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

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

whitespace

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        $_dispatcher event -idle !rebuild
919        return
920    }
921
922    # Turn on buffering of commands to the server.  We don't want to
923    # be preempted by a server disconnect/reconnect (which automatically
924    # generates a new call to Rebuild).
925    StartBufferingCommands
926
927    if { $_width != $w || $_height != $h || $_reset } {
928        set _width $w
929        set _height $h
930        $_arcball resize $w $h
931        DoResize
932        if { $_settings(-stretchtofit) } {
933            AdjustSetting -stretchtofit
934        }
935    }
936    if { $_reset } {
937        #
938        # Reset the camera and other view parameters
939        #
940        InitSettings -isheightmap -background
941
942        # Setting a custom exponent and label format for axes is causing
943        # a problem with rounding.  Near zero ticks aren't rounded by
944        # the %g format.  The VTK CubeAxes seem to currently work best
945        # when allowed to automatically set the exponent and precision
946        # based on the axis ranges.  This does tend to result in less
947        # visual clutter, so I think it is best to use the automatic
948        # settings by default.  We can test more fine-grained
949        # controls on the axis settings tab if necessary.
950        # -Leif
951        #SendCmd "axis exp 0 0 0 1"
952
953        SendCmd "axis lrot z 90"
954        $_arcball quaternion [ViewToQuaternion]
955        if {$_settings(-isheightmap) } {
956            if { $_view(-ortho)} {
957                SendCmd "camera mode ortho"
958            } else {
959                SendCmd "camera mode persp"
960            }
961            DoRotate
962            SendCmd "camera reset"
963        }
964        PanCamera
965        StopBufferingCommands
966        SendCmd "imgflush"
967        StartBufferingCommands
968    }
969
970    set _first ""
971    # Start off with no datasets are visible.
972    SendCmd "dataset visible 0"
973    set scale [GetHeightmapScale]
974    foreach dataobj [get -objects] {
975        if { [info exists _obj2ovride($dataobj-raise)] &&  $_first == "" } {
976            set _first $dataobj
977        }
978        set _obj2datasets($dataobj) ""
979        foreach comp [$dataobj components] {
980            set tag $dataobj-$comp
981            if { ![info exists _datasets($tag)] } {
982                set bytes [$dataobj vtkdata $comp]
983                if 0 {
984                    set f [open /tmp/vtkheightmap.vtk "w"]
985                    fconfigure $f -translation binary -encoding binary
986                    puts -nonewline $f $bytes
987                    close $f
988                }
989                set length [string length $bytes]
990                if { $_reportClientInfo }  {
991                    set info {}
992                    lappend info "tool_id"       [$dataobj hints toolid]
993                    lappend info "tool_name"     [$dataobj hints toolname]
994                    lappend info "tool_title"    [$dataobj hints tooltitle]
995                    lappend info "tool_command"  [$dataobj hints toolcommand]
996                    lappend info "tool_revision" [$dataobj hints toolrevision]
997                    lappend info "dataset_label" [$dataobj hints label]
998                    lappend info "dataset_size"  $length
999                    lappend info "dataset_tag"   $tag
1000                    SendCmd "clientinfo [list $info]"
1001                }
1002                SendCmd "dataset add $tag data follows $length"
1003                append _outbuf $bytes
1004                set _datasets($tag) 1
1005                SetObjectStyle $dataobj $comp
1006            }
1007            lappend _obj2datasets($dataobj) $tag
1008            if { [info exists _obj2ovride($dataobj-raise)] } {
1009                # Setting dataset visible enables outline
1010                # and heightmap
1011                SendCmd "dataset visible 1 $tag"
1012            }
1013            if { ![info exists _comp2scale($tag)] ||
1014                 $_comp2scale($tag) != $scale } {
1015                SendCmd "heightmap heightscale $scale $tag"
1016                set _comp2scale($tag) $scale
1017            }
1018        }
1019    }
1020    if { $_first != ""  } {
1021        $itk_component(field) choices delete 0 end
1022        $itk_component(fieldmenu) delete 0 end
1023        array unset _fields
1024        set _curFldName ""
1025        foreach cname [$_first components] {
1026            foreach fname [$_first fieldnames $cname] {
1027                if { [info exists _fields($fname)] } {
1028                    continue
1029                }
1030                foreach { label units components } \
1031                    [$_first fieldinfo $fname] break
1032                $itk_component(field) choices insert end "$fname" "$label"
1033                $itk_component(fieldmenu) add radiobutton -label "$label" \
1034                    -value $label -variable [itcl::scope _curFldLabel] \
1035                    -selectcolor red \
1036                    -activebackground $itk_option(-plotbackground) \
1037                    -activeforeground $itk_option(-plotforeground) \
1038                    -font "Arial 8" \
1039                    -command [itcl::code $this Combo invoke]
1040                set _fields($fname) [list $label $units $components]
1041                if { $_curFldName == "" } {
1042                    set _curFldName $fname
1043                    set _curFldLabel $label
1044                }
1045            }
1046        }
1047        $itk_component(field) value $_curFldLabel
1048    }
1049    InitSettings -stretchtofit -outline
1050
1051    if { $_reset } {
1052        SendCmd "axis tickpos outside"
1053        #SendCmd "axis lformat all %g"
1054
1055        foreach axis { x y z } {
1056            if { $axis == "z" } {
1057                set label [$_first hints label]
1058            } else {
1059                set label [$_first hints ${axis}label]
1060            }
1061            if { $label == "" } {
1062                if {$axis == "z"} {
1063                    if { [string match "component*" $_curFldName] } {
1064                        set label [string toupper $axis]
1065                    } else {
1066                        set label $_curFldLabel
1067                    }
1068                } else {
1069                    set label [string toupper $axis]
1070                }
1071            }
1072            # May be a space in the axis label.
1073            SendCmd [list axis name $axis $label]
1074
1075            set units ""
1076            if {$axis == "z" && [$_first hints ${axis}units] == ""} {
1077                if {$_curFldName != ""} {
1078                    set units [lindex $_fields($_curFldName) 1]
1079                }
1080            } else {
1081                set units [$_first hints ${axis}units]
1082            }
1083            if { $units != "" } {
1084                # May be a space in the axis units.
1085                SendCmd [list axis units $axis $units]
1086            }
1087        }
1088        #
1089        # Reset the camera and other view parameters
1090        #
1091        ResetAxes
1092        $_arcball quaternion [ViewToQuaternion]
1093        if {$_settings(-isheightmap) } {
1094            if { $_view(-ortho)} {
1095                SendCmd "camera mode ortho"
1096            } else {
1097                SendCmd "camera mode persp"
1098            }
1099            DoRotate
1100            SendCmd "camera reset"
1101        }
1102        PanCamera
1103        InitSettings -xgrid -ygrid -zgrid \
1104            -axisvisible -axislabels -heightmapscale -field -isheightmap \
1105            -numisolines
1106        if { [array size _fields] < 2 } {
1107            catch {blt::table forget $itk_component(field) $itk_component(field_l)}
1108        }
1109        RequestLegend
1110        set _reset 0
1111    }
1112    global readyForNextFrame
1113    set readyForNextFrame 0;                # Don't advance to the next frame
1114
1115    # Actually write the commands to the server socket.  If it fails, we don't
1116    # care.  We're finished here.
1117    blt::busy hold $itk_component(hull)
1118    StopBufferingCommands
1119    blt::busy release $itk_component(hull)
1120}
1121
1122# ----------------------------------------------------------------------
1123# USAGE: CurrentDatasets ?-all -visible? ?dataobjs?
1124#
1125# Returns a list of server IDs for the current datasets being displayed.  This
1126# is normally a single ID, but it might be a list of IDs if the current data
1127# object has multiple components.
1128# ----------------------------------------------------------------------
1129itcl::body Rappture::VtkHeightmapViewer::CurrentDatasets {args} {
1130    set flag [lindex $args 0]
1131    switch -- $flag {
1132        "-all" {
1133            if { [llength $args] > 1 } {
1134                error "CurrentDatasets: can't specify dataobj after \"-all\""
1135            }
1136            set dlist [get -objects]
1137        }
1138        "-visible" {
1139            if { [llength $args] > 1 } {
1140                set dlist {}
1141                set args [lrange $args 1 end]
1142                foreach dataobj $args {
1143                    if { [info exists _obj2ovride($dataobj-raise)] } {
1144                        lappend dlist $dataobj
1145                    }
1146                }
1147            } else {
1148                set dlist [get -visible]
1149            }
1150        }
1151        default {
1152            set dlist $args
1153        }
1154    }
1155    set rlist ""
1156    foreach dataobj $dlist {
1157        foreach comp [$dataobj components] {
1158            set tag $dataobj-$comp
1159            if { [info exists _datasets($tag)] && $_datasets($tag) } {
1160                lappend rlist $tag
1161            }
1162        }
1163    }
1164    return $rlist
1165}
1166
1167itcl::body Rappture::VtkHeightmapViewer::CameraReset {} {
1168    array set _view {
1169        -qw      0.36
1170        -qx      0.25
1171        -qy      0.50
1172        -qz      0.70
1173        -xpan    0
1174        -ypan    0
1175        -zoom    1.0
1176    }
1177    if { $_first != "" } {
1178        set location [$_first hints camera]
1179        if { $location != "" } {
1180            array set _view $location
1181        }
1182    }
1183    $_arcball quaternion [ViewToQuaternion]
1184    if {$_settings(-isheightmap) } {
1185        DoRotate
1186    }
1187    SendCmd "camera reset"
1188}
1189
1190# ----------------------------------------------------------------------
1191# USAGE: Zoom in
1192# USAGE: Zoom out
1193# USAGE: Zoom reset
1194#
1195# Called automatically when the user clicks on one of the zoom
1196# controls for this widget.  Changes the zoom for the current view.
1197# ----------------------------------------------------------------------
1198itcl::body Rappture::VtkHeightmapViewer::Zoom {option} {
1199    switch -- $option {
1200        "in" {
1201            set _view(-zoom) [expr {$_view(-zoom)*1.25}]
1202            SendCmd "camera zoom $_view(-zoom)"
1203        }
1204        "out" {
1205            set _view(-zoom) [expr {$_view(-zoom)*0.8}]
1206            SendCmd "camera zoom $_view(-zoom)"
1207        }
1208        "reset" {
1209            array set _view {
1210                -xpan    0
1211                -ypan    0
1212                -zoom    1.0
1213            }
1214            SendCmd "camera reset"
1215        }
1216    }
1217}
1218
1219itcl::body Rappture::VtkHeightmapViewer::PanCamera {} {
1220    set x $_view(-xpan)
1221    set y $_view(-ypan)
1222    SendCmd "camera pan $x $y"
1223}
1224
1225
1226# ----------------------------------------------------------------------
1227# USAGE: Rotate click <x> <y>
1228# USAGE: Rotate drag <x> <y>
1229# USAGE: Rotate release <x> <y>
1230#
1231# Called automatically when the user clicks/drags/releases in the
1232# plot area.  Moves the plot according to the user's actions.
1233# ----------------------------------------------------------------------
1234itcl::body Rappture::VtkHeightmapViewer::Rotate {option x y} {
1235    switch -- $option {
1236        "click" {
1237            $itk_component(view) configure -cursor fleur
1238            set _click(x) $x
1239            set _click(y) $y
1240        }
1241        "drag" {
1242            if {[array size _click] == 0} {
1243                Rotate click $x $y
1244            } else {
1245                set w [winfo width $itk_component(view)]
1246                set h [winfo height $itk_component(view)]
1247                if {$w <= 0 || $h <= 0} {
1248                    return
1249                }
1250
1251                if {[catch {
1252                    # this fails sometimes for no apparent reason
1253                    set dx [expr {double($x-$_click(x))/$w}]
1254                    set dy [expr {double($y-$_click(y))/$h}]
1255                }]} {
1256                    return
1257                }
1258                if { $dx == 0 && $dy == 0 } {
1259                    return
1260                }
1261                set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1262                EventuallyRotate $q
1263                set _click(x) $x
1264                set _click(y) $y
1265            }
1266        }
1267        "release" {
1268            Rotate drag $x $y
1269            $itk_component(view) configure -cursor ""
1270            catch {unset _click}
1271        }
1272        default {
1273            error "bad option \"$option\": should be click, drag, release"
1274        }
1275    }
1276}
1277
1278itcl::body Rappture::VtkHeightmapViewer::Pick {x y} {
1279    foreach tag [CurrentDatasets -visible] {
1280        SendCmd "dataset getscalar pixel $x $y $tag"
1281    }
1282}
1283
1284# ----------------------------------------------------------------------
1285# USAGE: $this Pan click x y
1286#        $this Pan drag x y
1287#        $this Pan release x y
1288#
1289# Called automatically when the user clicks on one of the zoom
1290# controls for this widget.  Changes the zoom for the current view.
1291# ----------------------------------------------------------------------
1292itcl::body Rappture::VtkHeightmapViewer::Pan {option x y} {
1293    switch -- $option {
1294        "set" {
1295            set w [winfo width $itk_component(view)]
1296            set h [winfo height $itk_component(view)]
1297            set x [expr $x / double($w)]
1298            set y [expr $y / double($h)]
1299            set _view(-xpan) [expr $_view(-xpan) + $x]
1300            set _view(-ypan) [expr $_view(-ypan) + $y]
1301            PanCamera
1302            return
1303        }
1304        "click" {
1305            set _click(x) $x
1306            set _click(y) $y
1307            $itk_component(view) configure -cursor hand1
1308        }
1309        "drag" {
1310            if { ![info exists _click(x)] } {
1311                set _click(x) $x
1312            }
1313            if { ![info exists _click(y)] } {
1314                set _click(y) $y
1315            }
1316            set w [winfo width $itk_component(view)]
1317            set h [winfo height $itk_component(view)]
1318            set dx [expr ($_click(x) - $x)/double($w)]
1319            set dy [expr ($_click(y) - $y)/double($h)]
1320            set _click(x) $x
1321            set _click(y) $y
1322            set _view(-xpan) [expr $_view(-xpan) - $dx]
1323            set _view(-ypan) [expr $_view(-ypan) - $dy]
1324            PanCamera
1325        }
1326        "release" {
1327            Pan drag $x $y
1328            $itk_component(view) configure -cursor ""
1329        }
1330        default {
1331            error "unknown option \"$option\": should set, click, drag, or release"
1332        }
1333    }
1334}
1335
1336# ----------------------------------------------------------------------
1337# USAGE: InitSettings <what> ?<value>?
1338#
1339# Used internally to update rendering settings whenever parameters
1340# change in the popup settings panel.  Sends the new settings off
1341# to the back end.
1342# ----------------------------------------------------------------------
1343itcl::body Rappture::VtkHeightmapViewer::InitSettings { args } {
1344    foreach spec $args {
1345        if { [info exists _settings($_first${spec})] } {
1346            # Reset global setting with dataobj specific setting
1347            set _settings($spec) $_settings($_first${spec})
1348        }
1349        AdjustSetting $spec
1350    }
1351}
1352
1353#
1354# AdjustSetting --
1355#
1356#       Changes/updates a specific setting in the widget.  There are
1357#       usually user-setable option.  Commands are sent to the render
1358#       server.
1359#
1360itcl::body Rappture::VtkHeightmapViewer::AdjustSetting {what {value ""}} {
1361    if { $_beforeConnect } {
1362        return
1363    }
1364    switch -- $what {
1365        "-axisflymode" {
1366            set mode [$itk_component(axisflymode) value]
1367            set mode [$itk_component(axisflymode) translate $mode]
1368            set _settings($what) $mode
1369            SendCmd "axis flymode $mode"
1370        }
1371        "-axislabels" {
1372            set bool $_settings($what)
1373            SendCmd "axis labels all $bool"
1374        }
1375        "-axisminorticks" {
1376            set bool $_settings($what)
1377            SendCmd "axis minticks all $bool"
1378        }
1379        "-axisvisible" {
1380            set bool $_settings($what)
1381            SendCmd "axis visible all $bool"
1382        }
1383        "-background" {
1384            set bg [$itk_component(background) value]
1385            array set fgcolors {
1386                "black" "white"
1387                "white" "black"
1388                "grey"  "black"
1389            }
1390            set fg $fgcolors($bg)
1391            configure -plotbackground $bg -plotforeground $fg
1392            $itk_component(view) delete "legend"
1393            SendCmd "screen bgcolor [Color2RGB $bg]"
1394            SendCmd "outline color [Color2RGB $fg]"
1395            SendCmd "axis color all [Color2RGB $fg]"
1396            DrawLegend
1397        }
1398        "-colormap" {
1399            set _changed($what) 1
1400            StartBufferingCommands
1401            set color [$itk_component(colormap) value]
1402            set _settings($what) $color
1403            if { $color == "none" } {
1404                if { $_settings(-colormapvisible) } {
1405                    SendCmd "heightmap surface 0"
1406                    set _settings(-colormapvisible) 0
1407                }
1408            } else {
1409                if { !$_settings(-colormapvisible) } {
1410                    SendCmd "heightmap surface 1"
1411                    set _settings(-colormapvisible) 1
1412                }
1413                SetCurrentColormap $color
1414                if {$_settings(-colormapdiscrete)} {
1415                    set numColors [expr $_settings(-numisolines) + 1]
1416                    SendCmd "colormap res $numColors $color"
1417                }
1418            }
1419            StopBufferingCommands
1420            EventuallyRequestLegend
1421        }
1422        "-colormapvisible" {
1423            set bool $_settings($what)
1424            SendCmd "heightmap surface $bool"
1425        }
1426        "-colormapdiscrete" {
1427            set bool $_settings($what)
1428            set numColors [expr $_settings(-numisolines) + 1]
1429            StartBufferingCommands
1430            if {$bool} {
1431                SendCmd "colormap res $numColors"
1432                # Discrete colormap requires preinterp on
1433                SendCmd "heightmap preinterp on"
1434            } else {
1435                SendCmd "colormap res default"
1436                # FIXME: add setting for preinterp (default on)
1437                SendCmd "heightmap preinterp on"
1438            }
1439            StopBufferingCommands
1440            EventuallyRequestLegend
1441        }
1442        "-edges" {
1443            set bool $_settings($what)
1444            SendCmd "heightmap edges $bool"
1445        }
1446        "-field" {
1447            set label [$itk_component(field) value]
1448            set fname [$itk_component(field) translate $label]
1449            set _settings($what) $fname
1450            if { [info exists _fields($fname)] } {
1451                foreach { label units components } $_fields($fname) break
1452                if { $components > 1 } {
1453                    set _colorMode vmag
1454                } else {
1455                    set _colorMode scalar
1456                }
1457                set _curFldName $fname
1458                set _curFldLabel $label
1459            } else {
1460                puts stderr "unknown field \"$fname\""
1461                return
1462            }
1463            set label [$_first hints label]
1464            if { $label == "" } {
1465                if { [string match "component*" $_curFldName] } {
1466                    set label Z
1467                } else {
1468                    set label $_curFldLabel
1469                }
1470            }
1471            # May be a space in the axis label.
1472            SendCmd [list axis name z $label]
1473
1474            if { [$_first hints zunits] == "" } {
1475                set units [lindex $_fields($_curFldName) 1]
1476            } else {
1477                set units [$_first hints zunits]
1478            }
1479            if { $units != "" } {
1480                # May be a space in the axis units.
1481                SendCmd [list axis units z $units]
1482            }
1483            # Get the new limits because the field changed.
1484            ResetAxes
1485            SendCmd "dataset scalar $_curFldName"
1486            SendCmd "heightmap colormode scalar $_curFldName"
1487            Zoom reset
1488            UpdateContourList
1489            DrawLegend
1490        }
1491        "-heightmapscale" {
1492            if { $_settings(-isheightmap) } {
1493                set scale [GetHeightmapScale]
1494                # Have to set the datasets individually because we are
1495                # tracking them in _comp2scale.
1496                foreach dataset [CurrentDatasets -all] {
1497                    SendCmd "heightmap heightscale $scale $dataset"
1498                    set _comp2scale($dataset) $scale
1499                }
1500                ResetAxes
1501            }
1502        }
1503        "-isheightmap" {
1504            set bool $_settings($what)
1505            set c $itk_component(view)
1506            StartBufferingCommands
1507            # Fix heightmap scale: 0 for contours, 1 for heightmaps.
1508            if { $bool } {
1509                set _settings(-heightmapscale) 50
1510                set _settings(-opacity) $_settings(-saveopacity)
1511                set _settings(-lighting) $_settings(-savelighting)
1512                set _settings(-outline) 0
1513            } else {
1514                set _settings(-heightmapscale) 0
1515                set _settings(-lighting) 0
1516                set _settings(-opacity) 100
1517                set _settings(-outline)  $_settings(-saveoutline)
1518            }
1519            InitSettings -lighting -opacity -outline
1520            set scale [GetHeightmapScale]
1521            # Have to set the datasets individually because we are
1522            # tracking them in _comp2scale.
1523            foreach dataset [CurrentDatasets -all] {
1524                SendCmd "heightmap heightscale $scale $dataset"
1525                set _comp2scale($dataset) $scale
1526            }
1527            if { $bool } {
1528                $itk_component(lighting) configure -state normal
1529                $itk_component(opacity) configure -state normal
1530                $itk_component(scale) configure -state normal
1531                $itk_component(opacity_l) configure -state normal
1532                $itk_component(scale_l) configure -state normal
1533                $itk_component(outline) configure -state disabled
1534                if {$_view(-ortho)} {
1535                    SendCmd "camera mode ortho"
1536                } else {
1537                    SendCmd "camera mode persp"
1538                }
1539            } else {
1540                $itk_component(lighting) configure -state disabled
1541                $itk_component(opacity) configure -state disabled
1542                $itk_component(scale) configure -state disabled
1543                $itk_component(opacity_l) configure -state disabled
1544                $itk_component(scale_l) configure -state disabled
1545                $itk_component(outline) configure -state normal
1546                SendCmd "camera mode image"
1547            }
1548            if {$_settings(-stretchtofit)} {
1549                if {$scale == 0} {
1550                    SendCmd "camera aspect window"
1551                } else {
1552                    SendCmd "camera aspect square"
1553                }
1554            }
1555            ResetAxes
1556            if { $bool } {
1557                set q [ViewToQuaternion]
1558                $_arcball quaternion $q
1559                SendCmd "camera orient $q"
1560            } else {
1561                bind $c <ButtonPress-1> {}
1562                bind $c <B1-Motion> {}
1563                bind $c <ButtonRelease-1> {}
1564            }
1565            Zoom reset
1566            # Fix the mouse bindings for rotation/panning and the
1567            # camera mode. Ideally we'd create a bindtag for these.
1568            if { $bool } {
1569                # Bindings for rotation via mouse
1570                bind $c <ButtonPress-1> \
1571                    [itcl::code $this Rotate click %x %y]
1572                bind $c <B1-Motion> \
1573                    [itcl::code $this Rotate drag %x %y]
1574                bind $c <ButtonRelease-1> \
1575                    [itcl::code $this Rotate release %x %y]
1576            }
1577            StopBufferingCommands
1578        }
1579        "-isolinecolor" {
1580            set color [$itk_component(isolinecolor) value]
1581            if { $color == "none" } {
1582                if { $_settings(-isolinesvisible) } {
1583                    SendCmd "heightmap isolines 0"
1584                    set _settings(-isolinesvisible) 0
1585                }
1586            } else {
1587                if { !$_settings(-isolinesvisible) } {
1588                    SendCmd "heightmap isolines 1"
1589                    set _settings(-isolinesvisible) 1
1590                }
1591                SendCmd "heightmap isolinecolor [Color2RGB $color]"
1592            }
1593            DrawLegend
1594        }
1595        "-isolinesvisible" {
1596            set bool $_settings($what)
1597            SendCmd "heightmap isolines $bool"
1598            DrawLegend
1599        }
1600        "-legendvisible" {
1601            if { !$_settings($what) } {
1602                $itk_component(view) delete legend
1603            }
1604            DrawLegend
1605        }
1606        "-lighting" {
1607            if { $_settings(-isheightmap) } {
1608                set _settings(-savelighting) $_settings($what)
1609                set bool $_settings($what)
1610                SendCmd "heightmap lighting $bool"
1611            } else {
1612                SendCmd "heightmap lighting 0"
1613            }
1614        }
1615        "-numisolines" {
1616            set _settings($what) [$itk_component(numisolines) value]
1617            set _currentNumIsolines $_settings($what)
1618            UpdateContourList
1619            set _changed($what) 1
1620            SendCmd "heightmap contourlist [list $_contourList]"
1621            if {$_settings(-colormapdiscrete)} {
1622                set numColors [expr $_settings($what) + 1]
1623                SendCmd "colormap res $numColors"
1624                EventuallyRequestLegend
1625            } else {
1626                DrawLegend
1627            }
1628        }
1629        "-opacity" {
1630            set _changed($what) 1
1631            set val [expr $_settings($what) * 0.01]
1632            if { $_settings(-isheightmap) } {
1633                set _settings(-saveopacity) $_settings($what)
1634                SendCmd "heightmap opacity $val"
1635            } else {
1636                SendCmd "heightmap opacity 1.0"
1637            }
1638        }
1639        "-outline" {
1640            if { $_settings(-isheightmap) } {
1641                SendCmd "outline visible 0"
1642            } else {
1643                set _settings(-saveoutline) $_settings($what)
1644                set bool $_settings($what)
1645                SendCmd "outline visible $bool"
1646            }
1647        }
1648        "-stretchtofit" {
1649            set bool $_settings($what)
1650            if { $bool } {
1651                set heightScale [GetHeightmapScale]
1652                if {$heightScale == 0} {
1653                    SendCmd "camera aspect window"
1654                } else {
1655                    SendCmd "camera aspect square"
1656                }
1657            } else {
1658                SendCmd "camera aspect native"
1659            }
1660            Zoom reset
1661        }
1662        "-wireframe" {
1663            set bool $_settings($what)
1664            SendCmd "heightmap wireframe $bool"
1665        }
1666        "-xgrid" - "-ygrid" - "-zgrid" {
1667            set axis [string tolower [string range $what 1 1]]
1668            set bool $_settings($what)
1669            SendCmd "axis grid $axis $bool"
1670        }
1671        default {
1672            error "don't know how to fix $what"
1673        }
1674    }
1675}
1676
1677#
1678# RequestLegend --
1679#
1680#       Request a new legend from the server.  The size of the legend
1681#       is determined from the height of the canvas.
1682#
1683# This should be called when
1684#        1.  A new current colormap is set.
1685#        2.  Window is resized.
1686#        3.  The limits of the data have changed.  (Just need a redraw).
1687#        4.  Number of isolines have changed. (Just need a redraw).
1688#        5.  Legend becomes visible (Just need a redraw).
1689#
1690itcl::body Rappture::VtkHeightmapViewer::RequestLegend {} {
1691    set _legendPending 0
1692    set font "Arial 8"
1693    set w 12
1694    set lineht [font metrics $font -linespace]
1695    # color ramp height = (canvas height) - (min and max value lines) - 2
1696    set h [expr {$_height - 2 * ($lineht + 2)}]
1697    set _legendHeight $h
1698
1699    set fname $_curFldName
1700    if { [string match "component*" $fname] } {
1701        set title ""
1702    } else {
1703        if { [info exists _fields($fname)] } {
1704            foreach { title units } $_fields($fname) break
1705            if { $units != "" } {
1706                set title [format "%s (%s)" $title $units]
1707            }
1708        } else {
1709            set title $fname
1710        }
1711    }
1712    # If there's a title too, substract one more line
1713    if { $title != "" } {
1714        incr h -$lineht
1715    }
1716    if { $h < 1 } {
1717        return
1718    }
1719    # Set the legend on the first heightmap dataset.
1720    if { $_currentColormap != ""  } {
1721        set cmap $_currentColormap
1722        #SendCmd "legend $cmap scalar $_curFldName {} $w $h 0"
1723        SendCmd "legend2 $cmap $w $h"
1724    }
1725}
1726
1727#
1728# ResetAxes --
1729#
1730#       Set axis z bounds and range
1731#
1732itcl::body Rappture::VtkHeightmapViewer::ResetAxes {} {
1733    if { ![info exists _limits($_curFldName)]} {
1734        SendCmd "dataset maprange all"
1735        SendCmd "axis autorange z on"
1736        SendCmd "axis autobounds z on"
1737        return
1738    }
1739    foreach { xmin xmax } $_limits(x) break
1740    foreach { ymin ymax } $_limits(y) break
1741    foreach { vmin vmax } $_limits($_curFldName) break
1742
1743    global tcl_precision
1744    set tcl_precision 17
1745    set xr [expr $xmax - $xmin]
1746    set yr [expr $ymax - $ymin]
1747    set vr [expr $vmax - $vmin]
1748    set r  [expr ($yr > $xr) ? $yr : $xr]
1749    if { $vr < 1.0e-17 } {
1750        set dataScale 1.0
1751    } else {
1752        set dataScale [expr $r / $vr]
1753    }
1754    set heightScale [GetHeightmapScale]
1755    set bmin [expr $heightScale * $dataScale * $vmin]
1756    set bmax [expr $heightScale * $dataScale * $vmax]
1757    if {$heightScale > 0} {
1758        set zpos [expr - $bmin]
1759        SendCmd "heightmap pos 0 0 $zpos"
1760    } else {
1761        SendCmd "heightmap pos 0 0 0"
1762    }
1763    set bmax [expr $bmax - $bmin]
1764    set bmin 0
1765    SendCmd "dataset maprange explicit $_limits($_curFldName) $_curFldName"
1766    SendCmd "axis bounds z $bmin $bmax"
1767    SendCmd "axis range z $_limits($_curFldName)"
1768}
1769
1770#
1771# SetCurrentColormap --
1772#
1773itcl::body Rappture::VtkHeightmapViewer::SetCurrentColormap { name } {
1774    # Keep track of the colormaps that we build.
1775    if { $name != "none" && ![info exists _colormaps($name)] } {
1776        BuildColormap $name
1777        set _colormaps($name) 1
1778    }
1779    set _currentColormap $name
1780    SendCmd "heightmap colormap $_currentColormap"
1781}
1782
1783#
1784# BuildColormap --
1785#
1786#       Build the designated colormap on the server.
1787#
1788itcl::body Rappture::VtkHeightmapViewer::BuildColormap { name } {
1789    set cmap [ColorsToColormap $name]
1790    if { [llength $cmap] == 0 } {
1791        set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0"
1792    }
1793    set wmap "0.0 1.0 1.0 1.0"
1794    SendCmd "colormap add $name { $cmap } { $wmap }"
1795}
1796
1797# ----------------------------------------------------------------------
1798# CONFIGURATION OPTION: -mode
1799# ----------------------------------------------------------------------
1800itcl::configbody Rappture::VtkHeightmapViewer::mode {
1801    switch -- $itk_option(-mode) {
1802        "heightmap" {
1803            set _settings(-isheightmap) 1
1804        }
1805        "contour" {
1806            set _settings(-isheightmap) 0
1807        }
1808        default {
1809            error "unknown mode settings \"$itk_option(-mode)\""
1810        }
1811    }
1812    if { !$_reset } {
1813        AdjustSetting -isheightmap
1814    }
1815}
1816
1817# ----------------------------------------------------------------------
1818# CONFIGURATION OPTION: -plotbackground
1819# ----------------------------------------------------------------------
1820itcl::configbody Rappture::VtkHeightmapViewer::plotbackground {
1821    if { [isconnected] } {
1822        set rgb [Color2RGB $itk_option(-plotbackground)]
1823        if { !$_reset } {
1824            SendCmd "screen bgcolor $rgb"
1825        }
1826        $itk_component(view) configure -background $itk_option(-plotbackground)
1827    }
1828}
1829
1830# ----------------------------------------------------------------------
1831# CONFIGURATION OPTION: -plotforeground
1832# ----------------------------------------------------------------------
1833itcl::configbody Rappture::VtkHeightmapViewer::plotforeground {
1834    if { [isconnected] } {
1835        set rgb [Color2RGB $itk_option(-plotforeground)]
1836        if { !$_reset } {
1837            SendCmd "axis color all $rgb"
1838            SendCmd "outline color $rgb"
1839        }
1840    }
1841}
1842
1843itcl::body Rappture::VtkHeightmapViewer::BuildContourTab {} {
1844
1845    set fg [option get $itk_component(hull) font Font]
1846    #set bfg [option get $itk_component(hull) boldFont Font]
1847
1848    set inner [$itk_component(main) insert end \
1849        -title "Contour/Surface Settings" \
1850        -icon [Rappture::icon contour2]]
1851    $inner configure -borderwidth 4
1852
1853    checkbutton $inner.legend \
1854        -text "Legend" \
1855        -variable [itcl::scope _settings(-legendvisible)] \
1856        -command [itcl::code $this AdjustSetting -legendvisible] \
1857        -font "Arial 9"
1858
1859    checkbutton $inner.wireframe \
1860        -text "Wireframe" \
1861        -variable [itcl::scope _settings(-wireframe)] \
1862        -command [itcl::code $this AdjustSetting -wireframe] \
1863        -font "Arial 9"
1864
1865    itk_component add lighting {
1866        checkbutton $inner.lighting \
1867            -text "Enable Lighting" \
1868            -variable [itcl::scope _settings(-lighting)] \
1869            -command [itcl::code $this AdjustSetting -lighting] \
1870            -font "Arial 9"
1871    } {
1872        ignore -font
1873    }
1874    checkbutton $inner.edges \
1875        -text "Edges" \
1876        -variable [itcl::scope _settings(-edges)] \
1877        -command [itcl::code $this AdjustSetting -edges] \
1878        -font "Arial 9"
1879
1880    itk_component add outline {
1881        checkbutton $inner.outline \
1882            -text "Outline" \
1883            -variable [itcl::scope _settings(-outline)] \
1884            -command [itcl::code $this AdjustSetting -outline] \
1885            -font "Arial 9"
1886    } {
1887        ignore -font
1888    }
1889    checkbutton $inner.stretch \
1890        -text "Stretch to fit" \
1891        -variable [itcl::scope _settings(-stretchtofit)] \
1892        -command [itcl::code $this AdjustSetting -stretchtofit] \
1893        -font "Arial 9"
1894
1895    checkbutton $inner.isolines \
1896        -text "Isolines" \
1897        -variable [itcl::scope _settings(-isolinesvisible)] \
1898        -command [itcl::code $this AdjustSetting -isolinesvisible] \
1899        -font "Arial 9"
1900
1901    checkbutton $inner.colormapDiscrete \
1902        -text "Discrete Colormap" \
1903        -variable [itcl::scope _settings(-colormapdiscrete)] \
1904        -command [itcl::code $this AdjustSetting -colormapdiscrete] \
1905        -font "Arial 9"
1906
1907    itk_component add field_l {
1908        label $inner.field_l -text "Field" -font "Arial 9"
1909    } {
1910        ignore -font
1911    }
1912    itk_component add field {
1913        Rappture::Combobox $inner.field -width 10 -editable no
1914    }
1915    bind $inner.field <<Value>> \
1916        [itcl::code $this AdjustSetting -field]
1917
1918    label $inner.colormap_l -text "Colormap" -font "Arial 9"
1919    itk_component add colormap {
1920        Rappture::Combobox $inner.colormap -width 10 -editable no
1921    }
1922    $inner.colormap choices insert end [GetColormapList -includeNone]
1923    $itk_component(colormap) value $_settings(-colormap)
1924    bind $inner.colormap <<Value>> \
1925        [itcl::code $this AdjustSetting -colormap]
1926
1927    label $inner.isolinecolor_l -text "Isolines Color" -font "Arial 9"
1928    itk_component add isolinecolor {
1929        Rappture::Combobox $inner.isolinecolor -width 10 -editable no
1930    }
1931    $inner.isolinecolor choices insert end \
1932        "black"              "black"            \
1933        "blue"               "blue"             \
1934        "cyan"               "cyan"             \
1935        "green"              "green"            \
1936        "grey"               "grey"             \
1937        "magenta"            "magenta"          \
1938        "orange"             "orange"           \
1939        "red"                "red"              \
1940        "white"              "white"            \
1941        "none"               "none"
1942
1943    $itk_component(isolinecolor) value $_settings(-isolinecolor)
1944    bind $inner.isolinecolor <<Value>> \
1945        [itcl::code $this AdjustSetting -isolinecolor]
1946
1947    label $inner.background_l -text "Background Color" -font "Arial 9"
1948    itk_component add background {
1949        Rappture::Combobox $inner.background -width 10 -editable no
1950    }
1951    $inner.background choices insert end \
1952        "black"              "black"            \
1953        "white"              "white"            \
1954        "grey"               "grey"
1955
1956    $itk_component(background) value "white"
1957    bind $inner.background <<Value>> \
1958        [itcl::code $this AdjustSetting -background]
1959
1960    itk_component add opacity_l {
1961        label $inner.opacity_l -text "Opacity" -font "Arial 9"
1962    } {
1963        ignore -font
1964    }
1965    itk_component add opacity {
1966        ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1967            -variable [itcl::scope _settings(-opacity)] \
1968            -showvalue off \
1969            -command [itcl::code $this AdjustSetting -opacity]
1970    }
1971    itk_component add scale_l {
1972        label $inner.scale_l -text "Scale" -font "Arial 9"
1973    } {
1974        ignore -font
1975    }
1976    itk_component add scale {
1977        ::scale $inner.scale -from 0 -to 100 -orient horizontal \
1978            -variable [itcl::scope _settings(-heightmapscale)] \
1979            -showvalue off \
1980            -command [itcl::code $this AdjustSetting -heightmapscale]
1981    }
1982    label $inner.numisolines_l -text "Number of Isolines" -font "Arial 9"
1983    itk_component add numisolines {
1984        Rappture::Spinint $inner.numisolines \
1985            -min 0 -max 50 -font "arial 9"
1986    }
1987    $itk_component(numisolines) value $_settings(-numisolines)
1988    bind $itk_component(numisolines) <<Value>> \
1989        [itcl::code $this AdjustSetting -numisolines]
1990
1991    frame $inner.separator1 -height 2 -relief sunken -bd 1
1992    frame $inner.separator2 -height 2 -relief sunken -bd 1
1993
1994    blt::table $inner \
1995        0,0 $inner.field_l -anchor w -pady 2 \
1996        0,1 $inner.field -anchor w -pady 2 -fill x \
1997        1,0 $inner.colormap_l -anchor w -pady 2  \
1998        1,1 $inner.colormap   -anchor w -pady 2 -fill x  \
1999        2,0 $inner.isolinecolor_l  -anchor w -pady 2  \
2000        2,1 $inner.isolinecolor    -anchor w -pady 2 -fill x  \
2001        3,0 $inner.background_l -anchor w -pady 2 \
2002        3,1 $inner.background -anchor w -pady 2  -fill x \
2003        4,0 $inner.numisolines_l -anchor w -pady 2 \
2004        4,1 $inner.numisolines -anchor w -pady 2 \
2005        5,0 $inner.stretch    -anchor w -pady 2 -cspan 2 \
2006        6,0 $inner.edges      -anchor w -pady 2 -cspan 2 \
2007        7,0 $inner.legend     -anchor w -pady 2 -cspan 2 \
2008        8,0 $inner.colormapDiscrete -anchor w -pady 2 -cspan 2 \
2009        9,0 $inner.wireframe  -anchor w -pady 2 -cspan 2\
2010        10,0 $inner.isolines   -anchor w -pady 2 -cspan 2 \
2011        11,0 $inner.separator1 -padx 2 -fill x -cspan 2 \
2012        12,0 $inner.outline    -anchor w -pady 2 -cspan 2 \
2013        13,0 $inner.separator2 -padx 2 -fill x -cspan 2 \
2014        14,0 $inner.lighting   -anchor w -pady 2 -cspan 2 \
2015        15,0 $inner.opacity_l -anchor w -pady 2 \
2016        15,1 $inner.opacity   -fill x   -pady 2 \
2017        16,0 $inner.scale_l   -anchor w -pady 2 -cspan 2 \
2018        16,1 $inner.scale     -fill x   -pady 2 -cspan 2 \
2019
2020    blt::table configure $inner r* c* -resize none
2021    blt::table configure $inner r17 c1 -resize expand
2022}
2023
2024itcl::body Rappture::VtkHeightmapViewer::BuildAxisTab {} {
2025
2026    set fg [option get $itk_component(hull) font Font]
2027    #set bfg [option get $itk_component(hull) boldFont Font]
2028
2029    set inner [$itk_component(main) insert end \
2030        -title "Axis Settings" \
2031        -icon [Rappture::icon axis2]]
2032    $inner configure -borderwidth 4
2033
2034    checkbutton $inner.visible \
2035        -text "Axes" \
2036        -variable [itcl::scope _settings(-axisvisible)] \
2037        -command [itcl::code $this AdjustSetting -axisvisible] \
2038        -font "Arial 9"
2039    checkbutton $inner.labels \
2040        -text "Axis Labels" \
2041        -variable [itcl::scope _settings(-axislabels)] \
2042        -command [itcl::code $this AdjustSetting -axislabels] \
2043        -font "Arial 9"
2044    label $inner.grid_l -text "Grid" -font "Arial 9"
2045    checkbutton $inner.xgrid \
2046        -text "X" \
2047        -variable [itcl::scope _settings(-xgrid)] \
2048        -command [itcl::code $this AdjustSetting -xgrid] \
2049        -font "Arial 9"
2050    checkbutton $inner.ygrid \
2051        -text "Y" \
2052        -variable [itcl::scope _settings(-ygrid)] \
2053        -command [itcl::code $this AdjustSetting -ygrid] \
2054        -font "Arial 9"
2055    checkbutton $inner.zgrid \
2056        -text "Z" \
2057        -variable [itcl::scope _settings(-zgrid)] \
2058        -command [itcl::code $this AdjustSetting -zgrid] \
2059        -font "Arial 9"
2060    checkbutton $inner.minorticks \
2061        -text "Minor Ticks" \
2062        -variable [itcl::scope _settings(-axisminorticks)] \
2063        -command [itcl::code $this AdjustSetting -axisminorticks] \
2064        -font "Arial 9"
2065
2066    label $inner.mode_l -text "Mode" -font "Arial 9"
2067
2068    itk_component add axisflymode {
2069        Rappture::Combobox $inner.mode -width 10 -editable no
2070    }
2071    $inner.mode choices insert end \
2072        "static_triad"    "static" \
2073        "closest_triad"   "closest" \
2074        "furthest_triad"  "farthest" \
2075        "outer_edges"     "outer"
2076    $itk_component(axisflymode) value $_settings(-axisflymode)
2077    bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axisflymode]
2078
2079    blt::table $inner \
2080        0,0 $inner.visible -anchor w -cspan 4 \
2081        1,0 $inner.labels  -anchor w -cspan 4 \
2082        2,0 $inner.minorticks  -anchor w -cspan 4 \
2083        4,0 $inner.grid_l  -anchor w \
2084        4,1 $inner.xgrid   -anchor w \
2085        4,2 $inner.ygrid   -anchor w \
2086        4,3 $inner.zgrid   -anchor w \
2087        5,0 $inner.mode_l  -anchor w -padx { 2 0 } \
2088        5,1 $inner.mode    -fill x -cspan 3
2089
2090    blt::table configure $inner r* c* -resize none
2091    blt::table configure $inner r7 c6 -resize expand
2092    blt::table configure $inner r3 -height 0.125i
2093}
2094
2095itcl::body Rappture::VtkHeightmapViewer::BuildCameraTab {} {
2096    set inner [$itk_component(main) insert end \
2097        -title "Camera Settings" \
2098        -icon [Rappture::icon camera]]
2099    $inner configure -borderwidth 4
2100
2101    label $inner.view_l -text "view" -font "Arial 9"
2102    set f [frame $inner.view]
2103    foreach side { front back left right top bottom } {
2104        button $f.$side  -image [Rappture::icon view$side] \
2105            -command [itcl::code $this SetOrientation $side]
2106        Rappture::Tooltip::for $f.$side "Change the view to $side"
2107        pack $f.$side -side left
2108    }
2109
2110    blt::table $inner \
2111        0,0 $inner.view_l -anchor e -pady 2 \
2112        0,1 $inner.view -anchor w -pady 2
2113    blt::table configure $inner r0 -resize none
2114
2115    set labels { qx qy qz qw xpan ypan zoom }
2116    set row 1
2117    foreach tag $labels {
2118        label $inner.${tag}label -text $tag -font "Arial 9"
2119        entry $inner.${tag} -font "Arial 9"  -bg white \
2120            -textvariable [itcl::scope _view(-$tag)]
2121        bind $inner.${tag} <Return> \
2122            [itcl::code $this camera set -${tag}]
2123        bind $inner.${tag} <KP_Enter> \
2124            [itcl::code $this camera set -${tag}]
2125        blt::table $inner \
2126            $row,0 $inner.${tag}label -anchor e -pady 2 \
2127            $row,1 $inner.${tag} -anchor w -pady 2
2128        blt::table configure $inner r$row -resize none
2129        incr row
2130    }
2131    checkbutton $inner.ortho \
2132        -text "Orthographic Projection" \
2133        -variable [itcl::scope _view(-ortho)] \
2134        -command [itcl::code $this camera set -ortho] \
2135        -font "Arial 9"
2136    blt::table $inner \
2137            $row,0 $inner.ortho -cspan 2 -anchor w -pady 2
2138    blt::table configure $inner r$row -resize none
2139    incr row
2140
2141    blt::table configure $inner c* -resize none
2142    blt::table configure $inner c2 -resize expand
2143    blt::table configure $inner r$row -resize expand
2144}
2145
2146#
2147#  camera --
2148#
2149itcl::body Rappture::VtkHeightmapViewer::camera {option args} {
2150    switch -- $option {
2151        "show" {
2152            puts [array get _view]
2153        }
2154        "set" {
2155            set what [lindex $args 0]
2156            set x $_view($what)
2157            set code [catch { string is double $x } result]
2158            if { $code != 0 || !$result } {
2159                return
2160            }
2161            switch -- $what {
2162                "-ortho" {
2163                    if {$_view($what)} {
2164                        SendCmd "camera mode ortho"
2165                    } else {
2166                        SendCmd "camera mode persp"
2167                    }
2168                }
2169                "-xpan" - "-ypan" {
2170                    PanCamera
2171                }
2172                "-qx" - "-qy" - "-qz" - "-qw" {
2173                    set q [ViewToQuaternion]
2174                    $_arcball quaternion $q
2175                    EventuallyRotate $q
2176                }
2177                "-zoom" {
2178                    SendCmd "camera zoom $_view($what)"
2179                }
2180            }
2181        }
2182    }
2183}
2184
2185itcl::body Rappture::VtkHeightmapViewer::GetVtkData { args } {
2186    set bytes ""
2187    foreach dataobj [get] {
2188        foreach comp [$dataobj components] {
2189            set tag $dataobj-$comp
2190            set contents [$dataobj vtkdata $comp]
2191            append bytes "$contents\n"
2192        }
2193    }
2194    return [list .vtk $bytes]
2195}
2196
2197itcl::body Rappture::VtkHeightmapViewer::GetImage { args } {
2198    if { [image width $_image(download)] > 0 &&
2199         [image height $_image(download)] > 0 } {
2200        set bytes [$_image(download) data -format "jpeg -quality 100"]
2201        set bytes [Rappture::encoding::decode -as b64 $bytes]
2202        return [list .jpg $bytes]
2203    }
2204    return ""
2205}
2206
2207itcl::body Rappture::VtkHeightmapViewer::BuildDownloadPopup { popup command } {
2208    Rappture::Balloon $popup \
2209        -title "[Rappture::filexfer::label downloadWord] as..."
2210    set inner [$popup component inner]
2211    label $inner.summary -text "" -anchor w
2212    radiobutton $inner.vtk_button -text "VTK data file" \
2213        -variable [itcl::scope _downloadPopup(format)] \
2214        -font "Arial 9 " \
2215        -value vtk
2216    Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
2217    radiobutton $inner.image_button -text "Image File" \
2218        -variable [itcl::scope _downloadPopup(format)] \
2219        -font "Arial 9 " \
2220        -value image
2221    Rappture::Tooltip::for $inner.image_button \
2222        "Save as digital image."
2223
2224    button $inner.ok -text "Save" \
2225        -highlightthickness 0 -pady 2 -padx 3 \
2226        -command $command \
2227        -compound left \
2228        -image [Rappture::icon download]
2229
2230    button $inner.cancel -text "Cancel" \
2231        -highlightthickness 0 -pady 2 -padx 3 \
2232        -command [list $popup deactivate] \
2233        -compound left \
2234        -image [Rappture::icon cancel]
2235
2236    blt::table $inner \
2237        0,0 $inner.summary -cspan 2  \
2238        1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
2239        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
2240        4,1 $inner.cancel -width .9i -fill y \
2241        4,0 $inner.ok -padx 2 -width .9i -fill y
2242    blt::table configure $inner r3 -height 4
2243    blt::table configure $inner r4 -pady 4
2244    raise $inner.image_button
2245    $inner.vtk_button invoke
2246    return $inner
2247}
2248
2249#
2250# SetObjectStyle --
2251#
2252#       Set the style of the heightmap/contour object.  This gets calls
2253#       for each dataset once as it is loaded.  It can overridden by
2254#       the user controls.
2255#
2256#
2257itcl::body Rappture::VtkHeightmapViewer::SetObjectStyle { dataobj comp } {
2258    # Parse style string.
2259    set tag $dataobj-$comp
2260    array set style {
2261        -color BCGYR
2262        -levels 10
2263        -opacity 1.0
2264    }
2265    set stylelist [$dataobj style $comp]
2266    if { $stylelist != "" } {
2267        array set style $stylelist
2268    }
2269    # This is too complicated.  We want to set the colormap, number of
2270    # isolines and opacity for the dataset.  They can be the default values,
2271    # the style hints loaded with the dataset, or set by user controls.  As
2272    # datasets get loaded, they first use the defaults that are overidden
2273    # by the style hints.  If the user changes the global controls, then that
2274    # overrides everything else.  I don't know what it means when global
2275    # controls are specified as style hints by each dataset.  It complicates
2276    # the code to handle aberrant cases.
2277
2278    if { $_changed(-opacity) } {
2279        set style(-opacity) [expr $_settings(-opacity) * 0.01]
2280    }
2281    if { $_changed(-numisolines) } {
2282        set style(-levels) $_settings(-numisolines)
2283    }
2284    if { $_changed(-colormap) } {
2285        set style(-color) $_settings(-colormap)
2286    }
2287    if { $_currentColormap == "" } {
2288        $itk_component(colormap) value $style(-color)
2289    }
2290    if { [info exists style(-stretchtofit)] } {
2291        set _settings(-stretchtofit) $style(-stretchtofit)
2292        AdjustSetting -stretchtofit
2293    }
2294    if { $_currentNumIsolines != $style(-levels) } {
2295        set _currentNumIsolines $style(-levels)
2296        set _settings(-numisolines) $_currentNumIsolines
2297        $itk_component(numisolines) value $_currentNumIsolines
2298        UpdateContourList
2299        DrawLegend
2300    }
2301    SendCmd "outline add $tag"
2302    SendCmd "outline color [Color2RGB $itk_option(-plotforeground)] $tag"
2303    SendCmd "outline visible $_settings(-outline) $tag"
2304    set scale [GetHeightmapScale]
2305    SendCmd "[list heightmap add contourlist $_contourList $scale $tag]"
2306    set _comp2scale($tag) $_settings(-heightmapscale)
2307    SendCmd "heightmap edges $_settings(-edges) $tag"
2308    SendCmd "heightmap wireframe $_settings(-wireframe) $tag"
2309    SetCurrentColormap $style(-color)
2310    set color [$itk_component(isolinecolor) value]
2311    SendCmd "heightmap isolinecolor [Color2RGB $color] $tag"
2312    SendCmd "heightmap lighting $_settings(-isheightmap) $tag"
2313    SendCmd "heightmap isolines $_settings(-isolinesvisible) $tag"
2314    SendCmd "heightmap surface $_settings(-colormapvisible) $tag"
2315    SendCmd "heightmap opacity $style(-opacity) $tag"
2316    set _settings(-opacity) [expr $style(-opacity) * 100.0]
2317}
2318
2319itcl::body Rappture::VtkHeightmapViewer::IsValidObject { dataobj } {
2320    if {[catch {$dataobj isa Rappture::Field} valid] != 0 || !$valid} {
2321        return 0
2322    }
2323    return 1
2324}
2325
2326# ----------------------------------------------------------------------
2327# USAGE: ReceiveLegend <colormap> <title> <min> <max> <size>
2328#
2329# Invoked automatically whenever the "legend" command comes in from
2330# the rendering server.  Indicates that binary image data with the
2331# specified <size> will follow.
2332# ----------------------------------------------------------------------
2333itcl::body Rappture::VtkHeightmapViewer::ReceiveLegend { colormap title min max size } {
2334    #puts stderr "ReceiveLegend colormap=$colormap title=$title range=$min,$max size=$size"
2335    if { [isconnected] } {
2336        set bytes [ReceiveBytes $size]
2337        if { ![info exists _image(legend)] } {
2338            set _image(legend) [image create photo]
2339        }
2340        $_image(legend) configure -data $bytes
2341        #puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
2342        if { [catch {DrawLegend} errs] != 0 } {
2343            global errorInfo
2344            puts stderr "errs=$errs errorInfo=$errorInfo"
2345        }
2346    }
2347}
2348
2349#
2350# DrawLegend --
2351#
2352#       Draws the legend in the own canvas on the right side of the plot area.
2353#
2354itcl::body Rappture::VtkHeightmapViewer::DrawLegend {} {
2355    set fname $_curFldName
2356    set c $itk_component(view)
2357    set w [winfo width $c]
2358    set h [winfo height $c]
2359    set font "Arial 8"
2360    set lineht [font metrics $font -linespace]
2361
2362    if { [string match "component*" $fname] } {
2363        set title ""
2364    } else {
2365        if { [info exists _fields($fname)] } {
2366            foreach { title units } $_fields($fname) break
2367            if { $units != "" } {
2368                set title [format "%s (%s)" $title $units]
2369            }
2370        } else {
2371            set title $fname
2372        }
2373    }
2374    set x [expr $w - 2]
2375    if { !$_settings(-legendvisible) } {
2376        $c delete legend
2377        return
2378    }
2379    if { [$c find withtag "legend"] == "" } {
2380        set y 2
2381        # If there's a legend title, create a text item for the title.
2382        $c create text $x $y \
2383            -anchor ne \
2384            -fill $itk_option(-plotforeground) -tags "title legend" \
2385            -font $font
2386        if { $title != "" } {
2387            incr y $lineht
2388        }
2389        $c create text $x $y \
2390            -anchor ne \
2391            -fill $itk_option(-plotforeground) -tags "vmax legend" \
2392            -font $font
2393        incr y $lineht
2394        $c create image $x $y \
2395            -anchor ne \
2396            -image $_image(legend) -tags "colormap legend"
2397        $c create rectangle $x $y 1 1 \
2398            -fill "" -outline "" -tags "sensor legend"
2399        $c create text $x [expr {$h-2}] \
2400            -anchor se \
2401            -fill $itk_option(-plotforeground) -tags "vmin legend" \
2402            -font $font
2403        $c bind sensor <Enter> [itcl::code $this EnterLegend %x %y]
2404        $c bind sensor <Leave> [itcl::code $this LeaveLegend]
2405        $c bind sensor <Motion> [itcl::code $this MotionLegend %x %y]
2406    }
2407    $c delete isoline
2408    set x2 $x
2409    set iw [image width $_image(legend)]
2410    set ih [image height $_image(legend)]
2411    set x1 [expr $x2 - ($iw*12)/10]
2412    set color [$itk_component(isolinecolor) value]
2413
2414    # Draw the isolines on the legend.
2415    array unset _isolines
2416    if { $color != "none"  && [info exists _limits($_curFldName)] &&
2417         $_settings(-isolinesvisible) && $_currentNumIsolines > 0 } {
2418
2419        foreach { vmin vmax } $_limits($_curFldName) break
2420        set range [expr double($vmax - $vmin)]
2421        if { $range <= 0.0 } {
2422            set range 1.0;              # Min is greater or equal to max.
2423        }
2424        set tags "isoline legend"
2425        set offset [expr 2 + $lineht]
2426        if { $title != "" } {
2427            incr offset $lineht
2428        }
2429        foreach value $_contourList {
2430            set norm [expr 1.0 - (($value - $vmin) / $range)]
2431            set y1 [expr int(round(($norm * $ih) + $offset))]
2432            for { set off 0 } { $off < 3 } { incr off } {
2433                set _isolines([expr $y1 + $off]) $value
2434                set _isolines([expr $y1 - $off]) $value
2435            }
2436            $c create line $x1 $y1 $x2 $y1 -fill $color -tags $tags
2437        }
2438    }
2439
2440    $c bind title <ButtonPress> [itcl::code $this Combo post]
2441    $c bind title <Enter> [itcl::code $this Combo activate]
2442    $c bind title <Leave> [itcl::code $this Combo deactivate]
2443    # Reset the item coordinates according the current size of the plot.
2444    if { [info exists _limits($_curFldName)] } {
2445        foreach { vmin vmax } $_limits($_curFldName) break
2446        $c itemconfigure vmin -text [format %g $vmin]
2447        $c itemconfigure vmax -text [format %g $vmax]
2448    }
2449    set y 2
2450    # If there's a legend title, move the title to the correct position
2451    if { $title != "" } {
2452        $c itemconfigure title -text $title
2453        $c coords title $x $y
2454        incr y $lineht
2455    }
2456    $c coords vmax $x $y
2457    incr y $lineht
2458    $c coords colormap $x $y
2459    $c coords sensor [expr $x - $iw] $y $x [expr $y + $ih]
2460    $c raise sensor
2461    $c coords vmin $x [expr {$h - 2}]
2462}
2463
2464#
2465# EnterLegend --
2466#
2467itcl::body Rappture::VtkHeightmapViewer::EnterLegend { x y } {
2468    SetLegendTip $x $y
2469}
2470
2471#
2472# MotionLegend --
2473#
2474itcl::body Rappture::VtkHeightmapViewer::MotionLegend { x y } {
2475    Rappture::Tooltip::tooltip cancel
2476    set c $itk_component(view)
2477    set cw [winfo width $c]
2478    set ch [winfo height $c]
2479    if { $x >= 0 && $x < $cw && $y >= 0 && $y < $ch } {
2480        SetLegendTip $x $y
2481    }
2482}
2483
2484#
2485# LeaveLegend --
2486#
2487itcl::body Rappture::VtkHeightmapViewer::LeaveLegend { } {
2488    Rappture::Tooltip::tooltip cancel
2489    .rappturetooltip configure -icon ""
2490}
2491
2492#
2493# SetLegendTip --
2494#
2495itcl::body Rappture::VtkHeightmapViewer::SetLegendTip { x y } {
2496    set fname $_curFldName
2497    set c $itk_component(view)
2498    set w [winfo width $c]
2499    set h [winfo height $c]
2500    set font "Arial 8"
2501    set lineht [font metrics $font -linespace]
2502
2503    set ih [image height $_image(legend)]
2504    # Subtract off the offset of the color ramp from the top of the canvas
2505    set iy [expr $y - ($lineht + 2)]
2506
2507    if { [string match "component*" $fname] } {
2508        set title ""
2509    } else {
2510        if { [info exists _fields($fname)] } {
2511            foreach { title units } $_fields($fname) break
2512            if { $units != "" } {
2513                set title [format "%s (%s)" $title $units]
2514            }
2515        } else {
2516            set title $fname
2517        }
2518    }
2519    # If there's a legend title, increase the offset by the line height.
2520    if { $title != "" } {
2521        incr iy -$lineht
2522    }
2523
2524    # Make a swatch of the selected color
2525    if { [catch { $_image(legend) get 10 $iy } pixel] != 0 } {
2526        return
2527    }
2528
2529    if { ![info exists _image(swatch)] } {
2530        set _image(swatch) [image create photo -width 24 -height 24]
2531    }
2532    set color [eval format "\#%02x%02x%02x" $pixel]
2533    $_image(swatch) put black  -to 0 0 23 23
2534    $_image(swatch) put $color -to 1 1 22 22
2535
2536    # Compute the value of the point
2537    if { [info exists _limits($fname)] } {
2538        foreach { vmin vmax } $_limits($fname) break
2539        set t [expr 1.0 - (double($iy) / double($ih-1))]
2540        set value [expr $t * ($vmax - $vmin) + $vmin]
2541    } else {
2542        set value 0.0
2543    }
2544    set tipx [expr $x + 15]
2545    set tipy [expr $y - 5]
2546    .rappturetooltip configure -icon $_image(swatch)
2547    if { [info exists _isolines($y)] } {
2548        Rappture::Tooltip::text $c [format "$title %g (isoline)" $_isolines($y)]
2549    } else {
2550        Rappture::Tooltip::text $c [format "$title %g" $value]
2551    }
2552    Rappture::Tooltip::tooltip show $c +$tipx,+$tipy
2553}
2554
2555# ----------------------------------------------------------------------
2556# USAGE: _dropdown post
2557# USAGE: _dropdown unpost
2558# USAGE: _dropdown select
2559#
2560# Used internally to handle the dropdown list for this combobox.  The
2561# post/unpost options are invoked when the list is posted or unposted
2562# to manage the relief of the controlling button.  The select option
2563# is invoked whenever there is a selection from the list, to assign
2564# the value back to the gauge.
2565# ----------------------------------------------------------------------
2566itcl::body Rappture::VtkHeightmapViewer::Combo {option} {
2567    set c $itk_component(view)
2568    switch -- $option {
2569        post {
2570            foreach { x1 y1 x2 y2 } [$c bbox title] break
2571            set x1 [expr [winfo width $itk_component(view)] - [winfo reqwidth $itk_component(fieldmenu)]]
2572            set x [expr $x1 + [winfo rootx $itk_component(view)]]
2573            set y [expr $y2 + [winfo rooty $itk_component(view)]]
2574            tk_popup $itk_component(fieldmenu) $x $y
2575        }
2576        activate {
2577            $c itemconfigure title -fill red
2578        }
2579        deactivate {
2580            $c itemconfigure title -fill $itk_option(-plotforeground)
2581        }
2582        invoke {
2583            $itk_component(field) value $_curFldLabel
2584            AdjustSetting -field
2585        }
2586        default {
2587            error "bad option \"$option\": should be post, unpost, select"
2588        }
2589    }
2590}
2591
2592itcl::body Rappture::VtkHeightmapViewer::GetHeightmapScale {} {
2593    if {  $_settings(-isheightmap) } {
2594        set val $_settings(-heightmapscale)
2595        set sval [expr { $val >= 50 ? double($val)/50.0 : 1.0/(2.0-(double($val)/50.0)) }]
2596        return $sval
2597    }
2598    return 0
2599}
2600
2601itcl::body Rappture::VtkHeightmapViewer::SetOrientation { side } {
2602    array set positions {
2603        front  "0.707107 0.707107 0 0"
2604        back   "0 0 0.707107 0.707107"
2605        left   "0.5 0.5 -0.5 -0.5"
2606        right  "0.5 0.5 0.5 0.5"
2607        top    "1 0 0 0"
2608        bottom "0 1 0 0"
2609    }
2610    foreach name { -qw -qx -qy -qz } value $positions($side) {
2611        set _view($name) $value
2612    }
2613    set q [ViewToQuaternion]
2614    $_arcball quaternion $q
2615    SendCmd "camera orient $q"
2616    SendCmd "camera reset"
2617    set _view(-xpan) 0
2618    set _view(-ypan) 0
2619    set _view(-zoom) 1.0
2620}
2621
2622itcl::body Rappture::VtkHeightmapViewer::UpdateContourList {} {
2623    if {$_currentNumIsolines == 0} {
2624        set _contourList ""
2625        return
2626    }
2627    if { ![info exists _limits($_curFldName)] } {
2628        return
2629    }
2630    foreach { vmin vmax } $_limits($_curFldName) break
2631    set v [blt::vector create \#auto]
2632    $v seq $vmin $vmax [expr $_currentNumIsolines+2]
2633    $v delete end 0
2634    set _contourList [$v range 0 end]
2635    blt::vector destroy $v
2636}
Note: See TracBrowser for help on using the repository browser.