source: branches/1.3/gui/scripts/flowvisviewer.tcl @ 5272

Last change on this file since 5272 was 5272, checked in by ldelgass, 5 years ago

merge r5270 from trunk

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