source: branches/1.3/gui/scripts/nanovisviewer.tcl @ 5267

Last change on this file since 5267 was 5267, checked in by ldelgass, 5 years ago

remove unused var

File size: 74.5 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: nanovisviewer - 3D volume rendering
4#
5#  This widget performs volume rendering on 3D scalar/vector datasets.
6#  It connects to the Nanovis server running on a rendering farm,
7#  transmits data, and displays the results.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15package require Itk
16package require BLT
17package require Img
18
19#
20# FIXME:
21#       Need to Add DX readers this client to examine the data before
22#       it's sent to the server.  This will eliminate 90% of the insanity in
23#       computing the limits of all the volumes.  I can rip out all the
24#       "receive data" "send transfer function" event crap.
25#
26#       This means we can compute the transfer function (relative values) and
27#       draw the legend min/max values without waiting for the information to
28#       come from the server.  This will also prevent the flashing that occurs
29#       when a new volume is drawn (using the default transfer function) and
30#       then when the correct transfer function has been sent and linked to
31#       the volume.
32#
33option add *NanovisViewer.width 4i widgetDefault
34option add *NanovisViewer*cursor crosshair widgetDefault
35option add *NanovisViewer.height 4i widgetDefault
36option add *NanovisViewer.foreground black widgetDefault
37option add *NanovisViewer.controlBackground gray widgetDefault
38option add *NanovisViewer.controlDarkBackground #999999 widgetDefault
39option add *NanovisViewer.plotBackground black widgetDefault
40option add *NanovisViewer.plotForeground white widgetDefault
41option add *NanovisViewer.plotOutline gray widgetDefault
42option add *NanovisViewer.font \
43    -*-helvetica-medium-r-normal-*-12-* widgetDefault
44
45# must use this name -- plugs into Rappture::resources::load
46proc NanovisViewer_init_resources {} {
47    Rappture::resources::register \
48        nanovis_server Rappture::NanovisViewer::SetServerList
49}
50
51itcl::class Rappture::NanovisViewer {
52    inherit Rappture::VisViewer
53
54    itk_option define -plotforeground plotForeground Foreground ""
55    itk_option define -plotbackground plotBackground Background ""
56    itk_option define -plotoutline plotOutline PlotOutline ""
57
58    constructor { hostlist args } {
59        Rappture::VisViewer::constructor $hostlist
60    } {
61        # defined below
62    }
63    destructor {
64        # defined below
65    }
66    public proc SetServerList { namelist } {
67        Rappture::VisViewer::SetServerList "nanovis" $namelist
68    }
69    public method add {dataobj {settings ""}}
70    public method camera {option args}
71    public method delete {args}
72    public method disconnect {}
73    public method download {option args}
74    public method get {args}
75    public method isconnected {}
76    public method limits { tf }
77    public method overMarker { m x }
78    public method parameters {title args} {
79        # do nothing
80    }
81    public method removeDuplicateMarker { m x }
82    public method scale {args}
83    public method updateTransferFunctions {}
84
85    # The following methods are only used by this class.
86    private method AddIsoMarker { x y }
87    private method AdjustSetting {what {value ""}}
88    private method BuildCameraTab {}
89    private method BuildCutplanesTab {}
90    private method BuildViewTab {}
91    private method BuildVolumeTab {}
92    private method ComputeTransferFunction { tf }
93    private method Connect {}
94    private method CurrentDatasets {{what -all}}
95    private method Disconnect {}
96    private method DoResize {}
97    private method EventuallyResize { w h }
98    private method EventuallyResizeLegend { }
99    private method FixLegend {}
100    private method GetVolumeInfo { w }
101    private method InitSettings { args }
102    private method NameTransferFunction { dataobj comp }
103    private method Pan {option x y}
104    private method PanCamera {}
105    private method ParseLevelsOption { tf levels }
106    private method ParseMarkersOption { tf markers }
107    private method QuaternionToView { q } {
108        foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break
109    }
110    private method Rebuild {}
111    private method ReceiveData { args }
112    private method ReceiveImage { args }
113    private method ReceiveLegend { tf vmin vmax size }
114    private method ResetColormap { color }
115    private method Rotate {option x y}
116    private method SendTransferFunctions {}
117    private method SetOrientation { side }
118    private method Slice {option args}
119    private method SlicerTip {axis}
120    private method ToggleVolume { tag name }
121    private method ViewToQuaternion {} {
122        return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)]
123    }
124    private method Zoom {option}
125
126    private variable _arcball ""
127
128    private variable _dlist ""         ;# list of data objects
129    private variable _obj2ovride       ;# maps dataobj => style override
130    private variable _serverDatasets   ;# contains all the dataobj-component
131                                       ;# to volumes in the server
132    private variable _serverTfs        ;# contains all the transfer functions
133                                       ;# in the server.
134    private variable _recvdDatasets    ;# list of data objs to send to server
135    private variable _dataset2style    ;# maps dataobj-component to transfunc
136    private variable _style2datasets   ;# maps tf back to list of
137                                        # dataobj-components using the tf.
138
139    private variable _reset 1          ;# Connection to server has been reset.
140    private variable _click            ;# Info used for rotate operations.
141    private variable _limits           ;# Autoscale min/max for all axes
142    private variable _view             ;# View params for 3D view
143    private variable _isomarkers       ;# array of isosurface level values 0..1
144    private variable  _settings
145    # Array of transfer functions in server.  If 0 the transfer has been
146    # defined but not loaded.  If 1 the transfer function has been named
147    # and loaded.
148    private variable _activeTfs
149    private variable _first ""         ;# This is the topmost volume.
150
151    common _downloadPopup              ;# download options from popup
152    private common _hardcopy
153    private variable _width 0
154    private variable _height 0
155    private variable _resizePending 0
156    private variable _resizeLegendPending 0
157}
158
159itk::usual NanovisViewer {
160    keep -background -foreground -cursor -font
161    keep -plotbackground -plotforeground
162}
163
164# ----------------------------------------------------------------------
165# CONSTRUCTOR
166# ----------------------------------------------------------------------
167itcl::body Rappture::NanovisViewer::constructor {hostlist args} {
168    set _serverType "nanovis"
169
170    # Draw legend event
171    $_dispatcher register !legend
172    $_dispatcher dispatch $this !legend "[itcl::code $this FixLegend]; list"
173
174    # Send transfer functions event
175    $_dispatcher register !send_transfunc
176    $_dispatcher dispatch $this !send_transfunc \
177        "[itcl::code $this SendTransferFunctions]; list"
178
179    # Rebuild event
180    $_dispatcher register !rebuild
181    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
182
183    # Resize event
184    $_dispatcher register !resize
185    $_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
186
187    #
188    # Populate parser with commands handle incoming requests
189    #
190    $_parser alias image [itcl::code $this ReceiveImage]
191    $_parser alias legend [itcl::code $this ReceiveLegend]
192    $_parser alias data [itcl::code $this ReceiveData]
193
194    # Initialize the view to some default parameters.
195    array set _view {
196        -qw      0.853553
197        -qx      -0.353553
198        -qy      0.353553
199        -qz      0.146447
200        -xpan    0
201        -ypan    0
202        -zoom    1.0
203    }
204    set _arcball [blt::arcball create 100 100]
205    $_arcball quaternion [ViewToQuaternion]
206
207    set _limits(vmin) 0.0
208    set _limits(vmax) 1.0
209    set _reset 1
210
211    array set _settings [subst {
212        $this-qw                $_view(-qw)
213        $this-qx                $_view(-qx)
214        $this-qy                $_view(-qy)
215        $this-qz                $_view(-qz)
216        $this-zoom              $_view(-zoom)
217        $this-xpan              $_view(-xpan)
218        $this-ypan              $_view(-ypan)
219        $this-volume            1
220        $this-xcutplane         0
221        $this-xcutposition      0
222        $this-ycutplane         0
223        $this-ycutposition      0
224        $this-zcutplane         0
225        $this-zcutposition      0
226    }]
227
228    itk_component add 3dview {
229        label $itk_component(plotarea).view -image $_image(plot) \
230            -highlightthickness 0 -borderwidth 0
231    } {
232        usual
233        ignore -highlightthickness -borderwidth  -background
234    }
235    bind $itk_component(3dview) <Control-F1> [itcl::code $this ToggleConsole]
236
237    set f [$itk_component(main) component controls]
238    itk_component add reset {
239        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
240            -highlightthickness 0 \
241            -image [Rappture::icon reset-view] \
242            -command [itcl::code $this Zoom reset]
243    } {
244        usual
245        ignore -highlightthickness
246    }
247    pack $itk_component(reset) -side top -padx 2 -pady 2
248    Rappture::Tooltip::for $itk_component(reset) \
249        "Reset the view to the default zoom level"
250
251    itk_component add zoomin {
252        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
253            -highlightthickness 0 \
254            -image [Rappture::icon zoom-in] \
255            -command [itcl::code $this Zoom in]
256    } {
257        usual
258        ignore -highlightthickness
259    }
260    pack $itk_component(zoomin) -side top -padx 2 -pady 2
261    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
262
263    itk_component add zoomout {
264        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
265            -highlightthickness 0 \
266            -image [Rappture::icon zoom-out] \
267            -command [itcl::code $this Zoom out]
268    } {
269        usual
270        ignore -highlightthickness
271    }
272    pack $itk_component(zoomout) -side top -padx 2 -pady 2
273    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
274
275    itk_component add volume {
276        Rappture::PushButton $f.volume \
277            -onimage [Rappture::icon volume-on] \
278            -offimage [Rappture::icon volume-off] \
279            -command [itcl::code $this AdjustSetting volume] \
280            -variable [itcl::scope _settings($this-volume)]
281    }
282    $itk_component(volume) select
283    Rappture::Tooltip::for $itk_component(volume) \
284        "Toggle the volume cloud on/off"
285    pack $itk_component(volume) -padx 2 -pady 2
286
287    if { [catch {
288        BuildViewTab
289        BuildVolumeTab
290        BuildCutplanesTab
291        BuildCameraTab
292    } errs] != 0 } {
293        global errorInfo
294        puts stderr "errs=$errs errorInfo=$errorInfo"
295    }
296
297    # Legend
298    set _image(legend) [image create photo]
299    itk_component add legend {
300        canvas $itk_component(plotarea).legend -height 50 -highlightthickness 0
301    } {
302        usual
303        ignore -highlightthickness
304        rename -background -plotbackground plotBackground Background
305    }
306    bind $itk_component(legend) <Configure> \
307        [itcl::code $this EventuallyResizeLegend]
308
309    # Hack around the Tk panewindow.  The problem is that the requested
310    # size of the 3d view isn't set until an image is retrieved from
311    # the server.  So the panewindow uses the tiny size.
312    set w 10000
313    pack forget $itk_component(3dview)
314    blt::table $itk_component(plotarea) \
315        0,0 $itk_component(3dview) -fill both -reqwidth $w \
316        1,0 $itk_component(legend) -fill x
317    blt::table configure $itk_component(plotarea) r1 -resize none
318
319    # Bindings for rotation via mouse
320    bind $itk_component(3dview) <ButtonPress-1> \
321        [itcl::code $this Rotate click %x %y]
322    bind $itk_component(3dview) <B1-Motion> \
323        [itcl::code $this Rotate drag %x %y]
324    bind $itk_component(3dview) <ButtonRelease-1> \
325        [itcl::code $this Rotate release %x %y]
326    bind $itk_component(3dview) <Configure> \
327        [itcl::code $this EventuallyResize %w %h]
328
329    # Bindings for panning via mouse
330    bind $itk_component(3dview) <ButtonPress-2> \
331        [itcl::code $this Pan click %x %y]
332    bind $itk_component(3dview) <B2-Motion> \
333        [itcl::code $this Pan drag %x %y]
334    bind $itk_component(3dview) <ButtonRelease-2> \
335        [itcl::code $this Pan release %x %y]
336
337    # Bindings for panning via keyboard
338    bind $itk_component(3dview) <KeyPress-Left> \
339        [itcl::code $this Pan set -10 0]
340    bind $itk_component(3dview) <KeyPress-Right> \
341        [itcl::code $this Pan set 10 0]
342    bind $itk_component(3dview) <KeyPress-Up> \
343        [itcl::code $this Pan set 0 -10]
344    bind $itk_component(3dview) <KeyPress-Down> \
345        [itcl::code $this Pan set 0 10]
346    bind $itk_component(3dview) <Shift-KeyPress-Left> \
347        [itcl::code $this Pan set -2 0]
348    bind $itk_component(3dview) <Shift-KeyPress-Right> \
349        [itcl::code $this Pan set 2 0]
350    bind $itk_component(3dview) <Shift-KeyPress-Up> \
351        [itcl::code $this Pan set 0 -2]
352    bind $itk_component(3dview) <Shift-KeyPress-Down> \
353        [itcl::code $this Pan set 0 2]
354
355    # Bindings for zoom via keyboard
356    bind $itk_component(3dview) <KeyPress-Prior> \
357        [itcl::code $this Zoom out]
358    bind $itk_component(3dview) <KeyPress-Next> \
359        [itcl::code $this Zoom in]
360
361    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
362
363    if {[string equal "x11" [tk windowingsystem]]} {
364        # Bindings for zoom via mouse
365        bind $itk_component(3dview) <4> [itcl::code $this Zoom out]
366        bind $itk_component(3dview) <5> [itcl::code $this Zoom in]
367    }
368
369    set _image(download) [image create photo]
370
371    eval itk_initialize $args
372
373    EnableWaitDialog 900
374    Connect
375}
376
377# ----------------------------------------------------------------------
378# DESTRUCTOR
379# ----------------------------------------------------------------------
380itcl::body Rappture::NanovisViewer::destructor {} {
381    $_dispatcher cancel !rebuild
382    $_dispatcher cancel !send_transfunc
383    $_dispatcher cancel !resize
384    image delete $_image(plot)
385    image delete $_image(legend)
386    image delete $_image(download)
387    catch { blt::arcball destroy $_arcball }
388    array unset _settings $this-*
389}
390
391# ----------------------------------------------------------------------
392# USAGE: add <dataobj> ?<settings>?
393#
394# Clients use this to add a data object to the plot.  The optional
395# <settings> are used to configure the plot.  Allowed settings are
396# -color, -brightness, -width, -linestyle, and -raise.
397# ----------------------------------------------------------------------
398itcl::body Rappture::NanovisViewer::add {dataobj {settings ""}} {
399    if { ![$dataobj isvalid] } {
400        return;                         # Object doesn't contain valid data.
401    }
402    array set params {
403        -color auto
404        -width 1
405        -linestyle solid
406        -brightness 0
407        -raise 0
408        -description ""
409        -param ""
410    }
411    array set params $settings
412
413    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
414        # can't handle -autocolors yet
415        set params(-color) black
416    }
417    set pos [lsearch -exact $_dlist $dataobj]
418    if {$pos < 0} {
419        lappend _dlist $dataobj
420        set _obj2ovride($dataobj-color) $params(-color)
421        set _obj2ovride($dataobj-width) $params(-width)
422        set _obj2ovride($dataobj-raise) $params(-raise)
423        $_dispatcher event -idle !rebuild
424    }
425}
426
427# ----------------------------------------------------------------------
428# USAGE: get ?-objects?
429# USAGE: get ?-image 3dview|legend?
430#
431# Clients use this to query the list of objects being plotted, in
432# order from bottom to top of this result.  The optional "-image"
433# flag can also request the internal images being shown.
434# ----------------------------------------------------------------------
435itcl::body Rappture::NanovisViewer::get {args} {
436    if {[llength $args] == 0} {
437        set args "-objects"
438    }
439
440    set op [lindex $args 0]
441    switch -- $op {
442        -objects {
443            # put the dataobj list in order according to -raise options
444            set dlist $_dlist
445            foreach obj $dlist {
446                if {[info exists _obj2ovride($obj-raise)] &&
447                    $_obj2ovride($obj-raise)} {
448                    set i [lsearch -exact $dlist $obj]
449                    if {$i >= 0} {
450                        set dlist [lreplace $dlist $i $i]
451                        lappend dlist $obj
452                    }
453                }
454            }
455            return $dlist
456        }
457        -image {
458            if {[llength $args] != 2} {
459                error "wrong # args: should be \"get -image 3dview|legend\""
460            }
461            switch -- [lindex $args end] {
462                3dview {
463                    return $_image(plot)
464                }
465                legend {
466                    return $_image(legend)
467                }
468                default {
469                    error "bad image name \"[lindex $args end]\": should be 3dview or legend"
470                }
471            }
472        }
473        default {
474            error "bad option \"$op\": should be -objects or -image"
475        }
476    }
477}
478
479# ----------------------------------------------------------------------
480# USAGE: delete ?<dataobj1> <dataobj2> ...?
481#
482#       Clients use this to delete a dataobj from the plot.  If no dataobjs
483#       are specified, then all dataobjs are deleted.  No data objects are
484#       deleted.  They are only removed from the display list.
485#
486# ----------------------------------------------------------------------
487itcl::body Rappture::NanovisViewer::delete {args} {
488    if {[llength $args] == 0} {
489        set args $_dlist
490    }
491    # Delete all specified dataobjs
492    set changed 0
493    foreach dataobj $args {
494        set pos [lsearch -exact $_dlist $dataobj]
495        if { $pos >= 0 } {
496            set _dlist [lreplace $_dlist $pos $pos]
497            array unset _limits $dataobj*
498            array unset _obj2ovride $dataobj-*
499            set changed 1
500        }
501    }
502    # If anything changed, then rebuild the plot
503    if {$changed} {
504        $_dispatcher event -idle !rebuild
505    }
506}
507
508# ----------------------------------------------------------------------
509# USAGE: scale ?<data1> <data2> ...?
510#
511# Sets the default limits for the overall plot according to the
512# limits of the data for all of the given <data> objects.  This
513# accounts for all objects--even those not showing on the screen.
514# Because of this, the limits are appropriate for all objects as
515# the user scans through data in the ResultSet viewer.
516# ----------------------------------------------------------------------
517itcl::body Rappture::NanovisViewer::scale {args} {
518    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
519        set _limits($val) ""
520    }
521    foreach dataobj $args {
522        if { ![$dataobj isvalid] } {
523            continue;                     # Object doesn't contain valid data.
524        }
525        foreach axis {x y z v} {
526            foreach { min max } [$dataobj limits $axis] break
527            if {"" != $min && "" != $max} {
528                if {"" == $_limits(${axis}min)} {
529                    set _limits(${axis}min) $min
530                    set _limits(${axis}max) $max
531                } else {
532                    if {$min < $_limits(${axis}min)} {
533                        set _limits(${axis}min) $min
534                    }
535                    if {$max > $_limits(${axis}max)} {
536                        set _limits(${axis}max) $max
537                    }
538                }
539            }
540        }
541    }
542}
543
544# ----------------------------------------------------------------------
545# USAGE: download coming
546# USAGE: download controls <downloadCommand>
547# USAGE: download now
548#
549# Clients use this method to create a downloadable representation
550# of the plot.  Returns a list of the form {ext string}, where
551# "ext" is the file extension (indicating the type of data) and
552# "string" is the data itself.
553# ----------------------------------------------------------------------
554itcl::body Rappture::NanovisViewer::download {option args} {
555    switch $option {
556        coming {
557            if {[catch {
558                blt::winop snap $itk_component(plotarea) $_image(download)
559            }]} {
560                $_image(download) configure -width 1 -height 1
561                $_image(download) put #000000
562            }
563        }
564        controls {
565            # no controls for this download yet
566            return ""
567        }
568        now {
569            # Get the image data (as base64) and decode it back to binary.
570            # This is better than writing to temporary files.  When we switch
571            # to the BLT picture image it won't be necessary to decode the
572            # image data.
573            if { [image width $_image(plot)] > 0 &&
574                 [image height $_image(plot)] > 0 } {
575                set bytes [$_image(plot) data -format "jpeg -quality 100"]
576                set bytes [Rappture::encoding::decode -as b64 $bytes]
577                return [list .jpg $bytes]
578            }
579            return ""
580        }
581        default {
582            error "bad option \"$option\": should be coming, controls, now"
583        }
584    }
585}
586
587# ----------------------------------------------------------------------
588# USAGE: Connect ?<host:port>,<host:port>...?
589#
590# Clients use this method to establish a connection to a new
591# server, or to reestablish a connection to the previous server.
592# Any existing connection is automatically closed.
593# ----------------------------------------------------------------------
594itcl::body Rappture::NanovisViewer::Connect {} {
595    set _hosts [GetServerList "nanovis"]
596    if { "" == $_hosts } {
597        return 0
598    }
599    set _reset 1
600    set result [VisViewer::Connect $_hosts]
601    if { $result } {
602        if { $_reportClientInfo }  {
603            # Tell the server the viewer, hub, user and session.
604            # Do this immediately on connect before buffering any commands
605            global env
606
607            set info {}
608            set user "???"
609            if { [info exists env(USER)] } {
610                set user $env(USER)
611            }
612            set session "???"
613            if { [info exists env(SESSION)] } {
614                set session $env(SESSION)
615            }
616            lappend info "version" "$Rappture::version"
617            lappend info "build" "$Rappture::build"
618            lappend info "svnurl" "$Rappture::svnurl"
619            lappend info "installdir" "$Rappture::installdir"
620            lappend info "hub" [exec hostname]
621            lappend info "client" "nanovisviewer"
622            lappend info "user" $user
623            lappend info "session" $session
624            SendCmd "clientinfo [list $info]"
625        }
626
627        set w [winfo width $itk_component(3dview)]
628        set h [winfo height $itk_component(3dview)]
629        EventuallyResize $w $h
630    }
631    return $result
632}
633
634#
635# isconnected --
636#
637#       Indicates if we are currently connected to the visualization server.
638#
639itcl::body Rappture::NanovisViewer::isconnected {} {
640    return [VisViewer::IsConnected]
641}
642
643#
644# disconnect --
645#
646itcl::body Rappture::NanovisViewer::disconnect {} {
647    Disconnect
648}
649
650#
651# Disconnect --
652#
653#       Clients use this method to disconnect from the current rendering
654#       server.
655#
656itcl::body Rappture::NanovisViewer::Disconnect {} {
657    VisViewer::Disconnect
658
659    # disconnected -- no more data sitting on server
660    array unset _serverDatasets
661}
662
663# ----------------------------------------------------------------------
664# USAGE: SendTransferFunctions
665# ----------------------------------------------------------------------
666itcl::body Rappture::NanovisViewer::SendTransferFunctions {} {
667    if { $_first == "" } {
668        puts stderr "first not set"
669        return
670    }
671    # Ensure that the global opacity and thickness settings (in the slider
672    # settings widgets) are used for the active transfer-function.  Update
673    # the values in the _settings varible.
674    set opacity [expr { double($_settings($this-opacity)) * 0.01 }]
675    # Scale values between 0.00001 and 0.01000
676    set thickness [expr {double($_settings($this-thickness)) * 0.0001}]
677
678    foreach tag [CurrentDatasets] {
679        if { ![info exists _serverDatasets($tag)] || !$_serverDatasets($tag) } {
680            # The volume hasn't reached the server yet.  How did we get
681            # here?
682            puts stderr "Don't have $tag in _serverDatasets"
683            continue
684        }
685        if { ![info exists _dataset2style($tag)] } {
686            puts stderr "don't have style for volume $tag"
687            continue;                        # How does this happen?
688        }
689        set tf $_dataset2style($tag)
690        set _settings($this-$tf-opacity) $opacity
691        set _settings($this-$tf-thickness) $thickness
692        ComputeTransferFunction $tf
693        # FIXME: Need to the send information as to what transfer functions
694        #        to update so that we only update the transfer function
695        #        as necessary.  Right now, all transfer functions are
696        #        updated. This makes moving the isomarker slider chunky.
697        if { ![info exists _activeTfs($tf)] || !$_activeTfs($tf) } {
698            set _activeTfs($tf) 1
699        }
700        SendCmd "volume shading transfunc $tf $tag"
701    }
702    FixLegend
703}
704
705# ----------------------------------------------------------------------
706# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
707#
708# Invoked automatically whenever the "image" command comes in from
709# the rendering server.  Indicates that binary image data with the
710# specified <size> will follow.
711# ----------------------------------------------------------------------
712itcl::body Rappture::NanovisViewer::ReceiveImage { args } {
713    array set info {
714        -token "???"
715        -bytes 0
716        -type image
717    }
718    array set info $args
719    set bytes [ReceiveBytes $info(-bytes)]
720    ReceiveEcho <<line "<read $info(-bytes) bytes"
721    if { $info(-type) == "image" } {
722        ReceiveEcho "for [image width $_image(plot)]x[image height $_image(plot)] image>"
723        $_image(plot) configure -data $bytes
724    } elseif { $info(-type) == "print" } {
725        set tag $this-print-$info(-token)
726        set _hardcopy($tag) $bytes
727    }
728}
729
730#
731# ReceiveLegend --
732#
733#       The procedure is the response from the render server to each "legend"
734#       command.  The server sends back a "legend" command invoked our
735#       the slave interpreter.  The purpose is to collect data of the image
736#       representing the legend in the canvas.  In addition, the isomarkers
737#       of the active transfer function are displayed.
738#
739#       I don't know is this is the right place to display the isomarkers.
740#       I don't know all the different paths used to draw the plot. There's
741#       "Rebuild", "add", etc.
742#
743itcl::body Rappture::NanovisViewer::ReceiveLegend { tf vmin vmax size } {
744    if { ![isconnected] } {
745        return
746    }
747    set bytes [ReceiveBytes $size]
748    $_image(legend) configure -data $bytes
749    ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
750
751    set c $itk_component(legend)
752    set w [winfo width $c]
753    set h [winfo height $c]
754    set lx 10
755    set ly [expr {$h - 1}]
756    if {"" == [$c find withtag transfunc]} {
757        $c create image 10 10 -anchor nw \
758            -image $_image(legend) -tags transfunc
759        $c create text $lx $ly -anchor sw \
760            -fill $itk_option(-plotforeground) -tags "limits vmin"
761        $c create text [expr {$w-$lx}] $ly -anchor se \
762            -fill $itk_option(-plotforeground) -tags "limits vmax"
763        $c lower transfunc
764        $c bind transfunc <ButtonRelease-1> \
765            [itcl::code $this AddIsoMarker %x %y]
766    }
767    # Display the markers used by the active transfer function.
768
769    array set limits [limits $tf]
770    $c itemconfigure vmin -text [format %.2g $limits(min)]
771    $c coords vmin $lx $ly
772
773    $c itemconfigure vmax -text [format %.2g $limits(max)]
774    $c coords vmax [expr {$w-$lx}] $ly
775
776    if { [info exists _isomarkers($tf)] } {
777        foreach m $_isomarkers($tf) {
778            $m visible yes
779        }
780    }
781
782    # The colormap may have changed. Resync the slicers with the colormap.
783    set datasets [CurrentDatasets -cutplanes]
784    SendCmd "volume data state $_settings($this-volume) $datasets"
785
786    # Adjust the cutplane for only the first component in the topmost volume
787    # (i.e. the first volume designated in the field).
788    set tag [lindex $datasets 0]
789    foreach axis {x y z} {
790        # Turn off cutplanes for all volumes
791        SendCmd "cutplane state 0 $axis"
792        if { $_settings($this-${axis}cutplane) } {
793            # Turn on cutplane for this particular volume and set the position
794            SendCmd "cutplane state 1 $axis $tag"
795            set pos [expr {0.01*$_settings($this-${axis}cutposition)}]
796            SendCmd "cutplane position $pos $axis $tag"
797        }
798    }
799}
800
801#
802# ReceiveData --
803#
804#       The procedure is the response from the render server to each "data
805#       follows" command.  The server sends back a "data" command invoked our
806#       the slave interpreter.  The purpose is to collect the min/max of the
807#       volume sent to the render server.  Since the client (nanovisviewer)
808#       doesn't parse 3D data formats, we rely on the server (nanovis) to
809#       tell us what the limits are.  Once we've received the limits to all
810#       the data we've sent (tracked by _recvdDatasets) we can then determine
811#       what the transfer functions are for these volumes.
812#
813#
814#       Note: There is a considerable tradeoff in having the server report
815#             back what the data limits are.  It means that much of the code
816#             having to do with transfer-functions has to wait for the data
817#             to come back, since the isomarkers are calculated based upon
818#             the data limits.  The client code is much messier because of
819#             this.  The alternative is to parse any of the 3D formats on the
820#             client side.
821#
822itcl::body Rappture::NanovisViewer::ReceiveData { args } {
823    if { ![isconnected] } {
824        return
825    }
826
827    # Arguments from server are name value pairs. Stuff them in an array.
828    array set info $args
829
830    set tag $info(tag)
831    set parts [split $tag -]
832
833    #
834    # Volumes don't exist until we're told about them.
835    #
836    set dataobj [lindex $parts 0]
837    set _serverDatasets($tag) 1
838    if { $_settings($this-volume) && $dataobj == $_first } {
839        SendCmd "volume state 1 $tag"
840    }
841    set _limits($tag-min)  $info(min);  # Minimum value of the volume.
842    set _limits($tag-max)  $info(max);  # Maximum value of the volume.
843    set _limits(vmin)      $info(vmin); # Overall minimum value.
844    set _limits(vmax)      $info(vmax); # Overall maximum value.
845
846    unset _recvdDatasets($tag)
847    if { [array size _recvdDatasets] == 0 } {
848        # The active transfer function is by default the first component of
849        # the first data object.  This assumes that the data is always
850        # successfully transferred.
851        updateTransferFunctions
852    }
853}
854
855# ----------------------------------------------------------------------
856# USAGE: Rebuild
857#
858# Called automatically whenever something changes that affects the
859# data in the widget.  Clears any existing data and rebuilds the
860# widget to display new data.
861# ----------------------------------------------------------------------
862itcl::body Rappture::NanovisViewer::Rebuild {} {
863    set w [winfo width $itk_component(3dview)]
864    set h [winfo height $itk_component(3dview)]
865    if { $w < 2 || $h < 2 } {
866        update
867        $_dispatcher event -idle !rebuild
868        return
869    }
870
871    # Turn on buffering of commands to the server.  We don't want to
872    # be preempted by a server disconnect/reconnect (which automatically
873    # generates a new call to Rebuild).
874    StartBufferingCommands
875
876    # Hide all the isomarkers. Can't remove them. Have to remember the
877    # settings since the user may have created/deleted/moved markers.
878
879    foreach tf [array names _isomarkers] {
880        foreach m $_isomarkers($tf) {
881            $m visible no
882        }
883    }
884
885    if { $_width != $w || $_height != $h || $_reset } {
886        set _width $w
887        set _height $h
888        $_arcball resize $w $h
889        DoResize
890    }
891
892    foreach dataobj [get] {
893        foreach cname [$dataobj components] {
894            set tag $dataobj-$cname
895            if { ![info exists _serverDatasets($tag)] } {
896                # Send the data as one huge base64-encoded mess -- yuck!
897                if { [$dataobj type] == "dx" } {
898                    if { ![$dataobj isvalid] } {
899                        puts stderr "??? $dataobj is invalid"
900                    }
901                    set data [$dataobj blob $cname]
902                } else {
903                    set data [$dataobj vtkdata $cname]
904                    if 0 {
905                        set f [open "/tmp/volume.vtk" "w"]
906                        fconfigure $f -translation binary -encoding binary
907                        puts -nonewline $f $data
908                        close $f
909                    }
910                }
911                set nbytes [string length $data]
912                if { $_reportClientInfo }  {
913                    set info {}
914                    lappend info "tool_id"       [$dataobj hints toolid]
915                    lappend info "tool_name"     [$dataobj hints toolname]
916                    lappend info "tool_title"    [$dataobj hints tooltitle]
917                    lappend info "tool_command"  [$dataobj hints toolcommand]
918                    lappend info "tool_revision" [$dataobj hints toolrevision]
919                    lappend info "dataset_label" [$dataobj hints label]
920                    lappend info "dataset_size"  $nbytes
921                    lappend info "dataset_tag"   $tag
922                    SendCmd "clientinfo [list $info]"
923                }
924                SendCmd "volume data follows $nbytes $tag"
925                SendData $data
926                set _recvdDatasets($tag) 1
927                set _serverDatasets($tag) 0
928            }
929            NameTransferFunction $dataobj $cname
930        }
931    }
932    set _first [lindex [get] 0]
933    if { $_reset } {
934        #
935        # Reset the camera and other view parameters
936        #
937        set _settings($this-qw)    $_view(-qw)
938        set _settings($this-qx)    $_view(-qx)
939        set _settings($this-qy)    $_view(-qy)
940        set _settings($this-qz)    $_view(-qz)
941        set _settings($this-xpan)  $_view(-xpan)
942        set _settings($this-ypan)  $_view(-ypan)
943        set _settings($this-zoom)  $_view(-zoom)
944
945        set q [ViewToQuaternion]
946        $_arcball quaternion $q
947        SendCmd "camera orient $q"
948        SendCmd "camera reset"
949        PanCamera
950        SendCmd "camera zoom $_view(-zoom)"
951        InitSettings light2side light transp isosurface grid axes
952
953        # Turn off cutplanes for all volumes
954        foreach axis {x y z} {
955            SendCmd "cutplane state 0 $axis"
956        }
957        if {"" != $_first} {
958            set axis [$_first hints updir]
959            if { "" != $axis } {
960                SendCmd "up $axis"
961            }
962            set location [$_first hints camera]
963            if { $location != "" } {
964                array set _view $location
965            }
966        }
967    }
968    # Outline seems to need to be reset every update.
969    InitSettings outline
970    # nothing to send -- activate the proper ivol
971    SendCmd "volume state 0"
972    if {"" != $_first} {
973        set datasets [array names _serverDatasets $_first-*]
974        if { $datasets != "" } {
975            SendCmd "volume state 1 $datasets"
976        }
977        # If the first volume already exists on the server, then make sure
978        # we display the proper transfer function in the legend.
979        set cname [lindex [$_first components] 0]
980        if { [info exists _serverDatasets($_first-$cname)] } {
981            updateTransferFunctions
982        }
983    }
984    # Actually write the commands to the server socket.  If it fails, we don't
985    # care.  We're finished here.
986    blt::busy hold $itk_component(hull)
987    StopBufferingCommands
988    blt::busy release $itk_component(hull)
989    set _reset 0
990}
991
992# ----------------------------------------------------------------------
993# USAGE: CurrentDatasets ?-cutplanes?
994#
995# Returns a list of volume server IDs for the current volume being
996# displayed.  This is normally a single ID, but it might be a list
997# of IDs if the current data object has multiple components.
998# ----------------------------------------------------------------------
999itcl::body Rappture::NanovisViewer::CurrentDatasets {{what -all}} {
1000    set rlist ""
1001    if { $_first == "" } {
1002        return
1003    }
1004    foreach cname [$_first components] {
1005        set tag $_first-$cname
1006        if { [info exists _serverDatasets($tag)] && $_serverDatasets($tag) } {
1007            array set style {
1008                -cutplanes 1
1009            }
1010            array set style [lindex [$_first components -style $cname] 0]
1011            if { $what != "-cutplanes" || $style(-cutplanes) } {
1012                lappend rlist $tag
1013            }
1014        }
1015    }
1016    return $rlist
1017}
1018
1019# ----------------------------------------------------------------------
1020# USAGE: Zoom in
1021# USAGE: Zoom out
1022# USAGE: Zoom reset
1023#
1024# Called automatically when the user clicks on one of the zoom
1025# controls for this widget.  Changes the zoom for the current view.
1026# ----------------------------------------------------------------------
1027itcl::body Rappture::NanovisViewer::Zoom {option} {
1028    switch -- $option {
1029        "in" {
1030            set _view(-zoom) [expr {$_view(-zoom)*1.25}]
1031            set _settings($this-zoom) $_view(-zoom)
1032            SendCmd "camera zoom $_view(-zoom)"
1033        }
1034        "out" {
1035            set _view(-zoom) [expr {$_view(-zoom)*0.8}]
1036            set _settings($this-zoom) $_view(-zoom)
1037            SendCmd "camera zoom $_view(-zoom)"
1038        }
1039        "reset" {
1040            array set _view {
1041                -qw      0.853553
1042                -qx      -0.353553
1043                -qy      0.353553
1044                -qz      0.146447
1045                -xpan    0
1046                -ypan    0
1047                -zoom    1.0
1048            }
1049            if { $_first != "" } {
1050                set location [$_first hints camera]
1051                if { $location != "" } {
1052                    array set _view $location
1053                }
1054            }
1055            set q [ViewToQuaternion]
1056            $_arcball quaternion $q
1057            SendCmd "camera orient $q"
1058            SendCmd "camera reset"
1059            set _settings($this-qw)    $_view(-qw)
1060            set _settings($this-qx)    $_view(-qx)
1061            set _settings($this-qy)    $_view(-qy)
1062            set _settings($this-qz)    $_view(-qz)
1063            set _settings($this-xpan)  $_view(-xpan)
1064            set _settings($this-ypan)  $_view(-ypan)
1065            set _settings($this-zoom)  $_view(-zoom)
1066        }
1067    }
1068}
1069
1070itcl::body Rappture::NanovisViewer::PanCamera {} {
1071    set x $_view(-xpan)
1072    set y $_view(-ypan)
1073    SendCmd "camera pan $x $y"
1074}
1075
1076# ----------------------------------------------------------------------
1077# USAGE: Rotate click <x> <y>
1078# USAGE: Rotate drag <x> <y>
1079# USAGE: Rotate release <x> <y>
1080#
1081# Called automatically when the user clicks/drags/releases in the
1082# plot area.  Moves the plot according to the user's actions.
1083# ----------------------------------------------------------------------
1084itcl::body Rappture::NanovisViewer::Rotate {option x y} {
1085    switch -- $option {
1086        click {
1087            $itk_component(3dview) configure -cursor fleur
1088            set _click(x) $x
1089            set _click(y) $y
1090        }
1091        drag {
1092            if {[array size _click] == 0} {
1093                Rotate click $x $y
1094            } else {
1095                set w [winfo width $itk_component(3dview)]
1096                set h [winfo height $itk_component(3dview)]
1097                if {$w <= 0 || $h <= 0} {
1098                    return
1099                }
1100
1101                if {[catch {
1102                    # this fails sometimes for no apparent reason
1103                    set dx [expr {double($x-$_click(x))/$w}]
1104                    set dy [expr {double($y-$_click(y))/$h}]
1105                }]} {
1106                    return
1107                }
1108
1109                set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1110                QuaternionToView $q
1111                set _settings($this-qw) $_view(-qw)
1112                set _settings($this-qx) $_view(-qx)
1113                set _settings($this-qy) $_view(-qy)
1114                set _settings($this-qz) $_view(-qz)
1115                SendCmd "camera orient $q"
1116
1117                set _click(x) $x
1118                set _click(y) $y
1119            }
1120        }
1121        release {
1122            Rotate drag $x $y
1123            $itk_component(3dview) configure -cursor ""
1124            catch {unset _click}
1125        }
1126        default {
1127            error "bad option \"$option\": should be click, drag, release"
1128        }
1129    }
1130}
1131
1132# ----------------------------------------------------------------------
1133# USAGE: $this Pan click x y
1134#        $this Pan drag x y
1135#        $this Pan release x y
1136#
1137# Called automatically when the user clicks on one of the zoom
1138# controls for this widget.  Changes the zoom for the current view.
1139# ----------------------------------------------------------------------
1140itcl::body Rappture::NanovisViewer::Pan {option x y} {
1141    # Experimental stuff
1142    set w [winfo width $itk_component(3dview)]
1143    set h [winfo height $itk_component(3dview)]
1144    if { $option == "set" } {
1145        set x [expr $x / double($w)]
1146        set y [expr $y / double($h)]
1147        set _view(-xpan) [expr $_view(-xpan) + $x]
1148        set _view(-ypan) [expr $_view(-ypan) + $y]
1149        PanCamera
1150        set _settings($this-xpan) $_view(-xpan)
1151        set _settings($this-ypan) $_view(-ypan)
1152        return
1153    }
1154    if { $option == "click" } {
1155        set _click(x) $x
1156        set _click(y) $y
1157        $itk_component(3dview) configure -cursor hand1
1158    }
1159    if { $option == "drag" || $option == "release" } {
1160        set dx [expr ($_click(x) - $x)/double($w)]
1161        set dy [expr ($_click(y) - $y)/double($h)]
1162        set _click(x) $x
1163        set _click(y) $y
1164        set _view(-xpan) [expr $_view(-xpan) - $dx]
1165        set _view(-ypan) [expr $_view(-ypan) - $dy]
1166        PanCamera
1167        set _settings($this-xpan) $_view(-xpan)
1168        set _settings($this-ypan) $_view(-ypan)
1169    }
1170    if { $option == "release" } {
1171        $itk_component(3dview) configure -cursor ""
1172    }
1173}
1174
1175# ----------------------------------------------------------------------
1176# USAGE: InitSettings <what> ?<value>?
1177#
1178# Used internally to update rendering settings whenever parameters
1179# change in the popup settings panel.  Sends the new settings off
1180# to the back end.
1181# ----------------------------------------------------------------------
1182itcl::body Rappture::NanovisViewer::InitSettings { args } {
1183    foreach arg $args {
1184        AdjustSetting $arg
1185    }
1186}
1187
1188# ----------------------------------------------------------------------
1189# USAGE: AdjustSetting <what> ?<value>?
1190#
1191# Used internally to update rendering settings whenever parameters
1192# change in the popup settings panel.  Sends the new settings off
1193# to the back end.
1194# ----------------------------------------------------------------------
1195itcl::body Rappture::NanovisViewer::AdjustSetting {what {value ""}} {
1196    if {![isconnected]} {
1197        return
1198    }
1199    switch -- $what {
1200        light {
1201            set val $_settings($this-light)
1202            set diffuse [expr {0.01*$val}]
1203            set ambient [expr {1.0-$diffuse}]
1204            set specularLevel 0.3
1205            set specularExp 90.0
1206            SendCmd "volume shading ambient $ambient"
1207            SendCmd "volume shading diffuse $diffuse"
1208            SendCmd "volume shading specularLevel $specularLevel"
1209            SendCmd "volume shading specularExp $specularExp"
1210        }
1211        light2side {
1212            set val $_settings($this-light2side)
1213            SendCmd "volume shading light2side $val"
1214        }
1215        transp {
1216            set val $_settings($this-transp)
1217            set sval [expr { 0.01 * double($val) }]
1218            SendCmd "volume shading opacity $sval"
1219        }
1220        opacity {
1221            set val $_settings($this-opacity)
1222            set sval [expr { 0.01 * double($val) }]
1223            foreach tf [array names _activeTfs] {
1224                set _settings($this-$tf-opacity) $sval
1225                set _activeTfs($tf) 0
1226            }
1227            updateTransferFunctions
1228        }
1229        thickness {
1230            if { [array names _activeTfs] > 0 } {
1231                set val $_settings($this-thickness)
1232                # Scale values between 0.00001 and 0.01000
1233                set sval [expr {0.0001*double($val)}]
1234                foreach tf [array names _activeTfs] {
1235                    set _settings($this-$tf-thickness) $sval
1236                    set _activeTfs($tf) 0
1237                }
1238                updateTransferFunctions
1239            }
1240        }
1241        "outline" {
1242            SendCmd "volume outline state $_settings($this-outline)"
1243        }
1244        "isosurface" {
1245            SendCmd "volume shading isosurface $_settings($this-isosurface)"
1246        }
1247        "colormap" {
1248            set color [$itk_component(colormap) value]
1249            set _settings(colormap) $color
1250            # Only set the colormap on the first volume. Ignore the others.
1251            #ResetColormap $color
1252        }
1253        "grid" {
1254            SendCmd "grid visible $_settings($this-grid)"
1255        }
1256        "axes" {
1257            SendCmd "axis visible $_settings($this-axes)"
1258        }
1259        "legend" {
1260            if { $_settings($this-legend) } {
1261                blt::table $itk_component(plotarea) \
1262                    0,0 $itk_component(3dview) -fill both \
1263                    1,0 $itk_component(legend) -fill x
1264                blt::table configure $itk_component(plotarea) r1 -resize none
1265            } else {
1266                blt::table forget $itk_component(legend)
1267            }
1268        }
1269        "volume" {
1270            set datasets [CurrentDatasets -cutplanes]
1271            SendCmd "volume data state $_settings($this-volume) $datasets"
1272        }
1273        "xcutplane" - "ycutplane" - "zcutplane" {
1274            set axis [string range $what 0 0]
1275            set bool $_settings($this-$what)
1276            set datasets [CurrentDatasets -cutplanes]
1277            set tag [lindex $datasets 0]
1278            SendCmd "cutplane state $bool $axis $tag"
1279            if { $bool } {
1280                $itk_component(${axis}CutScale) configure -state normal \
1281                    -troughcolor white
1282            } else {
1283                $itk_component(${axis}CutScale) configure -state disabled \
1284                    -troughcolor grey82
1285            }
1286        }
1287        default {
1288            error "don't know how to fix $what"
1289        }
1290    }
1291}
1292
1293# ----------------------------------------------------------------------
1294# USAGE: FixLegend
1295#
1296# Used internally to update the legend area whenever it changes size
1297# or when the field changes.  Asks the server to send a new legend
1298# for the current field.
1299# ----------------------------------------------------------------------
1300itcl::body Rappture::NanovisViewer::FixLegend {} {
1301    set _resizeLegendPending 0
1302    set lineht [font metrics $itk_option(-font) -linespace]
1303    set w [expr {$_width-20}]
1304    set h [expr {[winfo height $itk_component(legend)]-20-$lineht}]
1305    if {$w > 0 && $h > 0 && [array names _activeTfs] > 0 && $_first != "" } {
1306        set tag [lindex [CurrentDatasets] 0]
1307        if { [info exists _dataset2style($tag)] } {
1308            SendCmd "legend $_dataset2style($tag) $w $h"
1309        }
1310    } else {
1311        # Can't do this as this will remove the items associated with the
1312        # isomarkers.
1313
1314        #$itk_component(legend) delete all
1315    }
1316}
1317
1318#
1319# NameTransferFunction --
1320#
1321#       Creates a transfer function name based on the <style> settings in the
1322#       library run.xml file. This placeholder will be used later to create
1323#       and send the actual transfer function once the data info has been sent
1324#       to us by the render server. [We won't know the volume limits until the
1325#       server parses the 3D data and sends back the limits via ReceiveData.]
1326#
1327#       FIXME: The current way we generate transfer-function names completely
1328#              ignores the -markers option.  The problem is that we are forced
1329#              to compute the name from an increasing complex set of values:
1330#              color, levels, marker, opacity.  I think we're stuck doing it
1331#              now.
1332#
1333itcl::body Rappture::NanovisViewer::NameTransferFunction { dataobj cname } {
1334    array set style {
1335        -color BCGYR
1336        -levels 6
1337        -opacity 1.0
1338        -markers ""
1339    }
1340    set tag $dataobj-$cname
1341    array set style [lindex [$dataobj components -style $cname] 0]
1342    set tf "$style(-color):$style(-levels):$style(-opacity)"
1343    set _dataset2style($tag) $tf
1344    lappend _style2datasets($tf) $tag
1345    return $tf
1346}
1347
1348#
1349# ComputeTransferFunction --
1350#
1351#   Computes and sends the transfer function to the render server.  It's
1352#   assumed that the volume data limits are known and that the global
1353#   transfer-functions slider values have been set up.  Both parts are
1354#   needed to compute the relative value (location) of the marker, and
1355#   the alpha map of the transfer function.
1356#
1357itcl::body Rappture::NanovisViewer::ComputeTransferFunction { tf } {
1358    array set style {
1359        -color BCGYR
1360        -levels 6
1361        -opacity 1.0
1362        -markers ""
1363    }
1364
1365    foreach {dataobj cname} [split [lindex $_style2datasets($tf) 0] -] break
1366    array set style [lindex [$dataobj components -style $cname] 0]
1367
1368    # We have to parse the style attributes for a volume using this
1369    # transfer-function *once*.  This sets up the initial isomarkers for the
1370    # transfer function.  The user may add/delete markers, so we have to
1371    # maintain a list of markers for each transfer-function.  We use the one
1372    # of the volumes (the first in the list) using the transfer-function as a
1373    # reference.
1374    #
1375    # FIXME: The current way we generate transfer-function names completely
1376    #        ignores the -markers option.  The problem is that we are forced
1377    #        to compute the name from an increasing complex set of values:
1378    #        color, levels, marker, opacity.  I think the cow's out of the
1379    #        barn on this one.
1380
1381    if { ![info exists _isomarkers($tf)] } {
1382        # Have to defer creation of isomarkers until we have data limits
1383        if { [info exists style(-markers)] &&
1384             [llength $style(-markers)] > 0 } {
1385            ParseMarkersOption $tf $style(-markers)
1386        } else {
1387            ParseLevelsOption $tf $style(-levels)
1388        }
1389    }
1390    set cmap [ColorsToColormap $style(-color)]
1391    set tag $this-$tf
1392    if { ![info exists _settings($tag-opacity)] } {
1393        set _settings($tag-opacity) $style(-opacity)
1394    }
1395    set max 1.0 ;#$_settings($tag-opacity)
1396
1397    set isovalues {}
1398    foreach m $_isomarkers($tf) {
1399        lappend isovalues [$m relval]
1400    }
1401    # Sort the isovalues
1402    set isovalues [lsort -real $isovalues]
1403
1404    if { ![info exists _settings($tag-thickness)]} {
1405        set _settings($tag-thickness) 0.005
1406    }
1407    set delta $_settings($tag-thickness)
1408
1409    set first [lindex $isovalues 0]
1410    set last [lindex $isovalues end]
1411    set amap ""
1412    if { $first == "" || $first != 0.0 } {
1413        lappend amap 0.0 0.0
1414    }
1415    foreach x $isovalues {
1416        set x1 [expr {$x-$delta-0.00001}]
1417        set x2 [expr {$x-$delta}]
1418        set x3 [expr {$x+$delta}]
1419        set x4 [expr {$x+$delta+0.00001}]
1420        if { $x1 < 0.0 } {
1421            set x1 0.0
1422        } elseif { $x1 > 1.0 } {
1423            set x1 1.0
1424        }
1425        if { $x2 < 0.0 } {
1426            set x2 0.0
1427        } elseif { $x2 > 1.0 } {
1428            set x2 1.0
1429        }
1430        if { $x3 < 0.0 } {
1431            set x3 0.0
1432        } elseif { $x3 > 1.0 } {
1433            set x3 1.0
1434        }
1435        if { $x4 < 0.0 } {
1436            set x4 0.0
1437        } elseif { $x4 > 1.0 } {
1438            set x4 1.0
1439        }
1440        # add spikes in the middle
1441        lappend amap $x1 0.0
1442        lappend amap $x2 $max
1443        lappend amap $x3 $max
1444        lappend amap $x4 0.0
1445    }
1446    if { $last == "" || $last != 1.0 } {
1447        lappend amap 1.0 0.0
1448    }
1449    SendCmd "transfunc define $tf { $cmap } { $amap }"
1450}
1451
1452# ----------------------------------------------------------------------
1453# CONFIGURATION OPTION: -plotbackground
1454# ----------------------------------------------------------------------
1455itcl::configbody Rappture::NanovisViewer::plotbackground {
1456    if { [isconnected] } {
1457        foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1458        #fix this!
1459        #SendCmd "color background $r $g $b"
1460    }
1461}
1462
1463# ----------------------------------------------------------------------
1464# CONFIGURATION OPTION: -plotforeground
1465# ----------------------------------------------------------------------
1466itcl::configbody Rappture::NanovisViewer::plotforeground {
1467    if { [isconnected] } {
1468        foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1469        #fix this!
1470        #SendCmd "color background $r $g $b"
1471    }
1472}
1473
1474# ----------------------------------------------------------------------
1475# CONFIGURATION OPTION: -plotoutline
1476# ----------------------------------------------------------------------
1477itcl::configbody Rappture::NanovisViewer::plotoutline {
1478    # Must check if we are connected because this routine is called from the
1479    # class body when the -plotoutline itk_option is defined.  At that point
1480    # the NanovisViewer class constructor hasn't been called, so we can't
1481    # start sending commands to visualization server.
1482    if { [isconnected] } {
1483        if {"" == $itk_option(-plotoutline)} {
1484            SendCmd "volume outline state off"
1485        } else {
1486            SendCmd "volume outline state on"
1487            SendCmd "volume outline color [Color2RGB $itk_option(-plotoutline)]"
1488        }
1489    }
1490}
1491
1492#
1493# The -levels option takes a single value that represents the number
1494# of evenly distributed markers based on the current data range. Each
1495# marker is a relative value from 0.0 to 1.0.
1496#
1497itcl::body Rappture::NanovisViewer::ParseLevelsOption { tf levels } {
1498    set c $itk_component(legend)
1499    regsub -all "," $levels " " levels
1500    if {[string is int $levels]} {
1501        for {set i 1} { $i <= $levels } {incr i} {
1502            set x [expr {double($i)/($levels+1)}]
1503            set m [Rappture::IsoMarker \#auto $c $this $tf]
1504            $m relval $x
1505            lappend _isomarkers($tf) $m
1506        }
1507    } else {
1508        foreach x $levels {
1509            set m [Rappture::IsoMarker \#auto $c $this $tf]
1510            $m relval $x
1511            lappend _isomarkers($tf) $m
1512        }
1513    }
1514}
1515
1516#
1517# The -markers option takes a list of zero or more values (the values
1518# may be separated either by spaces or commas) that have the following
1519# format:
1520#
1521#   N%  Percent of current total data range.  Converted to
1522#       to a relative value between 0.0 and 1.0.
1523#   N   Absolute value of marker.  If the marker is outside of
1524#       the current range, it will be displayed on the outer
1525#       edge of the legends, but it range it represents will
1526#       not be seen.
1527#
1528itcl::body Rappture::NanovisViewer::ParseMarkersOption { tf markers } {
1529    set c $itk_component(legend)
1530    regsub -all "," $markers " " markers
1531    foreach marker $markers {
1532        set n [scan $marker "%g%s" value suffix]
1533        if { $n == 2 && $suffix == "%" } {
1534            # ${n}% : Set relative value.
1535            set value [expr {$value * 0.01}]
1536            set m [Rappture::IsoMarker \#auto $c $this $tf]
1537            $m relval $value
1538            lappend _isomarkers($tf) $m
1539        } else {
1540            # ${n} : Set absolute value.
1541            set m [Rappture::IsoMarker \#auto $c $this $tf]
1542            $m absval $value
1543            lappend _isomarkers($tf) $m
1544        }
1545    }
1546}
1547
1548# ----------------------------------------------------------------------
1549# USAGE: UpdateTransferFunctions
1550# ----------------------------------------------------------------------
1551itcl::body Rappture::NanovisViewer::updateTransferFunctions {} {
1552    $_dispatcher event -idle !send_transfunc
1553}
1554
1555itcl::body Rappture::NanovisViewer::AddIsoMarker { x y } {
1556    if { $_first == "" } {
1557        error "active transfer function isn't set"
1558    }
1559    set tag [lindex [CurrentDatasets] 0]
1560    set tf $_dataset2style($tag)
1561    set c $itk_component(legend)
1562    set m [Rappture::IsoMarker \#auto $c $this $tf]
1563    set w [winfo width $c]
1564    $m relval [expr {double($x-10)/($w-20)}]
1565    lappend _isomarkers($tf) $m
1566    updateTransferFunctions
1567    return 1
1568}
1569
1570itcl::body Rappture::NanovisViewer::removeDuplicateMarker { marker x } {
1571    set tf [$marker transferfunc]
1572    set bool 0
1573    if { [info exists _isomarkers($tf)] } {
1574        set list {}
1575        set marker [namespace tail $marker]
1576        foreach m $_isomarkers($tf) {
1577            set sx [$m screenpos]
1578            if { $m != $marker } {
1579                if { $x >= ($sx-3) && $x <= ($sx+3) } {
1580                    $marker relval [$m relval]
1581                    itcl::delete object $m
1582                    bell
1583                    set bool 1
1584                    continue
1585                }
1586            }
1587            lappend list $m
1588        }
1589        set _isomarkers($tf) $list
1590        updateTransferFunctions
1591    }
1592    return $bool
1593}
1594
1595itcl::body Rappture::NanovisViewer::overMarker { marker x } {
1596    set tf [$marker transferfunc]
1597    if { [info exists _isomarkers($tf)] } {
1598        set marker [namespace tail $marker]
1599        foreach m $_isomarkers($tf) {
1600            set sx [$m screenpos]
1601            if { $m != $marker } {
1602                set bool [expr { $x >= ($sx-3) && $x <= ($sx+3) }]
1603                $m activate $bool
1604            }
1605        }
1606    }
1607    return ""
1608}
1609
1610itcl::body Rappture::NanovisViewer::limits { tf } {
1611    set _limits(min) 0.0
1612    set _limits(max) 1.0
1613    if { ![info exists _style2datasets($tf)] } {
1614        return [array get _limits]
1615    }
1616    set min ""; set max ""
1617    foreach tag $_style2datasets($tf) {
1618        if { ![info exists _serverDatasets($tag)] } {
1619            continue
1620        }
1621        if { ![info exists _limits($tag-min)] } {
1622            continue
1623        }
1624        if { $min == "" || $min > $_limits($tag-min) } {
1625            set min $_limits($tag-min)
1626        }
1627        if { $max == "" || $max < $_limits($tag-max) } {
1628            set max $_limits($tag-max)
1629        }
1630    }
1631    if { $min != "" } {
1632        set _limits(min) $min
1633    }
1634    if { $max != "" } {
1635        set _limits(max) $max
1636    }
1637    return [array get _limits]
1638}
1639
1640
1641itcl::body Rappture::NanovisViewer::BuildViewTab {} {
1642    foreach { key value } {
1643        grid            0
1644        axes            1
1645        outline         0
1646        volume          1
1647        legend          1
1648        particles       1
1649        lic             1
1650    } {
1651        set _settings($this-$key) $value
1652    }
1653
1654    set fg [option get $itk_component(hull) font Font]
1655    #set bfg [option get $itk_component(hull) boldFont Font]
1656
1657    set inner [$itk_component(main) insert end \
1658        -title "View Settings" \
1659        -icon [Rappture::icon wrench]]
1660    $inner configure -borderwidth 4
1661
1662    set ::Rappture::NanovisViewer::_settings($this-isosurface) 0
1663    checkbutton $inner.isosurface \
1664        -text "Isosurface shading" \
1665        -variable [itcl::scope _settings($this-isosurface)] \
1666        -command [itcl::code $this AdjustSetting isosurface] \
1667        -font "Arial 9"
1668
1669    checkbutton $inner.axes \
1670        -text "Axes" \
1671        -variable [itcl::scope _settings($this-axes)] \
1672        -command [itcl::code $this AdjustSetting axes] \
1673        -font "Arial 9"
1674
1675    checkbutton $inner.grid \
1676        -text "Grid" \
1677        -variable [itcl::scope _settings($this-grid)] \
1678        -command [itcl::code $this AdjustSetting grid] \
1679        -font "Arial 9"
1680
1681    checkbutton $inner.outline \
1682        -text "Outline" \
1683        -variable [itcl::scope _settings($this-outline)] \
1684        -command [itcl::code $this AdjustSetting outline] \
1685        -font "Arial 9"
1686
1687    checkbutton $inner.legend \
1688        -text "Legend" \
1689        -variable [itcl::scope _settings($this-legend)] \
1690        -command [itcl::code $this AdjustSetting legend] \
1691        -font "Arial 9"
1692
1693    checkbutton $inner.volume \
1694        -text "Volume" \
1695        -variable [itcl::scope _settings($this-volume)] \
1696        -command [itcl::code $this AdjustSetting volume] \
1697        -font "Arial 9"
1698
1699    blt::table $inner \
1700        0,0 $inner.axes  -cspan 2 -anchor w \
1701        1,0 $inner.grid  -cspan 2 -anchor w \
1702        2,0 $inner.outline  -cspan 2 -anchor w \
1703        3,0 $inner.volume  -cspan 2 -anchor w \
1704        4,0 $inner.legend  -cspan 2 -anchor w
1705
1706    if 0 {
1707    bind $inner <Map> [itcl::code $this GetVolumeInfo $inner]
1708    }
1709    blt::table configure $inner r* -resize none
1710    blt::table configure $inner r5 -resize expand
1711}
1712
1713itcl::body Rappture::NanovisViewer::BuildVolumeTab {} {
1714    foreach { key value } {
1715        light2side      1
1716        light           40
1717        transp          50
1718        opacity         100
1719        thickness       350
1720    } {
1721        set _settings($this-$key) $value
1722    }
1723
1724    set inner [$itk_component(main) insert end \
1725        -title "Volume Settings" \
1726        -icon [Rappture::icon volume-on]]
1727    $inner configure -borderwidth 4
1728
1729    set fg [option get $itk_component(hull) font Font]
1730    #set bfg [option get $itk_component(hull) boldFont Font]
1731
1732    checkbutton $inner.vol -text "Show volume" -font $fg \
1733        -variable [itcl::scope _settings($this-volume)] \
1734        -command [itcl::code $this AdjustSetting volume]
1735    label $inner.shading -text "Shading:" -font $fg
1736
1737    checkbutton $inner.light2side -text "Two-sided lighting" -font $fg \
1738        -variable [itcl::scope _settings($this-light2side)] \
1739        -command [itcl::code $this AdjustSetting light2side]
1740
1741    label $inner.dim -text "Glow" -font $fg
1742    ::scale $inner.light -from 0 -to 100 -orient horizontal \
1743        -variable [itcl::scope _settings($this-light)] \
1744        -width 10 \
1745        -showvalue off -command [itcl::code $this AdjustSetting light]
1746    label $inner.bright -text "Surface" -font $fg
1747
1748    label $inner.fog -text "Clear" -font $fg
1749    ::scale $inner.transp -from 0 -to 100 -orient horizontal \
1750        -variable [itcl::scope _settings($this-transp)] \
1751        -width 10 \
1752        -showvalue off -command [itcl::code $this AdjustSetting transp]
1753    label $inner.plastic -text "Opaque" -font $fg
1754
1755    label $inner.clear -text "Clear" -font $fg
1756    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1757        -variable [itcl::scope _settings($this-opacity)] \
1758        -width 10 \
1759        -showvalue off -command [itcl::code $this AdjustSetting opacity]
1760    label $inner.opaque -text "Opaque" -font $fg
1761
1762    label $inner.thin -text "Thin" -font $fg
1763    ::scale $inner.thickness -from 0 -to 1000 -orient horizontal \
1764        -variable [itcl::scope _settings($this-thickness)] \
1765        -width 10 \
1766        -showvalue off -command [itcl::code $this AdjustSetting thickness]
1767    label $inner.thick -text "Thick" -font $fg
1768
1769    label $inner.colormap_l -text "Colormap" -font "Arial 9"
1770    itk_component add colormap {
1771        Rappture::Combobox $inner.colormap -width 10 -editable no
1772    }
1773
1774    $inner.colormap choices insert end [GetColormapList -includeNone]
1775    $itk_component(colormap) value "BCGYR"
1776    bind $inner.colormap <<Value>> \
1777        [itcl::code $this AdjustSetting colormap]
1778
1779    blt::table $inner \
1780        0,0 $inner.vol -cspan 4 -anchor w -pady 2 \
1781        1,0 $inner.shading -cspan 4 -anchor w -pady {10 2} \
1782        2,0 $inner.light2side -cspan 4 -anchor w -pady 2 \
1783        3,0 $inner.dim -anchor e -pady 2 \
1784        3,1 $inner.light -cspan 2 -pady 2 -fill x \
1785        3,3 $inner.bright -anchor w -pady 2 \
1786        4,0 $inner.fog -anchor e -pady 2 \
1787        4,1 $inner.transp -cspan 2 -pady 2 -fill x \
1788        4,3 $inner.plastic -anchor w -pady 2 \
1789        5,0 $inner.thin -anchor e -pady 2 \
1790        5,1 $inner.thickness -cspan 2 -pady 2 -fill x\
1791        5,3 $inner.thick -anchor w -pady 2
1792
1793    blt::table configure $inner c0 c1 c3 r* -resize none
1794    blt::table configure $inner r6 -resize expand
1795}
1796
1797itcl::body Rappture::NanovisViewer::BuildCutplanesTab {} {
1798    set inner [$itk_component(main) insert end \
1799        -title "Cutplane Settings" \
1800        -icon [Rappture::icon cutbutton]]
1801    $inner configure -borderwidth 4
1802
1803    # X-value slicer...
1804    itk_component add xCutButton {
1805        Rappture::PushButton $inner.xbutton \
1806            -onimage [Rappture::icon x-cutplane] \
1807            -offimage [Rappture::icon x-cutplane] \
1808            -command [itcl::code $this AdjustSetting xcutplane] \
1809            -variable [itcl::scope _settings($this-xcutplane)]
1810    }
1811    Rappture::Tooltip::for $itk_component(xCutButton) \
1812        "Toggle the X cut plane on/off"
1813
1814    itk_component add xCutScale {
1815        ::scale $inner.xval -from 100 -to 0 \
1816            -width 10 -orient vertical -showvalue off \
1817            -borderwidth 1 -highlightthickness 0 \
1818            -command [itcl::code $this Slice move x] \
1819            -variable [itcl::scope _settings($this-xcutposition)]
1820    } {
1821        usual
1822        ignore -borderwidth -highlightthickness
1823    }
1824    # Set the default cutplane value before disabling the scale.
1825    $itk_component(xCutScale) set 50
1826    $itk_component(xCutScale) configure -state disabled
1827    Rappture::Tooltip::for $itk_component(xCutScale) \
1828        "@[itcl::code $this SlicerTip x]"
1829
1830    # Y-value slicer...
1831    itk_component add yCutButton {
1832        Rappture::PushButton $inner.ybutton \
1833            -onimage [Rappture::icon y-cutplane] \
1834            -offimage [Rappture::icon y-cutplane] \
1835            -command [itcl::code $this AdjustSetting ycutplane] \
1836            -variable [itcl::scope _settings($this-ycutplane)]
1837    }
1838    Rappture::Tooltip::for $itk_component(yCutButton) \
1839        "Toggle the Y cut plane on/off"
1840
1841    itk_component add yCutScale {
1842        ::scale $inner.yval -from 100 -to 0 \
1843            -width 10 -orient vertical -showvalue off \
1844            -borderwidth 1 -highlightthickness 0 \
1845            -command [itcl::code $this Slice move y] \
1846            -variable [itcl::scope _settings($this-ycutposition)]
1847    } {
1848        usual
1849        ignore -borderwidth -highlightthickness
1850    }
1851    Rappture::Tooltip::for $itk_component(yCutScale) \
1852        "@[itcl::code $this SlicerTip y]"
1853    # Set the default cutplane value before disabling the scale.
1854    $itk_component(yCutScale) set 50
1855    $itk_component(yCutScale) configure -state disabled
1856
1857    # Z-value slicer...
1858    itk_component add zCutButton {
1859        Rappture::PushButton $inner.zbutton \
1860            -onimage [Rappture::icon z-cutplane] \
1861            -offimage [Rappture::icon z-cutplane] \
1862            -command [itcl::code $this AdjustSetting zcutplane] \
1863            -variable [itcl::scope _settings($this-zcutplane)]
1864    }
1865    Rappture::Tooltip::for $itk_component(zCutButton) \
1866        "Toggle the Z cut plane on/off"
1867
1868    itk_component add zCutScale {
1869        ::scale $inner.zval -from 100 -to 0 \
1870            -width 10 -orient vertical -showvalue off \
1871            -borderwidth 1 -highlightthickness 0 \
1872            -command [itcl::code $this Slice move z] \
1873            -variable [itcl::scope _settings($this-zcutposition)]
1874    } {
1875        usual
1876        ignore -borderwidth -highlightthickness
1877    }
1878    $itk_component(zCutScale) set 50
1879    $itk_component(zCutScale) configure -state disabled
1880    #$itk_component(zCutScale) configure -state disabled
1881    Rappture::Tooltip::for $itk_component(zCutScale) \
1882        "@[itcl::code $this SlicerTip z]"
1883
1884    blt::table $inner \
1885        1,1 $itk_component(xCutButton) \
1886        1,2 $itk_component(yCutButton) \
1887        1,3 $itk_component(zCutButton) \
1888        0,1 $itk_component(xCutScale) \
1889        0,2 $itk_component(yCutScale) \
1890        0,3 $itk_component(zCutScale)
1891
1892    blt::table configure $inner r0 r1 c* -resize none
1893    blt::table configure $inner r2 c4 -resize expand
1894    blt::table configure $inner c0 -width 2
1895    blt::table configure $inner c1 c2 c3 -padx 2
1896}
1897
1898itcl::body Rappture::NanovisViewer::BuildCameraTab {} {
1899    set inner [$itk_component(main) insert end \
1900        -title "Camera Settings" \
1901        -icon [Rappture::icon camera]]
1902    $inner configure -borderwidth 4
1903
1904    label $inner.view_l -text "view" -font "Arial 9"
1905    set f [frame $inner.view]
1906    foreach side { front back left right top bottom } {
1907        button $f.$side  -image [Rappture::icon view$side] \
1908            -command [itcl::code $this SetOrientation $side]
1909        Rappture::Tooltip::for $f.$side "Change the view to $side"
1910        pack $f.$side -side left
1911    }
1912
1913    blt::table $inner \
1914        0,0 $inner.view_l -anchor e -pady 2 \
1915        0,1 $inner.view -anchor w -pady 2
1916    blt::table configure $inner r0 -resize none
1917
1918    set row 1
1919    set labels { qw qx qy qz xpan ypan zoom }
1920    foreach tag $labels {
1921        label $inner.${tag}label -text $tag -font "Arial 9"
1922        entry $inner.${tag} -font "Arial 9"  -bg white \
1923            -textvariable [itcl::scope _settings($this-$tag)]
1924        bind $inner.${tag} <Return> \
1925            [itcl::code $this camera set -${tag}]
1926        bind $inner.${tag} <KP_Enter> \
1927            [itcl::code $this camera set -${tag}]
1928        blt::table $inner \
1929            $row,0 $inner.${tag}label -anchor e -pady 2 \
1930            $row,1 $inner.${tag} -anchor w -pady 2
1931        blt::table configure $inner r$row -resize none
1932        incr row
1933    }
1934
1935    blt::table configure $inner c* -resize none
1936    blt::table configure $inner c2 -resize expand
1937    blt::table configure $inner r$row -resize expand
1938}
1939
1940# ----------------------------------------------------------------------
1941# USAGE: Slice move x|y|z <newval>
1942#
1943# Called automatically when the user drags the slider to move the
1944# cut plane that slices 3D data.  Gets the current value from the
1945# slider and moves the cut plane to the appropriate point in the
1946# data set.
1947# ----------------------------------------------------------------------
1948itcl::body Rappture::NanovisViewer::Slice {option args} {
1949    switch -- $option {
1950        move {
1951            if {[llength $args] != 2} {
1952                error "wrong # args: should be \"Slice move x|y|z newval\""
1953            }
1954            set axis [lindex $args 0]
1955            set newval [lindex $args 1]
1956
1957            set newpos [expr {0.01*$newval}]
1958            set datasets [CurrentDatasets -cutplanes]
1959            set tag [lindex $datasets 0]
1960            SendCmd "cutplane position $newpos $axis $tag"
1961        }
1962        default {
1963            error "bad option \"$option\": should be axis, move, or volume"
1964        }
1965    }
1966}
1967
1968# ----------------------------------------------------------------------
1969# USAGE: SlicerTip <axis>
1970#
1971# Used internally to generate a tooltip for the x/y/z slicer controls.
1972# Returns a message that includes the current slicer value.
1973# ----------------------------------------------------------------------
1974itcl::body Rappture::NanovisViewer::SlicerTip {axis} {
1975    set val [$itk_component(${axis}CutScale) get]
1976    return "Move the [string toupper $axis] cut plane.\nCurrently:  $axis = $val%"
1977}
1978
1979
1980itcl::body Rappture::NanovisViewer::DoResize {} {
1981    $_arcball resize $_width $_height
1982    SendCmd "screen size $_width $_height"
1983    set _resizePending 0
1984}
1985
1986itcl::body Rappture::NanovisViewer::EventuallyResize { w h } {
1987    set _width $w
1988    set _height $h
1989    $_arcball resize $w $h
1990    if { !$_resizePending } {
1991        $_dispatcher event -idle !resize
1992        set _resizePending 1
1993    }
1994}
1995
1996itcl::body Rappture::NanovisViewer::EventuallyResizeLegend {} {
1997    if { !$_resizeLegendPending } {
1998        $_dispatcher event -idle !legend
1999        set _resizeLegendPending 1
2000    }
2001}
2002
2003#  camera --
2004#
2005itcl::body Rappture::NanovisViewer::camera {option args} {
2006    switch -- $option {
2007        "show" {
2008            puts [array get _view]
2009        }
2010        "set" {
2011            set what [lindex $args 0]
2012            set x $_settings(${this}${what})
2013            set code [catch { string is double $x } result]
2014            if { $code != 0 || !$result } {
2015                set _settings(${this}${what}) $_view($what)
2016                return
2017            }
2018            switch -- $what {
2019                "-xpan" - "-ypan" {
2020                    set _view($what) $_settings(${this}${what})
2021                    PanCamera
2022                }
2023                "-qx" - "-qy" - "-qz" - "-qw" {
2024                    set _view($what) $_settings(${this}${what})
2025                    set q [ViewToQuaternion]
2026                    $_arcball quaternion $q
2027                    SendCmd "camera orient $q"
2028                }
2029                "-zoom" {
2030                    set _view($what) $_settings(${this}${what})
2031                    SendCmd "camera zoom $_view($what)"
2032                }
2033            }
2034        }
2035    }
2036}
2037
2038itcl::body Rappture::NanovisViewer::GetVolumeInfo { w } {
2039    set flowobj ""
2040    foreach key [array names _obj2flow] {
2041        set flowobj $_obj2flow($key)
2042        break
2043    }
2044    if { $flowobj == "" } {
2045        return
2046    }
2047    if { [winfo exists $w.frame] } {
2048        destroy $w.frame
2049    }
2050    set inner [frame $w.frame]
2051    blt::table $w \
2052        5,0 $inner -fill both -cspan 2 -anchor nw
2053    array set hints [$dataobj hints]
2054
2055    label $inner.volumes -text "Volumes" -font "Arial 9 bold"
2056    blt::table $inner \
2057        1,0 $inner.volumes  -anchor w \
2058    blt::table configure $inner c0 c1 -resize none
2059    blt::table configure $inner c2 -resize expand
2060
2061    set row 3
2062    set volumes [get]
2063    if { [llength $volumes] > 0 } {
2064        blt::table $inner $row,0 $inner.volumes  -anchor w
2065        incr row
2066    }
2067    foreach vol $volumes {
2068        array unset info
2069        array set info $vol
2070        set name $info(name)
2071        if { ![info exists _settings($this-volume-$name)] } {
2072            set _settings($this-volume-$name) $info(hide)
2073        }
2074        checkbutton $inner.vol$row -text $info(label) \
2075            -variable [itcl::scope _settings($this-volume-$name)] \
2076            -onvalue 0 -offvalue 1 \
2077            -command [itcl::code $this ToggleVolume $key $name] \
2078            -font "Arial 9"
2079        Rappture::Tooltip::for $inner.vol$row $info(description)
2080        blt::table $inner $row,0 $inner.vol$row -anchor w
2081        if { !$_settings($this-volume-$name) } {
2082            $inner.vol$row select
2083        }
2084        incr row
2085    }
2086    blt::table configure $inner r* -resize none
2087    blt::table configure $inner r$row -resize expand
2088    blt::table configure $inner c3 -resize expand
2089    event generate [winfo parent [winfo parent $w]] <Configure>
2090}
2091
2092itcl::body Rappture::NanovisViewer::ToggleVolume { tag name } {
2093    set bool $_settings($this-volume-$name)
2094    SendCmd "volume state $bool $name"
2095}
2096
2097itcl::body Rappture::NanovisViewer::SetOrientation { side } {
2098    array set positions {
2099        front "1 0 0 0"
2100        back  "0 0 1 0"
2101        left  "0.707107 0 -0.707107 0"
2102        right "0.707107 0 0.707107 0"
2103        top   "0.707107 -0.707107 0 0"
2104        bottom "0.707107 0.707107 0 0"
2105    }
2106    foreach name { -qw -qx -qy -qz } value $positions($side) {
2107        set _view($name) $value
2108    }
2109    set q [ViewToQuaternion]
2110    $_arcball quaternion $q
2111    SendCmd "camera orient $q"
2112    SendCmd "camera reset"
2113    set _view(-xpan) 0
2114    set _view(-ypan) 0
2115    set _view(-zoom) 1.0
2116    set _settings($this-xpan) $_view(-xpan)
2117    set _settings($this-ypan) $_view(-ypan)
2118    set _settings($this-zoom) $_view(-zoom)
2119}
2120
Note: See TracBrowser for help on using the repository browser.