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

Last change on this file since 5246 was 5246, checked in by ldelgass, 9 years ago

typo in comment

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