source: branches/1.3/gui/scripts/vtkheightmapviewer.tcl @ 4766

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

merge r4765 from trunk

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