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

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

Reset zoom when changing aspect (stretch mode) setting. Also, make Zoom reset
only reset zoom/pan (not rotation) and add CameraReset? method to reset all
camera settings.

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