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

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

merge r4765 from trunk

File size: 81.1 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            puts $f $bytes
852            close $f
853        }
854        $_image(plot) configure -data $bytes
855        #puts stderr "[clock format [clock seconds]]: received image [image width $_image(plot)]x[image height $_image(plot)] image>"
856        if { $_start > 0 } {
857            set finish [clock clicks -milliseconds]
858            #puts stderr "round trip time [expr $finish -$_start] milliseconds"
859            set _start 0
860        }
861    } elseif { $info(type) == "print" } {
862        set tag $this-print-$info(-token)
863        set _hardcopy($tag) $bytes
864    }
865    if { $_legendPending } {
866        RequestLegend
867    }
868}
869
870#
871# ReceiveDataset --
872#
873itcl::body Rappture::VtkVolumeViewer::ReceiveDataset { args } {
874    if { ![isconnected] } {
875        return
876    }
877    set option [lindex $args 0]
878    switch -- $option {
879        "scalar" {
880            set option [lindex $args 1]
881            switch -- $option {
882                "world" {
883                    foreach { x y z value tag } [lrange $args 2 end] break
884                }
885                "pixel" {
886                    foreach { x y value tag } [lrange $args 2 end] break
887                }
888            }
889        }
890        "vector" {
891            set option [lindex $args 1]
892            switch -- $option {
893                "world" {
894                    foreach { x y z vx vy vz tag } [lrange $args 2 end] break
895                }
896                "pixel" {
897                    foreach { x y vx vy vz tag } [lrange $args 2 end] break
898                }
899            }
900        }
901        "names" {
902            foreach { name } [lindex $args 1] {
903                #puts stderr "Dataset: $name"
904            }
905        }
906        default {
907            error "unknown dataset option \"$option\" from server"
908        }
909    }
910}
911
912# ----------------------------------------------------------------------
913# USAGE: Rebuild
914#
915# Called automatically whenever something changes that affects the
916# data in the widget.  Clears any existing data and rebuilds the
917# widget to display new data.
918# ----------------------------------------------------------------------
919itcl::body Rappture::VtkVolumeViewer::Rebuild {} {
920    set w [winfo width $itk_component(view)]
921    set h [winfo height $itk_component(view)]
922
923    if { $w < 2 || $h < 2 } {
924        $_dispatcher event -idle !rebuild
925        return
926    }
927
928    # Turn on buffering of commands to the server.  We don't want to
929    # be preempted by a server disconnect/reconnect (which automatically
930    # generates a new call to Rebuild).   
931    StartBufferingCommands
932
933    set _legendPending 1
934
935    if { $_width != $w || $_height != $h || $_reset } {
936        set _width $w
937        set _height $h
938        $_arcball resize $w $h
939        DoResize
940    }
941    if { $_reset } {
942        #
943        # Reset the camera and other view parameters
944        #
945        $_arcball quaternion [ViewToQuaternion]
946        if {$_view(-ortho)} {
947            SendCmd "camera mode ortho"
948        } else {
949            SendCmd "camera mode persp"
950        }
951        DoRotate
952        PanCamera
953        set _first ""
954        InitSettings -background \
955            -xgrid -ygrid -zgrid -axisflymode \
956            -axesvisible -axislabels -axisminorticks
957        StopBufferingCommands
958        SendCmd "imgflush"
959        StartBufferingCommands
960     }
961    set _first ""
962
963    SendCmd "dataset visible 0"
964    foreach dataobj [get -objects] {
965        if { [info exists _obj2ovride($dataobj-raise)] &&  $_first == "" } {
966            set _first $dataobj
967        }
968        set _obj2datasets($dataobj) ""
969        foreach comp [$dataobj components] {
970            set tag $dataobj-$comp
971            if { ![info exists _datasets($tag)] } {
972                set bytes [$dataobj vtkdata $comp]
973                set length [string length $bytes]
974                if { $_reportClientInfo }  {
975                    set info {}
976                    lappend info "tool_id"       [$dataobj hints toolid]
977                    lappend info "tool_name"     [$dataobj hints toolname]
978                    lappend info "tool_title"    [$dataobj hints tooltitle]
979                    lappend info "tool_command"  [$dataobj hints toolcommand]
980                    lappend info "tool_revision" [$dataobj hints toolrevision]
981                    lappend info "dataset_label" [$dataobj hints label]
982                    lappend info "dataset_size"  $length
983                    lappend info "dataset_tag"   $tag
984                    SendCmd "clientinfo [list $info]"
985                }
986                SendCmd "dataset add $tag data follows $length"
987                append _outbuf $bytes
988                set _datasets($tag) 1
989                SetObjectStyle $dataobj $comp
990            }
991            lappend _obj2datasets($dataobj) $tag
992            if { [info exists _obj2ovride($dataobj-raise)] } {
993                SendCmd "volume visible 1 $tag"
994            }
995            break
996        }
997    }
998    if {"" != $_first} {
999        set location [$_first hints camera]
1000        if { $location != "" } {
1001            array set view $location
1002        }
1003
1004        foreach axis { x y z } {
1005            set label [$_first hints ${axis}label]
1006            if { $label != "" } {
1007                SendCmd [list axis name $axis $label]
1008            }
1009            set units [$_first hints ${axis}units]
1010            if { $units != "" } {
1011                SendCmd [list axis units $axis $units]
1012            }
1013        }
1014        $itk_component(field) choices delete 0 end
1015        $itk_component(fieldmenu) delete 0 end
1016        array unset _fields
1017        set _curFldName ""
1018        foreach cname [$_first components] {
1019            foreach fname [$_first fieldnames $cname] {
1020                if { [info exists _fields($fname)] } {
1021                    continue
1022                }
1023                foreach { label units components } \
1024                    [$_first fieldinfo $fname] break
1025                # Only scalar fields are valid
1026                if {$components == 1} {
1027                    $itk_component(field) choices insert end "$fname" "$label"
1028                    $itk_component(fieldmenu) add radiobutton -label "$label" \
1029                        -value $label -variable [itcl::scope _curFldLabel] \
1030                        -selectcolor red \
1031                        -activebackground $itk_option(-plotbackground) \
1032                        -activeforeground $itk_option(-plotforeground) \
1033                        -font "Arial 8" \
1034                        -command [itcl::code $this Combo invoke]
1035                    set _fields($fname) [list $label $units $components]
1036                    if { $_curFldName == "" } {
1037                        set _curFldName $fname
1038                        set _curFldLabel $label
1039                    }
1040                }
1041            }
1042        }
1043        $itk_component(field) value $_curFldLabel
1044    }
1045
1046    InitSettings -volumepalette \
1047        -volumematerial \
1048        -volumelighting -volumeopacity -volumequality -volumeoutline -volumevisible \
1049        -cutplanesvisible \
1050        -xcutplaneposition -ycutplaneposition -zcutplaneposition \
1051        -xcutplanevisible -ycutplanevisible -zcutplanevisible
1052
1053    if { $_reset } {
1054        Zoom reset
1055        set _reset 0
1056    }
1057    # Actually write the commands to the server socket.  If it fails, we don't
1058    # care.  We're finished here.
1059    blt::busy hold $itk_component(hull)
1060    StopBufferingCommands
1061    blt::busy release $itk_component(hull)
1062}
1063
1064# ----------------------------------------------------------------------
1065# USAGE: CurrentDatasets ?-all -visible? ?dataobjs?
1066#
1067# Returns a list of server IDs for the current datasets being displayed.  This
1068# is normally a single ID, but it might be a list of IDs if the current data
1069# object has multiple components.
1070# ----------------------------------------------------------------------
1071itcl::body Rappture::VtkVolumeViewer::CurrentDatasets {args} {
1072    set flag [lindex $args 0]
1073    switch -- $flag {
1074        "-all" {
1075            if { [llength $args] > 1 } {
1076                error "CurrentDatasets: can't specify dataobj after \"-all\""
1077            }
1078            set dlist [get -objects]
1079        }
1080        "-visible" {
1081            if { [llength $args] > 1 } {
1082                set dlist {}
1083                set args [lrange $args 1 end]
1084                foreach dataobj $args {
1085                    if { [info exists _obj2ovride($dataobj-raise)] } {
1086                        lappend dlist $dataobj
1087                    }
1088                }
1089            } else {
1090                set dlist [get -visible]
1091            }
1092        }           
1093        default {
1094            set dlist $args
1095        }
1096    }
1097    set rlist ""
1098    foreach dataobj $dlist {
1099        foreach comp [$dataobj components] {
1100            set tag $dataobj-$comp
1101            if { [info exists _datasets($tag)] && $_datasets($tag) } {
1102                lappend rlist $tag
1103            }
1104        }
1105    }
1106    return $rlist
1107}
1108
1109# ----------------------------------------------------------------------
1110# USAGE: Zoom in
1111# USAGE: Zoom out
1112# USAGE: Zoom reset
1113#
1114# Called automatically when the user clicks on one of the zoom
1115# controls for this widget.  Changes the zoom for the current view.
1116# ----------------------------------------------------------------------
1117itcl::body Rappture::VtkVolumeViewer::Zoom {option} {
1118    switch -- $option {
1119        "in" {
1120            set _view(-zoom) [expr {$_view(-zoom)*1.25}]
1121            SendCmd "camera zoom $_view(-zoom)"
1122        }
1123        "out" {
1124            set _view(-zoom) [expr {$_view(-zoom)*0.8}]
1125            SendCmd "camera zoom $_view(-zoom)"
1126        }
1127        "reset" {
1128            array set _view {
1129                -qw      0.853553
1130                -qx      -0.353553
1131                -qy      0.353553
1132                -qz      0.146447
1133                -xpan    0
1134                -ypan    0
1135                -zoom    1.0
1136            }
1137            if { $_first != "" } {
1138                set location [$_first hints camera]
1139                if { $location != "" } {
1140                    array set _view $location
1141                }
1142            }
1143            $_arcball quaternion [ViewToQuaternion]
1144            DoRotate
1145            SendCmd "camera reset"
1146        }
1147    }
1148}
1149
1150itcl::body Rappture::VtkVolumeViewer::PanCamera {} {
1151    set x $_view(-xpan)
1152    set y $_view(-ypan)
1153    SendCmd "camera pan $x $y"
1154}
1155
1156# ----------------------------------------------------------------------
1157# USAGE: Rotate click <x> <y>
1158# USAGE: Rotate drag <x> <y>
1159# USAGE: Rotate release <x> <y>
1160#
1161# Called automatically when the user clicks/drags/releases in the
1162# plot area.  Moves the plot according to the user's actions.
1163# ----------------------------------------------------------------------
1164itcl::body Rappture::VtkVolumeViewer::Rotate {option x y} {
1165    switch -- $option {
1166        "click" {
1167            $itk_component(view) configure -cursor fleur
1168            set _click(x) $x
1169            set _click(y) $y
1170        }
1171        "drag" {
1172            if {[array size _click] == 0} {
1173                Rotate click $x $y
1174            } else {
1175                set w [winfo width $itk_component(view)]
1176                set h [winfo height $itk_component(view)]
1177                if {$w <= 0 || $h <= 0} {
1178                    return
1179                }
1180
1181                if {[catch {
1182                    # this fails sometimes for no apparent reason
1183                    set dx [expr {double($x-$_click(x))/$w}]
1184                    set dy [expr {double($y-$_click(y))/$h}]
1185                }]} {
1186                    return
1187                }
1188                if { $dx == 0 && $dy == 0 } {
1189                    return
1190                }
1191                set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1192                EventuallyRotate $q
1193                set _click(x) $x
1194                set _click(y) $y
1195            }
1196        }
1197        "release" {
1198            Rotate drag $x $y
1199            $itk_component(view) configure -cursor ""
1200            catch {unset _click}
1201        }
1202        default {
1203            error "bad option \"$option\": should be click, drag, release"
1204        }
1205    }
1206}
1207
1208itcl::body Rappture::VtkVolumeViewer::Pick {x y} {
1209    foreach tag [CurrentDatasets -visible] {
1210        SendCmd "dataset getscalar pixel $x $y $tag"
1211    }
1212}
1213
1214# ----------------------------------------------------------------------
1215# USAGE: $this Pan click x y
1216#        $this Pan drag x y
1217#        $this Pan release x y
1218#
1219# Called automatically when the user clicks on one of the zoom
1220# controls for this widget.  Changes the zoom for the current view.
1221# ----------------------------------------------------------------------
1222itcl::body Rappture::VtkVolumeViewer::Pan {option x y} {
1223    switch -- $option {
1224        "set" {
1225            set w [winfo width $itk_component(view)]
1226            set h [winfo height $itk_component(view)]
1227            set x [expr $x / double($w)]
1228            set y [expr $y / double($h)]
1229            set _view(-xpan) [expr $_view(-xpan) + $x]
1230            set _view(-ypan) [expr $_view(-ypan) + $y]
1231            PanCamera
1232            return
1233        }
1234        "click" {
1235            set _click(x) $x
1236            set _click(y) $y
1237            $itk_component(view) configure -cursor hand1
1238        }
1239        "drag" {
1240            if { ![info exists _click(x)] } {
1241                set _click(x) $x
1242            }
1243            if { ![info exists _click(y)] } {
1244                set _click(y) $y
1245            }
1246            set w [winfo width $itk_component(view)]
1247            set h [winfo height $itk_component(view)]
1248            set dx [expr ($_click(x) - $x)/double($w)]
1249            set dy [expr ($_click(y) - $y)/double($h)]
1250            set _click(x) $x
1251            set _click(y) $y
1252            set _view(-xpan) [expr $_view(-xpan) - $dx]
1253            set _view(-ypan) [expr $_view(-ypan) - $dy]
1254            PanCamera
1255        }
1256        "release" {
1257            Pan drag $x $y
1258            $itk_component(view) configure -cursor ""
1259        }
1260        default {
1261            error "unknown option \"$option\": should set, click, drag, or release"
1262        }
1263    }
1264}
1265
1266# ----------------------------------------------------------------------
1267# USAGE: InitSettings <what> ?<value>?
1268#
1269# Used internally to update rendering settings whenever parameters
1270# change in the popup settings panel.  Sends the new settings off
1271# to the back end.
1272# ----------------------------------------------------------------------
1273itcl::body Rappture::VtkVolumeViewer::InitSettings { args } {
1274    foreach spec $args {
1275        if { [info exists _settings($_first${spec})] } {
1276            # Reset global setting with dataobj specific setting
1277            set _settings($spec) $_settings($_first${spec})
1278        }
1279        AdjustSetting $spec
1280    }
1281}
1282
1283#
1284# AdjustSetting --
1285#
1286#       Changes/updates a specific setting in the widget.  There are
1287#       usually user-setable option.  Commands are sent to the render
1288#       server.
1289#
1290itcl::body Rappture::VtkVolumeViewer::AdjustSetting {what {value ""}} {
1291    if { ![isconnected] } {
1292        return
1293    }
1294    switch -- $what {
1295        "-background" {
1296            set bgcolor [$itk_component(background) value]
1297            set _settings($what) $bgcolor
1298            array set fgcolors {
1299                "black" "white"
1300                "white" "black"
1301                "grey"  "black"
1302            }
1303            configure -plotbackground $bgcolor \
1304                -plotforeground $fgcolors($bgcolor)
1305            $itk_component(view) delete "legend"
1306            DrawLegend
1307        }
1308        "-volumeoutline" {
1309            set bool $_settings($what)
1310            SendCmd "outline visible 0"
1311            foreach tag [CurrentDatasets -visible] {
1312                SendCmd "outline visible $bool $tag"
1313            }
1314        }
1315        "-legendvisible" {
1316            set bool $_settings($what)
1317        }
1318        "-volumevisible" {
1319            set bool $_settings($what)
1320            foreach tag [CurrentDatasets -visible] {
1321                SendCmd "volume visible $bool $tag"
1322            }
1323            if { $bool } {
1324                Rappture::Tooltip::for $itk_component(volume) \
1325                    "Hide the volume"
1326            } else {
1327                Rappture::Tooltip::for $itk_component(volume) \
1328                    "Show the volume"
1329            }
1330        }
1331        "-volumematerial" {
1332            set val $_settings($what)
1333            set diffuse [expr {0.01*$val}]
1334            set specular [expr {0.01*$val}]
1335            #set power [expr {sqrt(160*$val+1.0)}]
1336            set power [expr {$val+1.0}]
1337            foreach tag [CurrentDatasets -visible] {
1338                SendCmd "volume shading diffuse $diffuse $tag"
1339                SendCmd "volume shading specular $specular $power $tag"
1340            }
1341        }
1342        "-volumelighting" {
1343            set bool $_settings($what)
1344            foreach tag [CurrentDatasets -visible] {
1345                SendCmd "volume lighting $bool $tag"
1346            }
1347        }
1348        "-volumeopacity" {
1349            set val $_settings($what)
1350            set val [expr {0.01*$val}]
1351            foreach tag [CurrentDatasets -visible] {
1352                SendCmd "volume opacity $val $tag"
1353            }
1354        }
1355        "-volumequality" {
1356            set val $_settings($what)
1357            set val [expr {0.01*$val}]
1358            foreach tag [CurrentDatasets -visible] {
1359                SendCmd "volume quality $val $tag"
1360            }
1361        }
1362        "-axesvisible" {
1363            set bool $_settings($what)
1364            SendCmd "axis visible all $bool"
1365        }
1366        "-axislabels" {
1367            set bool $_settings($what)
1368            SendCmd "axis labels all $bool"
1369        }
1370        "-axisminorticks" {
1371            set bool $_settings($what)
1372            SendCmd "axis minticks all $bool"
1373        }
1374        "-xgrid" - "-ygrid" - "-zgrid" {
1375            set axis [string range $what 1 1]
1376            set bool $_settings($what)
1377            SendCmd "axis grid $axis $bool"
1378        }
1379        "-axisflymode" {
1380            set mode [$itk_component(axismode) value]
1381            set mode [$itk_component(axismode) translate $mode]
1382            set _settings($what) $mode
1383            SendCmd "axis flymode $mode"
1384        }
1385        "-cutplanesvisible" {
1386            set bool $_settings($what)
1387            foreach dataset [CurrentDatasets -visible] {
1388                SendCmd "$_cutplaneCmd visible $bool $dataset"
1389            }
1390        }
1391        "-cutplanelighting" {
1392            set bool $_settings($what)
1393            foreach dataset [CurrentDatasets -visible] {
1394                if {$_cutplaneCmd != "imgcutplane"} {
1395                    SendCmd "$_cutplaneCmd lighting $bool $dataset"
1396                } else {
1397                    if {$bool} {
1398                        set ambient 0.0
1399                        set diffuse 1.0
1400                    } else {
1401                        set ambient 1.0
1402                        set diffuse 0.0
1403                    }
1404                    SendCmd "imgcutplane material $ambient $diffuse $dataset"
1405                }
1406            }
1407        }
1408        "-cutplaneopacity" {
1409            set val $_settings($what)
1410            set sval [expr { 0.01 * double($val) }]
1411            foreach dataset [CurrentDatasets -visible] {
1412                SendCmd "$_cutplaneCmd opacity $sval $dataset"
1413            }
1414        }
1415        "-xcutplanevisible" - "-ycutplanevisible" - "-zcutplanevisible" {
1416            set axis [string range $what 1 1]
1417            set bool $_settings($what)
1418            if { $bool } {
1419                $itk_component(${axis}CutScale) configure -state normal \
1420                    -troughcolor white
1421            } else {
1422                $itk_component(${axis}CutScale) configure -state disabled \
1423                    -troughcolor grey82
1424            }
1425            foreach dataset [CurrentDatasets -visible] {
1426                SendCmd "$_cutplaneCmd axis $axis $bool $dataset"
1427            }
1428        }
1429        "-xcutplaneposition" - "-ycutplaneposition" - "-zcutplaneposition" {
1430            set axis [string range $what 1 1]
1431            set pos [expr $_settings($what) * 0.01]
1432            foreach dataset [CurrentDatasets -visible] {
1433                SendCmd "$_cutplaneCmd slice ${axis} ${pos} $dataset"
1434            }
1435            set _cutplanePending 0
1436        }
1437        "-volumepalette" {
1438            set palette [$itk_component(palette) value]
1439            set _settings($what) $palette
1440            foreach dataset [CurrentDatasets -visible $_first] {
1441                foreach {dataobj comp} [split $dataset -] break
1442                ChangeColormap $dataobj $comp $palette
1443            }
1444            set _legendPending 1
1445        }
1446        "-field" {
1447            set label [$itk_component(field) value]
1448            set fname [$itk_component(field) translate $label]
1449            set _settings($what) $fname
1450            if { [info exists _fields($fname)] } {
1451                foreach { label units components } $_fields($fname) break
1452                if { $components > 1 } {
1453                    puts stderr "Can't use a vector field in a volume"
1454                    return
1455                } else {
1456                    set _colorMode scalar
1457                }
1458                set _curFldName $fname
1459                set _curFldLabel $label
1460            } else {
1461                puts stderr "unknown field \"$fname\""
1462                return
1463            }
1464            foreach dataset [CurrentDatasets -visible $_first] {
1465                #SendCmd "volume colormode $_colorMode ${fname} $dataset"
1466                SendCmd "$_cutplaneCmd colormode $_colorMode ${fname} $dataset"
1467            }
1468            SendCmd "camera reset"
1469            DrawLegend
1470        }
1471        default {
1472            error "don't know how to fix $what"
1473        }
1474    }
1475}
1476
1477#
1478# RequestLegend --
1479#
1480#       Request a new legend from the server.  The size of the legend
1481#       is determined from the height of the canvas.  It will be rotated
1482#       to be vertical when drawn.
1483#
1484itcl::body Rappture::VtkVolumeViewer::RequestLegend {} {
1485    set font "Arial 8"
1486    set lineht [font metrics $font -linespace]
1487    set c $itk_component(legend)
1488    set w 12
1489    set h [expr {$_height - 3 * ($lineht + 2)}]
1490    if { $h < 1} {
1491        return
1492    }
1493    # Set the legend on the first volume dataset.
1494    foreach dataset [CurrentDatasets -visible $_first] {
1495        foreach {dataobj comp} [split $dataset -] break
1496        if { [info exists _dataset2style($dataset)] } {
1497            SendCmdNoWait \
1498                "legend $_dataset2style($dataset) $_colorMode $_curFldName {} $w $h 0"
1499            break;
1500        }
1501    }
1502}
1503
1504#
1505# ChangeColormap --
1506#
1507itcl::body Rappture::VtkVolumeViewer::ChangeColormap {dataobj comp color} {
1508    set tag $dataobj-$comp
1509    if { ![info exist _style($tag)] } {
1510        error "no initial colormap"
1511    }
1512    array set style $_style($tag)
1513    set style(-color) $color
1514    set _style($tag) [array get style]
1515    SetColormap $dataobj $comp
1516}
1517
1518#
1519# SetColormap --
1520#
1521itcl::body Rappture::VtkVolumeViewer::SetColormap { dataobj comp } {
1522    array set style {
1523        -color BCGYR
1524        -levels 6
1525    }
1526    set tag $dataobj-$comp
1527    if { ![info exists _initialStyle($tag)] } {
1528        # Save the initial component style.
1529        set _initialStyle($tag) [$dataobj style $comp]
1530    }
1531
1532    # Override defaults with initial style defined in xml.
1533    array set style $_initialStyle($tag)
1534
1535    if { ![info exists _style($tag)] } {
1536        set _style($tag) [array get style]
1537    }
1538    # Override initial style with current style.
1539    array set style $_style($tag)
1540
1541    set name "$style(-color):$style(-levels)"
1542    if { ![info exists _colormaps($name)] } {
1543        BuildColormap $name [array get style]
1544        set _colormaps($name) 1
1545    }
1546    if { ![info exists _dataset2style($tag)] ||
1547         $_dataset2style($tag) != $name } {
1548        SendCmd "volume colormap $name $tag"
1549        SendCmd "$_cutplaneCmd colormap $name-opaque $tag"
1550        set _dataset2style($tag) $name
1551    }
1552}
1553
1554#
1555# BuildColormap --
1556#
1557itcl::body Rappture::VtkVolumeViewer::BuildColormap { name styles } {
1558    array set style $styles
1559    set cmap [ColorsToColormap $style(-color)]
1560    if { [llength $cmap] == 0 } {
1561        set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0"
1562    }
1563    set max 1.0
1564
1565    set opaqueWmap "0.0 1.0 1.0 1.0"
1566    #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"
1567    # Approximate cubic opacity curve
1568    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"
1569    SendCmd "colormap add $name { $cmap } { $wmap }"
1570    SendCmd "colormap add $name-opaque { $cmap } { $opaqueWmap }"
1571}
1572
1573# ----------------------------------------------------------------------
1574# CONFIGURATION OPTION: -plotbackground
1575# ----------------------------------------------------------------------
1576itcl::configbody Rappture::VtkVolumeViewer::plotbackground {
1577    if { [isconnected] } {
1578        set color $itk_option(-plotbackground)
1579        set rgb [Color2RGB $color]
1580        SendCmd "screen bgcolor $rgb"
1581        $itk_component(legend) configure -background $color
1582    }
1583}
1584
1585# ----------------------------------------------------------------------
1586# CONFIGURATION OPTION: -plotforeground
1587# ----------------------------------------------------------------------
1588itcl::configbody Rappture::VtkVolumeViewer::plotforeground {
1589    if { [isconnected] } {
1590        set color $itk_option(-plotforeground)
1591        set rgb [Color2RGB $color]
1592        SendCmd "axis color all $rgb"
1593        SendCmd "outline color $rgb"
1594        SendCmd "$_cutplaneCmd color $rgb"
1595        $itk_component(legend) itemconfigure labels -fill $color
1596        $itk_component(legend) itemconfigure limits -fill $color
1597    }
1598}
1599
1600itcl::body Rappture::VtkVolumeViewer::BuildViewTab {} {
1601    set fg [option get $itk_component(hull) font Font]
1602    #set bfg [option get $itk_component(hull) boldFont Font]
1603
1604    set inner [$itk_component(main) insert end \
1605        -title "View Settings" \
1606        -icon [Rappture::icon wrench]]
1607    $inner configure -borderwidth 4
1608
1609    checkbutton $inner.axes \
1610        -text "Axes" \
1611        -variable [itcl::scope _settings(-axesvisible)] \
1612        -command [itcl::code $this AdjustSetting -axesvisible] \
1613        -font "Arial 9"
1614
1615    checkbutton $inner.outline \
1616        -text "Outline" \
1617        -variable [itcl::scope _settings(-volumeoutline)] \
1618        -command [itcl::code $this AdjustSetting -volumeoutline] \
1619        -font "Arial 9"
1620
1621    checkbutton $inner.legend \
1622        -text "Legend" \
1623        -variable [itcl::scope _settings(-legendvisible)] \
1624        -command [itcl::code $this AdjustSetting -legendvisible] \
1625        -font "Arial 9"
1626
1627    checkbutton $inner.volume \
1628        -text "Volume" \
1629        -variable [itcl::scope _settings(-volumevisible)] \
1630        -command [itcl::code $this AdjustSetting -volumevisible] \
1631        -font "Arial 9"
1632
1633    label $inner.background_l -text "Background" -font "Arial 9"
1634    itk_component add background {
1635        Rappture::Combobox $inner.background -width 10 -editable no
1636    }
1637    $inner.background choices insert end \
1638        "black"              "black"            \
1639        "white"              "white"            \
1640        "grey"               "grey"             
1641
1642    $itk_component(background) value $_settings(-background)
1643    bind $inner.background <<Value>> \
1644        [itcl::code $this AdjustSetting -background]
1645
1646    blt::table $inner \
1647        0,0 $inner.axes  -cspan 2 -anchor w \
1648        1,0 $inner.outline  -cspan 2 -anchor w \
1649        2,0 $inner.volume  -cspan 2 -anchor w \
1650        3,0 $inner.legend  -cspan 2 -anchor w \
1651        4,0 $inner.background_l       -anchor e -pady 2 \
1652        4,1 $inner.background                   -fill x \
1653
1654    blt::table configure $inner r* -resize none
1655    blt::table configure $inner r5 -resize expand
1656}
1657
1658itcl::body Rappture::VtkVolumeViewer::BuildVolumeTab {} {
1659    set font [option get $itk_component(hull) font Font]
1660    #set bfont [option get $itk_component(hull) boldFont Font]
1661
1662    set inner [$itk_component(main) insert end \
1663        -title "Volume Settings" \
1664        -icon [Rappture::icon volume-on]]
1665    $inner configure -borderwidth 4
1666
1667    checkbutton $inner.visibility \
1668        -text "Visible" \
1669        -font $font \
1670        -variable [itcl::scope _settings(-volumevisible)] \
1671        -command [itcl::code $this AdjustSetting -volumevisible]
1672
1673    checkbutton $inner.lighting \
1674        -text "Enable Lighting" \
1675        -font $font \
1676        -variable [itcl::scope _settings(-volumelighting)] \
1677        -command [itcl::code $this AdjustSetting -volumelighting]
1678
1679    label $inner.dim_l -text "Dim" -font $font
1680    ::scale $inner.material -from 0 -to 100 -orient horizontal \
1681        -variable [itcl::scope _settings(-volumematerial)] \
1682        -showvalue off -command [itcl::code $this AdjustSetting -volumematerial]
1683    label $inner.bright_l -text "Bright" -font $font
1684
1685    label $inner.opacity_l -text "Opacity" -font $font
1686    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1687        -variable [itcl::scope _settings(-volumeopacity)] \
1688        -showvalue off \
1689        -command [itcl::code $this AdjustSetting -volumeopacity]
1690
1691    label $inner.quality_l -text "Quality" -font $font
1692    ::scale $inner.quality -from 0 -to 100 -orient horizontal \
1693        -variable [itcl::scope _settings(-volumequality)] \
1694        -showvalue off \
1695        -command [itcl::code $this AdjustSetting -volumequality]
1696
1697    label $inner.field_l -text "Field" -font $font
1698    itk_component add field {
1699        Rappture::Combobox $inner.field -editable no
1700    }
1701    bind $inner.field <<Value>> \
1702        [itcl::code $this AdjustSetting -field]
1703
1704    label $inner.palette_l -text "Palette" -font $font
1705    itk_component add palette {
1706        Rappture::Combobox $inner.palette -editable no
1707    }
1708    $inner.palette choices insert end [GetColormapList]
1709    $itk_component(palette) value "BCGYR"
1710    bind $inner.palette <<Value>> \
1711        [itcl::code $this AdjustSetting -volumepalette]
1712
1713    blt::table $inner \
1714        0,0 $inner.field_l   -anchor w -pady 2  \
1715        0,1 $inner.field     -fill x   -pady 2 -cspan 3 \
1716        1,0 $inner.visibility -anchor w -pady 2 -cspan 4 \
1717        2,0 $inner.lighting  -anchor w -pady 2 -cspan 4 \
1718        3,0 $inner.dim_l     -anchor e -pady 2 \
1719        3,1 $inner.material  -fill x   -pady 2 -cspan 2 \
1720        3,3 $inner.bright_l  -anchor w -pady 2 \
1721        4,0 $inner.opacity_l -anchor w -pady 2 -cspan 4 \
1722        5,0 $inner.opacity   -fill x   -pady 2 -cspan 4 \
1723        6,0 $inner.quality_l -anchor w -pady 2 -cspan 4 \
1724        7,0 $inner.quality   -fill x   -pady 2 -cspan 4 \
1725        8,0 $inner.palette_l -anchor w -pady 2  \
1726        8,1 $inner.palette   -fill x   -pady 2 -cspan 3 \
1727
1728    blt::table configure $inner r* c0 c1 c3 -resize none
1729    blt::table configure $inner r9 c2 -resize expand
1730}
1731
1732itcl::body Rappture::VtkVolumeViewer::BuildAxisTab {} {
1733    set fg [option get $itk_component(hull) font Font]
1734    #set bfg [option get $itk_component(hull) boldFont Font]
1735
1736    set inner [$itk_component(main) insert end \
1737        -title "Axis Settings" \
1738        -icon [Rappture::icon axis2]]
1739    $inner configure -borderwidth 4
1740
1741    checkbutton $inner.visible \
1742        -text "Axes" \
1743        -variable [itcl::scope _settings(-axesvisible)] \
1744        -command [itcl::code $this AdjustSetting -axesvisible] \
1745        -font "Arial 9"
1746
1747    checkbutton $inner.labels \
1748        -text "Axis Labels" \
1749        -variable [itcl::scope _settings(-axislabels)] \
1750        -command [itcl::code $this AdjustSetting -axislabels] \
1751        -font "Arial 9"
1752    label $inner.grid_l -text "Grid" -font "Arial 9"
1753    checkbutton $inner.xgrid \
1754        -text "X" \
1755        -variable [itcl::scope _settings(-xgrid)] \
1756        -command [itcl::code $this AdjustSetting -xgrid] \
1757        -font "Arial 9"
1758    checkbutton $inner.ygrid \
1759        -text "Y" \
1760        -variable [itcl::scope _settings(-ygrid)] \
1761        -command [itcl::code $this AdjustSetting -ygrid] \
1762        -font "Arial 9"
1763    checkbutton $inner.zgrid \
1764        -text "Z" \
1765        -variable [itcl::scope _settings(-zgrid)] \
1766        -command [itcl::code $this AdjustSetting -zgrid] \
1767        -font "Arial 9"
1768    checkbutton $inner.minorticks \
1769        -text "Minor Ticks" \
1770        -variable [itcl::scope _settings(-axisminorticks)] \
1771        -command [itcl::code $this AdjustSetting -axisminorticks] \
1772        -font "Arial 9"
1773
1774    label $inner.mode_l -text "Mode" -font "Arial 9"
1775
1776    itk_component add axismode {
1777        Rappture::Combobox $inner.mode -width 10 -editable no
1778    }
1779    $inner.mode choices insert end \
1780        "static_triad"    "static" \
1781        "closest_triad"   "closest" \
1782        "furthest_triad"  "farthest" \
1783        "outer_edges"     "outer"         
1784    $itk_component(axismode) value $_settings(-axisflymode)
1785    bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axisflymode]
1786
1787    blt::table $inner \
1788        0,0 $inner.visible -anchor w -cspan 4 \
1789        1,0 $inner.labels  -anchor w -cspan 4 \
1790        2,0 $inner.minorticks  -anchor w -cspan 4 \
1791        4,0 $inner.grid_l  -anchor w \
1792        4,1 $inner.xgrid   -anchor w \
1793        4,2 $inner.ygrid   -anchor w \
1794        4,3 $inner.zgrid   -anchor w \
1795        5,0 $inner.mode_l  -anchor w -padx { 2 0 } \
1796        5,1 $inner.mode    -fill x   -cspan 3
1797
1798    blt::table configure $inner r* c* -resize none
1799    blt::table configure $inner r7 c6 -resize expand
1800    blt::table configure $inner r3 -height 0.125i
1801}
1802
1803itcl::body Rappture::VtkVolumeViewer::BuildCameraTab {} {
1804    set inner [$itk_component(main) insert end \
1805        -title "Camera Settings" \
1806        -icon [Rappture::icon camera]]
1807    $inner configure -borderwidth 4
1808
1809    label $inner.view_l -text "view" -font "Arial 9"
1810    set f [frame $inner.view]
1811    foreach side { front back left right top bottom } {
1812        button $f.$side  -image [Rappture::icon view$side] \
1813            -command [itcl::code $this SetOrientation $side]
1814        Rappture::Tooltip::for $f.$side "Change the view to $side"
1815        pack $f.$side -side left
1816    }
1817    blt::table $inner \
1818        0,0 $inner.view_l -anchor e -pady 2 \
1819        0,1 $inner.view -anchor w -pady 2
1820    blt::table configure $inner r0 -resize none
1821
1822    set row 1
1823    set labels { qx qy qz qw xpan ypan zoom }
1824    foreach tag $labels {
1825        label $inner.${tag}-label -text $tag -font "Arial 9"
1826        entry $inner.${tag} -font "Arial 9"  -bg white \
1827            -textvariable [itcl::scope _view(-$tag)]
1828        bind $inner.${tag} <Return> \
1829            [itcl::code $this camera set -${tag}]
1830        bind $inner.${tag} <KP_Enter> \
1831            [itcl::code $this camera set -${tag}]
1832        blt::table $inner \
1833            $row,0 $inner.${tag}-label -anchor e -pady 2 \
1834            $row,1 $inner.${tag} -anchor w -pady 2
1835        blt::table configure $inner r$row -resize none
1836        incr row
1837    }
1838    checkbutton $inner.ortho \
1839        -text "Orthographic Projection" \
1840        -variable [itcl::scope _view(-ortho)] \
1841        -command [itcl::code $this camera set -ortho] \
1842        -font "Arial 9"
1843    blt::table $inner \
1844            $row,0 $inner.ortho -cspan 2 -anchor w -pady 2
1845    blt::table configure $inner r$row -resize none
1846    incr row
1847
1848    blt::table configure $inner c0 c1 -resize none
1849    blt::table configure $inner c2 -resize expand
1850    blt::table configure $inner r$row -resize expand
1851}
1852
1853itcl::body Rappture::VtkVolumeViewer::BuildCutplaneTab {} {
1854    set font [option get $itk_component(hull) font Font]
1855   
1856    set inner [$itk_component(main) insert end \
1857        -title "Cutplane Settings" \
1858        -icon [Rappture::icon cutbutton]]
1859
1860    $inner configure -borderwidth 4
1861
1862    checkbutton $inner.visible \
1863        -text "Show Cutplanes" \
1864        -variable [itcl::scope _settings(-cutplanesvisible)] \
1865        -command [itcl::code $this AdjustSetting -cutplanesvisible] \
1866        -font "Arial 9"
1867
1868    checkbutton $inner.lighting \
1869        -text "Enable Lighting" \
1870        -variable [itcl::scope _settings(-cutplanelighting)] \
1871        -command [itcl::code $this AdjustSetting -cutplanelighting] \
1872        -font "Arial 9"
1873
1874    label $inner.opacity_l -text "Opacity" -font "Arial 9"
1875    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1876        -variable [itcl::scope _settings(-cutplaneopacity)] \
1877        -width 10 \
1878        -showvalue off \
1879        -command [itcl::code $this AdjustSetting -cutplaneopacity]
1880    $inner.opacity set $_settings(-cutplaneopacity)
1881
1882    # X-value slicer...
1883    itk_component add xCutButton {
1884        Rappture::PushButton $inner.xbutton \
1885            -onimage [Rappture::icon x-cutplane] \
1886            -offimage [Rappture::icon x-cutplane] \
1887            -command [itcl::code $this AdjustSetting -xcutplanevisible] \
1888            -variable [itcl::scope _settings(-xcutplanevisible)]
1889    }
1890    Rappture::Tooltip::for $itk_component(xCutButton) \
1891        "Toggle the X-axis cutplane on/off"
1892    $itk_component(xCutButton) select
1893
1894    itk_component add xCutScale {
1895        ::scale $inner.xval -from 100 -to 0 \
1896            -width 10 -orient vertical -showvalue yes \
1897            -borderwidth 1 -highlightthickness 0 \
1898            -command [itcl::code $this EventuallySetCutplane x] \
1899            -variable [itcl::scope _settings(-xcutplaneposition)]
1900    } {
1901        usual
1902        ignore -borderwidth -highlightthickness
1903    }
1904    # Set the default cutplane value before disabling the scale.
1905    $itk_component(xCutScale) set 50
1906    $itk_component(xCutScale) configure -state disabled
1907    Rappture::Tooltip::for $itk_component(xCutScale) \
1908        "@[itcl::code $this Slice tooltip x]"
1909
1910    # Y-value slicer...
1911    itk_component add yCutButton {
1912        Rappture::PushButton $inner.ybutton \
1913            -onimage [Rappture::icon y-cutplane] \
1914            -offimage [Rappture::icon y-cutplane] \
1915            -command [itcl::code $this AdjustSetting -ycutplanevisible] \
1916            -variable [itcl::scope _settings(-ycutplanevisible)]
1917    }
1918    Rappture::Tooltip::for $itk_component(yCutButton) \
1919        "Toggle the Y-axis cutplane on/off"
1920    $itk_component(yCutButton) select
1921
1922    itk_component add yCutScale {
1923        ::scale $inner.yval -from 100 -to 0 \
1924            -width 10 -orient vertical -showvalue yes \
1925            -borderwidth 1 -highlightthickness 0 \
1926            -command [itcl::code $this EventuallySetCutplane y] \
1927            -variable [itcl::scope _settings(-ycutplaneposition)]
1928    } {
1929        usual
1930        ignore -borderwidth -highlightthickness
1931    }
1932    Rappture::Tooltip::for $itk_component(yCutScale) \
1933        "@[itcl::code $this Slice tooltip y]"
1934    # Set the default cutplane value before disabling the scale.
1935    $itk_component(yCutScale) set 50
1936    $itk_component(yCutScale) configure -state disabled
1937
1938    # Z-value slicer...
1939    itk_component add zCutButton {
1940        Rappture::PushButton $inner.zbutton \
1941            -onimage [Rappture::icon z-cutplane] \
1942            -offimage [Rappture::icon z-cutplane] \
1943            -command [itcl::code $this AdjustSetting -zcutplanevisible] \
1944            -variable [itcl::scope _settings(-zcutplanevisible)]
1945    }
1946    Rappture::Tooltip::for $itk_component(zCutButton) \
1947        "Toggle the Z-axis cutplane on/off"
1948    $itk_component(zCutButton) select
1949
1950    itk_component add zCutScale {
1951        ::scale $inner.zval -from 100 -to 0 \
1952            -width 10 -orient vertical -showvalue yes \
1953            -borderwidth 1 -highlightthickness 0 \
1954            -command [itcl::code $this EventuallySetCutplane z] \
1955            -variable [itcl::scope _settings(-zcutplaneposition)]
1956    } {
1957        usual
1958        ignore -borderwidth -highlightthickness
1959    }
1960    $itk_component(zCutScale) set 50
1961    $itk_component(zCutScale) configure -state disabled
1962    Rappture::Tooltip::for $itk_component(zCutScale) \
1963        "@[itcl::code $this Slice tooltip z]"
1964
1965    blt::table $inner \
1966        0,0 $inner.visible              -anchor w -pady 2 -cspan 4 \
1967        1,0 $inner.lighting             -anchor w -pady 2 -cspan 4 \
1968        2,0 $inner.opacity_l            -anchor w -pady 2 -cspan 3 \
1969        3,0 $inner.opacity              -fill x   -pady 2 -cspan 3 \
1970        4,0 $itk_component(xCutButton)  -anchor e -padx 2 -pady 2 \
1971        5,0 $itk_component(xCutScale)   -fill y \
1972        4,1 $itk_component(yCutButton)  -anchor e -padx 2 -pady 2 \
1973        5,1 $itk_component(yCutScale)   -fill y \
1974        4,2 $itk_component(zCutButton)  -anchor e -padx 2 -pady 2 \
1975        5,2 $itk_component(zCutScale)   -fill y
1976
1977    blt::table configure $inner r* c* -resize none
1978    blt::table configure $inner r5 c3 -resize expand
1979}
1980
1981#
1982#  camera --
1983#
1984itcl::body Rappture::VtkVolumeViewer::camera {option args} {
1985    switch -- $option {
1986        "show" {
1987            puts [array get _view]
1988        }
1989        "set" {
1990            set who [lindex $args 0]
1991            set x $_view($who)
1992            set code [catch { string is double $x } result]
1993            if { $code != 0 || !$result } {
1994                return
1995            }
1996            switch -- $who {
1997                "-ortho" {
1998                    if {$_view(-ortho)} {
1999                        SendCmd "camera mode ortho"
2000                    } else {
2001                        SendCmd "camera mode persp"
2002                    }
2003                }
2004                "-xpan" - "-ypan" {
2005                    PanCamera
2006                }
2007                "-qx" - "-qy" - "-qz" - "-qw" {
2008                    set q [ViewToQuaternion]
2009                    $_arcball quaternion $q
2010                    EventuallyRotate $q
2011                }
2012                "-zoom" {
2013                    SendCmd "camera zoom $_view(-zoom)"
2014                }
2015            }
2016        }
2017    }
2018}
2019
2020itcl::body Rappture::VtkVolumeViewer::GetVtkData { args } {
2021    set bytes ""
2022    foreach dataobj [get] {
2023        foreach comp [$dataobj components] {
2024            set tag $dataobj-$comp
2025            set contents [$dataobj vtkdata $comp]
2026            append bytes "$contents\n"
2027        }
2028    }
2029    return [list .vtk $bytes]
2030}
2031
2032itcl::body Rappture::VtkVolumeViewer::GetImage { args } {
2033    if { [image width $_image(download)] > 0 &&
2034         [image height $_image(download)] > 0 } {
2035        set bytes [$_image(download) data -format "jpeg -quality 100"]
2036        set bytes [Rappture::encoding::decode -as b64 $bytes]
2037        return [list .jpg $bytes]
2038    }
2039    return ""
2040}
2041
2042itcl::body Rappture::VtkVolumeViewer::BuildDownloadPopup { popup command } {
2043    Rappture::Balloon $popup \
2044        -title "[Rappture::filexfer::label downloadWord] as..."
2045    set inner [$popup component inner]
2046    label $inner.summary -text "" -anchor w
2047    radiobutton $inner.vtk_button -text "VTK data file" \
2048        -variable [itcl::scope _downloadPopup(format)] \
2049        -font "Helvetica 9 " \
2050        -value vtk 
2051    Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
2052    radiobutton $inner.image_button -text "Image File" \
2053        -variable [itcl::scope _downloadPopup(format)] \
2054        -value image
2055    Rappture::Tooltip::for $inner.image_button \
2056        "Save as digital image."
2057
2058    button $inner.ok -text "Save" \
2059        -highlightthickness 0 -pady 2 -padx 3 \
2060        -command $command \
2061        -compound left \
2062        -image [Rappture::icon download]
2063
2064    button $inner.cancel -text "Cancel" \
2065        -highlightthickness 0 -pady 2 -padx 3 \
2066        -command [list $popup deactivate] \
2067        -compound left \
2068        -image [Rappture::icon cancel]
2069
2070    blt::table $inner \
2071        0,0 $inner.summary -cspan 2  \
2072        1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
2073        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
2074        4,1 $inner.cancel -width .9i -fill y \
2075        4,0 $inner.ok -padx 2 -width .9i -fill y
2076    blt::table configure $inner r3 -height 4
2077    blt::table configure $inner r4 -pady 4
2078    raise $inner.image_button
2079    $inner.vtk_button invoke
2080    return $inner
2081}
2082
2083itcl::body Rappture::VtkVolumeViewer::SetObjectStyle { dataobj cname } {
2084    # Parse style string.
2085    set tag $dataobj-$cname
2086    array set styles {
2087        -lighting   1
2088        -opacity    0.5
2089        -outline    0
2090        -visible    1
2091    }
2092    array set styles [$dataobj style $cname]
2093    set _settings(-volumelighting) $styles(-lighting)
2094    set _settings(-volumeopacity) [expr $styles(-opacity) * 100.0]
2095    set _settings(-volumeoutline) $styles(-outline)
2096    set _settings(-volumevisible) $styles(-visible)
2097
2098    SendCmd "outline add $tag"
2099    SendCmd "outline color [Color2RGB $itk_option(-plotforeground)] $tag"
2100    SendCmd "outline visible $styles(-outline) $tag"
2101
2102    SendCmd "$_cutplaneCmd add $tag"
2103    SendCmd "$_cutplaneCmd color [Color2RGB $itk_option(-plotforeground)] $tag"
2104    SendCmd "$_cutplaneCmd visible 0 $tag"
2105
2106    SendCmd "volume add $tag"
2107    SendCmd "volume lighting $styles(-lighting) $tag"
2108    SendCmd "volume opacity $styles(-opacity) $tag"
2109    SendCmd "volume visible $styles(-visible) $tag"
2110    SetColormap $dataobj $cname
2111}
2112
2113itcl::body Rappture::VtkVolumeViewer::IsValidObject { dataobj } {
2114    if {[catch {$dataobj isa Rappture::Field} valid] != 0 || !$valid} {
2115        return 0
2116    }
2117    return 1
2118}
2119
2120# ----------------------------------------------------------------------
2121# USAGE: ReceiveLegend <colormap> <title> <vmin> <vmax> <size>
2122#
2123# Invoked automatically whenever the "legend" command comes in from
2124# the rendering server.  Indicates that binary image data with the
2125# specified <size> will follow.
2126# ----------------------------------------------------------------------
2127itcl::body Rappture::VtkVolumeViewer::ReceiveLegend { colormap title vmin vmax size } {
2128    set _legendPending 0
2129    if { [isconnected] } {
2130        set bytes [ReceiveBytes $size]
2131        if { ![info exists _image(legend)] } {
2132            set _image(legend) [image create photo]
2133        }
2134        $_image(legend) configure -data $bytes
2135        #puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
2136        if { [catch {DrawLegend} errs] != 0 } {
2137            puts stderr errs=$errs
2138        }
2139    }
2140}
2141
2142#
2143# DrawLegend --
2144#
2145#       Draws the legend in it's own canvas which resides to the right
2146#       of the contour plot area.
2147#
2148itcl::body Rappture::VtkVolumeViewer::DrawLegend { } {
2149    set fname $_curFldName
2150    set c $itk_component(view)
2151    set w [winfo width $c]
2152    set h [winfo height $c]
2153    set font "Arial 8"
2154    set lineht [font metrics $font -linespace]
2155   
2156    if { [info exists _fields($fname)] } {
2157        foreach { title units } $_fields($fname) break
2158        if { $units != "" } {
2159            set title [format "%s (%s)" $title $units]
2160        }
2161    } else {
2162        set title $fname
2163    }
2164    if { $_settings(-legendvisible) } {
2165        set x [expr $w - 2]
2166        if { [$c find withtag "legend"] == "" } {
2167            set y 2
2168            $c create text $x $y \
2169                -anchor ne \
2170                -fill $itk_option(-plotforeground) -tags "title legend" \
2171                -font $font
2172            incr y $lineht
2173            $c create text $x $y \
2174                -anchor ne \
2175                -fill $itk_option(-plotforeground) -tags "vmax legend" \
2176                -font $font
2177            incr y $lineht
2178            $c create image $x $y \
2179                -anchor ne \
2180                -image $_image(legend) -tags "colormap legend"
2181            $c create text $x [expr {$h-2}] \
2182                -anchor se \
2183                -fill $itk_option(-plotforeground) -tags "vmin legend" \
2184                -font $font
2185            #$c bind colormap <Enter> [itcl::code $this EnterLegend %x %y]
2186            $c bind colormap <Leave> [itcl::code $this LeaveLegend]
2187            $c bind colormap <Motion> [itcl::code $this MotionLegend %x %y]
2188        }
2189        $c bind title <ButtonPress> [itcl::code $this Combo post]
2190        $c bind title <Enter> [itcl::code $this Combo activate]
2191        $c bind title <Leave> [itcl::code $this Combo deactivate]
2192        # Reset the item coordinates according the current size of the plot.
2193        $c itemconfigure title -text $title
2194        if { [info exists _limits($_curFldName)] } {
2195            foreach { vmin vmax } $_limits($_curFldName) break
2196            $c itemconfigure vmin -text [format %g $vmin]
2197            $c itemconfigure vmax -text [format %g $vmax]
2198        }
2199        set y 2
2200        $c coords title $x $y
2201        incr y $lineht
2202        $c coords vmax $x $y
2203        incr y $lineht
2204        $c coords colormap $x $y
2205        $c coords vmin $x [expr {$h - 2}]
2206    }
2207}
2208
2209#
2210# EnterLegend --
2211#
2212itcl::body Rappture::VtkVolumeViewer::EnterLegend { x y } {
2213    SetLegendTip $x $y
2214}
2215
2216#
2217# MotionLegend --
2218#
2219itcl::body Rappture::VtkVolumeViewer::MotionLegend { x y } {
2220    Rappture::Tooltip::tooltip cancel
2221    set c $itk_component(view)
2222    SetLegendTip $x $y
2223}
2224
2225#
2226# LeaveLegend --
2227#
2228itcl::body Rappture::VtkVolumeViewer::LeaveLegend { } {
2229    Rappture::Tooltip::tooltip cancel
2230    .rappturetooltip configure -icon ""
2231}
2232
2233#
2234# SetLegendTip --
2235#
2236itcl::body Rappture::VtkVolumeViewer::SetLegendTip { x y } {
2237    set c $itk_component(view)
2238    set w [winfo width $c]
2239    set h [winfo height $c]
2240    set font "Arial 8"
2241    set lineht [font metrics $font -linespace]
2242   
2243    set imgHeight [image height $_image(legend)]
2244    set coords [$c coords colormap]
2245    set imgX [expr $w - [image width $_image(legend)] - 2]
2246    set imgY [expr $y - 2 * ($lineht + 2)]
2247
2248    if { [info exists _fields($_title)] } {
2249        foreach { title units } $_fields($_title) break
2250        if { $units != "" } {
2251            set title [format "%s (%s)" $title $units]
2252        }
2253    } else {
2254        set title $_title
2255    }
2256    # Make a swatch of the selected color
2257    if { [catch { $_image(legend) get 10 $imgY } pixel] != 0 } {
2258        #puts stderr "out of range: $imgY"
2259        return
2260    }
2261    if { ![info exists _image(swatch)] } {
2262        set _image(swatch) [image create photo -width 24 -height 24]
2263    }
2264    set color [eval format "\#%02x%02x%02x" $pixel]
2265    $_image(swatch) put black  -to 0 0 23 23
2266    $_image(swatch) put $color -to 1 1 22 22
2267    .rappturetooltip configure -icon $_image(swatch)
2268
2269    # Compute the value of the point
2270    if { [info exists _limits($_curFldName)] } {
2271        foreach { vmin vmax } $_limits($_curFldName) break
2272        set t [expr 1.0 - (double($imgY) / double($imgHeight-1))]
2273        set value [expr $t * ($vmax - $vmin) + $vmin]
2274    } else {
2275        set value 0.0
2276    }
2277    set tipx [expr $x + 15]
2278    set tipy [expr $y - 5]
2279    Rappture::Tooltip::text $c "$title $value"
2280    Rappture::Tooltip::tooltip show $c +$tipx,+$tipy   
2281}
2282
2283
2284# ----------------------------------------------------------------------
2285# USAGE: Slice move x|y|z <newval>
2286#
2287# Called automatically when the user drags the slider to move the
2288# cut plane that slices 3D data.  Gets the current value from the
2289# slider and moves the cut plane to the appropriate point in the
2290# data set.
2291# ----------------------------------------------------------------------
2292itcl::body Rappture::VtkVolumeViewer::Slice {option args} {
2293    switch -- $option {
2294        "move" {
2295            set axis [lindex $args 0]
2296            set newval [lindex $args 1]
2297            if {[llength $args] != 2} {
2298                error "wrong # args: should be \"Slice move x|y|z newval\""
2299            }
2300            set newpos [expr {0.01*$newval}]
2301            SendCmd "$_cutplaneCmd slice $axis $newpos"
2302        }
2303        "tooltip" {
2304            set axis [lindex $args 0]
2305            set val [$itk_component(${axis}CutScale) get]
2306            return "Move the [string toupper $axis] cut plane.\nCurrently:  $axis = $val%"
2307        }
2308        default {
2309            error "bad option \"$option\": should be axis, move, or tooltip"
2310        }
2311    }
2312}
2313
2314# ----------------------------------------------------------------------
2315# USAGE: _dropdown post
2316# USAGE: _dropdown unpost
2317# USAGE: _dropdown select
2318#
2319# Used internally to handle the dropdown list for this combobox.  The
2320# post/unpost options are invoked when the list is posted or unposted
2321# to manage the relief of the controlling button.  The select option
2322# is invoked whenever there is a selection from the list, to assign
2323# the value back to the gauge.
2324# ----------------------------------------------------------------------
2325itcl::body Rappture::VtkVolumeViewer::Combo {option} {
2326    set c $itk_component(view)
2327    switch -- $option {
2328        post {
2329            foreach { x1 y1 x2 y2 } [$c bbox title] break
2330            set x1 [expr [winfo width $itk_component(view)] - [winfo reqwidth $itk_component(fieldmenu)]]
2331            set x [expr $x1 + [winfo rootx $itk_component(view)]]
2332            set y [expr $y2 + [winfo rooty $itk_component(view)]]
2333            tk_popup $itk_component(fieldmenu) $x $y
2334        }
2335        activate {
2336            $c itemconfigure title -fill red
2337        }
2338        deactivate {
2339            $c itemconfigure title -fill $itk_option(-plotforeground)
2340        }
2341        invoke {
2342            $itk_component(field) value $_curFldLabel
2343            AdjustSetting -field
2344        }
2345        default {
2346            error "bad option \"$option\": should be post, unpost, select"
2347        }
2348    }
2349}
2350
2351itcl::body Rappture::VtkVolumeViewer::SetOrientation { side } {
2352    array set positions {
2353        front "1 0 0 0"
2354        back  "0 0 1 0"
2355        left  "0.707107 0 -0.707107 0"
2356        right "0.707107 0 0.707107 0"
2357        top   "0.707107 -0.707107 0 0"
2358        bottom "0.707107 0.707107 0 0"
2359    }
2360    foreach name { -qw -qx -qy -qz } value $positions($side) {
2361        set _view($name) $value
2362    }
2363    set q [ViewToQuaternion]
2364    $_arcball quaternion $q
2365    SendCmd "camera orient $q"
2366    SendCmd "camera reset"
2367    set _view(-xpan) 0
2368    set _view(-ypan) 0
2369    set _view(-zoom) 1.0
2370}
Note: See TracBrowser for help on using the repository browser.