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

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

merge nanovis fix from 1.6 branch

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