source: branches/1.7/gui/scripts/vtksurfaceviewer.tcl @ 6306

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

merge fixes from trunk

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