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

Last change on this file since 3396 was 3396, checked in by ldelgass, 11 years ago

Bring flowvisviewer more in line with nanovisviewer fixes

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