source: trunk/gui/scripts/flowvisviewer.tcl @ 2671

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