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

Last change on this file since 6260 was 6260, checked in by ldelgass, 8 years ago

code style fix

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