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

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

Add cutplane visibility button to nanovis viewers.

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