source: branches/1.3/gui/scripts/vtkvolumeviewer.tcl @ 4768

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

merge r4767 from trunk

File size: 81.4 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: vtkvolumeviewer - Vtk volume viewer
4#
5#  It connects to the Vtk server running on a rendering farm,
6#  transmits data, and displays the results.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2014  HUBzero Foundation, LLC
10#
11#  See the file "license.terms" for information on usage and
12#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13# ======================================================================
14package require Itk
15package require BLT
16#package require Img
17
18option add *VtkVolumeViewer.width 4i widgetDefault
19option add *VtkVolumeViewer*cursor crosshair widgetDefault
20option add *VtkVolumeViewer.height 4i widgetDefault
21option add *VtkVolumeViewer.foreground black widgetDefault
22option add *VtkVolumeViewer.controlBackground gray widgetDefault
23option add *VtkVolumeViewer.controlDarkBackground #999999 widgetDefault
24option add *VtkVolumeViewer.plotBackground black widgetDefault
25option add *VtkVolumeViewer.plotForeground white widgetDefault
26option add *VtkVolumeViewer.font \
27    -*-helvetica-medium-r-normal-*-12-* widgetDefault
28
29# must use this name -- plugs into Rappture::resources::load
30proc VtkVolumeViewer_init_resources {} {
31    Rappture::resources::register \
32        vtkvis_server Rappture::VtkVolumeViewer::SetServerList
33}
34
35itcl::class Rappture::VtkVolumeViewer {
36    inherit Rappture::VisViewer
37
38    itk_option define -plotforeground plotForeground Foreground ""
39    itk_option define -plotbackground plotBackground Background ""
40
41    constructor { hostlist args } {
42        Rappture::VisViewer::constructor $hostlist
43    } {
44        # defined below
45    }
46    destructor {
47        # defined below
48    }
49    public proc SetServerList { namelist } {
50        Rappture::VisViewer::SetServerList "vtkvis" $namelist
51    }
52    public method add {dataobj {settings ""}}
53    public method camera {option args}
54    public method delete {args}
55    public method disconnect {}
56    public method download {option args}
57    public method get {args}
58    public method isconnected {}
59    public method parameters {title args} {
60        # do nothing
61    }
62    public method scale {args}
63
64    # The following methods are only used by this class.
65    private method AdjustSetting {what {value ""}}
66    private method BuildAxisTab {}
67    private method BuildCameraTab {}
68    private method BuildColormap { name colors }
69    private method BuildCutplaneTab {}
70    private method BuildDownloadPopup { widget command }
71    private method BuildViewTab {}
72    private method BuildVolumeTab {}
73    private method DrawLegend {}
74    private method ChangeColormap { dataobj comp color }
75    private method Combo { option }
76    private method Connect {}
77    private method CurrentDatasets {args}
78    private method Disconnect {}
79    private method DoResize {}
80    private method DoRotate {}
81    private method EnterLegend { x y }
82    private method EventuallyResize { w h }
83    private method EventuallyRequestLegend {}
84    private method EventuallyRotate { q }
85    private method EventuallySetCutplane { axis args }
86    private method GetImage { args }
87    private method GetVtkData { args }
88    private method InitSettings { args  }
89    private method IsValidObject { dataobj }
90    private method LeaveLegend {}
91    private method MotionLegend { x y }
92    private method Pan {option x y}
93    private method PanCamera {}
94    private method Pick {x y}
95    private method QuaternionToView { q } {
96        foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break
97    }
98    private method Rebuild {}
99    private method ReceiveDataset { args }
100    private method ReceiveImage { args }
101    private method ReceiveLegend { colormap title vmin vmax size }
102    private method RequestLegend {}
103    private method SetColormap { dataobj comp }
104    private method Rotate {option x y}
105    private method SetLegendTip { x y }
106    private method SetObjectStyle { dataobj comp }
107    private method SetOrientation { side }
108    private method Slice {option args}
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 _obj2datasets
117    private variable _obj2ovride   ;    # maps dataobj => style override
118    private variable _datasets     ;    # contains all the dataobj-component
119                                   ;    # datasets in the server
120    private variable _colormaps    ;    # contains all the colormaps
121                                   ;    # in the server.
122    private variable _dataset2style    ;# maps dataobj-component to transfunc
123
124    private variable _click        ;    # info used for rotate operations
125    private variable _limits       ;    # autoscale min/max for all axes
126    private variable _view         ;    # view params for 3D view
127    private variable _settings
128    private variable _style;            # Array of current component styles.
129    private variable _initialStyle;     # Array of initial component styles.
130    private variable _reset 1;          # indicates if camera needs to be reset
131                                        # to starting position.
132
133    private variable _first ""     ;    # This is the topmost dataset.
134    private variable _start 0
135    private variable _title ""
136
137    common _downloadPopup;              # download options from popup
138    private common _hardcopy
139    private variable _width 0
140    private variable _height 0
141    private variable _resizePending 0
142    private variable _rotatePending 0
143    private variable _cutplanePending 0
144    private variable _legendPending 0
145    private variable _fields
146    private variable _curFldName ""
147    private variable _curFldLabel ""
148    private variable _colorMode "vmag";#  Mode of colormap (vmag or scalar)
149    private variable _cutplaneCmd "cutplane"
150}
151
152itk::usual VtkVolumeViewer {
153    keep -background -foreground -cursor -font
154    keep -plotbackground -plotforeground
155}
156
157# ----------------------------------------------------------------------
158# CONSTRUCTOR
159# ----------------------------------------------------------------------
160itcl::body Rappture::VtkVolumeViewer::constructor {hostlist args} {
161    package require vtk
162    set _serverType "vtkvis"
163
164    EnableWaitDialog 900
165
166    # Rebuild event
167    $_dispatcher register !rebuild
168    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
169
170    # Resize event
171    $_dispatcher register !resize
172    $_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
173
174    # Rotate event
175    $_dispatcher register !rotate
176    $_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
177
178    # Legend event
179    $_dispatcher register !legend
180    $_dispatcher dispatch $this !legend "[itcl::code $this RequestLegend]; list"
181
182    # X-Cutplane event
183    $_dispatcher register !xcutplane
184    $_dispatcher dispatch $this !xcutplane \
185        "[itcl::code $this AdjustSetting -xcutplaneposition]; list"
186
187    # Y-Cutplane event
188    $_dispatcher register !ycutplane
189    $_dispatcher dispatch $this !ycutplane \
190        "[itcl::code $this AdjustSetting -ycutplaneposition]; list"
191
192    # Z-Cutplane event
193    $_dispatcher register !zcutplane
194    $_dispatcher dispatch $this !zcutplane \
195        "[itcl::code $this AdjustSetting -zcutplaneposition]; list"
196
197    #
198    # Populate parser with commands handle incoming requests
199    #
200    $_parser alias image [itcl::code $this ReceiveImage]
201    $_parser alias dataset [itcl::code $this ReceiveDataset]
202    $_parser alias legend [itcl::code $this ReceiveLegend]
203
204    # Initialize the view to some default parameters.
205    array set _view {
206        -ortho           0
207        -qw              0.853553
208        -qx              -0.353553
209        -qy              0.353553
210        -qz              0.146447
211        -xpan            0
212        -ypan            0
213        -zoom            1.0
214    }
215    set _arcball [blt::arcball create 100 100]
216    $_arcball quaternion [ViewToQuaternion]
217
218    array set _settings {
219        -axesvisible                    1
220        -axisflymode                    static
221        -axislabels                     1
222        -axisminorticks                 1
223        -background                     black
224        -cutplanelighting               1
225        -cutplaneopacity                100
226        -cutplanesvisible               0
227        -legendvisible                  1
228        -volumelighting                 1
229        -volumematerial                 80
230        -volumeopacity                  50
231        -volumeoutline                  0
232        -volumequality                  80
233        -volumevisible                  1
234        -xcutplaneposition              50
235        -xcutplanevisible               1
236        -xgrid                          0
237        -ycutplaneposition              50
238        -ycutplanevisible               1
239        -ygrid                          0
240        -zcutplaneposition              50
241        -zcutplanevisible               1
242        -zgrid                          0
243    }
244
245    itk_component add view {
246        canvas $itk_component(plotarea).view \
247            -highlightthickness 0 -borderwidth 0
248    } {
249        usual
250        ignore -highlightthickness -borderwidth  -background
251    }
252
253    itk_component add fieldmenu {
254        menu $itk_component(plotarea).menu -bg black -fg white -relief flat \
255            -tearoff no
256    } {
257        usual
258        ignore -background -foreground -relief -tearoff
259    }
260    set c $itk_component(view)
261    bind $c <Configure> [itcl::code $this EventuallyResize %w %h]
262    bind $c <4> [itcl::code $this Zoom in 0.25]
263    bind $c <5> [itcl::code $this Zoom out 0.25]
264    bind $c <KeyPress-Left>  [list %W xview scroll 10 units]
265    bind $c <KeyPress-Right> [list %W xview scroll -10 units]
266    bind $c <KeyPress-Up>    [list %W yview scroll 10 units]
267    bind $c <KeyPress-Down>  [list %W yview scroll -10 units]
268    bind $c <Enter> "focus %W"
269    bind $c <Control-F1> [itcl::code $this ToggleConsole]
270
271    # Fixes the scrollregion in case we go off screen
272    $c configure -scrollregion [$c bbox all]
273
274    set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
275    set _map(cwidth) -1
276    set _map(cheight) -1
277    set _map(zoom) 1.0
278    set _map(original) ""
279
280    set f [$itk_component(main) component controls]
281    itk_component add reset {
282        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
283            -highlightthickness 0 \
284            -image [Rappture::icon reset-view] \
285            -command [itcl::code $this Zoom reset]
286    } {
287        usual
288        ignore -highlightthickness
289    }
290    pack $itk_component(reset) -side top -padx 2 -pady 2
291    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
292
293    itk_component add zoomin {
294        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
295            -highlightthickness 0 \
296            -image [Rappture::icon zoom-in] \
297            -command [itcl::code $this Zoom in]
298    } {
299        usual
300        ignore -highlightthickness
301    }
302    pack $itk_component(zoomin) -side top -padx 2 -pady 2
303    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
304
305    itk_component add zoomout {
306        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
307            -highlightthickness 0 \
308            -image [Rappture::icon zoom-out] \
309            -command [itcl::code $this Zoom out]
310    } {
311        usual
312        ignore -highlightthickness
313    }
314    pack $itk_component(zoomout) -side top -padx 2 -pady 2
315    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
316
317    itk_component add volume {
318        Rappture::PushButton $f.volume \
319            -onimage [Rappture::icon volume-on] \
320            -offimage [Rappture::icon volume-off] \
321            -variable [itcl::scope _settings(-volumevisible)] \
322            -command [itcl::code $this AdjustSetting -volumevisible]
323    }
324    $itk_component(volume) select
325    Rappture::Tooltip::for $itk_component(volume) \
326        "Don't display the volume"
327    pack $itk_component(volume) -padx 2 -pady 2
328
329    itk_component add cutplane {
330        Rappture::PushButton $f.cutplane \
331            -onimage [Rappture::icon cutbutton] \
332            -offimage [Rappture::icon cutbutton] \
333            -variable [itcl::scope _settings(-cutplanesvisible)] \
334            -command [itcl::code $this AdjustSetting -cutplanesvisible]
335    }
336    Rappture::Tooltip::for $itk_component(cutplane) \
337        "Show/Hide cutplanes"
338    pack $itk_component(cutplane) -padx 2 -pady 2
339
340
341    if { [catch {
342        BuildViewTab
343        BuildVolumeTab
344        BuildCutplaneTab
345        BuildAxisTab
346        BuildCameraTab
347    } errs] != 0 } {
348        puts stderr errs=$errs
349    }
350
351    # Legend
352    set _image(legend) [image create photo]
353    itk_component add legend {
354        canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0
355    } {
356        usual
357        ignore -highlightthickness
358        rename -background -plotbackground plotBackground Background
359    }
360
361    # Hack around the Tk panewindow.  The problem is that the requested
362    # size of the 3d view isn't set until an image is retrieved from
363    # the server.  So the panewindow uses the tiny size.
364    set w 10000
365    pack forget $itk_component(view)
366    blt::table $itk_component(plotarea) \
367        0,0 $itk_component(view) -fill both -reqwidth $w
368    blt::table configure $itk_component(plotarea) c1 -resize none
369
370    # Bindings for rotation via mouse
371    bind $itk_component(view) <ButtonPress-1> \
372        [itcl::code $this Rotate click %x %y]
373    bind $itk_component(view) <B1-Motion> \
374        [itcl::code $this Rotate drag %x %y]
375    bind $itk_component(view) <ButtonRelease-1> \
376        [itcl::code $this Rotate release %x %y]
377
378    # Bindings for panning via mouse
379    bind $itk_component(view) <ButtonPress-2> \
380        [itcl::code $this Pan click %x %y]
381    bind $itk_component(view) <B2-Motion> \
382        [itcl::code $this Pan drag %x %y]
383    bind $itk_component(view) <ButtonRelease-2> \
384        [itcl::code $this Pan release %x %y]
385
386    #bind $itk_component(view) <ButtonRelease-3> \
387    #    [itcl::code $this Pick %x %y]
388
389    # Bindings for panning via keyboard
390    bind $itk_component(view) <KeyPress-Left> \
391        [itcl::code $this Pan set -10 0]
392    bind $itk_component(view) <KeyPress-Right> \
393        [itcl::code $this Pan set 10 0]
394    bind $itk_component(view) <KeyPress-Up> \
395        [itcl::code $this Pan set 0 -10]
396    bind $itk_component(view) <KeyPress-Down> \
397        [itcl::code $this Pan set 0 10]
398    bind $itk_component(view) <Shift-KeyPress-Left> \
399        [itcl::code $this Pan set -2 0]
400    bind $itk_component(view) <Shift-KeyPress-Right> \
401        [itcl::code $this Pan set 2 0]
402    bind $itk_component(view) <Shift-KeyPress-Up> \
403        [itcl::code $this Pan set 0 -2]
404    bind $itk_component(view) <Shift-KeyPress-Down> \
405        [itcl::code $this Pan set 0 2]
406
407    # Bindings for zoom via keyboard
408    bind $itk_component(view) <KeyPress-Prior> \
409        [itcl::code $this Zoom out]
410    bind $itk_component(view) <KeyPress-Next> \
411        [itcl::code $this Zoom in]
412
413    bind $itk_component(view) <Enter> "focus $itk_component(view)"
414
415    if {[string equal "x11" [tk windowingsystem]]} {
416        # Bindings for zoom via mouse
417        bind $itk_component(view) <4> [itcl::code $this Zoom out]
418        bind $itk_component(view) <5> [itcl::code $this Zoom in]
419    }
420
421    set _image(download) [image create photo]
422
423    eval itk_initialize $args
424    Connect
425}
426
427# ----------------------------------------------------------------------
428# DESTRUCTOR
429# ----------------------------------------------------------------------
430itcl::body Rappture::VtkVolumeViewer::destructor {} {
431    Disconnect
432    image delete $_image(plot)
433    image delete $_image(download)
434    catch { blt::arcball destroy $_arcball }
435}
436
437itcl::body Rappture::VtkVolumeViewer::DoResize {} {
438    if { $_width < 2 } {
439        set _width 500
440    }
441    if { $_height < 2 } {
442        set _height 500
443    }
444    set _start [clock clicks -milliseconds]
445    SendCmd "screen size $_width $_height"
446
447    set _legendPending 1
448    set _resizePending 0
449}
450
451itcl::body Rappture::VtkVolumeViewer::DoRotate {} {
452    SendCmd "camera orient [ViewToQuaternion]"
453    set _rotatePending 0
454}
455
456itcl::body Rappture::VtkVolumeViewer::EventuallyResize { w h } {
457    set _width $w
458    set _height $h
459    $_arcball resize $w $h
460    if { !$_resizePending } {
461        set _resizePending 1
462        $_dispatcher event -after 400 !resize
463    }
464}
465
466itcl::body Rappture::VtkVolumeViewer::EventuallyRequestLegend {} {
467    if { !$_legendPending } {
468        set _legendPending 1
469        $_dispatcher event -idle !legend
470    }
471}
472
473set rotate_delay 100
474
475itcl::body Rappture::VtkVolumeViewer::EventuallyRotate { q } {
476    QuaternionToView $q
477    if { !$_rotatePending } {
478        set _rotatePending 1
479        global rotate_delay
480        $_dispatcher event -after $rotate_delay !rotate
481    }
482}
483
484itcl::body Rappture::VtkVolumeViewer::EventuallySetCutplane { axis args } {
485    if { !$_cutplanePending } {
486        set _cutplanePending 1
487        $_dispatcher event -after 100 !${axis}cutplane
488    }
489}
490
491# ----------------------------------------------------------------------
492# USAGE: add <dataobj> ?<settings>?
493#
494# Clients use this to add a data object to the plot.  The optional
495# <settings> are used to configure the plot.  Allowed settings are
496# -color, -brightness, -width, -linestyle, and -raise.
497# ----------------------------------------------------------------------
498itcl::body Rappture::VtkVolumeViewer::add {dataobj {settings ""}} {
499    if { ![IsValidObject $dataobj] } {
500        return;                         # Ignore invalid objects.
501    }
502    array set params {
503        -color auto
504        -width 1
505        -linestyle solid
506        -brightness 0
507        -raise 0
508        -description ""
509        -param ""
510        -type ""
511    }
512    array set params $settings
513    set params(-description) ""
514    set params(-param) ""
515    array set params $settings
516
517    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
518        # can't handle -autocolors yet
519        set params(-color) black
520    }
521    set pos [lsearch -exact $_dlist $dataobj]
522    if {$pos < 0} {
523        lappend _dlist $dataobj
524    }
525    set _obj2ovride($dataobj-color) $params(-color)
526    set _obj2ovride($dataobj-width) $params(-width)
527    set _obj2ovride($dataobj-raise) $params(-raise)
528    $_dispatcher event -idle !rebuild
529}
530
531
532# ----------------------------------------------------------------------
533# USAGE: delete ?<dataobj1> <dataobj2> ...?
534#
535#       Clients use this to delete a dataobj from the plot.  If no dataobjs
536#       are specified, then all dataobjs are deleted.  No data objects are
537#       deleted.  They are only removed from the display list.
538#
539# ----------------------------------------------------------------------
540itcl::body Rappture::VtkVolumeViewer::delete {args} {
541    if { [llength $args] == 0} {
542        set args $_dlist
543    }
544    # Delete all specified dataobjs
545    set changed 0
546    foreach dataobj $args {
547        set pos [lsearch -exact $_dlist $dataobj]
548        if { $pos < 0 } {
549            continue;                   # Don't know anything about it.
550        }
551        # Remove it from the dataobj list.
552        set _dlist [lreplace $_dlist $pos $pos]
553        array unset _obj2ovride $dataobj-*
554        array unset _settings $dataobj-*
555        set changed 1
556    }
557    # If anything changed, then rebuild the plot
558    if { $changed } {
559        $_dispatcher event -idle !rebuild
560    }
561}
562
563# ----------------------------------------------------------------------
564# USAGE: get ?-objects?
565# USAGE: get ?-visible?
566# USAGE: get ?-image view?
567#
568# Clients use this to query the list of objects being plotted, in
569# order from bottom to top of this result.  The optional "-image"
570# flag can also request the internal images being shown.
571# ----------------------------------------------------------------------
572itcl::body Rappture::VtkVolumeViewer::get {args} {
573    if {[llength $args] == 0} {
574        set args "-objects"
575    }
576
577    set op [lindex $args 0]
578    switch -- $op {
579        "-objects" {
580            # put the dataobj list in order according to -raise options
581            set dlist {}
582            foreach dataobj $_dlist {
583                if { ![IsValidObject $dataobj] } {
584                    continue
585                }
586                if {[info exists _obj2ovride($dataobj-raise)] &&
587                    $_obj2ovride($dataobj-raise)} {
588                    set dlist [linsert $dlist 0 $dataobj]
589                } else {
590                    lappend dlist $dataobj
591                }
592            }
593            return $dlist
594        }
595        "-visible" {
596            set dlist {}
597            foreach dataobj $_dlist {
598                if { ![IsValidObject $dataobj] } {
599                    continue
600                }
601                if { ![info exists _obj2ovride($dataobj-raise)] } {
602                    # No setting indicates that the object isn't visible.
603                    continue
604                }
605                # Otherwise use the -raise parameter to put the object to
606                # the front of the list.
607                if { $_obj2ovride($dataobj-raise) } {
608                    set dlist [linsert $dlist 0 $dataobj]
609                } else {
610                    lappend dlist $dataobj
611                }
612            }
613            return $dlist
614        }           
615        -image {
616            if {[llength $args] != 2} {
617                error "wrong # args: should be \"get -image view\""
618            }
619            switch -- [lindex $args end] {
620                view {
621                    return $_image(plot)
622                }
623                default {
624                    error "bad image name \"[lindex $args end]\": should be view"
625                }
626            }
627        }
628        default {
629            error "bad option \"$op\": should be -objects or -image"
630        }
631    }
632}
633
634# ----------------------------------------------------------------------
635# USAGE: scale ?<data1> <data2> ...?
636#
637# Sets the default limits for the overall plot according to the
638# limits of the data for all of the given <data> objects.  This
639# accounts for all objects--even those not showing on the screen.
640# Because of this, the limits are appropriate for all objects as
641# the user scans through data in the ResultSet viewer.
642# ----------------------------------------------------------------------
643itcl::body Rappture::VtkVolumeViewer::scale {args} {
644    foreach dataobj $args {
645        if { ![$dataobj isvalid] } {
646            continue;                     # Object doesn't contain valid data.
647        }
648        foreach axis { x y z } {
649            set lim [$dataobj limits $axis]
650            if { ![info exists _limits($axis)] } {
651                set _limits($axis) $lim
652                continue
653            }
654            foreach {min max} $lim break
655            foreach {amin amax} $_limits($axis) break
656            if { $amin > $min } {
657                set amin $min
658            }
659            if { $amax < $max } {
660                set amax $max
661            }
662            set _limits($axis) [list $amin $amax]
663        }
664        foreach { fname lim } [$dataobj fieldlimits] {
665            if { ![info exists _limits($fname)] } {
666                set _limits($fname) $lim
667                continue
668            }
669            foreach {min max} $lim break
670            foreach {fmin fmax} $_limits($fname) break
671            if { $fmin > $min } {
672                set fmin $min
673            }
674            if { $fmax < $max } {
675                set fmax $max
676            }
677            set _limits($fname) [list $fmin $fmax]
678        }
679    }
680}
681
682# ----------------------------------------------------------------------
683# USAGE: download coming
684# USAGE: download controls <downloadCommand>
685# USAGE: download now
686#
687# Clients use this method to create a downloadable representation
688# of the plot.  Returns a list of the form {ext string}, where
689# "ext" is the file extension (indicating the type of data) and
690# "string" is the data itself.
691# ----------------------------------------------------------------------
692itcl::body Rappture::VtkVolumeViewer::download {option args} {
693    switch $option {
694        coming {
695            if {[catch {
696                blt::winop snap $itk_component(plotarea) $_image(download)
697            }]} {
698                $_image(download) configure -width 1 -height 1
699                $_image(download) put #000000
700            }
701        }
702        controls {
703            set popup .vtkviewerdownload
704            if { ![winfo exists .vtkviewerdownload] } {
705                set inner [BuildDownloadPopup $popup [lindex $args 0]]
706            } else {
707                set inner [$popup component inner]
708            }
709            set _downloadPopup(image_controls) $inner.image_frame
710            set num [llength [get]]
711            set num [expr {($num == 1) ? "1 result" : "$num results"}]
712            set word [Rappture::filexfer::label downloadWord]
713            $inner.summary configure -text "$word $num in the following format:"
714            update idletasks            ;# Fix initial sizes
715            return $popup
716        }
717        now {
718            set popup .vtkviewerdownload
719            if {[winfo exists .vtkviewerdownload]} {
720                $popup deactivate
721            }
722            switch -- $_downloadPopup(format) {
723                "image" {
724                    return [$this GetImage [lindex $args 0]]
725                }
726                "vtk" {
727                    return [$this GetVtkData [lindex $args 0]]
728                }
729            }
730            return ""
731        }
732        default {
733            error "bad option \"$option\": should be coming, controls, now"
734        }
735    }
736}
737
738# ----------------------------------------------------------------------
739# USAGE: Connect ?<host:port>,<host:port>...?
740#
741# Clients use this method to establish a connection to a new
742# server, or to reestablish a connection to the previous server.
743# Any existing connection is automatically closed.
744# ----------------------------------------------------------------------
745itcl::body Rappture::VtkVolumeViewer::Connect {} {
746    set _hosts [GetServerList "vtkvis"]
747    if { "" == $_hosts } {
748        return 0
749    }
750    set result [VisViewer::Connect $_hosts]
751    if { $result } {
752        if { $_reportClientInfo }  {
753            # Tell the server the viewer, hub, user and session.
754            # Do this immediately on connect before buffering any commands
755            global env
756
757            set info {}
758            set user "???"
759            if { [info exists env(USER)] } {
760                set user $env(USER)
761            }
762            set session "???"
763            if { [info exists env(SESSION)] } {
764                set session $env(SESSION)
765            }
766            lappend info "version" "$Rappture::version"
767            lappend info "build" "$Rappture::build"
768            lappend info "svnurl" "$Rappture::svnurl"
769            lappend info "installdir" "$Rappture::installdir"
770            lappend info "hub" [exec hostname]
771            lappend info "client" "vtkvolumeviewer"
772            lappend info "user" $user
773            lappend info "session" $session
774            SendCmd "clientinfo [list $info]"
775        }
776
777        set w [winfo width $itk_component(view)]
778        set h [winfo height $itk_component(view)]
779        EventuallyResize $w $h
780    }
781    return $result
782}
783
784#
785# isconnected --
786#
787#       Indicates if we are currently connected to the visualization server.
788#
789itcl::body Rappture::VtkVolumeViewer::isconnected {} {
790    return [VisViewer::IsConnected]
791}
792
793#
794# disconnect --
795#
796itcl::body Rappture::VtkVolumeViewer::disconnect {} {
797    Disconnect
798    set _reset 1
799}
800
801#
802# Disconnect --
803#
804#       Clients use this method to disconnect from the current rendering
805#       server.
806#
807itcl::body Rappture::VtkVolumeViewer::Disconnect {} {
808    VisViewer::Disconnect
809
810    $_dispatcher cancel !rebuild
811    $_dispatcher cancel !resize
812    $_dispatcher cancel !rotate
813    $_dispatcher cancel !xcutplane
814    $_dispatcher cancel !ycutplane
815    $_dispatcher cancel !zcutplane
816    $_dispatcher cancel !legend
817    # disconnected -- no more data sitting on server
818    set _outbuf ""
819    array unset _datasets
820    array unset _data
821    array unset _colormaps
822    array unset _dataset2style
823    array unset _obj2datasets
824
825    set _resizePending 0
826    set _rotatePending 0
827    set _cutplanePending 0
828    set _legendPending 0
829    set _reset 1
830}
831
832# ----------------------------------------------------------------------
833# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
834#
835# Invoked automatically whenever the "image" command comes in from
836# the rendering server.  Indicates that binary image data with the
837# specified <size> will follow.
838# ----------------------------------------------------------------------
839itcl::body Rappture::VtkVolumeViewer::ReceiveImage { args } {
840    array set info {
841        -token "???"
842        -bytes 0
843        -type image
844    }
845    array set info $args
846    set bytes [ReceiveBytes $info(-bytes)]
847    StopWaiting
848    if { $info(-type) == "image" } {
849        if 0 {
850            set f [open "last.ppm" "w"]
851            fconfigure $f -encoding binary
852            puts -nonewline $f $bytes
853            close $f
854        }
855        $_image(plot) configure -data $bytes
856        #puts stderr "[clock format [clock seconds]]: received image [image width $_image(plot)]x[image height $_image(plot)] image>"
857        if { $_start > 0 } {
858            set finish [clock clicks -milliseconds]
859            #puts stderr "round trip time [expr $finish -$_start] milliseconds"
860            set _start 0
861        }
862    } elseif { $info(type) == "print" } {
863        set tag $this-print-$info(-token)
864        set _hardcopy($tag) $bytes
865    }
866    if { $_legendPending } {
867        RequestLegend
868    }
869}
870
871#
872# ReceiveDataset --
873#
874itcl::body Rappture::VtkVolumeViewer::ReceiveDataset { args } {
875    if { ![isconnected] } {
876        return
877    }
878    set option [lindex $args 0]
879    switch -- $option {
880        "scalar" {
881            set option [lindex $args 1]
882            switch -- $option {
883                "world" {
884                    foreach { x y z value tag } [lrange $args 2 end] break
885                }
886                "pixel" {
887                    foreach { x y value tag } [lrange $args 2 end] break
888                }
889            }
890        }
891        "vector" {
892            set option [lindex $args 1]
893            switch -- $option {
894                "world" {
895                    foreach { x y z vx vy vz tag } [lrange $args 2 end] break
896                }
897                "pixel" {
898                    foreach { x y vx vy vz tag } [lrange $args 2 end] break
899                }
900            }
901        }
902        "names" {
903            foreach { name } [lindex $args 1] {
904                #puts stderr "Dataset: $name"
905            }
906        }
907        default {
908            error "unknown dataset option \"$option\" from server"
909        }
910    }
911}
912
913# ----------------------------------------------------------------------
914# USAGE: Rebuild
915#
916# Called automatically whenever something changes that affects the
917# data in the widget.  Clears any existing data and rebuilds the
918# widget to display new data.
919# ----------------------------------------------------------------------
920itcl::body Rappture::VtkVolumeViewer::Rebuild {} {
921    set w [winfo width $itk_component(view)]
922    set h [winfo height $itk_component(view)]
923
924    if { $w < 2 || $h < 2 } {
925        $_dispatcher event -idle !rebuild
926        return
927    }
928
929    # Turn on buffering of commands to the server.  We don't want to
930    # be preempted by a server disconnect/reconnect (which automatically
931    # generates a new call to Rebuild).   
932    StartBufferingCommands
933
934    set _legendPending 1
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        #
944        # Reset the camera and other view parameters
945        #
946        $_arcball quaternion [ViewToQuaternion]
947        if {$_view(-ortho)} {
948            SendCmd "camera mode ortho"
949        } else {
950            SendCmd "camera mode persp"
951        }
952        DoRotate
953        PanCamera
954        set _first ""
955        InitSettings -background \
956            -xgrid -ygrid -zgrid -axisflymode \
957            -axesvisible -axislabels -axisminorticks
958        StopBufferingCommands
959        SendCmd "imgflush"
960        StartBufferingCommands
961     }
962    set _first ""
963
964    SendCmd "dataset visible 0"
965    foreach dataobj [get -objects] {
966        if { [info exists _obj2ovride($dataobj-raise)] &&  $_first == "" } {
967            set _first $dataobj
968        }
969        set _obj2datasets($dataobj) ""
970        foreach comp [$dataobj components] {
971            set tag $dataobj-$comp
972            if { ![info exists _datasets($tag)] } {
973                set bytes [$dataobj vtkdata $comp]
974                if 0 {
975                    set f [open /tmp/vtkvolume.vtk "w"]
976                    fconfigure $f -translation binary -encoding binary
977                    puts -nonewline $f $bytes
978                    close $f
979                }
980                set length [string length $bytes]
981                if { $_reportClientInfo }  {
982                    set info {}
983                    lappend info "tool_id"       [$dataobj hints toolid]
984                    lappend info "tool_name"     [$dataobj hints toolname]
985                    lappend info "tool_title"    [$dataobj hints tooltitle]
986                    lappend info "tool_command"  [$dataobj hints toolcommand]
987                    lappend info "tool_revision" [$dataobj hints toolrevision]
988                    lappend info "dataset_label" [$dataobj hints label]
989                    lappend info "dataset_size"  $length
990                    lappend info "dataset_tag"   $tag
991                    SendCmd "clientinfo [list $info]"
992                }
993                SendCmd "dataset add $tag data follows $length"
994                append _outbuf $bytes
995                set _datasets($tag) 1
996                SetObjectStyle $dataobj $comp
997            }
998            lappend _obj2datasets($dataobj) $tag
999            if { [info exists _obj2ovride($dataobj-raise)] } {
1000                SendCmd "volume visible 1 $tag"
1001            }
1002            break
1003        }
1004    }
1005    if {"" != $_first} {
1006        set location [$_first hints camera]
1007        if { $location != "" } {
1008            array set view $location
1009        }
1010
1011        foreach axis { x y z } {
1012            set label [$_first hints ${axis}label]
1013            if { $label != "" } {
1014                SendCmd [list axis name $axis $label]
1015            }
1016            set units [$_first hints ${axis}units]
1017            if { $units != "" } {
1018                SendCmd [list axis units $axis $units]
1019            }
1020        }
1021        $itk_component(field) choices delete 0 end
1022        $itk_component(fieldmenu) delete 0 end
1023        array unset _fields
1024        set _curFldName ""
1025        foreach cname [$_first components] {
1026            foreach fname [$_first fieldnames $cname] {
1027                if { [info exists _fields($fname)] } {
1028                    continue
1029                }
1030                foreach { label units components } \
1031                    [$_first fieldinfo $fname] break
1032                # Only scalar fields are valid
1033                if {$components == 1} {
1034                    $itk_component(field) choices insert end "$fname" "$label"
1035                    $itk_component(fieldmenu) add radiobutton -label "$label" \
1036                        -value $label -variable [itcl::scope _curFldLabel] \
1037                        -selectcolor red \
1038                        -activebackground $itk_option(-plotbackground) \
1039                        -activeforeground $itk_option(-plotforeground) \
1040                        -font "Arial 8" \
1041                        -command [itcl::code $this Combo invoke]
1042                    set _fields($fname) [list $label $units $components]
1043                    if { $_curFldName == "" } {
1044                        set _curFldName $fname
1045                        set _curFldLabel $label
1046                    }
1047                }
1048            }
1049        }
1050        $itk_component(field) value $_curFldLabel
1051    }
1052
1053    InitSettings -volumepalette \
1054        -volumematerial \
1055        -volumelighting -volumeopacity -volumequality -volumeoutline -volumevisible \
1056        -cutplanesvisible \
1057        -xcutplaneposition -ycutplaneposition -zcutplaneposition \
1058        -xcutplanevisible -ycutplanevisible -zcutplanevisible
1059
1060    if { $_reset } {
1061        Zoom reset
1062        set _reset 0
1063    }
1064    # Actually write the commands to the server socket.  If it fails, we don't
1065    # care.  We're finished here.
1066    blt::busy hold $itk_component(hull)
1067    StopBufferingCommands
1068    blt::busy release $itk_component(hull)
1069}
1070
1071# ----------------------------------------------------------------------
1072# USAGE: CurrentDatasets ?-all -visible? ?dataobjs?
1073#
1074# Returns a list of server IDs for the current datasets being displayed.  This
1075# is normally a single ID, but it might be a list of IDs if the current data
1076# object has multiple components.
1077# ----------------------------------------------------------------------
1078itcl::body Rappture::VtkVolumeViewer::CurrentDatasets {args} {
1079    set flag [lindex $args 0]
1080    switch -- $flag {
1081        "-all" {
1082            if { [llength $args] > 1 } {
1083                error "CurrentDatasets: can't specify dataobj after \"-all\""
1084            }
1085            set dlist [get -objects]
1086        }
1087        "-visible" {
1088            if { [llength $args] > 1 } {
1089                set dlist {}
1090                set args [lrange $args 1 end]
1091                foreach dataobj $args {
1092                    if { [info exists _obj2ovride($dataobj-raise)] } {
1093                        lappend dlist $dataobj
1094                    }
1095                }
1096            } else {
1097                set dlist [get -visible]
1098            }
1099        }           
1100        default {
1101            set dlist $args
1102        }
1103    }
1104    set rlist ""
1105    foreach dataobj $dlist {
1106        foreach comp [$dataobj components] {
1107            set tag $dataobj-$comp
1108            if { [info exists _datasets($tag)] && $_datasets($tag) } {
1109                lappend rlist $tag
1110            }
1111        }
1112    }
1113    return $rlist
1114}
1115
1116# ----------------------------------------------------------------------
1117# USAGE: Zoom in
1118# USAGE: Zoom out
1119# USAGE: Zoom reset
1120#
1121# Called automatically when the user clicks on one of the zoom
1122# controls for this widget.  Changes the zoom for the current view.
1123# ----------------------------------------------------------------------
1124itcl::body Rappture::VtkVolumeViewer::Zoom {option} {
1125    switch -- $option {
1126        "in" {
1127            set _view(-zoom) [expr {$_view(-zoom)*1.25}]
1128            SendCmd "camera zoom $_view(-zoom)"
1129        }
1130        "out" {
1131            set _view(-zoom) [expr {$_view(-zoom)*0.8}]
1132            SendCmd "camera zoom $_view(-zoom)"
1133        }
1134        "reset" {
1135            array set _view {
1136                -qw      0.853553
1137                -qx      -0.353553
1138                -qy      0.353553
1139                -qz      0.146447
1140                -xpan    0
1141                -ypan    0
1142                -zoom    1.0
1143            }
1144            if { $_first != "" } {
1145                set location [$_first hints camera]
1146                if { $location != "" } {
1147                    array set _view $location
1148                }
1149            }
1150            $_arcball quaternion [ViewToQuaternion]
1151            DoRotate
1152            SendCmd "camera reset"
1153        }
1154    }
1155}
1156
1157itcl::body Rappture::VtkVolumeViewer::PanCamera {} {
1158    set x $_view(-xpan)
1159    set y $_view(-ypan)
1160    SendCmd "camera pan $x $y"
1161}
1162
1163# ----------------------------------------------------------------------
1164# USAGE: Rotate click <x> <y>
1165# USAGE: Rotate drag <x> <y>
1166# USAGE: Rotate release <x> <y>
1167#
1168# Called automatically when the user clicks/drags/releases in the
1169# plot area.  Moves the plot according to the user's actions.
1170# ----------------------------------------------------------------------
1171itcl::body Rappture::VtkVolumeViewer::Rotate {option x y} {
1172    switch -- $option {
1173        "click" {
1174            $itk_component(view) configure -cursor fleur
1175            set _click(x) $x
1176            set _click(y) $y
1177        }
1178        "drag" {
1179            if {[array size _click] == 0} {
1180                Rotate click $x $y
1181            } else {
1182                set w [winfo width $itk_component(view)]
1183                set h [winfo height $itk_component(view)]
1184                if {$w <= 0 || $h <= 0} {
1185                    return
1186                }
1187
1188                if {[catch {
1189                    # this fails sometimes for no apparent reason
1190                    set dx [expr {double($x-$_click(x))/$w}]
1191                    set dy [expr {double($y-$_click(y))/$h}]
1192                }]} {
1193                    return
1194                }
1195                if { $dx == 0 && $dy == 0 } {
1196                    return
1197                }
1198                set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1199                EventuallyRotate $q
1200                set _click(x) $x
1201                set _click(y) $y
1202            }
1203        }
1204        "release" {
1205            Rotate drag $x $y
1206            $itk_component(view) configure -cursor ""
1207            catch {unset _click}
1208        }
1209        default {
1210            error "bad option \"$option\": should be click, drag, release"
1211        }
1212    }
1213}
1214
1215itcl::body Rappture::VtkVolumeViewer::Pick {x y} {
1216    foreach tag [CurrentDatasets -visible] {
1217        SendCmd "dataset getscalar pixel $x $y $tag"
1218    }
1219}
1220
1221# ----------------------------------------------------------------------
1222# USAGE: $this Pan click x y
1223#        $this Pan drag x y
1224#        $this Pan release x y
1225#
1226# Called automatically when the user clicks on one of the zoom
1227# controls for this widget.  Changes the zoom for the current view.
1228# ----------------------------------------------------------------------
1229itcl::body Rappture::VtkVolumeViewer::Pan {option x y} {
1230    switch -- $option {
1231        "set" {
1232            set w [winfo width $itk_component(view)]
1233            set h [winfo height $itk_component(view)]
1234            set x [expr $x / double($w)]
1235            set y [expr $y / double($h)]
1236            set _view(-xpan) [expr $_view(-xpan) + $x]
1237            set _view(-ypan) [expr $_view(-ypan) + $y]
1238            PanCamera
1239            return
1240        }
1241        "click" {
1242            set _click(x) $x
1243            set _click(y) $y
1244            $itk_component(view) configure -cursor hand1
1245        }
1246        "drag" {
1247            if { ![info exists _click(x)] } {
1248                set _click(x) $x
1249            }
1250            if { ![info exists _click(y)] } {
1251                set _click(y) $y
1252            }
1253            set w [winfo width $itk_component(view)]
1254            set h [winfo height $itk_component(view)]
1255            set dx [expr ($_click(x) - $x)/double($w)]
1256            set dy [expr ($_click(y) - $y)/double($h)]
1257            set _click(x) $x
1258            set _click(y) $y
1259            set _view(-xpan) [expr $_view(-xpan) - $dx]
1260            set _view(-ypan) [expr $_view(-ypan) - $dy]
1261            PanCamera
1262        }
1263        "release" {
1264            Pan drag $x $y
1265            $itk_component(view) configure -cursor ""
1266        }
1267        default {
1268            error "unknown option \"$option\": should set, click, drag, or release"
1269        }
1270    }
1271}
1272
1273# ----------------------------------------------------------------------
1274# USAGE: InitSettings <what> ?<value>?
1275#
1276# Used internally to update rendering settings whenever parameters
1277# change in the popup settings panel.  Sends the new settings off
1278# to the back end.
1279# ----------------------------------------------------------------------
1280itcl::body Rappture::VtkVolumeViewer::InitSettings { args } {
1281    foreach spec $args {
1282        if { [info exists _settings($_first${spec})] } {
1283            # Reset global setting with dataobj specific setting
1284            set _settings($spec) $_settings($_first${spec})
1285        }
1286        AdjustSetting $spec
1287    }
1288}
1289
1290#
1291# AdjustSetting --
1292#
1293#       Changes/updates a specific setting in the widget.  There are
1294#       usually user-setable option.  Commands are sent to the render
1295#       server.
1296#
1297itcl::body Rappture::VtkVolumeViewer::AdjustSetting {what {value ""}} {
1298    if { ![isconnected] } {
1299        return
1300    }
1301    switch -- $what {
1302        "-background" {
1303            set bgcolor [$itk_component(background) value]
1304            set _settings($what) $bgcolor
1305            array set fgcolors {
1306                "black" "white"
1307                "white" "black"
1308                "grey"  "black"
1309            }
1310            configure -plotbackground $bgcolor \
1311                -plotforeground $fgcolors($bgcolor)
1312            $itk_component(view) delete "legend"
1313            DrawLegend
1314        }
1315        "-volumeoutline" {
1316            set bool $_settings($what)
1317            SendCmd "outline visible 0"
1318            foreach tag [CurrentDatasets -visible] {
1319                SendCmd "outline visible $bool $tag"
1320            }
1321        }
1322        "-legendvisible" {
1323            set bool $_settings($what)
1324        }
1325        "-volumevisible" {
1326            set bool $_settings($what)
1327            foreach tag [CurrentDatasets -visible] {
1328                SendCmd "volume visible $bool $tag"
1329            }
1330            if { $bool } {
1331                Rappture::Tooltip::for $itk_component(volume) \
1332                    "Hide the volume"
1333            } else {
1334                Rappture::Tooltip::for $itk_component(volume) \
1335                    "Show the volume"
1336            }
1337        }
1338        "-volumematerial" {
1339            set val $_settings($what)
1340            set diffuse [expr {0.01*$val}]
1341            set specular [expr {0.01*$val}]
1342            #set power [expr {sqrt(160*$val+1.0)}]
1343            set power [expr {$val+1.0}]
1344            foreach tag [CurrentDatasets -visible] {
1345                SendCmd "volume shading diffuse $diffuse $tag"
1346                SendCmd "volume shading specular $specular $power $tag"
1347            }
1348        }
1349        "-volumelighting" {
1350            set bool $_settings($what)
1351            foreach tag [CurrentDatasets -visible] {
1352                SendCmd "volume lighting $bool $tag"
1353            }
1354        }
1355        "-volumeopacity" {
1356            set val $_settings($what)
1357            set val [expr {0.01*$val}]
1358            foreach tag [CurrentDatasets -visible] {
1359                SendCmd "volume opacity $val $tag"
1360            }
1361        }
1362        "-volumequality" {
1363            set val $_settings($what)
1364            set val [expr {0.01*$val}]
1365            foreach tag [CurrentDatasets -visible] {
1366                SendCmd "volume quality $val $tag"
1367            }
1368        }
1369        "-axesvisible" {
1370            set bool $_settings($what)
1371            SendCmd "axis visible all $bool"
1372        }
1373        "-axislabels" {
1374            set bool $_settings($what)
1375            SendCmd "axis labels all $bool"
1376        }
1377        "-axisminorticks" {
1378            set bool $_settings($what)
1379            SendCmd "axis minticks all $bool"
1380        }
1381        "-xgrid" - "-ygrid" - "-zgrid" {
1382            set axis [string range $what 1 1]
1383            set bool $_settings($what)
1384            SendCmd "axis grid $axis $bool"
1385        }
1386        "-axisflymode" {
1387            set mode [$itk_component(axismode) value]
1388            set mode [$itk_component(axismode) translate $mode]
1389            set _settings($what) $mode
1390            SendCmd "axis flymode $mode"
1391        }
1392        "-cutplanesvisible" {
1393            set bool $_settings($what)
1394            foreach dataset [CurrentDatasets -visible] {
1395                SendCmd "$_cutplaneCmd visible $bool $dataset"
1396            }
1397        }
1398        "-cutplanelighting" {
1399            set bool $_settings($what)
1400            foreach dataset [CurrentDatasets -visible] {
1401                if {$_cutplaneCmd != "imgcutplane"} {
1402                    SendCmd "$_cutplaneCmd lighting $bool $dataset"
1403                } else {
1404                    if {$bool} {
1405                        set ambient 0.0
1406                        set diffuse 1.0
1407                    } else {
1408                        set ambient 1.0
1409                        set diffuse 0.0
1410                    }
1411                    SendCmd "imgcutplane material $ambient $diffuse $dataset"
1412                }
1413            }
1414        }
1415        "-cutplaneopacity" {
1416            set val $_settings($what)
1417            set sval [expr { 0.01 * double($val) }]
1418            foreach dataset [CurrentDatasets -visible] {
1419                SendCmd "$_cutplaneCmd opacity $sval $dataset"
1420            }
1421        }
1422        "-xcutplanevisible" - "-ycutplanevisible" - "-zcutplanevisible" {
1423            set axis [string range $what 1 1]
1424            set bool $_settings($what)
1425            if { $bool } {
1426                $itk_component(${axis}CutScale) configure -state normal \
1427                    -troughcolor white
1428            } else {
1429                $itk_component(${axis}CutScale) configure -state disabled \
1430                    -troughcolor grey82
1431            }
1432            foreach dataset [CurrentDatasets -visible] {
1433                SendCmd "$_cutplaneCmd axis $axis $bool $dataset"
1434            }
1435        }
1436        "-xcutplaneposition" - "-ycutplaneposition" - "-zcutplaneposition" {
1437            set axis [string range $what 1 1]
1438            set pos [expr $_settings($what) * 0.01]
1439            foreach dataset [CurrentDatasets -visible] {
1440                SendCmd "$_cutplaneCmd slice ${axis} ${pos} $dataset"
1441            }
1442            set _cutplanePending 0
1443        }
1444        "-volumepalette" {
1445            set palette [$itk_component(palette) value]
1446            set _settings($what) $palette
1447            foreach dataset [CurrentDatasets -visible $_first] {
1448                foreach {dataobj comp} [split $dataset -] break
1449                ChangeColormap $dataobj $comp $palette
1450            }
1451            set _legendPending 1
1452        }
1453        "-field" {
1454            set label [$itk_component(field) value]
1455            set fname [$itk_component(field) translate $label]
1456            set _settings($what) $fname
1457            if { [info exists _fields($fname)] } {
1458                foreach { label units components } $_fields($fname) break
1459                if { $components > 1 } {
1460                    puts stderr "Can't use a vector field in a volume"
1461                    return
1462                } else {
1463                    set _colorMode scalar
1464                }
1465                set _curFldName $fname
1466                set _curFldLabel $label
1467            } else {
1468                puts stderr "unknown field \"$fname\""
1469                return
1470            }
1471            foreach dataset [CurrentDatasets -visible $_first] {
1472                #SendCmd "volume colormode $_colorMode ${fname} $dataset"
1473                SendCmd "$_cutplaneCmd colormode $_colorMode ${fname} $dataset"
1474            }
1475            SendCmd "camera reset"
1476            DrawLegend
1477        }
1478        default {
1479            error "don't know how to fix $what"
1480        }
1481    }
1482}
1483
1484#
1485# RequestLegend --
1486#
1487#       Request a new legend from the server.  The size of the legend
1488#       is determined from the height of the canvas.  It will be rotated
1489#       to be vertical when drawn.
1490#
1491itcl::body Rappture::VtkVolumeViewer::RequestLegend {} {
1492    set font "Arial 8"
1493    set lineht [font metrics $font -linespace]
1494    set c $itk_component(legend)
1495    set w 12
1496    set h [expr {$_height - 3 * ($lineht + 2)}]
1497    if { $h < 1} {
1498        return
1499    }
1500    # Set the legend on the first volume dataset.
1501    foreach dataset [CurrentDatasets -visible $_first] {
1502        foreach {dataobj comp} [split $dataset -] break
1503        if { [info exists _dataset2style($dataset)] } {
1504            SendCmdNoWait \
1505                "legend $_dataset2style($dataset) $_colorMode $_curFldName {} $w $h 0"
1506            break;
1507        }
1508    }
1509}
1510
1511#
1512# ChangeColormap --
1513#
1514itcl::body Rappture::VtkVolumeViewer::ChangeColormap {dataobj comp color} {
1515    set tag $dataobj-$comp
1516    if { ![info exist _style($tag)] } {
1517        error "no initial colormap"
1518    }
1519    array set style $_style($tag)
1520    set style(-color) $color
1521    set _style($tag) [array get style]
1522    SetColormap $dataobj $comp
1523}
1524
1525#
1526# SetColormap --
1527#
1528itcl::body Rappture::VtkVolumeViewer::SetColormap { dataobj comp } {
1529    array set style {
1530        -color BCGYR
1531        -levels 6
1532    }
1533    set tag $dataobj-$comp
1534    if { ![info exists _initialStyle($tag)] } {
1535        # Save the initial component style.
1536        set _initialStyle($tag) [$dataobj style $comp]
1537    }
1538
1539    # Override defaults with initial style defined in xml.
1540    array set style $_initialStyle($tag)
1541
1542    if { ![info exists _style($tag)] } {
1543        set _style($tag) [array get style]
1544    }
1545    # Override initial style with current style.
1546    array set style $_style($tag)
1547
1548    set name "$style(-color):$style(-levels)"
1549    if { ![info exists _colormaps($name)] } {
1550        BuildColormap $name [array get style]
1551        set _colormaps($name) 1
1552    }
1553    if { ![info exists _dataset2style($tag)] ||
1554         $_dataset2style($tag) != $name } {
1555        SendCmd "volume colormap $name $tag"
1556        SendCmd "$_cutplaneCmd colormap $name-opaque $tag"
1557        set _dataset2style($tag) $name
1558    }
1559}
1560
1561#
1562# BuildColormap --
1563#
1564itcl::body Rappture::VtkVolumeViewer::BuildColormap { name styles } {
1565    array set style $styles
1566    set cmap [ColorsToColormap $style(-color)]
1567    if { [llength $cmap] == 0 } {
1568        set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0"
1569    }
1570    set max 1.0
1571
1572    set opaqueWmap "0.0 1.0 1.0 1.0"
1573    #set wmap "0.0 0.0 0.1 0.0 0.2 0.8 0.98 0.8 0.99 0.0 1.0 0.0"
1574    # Approximate cubic opacity curve
1575    set wmap "0.0 0.0 0.1 0.001 0.2 0.008 0.3 0.027 0.4 0.064 0.5 0.125 0.6 0.216 0.7 0.343 0.8 0.512 0.9 0.729 1.0 1.0"
1576    SendCmd "colormap add $name { $cmap } { $wmap }"
1577    SendCmd "colormap add $name-opaque { $cmap } { $opaqueWmap }"
1578}
1579
1580# ----------------------------------------------------------------------
1581# CONFIGURATION OPTION: -plotbackground
1582# ----------------------------------------------------------------------
1583itcl::configbody Rappture::VtkVolumeViewer::plotbackground {
1584    if { [isconnected] } {
1585        set color $itk_option(-plotbackground)
1586        set rgb [Color2RGB $color]
1587        SendCmd "screen bgcolor $rgb"
1588        $itk_component(legend) configure -background $color
1589    }
1590}
1591
1592# ----------------------------------------------------------------------
1593# CONFIGURATION OPTION: -plotforeground
1594# ----------------------------------------------------------------------
1595itcl::configbody Rappture::VtkVolumeViewer::plotforeground {
1596    if { [isconnected] } {
1597        set color $itk_option(-plotforeground)
1598        set rgb [Color2RGB $color]
1599        SendCmd "axis color all $rgb"
1600        SendCmd "outline color $rgb"
1601        SendCmd "$_cutplaneCmd color $rgb"
1602        $itk_component(legend) itemconfigure labels -fill $color
1603        $itk_component(legend) itemconfigure limits -fill $color
1604    }
1605}
1606
1607itcl::body Rappture::VtkVolumeViewer::BuildViewTab {} {
1608    set fg [option get $itk_component(hull) font Font]
1609    #set bfg [option get $itk_component(hull) boldFont Font]
1610
1611    set inner [$itk_component(main) insert end \
1612        -title "View Settings" \
1613        -icon [Rappture::icon wrench]]
1614    $inner configure -borderwidth 4
1615
1616    checkbutton $inner.axes \
1617        -text "Axes" \
1618        -variable [itcl::scope _settings(-axesvisible)] \
1619        -command [itcl::code $this AdjustSetting -axesvisible] \
1620        -font "Arial 9"
1621
1622    checkbutton $inner.outline \
1623        -text "Outline" \
1624        -variable [itcl::scope _settings(-volumeoutline)] \
1625        -command [itcl::code $this AdjustSetting -volumeoutline] \
1626        -font "Arial 9"
1627
1628    checkbutton $inner.legend \
1629        -text "Legend" \
1630        -variable [itcl::scope _settings(-legendvisible)] \
1631        -command [itcl::code $this AdjustSetting -legendvisible] \
1632        -font "Arial 9"
1633
1634    checkbutton $inner.volume \
1635        -text "Volume" \
1636        -variable [itcl::scope _settings(-volumevisible)] \
1637        -command [itcl::code $this AdjustSetting -volumevisible] \
1638        -font "Arial 9"
1639
1640    label $inner.background_l -text "Background" -font "Arial 9"
1641    itk_component add background {
1642        Rappture::Combobox $inner.background -width 10 -editable no
1643    }
1644    $inner.background choices insert end \
1645        "black"              "black"            \
1646        "white"              "white"            \
1647        "grey"               "grey"             
1648
1649    $itk_component(background) value $_settings(-background)
1650    bind $inner.background <<Value>> \
1651        [itcl::code $this AdjustSetting -background]
1652
1653    blt::table $inner \
1654        0,0 $inner.axes  -cspan 2 -anchor w \
1655        1,0 $inner.outline  -cspan 2 -anchor w \
1656        2,0 $inner.volume  -cspan 2 -anchor w \
1657        3,0 $inner.legend  -cspan 2 -anchor w \
1658        4,0 $inner.background_l       -anchor e -pady 2 \
1659        4,1 $inner.background                   -fill x \
1660
1661    blt::table configure $inner r* -resize none
1662    blt::table configure $inner r5 -resize expand
1663}
1664
1665itcl::body Rappture::VtkVolumeViewer::BuildVolumeTab {} {
1666    set font [option get $itk_component(hull) font Font]
1667    #set bfont [option get $itk_component(hull) boldFont Font]
1668
1669    set inner [$itk_component(main) insert end \
1670        -title "Volume Settings" \
1671        -icon [Rappture::icon volume-on]]
1672    $inner configure -borderwidth 4
1673
1674    checkbutton $inner.visibility \
1675        -text "Visible" \
1676        -font $font \
1677        -variable [itcl::scope _settings(-volumevisible)] \
1678        -command [itcl::code $this AdjustSetting -volumevisible]
1679
1680    checkbutton $inner.lighting \
1681        -text "Enable Lighting" \
1682        -font $font \
1683        -variable [itcl::scope _settings(-volumelighting)] \
1684        -command [itcl::code $this AdjustSetting -volumelighting]
1685
1686    label $inner.dim_l -text "Dim" -font $font
1687    ::scale $inner.material -from 0 -to 100 -orient horizontal \
1688        -variable [itcl::scope _settings(-volumematerial)] \
1689        -showvalue off -command [itcl::code $this AdjustSetting -volumematerial]
1690    label $inner.bright_l -text "Bright" -font $font
1691
1692    label $inner.opacity_l -text "Opacity" -font $font
1693    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1694        -variable [itcl::scope _settings(-volumeopacity)] \
1695        -showvalue off \
1696        -command [itcl::code $this AdjustSetting -volumeopacity]
1697
1698    label $inner.quality_l -text "Quality" -font $font
1699    ::scale $inner.quality -from 0 -to 100 -orient horizontal \
1700        -variable [itcl::scope _settings(-volumequality)] \
1701        -showvalue off \
1702        -command [itcl::code $this AdjustSetting -volumequality]
1703
1704    label $inner.field_l -text "Field" -font $font
1705    itk_component add field {
1706        Rappture::Combobox $inner.field -editable no
1707    }
1708    bind $inner.field <<Value>> \
1709        [itcl::code $this AdjustSetting -field]
1710
1711    label $inner.palette_l -text "Palette" -font $font
1712    itk_component add palette {
1713        Rappture::Combobox $inner.palette -editable no
1714    }
1715    $inner.palette choices insert end [GetColormapList]
1716    $itk_component(palette) value "BCGYR"
1717    bind $inner.palette <<Value>> \
1718        [itcl::code $this AdjustSetting -volumepalette]
1719
1720    blt::table $inner \
1721        0,0 $inner.field_l   -anchor w -pady 2  \
1722        0,1 $inner.field     -fill x   -pady 2 -cspan 3 \
1723        1,0 $inner.visibility -anchor w -pady 2 -cspan 4 \
1724        2,0 $inner.lighting  -anchor w -pady 2 -cspan 4 \
1725        3,0 $inner.dim_l     -anchor e -pady 2 \
1726        3,1 $inner.material  -fill x   -pady 2 -cspan 2 \
1727        3,3 $inner.bright_l  -anchor w -pady 2 \
1728        4,0 $inner.opacity_l -anchor w -pady 2 -cspan 4 \
1729        5,0 $inner.opacity   -fill x   -pady 2 -cspan 4 \
1730        6,0 $inner.quality_l -anchor w -pady 2 -cspan 4 \
1731        7,0 $inner.quality   -fill x   -pady 2 -cspan 4 \
1732        8,0 $inner.palette_l -anchor w -pady 2  \
1733        8,1 $inner.palette   -fill x   -pady 2 -cspan 3 \
1734
1735    blt::table configure $inner r* c0 c1 c3 -resize none
1736    blt::table configure $inner r9 c2 -resize expand
1737}
1738
1739itcl::body Rappture::VtkVolumeViewer::BuildAxisTab {} {
1740    set fg [option get $itk_component(hull) font Font]
1741    #set bfg [option get $itk_component(hull) boldFont Font]
1742
1743    set inner [$itk_component(main) insert end \
1744        -title "Axis Settings" \
1745        -icon [Rappture::icon axis2]]
1746    $inner configure -borderwidth 4
1747
1748    checkbutton $inner.visible \
1749        -text "Axes" \
1750        -variable [itcl::scope _settings(-axesvisible)] \
1751        -command [itcl::code $this AdjustSetting -axesvisible] \
1752        -font "Arial 9"
1753
1754    checkbutton $inner.labels \
1755        -text "Axis Labels" \
1756        -variable [itcl::scope _settings(-axislabels)] \
1757        -command [itcl::code $this AdjustSetting -axislabels] \
1758        -font "Arial 9"
1759    label $inner.grid_l -text "Grid" -font "Arial 9"
1760    checkbutton $inner.xgrid \
1761        -text "X" \
1762        -variable [itcl::scope _settings(-xgrid)] \
1763        -command [itcl::code $this AdjustSetting -xgrid] \
1764        -font "Arial 9"
1765    checkbutton $inner.ygrid \
1766        -text "Y" \
1767        -variable [itcl::scope _settings(-ygrid)] \
1768        -command [itcl::code $this AdjustSetting -ygrid] \
1769        -font "Arial 9"
1770    checkbutton $inner.zgrid \
1771        -text "Z" \
1772        -variable [itcl::scope _settings(-zgrid)] \
1773        -command [itcl::code $this AdjustSetting -zgrid] \
1774        -font "Arial 9"
1775    checkbutton $inner.minorticks \
1776        -text "Minor Ticks" \
1777        -variable [itcl::scope _settings(-axisminorticks)] \
1778        -command [itcl::code $this AdjustSetting -axisminorticks] \
1779        -font "Arial 9"
1780
1781    label $inner.mode_l -text "Mode" -font "Arial 9"
1782
1783    itk_component add axismode {
1784        Rappture::Combobox $inner.mode -width 10 -editable no
1785    }
1786    $inner.mode choices insert end \
1787        "static_triad"    "static" \
1788        "closest_triad"   "closest" \
1789        "furthest_triad"  "farthest" \
1790        "outer_edges"     "outer"         
1791    $itk_component(axismode) value $_settings(-axisflymode)
1792    bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axisflymode]
1793
1794    blt::table $inner \
1795        0,0 $inner.visible -anchor w -cspan 4 \
1796        1,0 $inner.labels  -anchor w -cspan 4 \
1797        2,0 $inner.minorticks  -anchor w -cspan 4 \
1798        4,0 $inner.grid_l  -anchor w \
1799        4,1 $inner.xgrid   -anchor w \
1800        4,2 $inner.ygrid   -anchor w \
1801        4,3 $inner.zgrid   -anchor w \
1802        5,0 $inner.mode_l  -anchor w -padx { 2 0 } \
1803        5,1 $inner.mode    -fill x   -cspan 3
1804
1805    blt::table configure $inner r* c* -resize none
1806    blt::table configure $inner r7 c6 -resize expand
1807    blt::table configure $inner r3 -height 0.125i
1808}
1809
1810itcl::body Rappture::VtkVolumeViewer::BuildCameraTab {} {
1811    set inner [$itk_component(main) insert end \
1812        -title "Camera Settings" \
1813        -icon [Rappture::icon camera]]
1814    $inner configure -borderwidth 4
1815
1816    label $inner.view_l -text "view" -font "Arial 9"
1817    set f [frame $inner.view]
1818    foreach side { front back left right top bottom } {
1819        button $f.$side  -image [Rappture::icon view$side] \
1820            -command [itcl::code $this SetOrientation $side]
1821        Rappture::Tooltip::for $f.$side "Change the view to $side"
1822        pack $f.$side -side left
1823    }
1824    blt::table $inner \
1825        0,0 $inner.view_l -anchor e -pady 2 \
1826        0,1 $inner.view -anchor w -pady 2
1827    blt::table configure $inner r0 -resize none
1828
1829    set row 1
1830    set labels { qx qy qz qw xpan ypan zoom }
1831    foreach tag $labels {
1832        label $inner.${tag}-label -text $tag -font "Arial 9"
1833        entry $inner.${tag} -font "Arial 9"  -bg white \
1834            -textvariable [itcl::scope _view(-$tag)]
1835        bind $inner.${tag} <Return> \
1836            [itcl::code $this camera set -${tag}]
1837        bind $inner.${tag} <KP_Enter> \
1838            [itcl::code $this camera set -${tag}]
1839        blt::table $inner \
1840            $row,0 $inner.${tag}-label -anchor e -pady 2 \
1841            $row,1 $inner.${tag} -anchor w -pady 2
1842        blt::table configure $inner r$row -resize none
1843        incr row
1844    }
1845    checkbutton $inner.ortho \
1846        -text "Orthographic Projection" \
1847        -variable [itcl::scope _view(-ortho)] \
1848        -command [itcl::code $this camera set -ortho] \
1849        -font "Arial 9"
1850    blt::table $inner \
1851            $row,0 $inner.ortho -cspan 2 -anchor w -pady 2
1852    blt::table configure $inner r$row -resize none
1853    incr row
1854
1855    blt::table configure $inner c0 c1 -resize none
1856    blt::table configure $inner c2 -resize expand
1857    blt::table configure $inner r$row -resize expand
1858}
1859
1860itcl::body Rappture::VtkVolumeViewer::BuildCutplaneTab {} {
1861    set font [option get $itk_component(hull) font Font]
1862   
1863    set inner [$itk_component(main) insert end \
1864        -title "Cutplane Settings" \
1865        -icon [Rappture::icon cutbutton]]
1866
1867    $inner configure -borderwidth 4
1868
1869    checkbutton $inner.visible \
1870        -text "Show Cutplanes" \
1871        -variable [itcl::scope _settings(-cutplanesvisible)] \
1872        -command [itcl::code $this AdjustSetting -cutplanesvisible] \
1873        -font "Arial 9"
1874
1875    checkbutton $inner.lighting \
1876        -text "Enable Lighting" \
1877        -variable [itcl::scope _settings(-cutplanelighting)] \
1878        -command [itcl::code $this AdjustSetting -cutplanelighting] \
1879        -font "Arial 9"
1880
1881    label $inner.opacity_l -text "Opacity" -font "Arial 9"
1882    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1883        -variable [itcl::scope _settings(-cutplaneopacity)] \
1884        -width 10 \
1885        -showvalue off \
1886        -command [itcl::code $this AdjustSetting -cutplaneopacity]
1887    $inner.opacity set $_settings(-cutplaneopacity)
1888
1889    # X-value slicer...
1890    itk_component add xCutButton {
1891        Rappture::PushButton $inner.xbutton \
1892            -onimage [Rappture::icon x-cutplane] \
1893            -offimage [Rappture::icon x-cutplane] \
1894            -command [itcl::code $this AdjustSetting -xcutplanevisible] \
1895            -variable [itcl::scope _settings(-xcutplanevisible)]
1896    }
1897    Rappture::Tooltip::for $itk_component(xCutButton) \
1898        "Toggle the X-axis cutplane on/off"
1899    $itk_component(xCutButton) select
1900
1901    itk_component add xCutScale {
1902        ::scale $inner.xval -from 100 -to 0 \
1903            -width 10 -orient vertical -showvalue yes \
1904            -borderwidth 1 -highlightthickness 0 \
1905            -command [itcl::code $this EventuallySetCutplane x] \
1906            -variable [itcl::scope _settings(-xcutplaneposition)]
1907    } {
1908        usual
1909        ignore -borderwidth -highlightthickness
1910    }
1911    # Set the default cutplane value before disabling the scale.
1912    $itk_component(xCutScale) set 50
1913    $itk_component(xCutScale) configure -state disabled
1914    Rappture::Tooltip::for $itk_component(xCutScale) \
1915        "@[itcl::code $this Slice tooltip x]"
1916
1917    # Y-value slicer...
1918    itk_component add yCutButton {
1919        Rappture::PushButton $inner.ybutton \
1920            -onimage [Rappture::icon y-cutplane] \
1921            -offimage [Rappture::icon y-cutplane] \
1922            -command [itcl::code $this AdjustSetting -ycutplanevisible] \
1923            -variable [itcl::scope _settings(-ycutplanevisible)]
1924    }
1925    Rappture::Tooltip::for $itk_component(yCutButton) \
1926        "Toggle the Y-axis cutplane on/off"
1927    $itk_component(yCutButton) select
1928
1929    itk_component add yCutScale {
1930        ::scale $inner.yval -from 100 -to 0 \
1931            -width 10 -orient vertical -showvalue yes \
1932            -borderwidth 1 -highlightthickness 0 \
1933            -command [itcl::code $this EventuallySetCutplane y] \
1934            -variable [itcl::scope _settings(-ycutplaneposition)]
1935    } {
1936        usual
1937        ignore -borderwidth -highlightthickness
1938    }
1939    Rappture::Tooltip::for $itk_component(yCutScale) \
1940        "@[itcl::code $this Slice tooltip y]"
1941    # Set the default cutplane value before disabling the scale.
1942    $itk_component(yCutScale) set 50
1943    $itk_component(yCutScale) configure -state disabled
1944
1945    # Z-value slicer...
1946    itk_component add zCutButton {
1947        Rappture::PushButton $inner.zbutton \
1948            -onimage [Rappture::icon z-cutplane] \
1949            -offimage [Rappture::icon z-cutplane] \
1950            -command [itcl::code $this AdjustSetting -zcutplanevisible] \
1951            -variable [itcl::scope _settings(-zcutplanevisible)]
1952    }
1953    Rappture::Tooltip::for $itk_component(zCutButton) \
1954        "Toggle the Z-axis cutplane on/off"
1955    $itk_component(zCutButton) select
1956
1957    itk_component add zCutScale {
1958        ::scale $inner.zval -from 100 -to 0 \
1959            -width 10 -orient vertical -showvalue yes \
1960            -borderwidth 1 -highlightthickness 0 \
1961            -command [itcl::code $this EventuallySetCutplane z] \
1962            -variable [itcl::scope _settings(-zcutplaneposition)]
1963    } {
1964        usual
1965        ignore -borderwidth -highlightthickness
1966    }
1967    $itk_component(zCutScale) set 50
1968    $itk_component(zCutScale) configure -state disabled
1969    Rappture::Tooltip::for $itk_component(zCutScale) \
1970        "@[itcl::code $this Slice tooltip z]"
1971
1972    blt::table $inner \
1973        0,0 $inner.visible              -anchor w -pady 2 -cspan 4 \
1974        1,0 $inner.lighting             -anchor w -pady 2 -cspan 4 \
1975        2,0 $inner.opacity_l            -anchor w -pady 2 -cspan 3 \
1976        3,0 $inner.opacity              -fill x   -pady 2 -cspan 3 \
1977        4,0 $itk_component(xCutButton)  -anchor e -padx 2 -pady 2 \
1978        5,0 $itk_component(xCutScale)   -fill y \
1979        4,1 $itk_component(yCutButton)  -anchor e -padx 2 -pady 2 \
1980        5,1 $itk_component(yCutScale)   -fill y \
1981        4,2 $itk_component(zCutButton)  -anchor e -padx 2 -pady 2 \
1982        5,2 $itk_component(zCutScale)   -fill y
1983
1984    blt::table configure $inner r* c* -resize none
1985    blt::table configure $inner r5 c3 -resize expand
1986}
1987
1988#
1989#  camera --
1990#
1991itcl::body Rappture::VtkVolumeViewer::camera {option args} {
1992    switch -- $option {
1993        "show" {
1994            puts [array get _view]
1995        }
1996        "set" {
1997            set who [lindex $args 0]
1998            set x $_view($who)
1999            set code [catch { string is double $x } result]
2000            if { $code != 0 || !$result } {
2001                return
2002            }
2003            switch -- $who {
2004                "-ortho" {
2005                    if {$_view(-ortho)} {
2006                        SendCmd "camera mode ortho"
2007                    } else {
2008                        SendCmd "camera mode persp"
2009                    }
2010                }
2011                "-xpan" - "-ypan" {
2012                    PanCamera
2013                }
2014                "-qx" - "-qy" - "-qz" - "-qw" {
2015                    set q [ViewToQuaternion]
2016                    $_arcball quaternion $q
2017                    EventuallyRotate $q
2018                }
2019                "-zoom" {
2020                    SendCmd "camera zoom $_view(-zoom)"
2021                }
2022            }
2023        }
2024    }
2025}
2026
2027itcl::body Rappture::VtkVolumeViewer::GetVtkData { args } {
2028    set bytes ""
2029    foreach dataobj [get] {
2030        foreach comp [$dataobj components] {
2031            set tag $dataobj-$comp
2032            set contents [$dataobj vtkdata $comp]
2033            append bytes "$contents\n"
2034        }
2035    }
2036    return [list .vtk $bytes]
2037}
2038
2039itcl::body Rappture::VtkVolumeViewer::GetImage { args } {
2040    if { [image width $_image(download)] > 0 &&
2041         [image height $_image(download)] > 0 } {
2042        set bytes [$_image(download) data -format "jpeg -quality 100"]
2043        set bytes [Rappture::encoding::decode -as b64 $bytes]
2044        return [list .jpg $bytes]
2045    }
2046    return ""
2047}
2048
2049itcl::body Rappture::VtkVolumeViewer::BuildDownloadPopup { popup command } {
2050    Rappture::Balloon $popup \
2051        -title "[Rappture::filexfer::label downloadWord] as..."
2052    set inner [$popup component inner]
2053    label $inner.summary -text "" -anchor w
2054    radiobutton $inner.vtk_button -text "VTK data file" \
2055        -variable [itcl::scope _downloadPopup(format)] \
2056        -font "Helvetica 9 " \
2057        -value vtk 
2058    Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
2059    radiobutton $inner.image_button -text "Image File" \
2060        -variable [itcl::scope _downloadPopup(format)] \
2061        -value image
2062    Rappture::Tooltip::for $inner.image_button \
2063        "Save as digital image."
2064
2065    button $inner.ok -text "Save" \
2066        -highlightthickness 0 -pady 2 -padx 3 \
2067        -command $command \
2068        -compound left \
2069        -image [Rappture::icon download]
2070
2071    button $inner.cancel -text "Cancel" \
2072        -highlightthickness 0 -pady 2 -padx 3 \
2073        -command [list $popup deactivate] \
2074        -compound left \
2075        -image [Rappture::icon cancel]
2076
2077    blt::table $inner \
2078        0,0 $inner.summary -cspan 2  \
2079        1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
2080        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
2081        4,1 $inner.cancel -width .9i -fill y \
2082        4,0 $inner.ok -padx 2 -width .9i -fill y
2083    blt::table configure $inner r3 -height 4
2084    blt::table configure $inner r4 -pady 4
2085    raise $inner.image_button
2086    $inner.vtk_button invoke
2087    return $inner
2088}
2089
2090itcl::body Rappture::VtkVolumeViewer::SetObjectStyle { dataobj cname } {
2091    # Parse style string.
2092    set tag $dataobj-$cname
2093    array set styles {
2094        -lighting   1
2095        -opacity    0.5
2096        -outline    0
2097        -visible    1
2098    }
2099    array set styles [$dataobj style $cname]
2100    set _settings(-volumelighting) $styles(-lighting)
2101    set _settings(-volumeopacity) [expr $styles(-opacity) * 100.0]
2102    set _settings(-volumeoutline) $styles(-outline)
2103    set _settings(-volumevisible) $styles(-visible)
2104
2105    SendCmd "outline add $tag"
2106    SendCmd "outline color [Color2RGB $itk_option(-plotforeground)] $tag"
2107    SendCmd "outline visible $styles(-outline) $tag"
2108
2109    SendCmd "$_cutplaneCmd add $tag"
2110    SendCmd "$_cutplaneCmd color [Color2RGB $itk_option(-plotforeground)] $tag"
2111    SendCmd "$_cutplaneCmd visible 0 $tag"
2112
2113    SendCmd "volume add $tag"
2114    SendCmd "volume lighting $styles(-lighting) $tag"
2115    SendCmd "volume opacity $styles(-opacity) $tag"
2116    SendCmd "volume visible $styles(-visible) $tag"
2117    SetColormap $dataobj $cname
2118}
2119
2120itcl::body Rappture::VtkVolumeViewer::IsValidObject { dataobj } {
2121    if {[catch {$dataobj isa Rappture::Field} valid] != 0 || !$valid} {
2122        return 0
2123    }
2124    return 1
2125}
2126
2127# ----------------------------------------------------------------------
2128# USAGE: ReceiveLegend <colormap> <title> <vmin> <vmax> <size>
2129#
2130# Invoked automatically whenever the "legend" command comes in from
2131# the rendering server.  Indicates that binary image data with the
2132# specified <size> will follow.
2133# ----------------------------------------------------------------------
2134itcl::body Rappture::VtkVolumeViewer::ReceiveLegend { colormap title vmin vmax size } {
2135    set _legendPending 0
2136    if { [isconnected] } {
2137        set bytes [ReceiveBytes $size]
2138        if { ![info exists _image(legend)] } {
2139            set _image(legend) [image create photo]
2140        }
2141        $_image(legend) configure -data $bytes
2142        #puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
2143        if { [catch {DrawLegend} errs] != 0 } {
2144            puts stderr errs=$errs
2145        }
2146    }
2147}
2148
2149#
2150# DrawLegend --
2151#
2152#       Draws the legend in it's own canvas which resides to the right
2153#       of the contour plot area.
2154#
2155itcl::body Rappture::VtkVolumeViewer::DrawLegend { } {
2156    set fname $_curFldName
2157    set c $itk_component(view)
2158    set w [winfo width $c]
2159    set h [winfo height $c]
2160    set font "Arial 8"
2161    set lineht [font metrics $font -linespace]
2162   
2163    if { [info exists _fields($fname)] } {
2164        foreach { title units } $_fields($fname) break
2165        if { $units != "" } {
2166            set title [format "%s (%s)" $title $units]
2167        }
2168    } else {
2169        set title $fname
2170    }
2171    if { $_settings(-legendvisible) } {
2172        set x [expr $w - 2]
2173        if { [$c find withtag "legend"] == "" } {
2174            set y 2
2175            $c create text $x $y \
2176                -anchor ne \
2177                -fill $itk_option(-plotforeground) -tags "title legend" \
2178                -font $font
2179            incr y $lineht
2180            $c create text $x $y \
2181                -anchor ne \
2182                -fill $itk_option(-plotforeground) -tags "vmax legend" \
2183                -font $font
2184            incr y $lineht
2185            $c create image $x $y \
2186                -anchor ne \
2187                -image $_image(legend) -tags "colormap legend"
2188            $c create text $x [expr {$h-2}] \
2189                -anchor se \
2190                -fill $itk_option(-plotforeground) -tags "vmin legend" \
2191                -font $font
2192            #$c bind colormap <Enter> [itcl::code $this EnterLegend %x %y]
2193            $c bind colormap <Leave> [itcl::code $this LeaveLegend]
2194            $c bind colormap <Motion> [itcl::code $this MotionLegend %x %y]
2195        }
2196        $c bind title <ButtonPress> [itcl::code $this Combo post]
2197        $c bind title <Enter> [itcl::code $this Combo activate]
2198        $c bind title <Leave> [itcl::code $this Combo deactivate]
2199        # Reset the item coordinates according the current size of the plot.
2200        $c itemconfigure title -text $title
2201        if { [info exists _limits($_curFldName)] } {
2202            foreach { vmin vmax } $_limits($_curFldName) break
2203            $c itemconfigure vmin -text [format %g $vmin]
2204            $c itemconfigure vmax -text [format %g $vmax]
2205        }
2206        set y 2
2207        $c coords title $x $y
2208        incr y $lineht
2209        $c coords vmax $x $y
2210        incr y $lineht
2211        $c coords colormap $x $y
2212        $c coords vmin $x [expr {$h - 2}]
2213    }
2214}
2215
2216#
2217# EnterLegend --
2218#
2219itcl::body Rappture::VtkVolumeViewer::EnterLegend { x y } {
2220    SetLegendTip $x $y
2221}
2222
2223#
2224# MotionLegend --
2225#
2226itcl::body Rappture::VtkVolumeViewer::MotionLegend { x y } {
2227    Rappture::Tooltip::tooltip cancel
2228    set c $itk_component(view)
2229    SetLegendTip $x $y
2230}
2231
2232#
2233# LeaveLegend --
2234#
2235itcl::body Rappture::VtkVolumeViewer::LeaveLegend { } {
2236    Rappture::Tooltip::tooltip cancel
2237    .rappturetooltip configure -icon ""
2238}
2239
2240#
2241# SetLegendTip --
2242#
2243itcl::body Rappture::VtkVolumeViewer::SetLegendTip { x y } {
2244    set c $itk_component(view)
2245    set w [winfo width $c]
2246    set h [winfo height $c]
2247    set font "Arial 8"
2248    set lineht [font metrics $font -linespace]
2249   
2250    set imgHeight [image height $_image(legend)]
2251    set coords [$c coords colormap]
2252    set imgX [expr $w - [image width $_image(legend)] - 2]
2253    set imgY [expr $y - 2 * ($lineht + 2)]
2254
2255    if { [info exists _fields($_title)] } {
2256        foreach { title units } $_fields($_title) break
2257        if { $units != "" } {
2258            set title [format "%s (%s)" $title $units]
2259        }
2260    } else {
2261        set title $_title
2262    }
2263    # Make a swatch of the selected color
2264    if { [catch { $_image(legend) get 10 $imgY } pixel] != 0 } {
2265        #puts stderr "out of range: $imgY"
2266        return
2267    }
2268    if { ![info exists _image(swatch)] } {
2269        set _image(swatch) [image create photo -width 24 -height 24]
2270    }
2271    set color [eval format "\#%02x%02x%02x" $pixel]
2272    $_image(swatch) put black  -to 0 0 23 23
2273    $_image(swatch) put $color -to 1 1 22 22
2274    .rappturetooltip configure -icon $_image(swatch)
2275
2276    # Compute the value of the point
2277    if { [info exists _limits($_curFldName)] } {
2278        foreach { vmin vmax } $_limits($_curFldName) break
2279        set t [expr 1.0 - (double($imgY) / double($imgHeight-1))]
2280        set value [expr $t * ($vmax - $vmin) + $vmin]
2281    } else {
2282        set value 0.0
2283    }
2284    set tipx [expr $x + 15]
2285    set tipy [expr $y - 5]
2286    Rappture::Tooltip::text $c "$title $value"
2287    Rappture::Tooltip::tooltip show $c +$tipx,+$tipy   
2288}
2289
2290
2291# ----------------------------------------------------------------------
2292# USAGE: Slice move x|y|z <newval>
2293#
2294# Called automatically when the user drags the slider to move the
2295# cut plane that slices 3D data.  Gets the current value from the
2296# slider and moves the cut plane to the appropriate point in the
2297# data set.
2298# ----------------------------------------------------------------------
2299itcl::body Rappture::VtkVolumeViewer::Slice {option args} {
2300    switch -- $option {
2301        "move" {
2302            set axis [lindex $args 0]
2303            set newval [lindex $args 1]
2304            if {[llength $args] != 2} {
2305                error "wrong # args: should be \"Slice move x|y|z newval\""
2306            }
2307            set newpos [expr {0.01*$newval}]
2308            SendCmd "$_cutplaneCmd slice $axis $newpos"
2309        }
2310        "tooltip" {
2311            set axis [lindex $args 0]
2312            set val [$itk_component(${axis}CutScale) get]
2313            return "Move the [string toupper $axis] cut plane.\nCurrently:  $axis = $val%"
2314        }
2315        default {
2316            error "bad option \"$option\": should be axis, move, or tooltip"
2317        }
2318    }
2319}
2320
2321# ----------------------------------------------------------------------
2322# USAGE: _dropdown post
2323# USAGE: _dropdown unpost
2324# USAGE: _dropdown select
2325#
2326# Used internally to handle the dropdown list for this combobox.  The
2327# post/unpost options are invoked when the list is posted or unposted
2328# to manage the relief of the controlling button.  The select option
2329# is invoked whenever there is a selection from the list, to assign
2330# the value back to the gauge.
2331# ----------------------------------------------------------------------
2332itcl::body Rappture::VtkVolumeViewer::Combo {option} {
2333    set c $itk_component(view)
2334    switch -- $option {
2335        post {
2336            foreach { x1 y1 x2 y2 } [$c bbox title] break
2337            set x1 [expr [winfo width $itk_component(view)] - [winfo reqwidth $itk_component(fieldmenu)]]
2338            set x [expr $x1 + [winfo rootx $itk_component(view)]]
2339            set y [expr $y2 + [winfo rooty $itk_component(view)]]
2340            tk_popup $itk_component(fieldmenu) $x $y
2341        }
2342        activate {
2343            $c itemconfigure title -fill red
2344        }
2345        deactivate {
2346            $c itemconfigure title -fill $itk_option(-plotforeground)
2347        }
2348        invoke {
2349            $itk_component(field) value $_curFldLabel
2350            AdjustSetting -field
2351        }
2352        default {
2353            error "bad option \"$option\": should be post, unpost, select"
2354        }
2355    }
2356}
2357
2358itcl::body Rappture::VtkVolumeViewer::SetOrientation { side } {
2359    array set positions {
2360        front "1 0 0 0"
2361        back  "0 0 1 0"
2362        left  "0.707107 0 -0.707107 0"
2363        right "0.707107 0 0.707107 0"
2364        top   "0.707107 -0.707107 0 0"
2365        bottom "0.707107 0.707107 0 0"
2366    }
2367    foreach name { -qw -qx -qy -qz } value $positions($side) {
2368        set _view($name) $value
2369    }
2370    set q [ViewToQuaternion]
2371    $_arcball quaternion $q
2372    SendCmd "camera orient $q"
2373    SendCmd "camera reset"
2374    set _view(-xpan) 0
2375    set _view(-ypan) 0
2376    set _view(-zoom) 1.0
2377}
Note: See TracBrowser for help on using the repository browser.