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

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

Merge r5205,r5210:5211

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