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

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

more backporting in nanovis viewer

File size: 74.1 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 DrawLegend { tf }
98    private method EventuallyResize { w h }
99    private method EventuallyResizeLegend { }
100    private method FixLegend {}
101    private method GetVolumeInfo { w }
102    private method InitSettings { args }
103    private method NameTransferFunction { dataobj comp }
104    private method Pan {option x y}
105    private method PanCamera {}
106    private method ParseLevelsOption { tf levels }
107    private method ParseMarkersOption { tf markers }
108    private method QuaternionToView { q } {
109        foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break
110    }
111    private method Rebuild {}
112    private method ReceiveData { args }
113    private method ReceiveImage { args }
114    private method ReceiveLegend { tf vmin vmax size }
115    private method ResetColormap { color }
116    private method Rotate {option x y}
117    private method SendTransferFunctions {}
118    private method SetOrientation { side }
119    private method Slice {option args}
120    private method SlicerTip {axis}
121    private method ToggleVolume { tag name }
122    private method ViewToQuaternion {} {
123        return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)]
124    }
125    private method Zoom {option}
126
127    private variable _arcball ""
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 _recvdDatasets    ;# list of data objs to send to server
133    private variable _dataset2style    ;# maps dataobj-component to transfunc
134    private variable _style2datasets   ;# maps tf back to list of
135                                        # dataobj-components using the tf.
136
137    private variable _reset 1          ;# Connection to server has been reset.
138    private variable _click            ;# Info used for rotate operations.
139    private variable _limits           ;# Autoscale min/max for all axes
140    private variable _view             ;# View params for 3D view
141    private variable _isomarkers       ;# array of isosurface level values 0..1
142    private variable  _settings
143    # Array of transfer functions in server.  If 0 the transfer has been
144    # defined but not loaded.  If 1 the transfer function has been named
145    # and loaded.
146    private variable _activeTfs
147    private variable _first ""         ;# This is the topmost volume.
148
149    private common _downloadPopup      ;# download options from popup
150    private common _hardcopy
151    private variable _width 0
152    private variable _height 0
153    private variable _resizePending 0
154    private variable _resizeLegendPending 0
155}
156
157itk::usual NanovisViewer {
158    keep -background -foreground -cursor -font
159    keep -plotbackground -plotforeground
160}
161
162# ----------------------------------------------------------------------
163# CONSTRUCTOR
164# ----------------------------------------------------------------------
165itcl::body Rappture::NanovisViewer::constructor {hostlist args} {
166    set _serverType "nanovis"
167
168    # Draw legend event
169    $_dispatcher register !legend
170    $_dispatcher dispatch $this !legend "[itcl::code $this FixLegend]; list"
171
172    # Send transfer functions event
173    $_dispatcher register !send_transfunc
174    $_dispatcher dispatch $this !send_transfunc \
175        "[itcl::code $this SendTransferFunctions]; list"
176
177    # Rebuild event
178    $_dispatcher register !rebuild
179    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
180
181    # Resize event
182    $_dispatcher register !resize
183    $_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
184
185    #
186    # Populate parser with commands handle incoming requests
187    #
188    $_parser alias image [itcl::code $this ReceiveImage]
189    $_parser alias legend [itcl::code $this ReceiveLegend]
190    $_parser alias data [itcl::code $this ReceiveData]
191
192    # Initialize the view to some default parameters.
193    array set _view {
194        -qw      0.853553
195        -qx      -0.353553
196        -qy      0.353553
197        -qz      0.146447
198        -xpan    0
199        -ypan    0
200        -zoom    1.0
201    }
202    set _arcball [blt::arcball create 100 100]
203    $_arcball quaternion [ViewToQuaternion]
204
205    set _limits(vmin) 0.0
206    set _limits(vmax) 1.0
207    set _reset 1
208
209    array set _settings [subst {
210        -qw                     $_view(-qw)
211        -qx                     $_view(-qx)
212        -qy                     $_view(-qy)
213        -qz                     $_view(-qz)
214        -xpan                   $_view(-xpan)
215        -ypan                   $_view(-ypan)
216        -zoom                   $_view(-zoom)
217        $this-volume            1
218        $this-xcutplane         0
219        $this-xcutposition      0
220        $this-ycutplane         0
221        $this-ycutposition      0
222        $this-zcutplane         0
223        $this-zcutposition      0
224    }]
225
226    itk_component add 3dview {
227        label $itk_component(plotarea).view -image $_image(plot) \
228            -highlightthickness 0 -borderwidth 0
229    } {
230        usual
231        ignore -highlightthickness -borderwidth  -background
232    }
233    bind $itk_component(3dview) <Control-F1> [itcl::code $this ToggleConsole]
234
235    set f [$itk_component(main) component controls]
236    itk_component add reset {
237        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
238            -highlightthickness 0 \
239            -image [Rappture::icon reset-view] \
240            -command [itcl::code $this Zoom reset]
241    } {
242        usual
243        ignore -highlightthickness
244    }
245    pack $itk_component(reset) -side top -padx 2 -pady 2
246    Rappture::Tooltip::for $itk_component(reset) \
247        "Reset the view to the default zoom level"
248
249    itk_component add zoomin {
250        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
251            -highlightthickness 0 \
252            -image [Rappture::icon zoom-in] \
253            -command [itcl::code $this Zoom in]
254    } {
255        usual
256        ignore -highlightthickness
257    }
258    pack $itk_component(zoomin) -side top -padx 2 -pady 2
259    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
260
261    itk_component add zoomout {
262        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
263            -highlightthickness 0 \
264            -image [Rappture::icon zoom-out] \
265            -command [itcl::code $this Zoom out]
266    } {
267        usual
268        ignore -highlightthickness
269    }
270    pack $itk_component(zoomout) -side top -padx 2 -pady 2
271    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
272
273    itk_component add volume {
274        Rappture::PushButton $f.volume \
275            -onimage [Rappture::icon volume-on] \
276            -offimage [Rappture::icon volume-off] \
277            -command [itcl::code $this AdjustSetting volume] \
278            -variable [itcl::scope _settings($this-volume)]
279    }
280    $itk_component(volume) select
281    Rappture::Tooltip::for $itk_component(volume) \
282        "Toggle the volume cloud on/off"
283    pack $itk_component(volume) -padx 2 -pady 2
284
285    if { [catch {
286        BuildViewTab
287        BuildVolumeTab
288        BuildCutplanesTab
289        BuildCameraTab
290    } errs] != 0 } {
291        global errorInfo
292        puts stderr "errs=$errs errorInfo=$errorInfo"
293    }
294
295    # Legend
296    set _image(legend) [image create photo]
297    itk_component add legend {
298        canvas $itk_component(plotarea).legend -height 50 -highlightthickness 0
299    } {
300        usual
301        ignore -highlightthickness
302        rename -background -plotbackground plotBackground Background
303    }
304    bind $itk_component(legend) <Configure> \
305        [itcl::code $this EventuallyResizeLegend]
306
307    # Hack around the Tk panewindow.  The problem is that the requested
308    # size of the 3d view isn't set until an image is retrieved from
309    # the server.  So the panewindow uses the tiny size.
310    set w 10000
311    pack forget $itk_component(3dview)
312    blt::table $itk_component(plotarea) \
313        0,0 $itk_component(3dview) -fill both -reqwidth $w \
314        1,0 $itk_component(legend) -fill x
315    blt::table configure $itk_component(plotarea) r1 -resize none
316
317    # Bindings for rotation via mouse
318    bind $itk_component(3dview) <ButtonPress-1> \
319        [itcl::code $this Rotate click %x %y]
320    bind $itk_component(3dview) <B1-Motion> \
321        [itcl::code $this Rotate drag %x %y]
322    bind $itk_component(3dview) <ButtonRelease-1> \
323        [itcl::code $this Rotate release %x %y]
324    bind $itk_component(3dview) <Configure> \
325        [itcl::code $this EventuallyResize %w %h]
326
327    # Bindings for panning via mouse
328    bind $itk_component(3dview) <ButtonPress-2> \
329        [itcl::code $this Pan click %x %y]
330    bind $itk_component(3dview) <B2-Motion> \
331        [itcl::code $this Pan drag %x %y]
332    bind $itk_component(3dview) <ButtonRelease-2> \
333        [itcl::code $this Pan release %x %y]
334
335    # Bindings for panning via keyboard
336    bind $itk_component(3dview) <KeyPress-Left> \
337        [itcl::code $this Pan set -10 0]
338    bind $itk_component(3dview) <KeyPress-Right> \
339        [itcl::code $this Pan set 10 0]
340    bind $itk_component(3dview) <KeyPress-Up> \
341        [itcl::code $this Pan set 0 -10]
342    bind $itk_component(3dview) <KeyPress-Down> \
343        [itcl::code $this Pan set 0 10]
344    bind $itk_component(3dview) <Shift-KeyPress-Left> \
345        [itcl::code $this Pan set -2 0]
346    bind $itk_component(3dview) <Shift-KeyPress-Right> \
347        [itcl::code $this Pan set 2 0]
348    bind $itk_component(3dview) <Shift-KeyPress-Up> \
349        [itcl::code $this Pan set 0 -2]
350    bind $itk_component(3dview) <Shift-KeyPress-Down> \
351        [itcl::code $this Pan set 0 2]
352
353    # Bindings for zoom via keyboard
354    bind $itk_component(3dview) <KeyPress-Prior> \
355        [itcl::code $this Zoom out]
356    bind $itk_component(3dview) <KeyPress-Next> \
357        [itcl::code $this Zoom in]
358
359    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
360
361    if {[string equal "x11" [tk windowingsystem]]} {
362        # Bindings for zoom via mouse
363        bind $itk_component(3dview) <4> [itcl::code $this Zoom out]
364        bind $itk_component(3dview) <5> [itcl::code $this Zoom in]
365    }
366
367    set _image(download) [image create photo]
368
369    eval itk_initialize $args
370
371    EnableWaitDialog 900
372    Connect
373}
374
375# ----------------------------------------------------------------------
376# DESTRUCTOR
377# ----------------------------------------------------------------------
378itcl::body Rappture::NanovisViewer::destructor {} {
379    $_dispatcher cancel !rebuild
380    $_dispatcher cancel !send_transfunc
381    $_dispatcher cancel !resize
382    image delete $_image(plot)
383    image delete $_image(legend)
384    image delete $_image(download)
385    catch { blt::arcball destroy $_arcball }
386    array unset _settings $this-*
387}
388
389# ----------------------------------------------------------------------
390# USAGE: add <dataobj> ?<settings>?
391#
392# Clients use this to add a data object to the plot.  The optional
393# <settings> are used to configure the plot.  Allowed settings are
394# -color, -brightness, -width, -linestyle, and -raise.
395# ----------------------------------------------------------------------
396itcl::body Rappture::NanovisViewer::add {dataobj {settings ""}} {
397    if { ![$dataobj isvalid] } {
398        return;                         # Object doesn't contain valid data.
399    }
400    array set params {
401        -color auto
402        -width 1
403        -linestyle solid
404        -brightness 0
405        -raise 0
406        -description ""
407        -param ""
408    }
409    array set params $settings
410
411    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
412        # can't handle -autocolors yet
413        set params(-color) black
414    }
415    set pos [lsearch -exact $_dlist $dataobj]
416    if {$pos < 0} {
417        lappend _dlist $dataobj
418        set _obj2ovride($dataobj-color) $params(-color)
419        set _obj2ovride($dataobj-width) $params(-width)
420        set _obj2ovride($dataobj-raise) $params(-raise)
421        $_dispatcher event -idle !rebuild
422    }
423}
424
425# ----------------------------------------------------------------------
426# USAGE: get ?-objects?
427# USAGE: get ?-image 3dview|legend?
428#
429# Clients use this to query the list of objects being plotted, in
430# order from bottom to top of this result.  The optional "-image"
431# flag can also request the internal images being shown.
432# ----------------------------------------------------------------------
433itcl::body Rappture::NanovisViewer::get {args} {
434    if {[llength $args] == 0} {
435        set args "-objects"
436    }
437
438    set op [lindex $args 0]
439    switch -- $op {
440        -objects {
441            # put the dataobj list in order according to -raise options
442            set dlist $_dlist
443            foreach obj $dlist {
444                if {[info exists _obj2ovride($obj-raise)] &&
445                    $_obj2ovride($obj-raise)} {
446                    set i [lsearch -exact $dlist $obj]
447                    if {$i >= 0} {
448                        set dlist [lreplace $dlist $i $i]
449                        lappend dlist $obj
450                    }
451                }
452            }
453            return $dlist
454        }
455        -image {
456            if {[llength $args] != 2} {
457                error "wrong # args: should be \"get -image 3dview|legend\""
458            }
459            switch -- [lindex $args end] {
460                3dview {
461                    return $_image(plot)
462                }
463                legend {
464                    return $_image(legend)
465                }
466                default {
467                    error "bad image name \"[lindex $args end]\": should be 3dview or legend"
468                }
469            }
470        }
471        default {
472            error "bad option \"$op\": should be -objects or -image"
473        }
474    }
475}
476
477# ----------------------------------------------------------------------
478# USAGE: delete ?<dataobj1> <dataobj2> ...?
479#
480#       Clients use this to delete a dataobj from the plot.  If no dataobjs
481#       are specified, then all dataobjs are deleted.  No data objects are
482#       deleted.  They are only removed from the display list.
483#
484# ----------------------------------------------------------------------
485itcl::body Rappture::NanovisViewer::delete {args} {
486    if {[llength $args] == 0} {
487        set args $_dlist
488    }
489    # Delete all specified dataobjs
490    set changed 0
491    foreach dataobj $args {
492        set pos [lsearch -exact $_dlist $dataobj]
493        if { $pos >= 0 } {
494            set _dlist [lreplace $_dlist $pos $pos]
495            array unset _limits $dataobj*
496            array unset _obj2ovride $dataobj-*
497            set changed 1
498        }
499    }
500    # If anything changed, then rebuild the plot
501    if {$changed} {
502        $_dispatcher event -idle !rebuild
503    }
504}
505
506# ----------------------------------------------------------------------
507# USAGE: scale ?<data1> <data2> ...?
508#
509# Sets the default limits for the overall plot according to the
510# limits of the data for all of the given <data> objects.  This
511# accounts for all objects--even those not showing on the screen.
512# Because of this, the limits are appropriate for all objects as
513# the user scans through data in the ResultSet viewer.
514# ----------------------------------------------------------------------
515itcl::body Rappture::NanovisViewer::scale {args} {
516    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
517        set _limits($val) ""
518    }
519    foreach dataobj $args {
520        if { ![$dataobj isvalid] } {
521            continue;                     # Object doesn't contain valid data.
522        }
523        foreach axis {x y z v} {
524            foreach { min max } [$dataobj limits $axis] break
525            if {"" != $min && "" != $max} {
526                if {"" == $_limits(${axis}min)} {
527                    set _limits(${axis}min) $min
528                    set _limits(${axis}max) $max
529                } else {
530                    if {$min < $_limits(${axis}min)} {
531                        set _limits(${axis}min) $min
532                    }
533                    if {$max > $_limits(${axis}max)} {
534                        set _limits(${axis}max) $max
535                    }
536                }
537            }
538        }
539    }
540}
541
542# ----------------------------------------------------------------------
543# USAGE: download coming
544# USAGE: download controls <downloadCommand>
545# USAGE: download now
546#
547# Clients use this method to create a downloadable representation
548# of the plot.  Returns a list of the form {ext string}, where
549# "ext" is the file extension (indicating the type of data) and
550# "string" is the data itself.
551# ----------------------------------------------------------------------
552itcl::body Rappture::NanovisViewer::download {option args} {
553    switch $option {
554        coming {
555            if {[catch {
556                blt::winop snap $itk_component(plotarea) $_image(download)
557            }]} {
558                $_image(download) configure -width 1 -height 1
559                $_image(download) put #000000
560            }
561        }
562        controls {
563            # no controls for this download yet
564            return ""
565        }
566        now {
567            # Get the image data (as base64) and decode it back to binary.
568            # This is better than writing to temporary files.  When we switch
569            # to the BLT picture image it won't be necessary to decode the
570            # image data.
571            if { [image width $_image(plot)] > 0 &&
572                 [image height $_image(plot)] > 0 } {
573                set bytes [$_image(plot) data -format "jpeg -quality 100"]
574                set bytes [Rappture::encoding::decode -as b64 $bytes]
575                return [list .jpg $bytes]
576            }
577            return ""
578        }
579        default {
580            error "bad option \"$option\": should be coming, controls, now"
581        }
582    }
583}
584
585# ----------------------------------------------------------------------
586# USAGE: Connect ?<host:port>,<host:port>...?
587#
588# Clients use this method to establish a connection to a new
589# server, or to reestablish a connection to the previous server.
590# Any existing connection is automatically closed.
591# ----------------------------------------------------------------------
592itcl::body Rappture::NanovisViewer::Connect {} {
593    set _hosts [GetServerList "nanovis"]
594    if { "" == $_hosts } {
595        return 0
596    }
597    set _reset 1
598    set result [VisViewer::Connect $_hosts]
599    if { $result } {
600        if { $_reportClientInfo }  {
601            # Tell the server the viewer, hub, user and session.
602            # Do this immediately on connect before buffering any commands
603            global env
604
605            set info {}
606            set user "???"
607            if { [info exists env(USER)] } {
608                set user $env(USER)
609            }
610            set session "???"
611            if { [info exists env(SESSION)] } {
612                set session $env(SESSION)
613            }
614            lappend info "version" "$Rappture::version"
615            lappend info "build" "$Rappture::build"
616            lappend info "svnurl" "$Rappture::svnurl"
617            lappend info "installdir" "$Rappture::installdir"
618            lappend info "hub" [exec hostname]
619            lappend info "client" "nanovisviewer"
620            lappend info "user" $user
621            lappend info "session" $session
622            SendCmd "clientinfo [list $info]"
623        }
624
625        set w [winfo width $itk_component(3dview)]
626        set h [winfo height $itk_component(3dview)]
627        EventuallyResize $w $h
628    }
629    return $result
630}
631
632#
633# isconnected --
634#
635#       Indicates if we are currently connected to the visualization server.
636#
637itcl::body Rappture::NanovisViewer::isconnected {} {
638    return [VisViewer::IsConnected]
639}
640
641#
642# disconnect --
643#
644itcl::body Rappture::NanovisViewer::disconnect {} {
645    Disconnect
646}
647
648#
649# Disconnect --
650#
651#       Clients use this method to disconnect from the current rendering
652#       server.
653#
654itcl::body Rappture::NanovisViewer::Disconnect {} {
655    VisViewer::Disconnect
656
657    # disconnected -- no more data sitting on server
658    array unset _serverDatasets
659}
660
661# ----------------------------------------------------------------------
662# USAGE: SendTransferFunctions
663# ----------------------------------------------------------------------
664itcl::body Rappture::NanovisViewer::SendTransferFunctions {} {
665    if { $_first == "" } {
666        puts stderr "first not set"
667        return
668    }
669    # Ensure that the global opacity and thickness settings (in the slider
670    # settings widgets) are used for the active transfer-function.  Update
671    # the values in the _settings varible.
672    set opacity [expr { double($_settings($this-opacity)) * 0.01 }]
673    # Scale values between 0.00001 and 0.01000
674    set thickness [expr {double($_settings($this-thickness)) * 0.0001}]
675
676    foreach tag [CurrentDatasets] {
677        if { ![info exists _serverDatasets($tag)] || !$_serverDatasets($tag) } {
678            # The volume hasn't reached the server yet.  How did we get
679            # here?
680            puts stderr "Don't have $tag in _serverDatasets"
681            continue
682        }
683        if { ![info exists _dataset2style($tag)] } {
684            puts stderr "don't have style for volume $tag"
685            continue;                        # How does this happen?
686        }
687        set tf $_dataset2style($tag)
688        set _settings($this-$tf-opacity) $opacity
689        set _settings($this-$tf-thickness) $thickness
690        ComputeTransferFunction $tf
691        # FIXME: Need to the send information as to what transfer functions
692        #        to update so that we only update the transfer function
693        #        as necessary.  Right now, all transfer functions are
694        #        updated. This makes moving the isomarker slider chunky.
695        if { ![info exists _activeTfs($tf)] || !$_activeTfs($tf) } {
696            set _activeTfs($tf) 1
697        }
698        SendCmd "volume shading transfunc $tf $tag"
699    }
700    FixLegend
701}
702
703# ----------------------------------------------------------------------
704# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
705#
706# Invoked automatically whenever the "image" command comes in from
707# the rendering server.  Indicates that binary image data with the
708# specified <size> will follow.
709# ----------------------------------------------------------------------
710itcl::body Rappture::NanovisViewer::ReceiveImage { args } {
711    array set info {
712        -token "???"
713        -bytes 0
714        -type image
715    }
716    array set info $args
717    set bytes [ReceiveBytes $info(-bytes)]
718    ReceiveEcho <<line "<read $info(-bytes) bytes"
719    if { $info(-type) == "image" } {
720        ReceiveEcho "for [image width $_image(plot)]x[image height $_image(plot)] image>"
721        $_image(plot) configure -data $bytes
722    } elseif { $info(-type) == "print" } {
723        set tag $this-print-$info(-token)
724        set _hardcopy($tag) $bytes
725    }
726}
727
728#
729# DrawLegend --
730#
731itcl::body Rappture::NanovisViewer::DrawLegend { tf } {
732    set c $itk_component(legend)
733    set w [winfo width $c]
734    set h [winfo height $c]
735    set lx 10
736    set ly [expr {$h - 1}]
737    if {"" == [$c find withtag colorbar]} {
738        $c create image 10 10 -anchor nw \
739            -image $_image(legend) -tags colorbar
740        $c create text $lx $ly -anchor sw \
741            -fill $itk_option(-plotforeground) -tags "limits vmin"
742        $c create text [expr {$w-$lx}] $ly -anchor se \
743            -fill $itk_option(-plotforeground) -tags "limits vmax"
744        $c lower colorbar
745        $c bind colorbar <ButtonRelease-1> [itcl::code $this AddIsoMarker %x %y]
746    }
747
748    # Display the markers used by the current transfer function.
749    array set limits [limits $tf]
750    $c itemconfigure vmin -text [format %g $limits(min)]
751    $c coords vmin $lx $ly
752
753    $c itemconfigure vmax -text [format %g $limits(max)]
754    $c coords vmax [expr {$w-$lx}] $ly
755
756    if { [info exists _isomarkers($tf)] } {
757        foreach m $_isomarkers($tf) {
758            $m visible yes
759        }
760    }
761
762    # The colormap may have changed. Resync the slicers with the colormap.
763    set datasets [CurrentDatasets -cutplanes]
764    SendCmd "volume data state $_settings($this-volume) $datasets"
765
766    # Adjust the cutplane for only the first component in the topmost volume
767    # (i.e. the first volume designated in the field).
768    set tag [lindex $datasets 0]
769    foreach axis {x y z} {
770        # Turn off cutplanes for all volumes
771        SendCmd "cutplane state 0 $axis"
772        if { $_settings($this-${axis}cutplane) } {
773            # Turn on cutplane for this particular volume and set the position
774            SendCmd "cutplane state 1 $axis $tag"
775            set pos [expr {0.01*$_settings($this-${axis}cutposition)}]
776            SendCmd "cutplane position $pos $axis $tag"
777        }
778    }
779}
780
781#
782# ReceiveLegend --
783#
784#       The procedure is the response from the render server to each "legend"
785#       command.  The server sends back a "legend" command invoked our
786#       the slave interpreter.  The purpose is to collect data of the image
787#       representing the legend in the canvas.  In addition, the
788#       active transfer function is displayed.
789#
790itcl::body Rappture::NanovisViewer::ReceiveLegend { tf vmin vmax size } {
791    if { ![isconnected] } {
792        return
793    }
794    set bytes [ReceiveBytes $size]
795    $_image(legend) configure -data $bytes
796    ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
797
798    DrawLegend $tf
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(-qw)    $_view(-qw)
938        set _settings(-qx)    $_view(-qx)
939        set _settings(-qy)    $_view(-qy)
940        set _settings(-qz)    $_view(-qz)
941        set _settings(-xpan)  $_view(-xpan)
942        set _settings(-ypan)  $_view(-ypan)
943        set _settings(-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(-zoom) $_view(-zoom)
1032            SendCmd "camera zoom $_view(-zoom)"
1033        }
1034        "out" {
1035            set _view(-zoom) [expr {$_view(-zoom)*0.8}]
1036            set _settings(-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(-qw)    $_view(-qw)
1060            set _settings(-qx)    $_view(-qx)
1061            set _settings(-qy)    $_view(-qy)
1062            set _settings(-qz)    $_view(-qz)
1063            set _settings(-xpan)  $_view(-xpan)
1064            set _settings(-ypan)  $_view(-ypan)
1065            set _settings(-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(-qw) $_view(-qw)
1112                set _settings(-qx) $_view(-qx)
1113                set _settings(-qy) $_view(-qy)
1114                set _settings(-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(-xpan) $_view(-xpan)
1151        set _settings(-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(-xpan) $_view(-xpan)
1168        set _settings(-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    Rappture::Tooltip::for $itk_component(zCutScale) \
1881        "@[itcl::code $this SlicerTip z]"
1882
1883    blt::table $inner \
1884        1,1 $itk_component(xCutButton) \
1885        1,2 $itk_component(yCutButton) \
1886        1,3 $itk_component(zCutButton) \
1887        0,1 $itk_component(xCutScale) \
1888        0,2 $itk_component(yCutScale) \
1889        0,3 $itk_component(zCutScale)
1890
1891    blt::table configure $inner r0 r1 c* -resize none
1892    blt::table configure $inner r2 c4 -resize expand
1893    blt::table configure $inner c0 -width 2
1894    blt::table configure $inner c1 c2 c3 -padx 2
1895}
1896
1897itcl::body Rappture::NanovisViewer::BuildCameraTab {} {
1898    set inner [$itk_component(main) insert end \
1899        -title "Camera Settings" \
1900        -icon [Rappture::icon camera]]
1901    $inner configure -borderwidth 4
1902
1903    label $inner.view_l -text "view" -font "Arial 9"
1904    set f [frame $inner.view]
1905    foreach side { front back left right top bottom } {
1906        button $f.$side  -image [Rappture::icon view$side] \
1907            -command [itcl::code $this SetOrientation $side]
1908        Rappture::Tooltip::for $f.$side "Change the view to $side"
1909        pack $f.$side -side left
1910    }
1911
1912    blt::table $inner \
1913        0,0 $inner.view_l -anchor e -pady 2 \
1914        0,1 $inner.view -anchor w -pady 2
1915    blt::table configure $inner r0 -resize none
1916
1917    set row 1
1918    set labels { qw qx qy qz xpan ypan zoom }
1919    foreach tag $labels {
1920        label $inner.${tag}label -text $tag -font "Arial 9"
1921        entry $inner.${tag} -font "Arial 9"  -bg white \
1922            -textvariable [itcl::scope _settings(-$tag)]
1923        bind $inner.${tag} <Return> \
1924            [itcl::code $this camera set -${tag}]
1925        bind $inner.${tag} <KP_Enter> \
1926            [itcl::code $this camera set -${tag}]
1927        blt::table $inner \
1928            $row,0 $inner.${tag}label -anchor e -pady 2 \
1929            $row,1 $inner.${tag} -anchor w -pady 2
1930        blt::table configure $inner r$row -resize none
1931        incr row
1932    }
1933
1934    blt::table configure $inner c* -resize none
1935    blt::table configure $inner c2 -resize expand
1936    blt::table configure $inner r$row -resize expand
1937}
1938
1939# ----------------------------------------------------------------------
1940# USAGE: Slice move x|y|z <newval>
1941#
1942# Called automatically when the user drags the slider to move the
1943# cut plane that slices 3D data.  Gets the current value from the
1944# slider and moves the cut plane to the appropriate point in the
1945# data set.
1946# ----------------------------------------------------------------------
1947itcl::body Rappture::NanovisViewer::Slice {option args} {
1948    switch -- $option {
1949        move {
1950            if {[llength $args] != 2} {
1951                error "wrong # args: should be \"Slice move x|y|z newval\""
1952            }
1953            set axis [lindex $args 0]
1954            set newval [lindex $args 1]
1955
1956            set newpos [expr {0.01*$newval}]
1957            set datasets [CurrentDatasets -cutplanes]
1958            set tag [lindex $datasets 0]
1959            SendCmd "cutplane position $newpos $axis $tag"
1960        }
1961        default {
1962            error "bad option \"$option\": should be axis, move, or volume"
1963        }
1964    }
1965}
1966
1967# ----------------------------------------------------------------------
1968# USAGE: SlicerTip <axis>
1969#
1970# Used internally to generate a tooltip for the x/y/z slicer controls.
1971# Returns a message that includes the current slicer value.
1972# ----------------------------------------------------------------------
1973itcl::body Rappture::NanovisViewer::SlicerTip {axis} {
1974    set val [$itk_component(${axis}CutScale) get]
1975    return "Move the [string toupper $axis] cut plane.\nCurrently:  $axis = $val%"
1976}
1977
1978
1979itcl::body Rappture::NanovisViewer::DoResize {} {
1980    $_arcball resize $_width $_height
1981    SendCmd "screen size $_width $_height"
1982    set _resizePending 0
1983}
1984
1985itcl::body Rappture::NanovisViewer::EventuallyResize { w h } {
1986    set _width $w
1987    set _height $h
1988    $_arcball resize $w $h
1989    if { !$_resizePending } {
1990        $_dispatcher event -idle !resize
1991        set _resizePending 1
1992    }
1993}
1994
1995itcl::body Rappture::NanovisViewer::EventuallyResizeLegend {} {
1996    if { !$_resizeLegendPending } {
1997        $_dispatcher event -idle !legend
1998        set _resizeLegendPending 1
1999    }
2000}
2001
2002#  camera --
2003#
2004itcl::body Rappture::NanovisViewer::camera {option args} {
2005    switch -- $option {
2006        "show" {
2007            puts [array get _view]
2008        }
2009        "set" {
2010            set what [lindex $args 0]
2011            set x $_settings($what)
2012            set code [catch { string is double $x } result]
2013            if { $code != 0 || !$result } {
2014                set _settings($what) $_view($what)
2015                return
2016            }
2017            switch -- $what {
2018                "-xpan" - "-ypan" {
2019                    set _view($what) $_settings($what)
2020                    PanCamera
2021                }
2022                "-qx" - "-qy" - "-qz" - "-qw" {
2023                    set _view($what) $_settings($what)
2024                    set q [ViewToQuaternion]
2025                    $_arcball quaternion $q
2026                    SendCmd "camera orient $q"
2027                }
2028                "-zoom" {
2029                    set _view($what) $_settings($what)
2030                    SendCmd "camera zoom $_view($what)"
2031                }
2032            }
2033        }
2034    }
2035}
2036
2037itcl::body Rappture::NanovisViewer::GetVolumeInfo { w } {
2038    set flowobj ""
2039    foreach key [array names _obj2flow] {
2040        set flowobj $_obj2flow($key)
2041        break
2042    }
2043    if { $flowobj == "" } {
2044        return
2045    }
2046    if { [winfo exists $w.frame] } {
2047        destroy $w.frame
2048    }
2049    set inner [frame $w.frame]
2050    blt::table $w \
2051        5,0 $inner -fill both -cspan 2 -anchor nw
2052    array set hints [$dataobj hints]
2053
2054    label $inner.volumes -text "Volumes" -font "Arial 9 bold"
2055    blt::table $inner \
2056        1,0 $inner.volumes  -anchor w \
2057    blt::table configure $inner c0 c1 -resize none
2058    blt::table configure $inner c2 -resize expand
2059
2060    set row 3
2061    set volumes [get]
2062    if { [llength $volumes] > 0 } {
2063        blt::table $inner $row,0 $inner.volumes  -anchor w
2064        incr row
2065    }
2066    foreach vol $volumes {
2067        array unset info
2068        array set info $vol
2069        set name $info(name)
2070        if { ![info exists _settings($this-volume-$name)] } {
2071            set _settings($this-volume-$name) $info(hide)
2072        }
2073        checkbutton $inner.vol$row -text $info(label) \
2074            -variable [itcl::scope _settings($this-volume-$name)] \
2075            -onvalue 0 -offvalue 1 \
2076            -command [itcl::code $this ToggleVolume $key $name] \
2077            -font "Arial 9"
2078        Rappture::Tooltip::for $inner.vol$row $info(description)
2079        blt::table $inner $row,0 $inner.vol$row -anchor w
2080        if { !$_settings($this-volume-$name) } {
2081            $inner.vol$row select
2082        }
2083        incr row
2084    }
2085    blt::table configure $inner r* -resize none
2086    blt::table configure $inner r$row -resize expand
2087    blt::table configure $inner c3 -resize expand
2088    event generate [winfo parent [winfo parent $w]] <Configure>
2089}
2090
2091itcl::body Rappture::NanovisViewer::ToggleVolume { tag name } {
2092    set bool $_settings($this-volume-$name)
2093    SendCmd "volume state $bool $name"
2094}
2095
2096itcl::body Rappture::NanovisViewer::SetOrientation { side } {
2097    array set positions {
2098        front "1 0 0 0"
2099        back  "0 0 1 0"
2100        left  "0.707107 0 -0.707107 0"
2101        right "0.707107 0 0.707107 0"
2102        top   "0.707107 -0.707107 0 0"
2103        bottom "0.707107 0.707107 0 0"
2104    }
2105    foreach name { -qw -qx -qy -qz } value $positions($side) {
2106        set _view($name) $value
2107    }
2108    set q [ViewToQuaternion]
2109    $_arcball quaternion $q
2110    SendCmd "camera orient $q"
2111    SendCmd "camera reset"
2112    set _view(-xpan) 0
2113    set _view(-ypan) 0
2114    set _view(-zoom) 1.0
2115    set _settings(-xpan) $_view(-xpan)
2116    set _settings(-ypan) $_view(-ypan)
2117    set _settings(-zoom) $_view(-zoom)
2118}
Note: See TracBrowser for help on using the repository browser.