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

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

sync with release branch changes

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