source: branches/1.7/gui/scripts/vtkheightmapviewer.tcl @ 6266

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

merge r6265 from 1.6 branch

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