source: trunk/gui/scripts/nanovisviewer.tcl @ 5514

Last change on this file since 5514 was 5514, checked in by ldelgass, 4 years ago

Use view settings to init widget settings

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