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

Last change on this file since 3963 was 3963, checked in by ldelgass, 11 years ago

Bring vtk volume viewer UI closer in line with new nanovis viewer, add settings
for blendmode, opacity. Note that some controls only work with certain volume
mappers in VTK (right now this is selected when the server is built).

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