source: trunk/gui/scripts/vtkimageviewer.tcl @ 5092

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

Add update in Rebuild to allow initial canvas size to be set. We don't want to
do this in the constructor since that can cause an error when the add method is
called before the constructor returns.

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