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

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

merge (by hand) with Rappture1.2 branch

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