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

Last change on this file since 3421 was 3421, checked in by gah, 12 years ago

push SendCmd? into base class w/ buffering

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