source: trunk/gui/scripts/vtksurfaceviewer.tcl @ 4381

Last change on this file since 4381 was 4381, checked in by ldelgass, 7 years ago

opacity style setting fixes for VTK viewers (expect vtkvolumeviewer which does
not yet support the style setting). Also note that nanovisviewer (and
flowvisviewer?) have a regression which changes the -opacity style to [0,100]
instead of [0,1]

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