source: branches/1.7/gui/scripts/nanovisviewer.tcl @ 6306

Last change on this file since 6306 was 6306, checked in by ldelgass, 6 years ago

merge fixes from trunk

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