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

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

merge r6235:6236 from trunk (streamlines scaling)

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