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

Last change on this file since 5377 was 5377, checked in by ldelgass, 10 years ago

More refactoring to sync flowvis and nanovis viewers

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