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

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