source: branches/1.2/gui/scripts/flowvisviewer.tcl @ 3652

Last change on this file since 3652 was 3555, checked in by gah, 11 years ago

convert grab on balloon to local

File size: 104.4 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: flowvisviewer - 3D flow rendering
4#
5#
6# This widget performs volume and flow rendering on 3D scalar/vector datasets.
7# It connects to the Flowvis server running on a rendering farm, transmits
8# data, and displays the results.
9#
10# ======================================================================
11#  AUTHOR:  Michael McLennan, Purdue University
12#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
13#
14# See the file "license.terms" for information on usage and redistribution of
15# this file, and for a DISCLAIMER OF ALL WARRANTIES.
16# ======================================================================
17package require Itk
18package require BLT
19package require Img
20
21option add *FlowvisViewer.width 5i widgetDefault
22option add *FlowvisViewer*cursor crosshair widgetDefault
23option add *FlowvisViewer.height 4i widgetDefault
24option add *FlowvisViewer.foreground black widgetDefault
25option add *FlowvisViewer.controlBackground gray widgetDefault
26option add *FlowvisViewer.controlDarkBackground #999999 widgetDefault
27option add *FlowvisViewer.plotBackground black widgetDefault
28option add *FlowvisViewer.plotForeground white widgetDefault
29option add *FlowvisViewer.plotOutline gray widgetDefault
30option add *FlowvisViewer.font \
31    -*-helvetica-medium-r-normal-*-12-* widgetDefault
32
33# must use this name -- plugs into Rappture::resources::load
34proc FlowvisViewer_init_resources {} {
35    Rappture::resources::register \
36        nanovis_server Rappture::FlowvisViewer::SetServerList
37}
38
39itcl::class Rappture::FlowvisViewer {
40    inherit Rappture::VisViewer
41
42    itk_option define -plotforeground plotForeground Foreground ""
43    itk_option define -plotbackground plotBackground Background ""
44    itk_option define -plotoutline plotOutline PlotOutline ""
45
46    constructor { hostlist args } {
47        Rappture::VisViewer::constructor $hostlist
48    } {
49        # defined below
50    }
51    destructor {
52        # defined below
53    }
54    public proc SetServerList { namelist } {
55        Rappture::VisViewer::SetServerList "nanovis" $namelist
56    }
57    public method add {dataobj {settings ""}}
58    public method camera {option args}
59    public method delete {args}
60    public method disconnect {}
61    public method download {option args}
62    public method flow {option}
63    public method get {args}
64    public method isconnected {}
65    public method limits { tf }
66    public method overmarker { m x }
67    public method parameters {title args} {
68        # do nothing
69    }
70    public method rmdupmarker { m x }
71    public method scale {args}
72    public method updatetransferfuncs {}
73
74    protected method Connect {}
75    protected method CurrentVolumeIds {{what -all}}
76    protected method Disconnect {}
77    protected method Resize {}
78    protected method ResizeLegend {}
79    protected method AdjustSetting {what {value ""}}
80    protected method InitSettings { args }
81    protected method Pan {option x y}
82    protected method Rebuild {}
83    protected method ReceiveData { args }
84    protected method ReceiveImage { args }
85    protected method ReceiveLegend { tf vmin vmax size }
86    protected method Rotate {option x y}
87    protected method SendDataObjs {}
88    protected method SendTransferFuncs {}
89    protected method Slice {option args}
90    protected method SlicerTip {axis}
91    protected method Zoom {option}
92
93    # soon to be removed.
94    protected method Flow {option args}
95    protected method Play {}
96    protected method Pause {}
97
98
99    # The following methods are only used by this class.
100
101    private method AddIsoMarker { x y }
102    private method BuildCameraTab {}
103    private method BuildCutplanesTab {}
104    private method BuildViewTab {}
105    private method BuildVolumeTab {}
106    private method ComputeTransferFunc { tf }
107    private method EventuallyResize { w h }
108    private method EventuallyGoto { nSteps }
109    private method EventuallyResizeLegend { }
110    private method FlowCmd { dataobj comp nbytes extents }
111    private method GetMovie { widget width height }
112    private method GetPngImage { widget width height }
113    private method NameTransferFunc { dataobj comp }
114    private method PanCamera {}
115    private method ParseLevelsOption { tf levels }
116    private method ParseMarkersOption { tf markers }
117    private method WaitIcon { option widget }
118    private method str2millisecs { value }
119    private method millisecs2str { value }
120    private method GetFlowInfo { widget }
121    private method particles { tag name }
122    private method box { tag name }
123    private method streams { tag name }
124    private method arrows { tag name }
125    private method SetOrientation { side }
126
127    private variable _arcball ""
128    private variable _dlist ""     ;# list of data objects
129    private variable _allDataObjs
130    private variable _obj2ovride   ;# maps dataobj => style override
131    private variable _serverObjs   ;# maps dataobj-component to volume ID
132                                    # in the server
133    private variable _sendobjs ""  ;# list of data objs to send to server
134    private variable _recvObjs  ;# list of data objs to send to server
135    private variable _obj2style    ;# maps dataobj-component to transfunc
136    private variable _style2objs   ;# maps tf back to list of
137                                    # dataobj-components using the tf.
138    private variable _obj2flow;         # Maps dataobj-component to a flow.
139
140    private variable _reset 1;          # Connection to server has been reset
141    private variable _click        ;# info used for rotate operations
142    private variable _limits       ;# autoscale min/max for all axes
143    private variable _view         ;# view params for 3D view
144    private variable _isomarkers    ;# array of isosurface level values 0..1
145    private common   _settings
146    private variable _activeTf ""  ;# The currently active transfer function.
147    private variable _first ""     ;# This is the topmost volume.
148    private variable _nextToken 0
149    private variable _icon 0
150    private variable _flow
151    # This
152    # indicates which isomarkers and transfer
153    # function to use when changing markers,
154    # opacity, or thickness.
155    private common _downloadPopup          ;# download options from popup
156
157    private common _hardcopy
158    private variable _width 0
159    private variable _height 0
160    private variable _resizePending 0
161    private variable _resizeLegendPending 0
162    private variable _gotoPending 0
163}
164
165itk::usual FlowvisViewer {
166    keep -background -foreground -cursor -font
167    keep -plotbackground -plotforeground
168}
169
170# ----------------------------------------------------------------------
171# CONSTRUCTOR
172# ----------------------------------------------------------------------
173itcl::body Rappture::FlowvisViewer::constructor { hostlist args } {
174    set _serverType "nanovis"
175
176    # Draw legend event
177    $_dispatcher register !legend
178    $_dispatcher dispatch $this !legend "[itcl::code $this ResizeLegend]; list"
179
180    # Send dataobjs event
181    $_dispatcher register !send_dataobjs
182    $_dispatcher dispatch $this !send_dataobjs \
183        "[itcl::code $this SendDataObjs]; list"
184
185    # Send transferfunctions event
186    $_dispatcher register !send_transfunc
187    $_dispatcher dispatch $this !send_transfunc \
188        "[itcl::code $this SendTransferFuncs]; list"
189
190    # Rebuild event.
191    $_dispatcher register !rebuild
192    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
193
194    # Resize event.
195    $_dispatcher register !resize
196    $_dispatcher dispatch $this !resize "[itcl::code $this Resize]; list"
197
198    $_dispatcher register !play
199    $_dispatcher dispatch $this !play "[itcl::code $this flow next]; list"
200   
201    # Draw legend event
202    $_dispatcher register !goto
203    $_dispatcher dispatch $this !goto "[itcl::code $this flow goto2]; list"
204
205    $_dispatcher register !movietimeout
206    $_dispatcher register !waiticon
207
208    set _flow(state) 0
209
210    array set _downloadPopup {
211        format draft
212    }
213    #
214    # Populate parser with commands handle incoming requests
215    #
216    $_parser alias image [itcl::code $this ReceiveImage]
217    $_parser alias legend [itcl::code $this ReceiveLegend]
218    $_parser alias data [itcl::code $this ReceiveData]
219
220    # Initialize the view to some default parameters.
221    array set _view {
222        qw      0.853553
223        qx      -0.353553
224        qy      0.353553
225        qz      0.146447
226        zoom    1.0
227        xpan    0
228        ypan    0
229    }
230    set _arcball [blt::arcball create 100 100]
231    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
232    $_arcball quaternion $q
233
234    set _limits(vmin) 0.0
235    set _limits(vmax) 1.0
236    set _reset 1
237
238    array set _settings [subst {
239        $this-qw                $_view(qw)
240        $this-qx                $_view(qx)
241        $this-qy                $_view(qy)
242        $this-qz                $_view(qz)
243        $this-zoom              $_view(zoom)   
244        $this-xpan              $_view(xpan)
245        $this-ypan              $_view(ypan)
246        $this-arrows            0
247        $this-currenttime       0
248        $this-duration          1:00
249        $this-loop              0
250        $this-play              0
251        $this-speed             500
252        $this-step              0
253        $this-streams           0
254        $this-volume            1
255        $this-xcutplane         0
256        $this-xcutposition      0
257        $this-ycutplane         0
258        $this-ycutposition      0
259        $this-zcutplane         0
260        $this-zcutposition      0
261    }]
262
263    itk_component add 3dview {
264        label $itk_component(plotarea).view -image $_image(plot) \
265            -highlightthickness 0 -borderwidth 0
266    } {
267        usual
268        ignore -highlightthickness -borderwidth  -background
269    }
270    bind $itk_component(3dview) <Control-F1> [itcl::code $this ToggleConsole]
271
272    set f [$itk_component(main) component controls]
273    itk_component add reset {
274        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
275            -highlightthickness 0 \
276            -image [Rappture::icon reset-view] \
277            -command [itcl::code $this Zoom reset]
278    } {
279        usual
280        ignore -highlightthickness
281    }
282    pack $itk_component(reset) -side top -padx 2 -pady 2
283    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
284
285    itk_component add zoomin {
286        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
287            -highlightthickness 0 \
288            -image [Rappture::icon zoom-in] \
289            -command [itcl::code $this Zoom in]
290    } {
291        usual
292        ignore -highlightthickness
293    }
294    pack $itk_component(zoomin) -side top -padx 2 -pady 2
295    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
296
297    itk_component add zoomout {
298        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
299            -highlightthickness 0 \
300            -image [Rappture::icon zoom-out] \
301            -command [itcl::code $this Zoom out]
302    } {
303        usual
304        ignore -highlightthickness
305    }
306    pack $itk_component(zoomout) -side top -padx 2 -pady 2
307    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
308
309    itk_component add volume {
310        Rappture::PushButton $f.volume \
311            -onimage [Rappture::icon volume-on] \
312            -offimage [Rappture::icon volume-off] \
313            -command [itcl::code $this AdjustSetting volume] \
314            -variable [itcl::scope _settings($this-volume)]
315    }
316    $itk_component(volume) select
317    Rappture::Tooltip::for $itk_component(volume) \
318        "Toggle the volume cloud on/off"
319    pack $itk_component(volume) -padx 2 -pady 2
320
321    if { [catch {
322        BuildViewTab
323        BuildVolumeTab
324        BuildCutplanesTab
325        BuildCameraTab
326    } errs] != 0 } {
327        global errorInfo
328        puts stderr "errs=$errs errorInfo=$errorInfo"
329    }
330
331    bind $itk_component(3dview) <Configure> \
332        [itcl::code $this EventuallyResize %w %h]
333
334    # Legend
335    set _image(legend) [image create photo]
336    itk_component add legend {
337        canvas $itk_component(plotarea).legend \
338            -height 50 -highlightthickness 0 -background black
339    } {
340        usual
341        ignore -highlightthickness
342        rename -background -plotbackground plotBackground Background
343    }
344    bind $itk_component(legend) <Configure> \
345        [itcl::code $this EventuallyResizeLegend]
346
347    # Hack around the Tk panewindow.  The problem is that the requested
348    # size of the 3d view isn't set until an image is retrieved from
349    # the server.  So the panewindow uses the tiny size.
350    set w 10000
351    pack forget $itk_component(3dview)
352    blt::table $itk_component(plotarea) \
353        0,0 $itk_component(3dview) -fill both -reqwidth $w \
354        1,0 $itk_component(legend) -fill x
355    blt::table configure $itk_component(plotarea) r1 -resize none   
356    # Create flow controls...
357
358    itk_component add flowcontrols {
359        frame $itk_interior.flowcontrols
360    } {
361        usual
362        rename -background -controlbackground controlBackground Background
363    }
364    pack forget $itk_component(main)
365    blt::table $itk_interior \
366        0,0 $itk_component(main) -fill both  \
367        1,0 $itk_component(flowcontrols) -fill x
368    blt::table configure $itk_interior r1 -resize none
369
370    # Rewind
371    itk_component add rewind {
372        button $itk_component(flowcontrols).reset \
373            -borderwidth 1 -padx 1 -pady 1 \
374            -image [Rappture::icon flow-rewind] \
375            -command [itcl::code $this flow reset]
376    } {
377        usual
378        ignore -borderwidth
379        rename -highlightbackground -controlbackground controlBackground \
380            Background
381    }
382    Rappture::Tooltip::for $itk_component(rewind) \
383        "Rewind flow"
384
385    # Stop
386    itk_component add stop {
387        button $itk_component(flowcontrols).stop \
388            -borderwidth 1 -padx 1 -pady 1 \
389            -image [Rappture::icon flow-stop] \
390            -command [itcl::code $this flow stop]
391    } {
392        usual
393        ignore -borderwidth
394        rename -highlightbackground -controlbackground controlBackground \
395            Background
396    }
397    Rappture::Tooltip::for $itk_component(stop) \
398        "Stop flow"
399
400    # Play
401    itk_component add play {
402        Rappture::PushButton $itk_component(flowcontrols).play \
403            -onimage [Rappture::icon flow-pause] \
404            -offimage [Rappture::icon flow-play] \
405            -variable [itcl::scope _settings($this-play)] \
406            -command [itcl::code $this flow toggle]
407    }
408    set fg [option get $itk_component(hull) font Font]
409    Rappture::Tooltip::for $itk_component(play) \
410        "Play/Pause flow"
411
412    # Loop
413    itk_component add loop {
414        Rappture::PushButton $itk_component(flowcontrols).loop \
415            -onimage [Rappture::icon flow-loop] \
416            -offimage [Rappture::icon flow-loop] \
417            -variable [itcl::scope _settings($this-loop)]
418    }
419    Rappture::Tooltip::for $itk_component(loop) \
420        "Play continuously"
421
422    itk_component add dial {
423        Rappture::Flowdial $itk_component(flowcontrols).dial \
424            -length 10 -valuewidth 0 -valuepadding 0 -padding 6 \
425            -linecolor "" -activelinecolor "" \
426            -min 0.0 -max 1.0 \
427            -variable [itcl::scope _settings($this-currenttime)] \
428            -knobimage [Rappture::icon knob2] -knobposition center@middle
429    } {
430        usual
431        ignore -dialprogresscolor
432        rename -background -controlbackground controlBackground Background
433    }
434    $itk_component(dial) current 0.0
435    bind $itk_component(dial) <<Value>> [itcl::code $this flow goto]
436    # Duration
437    itk_component add duration {
438        entry $itk_component(flowcontrols).duration \
439            -textvariable [itcl::scope _settings($this-duration)] \
440            -bg white -width 6 -font "arial 9"
441    } {
442        usual
443        ignore -highlightthickness -background
444    }
445    bind $itk_component(duration) <Return> [itcl::code $this flow duration]
446    bind $itk_component(duration) <KP_Enter> [itcl::code $this flow duration]
447    bind $itk_component(duration) <Tab> [itcl::code $this flow duration]
448    Rappture::Tooltip::for $itk_component(duration) \
449        "Set duration of flow (format is min:sec)"
450
451
452    itk_component add durationlabel {
453        label $itk_component(flowcontrols).durationl \
454            -text "Duration:" -font $fg \
455            -highlightthickness 0
456    } {
457        usual
458        ignore -highlightthickness
459        rename -background -controlbackground controlBackground Background
460    }
461
462    itk_component add speedlabel {
463        label $itk_component(flowcontrols).speedl -text "Speed:" -font $fg \
464            -highlightthickness 0
465    } {
466        usual
467        ignore -highlightthickness
468        rename -background -controlbackground controlBackground Background
469    }
470
471    # Speed
472    itk_component add speed {
473        Rappture::Flowspeed $itk_component(flowcontrols).speed \
474            -min 1 -max 10 -width 3 -font "arial 9"
475    } {
476        usual
477        ignore -highlightthickness
478        rename -background -controlbackground controlBackground Background
479    }
480    Rappture::Tooltip::for $itk_component(speed) \
481        "Change speed of flow"
482
483    $itk_component(speed) value 1
484    bind $itk_component(speed) <<Value>> [itcl::code $this flow speed]
485
486
487    blt::table $itk_component(flowcontrols) \
488        0,0 $itk_component(rewind) -padx {3 0} \
489        0,1 $itk_component(stop) -padx {2 0} \
490        0,2 $itk_component(play) -padx {2 0} \
491        0,3 $itk_component(loop) -padx {2 0} \
492        0,4 $itk_component(dial) -fill x -padx {2 0 } \
493        0,5 $itk_component(duration) -padx { 0 0} \
494        0,7 $itk_component(speed) -padx {2 3}
495
496#        0,6 $itk_component(speedlabel) -padx {2 0}
497    blt::table configure $itk_component(flowcontrols) c* -resize none
498    blt::table configure $itk_component(flowcontrols) c4 -resize both
499    blt::table configure $itk_component(flowcontrols) r0 -pady 1
500    # Bindings for rotation via mouse
501    bind $itk_component(3dview) <ButtonPress-1> \
502        [itcl::code $this Rotate click %x %y]
503    bind $itk_component(3dview) <B1-Motion> \
504        [itcl::code $this Rotate drag %x %y]
505    bind $itk_component(3dview) <ButtonRelease-1> \
506        [itcl::code $this Rotate release %x %y]
507
508    bind $itk_component(3dview) <Configure> \
509        [itcl::code $this EventuallyResize %w %h]
510
511    # Bindings for panning via mouse
512    bind $itk_component(3dview) <ButtonPress-2> \
513        [itcl::code $this Pan click %x %y]
514    bind $itk_component(3dview) <B2-Motion> \
515        [itcl::code $this Pan drag %x %y]
516    bind $itk_component(3dview) <ButtonRelease-2> \
517        [itcl::code $this Pan release %x %y]
518
519    # Bindings for panning via keyboard
520    bind $itk_component(3dview) <KeyPress-Left> \
521        [itcl::code $this Pan set -10 0]
522    bind $itk_component(3dview) <KeyPress-Right> \
523        [itcl::code $this Pan set 10 0]
524    bind $itk_component(3dview) <KeyPress-Up> \
525        [itcl::code $this Pan set 0 -10]
526    bind $itk_component(3dview) <KeyPress-Down> \
527        [itcl::code $this Pan set 0 10]
528    bind $itk_component(3dview) <Shift-KeyPress-Left> \
529        [itcl::code $this Pan set -2 0]
530    bind $itk_component(3dview) <Shift-KeyPress-Right> \
531        [itcl::code $this Pan set 2 0]
532    bind $itk_component(3dview) <Shift-KeyPress-Up> \
533        [itcl::code $this Pan set 0 -2]
534    bind $itk_component(3dview) <Shift-KeyPress-Down> \
535        [itcl::code $this Pan set 0 2]
536
537    # Bindings for zoom via keyboard
538    bind $itk_component(3dview) <KeyPress-Prior> \
539        [itcl::code $this Zoom out]
540    bind $itk_component(3dview) <KeyPress-Next> \
541        [itcl::code $this Zoom in]
542
543    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
544
545    if {[string equal "x11" [tk windowingsystem]]} {
546        # Bindings for zoom via mouse
547        bind $itk_component(3dview) <4> [itcl::code $this Zoom out]
548        bind $itk_component(3dview) <5> [itcl::code $this Zoom in]
549    }
550
551    set _image(download) [image create photo]
552
553    eval itk_initialize $args
554
555    Connect
556}
557
558# ----------------------------------------------------------------------
559# DESTRUCTOR
560# ----------------------------------------------------------------------
561itcl::body Rappture::FlowvisViewer::destructor {} {
562    set _sendobjs ""  ;# stop any send in progress
563    $_dispatcher cancel !rebuild
564    $_dispatcher cancel !send_dataobjs
565    $_dispatcher cancel !send_transfunc
566    image delete $_image(plot)
567    image delete $_image(legend)
568    image delete $_image(download)
569    catch { blt::arcball destroy $_arcball }
570    array unset _settings $this-*
571}
572
573# ----------------------------------------------------------------------
574# USAGE: add <dataobj> ?<settings>?
575#
576# Clients use this to add a data object to the plot.  The optional
577# <settings> are used to configure the plot.  Allowed settings are
578# -color, -brightness, -width, -linestyle, and -raise.
579# ----------------------------------------------------------------------
580itcl::body Rappture::FlowvisViewer::add {dataobj {settings ""}} {
581    array set params {
582        -color auto
583        -width 1
584        -linestyle solid
585        -brightness 0
586        -raise 0
587        -description ""
588        -param ""
589    }
590    foreach {opt val} $settings {
591        if {![info exists params($opt)]} {
592            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
593        }
594        set params($opt) $val
595    }
596    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
597        # can't handle -autocolors yet
598        set params(-color) black
599    }
600    foreach comp [$dataobj components] {
601        set flowobj [$dataobj flowhints $comp]
602        if { $flowobj == "" } {
603            puts stderr "no flowhints $dataobj-$comp"
604            continue
605        }
606        set _obj2flow($dataobj-$comp) $flowobj
607    }
608    set pos [lsearch -exact $dataobj $_dlist]
609    if {$pos < 0} {
610        lappend _dlist $dataobj
611        set _allDataObjs($dataobj) 1
612        set _obj2ovride($dataobj-color) $params(-color)
613        set _obj2ovride($dataobj-width) $params(-width)
614        set _obj2ovride($dataobj-raise) $params(-raise)
615        $_dispatcher event -idle !rebuild
616    }
617}
618
619# ----------------------------------------------------------------------
620# USAGE: get ?-objects?
621# USAGE: get ?-image 3dview|legend?
622#
623# Clients use this to query the list of objects being plotted, in
624# order from bottom to top of this result.  The optional "-image"
625# flag can also request the internal images being shown.
626# ----------------------------------------------------------------------
627itcl::body Rappture::FlowvisViewer::get {args} {
628    if {[llength $args] == 0} {
629        set args "-objects"
630    }
631
632    set op [lindex $args 0]
633    switch -- $op {
634      -objects {
635        # put the dataobj list in order according to -raise options
636        set dlist $_dlist
637        foreach obj $dlist {
638            if {[info exists _obj2ovride($obj-raise)] && $_obj2ovride($obj-raise)} {
639                set i [lsearch -exact $dlist $obj]
640                if {$i >= 0} {
641                    set dlist [lreplace $dlist $i $i]
642                    lappend dlist $obj
643                }
644            }
645        }
646        return $dlist
647      }
648      -image {
649        if {[llength $args] != 2} {
650            error "wrong # args: should be \"get -image 3dview|legend\""
651        }
652        switch -- [lindex $args end] {
653            3dview {
654                return $_image(plot)
655            }
656            legend {
657                return $_image(legend)
658            }
659            default {
660                error "bad image name \"[lindex $args end]\": should be 3dview or legend"
661            }
662        }
663      }
664      default {
665        error "bad option \"$op\": should be -objects or -image"
666      }
667    }
668}
669
670# ----------------------------------------------------------------------
671# USAGE: delete ?<dataobj1> <dataobj2> ...?
672#
673#       Clients use this to delete a dataobj from the plot.  If no dataobjs
674#       are specified, then all dataobjs are deleted.  No data objects are
675#       deleted.  They are only removed from the display list.
676#
677# ----------------------------------------------------------------------
678itcl::body Rappture::FlowvisViewer::delete {args} {
679     flow stop
680    if {[llength $args] == 0} {
681        set args $_dlist
682    }
683
684    # Delete all specified dataobjs
685    set changed 0
686    foreach dataobj $args {
687        set pos [lsearch -exact $_dlist $dataobj]
688        if { $pos >= 0 } {
689            foreach comp [$dataobj components] {
690                array unset _limits $dataobj-$comp-*
691            }
692            set _dlist [lreplace $_dlist $pos $pos]
693            array unset _obj2ovride $dataobj-*
694            array unset _obj2flow $dataobj-*
695            array unset _serverObjs $dataobj-*
696            array unset _obj2style $dataobj-*
697            set changed 1
698        }
699    }
700    # If anything changed, then rebuild the plot
701    if {$changed} {
702        # Repair the reverse lookup
703        foreach tf [array names _style2objs] {
704            set list {}
705            foreach {dataobj comp} $_style2objs($tf) break
706            if { [info exists _serverObjs($dataobj-$comp)] } {
707                lappend list $dataobj $comp
708            }
709            if { $list == "" } {
710                array unset _style2objs $tf
711            } else {
712                set _style2objs($tf) $list
713            }
714        }
715        $_dispatcher event -idle !rebuild
716    }
717}
718
719# ----------------------------------------------------------------------
720# USAGE: scale ?<data1> <data2> ...?
721#
722# Sets the default limits for the overall plot according to the
723# limits of the data for all of the given <data> objects.  This
724# accounts for all objects--even those not showing on the screen.
725# Because of this, the limits are appropriate for all objects as
726# the user scans through data in the ResultSet viewer.
727# ----------------------------------------------------------------------
728itcl::body Rappture::FlowvisViewer::scale {args} {
729    foreach val {xmin xmax ymin ymax vmin vmax} {
730        set _limits($val) ""
731    }
732    foreach obj $args {
733        foreach axis {x y v} {
734
735            foreach { min max } [$obj limits $axis] break
736
737            if {"" != $min && "" != $max} {
738                if {"" == $_limits(${axis}min)} {
739                    set _limits(${axis}min) $min
740                    set _limits(${axis}max) $max
741                } else {
742                    if {$min < $_limits(${axis}min)} {
743                        set _limits(${axis}min) $min
744                    }
745                    if {$max > $_limits(${axis}max)} {
746                        set _limits(${axis}max) $max
747                    }
748                }
749            }
750        }
751    }
752}
753
754# ----------------------------------------------------------------------
755# USAGE: download coming
756# USAGE: download controls <downloadCommand>
757# USAGE: download now
758#
759# Clients use this method to create a downloadable representation
760# of the plot.  Returns a list of the form {ext string}, where
761# "ext" is the file extension (indicating the type of data) and
762# "string" is the data itself.
763# ----------------------------------------------------------------------
764itcl::body Rappture::FlowvisViewer::download {option args} {
765    set popup .flowvisviewerdownload
766    switch $option {
767        coming {
768            if {[catch {
769                blt::winop snap $itk_component(plotarea) $_image(download)
770            }]} {
771                $_image(download) configure -width 1 -height 1
772                $_image(download) put #000000
773            }
774        }
775        controls {
776            if {![winfo exists $popup]} {
777                # if we haven't created the popup yet, do it now
778                Rappture::Balloon $popup \
779                    -title "[Rappture::filexfer::label downloadWord] as..."
780                set inner [$popup component inner]
781                label $inner.summary -text "" -anchor w
782                pack $inner.summary -side top
783                set img $_image(plot)
784                set res "[image width $img]x[image height $img]"
785                radiobutton $inner.draft -text "Image (draft $res)" \
786                    -variable Rappture::FlowvisViewer::_downloadPopup(format) \
787                    -value draft
788                pack $inner.draft -anchor w
789
790                set res "640x480"
791                radiobutton $inner.medium -text "Movie (standard $res)" \
792                    -variable Rappture::FlowvisViewer::_downloadPopup(format) \
793                    -value $res
794                pack $inner.medium -anchor w
795
796                set res "1024x768"
797                radiobutton $inner.high -text "Movie (high quality $res)" \
798                    -variable Rappture::FlowvisViewer::_downloadPopup(format) \
799                    -value $res
800                pack $inner.high -anchor w
801                button $inner.go -text [Rappture::filexfer::label download] \
802                    -command [lindex $args 0]
803                pack $inner.go -pady 4
804                $inner.draft select
805            } else {
806                set inner [$popup component inner]
807            }
808            set num [llength [get]]
809            set num [expr {($num == 1) ? "1 result" : "$num results"}]
810            set word [Rappture::filexfer::label downloadWord]
811            $inner.summary configure -text "$word $num in the following format:"
812            update idletasks ;# fix initial sizes
813            update
814            return $popup
815        }
816        now {
817            if { [winfo exists $popup] } {
818                $popup deactivate
819            }
820            switch -- $_downloadPopup(format) {
821                draft {
822                    # Get the image data (as base64) and decode it back to
823                    # binary.  This is better than writing to temporary
824                    # files.  When we switch to the BLT picture image it
825                    # won't be necessary to decode the image data.
826                    set bytes [$_image(plot) data -format "jpeg -quality 100"]
827                    set bytes [Rappture::encoding::decode -as b64 $bytes]
828                    return [list .jpg $bytes]
829                }
830                "640x480" {
831                    return [$this GetMovie [lindex $args 0] 640 480]
832                }
833                "1024x768" {
834                    return [$this GetMovie [lindex $args 0] 1024 768]
835                }
836                default {
837                    error "bad download format $_downloadPopup(format)"
838                }
839            }
840        }
841        default {
842            error "bad option \"$option\": should be coming, controls, now"
843        }
844    }
845}
846
847# ----------------------------------------------------------------------
848# USAGE: Connect ?<host:port>,<host:port>...?
849#
850# Clients use this method to establish a connection to a new
851# server, or to reestablish a connection to the previous server.
852# Any existing connection is automatically closed.
853# ----------------------------------------------------------------------
854itcl::body Rappture::FlowvisViewer::Connect {} {
855    set _hosts [GetServerList "nanovis"]
856    if { "" == $_hosts } {
857        return 0
858    }
859    set _reset 1
860    set result [VisViewer::Connect $_hosts]
861    if { $result } {
862        set w [winfo width $itk_component(3dview)]
863        set h [winfo height $itk_component(3dview)]
864        EventuallyResize $w $h
865    }
866    return $result
867}
868
869#
870# isconnected --
871#
872#       Indicates if we are currently connected to the visualization server.
873#
874itcl::body Rappture::FlowvisViewer::isconnected {} {
875    return [VisViewer::IsConnected]
876}
877
878#
879# disconnect --
880#
881itcl::body Rappture::FlowvisViewer::disconnect {} {
882    Disconnect
883}
884
885#
886# Disconnect --
887#
888#       Clients use this method to disconnect from the current rendering
889#       server.
890#
891itcl::body Rappture::FlowvisViewer::Disconnect {} {
892    VisViewer::Disconnect
893
894    # disconnected -- no more data sitting on server
895    array unset _serverObjs
896    set _sendobjs ""
897}
898
899# ----------------------------------------------------------------------
900# USAGE: SendDataObjs
901#
902# Used internally to send a series of volume objects off to the
903# server.  Sends each object, a little at a time, with updates in
904# between so the interface doesn't lock up.
905# ----------------------------------------------------------------------
906itcl::body Rappture::FlowvisViewer::SendDataObjs {} {
907    blt::busy hold $itk_component(hull)
908    foreach dataobj $_sendobjs {
909        foreach comp [$dataobj components] {
910            # Send the data as one huge base64-encoded mess -- yuck!
911            set data [$dataobj blob $comp]
912            set nbytes [string length $data]
913            set extents [$dataobj extents $comp]
914
915            # I have a field. Is a vector field or a volume field?
916            if { $extents == 1 } {
917                set cmd "volume data follows $nbytes $dataobj-$comp\n"
918            } else {
919                set cmd [FlowCmd $dataobj $comp $nbytes $extents]
920                if { $cmd == "" } {
921                    puts stderr "no command"
922                    continue
923                }
924            }
925            f { ![SendBytes $cmd] } {
926                puts stderr "can't send"
927                return
928            }
929            if { ![SendBytes $data] } {
930                puts stderr "can't send"
931                return
932            }
933            NameTransferFunc $dataobj $comp
934            set _recvObjs($dataobj-$comp) 1
935        }
936    }
937    set _sendobjs ""
938    blt::busy release $itk_component(hull)
939
940    # Turn on buffering of commands to the server.  We don't want to
941    # be preempted by a server disconnect/reconnect (which automatically
942    # generates a new call to Rebuild).   
943    StartBufferingCommands
944
945    # activate the proper volume
946    set _first [lindex [get] 0]
947    if { "" != $_first } {
948        set axis [$_first hints updir]
949        if {"" != $axis} {
950            SendCmd "up $axis"
951        }
952
953        if 0 {
954        set location [$_first hints camera]
955        if { $location != "" } {
956            array set _view $location
957        }
958        set _settings($this-qw)    $_view(qw)
959        set _settings($this-qx)    $_view(qx)
960        set _settings($this-qy)    $_view(qy)
961        set _settings($this-qz)    $_view(qz)
962        set _settings($this-xpan)  $_view(xpan)
963        set _settings($this-ypan)  $_view(ypan)
964        set _settings($this-zoom)  $_view(zoom)
965        set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
966        $_arcball quaternion $q
967        SendCmd "camera orient $q"
968        SendCmd "camera reset"
969        PanCamera
970        SendCmd "camera zoom $_view(zoom)"
971        }
972        # The active transfer function is by default the first component of
973        # the first data object.  This assumes that the data is always
974        # successfully transferred.
975        set comp [lindex [$_first components] 0]
976        set _activeTf [lindex $_obj2style($_first-$comp) 0]
977    }
978
979    SendCmd "flow reset"
980    StopBufferingCommands
981}
982
983# ----------------------------------------------------------------------
984# USAGE: SendTransferFuncs
985# ----------------------------------------------------------------------
986itcl::body Rappture::FlowvisViewer::SendTransferFuncs {} {
987    if { $_activeTf == "" } {
988        puts stderr "no active tf"
989        return
990    }
991    set tf $_activeTf
992    if { $_first == "" } {
993        puts stderr "no first"
994        return
995    }
996
997    # Ensure that the global opacity and thickness settings (in the slider
998    # settings widgets) are used for the active transfer-function.  Update the
999    # values in the _settings varible.
1000    set value $_settings($this-opacity)
1001    set opacity [expr { double($value) * 0.01 }]
1002    set _settings($this-$tf-opacity) $opacity
1003    set value $_settings($this-thickness)
1004    # Scale values between 0.00001 and 0.01000
1005    set thickness [expr {double($value) * 0.0001}]
1006    set _settings($this-$tf-thickness) $thickness
1007
1008    foreach key [array names _obj2style $_first-*] {
1009        if { [info exists _obj2style($key)] } {
1010            foreach tf $_obj2style($key) {
1011                ComputeTransferFunc $tf
1012            }
1013        }
1014    }
1015    EventuallyResizeLegend
1016}
1017
1018# ----------------------------------------------------------------------
1019# USAGE: ReceiveImage -bytes $size -type $type -token $token
1020#
1021# Invoked automatically whenever the "image" command comes in from
1022# the rendering server.  Indicates that binary image data with the
1023# specified <size> will follow.
1024# ----------------------------------------------------------------------
1025itcl::body Rappture::FlowvisViewer::ReceiveImage { args } {
1026    array set info {
1027        -token "???"
1028        -bytes 0
1029        -type image
1030    }
1031    array set info $args
1032    set bytes [ReceiveBytes $info(-bytes)]
1033    ReceiveEcho <<line "<read $info(-bytes) bytes"
1034    switch -- $info(-type)  {
1035        "image" {
1036            $_image(plot) configure -data $bytes
1037            #puts stderr "image received [image width $_image(plot)] by [image height $_image(plot)]"
1038        }
1039        "print" {
1040            set tag $this-$info(-token)
1041            set _hardcopy($tag) $bytes
1042        }
1043        "movie" {
1044            set tag $this-$info(-token)
1045            set _hardcopy($tag) $bytes
1046        }
1047        default {
1048            puts stderr "unknown download type $info(-type)"
1049        }
1050    }
1051}
1052
1053#
1054# ReceiveLegend --
1055#
1056#       The procedure is the response from the render server to each "legend"
1057#       command.  The server sends back a "legend" command invoked our
1058#       the slave interpreter.  The purpose is to collect data of the image
1059#       representing the legend in the canvas.  In addition, the isomarkers
1060#       of the active transfer function are displayed.
1061#
1062#       I don't know is this is the right place to display the isomarkers.
1063#       I don't know all the different paths used to draw the plot. There's
1064#       "Rebuild", "add", etc.
1065#
1066itcl::body Rappture::FlowvisViewer::ReceiveLegend { tag vmin vmax size } {
1067    if { ![isconnected] } {
1068        return
1069    }
1070    #puts stderr "receive legend $tag $vmin $vmax $size"
1071    set bytes [ReceiveBytes $size]
1072    $_image(legend) configure -data $bytes
1073    ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
1074
1075    set c $itk_component(legend)
1076    set w [winfo width $c]
1077    set h [winfo height $c]
1078    set lx 10
1079    # FIXME:  I don't know what I have to do this for the 2D flow
1080    #         example.  Otherwise the canvas background is white.
1081    #         I'll get to this when we add background changes into
1082    #         nanvis.
1083    $c configure -background black
1084    set ly [expr {$h - 1}]
1085    if {"" == [$c find withtag transfunc]} {
1086        $c create image 10 10 -anchor nw \
1087            -image $_image(legend) -tags transfunc
1088        $c create text $lx $ly -anchor sw \
1089            -fill $itk_option(-plotforeground) -tags "limits vmin"
1090        $c create text [expr {$w-$lx}] $ly -anchor se \
1091            -fill $itk_option(-plotforeground) -tags "limits vmax"
1092        $c lower transfunc
1093        $c bind transfunc <ButtonRelease-1> \
1094            [itcl::code $this AddIsoMarker %x %y]
1095    }
1096    # Display the markers used by the active transfer function.
1097    set tf $_obj2style($tag)
1098    array set limits [limits $tf]
1099    $c itemconfigure vmin -text [format %.2g $limits(vmin)]
1100    $c coords vmin $lx $ly
1101
1102    $c itemconfigure vmax -text [format %.2g $limits(vmax)]
1103    $c coords vmax [expr {$w-$lx}] $ly
1104
1105    if { [info exists _isomarkers($tf)] } {
1106        foreach m $_isomarkers($tf) {
1107            $m visible yes
1108        }
1109    }
1110}
1111
1112#
1113# ReceiveData --
1114#
1115#       The procedure is the response from the render server to each "data
1116#       follows" command.  The server sends back a "data" command invoked our
1117#       the slave interpreter.  The purpose is to collect the min/max of the
1118#       volume sent to the render server.  Since the client (flowvisviewer)
1119#       doesn't parse 3D data formats, we rely on the server (flowvis) to
1120#       tell us what the limits are.  Once we've received the limits to all
1121#       the data we've sent (tracked by _recvObjs) we can then determine
1122#       what the transfer functions are for these # volumes.
1123#
1124#       Note: There is a considerable tradeoff in having the server report
1125#             back what the data limits are.  It means that much of the code
1126#             having to do with transfer-functions has to wait for the data
1127#             to come back, since the isomarkers are calculated based upon
1128#             the data limits.  The client code is much messier because of
1129#             this.  The alternative is to parse any of the 3D formats on the
1130#             client side.
1131#
1132itcl::body Rappture::FlowvisViewer::ReceiveData { args } {
1133    if { ![isconnected] } {
1134        return
1135    }
1136    # Arguments from server are name value pairs. Stuff them in an array.
1137    array set values $args
1138    set tag $values(tag)
1139    set parts [split $tag -]
1140    set dataobj [lindex $parts 0]
1141    set _serverObjs($tag) 0
1142    set _limits($tag-min)  $values(min);  # Minimum value of the volume.
1143    set _limits($tag-max)  $values(max);  # Maximum value of the volume.
1144    unset _recvObjs($tag)
1145    if { [array size _recvObjs] == 0 } {
1146        updatetransferfuncs
1147    }
1148}
1149
1150#
1151# Rebuild --
1152#
1153# Called automatically whenever something changes that affects the data
1154# in the widget.  Clears any existing data and rebuilds the widget to
1155# display new data. 
1156#
1157itcl::body Rappture::FlowvisViewer::Rebuild {} {
1158    set w [winfo width $itk_component(3dview)]
1159    set h [winfo height $itk_component(3dview)]
1160    if { $w < 2 || $h < 2 } {
1161        $_dispatcher event -idle !rebuild
1162        return
1163    }
1164
1165    # Turn on buffering of commands to the server.  We don't want to
1166    # be preempted by a server disconnect/reconnect (which automatically
1167    # generates a new call to Rebuild).   
1168    StartBufferingCommands
1169
1170    # Hide all the isomarkers. Can't remove them. Have to remember the
1171    # settings since the user may have created/deleted/moved markers.
1172
1173    foreach tf [array names _isomarkers] {
1174        foreach m $_isomarkers($tf) {
1175            $m visible no
1176        }
1177    }
1178
1179    if { $_width != $w || $_height != $h || $_reset } {
1180        set _width $w
1181        set _height $h
1182        $_arcball resize $w $h
1183        Resize
1184    }
1185
1186    set _first ""
1187
1188    if { $_reset } {
1189        if { $_reportClientInfo }  {
1190            # Tell the server the name of the tool, the version, and
1191            # dataset that we are rendering.  Have to do it here because
1192            # we don't know what data objects are using the renderer until
1193            # be get here.
1194            global env
1195
1196            set info {}
1197            set user "???"
1198            if { [info exists env(USER)] } {
1199                set user $env(USER)
1200            }
1201            set session "???"
1202            if { [info exists env(SESSION)] } {
1203                set session $env(SESSION)
1204            }
1205            lappend info "hub" [exec hostname]
1206            lappend info "client" "flowvisviewer"
1207            lappend info "user" $user
1208            lappend info "session" $session
1209            SendCmd "clientinfo [list $info]"
1210        }
1211    }
1212    foreach dataobj [get] {
1213        foreach comp [$dataobj components] {
1214            set tag $dataobj-$comp
1215            # Send the data as one huge base64-encoded mess -- yuck!
1216            set data [$dataobj blob $comp]
1217            set nbytes [string length $data]
1218            if { $_reportClientInfo }  {
1219                set info {}
1220                lappend info "tool_id"       [$dataobj hints toolId]
1221                lappend info "tool_name"     [$dataobj hints toolName]
1222                lappend info "tool_version"  [$dataobj hints toolRevision]
1223                lappend info "tool_title"    [$dataobj hints toolTitle]
1224                lappend info "dataset_label" [$dataobj hints label]
1225                lappend info "dataset_size"  $nbytes
1226                lappend info "dataset_tag"   $tag
1227                SendCmd "clientinfo [list $info]"
1228            }
1229            set extents [$dataobj extents $comp]
1230            # I have a field. Is a vector field or a volume field?
1231            if { $extents == 1 } {
1232                set cmd "volume data follows $nbytes $tag\n"
1233            } else {
1234                set cmd [FlowCmd $dataobj $comp $nbytes $extents]
1235                if { $cmd == "" } {
1236                    puts stderr "no command"
1237                    continue
1238                }
1239            }
1240            append _outbuf $cmd
1241            append _outbuf $data
1242            NameTransferFunc $dataobj $comp
1243            set _recvObjs($tag) 1
1244        }
1245    }
1246
1247    set _first [lindex [get] 0]
1248
1249    # Reset the camera and other view parameters
1250    InitSettings light2side light transp isosurface grid axes volume outline
1251   
1252    # nothing to send -- activate the proper volume
1253    if {"" != $_first} {
1254        AdjustSetting light
1255        AdjustSetting transp
1256        set axis [$_first hints updir]
1257        if {"" != $axis} {
1258            SendCmd "up $axis"
1259        }
1260        set location [$_first hints camera]
1261        if { $location != "" } {
1262            array set _view $location
1263        }
1264
1265    }
1266    set _settings($this-qw)    $_view(qw)
1267    set _settings($this-qx)    $_view(qx)
1268    set _settings($this-qy)    $_view(qy)
1269    set _settings($this-qz)    $_view(qz)
1270    set _settings($this-xpan)  $_view(xpan)
1271    set _settings($this-ypan)  $_view(ypan)
1272    set _settings($this-zoom)  $_view(zoom)
1273
1274    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1275    $_arcball quaternion $q
1276    SendCmd "camera orient $q"
1277    SendCmd "camera reset"
1278    PanCamera
1279    SendCmd "camera zoom $_view(zoom)"
1280
1281    foreach dataobj [get] {
1282        foreach comp [$dataobj components] {
1283            NameTransferFunc $dataobj $comp
1284        }
1285    }
1286
1287    # nothing to send -- activate the proper ivol
1288    set _first [lindex [get] 0]
1289    if {"" != $_first} {
1290        set axis [$_first hints updir]
1291        if {"" != $axis} {
1292            SendCmd "up $axis"
1293        }
1294        set location [$_first hints camera]
1295        if { $location != "" } {
1296            array set _view $location
1297        }
1298        set comp [lindex [$_first components] 0]
1299        set _activeTf [lindex $_obj2style($_first-$comp) 0]
1300    }
1301
1302
1303    # sync the state of slicers
1304    set vols [CurrentVolumeIds -cutplanes]
1305    foreach axis {x y z} {
1306        SendCmd "cutplane state $_settings($this-${axis}cutplane) $axis $vols"
1307        set pos [expr {0.01*$_settings($this-${axis}cutposition)}]
1308        SendCmd "cutplane position $pos $axis $vols"
1309    }
1310    SendCmd "volume data state $_settings($this-volume)"
1311    EventuallyResizeLegend
1312
1313    # Actually write the commands to the server socket.  If it fails, we don't
1314    # care.  We're finished here.
1315    blt::busy hold $itk_component(hull)
1316    StopBufferingCommands
1317    blt::busy release $itk_component(hull)
1318    set _reset 0
1319}
1320
1321# ----------------------------------------------------------------------
1322# USAGE: CurrentVolumeIds ?-cutplanes?
1323#
1324# Returns a list of volume server IDs for the current volume being
1325# displayed.  This is normally a single ID, but it might be a list
1326# of IDs if the current data object has multiple components.
1327# ----------------------------------------------------------------------
1328itcl::body Rappture::FlowvisViewer::CurrentVolumeIds {{what -all}} {
1329    return ""
1330    if { $_first == "" } {
1331        return
1332    }
1333    foreach key [array names _serverObjs *-*] {
1334        if {[string match $_first-* $key]} {
1335            array set style {
1336                -cutplanes 1
1337            }
1338            foreach {dataobj comp} [split $key -] break
1339            array set style [lindex [$dataobj components -style $comp] 0]
1340            if {$what != "-cutplanes" || $style(-cutplanes)} {
1341                lappend rlist $_serverObjs($key)
1342            }
1343        }
1344    }
1345    return $rlist
1346}
1347
1348# ----------------------------------------------------------------------
1349# USAGE: Zoom in
1350# USAGE: Zoom out
1351# USAGE: Zoom reset
1352#
1353# Called automatically when the user clicks on one of the zoom
1354# controls for this widget.  Changes the zoom for the current view.
1355# ----------------------------------------------------------------------
1356itcl::body Rappture::FlowvisViewer::Zoom {option} {
1357    switch -- $option {
1358        "in" {
1359            set _view(zoom) [expr {$_view(zoom)*1.25}]
1360            set _settings($this-zoom) $_view(zoom)
1361            SendCmd "camera zoom $_view(zoom)"
1362        }
1363        "out" {
1364            set _view(zoom) [expr {$_view(zoom)*0.8}]
1365            set _settings($this-zoom) $_view(zoom)
1366            SendCmd "camera zoom $_view(zoom)"
1367        }
1368        "reset" {
1369            array set _view {
1370                qw      0.853553
1371                qx      -0.353553
1372                qy      0.353553
1373                qz      0.146447
1374                zoom    1.0
1375                xpan   0
1376                ypan   0
1377            }
1378            if { $_first != "" } {
1379                set location [$_first hints camera]
1380                if { $location != "" } {
1381                    array set _view $location
1382                }
1383            }
1384            set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1385            $_arcball quaternion $q
1386            SendCmd "camera orient $q"
1387            SendCmd "camera reset"
1388            set _settings($this-qw)    $_view(qw)
1389            set _settings($this-qx)    $_view(qx)
1390            set _settings($this-qy)    $_view(qy)
1391            set _settings($this-qz)    $_view(qz)
1392            set _settings($this-xpan)  $_view(xpan)
1393            set _settings($this-ypan)  $_view(ypan)
1394            set _settings($this-zoom)  $_view(zoom)
1395        }
1396    }
1397}
1398
1399itcl::body Rappture::FlowvisViewer::PanCamera {} {
1400    #set x [expr ($_view(xpan)) / $_limits(xrange)]
1401    #set y [expr ($_view(ypan)) / $_limits(yrange)]
1402    set x $_view(xpan)
1403    set y $_view(ypan)
1404    SendCmd "camera pan $x $y"
1405}
1406
1407# ----------------------------------------------------------------------
1408# USAGE: Rotate click <x> <y>
1409# USAGE: Rotate drag <x> <y>
1410# USAGE: Rotate release <x> <y>
1411#
1412# Called automatically when the user clicks/drags/releases in the
1413# plot area.  Moves the plot according to the user's actions.
1414# ----------------------------------------------------------------------
1415itcl::body Rappture::FlowvisViewer::Rotate {option x y} {
1416    switch -- $option {
1417        click {
1418            $itk_component(3dview) configure -cursor fleur
1419            set _click(x) $x
1420            set _click(y) $y
1421        }
1422        drag {
1423            if {[array size _click] == 0} {
1424                Rotate click $x $y
1425            } else {
1426                set w [winfo width $itk_component(3dview)]
1427                set h [winfo height $itk_component(3dview)]
1428                if {$w <= 0 || $h <= 0} {
1429                    return
1430                }
1431
1432                if {[catch {
1433                    # this fails sometimes for no apparent reason
1434                    set dx [expr {double($x-$_click(x))/$w}]
1435                    set dy [expr {double($y-$_click(y))/$h}]
1436                }]} {
1437                    return
1438                }
1439
1440                set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1441                foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break
1442                set _settings($this-qw) $_view(qw)
1443                set _settings($this-qx) $_view(qx)
1444                set _settings($this-qy) $_view(qy)
1445                set _settings($this-qz) $_view(qz)
1446                SendCmd "camera orient $q"
1447
1448                set _click(x) $x
1449                set _click(y) $y
1450            }
1451        }
1452        release {
1453            Rotate drag $x $y
1454            $itk_component(3dview) configure -cursor ""
1455            catch {unset _click}
1456        }
1457        default {
1458            error "bad option \"$option\": should be click, drag, release"
1459        }
1460    }
1461}
1462
1463# ----------------------------------------------------------------------
1464# USAGE: $this Pan click x y
1465#        $this Pan drag x y
1466#        $this Pan release x y
1467#
1468# Called automatically when the user clicks on one of the zoom
1469# controls for this widget.  Changes the zoom for the current view.
1470# ----------------------------------------------------------------------
1471itcl::body Rappture::FlowvisViewer::Pan {option x y} {
1472    # Experimental stuff
1473    set w [winfo width $itk_component(3dview)]
1474    set h [winfo height $itk_component(3dview)]
1475    if { $option == "set" } {
1476        set x [expr $x / double($w)]
1477        set y [expr $y / double($h)]
1478        set _view(xpan) [expr $_view(xpan) + $x]
1479        set _view(ypan) [expr $_view(ypan) + $y]
1480        PanCamera
1481        set _settings($this-xpan) $_view(xpan)
1482        set _settings($this-ypan) $_view(ypan)
1483        return
1484    }
1485    if { $option == "click" } {
1486        set _click(x) $x
1487        set _click(y) $y
1488        $itk_component(3dview) configure -cursor hand1
1489    }
1490    if { $option == "drag" || $option == "release" } {
1491        set dx [expr ($_click(x) - $x)/double($w)]
1492        set dy [expr ($_click(y) - $y)/double($h)]
1493        set _click(x) $x
1494        set _click(y) $y
1495        set _view(xpan) [expr $_view(xpan) - $dx]
1496        set _view(ypan) [expr $_view(ypan) - $dy]
1497        PanCamera
1498        set _settings($this-xpan) $_view(xpan)
1499        set _settings($this-ypan) $_view(ypan)
1500    }
1501    if { $option == "release" } {
1502        $itk_component(3dview) configure -cursor ""
1503    }
1504}
1505
1506
1507# ----------------------------------------------------------------------
1508# USAGE: Flow movie record|stop|play ?on|off|toggle?
1509#
1510# Called when the user clicks on the record, stop or play buttons
1511# for flow visualization.
1512# ----------------------------------------------------------------------
1513itcl::body Rappture::FlowvisViewer::Flow {option args} {
1514    switch -- $option {
1515        movie {
1516            if {[llength $args] < 1 || [llength $args] > 2} {
1517                error "wrong # args: should be \"Flow movie record|stop|play ?on|off|toggle?\""
1518            }
1519            set action [lindex $args 0]
1520            set op [lindex $args 1]
1521            if {$op == ""} { set op "on" }
1522
1523            set current [State $action]
1524            if {$op == "toggle"} {
1525                if {$current == "on"} {
1526                    set op "off"
1527                } else {
1528                    set op "on"
1529                }
1530            }
1531            set cmds ""
1532            switch -- $action {
1533                record {
1534                    if { [$itk_component(rewind) cget -relief] != "sunken" } {
1535                        $itk_component(rewind) configure -relief sunken
1536                        $itk_component(stop) configure -relief raised
1537                        $itk_component(play) configure -relief raised
1538                        set inner $itk_component(settingsFrame)
1539                        set frames [$inner.framecnt value]
1540                        set _settings(nsteps) $frames
1541                        set cmds "flow capture $frames"
1542                        SendCmd $cmds
1543                    }
1544                }
1545                stop {
1546                    if { [$itk_component(stop) cget -relief] != "sunken" } {
1547                        $itk_component(rewind) configure -relief raised
1548                        $itk_component(stop) configure -relief sunken
1549                        $itk_component(play) configure -relief raised
1550                        _pause
1551                        set cmds "flow reset"
1552                        SendCmd $cmds
1553                    }
1554                }
1555                play {
1556                    if { [$itk_component(play) cget -relief] != "sunken" } {
1557                        $itk_component(rewind) configure -relief raised
1558                        $itk_component(stop) configure -relief raised
1559                        $itk_component(play) configure \
1560                            -image [Rappture::icon flow-pause] \
1561                            -relief sunken
1562                        bind $itk_component(play) <ButtonPress> \
1563                            [itcl::code $this _pause]
1564                        flow next
1565                    }
1566                }
1567                default {
1568                    error "bad option \"$option\": should be one of record|stop|play"
1569                }
1570
1571            }
1572        }
1573        default {
1574            error "bad option \"$option\": should be movie"
1575        }
1576    }
1577}
1578
1579# ----------------------------------------------------------------------
1580# USAGE: Play
1581#
1582# ----------------------------------------------------------------------
1583itcl::body Rappture::FlowvisViewer::Play {} {
1584    SendCmd "flow next"
1585    set delay [expr {int(ceil(pow($_settings(speed)/10.0+2,2.0)*15))}]
1586    $_dispatcher event -after $delay !play
1587}
1588
1589# ----------------------------------------------------------------------
1590# USAGE: Pause
1591#
1592# Invoked when the user hits the "pause" button to stop playing the
1593# current sequence of frames as a movie.
1594# ----------------------------------------------------------------------
1595itcl::body Rappture::FlowvisViewer::Pause {} {
1596    $_dispatcher cancel !play
1597
1598    # Toggle the button to "play" mode
1599    $itk_component(play) configure \
1600        -image [Rappture::icon flow-start] \
1601        -relief raised
1602    bind $itk_component(play) <ButtonPress> \
1603        [itcl::code $this Flow movie play toggle]
1604}
1605
1606# ----------------------------------------------------------------------
1607# USAGE: InitSettings <what> ?<value>?
1608#
1609# Used internally to update rendering settings whenever parameters
1610# change in the popup settings panel.  Sends the new settings off
1611# to the back end.
1612# ----------------------------------------------------------------------
1613itcl::body Rappture::FlowvisViewer::InitSettings { args } {
1614    foreach arg $args {
1615        AdjustSetting $arg
1616    }
1617}
1618
1619# ----------------------------------------------------------------------
1620# USAGE: AdjustSetting <what> ?<value>?
1621#
1622# Used internally to update rendering settings whenever parameters
1623# change in the popup settings panel.  Sends the new settings off
1624# to the back end.
1625# ----------------------------------------------------------------------
1626itcl::body Rappture::FlowvisViewer::AdjustSetting {what {value ""}} {
1627    switch -- $what {
1628        colormap {
1629            set color [$itk_component(colormap) value]
1630            set _settings(colormap) $color
1631            #ResetColormap $color
1632        }
1633        light {
1634            if { $_first != "" } {
1635                set comp [lindex [$_first components] 0]
1636                set tag $_first-$comp
1637                set diffuse [expr {0.01*$_settings($this-light)}]
1638                set ambient [expr {1.0 - $diffuse}]
1639                set specularLevel 0.3
1640                set specularExp 90.0
1641                SendCmd "$tag configure -ambient $ambient -diffuse $diffuse -specularLevel $specularLevel -specularExp $specularExp"
1642            }
1643        }
1644        light2side {
1645            if { $_first != "" } {
1646                set comp [lindex [$_first components] 0]
1647                set tag $_first-$comp
1648                set val $_settings($this-light2side)
1649                SendCmd "$tag configure -light2side $val"
1650            }
1651        }
1652        transp {
1653            if { $_first != "" } {
1654                set comp [lindex [$_first components] 0]
1655                set tag $_first-$comp
1656                set opacity [expr { 0.01 * double($_settings($this-transp)) }]
1657                SendCmd "$tag configure -opacity $opacity"
1658            }
1659        }
1660        opacity {
1661            if { $_first != "" && $_activeTf != "" } {
1662                set opacity [expr { 0.01 * double($_settings($this-opacity)) }]
1663                set tf $_activeTf
1664                set _settings($this-$tf-opacity) $opacity
1665                updatetransferfuncs
1666            }
1667        }
1668
1669        thickness {
1670            if { $_first != "" && $_activeTf != "" } {
1671                set val $_settings($this-thickness)
1672                # Scale values between 0.00001 and 0.01000
1673                set sval [expr {0.0001*double($val)}]
1674                set tf $_activeTf
1675                set _settings($this-$tf-thickness) $sval
1676                updatetransferfuncs
1677            }
1678        }
1679        "outline" {
1680            if { $_first != "" } {
1681                set comp [lindex [$_first components] 0]
1682                set tag $_first-$comp
1683                SendCmd "$tag configure -outline $_settings($this-outline)"
1684            }
1685        }
1686        "isosurface" {
1687            if { [isconnected] } {
1688                SendCmd "volume shading isosurface $_settings($this-isosurface)"
1689            }
1690        }
1691        "grid" {
1692            if { [isconnected] } {
1693                SendCmd "grid visible $_settings($this-grid)"
1694            }
1695        }
1696        "axes" {
1697            if { [isconnected] } {
1698                SendCmd "axis visible $_settings($this-axes)"
1699            }
1700        }
1701        "legend" {
1702            if { $_settings($this-legend) } {
1703                blt::table $itk_component(plotarea) \
1704                    0,0 $itk_component(3dview) -fill both \
1705                    1,0 $itk_component(legend) -fill x
1706                blt::table configure $itk_component(plotarea) r1 -resize none
1707            } else {
1708                blt::table forget $itk_component(legend)
1709            }
1710        }
1711        "volume" {
1712            if { $_first != "" } {
1713                set comp [lindex [$_first components] 0]
1714                set tag $_first-$comp
1715                SendCmd "$tag configure -volume $_settings($this-volume)"
1716            }
1717        }
1718        "xcutplane" - "ycutplane" - "zcutplane" {
1719            set axis [string range $what 0 0]
1720            set bool $_settings($this-$what)
1721            if { [isconnected] } {
1722                set vols [CurrentVolumeIds -cutplanes]
1723                SendCmd "cutplane state $bool $axis $vols"
1724            }
1725            if { $bool } {
1726                $itk_component(${axis}CutScale) configure -state normal \
1727                    -troughcolor white
1728            } else {
1729                $itk_component(${axis}CutScale) configure -state disabled \
1730                    -troughcolor grey82
1731            }
1732        }
1733        default {
1734            error "don't know how to fix $what"
1735        }
1736    }
1737}
1738
1739# ----------------------------------------------------------------------
1740# USAGE: ResizeLegend
1741#
1742# Used internally to update the legend area whenever it changes size
1743# or when the field changes.  Asks the server to send a new legend
1744# for the current field.
1745# ----------------------------------------------------------------------
1746itcl::body Rappture::FlowvisViewer::ResizeLegend {} {
1747    set _resizeLegendPending 0
1748    set lineht [font metrics $itk_option(-font) -linespace]
1749    set w [expr {$_width-20}]
1750    set h [expr {[winfo height $itk_component(legend)]-20-$lineht}]
1751
1752    if { $_first == "" } {
1753        return
1754    }
1755    set comp [lindex [$_first components] 0]
1756    set tag $_first-$comp
1757    #set _activeTf [lindex $_obj2style($tag) 0]
1758    if {$w > 0 && $h > 0 && "" != $_activeTf} {
1759        #SendCmd "legend $_activeTf $w $h"
1760        SendCmd "$tag legend $w $h"
1761    } else {
1762    # Can't do this as this will remove the items associated with the
1763    # isomarkers.
1764
1765    #$itk_component(legend) delete all
1766    }
1767}
1768
1769#
1770# NameTransferFunc --
1771#
1772#       Creates a transfer function name based on the <style> settings in the
1773#       library run.xml file. This placeholder will be used later to create
1774#       and send the actual transfer function once the data info has been sent
1775#       to us by the render server. [We won't know the volume limits until the
1776#       server parses the 3D data and sends back the limits via ReceiveData.]
1777#
1778#       FIXME: The current way we generate transfer-function names completely
1779#              ignores the -markers option.  The problem is that we are forced
1780#              to compute the name from an increasing complex set of values:
1781#              color, levels, marker, opacity.  I think we're stuck doing it
1782#              now.
1783#
1784itcl::body Rappture::FlowvisViewer::NameTransferFunc { dataobj comp } {
1785    array set style {
1786        -color BCGYR
1787        -levels 6
1788        -opacity 1.0
1789        -light 40
1790        -transp 50
1791    }
1792    array set style [lindex [$dataobj components -style $comp] 0]
1793    set _settings($this-light) $style(-light)
1794    set _settings($this-transp) $style(-transp)
1795    set _settings($this-opacity) [expr $style(-opacity) * 100]
1796    set tf "$style(-color):$style(-levels):$style(-opacity)"
1797    set _obj2style($dataobj-$comp) $tf
1798    lappend _style2objs($tf) $dataobj $comp
1799    return $tf
1800}
1801
1802#
1803# ComputeTransferFunc --
1804#
1805#   Computes and sends the transfer function to the render server.  It's
1806#   assumed that the volume data limits are known and that the global
1807#   transfer-functions slider values have be setup.  Both parts are
1808#   needed to compute the relative value (location) of the marker, and
1809#   the alpha map of the transfer function.
1810#
1811itcl::body Rappture::FlowvisViewer::ComputeTransferFunc { tf } {
1812    array set style {
1813        -color BCGYR
1814        -levels 6
1815        -opacity 1.0
1816        -light 40
1817        -transp 50
1818    }
1819    set dataobj ""; set comp ""
1820    foreach {dataobj comp} $_style2objs($tf) break
1821    if { $dataobj == "" } {
1822        return 0
1823    }
1824    array set style [lindex [$dataobj components -style $comp] 0]
1825
1826
1827    # We have to parse the style attributes for a volume using this
1828    # transfer-function *once*.  This sets up the initial isomarkers for the
1829    # transfer function.  The user may add/delete markers, so we have to
1830    # maintain a list of markers for each transfer-function.  We use the one
1831    # of the volumes (the first in the list) using the transfer-function as a
1832    # reference.
1833    #
1834    # FIXME: The current way we generate transfer-function names completely
1835    #        ignores the -markers option.  The problem is that we are forced
1836    #        to compute the name from an increasing complex set of values:
1837    #        color, levels, marker, opacity.  I think the cow's out of the
1838    #        barn on this one.
1839
1840    if { ![info exists _isomarkers($tf)] } {
1841        # Have to defer creation of isomarkers until we have data limits
1842        if { [info exists style(-markers)] &&
1843             [llength $style(-markers)] > 0  } {
1844            ParseMarkersOption $tf $style(-markers)
1845        } else {
1846            ParseLevelsOption $tf $style(-levels)
1847        }
1848    }
1849    if { [info exists style(-nonuniformcolors)] } {
1850        foreach { value color } $style(-nonuniformcolors) {
1851            append cmap "$value [Color2RGB $color] "
1852        }
1853    } else {
1854        set cmap [ColorsToColormap $style(-color)]
1855    }
1856    set tag $this-$tf
1857    if { ![info exists _settings($tag-opacity)] } {
1858        set _settings($tag-opacity) $style(-opacity)
1859    }
1860    set max 1.0 ;#$_settings($tag-opacity)
1861   
1862    set isovalues {}
1863    foreach m $_isomarkers($tf) {
1864        lappend isovalues [$m relval]
1865    }
1866    # Sort the isovalues
1867    set isovalues [lsort -real $isovalues]
1868
1869    if { ![info exists _settings($tag-thickness)]} {
1870        set _settings($tag-thickness) 0.005
1871    }
1872    set delta $_settings($tag-thickness)
1873
1874    set first [lindex $isovalues 0]
1875    set last [lindex $isovalues end]
1876    set wmap ""
1877    if { $first == "" || $first != 0.0 } {
1878        lappend wmap 0.0 0.0
1879    }
1880    foreach x $isovalues {
1881        set x1 [expr {$x-$delta-0.00001}]
1882        set x2 [expr {$x-$delta}]
1883        set x3 [expr {$x+$delta}]
1884        set x4 [expr {$x+$delta+0.00001}]
1885        if { $x1 < 0.0 } {
1886            set x1 0.0
1887        } elseif { $x1 > 1.0 } {
1888            set x1 1.0
1889        }
1890        if { $x2 < 0.0 } {
1891            set x2 0.0
1892        } elseif { $x2 > 1.0 } {
1893            set x2 1.0
1894        }
1895        if { $x3 < 0.0 } {
1896            set x3 0.0
1897        } elseif { $x3 > 1.0 } {
1898            set x3 1.0
1899        }
1900        if { $x4 < 0.0 } {
1901            set x4 0.0
1902        } elseif { $x4 > 1.0 } {
1903            set x4 1.0
1904        }
1905        # add spikes in the middle
1906        lappend wmap $x1 0.0
1907        lappend wmap $x2 $max
1908        lappend wmap $x3 $max
1909        lappend wmap $x4 0.0
1910    }
1911    if { $last == "" || $last != 1.0 } {
1912        lappend wmap 1.0 0.0
1913    }
1914    SendCmd "transfunc define $tf { $cmap } { $wmap }"
1915    return [SendCmd "$dataobj-$comp configure -transferfunction $tf"]
1916}
1917
1918# ----------------------------------------------------------------------
1919# CONFIGURATION OPTION: -plotbackground
1920# ----------------------------------------------------------------------
1921itcl::configbody Rappture::FlowvisViewer::plotbackground {
1922    if { [isconnected] } {
1923        foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1924        #fix this!
1925        #SendCmd "color background $r $g $b"
1926    }
1927}
1928
1929# ----------------------------------------------------------------------
1930# CONFIGURATION OPTION: -plotforeground
1931# ----------------------------------------------------------------------
1932itcl::configbody Rappture::FlowvisViewer::plotforeground {
1933    if { [isconnected] } {
1934        foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1935        #fix this!
1936        #SendCmd "color background $r $g $b"
1937    }
1938}
1939
1940# ----------------------------------------------------------------------
1941# CONFIGURATION OPTION: -plotoutline
1942# ----------------------------------------------------------------------
1943itcl::configbody Rappture::FlowvisViewer::plotoutline {
1944    # Must check if we are connected because this routine is called from the
1945    # class body when the -plotoutline itk_option is defined.  At that point
1946    # the FlowvisViewer class constructor hasn't been called, so we can't
1947    # start sending commands to visualization server.
1948    if { [isconnected] } {
1949        if {"" == $itk_option(-plotoutline)} {
1950            SendCmd "volume outline state off"
1951        } else {
1952            SendCmd "volume outline state on"
1953            SendCmd "volume outline color [Color2RGB $itk_option(-plotoutline)]"
1954        }
1955    }
1956}
1957
1958#
1959# The -levels option takes a single value that represents the number
1960# of evenly distributed markers based on the current data range. Each
1961# marker is a relative value from 0.0 to 1.0.
1962#
1963itcl::body Rappture::FlowvisViewer::ParseLevelsOption { tf levels } {
1964    set c $itk_component(legend)
1965    regsub -all "," $levels " " levels
1966    if {[string is int $levels]} {
1967        for {set i 1} { $i <= $levels } {incr i} {
1968            set x [expr {double($i)/($levels+1)}]
1969            set m [Rappture::IsoMarker \#auto $c $this $tf]
1970            $m relval $x
1971            lappend _isomarkers($tf) $m
1972        }
1973    } else {
1974        foreach x $levels {
1975            set m [Rappture::IsoMarker \#auto $c $this $tf]
1976            $m relval $x
1977            lappend _isomarkers($tf) $m
1978        }
1979    }
1980}
1981
1982#
1983# The -markers option takes a list of zero or more values (the values
1984# may be separated either by spaces or commas) that have the following
1985# format:
1986#
1987#   N%  Percent of current total data range.  Converted to
1988#       to a relative value between 0.0 and 1.0.
1989#   N   Absolute value of marker.  If the marker is outside of
1990#       the current range, it will be displayed on the outer
1991#       edge of the legends, but it range it represents will
1992#       not be seen.
1993#
1994itcl::body Rappture::FlowvisViewer::ParseMarkersOption { tf markers } {
1995    set c $itk_component(legend)
1996    regsub -all "," $markers " " markers
1997    foreach marker $markers {
1998        set n [scan $marker "%g%s" value suffix]
1999        if { $n == 2 && $suffix == "%" } {
2000            # ${n}% : Set relative value.
2001            set value [expr {$value * 0.01}]
2002            set m [Rappture::IsoMarker \#auto $c $this $tf]
2003            $m relval $value
2004            lappend _isomarkers($tf) $m
2005        } else {
2006            # ${n} : Set absolute value.
2007            set m [Rappture::IsoMarker \#auto $c $this $tf]
2008            $m absval $value
2009            lappend _isomarkers($tf) $m
2010        }
2011    }
2012}
2013
2014# ----------------------------------------------------------------------
2015# USAGE: UndateTransferFuncs
2016# ----------------------------------------------------------------------
2017itcl::body Rappture::FlowvisViewer::updatetransferfuncs {} {
2018    $_dispatcher event -after 100 !send_transfunc
2019}
2020
2021itcl::body Rappture::FlowvisViewer::AddIsoMarker { x y } {
2022    if { $_activeTf == "" } {
2023        error "active transfer function isn't set"
2024    }
2025    set tf $_activeTf
2026    set c $itk_component(legend)
2027    set m [Rappture::IsoMarker \#auto $c $this $tf]
2028    set w [winfo width $c]
2029    $m relval [expr {double($x-10)/($w-20)}]
2030    lappend _isomarkers($tf) $m
2031    updatetransferfuncs
2032    return 1
2033}
2034
2035itcl::body Rappture::FlowvisViewer::rmdupmarker { marker x } {
2036    set tf [$marker transferfunc]
2037    set bool 0
2038    if { [info exists _isomarkers($tf)] } {
2039        set list {}
2040        set marker [namespace tail $marker]
2041        foreach m $_isomarkers($tf) {
2042            set sx [$m screenpos]
2043            if { $m != $marker } {
2044                if { $x >= ($sx-3) && $x <= ($sx+3) } {
2045                    $marker relval [$m relval]
2046                    itcl::delete object $m
2047                    bell
2048                    set bool 1
2049                    continue
2050                }
2051            }
2052            lappend list $m
2053        }
2054        set _isomarkers($tf) $list
2055        updatetransferfuncs
2056    }
2057    return $bool
2058}
2059
2060itcl::body Rappture::FlowvisViewer::overmarker { marker x } {
2061    set tf [$marker transferfunc]
2062    if { [info exists _isomarkers($tf)] } {
2063        set marker [namespace tail $marker]
2064        foreach m $_isomarkers($tf) {
2065            set sx [$m screenpos]
2066            if { $m != $marker } {
2067                set bool [expr { $x >= ($sx-3) && $x <= ($sx+3) }]
2068                $m activate $bool
2069            }
2070        }
2071    }
2072    return ""
2073}
2074
2075itcl::body Rappture::FlowvisViewer::limits { tf } {
2076    set _limits(vmin) 0.0
2077    set _limits(vmax) 1.0
2078    if { ![info exists _style2objs($tf)] } {
2079        puts stderr "no style2objs for $tf tf=($tf)"
2080        return [array get _limits]
2081    }
2082    set min ""; set max ""
2083    foreach {dataobj comp} $_style2objs($tf) {
2084        set tag $dataobj-$comp
2085        if { ![info exists _serverObjs($tag)] } {
2086            puts stderr "$tag not in serverObjs?"
2087            continue
2088        }
2089        if { ![info exists _limits($tag-min)] } {
2090            puts stderr "$tag no min?"
2091            continue
2092        }
2093        if { $min == "" || $min > $_limits($tag-min) } {
2094            set min $_limits($tag-min)
2095        }
2096        if { $max == "" || $max < $_limits($tag-max) } {
2097            set max $_limits($tag-max)
2098        }
2099    }
2100    if { $min != "" } {
2101        set _limits(vmin) $min
2102    }
2103    if { $max != "" } {
2104        set _limits(vmax) $max
2105    }
2106    return [array get _limits]
2107}
2108
2109itcl::body Rappture::FlowvisViewer::BuildViewTab {} {
2110    foreach { key value } {
2111        grid            0
2112        axes            0
2113        outline         1
2114        volume          1
2115        legend          1
2116        particles       1
2117        lic             1
2118    } {
2119        set _settings($this-$key) $value
2120    }
2121
2122    set fg [option get $itk_component(hull) font Font]
2123    #set bfg [option get $itk_component(hull) boldFont Font]
2124
2125    set inner [$itk_component(main) insert end \
2126        -title "View Settings" \
2127        -icon [Rappture::icon wrench]]
2128    $inner configure -borderwidth 4
2129
2130    set ::Rappture::FlowvisViewer::_settings($this-isosurface) 0
2131    checkbutton $inner.isosurface \
2132        -text "Isosurface shading" \
2133        -variable [itcl::scope _settings($this-isosurface)] \
2134        -command [itcl::code $this AdjustSetting isosurface] \
2135        -font "Arial 9"
2136
2137    checkbutton $inner.axes \
2138        -text "Axes" \
2139        -variable [itcl::scope _settings($this-axes)] \
2140        -command [itcl::code $this AdjustSetting axes] \
2141        -font "Arial 9"
2142
2143    checkbutton $inner.grid \
2144        -text "Grid" \
2145        -variable [itcl::scope _settings($this-grid)] \
2146        -command [itcl::code $this AdjustSetting grid] \
2147        -font "Arial 9"
2148
2149    checkbutton $inner.outline \
2150        -text "Outline" \
2151        -variable [itcl::scope _settings($this-outline)] \
2152        -command [itcl::code $this AdjustSetting outline] \
2153        -font "Arial 9"
2154
2155    checkbutton $inner.legend \
2156        -text "Legend" \
2157        -variable [itcl::scope _settings($this-legend)] \
2158        -command [itcl::code $this AdjustSetting legend] \
2159        -font "Arial 9"
2160
2161    checkbutton $inner.volume \
2162        -text "Volume" \
2163        -variable [itcl::scope _settings($this-volume)] \
2164        -command [itcl::code $this AdjustSetting volume] \
2165        -font "Arial 9"
2166
2167    checkbutton $inner.particles \
2168        -text "Particles" \
2169        -variable [itcl::scope _settings($this-particles)] \
2170        -command [itcl::code $this AdjustSetting particles] \
2171        -font "Arial 9"
2172
2173    checkbutton $inner.lic \
2174        -text "Lic" \
2175        -variable [itcl::scope _settings($this-lic)] \
2176        -command [itcl::code $this AdjustSetting lic] \
2177        -font "Arial 9"
2178
2179    frame $inner.frame
2180
2181    blt::table $inner \
2182        0,0 $inner.axes  -cspan 2 -anchor w \
2183        1,0 $inner.grid  -cspan 2 -anchor w \
2184        2,0 $inner.outline  -cspan 2 -anchor w \
2185        3,0 $inner.volume  -cspan 2 -anchor w \
2186        4,0 $inner.legend  -cspan 2 -anchor w
2187
2188    bind $inner <Map> [itcl::code $this GetFlowInfo $inner]
2189
2190    blt::table configure $inner r* -resize none
2191    blt::table configure $inner r5 -resize expand
2192}
2193
2194itcl::body Rappture::FlowvisViewer::BuildVolumeTab {} {
2195    foreach { key value } {
2196        light2side      0
2197        light           40
2198        transp          50
2199        opacity         100
2200        thickness       350
2201    } {
2202        set _settings($this-$key) $value
2203    }
2204
2205    set inner [$itk_component(main) insert end \
2206        -title "Volume Settings" \
2207        -icon [Rappture::icon volume-on]]
2208    $inner configure -borderwidth 4
2209
2210    set fg [option get $itk_component(hull) font Font]
2211    #set bfg [option get $itk_component(hull) boldFont Font]
2212
2213    checkbutton $inner.vol -text "Show volume" -font $fg \
2214        -text "Volume" \
2215        -variable [itcl::scope _settings($this-volume)] \
2216        -command [itcl::code $this AdjustSetting volume] \
2217        -font "Arial 9"
2218
2219    label $inner.shading -text "Shading:" -font $fg
2220
2221    checkbutton $inner.light2side -text "Two-sided lighting" -font $fg \
2222        -variable [itcl::scope _settings($this-light2side)] \
2223        -command [itcl::code $this AdjustSetting light2side]
2224
2225    label $inner.dim -text "Glow" -font $fg
2226    ::scale $inner.light -from 0 -to 100 -orient horizontal \
2227        -variable [itcl::scope _settings($this-light)] \
2228        -width 10 \
2229        -showvalue off -command [itcl::code $this AdjustSetting light]
2230    label $inner.bright -text "Surface" -font $fg
2231
2232    label $inner.fog -text "Clear" -font $fg
2233    ::scale $inner.transp -from 0 -to 100 -orient horizontal \
2234        -variable [itcl::scope _settings($this-transp)] \
2235        -width 10 \
2236        -showvalue off -command [itcl::code $this AdjustSetting transp]
2237    label $inner.plastic -text "Opaque" -font $fg
2238
2239    label $inner.clear -text "Clear" -font $fg
2240    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
2241        -variable [itcl::scope _settings($this-opacity)] \
2242        -width 10 \
2243        -showvalue off -command [itcl::code $this AdjustSetting opacity]
2244    label $inner.opaque -text "Opaque" -font $fg
2245
2246    label $inner.thin -text "Thin" -font $fg
2247    ::scale $inner.thickness -from 0 -to 1000 -orient horizontal \
2248        -variable [itcl::scope _settings($this-thickness)] \
2249        -width 10 \
2250        -showvalue off -command [itcl::code $this AdjustSetting thickness]
2251    label $inner.thick -text "Thick" -font $fg
2252
2253    label $inner.colormap_l -text "Colormap" -font "Arial 9"
2254    itk_component add colormap {
2255        Rappture::Combobox $inner.colormap -width 10 -editable no
2256    }
2257
2258    $inner.colormap choices insert end \
2259        "BCGYR"              "BCGYR"            \
2260        "BGYOR"              "BGYOR"            \
2261        "blue"               "blue"             \
2262        "blue-to-brown"      "blue-to-brown"    \
2263        "blue-to-orange"     "blue-to-orange"   \
2264        "blue-to-grey"       "blue-to-grey"     \
2265        "green-to-magenta"   "green-to-magenta" \
2266        "greyscale"          "greyscale"        \
2267        "nanohub"            "nanohub"          \
2268        "rainbow"            "rainbow"          \
2269        "spectral"           "spectral"         \
2270        "ROYGB"              "ROYGB"            \
2271        "RYGCB"              "RYGCB"            \
2272        "brown-to-blue"      "brown-to-blue"    \
2273        "grey-to-blue"       "grey-to-blue"     \
2274        "orange-to-blue"     "orange-to-blue"   \
2275        "none"               "none"
2276
2277    $itk_component(colormap) value "BCGYR"
2278    bind $inner.colormap <<Value>> \
2279        [itcl::code $this AdjustSetting colormap]
2280
2281    blt::table $inner \
2282        0,0 $inner.vol -cspan 4 -anchor w -pady 2 \
2283        1,0 $inner.shading -cspan 4 -anchor w -pady {10 2} \
2284        2,0 $inner.light2side -cspan 4 -anchor w -pady 2 \
2285        3,0 $inner.dim -anchor e -pady 2 \
2286        3,1 $inner.light -cspan 2 -pady 2 -fill x \
2287        3,3 $inner.bright -anchor w -pady 2 \
2288        4,0 $inner.fog -anchor e -pady 2 \
2289        4,1 $inner.transp -cspan 2 -pady 2 -fill x \
2290        4,3 $inner.plastic -anchor w -pady 2 \
2291        5,0 $inner.thin -anchor e -pady 2 \
2292        5,1 $inner.thickness -cspan 2 -pady 2 -fill x\
2293        5,3 $inner.thick -anchor w -pady 2
2294
2295    blt::table configure $inner c0 c1 c3 r* -resize none
2296    blt::table configure $inner r6 -resize expand
2297}
2298
2299itcl::body Rappture::FlowvisViewer::BuildCutplanesTab {} {
2300    set inner [$itk_component(main) insert end \
2301        -title "Cutplane Settings" \
2302        -icon [Rappture::icon cutbutton]]
2303    $inner configure -borderwidth 4
2304
2305    # X-value slicer...
2306    itk_component add xCutButton {
2307        Rappture::PushButton $inner.xbutton \
2308            -onimage [Rappture::icon x-cutplane] \
2309            -offimage [Rappture::icon x-cutplane] \
2310            -command [itcl::code $this AdjustSetting xcutplane] \
2311            -variable [itcl::scope _settings($this-xcutplane)]
2312    }
2313    Rappture::Tooltip::for $itk_component(xCutButton) \
2314        "Toggle the X cut plane on/off"
2315
2316    itk_component add xCutScale {
2317        ::scale $inner.xval -from 100 -to 0 \
2318            -width 10 -orient vertical -showvalue off \
2319            -borderwidth 1 -highlightthickness 0 \
2320            -command [itcl::code $this Slice move x] \
2321            -variable [itcl::scope _settings($this-xcutposition)]
2322    } {
2323        usual
2324        ignore -borderwidth -highlightthickness
2325    }
2326    # Set the default cutplane value before disabling the scale.
2327    $itk_component(xCutScale) set 50
2328    $itk_component(xCutScale) configure -state disabled
2329    Rappture::Tooltip::for $itk_component(xCutScale) \
2330        "@[itcl::code $this SlicerTip x]"
2331
2332    # Y-value slicer...
2333    itk_component add yCutButton {
2334        Rappture::PushButton $inner.ybutton \
2335            -onimage [Rappture::icon y-cutplane] \
2336            -offimage [Rappture::icon y-cutplane] \
2337            -command [itcl::code $this AdjustSetting ycutplane] \
2338            -variable [itcl::scope _settings($this-ycutplane)]
2339    }
2340    Rappture::Tooltip::for $itk_component(yCutButton) \
2341        "Toggle the Y cut plane on/off"
2342
2343    itk_component add yCutScale {
2344        ::scale $inner.yval -from 100 -to 0 \
2345            -width 10 -orient vertical -showvalue off \
2346            -borderwidth 1 -highlightthickness 0 \
2347            -command [itcl::code $this Slice move y] \
2348            -variable [itcl::scope _settings($this-ycutposition)]
2349    } {
2350        usual
2351        ignore -borderwidth -highlightthickness
2352    }
2353    Rappture::Tooltip::for $itk_component(yCutScale) \
2354        "@[itcl::code $this SlicerTip y]"
2355    # Set the default cutplane value before disabling the scale.
2356    $itk_component(yCutScale) set 50
2357    $itk_component(yCutScale) configure -state disabled
2358
2359    # Z-value slicer...
2360    itk_component add zCutButton {
2361        Rappture::PushButton $inner.zbutton \
2362            -onimage [Rappture::icon z-cutplane] \
2363            -offimage [Rappture::icon z-cutplane] \
2364            -command [itcl::code $this AdjustSetting zcutplane] \
2365            -variable [itcl::scope _settings($this-zcutplane)]
2366    }
2367    Rappture::Tooltip::for $itk_component(zCutButton) \
2368        "Toggle the Z cut plane on/off"
2369
2370    itk_component add zCutScale {
2371        ::scale $inner.zval -from 100 -to 0 \
2372            -width 10 -orient vertical -showvalue off \
2373            -borderwidth 1 -highlightthickness 0 \
2374            -command [itcl::code $this Slice move z] \
2375            -variable [itcl::scope _settings($this-zcutposition)]
2376    } {
2377        usual
2378        ignore -borderwidth -highlightthickness
2379    }
2380    $itk_component(zCutScale) set 50
2381    $itk_component(zCutScale) configure -state disabled
2382    #$itk_component(zCutScale) configure -state disabled
2383    Rappture::Tooltip::for $itk_component(zCutScale) \
2384        "@[itcl::code $this SlicerTip z]"
2385
2386    blt::table $inner \
2387        1,1 $itk_component(xCutButton) \
2388        1,2 $itk_component(yCutButton) \
2389        1,3 $itk_component(zCutButton) \
2390        0,1 $itk_component(xCutScale) \
2391        0,2 $itk_component(yCutScale) \
2392        0,3 $itk_component(zCutScale) \
2393
2394    blt::table configure $inner r0 r1 c* -resize none
2395    blt::table configure $inner r2 c4 -resize expand
2396    blt::table configure $inner c0 -width 2
2397    blt::table configure $inner c1 c2 c3 -padx 2
2398}
2399
2400itcl::body Rappture::FlowvisViewer::BuildCameraTab {} {
2401    set inner [$itk_component(main) insert end \
2402        -title "Camera Settings" \
2403        -icon [Rappture::icon camera]]
2404    $inner configure -borderwidth 4
2405
2406    label $inner.view_l -text "view" -font "Arial 9"
2407    set f [frame $inner.view]
2408    foreach side { front back left right top bottom } {
2409        button $f.$side  -image [Rappture::icon view$side] \
2410            -command [itcl::code $this SetOrientation $side]
2411        Rappture::Tooltip::for $f.$side "Change the view to $side"
2412        pack $f.$side -side left
2413    }
2414
2415    blt::table $inner \
2416        0,0 $inner.view_l -anchor e -pady 2 \
2417        0,1 $inner.view -anchor w -pady 2
2418
2419    set row 1
2420    set labels { qw qx qy qz xpan ypan zoom }
2421    foreach tag $labels {
2422        label $inner.${tag}label -text $tag -font "Arial 9"
2423        entry $inner.${tag} -font "Arial 9"  -bg white \
2424            -textvariable [itcl::scope _settings($this-$tag)]
2425        bind $inner.${tag} <KeyPress-Return> \
2426            [itcl::code $this camera set ${tag}]
2427        blt::table $inner \
2428            $row,0 $inner.${tag}label -anchor e -pady 2 \
2429            $row,1 $inner.${tag} -anchor w -pady 2
2430        blt::table configure $inner r$row -resize none
2431        incr row
2432    }
2433
2434    blt::table configure $inner c* r* -resize none
2435    blt::table configure $inner c2 -resize expand
2436    blt::table configure $inner r$row -resize expand
2437}
2438
2439itcl::body Rappture::FlowvisViewer::GetFlowInfo { w } {
2440    set flowobj ""
2441    foreach key [array names _obj2flow] {
2442        set flowobj $_obj2flow($key)
2443        break
2444    }
2445    if { $flowobj == "" } {
2446        return
2447    }
2448    if { [winfo exists $w.frame] } {
2449        destroy $w.frame
2450    }
2451    set inner [frame $w.frame]
2452    blt::table $w \
2453        5,0 $inner -fill both -cspan 2 -anchor nw
2454    array set hints [$flowobj hints]
2455    checkbutton $inner.showstreams -text "Streams Plane" \
2456        -variable [itcl::scope _settings($this-streams)] \
2457        -command  [itcl::code $this streams $key $hints(name)]  \
2458        -font "Arial 9"
2459    Rappture::Tooltip::for $inner.showstreams $hints(description)
2460
2461    checkbutton $inner.showarrows -text "Arrows" \
2462        -variable [itcl::scope _settings($this-arrows)] \
2463        -command  [itcl::code $this arrows $key $hints(name)]  \
2464        -font "Arial 9"
2465
2466    label $inner.particles -text "Particles"         -font "Arial 9 bold"
2467    label $inner.boxes -text "Boxes"         -font "Arial 9 bold"
2468
2469    blt::table $inner \
2470        1,0 $inner.showstreams  -anchor w \
2471        2,0 $inner.showarrows  -anchor w
2472    blt::table configure $inner c0 c1 -resize none
2473    blt::table configure $inner c2 -resize expand
2474
2475    set row 3
2476    set particles [$flowobj particles]
2477    if { [llength $particles] > 0 } {
2478        blt::table $inner $row,0 $inner.particles  -anchor w
2479        incr row
2480    }
2481    foreach part $particles {
2482        array unset info
2483        array set info $part
2484        set name $info(name)
2485        if { ![info exists _settings($this-particles-$name)] } {
2486            set _settings($this-particles-$name) $info(hide)
2487        }
2488        checkbutton $inner.part$row -text $info(label) \
2489            -variable [itcl::scope _settings($this-particles-$name)] \
2490            -onvalue 0 -offvalue 1 \
2491            -command [itcl::code $this particles $key $name] \
2492            -font "Arial 9"
2493        Rappture::Tooltip::for $inner.part$row $info(description)
2494        blt::table $inner $row,0 $inner.part$row -anchor w
2495        if { !$_settings($this-particles-$name) } {
2496            $inner.part$row select
2497        }
2498        incr row
2499    }
2500    set boxes [$flowobj boxes]
2501    if { [llength $boxes] > 0 } {
2502        blt::table $inner $row,0 $inner.boxes  -anchor w
2503        incr row
2504    }
2505    foreach box $boxes {
2506        array unset info
2507        array set info $box
2508        set name $info(name)
2509        if { ![info exists _settings($this-box-$name)] } {
2510            set _settings($this-box-$name) $info(hide)
2511        }
2512        checkbutton $inner.box$row -text $info(label) \
2513            -variable [itcl::scope _settings($this-box-$name)] \
2514            -onvalue 0 -offvalue 1 \
2515            -command [itcl::code $this box $key $name] \
2516            -font "Arial 9"
2517        Rappture::Tooltip::for $inner.box$row $info(description)
2518        blt::table $inner $row,0 $inner.box$row -anchor w
2519        if { !$_settings($this-box-$name) } {
2520            $inner.box$row select
2521        }
2522        incr row
2523    }
2524    blt::table configure $inner r* -resize none
2525    blt::table configure $inner r$row -resize expand
2526    blt::table configure $inner c3 -resize expand
2527    event generate [winfo parent [winfo parent $w]] <Configure>
2528}
2529
2530itcl::body Rappture::FlowvisViewer::particles { tag name } {
2531    set bool $_settings($this-particles-$name)
2532    SendCmd "$tag particles configure {$name} -hide $bool"
2533}
2534
2535itcl::body Rappture::FlowvisViewer::box { tag name } {
2536    set bool $_settings($this-box-$name)
2537    SendCmd "$tag box configure {$name} -hide $bool"
2538}
2539
2540itcl::body Rappture::FlowvisViewer::streams { tag name } {
2541    set bool $_settings($this-streams)
2542    SendCmd "$tag configure -slice $bool"
2543}
2544
2545itcl::body Rappture::FlowvisViewer::arrows { tag name } {
2546    set bool $_settings($this-arrows)
2547    SendCmd "$tag configure -arrows $bool"
2548}
2549
2550# ----------------------------------------------------------------------
2551# USAGE: Slice move x|y|z <newval>
2552#
2553# Called automatically when the user drags the slider to move the
2554# cut plane that slices 3D data.  Gets the current value from the
2555# slider and moves the cut plane to the appropriate point in the
2556# data set.
2557# ----------------------------------------------------------------------
2558itcl::body Rappture::FlowvisViewer::Slice {option args} {
2559    switch -- $option {
2560        move {
2561            if {[llength $args] != 2} {
2562                error "wrong # args: should be \"Slice move x|y|z newval\""
2563            }
2564            set axis [lindex $args 0]
2565            set newval [lindex $args 1]
2566            set newpos [expr {0.01*$newval}]
2567
2568            # show the current value in the readout
2569
2570            set ids [CurrentVolumeIds -cutplanes]
2571            SendCmd "cutplane position $newpos $axis $ids"
2572        }
2573        default {
2574            error "bad option \"$option\": should be axis, move, or volume"
2575        }
2576    }
2577}
2578
2579# ----------------------------------------------------------------------
2580# USAGE: SlicerTip <axis>
2581#
2582# Used internally to generate a tooltip for the x/y/z slicer controls.
2583# Returns a message that includes the current slicer value.
2584# ----------------------------------------------------------------------
2585itcl::body Rappture::FlowvisViewer::SlicerTip {axis} {
2586    set val [$itk_component(${axis}CutScale) get]
2587#    set val [expr {0.01*($val-50)
2588#        *($_limits(${axis}max)-$_limits(${axis}min))
2589#          + 0.5*($_limits(${axis}max)+$_limits(${axis}min))}]
2590    return "Move the [string toupper $axis] cut plane.\nCurrently:  $axis = $val%"
2591}
2592
2593itcl::body Rappture::FlowvisViewer::Resize {} {
2594    $_arcball resize $_width $_height
2595    SendCmd "screen size $_width $_height"
2596    set _resizePending 0
2597}
2598
2599itcl::body Rappture::FlowvisViewer::EventuallyResize { w h } {
2600    set _width $w
2601    set _height $h
2602    $_arcball resize $w $h
2603    if { !$_resizePending } {
2604        $_dispatcher event -after 200 !resize
2605        set _resizePending 1
2606    }
2607}
2608
2609itcl::body Rappture::FlowvisViewer::EventuallyResizeLegend {} {
2610    if { !$_resizeLegendPending } {
2611        $_dispatcher event -after 100 !legend
2612        set _resizeLegendPending 1
2613    }
2614}
2615
2616itcl::body Rappture::FlowvisViewer::EventuallyGoto { nSteps } {
2617    set _flow(goto) $nSteps
2618    if { !$_gotoPending } {
2619        $_dispatcher event -after 1000 !goto
2620        set _gotoPending 1
2621    }
2622}
2623
2624#  camera --
2625itcl::body Rappture::FlowvisViewer::camera {option args} {
2626    switch -- $option {
2627        "show" {
2628            puts [array get _view]
2629        }
2630        "set" {
2631            set who [lindex $args 0]
2632            set x $_settings($this-$who)
2633            set code [catch { string is double $x } result]
2634            if { $code != 0 || !$result } {
2635                set _settings($this-$who) $_view($who)
2636                return
2637            }
2638            switch -- $who {
2639                "xpan" - "ypan" {
2640                    set _view($who) $_settings($this-$who)
2641                    PanCamera
2642                }
2643                "qx" - "qy" - "qz" - "qw" {
2644                    set _view($who) $_settings($this-$who)
2645                    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
2646                    $_arcball quaternion $q
2647                    SendCmd "camera orient $q"
2648                }
2649                "zoom" {
2650                    set _view($who) $_settings($this-$who)
2651                    SendCmd "camera zoom $_view(zoom)"
2652                }
2653            }
2654        }
2655    }
2656}
2657
2658itcl::body Rappture::FlowvisViewer::FlowCmd { dataobj comp nbytes extents } {
2659    set tag "$dataobj-$comp"
2660    if { ![info exists _obj2flow($tag)] } {
2661        append cmd "flow add $tag\n"
2662        append cmd "$tag data follows $nbytes $extents\n"
2663        return $cmd
2664    }
2665    set flowobj $_obj2flow($tag)
2666    if { $flowobj == "" } {
2667        puts stderr "no flowobj"
2668        return ""
2669    }
2670    set cmd {}
2671    append cmd "if {\[flow exists $tag\]} {flow delete $tag}\n"
2672    array set info  [$flowobj hints]
2673    set _settings($this-volume) $info(volume)
2674    set _settings($this-outline) $info(outline)
2675    set _settings($this-arrows) $info(arrows)
2676    set _settings($this-duration) $info(duration)
2677    $itk_component(speed) value $info(speed)
2678    append cmd "flow add $tag"
2679    append cmd " -position $info(position)"
2680    append cmd " -axis $info(axis)"
2681    append cmd " -volume $info(volume)"
2682    append cmd " -outline $info(outline)"
2683    append cmd " -slice $info(streams)"
2684    append cmd " -arrows $info(arrows)\n"
2685    foreach part [$flowobj particles] {
2686        array unset info
2687        array set info $part
2688        set color [Color2RGB $info(color)]
2689        append cmd "$tag particles add $info(name)"
2690        append cmd " -position $info(position)"
2691        append cmd " -hide $info(hide)"
2692        append cmd " -axis $info(axis)"
2693        append cmd " -color {$color}"
2694        append cmd " -size $info(size)\n"
2695    }
2696    foreach box [$flowobj boxes] {
2697        array unset info
2698        set info(corner1) ""
2699        set info(corner2) ""
2700        array set info $box
2701        if { $info(corner1) == "" || $info(corner2) == "" } {
2702            continue
2703        }
2704        set color [Color2RGB $info(color)]
2705        append cmd "$tag box add $info(name)"
2706        append cmd " -color {$color}"
2707        append cmd " -hide $info(hide)"
2708        append cmd " -linewidth $info(linewidth) "
2709        append cmd " -corner1 {$info(corner1)} "
2710        append cmd " -corner2 {$info(corner2)}\n"
2711    }   
2712    append cmd "$tag data follows $nbytes $extents\n"
2713    return $cmd
2714}
2715
2716
2717#
2718# flow --
2719#
2720# Called when the user clicks on the stop or play buttons
2721# for flow visualization.
2722#
2723#        $this flow play
2724#        $this flow stop
2725#        $this flow toggle
2726#        $this flow reset
2727#        $this flow pause
2728#        $this flow next
2729#
2730itcl::body Rappture::FlowvisViewer::flow { args } {
2731    set option [lindex $args 0]
2732    switch -- $option {
2733        "goto2" {
2734            puts stderr "actually sending \"flow goto $_flow(goto)\""
2735            SendCmd "flow goto $_flow(goto)"
2736            set _gotoPending 0
2737        }
2738        "goto" {
2739            puts stderr "flow goto to $_settings($this-currenttime)"
2740            # Figure out how many steps to the current time based upon
2741            # the speed and duration.
2742            set current $_settings($this-currenttime)
2743            set speed [$itk_component(speed) value]
2744            set time [str2millisecs $_settings($this-duration)]
2745            $itk_component(dial) configure -max $time
2746            set delay [expr int(round(500.0/$speed))]
2747            set timePerStep [expr {double($time) / $delay}]
2748            set nSteps [expr {int(ceil($current/$timePerStep))}]
2749            EventuallyGoto $nSteps
2750        }
2751        "speed" {
2752            set speed [$itk_component(speed) value]
2753            set _flow(delay) [expr int(round(500.0/$speed))]
2754        }
2755        "duration" {
2756            set max [str2millisecs $_settings($this-duration)]
2757            if { $max < 0 } {
2758                bell
2759                return
2760            }
2761            set _flow(duration) $max
2762            set _settings($this-duration) [millisecs2str $max]
2763            $itk_component(dial) configure -max $max
2764        }
2765        "off" {
2766            set _flow(state) 0
2767            $_dispatcher cancel !play
2768            $itk_component(play) deselect
2769        }
2770        "on" {
2771            flow speed
2772            flow duration
2773            set _flow(state) 1
2774            set _settings($this-currenttime) 0
2775            $itk_component(play) select
2776        }
2777        "stop" {
2778            if { $_flow(state) } {
2779                flow off
2780                flow reset
2781            }
2782        }
2783        "pause" {
2784            if { $_flow(state) } {
2785                flow off
2786            }
2787        }
2788        "play" {
2789            # If the flow is currently off, then restart it.
2790            if { !$_flow(state) } {
2791                flow on
2792                # If we're at the end of the flow, reset the flow.
2793                set _settings($this-currenttime) \
2794                    [expr {$_settings($this-currenttime) + $_flow(delay)}]
2795                if { $_settings($this-currenttime) >= $_flow(duration) } {
2796                    set _settings($this-step) 1
2797                    SendCmd "flow reset"
2798                }
2799                flow next
2800            }
2801        }
2802        "toggle" {
2803            if { $_settings($this-play) } {
2804                flow play
2805            } else {
2806                flow pause
2807            }
2808        }
2809        "reset" {
2810            set _settings($this-currenttime) 0
2811            SendCmd "flow reset"
2812            if { !$_flow(state) } {
2813                SendCmd "flow next"
2814            }
2815        }
2816        "next" {
2817            if { ![winfo viewable $itk_component(3dview)] } {
2818                flow stop
2819                return
2820            }
2821            set _settings($this-currenttime) \
2822                [expr {$_settings($this-currenttime) + $_flow(delay)}]
2823            if { $_settings($this-currenttime) >= $_flow(duration) } {
2824                if { !$_settings($this-loop) } {
2825                    flow off
2826                    return
2827                }
2828                flow reset
2829            } else {
2830                SendCmd "flow next"
2831            }
2832            $_dispatcher event -after $_flow(delay) !play
2833        }
2834        default {
2835            error "bad option \"$option\": should be play, stop, toggle, or reset."
2836        }
2837    }
2838}
2839
2840itcl::body Rappture::FlowvisViewer::WaitIcon  { option widget } {
2841    switch -- $option {
2842        "start" {
2843            $_dispatcher dispatch $this !waiticon \
2844                "[itcl::code $this WaitIcon "next" $widget] ; list"
2845            set _icon 0
2846            $widget configure -image [Rappture::icon bigroller${_icon}]
2847            $_dispatcher event -after 100 !waiticon
2848        }
2849        "next" {
2850            incr _icon
2851            if { $_icon >= 8 } {
2852                set _icon 0
2853            }
2854            $widget configure -image [Rappture::icon bigroller${_icon}]
2855            $_dispatcher event -after 100 !waiticon
2856        }
2857        "stop" {
2858            $_dispatcher cancel !waiticon
2859        }
2860    }
2861}
2862
2863itcl::body Rappture::FlowvisViewer::GetPngImage  { widget width height } {
2864    set token "print[incr _nextToken]"
2865    set var ::Rappture::FlowvisViewer::_hardcopy($this-$token)
2866    set $var ""
2867
2868    # Setup an automatic timeout procedure.
2869    $_dispatcher dispatch $this !pngtimeout "set $var {} ; list"
2870
2871    set popup .flowvisviewerprint
2872    if {![winfo exists $popup]} {
2873        Rappture::Balloon $popup -title "Generating file..."
2874        set inner [$popup component inner]
2875        label $inner.title -text "Generating hardcopy." -font "Arial 10 bold"
2876        label $inner.please -text "This may take a minute." -font "Arial 10"
2877        label $inner.icon -image [Rappture::icon bigroller0]
2878        button $inner.cancel -text "Cancel" -font "Arial 10 bold" \
2879            -command [list set $var ""]
2880        blt::table $inner \
2881            0,0 $inner.title -cspan 2 \
2882            1,0 $inner.please -anchor w \
2883            1,1 $inner.icon -anchor e  \
2884            2,0 $inner.cancel -cspan 2
2885        blt::table configure $inner r0 -pady 4
2886        blt::table configure $inner r2 -pady 4
2887        bind $inner.cancel <KeyPress-Return> [list $inner.cancel invoke]
2888    } else {
2889        set inner [$popup component inner]
2890    }
2891
2892    $_dispatcher event -after 60000 !pngtimeout
2893    WaitIcon start $inner.icon
2894    grab set $inner
2895    focus $inner.cancel
2896
2897    SendCmd "print $token $width $height"
2898
2899    $popup activate $widget below
2900    update idletasks
2901    update
2902    # We wait here for either
2903    #  1) the png to be delivered or
2904    #  2) timeout or 
2905    #  3) user cancels the operation.
2906    tkwait variable $var
2907
2908    # Clean up.
2909    $_dispatcher cancel !pngtimeout
2910    WaitIcon stop $inner.icon
2911    grab release $inner
2912    $popup deactivate
2913    update
2914
2915    if { $_hardcopy($this-$token) != "" } {
2916        return [list .png $_hardcopy($this-$token)]
2917    }
2918    return ""
2919}
2920
2921itcl::body Rappture::FlowvisViewer::GetMovie { widget w h } {
2922    set token "movie[incr _nextToken]"
2923    set var ::Rappture::FlowvisViewer::_hardcopy($this-$token)
2924    set $var ""
2925
2926    # Setup an automatic timeout procedure.
2927    $_dispatcher dispatch $this !movietimeout "set $var {} ; list"
2928    set popup .flowvisviewermovie
2929    if {![winfo exists $popup]} {
2930        Rappture::Balloon $popup -title "Generating movie..."
2931        set inner [$popup component inner]
2932        label $inner.title -text "Generating movie for download" \
2933                -font "Arial 10 bold"
2934        label $inner.please -text "This may take a few minutes." \
2935                -font "Arial 10"
2936        label $inner.icon -image [Rappture::icon bigroller0]
2937        button $inner.cancel -text "Cancel" -font "Arial 10 bold" \
2938            -command [list set $var ""]
2939        blt::table $inner \
2940            0,0 $inner.title -cspan 2 \
2941            1,0 $inner.please -anchor w \
2942            1,1 $inner.icon -anchor e  \
2943            2,0 $inner.cancel -cspan 2
2944        blt::table configure $inner r0 -pady 4
2945        blt::table configure $inner r2 -pady 4
2946        bind $inner.cancel <KeyPress-Return> [list $inner.cancel invoke]
2947    } else {
2948        set inner [$popup component inner]
2949    }
2950    update
2951    # Timeout is set to 10 minutes.
2952    $_dispatcher event -after 600000 !movietimeout
2953    WaitIcon start $inner.icon
2954    grab set $inner
2955    focus $inner.cancel
2956   
2957    flow duration
2958    flow speed
2959    set nframes [expr round($_flow(duration) / $_flow(delay))]
2960    set framerate [expr 1000.0 / $_flow(delay)]
2961
2962    # These are specific to MPEG1 video generation
2963    set framerate 25.0
2964    set bitrate 6.0e+6
2965
2966    set start [clock seconds]
2967    SendCmd "flow video $token -width $w -height $h -numframes $nframes "
2968   
2969    $popup activate $widget below
2970    update idletasks
2971    update
2972    # We wait here until
2973    #  1. the movie is delivered or
2974    #  2. we've timed out or 
2975    #  3. the user has canceled the operation.b
2976    tkwait variable $var
2977
2978    puts stderr "Video generated in [expr [clock seconds] - $start] seconds."
2979
2980    # Clean up.
2981    $_dispatcher cancel !movietimeout
2982    WaitIcon stop $inner.icon
2983    grab release $inner
2984    $popup deactivate
2985    destroy $popup
2986    update
2987
2988    # This will both cancel the movie generation (if it hasn't already
2989    # completed) and reset the flow.
2990    SendCmd "flow reset"
2991    if { $_hardcopy($this-$token) != "" } {
2992        return [list .mpg $_hardcopy($this-$token)]
2993    }
2994    return ""
2995}
2996
2997itcl::body Rappture::FlowvisViewer::str2millisecs { value } {
2998    set parts [split $value :]
2999    set secs 0
3000    set mins 0
3001    if { [llength $parts] == 1 } {
3002        scan [lindex $parts 0] "%d" secs
3003    } else {
3004        scan [lindex $parts 1] "%d" secs
3005        scan [lindex $parts 0] "%d" mins
3006    }
3007    set ms [expr {(($mins * 60) + $secs) * 1000.0}]
3008    if { $ms > 600000.0 } {
3009        set ms 600000.0
3010    }
3011    if { $ms == 0.0 } {
3012        set ms 60000.0
3013    }
3014    return $ms
3015}
3016
3017itcl::body Rappture::FlowvisViewer::millisecs2str { value } {
3018    set min [expr floor($value / 60000.0)]
3019    set sec [expr ($value - ($min*60000.0)) / 1000.0]
3020    return [format %02d:%02d [expr round($min)] [expr round($sec)]]
3021}
3022
3023itcl::body Rappture::FlowvisViewer::SetOrientation { side } {
3024    array set positions {
3025        front "1 0 0 0"
3026        back  "0 0 1 0"
3027        left  "0.707107 0 -0.707107 0"
3028        right "0.707107 0 0.707107 0"
3029        top   "0.707107 -0.707107 0 0"
3030        bottom "0.707107 0.707107 0 0"
3031    }
3032    foreach name { qw qx qy qz } value $positions($side) {
3033        set _view($name) $value
3034    }
3035    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
3036    $_arcball quaternion $q
3037    SendCmd "camera orient $q"
3038    SendCmd "camera reset"
3039    set _view(xpan) 0.0
3040    set _view(ypan) 0.0
3041    set _view(zoom) 1.0
3042    set _settings($this-xpan) $_view(xpan)
3043    set _settings($this-ypan) $_view(ypan)
3044    set _settings($this-zoom) $_view(zoom)
3045}
Note: See TracBrowser for help on using the repository browser.