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

Last change on this file since 5347 was 5347, checked in by ldelgass, 5 years ago

set _downloadPopup to private access

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