source: branches/1.6/gui/scripts/nanovisviewer.tcl @ 6294

Last change on this file since 6294 was 6294, checked in by gah, 8 years ago

fixes for nanovisviewer

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