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

Last change on this file since 6363 was 6363, checked in by ldelgass, 8 years ago

merge viewer fixes from trunk

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