source: branches/1.7/gui/scripts/vtkglyphviewer.tcl @ 6228

Last change on this file since 6228 was 6228, checked in by ldelgass, 9 years ago

merge r6182 from trunk (custom range support for vtkglyphviewer)

File size: 108.7 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: vtkglyphviewer - Vtk 3D glyphs object 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 *VtkGlyphViewer.width 4i widgetDefault
19option add *VtkGlyphViewer*cursor crosshair widgetDefault
20option add *VtkGlyphViewer.height 4i widgetDefault
21option add *VtkGlyphViewer.foreground black widgetDefault
22option add *VtkGlyphViewer.controlBackground gray widgetDefault
23option add *VtkGlyphViewer.controlDarkBackground #999999 widgetDefault
24option add *VtkGlyphViewer.plotBackground black widgetDefault
25option add *VtkGlyphViewer.plotForeground white widgetDefault
26option add *VtkGlyphViewer.font \
27    -*-helvetica-medium-r-normal-*-12-* widgetDefault
28
29# must use this name -- plugs into Rappture::resources::load
30proc VtkGlyphViewer_init_resources {} {
31    Rappture::resources::register \
32        vtkvis_server Rappture::VtkGlyphViewer::SetServerList
33}
34
35itcl::class Rappture::VtkGlyphViewer {
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 BuildCutplanesTab {}
70    private method BuildDownloadPopup { widget command }
71    private method BuildGlyphTab {}
72    private method Connect {}
73    private method CurrentDatasets {args}
74    private method DisableMouseRotationBindings {}
75    private method Disconnect {}
76    private method DoResize {}
77    private method DoRotate {}
78    private method DrawLegend {}
79    private method EnterLegend { x y }
80    private method EventuallyRequestLegend {}
81    private method EventuallyResize { w h }
82    private method EventuallyRotate { q }
83    private method EventuallySetCutplane { axis args }
84    private method GetImage { args }
85    private method GetVtkData { args }
86    private method InitSettings { args }
87    private method IsValidObject { dataobj }
88    private method LeaveLegend {}
89    private method LegendPointToValue { x y }
90    private method LegendRangeAction { option args }
91    private method LegendRangeValidate { widget which value }
92    private method LegendTitleAction { option }
93    private method MotionLegend { x y }
94    private method MouseOver2Which {}
95    private method Pan {option x y}
96    private method PanCamera {}
97    private method Pick {x y}
98    private method QuaternionToView { q } {
99        foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break
100    }
101    private method Rebuild {}
102    private method ReceiveDataset { args }
103    private method ReceiveImage { args }
104    private method ReceiveLegend { colormap title vmin vmax size }
105    private method RequestLegend {}
106    private method Rotate {option x y}
107    private method SetCurrentColormap { color }
108    private method SetCurrentFieldName { dataobj }
109    private method SetLegendTip { x y }
110    private method SetMinMaxGauges { min max }
111    private method SetObjectStyle { dataobj comp }
112    private method SetOrientation { side }
113    private method SetupKeyboardBindings {}
114    private method SetupMousePanningBindings {}
115    private method SetupMouseRotationBindings {}
116    private method SetupMouseZoomBindings {}
117    private method Slice {option args}
118    private method ToggleCustomRange { args }
119    private method ViewToQuaternion {} {
120        return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)]
121    }
122    private method Zoom {option}
123
124    private variable _arcball ""
125
126    private variable _dlist "";         # list of data objects
127    private variable _obj2ovride;       # maps dataobj => style override
128    private variable _datasets;         # contains all the dataobj-component
129                                        # datasets in the server
130    private variable _colormaps;        # contains all the colormaps
131                                        # in the server.
132    # The name of the current colormap used.  The colormap is global to all
133    # heightmaps displayed.
134    private variable _currentColormap ""
135
136    private variable _click;            # info used for rotate operations
137    private variable _limits;           # autoscale min/max for all axes
138    private variable _view;             # view params for 3D view
139    private variable _settings
140    private variable _changed
141    private variable _reset 1;          # Connection to server has been reset.
142
143    private variable _first "";         # This is the topmost dataset.
144    private variable _start 0
145    private variable _title ""
146    private variable _widget
147    private variable _width 0
148    private variable _height 0
149    private variable _resizePending 0
150    private variable _legendPending 0
151    private variable _rotatePending 0
152    private variable _cutplanePending 0
153    private variable _field      ""
154    private variable _colorMode "vmag"; # Mode of colormap (vmag or scalar)
155    private variable _fields
156    private variable _curFldName ""
157    private variable _curFldLabel ""
158    private variable _curFldComp 3
159    private variable _mouseOver "";     # what called LegendRangeAction:
160                                        # vmin or vmax
161    private variable _customRangeClick 1; # what called ToggleCustomRange
162
163    private common _downloadPopup;      # download options from popup
164    private common _hardcopy
165}
166
167itk::usual VtkGlyphViewer {
168    keep -background -foreground -cursor -font
169    keep -plotbackground -plotforeground
170}
171
172# ----------------------------------------------------------------------
173# CONSTRUCTOR
174# ----------------------------------------------------------------------
175itcl::body Rappture::VtkGlyphViewer::constructor {args} {
176    set _serverType "vtkvis"
177
178    #DebugOn
179    EnableWaitDialog 900
180
181    # Rebuild event
182    $_dispatcher register !rebuild
183    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
184
185    # Resize event
186    $_dispatcher register !resize
187    $_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
188
189    # Legend event
190    $_dispatcher register !legend
191    $_dispatcher dispatch $this !legend "[itcl::code $this RequestLegend]; list"
192
193    # Rotate event
194    $_dispatcher register !rotate
195    $_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
196
197    # X-Cutplane event
198    $_dispatcher register !xcutplane
199    $_dispatcher dispatch $this !xcutplane \
200        "[itcl::code $this AdjustSetting -xcutplaneposition]; list"
201
202    # Y-Cutplane event
203    $_dispatcher register !ycutplane
204    $_dispatcher dispatch $this !ycutplane \
205        "[itcl::code $this AdjustSetting -ycutplaneposition]; list"
206
207    # Z-Cutplane event
208    $_dispatcher register !zcutplane
209    $_dispatcher dispatch $this !zcutplane \
210        "[itcl::code $this AdjustSetting -zcutplaneposition]; list"
211
212    #
213    # Populate parser with commands handle incoming requests
214    #
215    $_parser alias image [itcl::code $this ReceiveImage]
216    $_parser alias legend [itcl::code $this ReceiveLegend]
217    $_parser alias dataset [itcl::code $this ReceiveDataset]
218
219    # Initialize the view to some default parameters.
220    array set _view {
221        -ortho    0
222        -qw       0.853553
223        -qx       -0.353553
224        -qy       0.353553
225        -qz       0.146447
226        -xpan     0
227        -ypan     0
228        -zoom     1.0
229    }
230    set _arcball [blt::arcball create 100 100]
231    $_arcball quaternion [ViewToQuaternion]
232
233    array set _settings {
234        -axesvisible            1
235        -axislabels             1
236        -axisminorticks         1
237        -axismode               "static"
238        -background             black
239        -colormap               BCGYR
240        -colormapvisible        1
241        -customrange            0
242        -customrangemin         0
243        -customrangemax         1
244        -cutplaneedges          0
245        -cutplanelighting       1
246        -cutplaneopacity        1.0
247        -cutplanepreinterp      1
248        -cutplanesvisible       0
249        -cutplanewireframe      0
250        -field                  "Default"
251        -glyphedges             0
252        -glyphlighting          1
253        -glyphnormscale         1
254        -glyphopacity           1.0
255        -glyphorient            1
256        -glyphscale             1
257        -glyphscalemode         "vmag"
258        -glyphshape             "arrow"
259        -glyphsvisible          1
260        -glyphwireframe         0
261        -legendvisible          1
262        -outline                0
263        -xcutplaneposition      50
264        -xcutplanevisible       1
265        -xgrid                  0
266        -ycutplaneposition      50
267        -ycutplanevisible       1
268        -ygrid                  0
269        -zcutplaneposition      50
270        -zcutplanevisible       1
271        -zgrid                  0
272    }
273    array set _changed {
274        -colormap               0
275        -cutplaneedges          0
276        -cutplanelighting       0
277        -cutplaneopacity        0
278        -cutplanepreinterp      0
279        -cutplanesvisible       0
280        -cutplanewireframe      0
281        -glyphedges             0
282        -glyphlighting          0
283        -glyphnormscale         0
284        -glyphopacity           0
285        -glyphorient            0
286        -glyphscale             0
287        -glyphscalemode         0
288        -glyphshape             0
289        -glyphsvisible          0
290        -glyphwireframe         0
291        -outline                0
292        -xcutplaneposition      0
293        -xcutplanevisible       0
294        -ycutplaneposition      0
295        -ycutplanevisible       0
296        -zcutplaneposition      0
297        -zcutplanevisible       0
298    }
299    array set _widget {
300        -cutplaneopacity        100
301        -glyphopacity           100
302    }
303
304    itk_component add view {
305        canvas $itk_component(plotarea).view \
306            -highlightthickness 0 -borderwidth 0
307    } {
308        usual
309        ignore -highlightthickness -borderwidth -background
310    }
311
312    itk_component add fieldmenu {
313        menu $itk_component(plotarea).menu -bg black -fg white -relief flat \
314            -tearoff 0
315    } {
316        usual
317        ignore -background -foreground -relief -tearoff
318    }
319
320    # add an editor for adjusting the legend min and max values
321    itk_component add editor {
322        Rappture::Editor $itk_interior.editor \
323            -activatecommand [itcl::code $this LegendRangeAction activate] \
324            -validatecommand [itcl::code $this LegendRangeAction validate] \
325            -applycommand [itcl::code $this LegendRangeAction apply]
326    }
327
328    set c $itk_component(view)
329    bind $c <Configure> [itcl::code $this EventuallyResize %w %h]
330    bind $c <Control-F1> [itcl::code $this ToggleConsole]
331
332    # Fix the scrollregion in case we go off screen
333    $c configure -scrollregion [$c bbox all]
334
335    set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
336    set _map(cwidth) -1
337    set _map(cheight) -1
338    set _map(zoom) 1.0
339    set _map(original) ""
340
341    set f [$itk_component(main) component controls]
342    itk_component add reset {
343        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
344            -highlightthickness 0 \
345            -image [Rappture::icon reset-view] \
346            -command [itcl::code $this Zoom reset]
347    } {
348        usual
349        ignore -highlightthickness
350    }
351    pack $itk_component(reset) -side top -padx 2 -pady 2
352    Rappture::Tooltip::for $itk_component(reset) \
353        "Reset the view to the default zoom level"
354
355    itk_component add zoomin {
356        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
357            -highlightthickness 0 \
358            -image [Rappture::icon zoom-in] \
359            -command [itcl::code $this Zoom in]
360    } {
361        usual
362        ignore -highlightthickness
363    }
364    pack $itk_component(zoomin) -side top -padx 2 -pady 2
365    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
366
367    itk_component add zoomout {
368        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
369            -highlightthickness 0 \
370            -image [Rappture::icon zoom-out] \
371            -command [itcl::code $this Zoom out]
372    } {
373        usual
374        ignore -highlightthickness
375    }
376    pack $itk_component(zoomout) -side top -padx 2 -pady 2
377    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
378
379    itk_component add glyphs {
380        Rappture::PushButton $f.glyphs \
381            -onimage [Rappture::icon volume-on] \
382            -offimage [Rappture::icon volume-off] \
383            -variable [itcl::scope _settings(-glyphsvisible)] \
384            -command [itcl::code $this AdjustSetting -glyphsvisible]
385    }
386    $itk_component(glyphs) select
387    Rappture::Tooltip::for $itk_component(glyphs) \
388        "Hide the glyphs"
389    pack $itk_component(glyphs) -padx 2 -pady 2
390
391    if {0} {
392    itk_component add cutplane {
393        Rappture::PushButton $f.cutplane \
394            -onimage [Rappture::icon cutbutton] \
395            -offimage [Rappture::icon cutbutton] \
396            -variable [itcl::scope _settings(-cutplanesvisible)] \
397            -command [itcl::code $this AdjustSetting -cutplanesvisible]
398    }
399    Rappture::Tooltip::for $itk_component(cutplane) \
400        "Show the cutplanes"
401    pack $itk_component(cutplane) -padx 2 -pady 2
402    }
403
404    if { [catch {
405        BuildGlyphTab
406        #BuildCutplanesTab
407        BuildAxisTab
408        BuildCameraTab
409    } errs] != 0 } {
410        puts stderr errs=$errs
411    }
412
413    # Legend
414    set _image(legend) [image create photo]
415    itk_component add legend {
416        canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0
417    } {
418        usual
419        ignore -highlightthickness
420        rename -background -plotbackground plotBackground Background
421    }
422
423    # Hack around the Tk panewindow.  The problem is that the requested
424    # size of the 3d view isn't set until an image is retrieved from
425    # the server.  So the panewindow uses the tiny size.
426    set w 10000
427    pack forget $itk_component(view)
428    blt::table $itk_component(plotarea) \
429        0,0 $itk_component(view) -fill both -reqwidth $w
430    blt::table configure $itk_component(plotarea) c1 -resize none
431
432    SetupMouseRotationBindings
433    SetupMousePanningBindings
434    SetupMouseZoomBindings
435    SetupKeyboardBindings
436
437    #bind $itk_component(view) <ButtonRelease-3> \
438    #    [itcl::code $this Pick %x %y]
439
440    set _image(download) [image create photo]
441
442    eval itk_initialize $args
443
444    Connect
445}
446
447# ----------------------------------------------------------------------
448# DESTRUCTOR
449# ----------------------------------------------------------------------
450itcl::body Rappture::VtkGlyphViewer::destructor {} {
451    Disconnect
452    image delete $_image(plot)
453    image delete $_image(download)
454    catch { blt::arcball destroy $_arcball }
455}
456
457itcl::body Rappture::VtkGlyphViewer::SetupMouseRotationBindings {} {
458    # Bindings for rotation via mouse
459    bind $itk_component(view) <ButtonPress-1> \
460        [itcl::code $this Rotate click %x %y]
461    bind $itk_component(view) <B1-Motion> \
462        [itcl::code $this Rotate drag %x %y]
463    bind $itk_component(view) <ButtonRelease-1> \
464        [itcl::code $this Rotate release %x %y]
465}
466
467itcl::body Rappture::VtkGlyphViewer::DisableMouseRotationBindings {} {
468    # Bindings for rotation via mouse
469    bind $itk_component(view) <ButtonPress-1> ""
470    bind $itk_component(view) <B1-Motion> ""
471    bind $itk_component(view) <ButtonRelease-1> ""
472}
473
474itcl::body Rappture::VtkGlyphViewer::SetupMousePanningBindings {} {
475    # Bindings for panning via mouse
476    bind $itk_component(view) <ButtonPress-2> \
477        [itcl::code $this Pan click %x %y]
478    bind $itk_component(view) <B2-Motion> \
479        [itcl::code $this Pan drag %x %y]
480    bind $itk_component(view) <ButtonRelease-2> \
481        [itcl::code $this Pan release %x %y]
482}
483
484itcl::body Rappture::VtkGlyphViewer::SetupMouseZoomBindings {} {
485    if {[string equal "x11" [tk windowingsystem]]} {
486        # Bindings for zoom via mouse
487        bind $itk_component(view) <4> [itcl::code $this Zoom out]
488        bind $itk_component(view) <5> [itcl::code $this Zoom in]
489    }
490}
491
492itcl::body Rappture::VtkGlyphViewer::SetupKeyboardBindings {} {
493    # Bindings for panning via keyboard
494    bind $itk_component(view) <KeyPress-Left> \
495        [itcl::code $this Pan set -10 0]
496    bind $itk_component(view) <KeyPress-Right> \
497        [itcl::code $this Pan set 10 0]
498    bind $itk_component(view) <KeyPress-Up> \
499        [itcl::code $this Pan set 0 -10]
500    bind $itk_component(view) <KeyPress-Down> \
501        [itcl::code $this Pan set 0 10]
502    bind $itk_component(view) <Shift-KeyPress-Left> \
503        [itcl::code $this Pan set -2 0]
504    bind $itk_component(view) <Shift-KeyPress-Right> \
505        [itcl::code $this Pan set 2 0]
506    bind $itk_component(view) <Shift-KeyPress-Up> \
507        [itcl::code $this Pan set 0 -2]
508    bind $itk_component(view) <Shift-KeyPress-Down> \
509        [itcl::code $this Pan set 0 2]
510
511    # Bindings for zoom via keyboard
512    bind $itk_component(view) <KeyPress-Prior> \
513        [itcl::code $this Zoom out]
514    bind $itk_component(view) <KeyPress-Next> \
515        [itcl::code $this Zoom in]
516
517    bind $itk_component(view) <Enter> "focus $itk_component(view)"
518}
519
520itcl::body Rappture::VtkGlyphViewer::DoResize {} {
521    if { $_width < 2 } {
522        set _width 500
523    }
524    if { $_height < 2 } {
525        set _height 500
526    }
527    set _start [clock clicks -milliseconds]
528    SendCmd "screen size $_width $_height"
529
530    EventuallyRequestLegend
531    set _resizePending 0
532}
533
534itcl::body Rappture::VtkGlyphViewer::DoRotate {} {
535    SendCmd "camera orient [ViewToQuaternion]"
536    set _rotatePending 0
537}
538
539itcl::body Rappture::VtkGlyphViewer::EventuallyRequestLegend {} {
540    if { !$_legendPending } {
541        set _legendPending 1
542        $_dispatcher event -idle !legend
543    }
544}
545
546itcl::body Rappture::VtkGlyphViewer::EventuallyResize { w h } {
547    set _width $w
548    set _height $h
549    $_arcball resize $w $h
550    if { !$_resizePending } {
551        set _resizePending 1
552        $_dispatcher event -after 400 !resize
553    }
554}
555
556set rotate_delay 100
557
558itcl::body Rappture::VtkGlyphViewer::EventuallyRotate { q } {
559    QuaternionToView $q
560    if { !$_rotatePending } {
561        set _rotatePending 1
562        global rotate_delay
563        $_dispatcher event -after $rotate_delay !rotate
564    }
565}
566
567itcl::body Rappture::VtkGlyphViewer::EventuallySetCutplane { axis args } {
568    if { !$_cutplanePending } {
569        set _cutplanePending 1
570        $_dispatcher event -after 100 !${axis}cutplane
571    }
572}
573
574# ----------------------------------------------------------------------
575# USAGE: add <dataobj> ?<settings>?
576#
577# Clients use this to add a data object to the plot.  The optional
578# <settings> are used to configure the plot.  Allowed settings are
579# -color, -brightness, -width, -linestyle, and -raise.
580# ----------------------------------------------------------------------
581itcl::body Rappture::VtkGlyphViewer::add {dataobj {settings ""}} {
582    if { ![$dataobj isvalid] } {
583        return;                         # Object doesn't contain valid data.
584    }
585    array set params {
586        -color auto
587        -width 1
588        -linestyle solid
589        -brightness 0
590        -raise 0
591        -description ""
592        -param ""
593        -type ""
594    }
595    array set params $settings
596    set params(-description) ""
597    set params(-param) ""
598    array set params $settings
599
600    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
601        # can't handle -autocolors yet
602        set params(-color) black
603    }
604    set pos [lsearch -exact $_dlist $dataobj]
605    if {$pos < 0} {
606        lappend _dlist $dataobj
607    }
608    set _obj2ovride($dataobj-color) $params(-color)
609    set _obj2ovride($dataobj-width) $params(-width)
610    set _obj2ovride($dataobj-raise) $params(-raise)
611    $_dispatcher event -idle !rebuild
612}
613
614# ----------------------------------------------------------------------
615# USAGE: delete ?<dataobj1> <dataobj2> ...?
616#
617# Clients use this to delete a dataobj from the plot.  If no dataobjs
618# are specified, then all dataobjs are deleted.  No data objects are
619# deleted.  They are only removed from the display list.
620# ----------------------------------------------------------------------
621itcl::body Rappture::VtkGlyphViewer::delete {args} {
622    if { [llength $args] == 0} {
623        set args $_dlist
624    }
625    # Delete all specified dataobjs
626    set changed 0
627    foreach dataobj $args {
628        set pos [lsearch -exact $_dlist $dataobj]
629        if { $pos < 0 } {
630            continue;                   # Don't know anything about it.
631        }
632        # Remove it from the dataobj list.
633        set _dlist [lreplace $_dlist $pos $pos]
634        array unset _obj2ovride $dataobj-*
635        array unset _settings $dataobj-*
636        set changed 1
637    }
638    # If anything changed, then rebuild the plot
639    if { $changed } {
640        $_dispatcher event -idle !rebuild
641    }
642}
643
644# ----------------------------------------------------------------------
645# USAGE: get ?-objects?
646# USAGE: get ?-visible?
647# USAGE: get ?-image view?
648#
649# Clients use this to query the list of objects being plotted, in
650# order from bottom to top of this result.  The optional "-image"
651# flag can also request the internal images being shown.
652# ----------------------------------------------------------------------
653itcl::body Rappture::VtkGlyphViewer::get {args} {
654    if {[llength $args] == 0} {
655        set args "-objects"
656    }
657
658    set op [lindex $args 0]
659    switch -- $op {
660        "-objects" {
661            # put the dataobj list in order according to -raise options
662            set dlist {}
663            foreach dataobj $_dlist {
664                if { ![IsValidObject $dataobj] } {
665                    continue
666                }
667                if {[info exists _obj2ovride($dataobj-raise)] &&
668                    $_obj2ovride($dataobj-raise)} {
669                    set dlist [linsert $dlist 0 $dataobj]
670                } else {
671                    lappend dlist $dataobj
672                }
673            }
674            return $dlist
675        }
676        "-visible" {
677            set dlist {}
678            foreach dataobj $_dlist {
679                if { ![IsValidObject $dataobj] } {
680                    continue
681                }
682                if { ![info exists _obj2ovride($dataobj-raise)] } {
683                    # No setting indicates that the object isn't visible.
684                    continue
685                }
686                # Otherwise use the -raise parameter to put the object to
687                # the front of the list.
688                if { $_obj2ovride($dataobj-raise) } {
689                    set dlist [linsert $dlist 0 $dataobj]
690                } else {
691                    lappend dlist $dataobj
692                }
693            }
694            return $dlist
695        }
696        -image {
697            if {[llength $args] != 2} {
698                error "wrong # args: should be \"get -image view\""
699            }
700            switch -- [lindex $args end] {
701                view {
702                    return $_image(plot)
703                }
704                default {
705                    error "bad image name \"[lindex $args end]\": should be view"
706                }
707            }
708        }
709        default {
710            error "bad option \"$op\": should be -objects or -image"
711        }
712    }
713}
714
715# ----------------------------------------------------------------------
716# USAGE: scale ?<data1> <data2> ...?
717#
718# Sets the default limits for the overall plot according to the
719# limits of the data for all of the given <data> objects.  This
720# accounts for all objects--even those not showing on the screen.
721# Because of this, the limits are appropriate for all objects as
722# the user scans through data in the ResultSet viewer.
723# ----------------------------------------------------------------------
724itcl::body Rappture::VtkGlyphViewer::scale { args } {
725    foreach dataobj $args {
726        if { ![$dataobj isvalid] } {
727            continue;                   # Object doesn't contain valid data.
728        }
729        foreach axis { x y z } {
730            set lim [$dataobj limits $axis]
731            if { ![info exists _limits($axis)] } {
732                set _limits($axis) $lim
733                continue
734            }
735            foreach {min max} $lim break
736            foreach {amin amax} $_limits($axis) break
737            if { $amin > $min } {
738                set amin $min
739            }
740            if { $amax < $max } {
741                set amax $max
742            }
743            set _limits($axis) [list $amin $amax]
744        }
745        foreach { fname lim } [$dataobj fieldlimits] {
746            if { ![info exists _limits($fname)] } {
747                set _limits($fname) $lim
748
749                # set reasonable defaults for
750                # customrangevmin and customrangevmax
751                foreach {min max} $lim break
752                SetMinMaxGauges $min $max
753                set _settings(-customrangemin) $min
754                set _settings(-customrangemax) $max
755
756                continue
757            }
758            foreach {min max} $lim break
759            foreach {fmin fmax} $_limits($fname) break
760            if { ! $_settings(-customrange) } {
761                SetMinMaxGauges $fmin $fmax
762            }
763            if { $fmin > $min } {
764                set fmin $min
765            }
766            if { $fmax < $max } {
767                set fmax $max
768            }
769            set _limits($fname) [list $fmin $fmax]
770        }
771    }
772}
773
774# ----------------------------------------------------------------------
775# USAGE: download coming
776# USAGE: download controls <downloadCommand>
777# USAGE: download now
778#
779# Clients use this method to create a downloadable representation
780# of the plot.  Returns a list of the form {ext string}, where
781# "ext" is the file extension (indicating the type of data) and
782# "string" is the data itself.
783# ----------------------------------------------------------------------
784itcl::body Rappture::VtkGlyphViewer::download {option args} {
785    switch $option {
786        coming {
787            if {[catch {
788                blt::winop snap $itk_component(plotarea) $_image(download)
789            }]} {
790                $_image(download) configure -width 1 -height 1
791                $_image(download) put #000000
792            }
793        }
794        controls {
795            set popup .vtkviewerdownload
796            if { ![winfo exists .vtkviewerdownload] } {
797                set inner [BuildDownloadPopup $popup [lindex $args 0]]
798            } else {
799                set inner [$popup component inner]
800            }
801            set _downloadPopup(image_controls) $inner.image_frame
802            set num [llength [get]]
803            set num [expr {($num == 1) ? "1 result" : "$num results"}]
804            set word [Rappture::filexfer::label downloadWord]
805            $inner.summary configure -text "$word $num in the following format:"
806            update idletasks            ;# Fix initial sizes
807            return $popup
808        }
809        now {
810            set popup .vtkviewerdownload
811            if {[winfo exists .vtkviewerdownload]} {
812                $popup deactivate
813            }
814            switch -- $_downloadPopup(format) {
815                "image" {
816                    return [$this GetImage [lindex $args 0]]
817                }
818                "vtk" {
819                    return [$this GetVtkData [lindex $args 0]]
820                }
821            }
822            return ""
823        }
824        default {
825            error "bad option \"$option\": should be coming, controls, now"
826        }
827    }
828}
829
830# ----------------------------------------------------------------------
831# USAGE: Connect ?<host:port>,<host:port>...?
832#
833# Clients use this method to establish a connection to a new
834# server, or to reestablish a connection to the previous server.
835# Any existing connection is automatically closed.
836# ----------------------------------------------------------------------
837itcl::body Rappture::VtkGlyphViewer::Connect {} {
838    set _hosts [GetServerList "vtkvis"]
839    if { "" == $_hosts } {
840        return 0
841    }
842    set _reset 1
843    set result [VisViewer::Connect $_hosts]
844    if { $result } {
845        if { $_reportClientInfo }  {
846            # Tell the server the viewer, hub, user and session.
847            # Do this immediately on connect before buffering any commands
848            global env
849
850            set info {}
851            set user "???"
852            if { [info exists env(USER)] } {
853                set user $env(USER)
854            }
855            set session "???"
856            if { [info exists env(SESSION)] } {
857                set session $env(SESSION)
858            }
859            lappend info "version" "$Rappture::version"
860            lappend info "build" "$Rappture::build"
861            lappend info "svnurl" "$Rappture::svnurl"
862            lappend info "installdir" "$Rappture::installdir"
863            lappend info "hub" [exec hostname]
864            lappend info "client" "vtkglyphviewer"
865            lappend info "user" $user
866            lappend info "session" $session
867            SendCmd "clientinfo [list $info]"
868        }
869
870        set w [winfo width $itk_component(view)]
871        set h [winfo height $itk_component(view)]
872        EventuallyResize $w $h
873    }
874    return $result
875}
876
877#
878# isconnected --
879#
880# Indicates if we are currently connected to the visualization server.
881#
882itcl::body Rappture::VtkGlyphViewer::isconnected {} {
883    return [VisViewer::IsConnected]
884}
885
886#
887# disconnect --
888#
889itcl::body Rappture::VtkGlyphViewer::disconnect {} {
890    Disconnect
891    set _reset 1
892}
893
894#
895# Disconnect --
896#
897# Clients use this method to disconnect from the current rendering server.
898#
899itcl::body Rappture::VtkGlyphViewer::Disconnect {} {
900    VisViewer::Disconnect
901
902    $_dispatcher cancel !rebuild
903    $_dispatcher cancel !resize
904    $_dispatcher cancel !rotate
905    $_dispatcher cancel !xcutplane
906    $_dispatcher cancel !ycutplane
907    $_dispatcher cancel !zcutplane
908    $_dispatcher cancel !legend
909    # disconnected -- no more data sitting on server
910    array unset _datasets
911    array unset _colormaps
912}
913
914# ----------------------------------------------------------------------
915# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
916#
917# Invoked automatically whenever the "image" command comes in from
918# the rendering server.  Indicates that binary image data with the
919# specified <size> will follow.
920# ----------------------------------------------------------------------
921itcl::body Rappture::VtkGlyphViewer::ReceiveImage { args } {
922    array set info {
923        -token "???"
924        -bytes 0
925        -type image
926    }
927    array set info $args
928    set bytes [ReceiveBytes $info(-bytes)]
929    if { $info(-type) == "image" } {
930        if 0 {
931            set f [open "last.ppm" "w"]
932            fconfigure $f -encoding binary
933            puts -nonewline $f $bytes
934            close $f
935        }
936        $_image(plot) configure -data $bytes
937        #set time [clock seconds]
938        #set date [clock format $time]
939        #set w [image width $_image(plot)]
940        #set h [image height $_image(plot)]
941        #puts stderr "$date: received image ${w}x${h} image"
942        if { $_start > 0 } {
943            set finish [clock clicks -milliseconds]
944            #puts stderr "round trip time [expr $finish -$_start] milliseconds"
945            set _start 0
946        }
947    } elseif { $info(type) == "print" } {
948        set tag $this-print-$info(-token)
949        set _hardcopy($tag) $bytes
950    }
951}
952
953#
954# ReceiveDataset --
955#
956itcl::body Rappture::VtkGlyphViewer::ReceiveDataset { args } {
957    if { ![isconnected] } {
958        return
959    }
960    set option [lindex $args 0]
961    switch -- $option {
962        "scalar" {
963            set option [lindex $args 1]
964            switch -- $option {
965                "world" {
966                    foreach { x y z value tag } [lrange $args 2 end] break
967                }
968                "pixel" {
969                    foreach { x y value tag } [lrange $args 2 end] break
970                }
971            }
972        }
973        "vector" {
974            set option [lindex $args 1]
975            switch -- $option {
976                "world" {
977                    foreach { x y z vx vy vz tag } [lrange $args 2 end] break
978                }
979                "pixel" {
980                    foreach { x y vx vy vz tag } [lrange $args 2 end] break
981                }
982            }
983        }
984        "names" {
985            foreach { name } [lindex $args 1] {
986                #puts stderr "Dataset: $name"
987            }
988        }
989        default {
990            error "unknown dataset option \"$option\" from server"
991        }
992    }
993}
994
995# ----------------------------------------------------------------------
996# USAGE: Rebuild
997#
998# Called automatically whenever something changes that affects the
999# data in the widget.  Clears any existing data and rebuilds the
1000# widget to display new data.
1001# ----------------------------------------------------------------------
1002itcl::body Rappture::VtkGlyphViewer::Rebuild {} {
1003    set w [winfo width $itk_component(view)]
1004    set h [winfo height $itk_component(view)]
1005    if { $w < 2 || $h < 2 } {
1006        update
1007        $_dispatcher event -idle !rebuild
1008        return
1009    }
1010
1011    # Turn on buffering of commands to the server.  We don't want to
1012    # be preempted by a server disconnect/reconnect (which automatically
1013    # generates a new call to Rebuild).
1014    StartBufferingCommands
1015
1016    if { $_reset } {
1017        set _width $w
1018        set _height $h
1019        $_arcball resize $w $h
1020        DoResize
1021
1022        # Reset the camera and other view parameters
1023        $_arcball quaternion [ViewToQuaternion]
1024        InitSettings -ortho
1025        DoRotate
1026        PanCamera
1027        set _first ""
1028        InitSettings -background \
1029            -xgrid -ygrid -zgrid -axismode \
1030            -axesvisible -axislabels -axisminorticks
1031        #SendCmd "axis lformat all %g"
1032        StopBufferingCommands
1033        SendCmd "imgflush"
1034        StartBufferingCommands
1035    }
1036    set _first ""
1037    SendCmd "dataset visible 0"
1038    eval scale $_dlist
1039    foreach dataobj [get -objects] {
1040        if { [info exists _obj2ovride($dataobj-raise)] &&  $_first == "" } {
1041            set _first $dataobj
1042            SetCurrentFieldName $dataobj
1043        }
1044        foreach comp [$dataobj components] {
1045            set tag $dataobj-$comp
1046            if { ![info exists _datasets($tag)] } {
1047                set bytes [$dataobj vtkdata $comp]
1048                if 0 {
1049                    set f [open "/tmp/glyph.vtk" "w"]
1050                    fconfigure $f -translation binary -encoding binary
1051                    puts -nonewline $f $bytes
1052                    close $f
1053                }
1054                set length [string length $bytes]
1055                if { $_reportClientInfo }  {
1056                    set info {}
1057                    lappend info "tool_id"       [$dataobj hints toolid]
1058                    lappend info "tool_name"     [$dataobj hints toolname]
1059                    lappend info "tool_title"    [$dataobj hints tooltitle]
1060                    lappend info "tool_command"  [$dataobj hints toolcommand]
1061                    lappend info "tool_revision" [$dataobj hints toolrevision]
1062                    lappend info "dataset_label" [$dataobj hints label]
1063                    lappend info "dataset_size"  $length
1064                    lappend info "dataset_tag"   $tag
1065                    SendCmd "clientinfo [list $info]"
1066                }
1067                SendCmd "dataset add $tag data follows $length"
1068                SendData $bytes
1069                set _datasets($tag) 1
1070                SetObjectStyle $dataobj $comp
1071            }
1072            if { [info exists _obj2ovride($dataobj-raise)] } {
1073                SendCmd "glyphs visible 1 $tag"
1074            }
1075        }
1076    }
1077
1078    InitSettings -glyphsvisible -outline
1079        #-cutplanesvisible
1080    if { $_reset } {
1081        # These are settings that rely on a dataset being loaded.
1082        InitSettings \
1083            -field -range \
1084            -glyphedges -glyphlighting -glyphnormscale -glyphopacity \
1085            -glyphorient -glyphscale -glyphscalemode -glyphshape -glyphwireframe
1086
1087        #-xcutplaneposition -ycutplaneposition -zcutplaneposition \
1088            -xcutplanevisible -ycutplanevisible -zcutplanevisible \
1089            -cutplanepreinterp
1090
1091        Zoom reset
1092        foreach axis { x y z } {
1093            set label ""
1094            if { $_first != "" } {
1095                set label [$_first hints ${axis}label]
1096            }
1097            if { $label == "" } {
1098                set label [string toupper $axis]
1099            }
1100            # There may be a space in the axis label.
1101            SendCmd [list axis name $axis $label]
1102        }
1103        if { [array size _fields] < 2 } {
1104            catch {blt::table forget $itk_component(field) $itk_component(field_l)}
1105        }
1106        set _reset 0
1107    }
1108    #DrawLegend
1109
1110    # Actually write the commands to the server socket.  If it fails, we don't
1111    # care.  We're finished here.
1112    blt::busy hold $itk_component(hull)
1113    StopBufferingCommands;              # Turn off buffering and send commands.
1114    blt::busy release $itk_component(hull)
1115}
1116
1117# ----------------------------------------------------------------------
1118# USAGE: CurrentDatasets ?-all -visible? ?dataobjs?
1119#
1120# Returns a list of server IDs for the current datasets being displayed.  This
1121# is normally a single ID, but it might be a list of IDs if the current data
1122# object has multiple components.
1123# ----------------------------------------------------------------------
1124itcl::body Rappture::VtkGlyphViewer::CurrentDatasets {args} {
1125    set flag [lindex $args 0]
1126    switch -- $flag {
1127        "-all" {
1128            if { [llength $args] > 1 } {
1129                error "CurrentDatasets: can't specify dataobj after \"-all\""
1130            }
1131            set dlist [get -objects]
1132        }
1133        "-visible" {
1134            if { [llength $args] > 1 } {
1135                set dlist {}
1136                set args [lrange $args 1 end]
1137                foreach dataobj $args {
1138                    if { [info exists _obj2ovride($dataobj-raise)] } {
1139                        lappend dlist $dataobj
1140                    }
1141                }
1142            } else {
1143                set dlist [get -visible]
1144            }
1145        }
1146        default {
1147            set dlist $args
1148        }
1149    }
1150    set rlist ""
1151    foreach dataobj $dlist {
1152        foreach comp [$dataobj components] {
1153            set tag $dataobj-$comp
1154            if { [info exists _datasets($tag)] && $_datasets($tag) } {
1155                lappend rlist $tag
1156            }
1157        }
1158    }
1159    return $rlist
1160}
1161
1162# ----------------------------------------------------------------------
1163# USAGE: Zoom in
1164# USAGE: Zoom out
1165# USAGE: Zoom reset
1166#
1167# Called automatically when the user clicks on one of the zoom
1168# controls for this widget.  Changes the zoom for the current view.
1169# ----------------------------------------------------------------------
1170itcl::body Rappture::VtkGlyphViewer::Zoom {option} {
1171    switch -- $option {
1172        "in" {
1173            set _view(-zoom) [expr {$_view(-zoom)*1.25}]
1174            SendCmd "camera zoom $_view(-zoom)"
1175        }
1176        "out" {
1177            set _view(-zoom) [expr {$_view(-zoom)*0.8}]
1178            SendCmd "camera zoom $_view(-zoom)"
1179        }
1180        "reset" {
1181            array set _view {
1182                -qw      0.853553
1183                -qx      -0.353553
1184                -qy      0.353553
1185                -qz      0.146447
1186                -xpan    0
1187                -ypan    0
1188                -zoom    1.0
1189            }
1190            if { $_first != "" } {
1191                set location [$_first hints camera]
1192                if { $location != "" } {
1193                    array set _view $location
1194                }
1195            }
1196            $_arcball quaternion [ViewToQuaternion]
1197            DoRotate
1198            SendCmd "camera reset"
1199        }
1200    }
1201}
1202
1203itcl::body Rappture::VtkGlyphViewer::PanCamera {} {
1204    set x $_view(-xpan)
1205    set y $_view(-ypan)
1206    SendCmd "camera pan $x $y"
1207}
1208
1209# ----------------------------------------------------------------------
1210# USAGE: Rotate click <x> <y>
1211# USAGE: Rotate drag <x> <y>
1212# USAGE: Rotate release <x> <y>
1213#
1214# Called automatically when the user clicks/drags/releases in the
1215# plot area.  Moves the plot according to the user's actions.
1216# ----------------------------------------------------------------------
1217itcl::body Rappture::VtkGlyphViewer::Rotate {option x y} {
1218    switch -- $option {
1219        "click" {
1220            $itk_component(view) configure -cursor fleur
1221            set _click(x) $x
1222            set _click(y) $y
1223        }
1224        "drag" {
1225            if {[array size _click] == 0} {
1226                Rotate click $x $y
1227            } else {
1228                set w [winfo width $itk_component(view)]
1229                set h [winfo height $itk_component(view)]
1230                if {$w <= 0 || $h <= 0} {
1231                    return
1232                }
1233
1234                if {[catch {
1235                    # this fails sometimes for no apparent reason
1236                    set dx [expr {double($x-$_click(x))/$w}]
1237                    set dy [expr {double($y-$_click(y))/$h}]
1238                }]} {
1239                    return
1240                }
1241                if { $dx == 0 && $dy == 0 } {
1242                    return
1243                }
1244                set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1245                EventuallyRotate $q
1246                set _click(x) $x
1247                set _click(y) $y
1248            }
1249        }
1250        "release" {
1251            Rotate drag $x $y
1252            $itk_component(view) configure -cursor ""
1253            catch {unset _click}
1254        }
1255        default {
1256            error "bad option \"$option\": should be click, drag, release"
1257        }
1258    }
1259}
1260
1261itcl::body Rappture::VtkGlyphViewer::Pick {x y} {
1262    foreach tag [CurrentDatasets -visible] {
1263        SendCmd "dataset getscalar pixel $x $y $tag"
1264    }
1265}
1266
1267# ----------------------------------------------------------------------
1268# USAGE: $this Pan click x y
1269#        $this Pan drag x y
1270#        $this Pan release x y
1271#
1272# Called automatically when the user clicks on one of the zoom
1273# controls for this widget.  Changes the zoom for the current view.
1274# ----------------------------------------------------------------------
1275itcl::body Rappture::VtkGlyphViewer::Pan {option x y} {
1276    switch -- $option {
1277        "set" {
1278            set w [winfo width $itk_component(view)]
1279            set h [winfo height $itk_component(view)]
1280            set x [expr $x / double($w)]
1281            set y [expr $y / double($h)]
1282            set _view(-xpan) [expr $_view(-xpan) + $x]
1283            set _view(-ypan) [expr $_view(-ypan) + $y]
1284            PanCamera
1285            return
1286        }
1287        "click" {
1288            set _click(x) $x
1289            set _click(y) $y
1290            $itk_component(view) configure -cursor hand1
1291        }
1292        "drag" {
1293            if { ![info exists _click(x)] } {
1294                set _click(x) $x
1295            }
1296            if { ![info exists _click(y)] } {
1297                set _click(y) $y
1298            }
1299            set w [winfo width $itk_component(view)]
1300            set h [winfo height $itk_component(view)]
1301            set dx [expr ($_click(x) - $x)/double($w)]
1302            set dy [expr ($_click(y) - $y)/double($h)]
1303            set _click(x) $x
1304            set _click(y) $y
1305            set _view(-xpan) [expr $_view(-xpan) - $dx]
1306            set _view(-ypan) [expr $_view(-ypan) - $dy]
1307            PanCamera
1308        }
1309        "release" {
1310            Pan drag $x $y
1311            $itk_component(view) configure -cursor ""
1312        }
1313        default {
1314            error "unknown option \"$option\": should set, click, drag, or release"
1315        }
1316    }
1317}
1318
1319# ----------------------------------------------------------------------
1320# USAGE: InitSettings <what> ?<value>?
1321#
1322# Used internally to update rendering settings whenever parameters
1323# change in the popup settings panel.  Sends the new settings off
1324# to the back end.
1325# ----------------------------------------------------------------------
1326itcl::body Rappture::VtkGlyphViewer::InitSettings { args } {
1327    foreach spec $args {
1328        if { [info exists _settings($_first${spec})] } {
1329            # Reset global setting with dataobj specific setting
1330            set _settings($spec) $_settings($_first${spec})
1331        }
1332        AdjustSetting $spec
1333    }
1334}
1335
1336#
1337# AdjustSetting --
1338#
1339# Changes/updates a specific setting in the widget.  There are
1340# usually user-setable option.  Commands are sent to the render
1341# server.
1342#
1343itcl::body Rappture::VtkGlyphViewer::AdjustSetting {what {value ""}} {
1344    DebugTrace "Enter"
1345    if { ![isconnected] } {
1346        DebugTrace "Not connected"
1347        return
1348    }
1349    switch -- $what {
1350        "-axesvisible" {
1351            set bool $_settings($what)
1352            SendCmd "axis visible all $bool"
1353        }
1354        "-axislabels" {
1355            set bool $_settings($what)
1356            SendCmd "axis labels all $bool"
1357        }
1358        "-axisminorticks" {
1359            set bool $_settings($what)
1360            SendCmd "axis minticks all $bool"
1361        }
1362        "-axismode" {
1363            set mode [$itk_component(axisMode) value]
1364            set mode [$itk_component(axisMode) translate $mode]
1365            set _settings($what) $mode
1366            SendCmd "axis flymode $mode"
1367        }
1368        "-background" {
1369            set bgcolor [$itk_component(background) value]
1370            array set fgcolors {
1371                "black" "white"
1372                "white" "black"
1373                "grey"  "black"
1374            }
1375            configure -plotbackground $bgcolor \
1376                -plotforeground $fgcolors($bgcolor)
1377            $itk_component(view) delete "legend"
1378            DrawLegend
1379        }
1380        "-colormap" {
1381            set _changed($what) 1
1382            StartBufferingCommands
1383            set color [$itk_component(colormap) value]
1384            set _settings($what) $color
1385            if { $color == "none" } {
1386                if { $_settings(-colormapvisible) } {
1387                    SendCmd "glyphs colormode constant {}"
1388                    set _settings(-colormapvisible) 0
1389                }
1390            } else {
1391                if { !$_settings(-colormapvisible) } {
1392                    SendCmd "glyphs colormode $_colorMode $_curFldName"
1393                    set _settings(-colormapvisible) 1
1394                }
1395                SetCurrentColormap $color
1396            }
1397            StopBufferingCommands
1398            EventuallyRequestLegend
1399        }
1400        "-cutplaneedges" {
1401            set _changed($what) 1
1402            set bool $_settings($what)
1403            SendCmd "cutplane edges $bool"
1404        }
1405        "-cutplanelighting" {
1406            set _changed($what) 1
1407            set bool $_settings($what)
1408            SendCmd "cutplane lighting $bool"
1409        }
1410        "-cutplaneopacity" {
1411            set _changed($what) 1
1412            set _settings($what) [expr $_widget($what) * 0.01]
1413            SendCmd "cutplane opacity $_settings($what)"
1414        }
1415        "-cutplanepreinterp" {
1416            set _changed($what) 1
1417            set bool $_settings($what)
1418            SendCmd "cutplane preinterp $bool"
1419        }
1420        "-cutplanesvisible" {
1421            set _changed($what) 1
1422            set bool $_settings($what)
1423            SendCmd "cutplane visible 0"
1424            if { $bool } {
1425                foreach tag [CurrentDatasets -visible] {
1426                    SendCmd "cutplane visible $bool $tag"
1427                }
1428            }
1429            if { $bool } {
1430                Rappture::Tooltip::for $itk_component(cutplane) \
1431                    "Hide the cutplanes"
1432            } else {
1433                Rappture::Tooltip::for $itk_component(cutplane) \
1434                    "Show the cutplanes"
1435            }
1436        }
1437        "-cutplanewireframe" {
1438            set _changed($what) 1
1439            set bool $_settings($what)
1440            SendCmd "cutplane wireframe $bool"
1441        }
1442        "-field" {
1443            set label [$itk_component(field) value]
1444            set fname [$itk_component(field) translate $label]
1445            set _settings($what) $fname
1446            if { [info exists _fields($fname)] } {
1447                foreach { label units components } $_fields($fname) break
1448                if { $components > 1 } {
1449                    set _colorMode vmag
1450                } else {
1451                    set _colorMode scalar
1452                }
1453                set _curFldName $fname
1454                set _curFldLabel $label
1455                set _curFldComp $components
1456            } else {
1457                puts stderr "unknown field \"$fname\""
1458                return
1459            }
1460            if { ![info exists _limits($_curFldName)] } {
1461                SendCmd "dataset maprange all"
1462            } else {
1463                if { $_settings(-customrange) } {
1464                    set vmin [$itk_component(min) value]
1465                    set vmax [$itk_component(max) value]
1466                } else {
1467                    foreach { vmin vmax } $_limits($_curFldName) break
1468                    # set the min / max gauges with limits from the field
1469                    # the legend's min and max text will be updated
1470                    # when the legend is redrawn in DrawLegend
1471                    SetMinMaxGauges $vmin $vmax
1472                }
1473                SendCmd "dataset maprange explicit $vmin $vmax $_curFldName point_data $_curFldComp"
1474            }
1475            #SendCmd "cutplane colormode $_colorMode $_curFldName"
1476            SendCmd "glyphs colormode $_colorMode $_curFldName"
1477            DrawLegend
1478        }
1479        "-glyphedges" {
1480            set _changed($what) 1
1481            set bool $_settings($what)
1482            SendCmd "glyphs edges $bool"
1483        }
1484        "-glyphlighting" {
1485            set _changed($what) 1
1486            set bool $_settings($what)
1487            SendCmd "glyphs lighting $bool"
1488        }
1489        "-glyphnormscale" {
1490            set _changed($what) 1
1491            set bool $_settings($what)
1492            SendCmd "glyphs normscale $bool"
1493        }
1494        "-glyphopacity" {
1495            set _changed($what) 1
1496            set _settings($what) [expr $_widget($what) * 0.01]
1497            SendCmd "glyphs opacity $_settings($what)"
1498        }
1499        "-glyphorient" {
1500            set _changed($what) 1
1501            set bool $_settings($what)
1502            SendCmd "glyphs gorient $bool {}"
1503        }
1504        "-glyphscale" {
1505            set _changed($what) 1
1506            set val $_settings($what)
1507            if { [string is double $val] } {
1508                SendCmd "glyphs gscale $val"
1509            }
1510        }
1511        "-glyphscalemode" {
1512            set _changed($what) 1
1513            set label [$itk_component(scaleMode) value]
1514            set mode [$itk_component(scaleMode) translate $label]
1515            set _settings($what) $mode
1516            SendCmd "glyphs smode $mode {}"
1517        }
1518        "-glyphshape" {
1519            set _changed($what) 1
1520            set label [$itk_component(gshape) value]
1521            set shape [$itk_component(gshape) translate $label]
1522            set _settings($what) $shape
1523            SendCmd "glyphs shape $shape"
1524        }
1525        "-glyphsvisible" {
1526            set _changed($what) 1
1527            set bool $_settings($what)
1528            SendCmd "glyphs visible 0"
1529            if { $bool } {
1530                foreach tag [CurrentDatasets -visible] {
1531                    SendCmd "glyphs visible $bool $tag"
1532                }
1533                Rappture::Tooltip::for $itk_component(glyphs) \
1534                    "Hide the glyphs"
1535            } else {
1536                Rappture::Tooltip::for $itk_component(glyphs) \
1537                    "Show the glyphs"
1538            }
1539            DrawLegend
1540        }
1541        "-glyphwireframe" {
1542            set _changed($what) 1
1543            set bool $_settings($what)
1544            SendCmd "glyphs wireframe $bool"
1545        }
1546        "-legendvisible" {
1547            if { !$_settings($what) } {
1548                $itk_component(view) delete legend
1549            }
1550            DrawLegend
1551        }
1552        "-ortho" {
1553            set bool $_view($what)
1554            if { $bool } {
1555                SendCmd "camera mode ortho"
1556            } else {
1557                SendCmd "camera mode persp"
1558            }
1559        }
1560        "-outline" {
1561            set _changed($what) 1
1562            set bool $_settings($what)
1563            SendCmd "outline visible 0"
1564            if { $bool } {
1565                foreach tag [CurrentDatasets -visible] {
1566                    SendCmd "outline visible $bool $tag"
1567                }
1568            }
1569        }
1570        "-range" {
1571            if { $_settings(-customrange) } {
1572                set vmin [$itk_component(min) value]
1573                set vmax [$itk_component(max) value]
1574            } else {
1575                foreach { vmin vmax } $_limits($_curFldName) break
1576            }
1577            SendCmd "dataset maprange explicit $vmin $vmax $_curFldName point_data $_curFldComp"
1578            DrawLegend
1579        }
1580        "-xcutplanevisible" - "-ycutplanevisible" - "-zcutplanevisible" {
1581            set _changed($what) 1
1582            set axis [string tolower [string range $what 1 1]]
1583            set bool $_settings($what)
1584            if { $bool } {
1585                $itk_component(${axis}position) configure -state normal \
1586                    -troughcolor white
1587            } else {
1588                $itk_component(${axis}position) configure -state disabled \
1589                    -troughcolor grey82
1590            }
1591            SendCmd "cutplane axis $axis $bool"
1592        }
1593        "-xcutplaneposition" - "-ycutplaneposition" - "-zcutplaneposition" {
1594            set _changed($what) 1
1595            set axis [string tolower [string range $what 1 1]]
1596            set pos [expr $_settings($what) * 0.01]
1597            SendCmd "cutplane slice ${axis} ${pos}"
1598            set _cutplanePending 0
1599        }
1600        "-xgrid" - "-ygrid" - "-zgrid" {
1601            set axis [string tolower [string range $what 1 1]]
1602            set bool $_settings($what)
1603            SendCmd "axis grid $axis $bool"
1604        }
1605        default {
1606            error "don't know how to fix $what"
1607        }
1608    }
1609}
1610
1611#
1612# RequestLegend --
1613#
1614# Request a new legend from the server.  The size of the legend
1615# is determined from the height of the canvas.
1616#
1617# This should be called when
1618#   1.  A new current colormap is set.
1619#   2.  Window is resized.
1620#   3.  The limits of the data have changed.  (Just need a redraw).
1621#   4.  Legend becomes visible (Just need a redraw).
1622#
1623itcl::body Rappture::VtkGlyphViewer::RequestLegend {} {
1624    set _legendPending 0
1625    if { ![info exists _fields($_curFldName)] } {
1626        return
1627    }
1628    set fname $_curFldName
1629    set font "Arial 8"
1630    set lineht [font metrics $font -linespace]
1631    set w 12
1632    set h [expr {$_height - 2 * ($lineht + 2)}]
1633    if { $h < 1 } {
1634        return
1635    }
1636    if { [string match "component*" $fname] } {
1637        set title ""
1638    } else {
1639        if { [info exists _fields($fname)] } {
1640            foreach { title units } $_fields($fname) break
1641            if { $units != "" } {
1642                set title [format "%s (%s)" $title $units]
1643            }
1644        } else {
1645            set title $fname
1646        }
1647    }
1648    # If there's a title too, subtract one more line
1649    if { $title != "" } {
1650        incr h -$lineht
1651    }
1652    # Set the legend on the first dataset.
1653    if { $_currentColormap != "" } {
1654        set cmap $_currentColormap
1655        if { ![info exists _colormaps($cmap)] } {
1656            BuildColormap $cmap
1657            set _colormaps($cmap) 1
1658        }
1659        #SendCmd "legend $cmap $_colorMode $_curFldName {} $w $h 0"
1660        SendCmd "legend2 $cmap $w $h"
1661    }
1662}
1663
1664# ----------------------------------------------------------------------
1665# CONFIGURATION OPTION: -plotbackground
1666# ----------------------------------------------------------------------
1667itcl::configbody Rappture::VtkGlyphViewer::plotbackground {
1668    if { [isconnected] } {
1669        set rgb [Color2RGB $itk_option(-plotbackground)]
1670        SendCmd "screen bgcolor $rgb"
1671    }
1672}
1673
1674# ----------------------------------------------------------------------
1675# CONFIGURATION OPTION: -plotforeground
1676# ----------------------------------------------------------------------
1677itcl::configbody Rappture::VtkGlyphViewer::plotforeground {
1678    if { [isconnected] } {
1679        set rgb [Color2RGB $itk_option(-plotforeground)]
1680        SendCmd "axis color all $rgb"
1681        SendCmd "outline color $rgb"
1682        #SendCmd "cutplane color $rgb"
1683    }
1684}
1685
1686itcl::body Rappture::VtkGlyphViewer::BuildGlyphTab {} {
1687    set fg [option get $itk_component(hull) font Font]
1688    #set bfg [option get $itk_component(hull) boldFont Font]
1689
1690    set inner [$itk_component(main) insert end \
1691        -title "Glyph Settings" \
1692        -icon [Rappture::icon volume-on]]
1693    $inner configure -borderwidth 4
1694
1695    checkbutton $inner.glyphs \
1696        -text "Glyphs" \
1697        -variable [itcl::scope _settings(-glyphsvisible)] \
1698        -command [itcl::code $this AdjustSetting -glyphsvisible] \
1699        -font "Arial 9"
1700
1701    label $inner.gshape_l -text "Glyph shape" -font "Arial 9"
1702    itk_component add gshape {
1703        Rappture::Combobox $inner.gshape -width 10 -editable 0
1704    }
1705    $inner.gshape choices insert end \
1706        "arrow"              "arrow"           \
1707        "cone"               "cone"            \
1708        "cube"               "cube"            \
1709        "cylinder"           "cylinder"        \
1710        "dodecahedron"       "dodecahedron"    \
1711        "icosahedron"        "icosahedron"     \
1712        "line"               "line"            \
1713        "octahedron"         "octahedron"      \
1714        "point"              "point"           \
1715        "sphere"             "sphere"          \
1716        "tetrahedron"        "tetrahedron"
1717
1718    $itk_component(gshape) value $_settings(-glyphshape)
1719    bind $inner.gshape <<Value>> [itcl::code $this AdjustSetting -glyphshape]
1720
1721    label $inner.scaleMode_l -text "Scale by" -font "Arial 9"
1722    itk_component add scaleMode {
1723        Rappture::Combobox $inner.scaleMode -width 10 -editable 0
1724    }
1725    $inner.scaleMode choices insert end \
1726        "scalar" "Scalar"            \
1727        "vmag"   "Vector magnitude"  \
1728        "vcomp"  "Vector components" \
1729        "off"    "Constant size"
1730
1731    $itk_component(scaleMode) value "[$itk_component(scaleMode) label $_settings(-glyphscalemode)]"
1732    bind $inner.scaleMode <<Value>> [itcl::code $this AdjustSetting -glyphscalemode]
1733
1734    checkbutton $inner.normscale \
1735        -text "Normalize scaling" \
1736        -variable [itcl::scope _settings(-glyphnormscale)] \
1737        -command [itcl::code $this AdjustSetting -glyphnormscale] \
1738        -font "Arial 9"
1739    Rappture::Tooltip::for $inner.normscale "If enabled, field values are normalized to \[0,1\] before scaling and scale factor is relative to a default size"
1740
1741    checkbutton $inner.gorient \
1742        -text "Orient" \
1743        -variable [itcl::scope _settings(-glyphorient)] \
1744        -command [itcl::code $this AdjustSetting -glyphorient] \
1745        -font "Arial 9"
1746    Rappture::Tooltip::for $inner.gorient "Orient glyphs by vector field directions"
1747
1748    checkbutton $inner.wireframe \
1749        -text "Wireframe" \
1750        -variable [itcl::scope _settings(-glyphwireframe)] \
1751        -command [itcl::code $this AdjustSetting -glyphwireframe] \
1752        -font "Arial 9"
1753
1754    checkbutton $inner.lighting \
1755        -text "Enable Lighting" \
1756        -variable [itcl::scope _settings(-glyphlighting)] \
1757        -command [itcl::code $this AdjustSetting -glyphlighting] \
1758        -font "Arial 9"
1759
1760    checkbutton $inner.edges \
1761        -text "Edges" \
1762        -variable [itcl::scope _settings(-glyphedges)] \
1763        -command [itcl::code $this AdjustSetting -glyphedges] \
1764        -font "Arial 9"
1765
1766    checkbutton $inner.outline \
1767        -text "Outline" \
1768        -variable [itcl::scope _settings(-outline)] \
1769        -command [itcl::code $this AdjustSetting -outline] \
1770        -font "Arial 9"
1771
1772    checkbutton $inner.legend \
1773        -text "Legend" \
1774        -variable [itcl::scope _settings(-legendvisible)] \
1775        -command [itcl::code $this AdjustSetting -legendvisible] \
1776        -font "Arial 9"
1777
1778    label $inner.background_l -text "Background" -font "Arial 9"
1779    itk_component add background {
1780        Rappture::Combobox $inner.background -width 10 -editable 0
1781    }
1782    $inner.background choices insert end \
1783        "black"              "black"            \
1784        "white"              "white"            \
1785        "grey"               "grey"
1786
1787    $itk_component(background) value $_settings(-background)
1788    bind $inner.background <<Value>> \
1789        [itcl::code $this AdjustSetting -background]
1790
1791    label $inner.opacity_l -text "Opacity" -font "Arial 9"
1792    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1793        -variable [itcl::scope _widget(-glyphopacity)] \
1794        -width 10 \
1795        -showvalue off \
1796        -command [itcl::code $this AdjustSetting -glyphopacity]
1797    $inner.opacity set [expr $_settings(-glyphopacity) * 100.0]
1798
1799    label $inner.gscale_l -text "Scale factor" -font "Arial 9"
1800    if {0} {
1801    ::scale $inner.gscale -from 1 -to 100 -orient horizontal \
1802        -variable [itcl::scope _settings(-glyphscale)] \
1803        -width 10 \
1804        -showvalue off \
1805        -command [itcl::code $this AdjustSetting -glyphscale]
1806    } else {
1807    itk_component add gscale {
1808        entry $inner.gscale -font "Arial 9" -bg white \
1809            -textvariable [itcl::scope _settings(-glyphscale)]
1810    } {
1811        ignore -font -background
1812    }
1813    bind $inner.gscale <Return> \
1814        [itcl::code $this AdjustSetting -glyphscale]
1815    bind $inner.gscale <KP_Enter> \
1816        [itcl::code $this AdjustSetting -glyphscale]
1817    }
1818    Rappture::Tooltip::for $inner.gscale "Set scaling multiplier (or constant size)"
1819
1820    itk_component add field_l {
1821        label $inner.field_l -text "Color By" -font "Arial 9"
1822    } {
1823        ignore -font
1824    }
1825    itk_component add field {
1826        Rappture::Combobox $inner.field -width 10 -editable 0
1827    }
1828    bind $inner.field <<Value>> \
1829        [itcl::code $this AdjustSetting -field]
1830
1831    label $inner.colormap_l -text "Colormap" -font "Arial 9"
1832    itk_component add colormap {
1833        Rappture::Combobox $inner.colormap -width 10 -editable 0
1834    }
1835
1836    $inner.colormap choices insert end [GetColormapList -includeNone]
1837    $itk_component(colormap) value "BCGYR"
1838    bind $inner.colormap <<Value>> \
1839        [itcl::code $this AdjustSetting -colormap]
1840
1841    # add widgets for setting a custom range on the legend
1842
1843    itk_component add crange {
1844        checkbutton $inner.crange \
1845            -text "Use Custom Range:" \
1846            -variable [itcl::scope _settings(-customrange)] \
1847            -command [itcl::code $this ToggleCustomRange] \
1848            -font "Arial 9"
1849    }
1850
1851    itk_component add l_min {
1852        label $inner.l_min -text "Min" -font "Arial 9"
1853    }
1854    itk_component add min {
1855        Rappture::Gauge $inner.min -font "Arial 9" \
1856            -validatecommand [itcl::code $this LegendRangeValidate "" vmin]
1857    }
1858    bind $itk_component(min) <<Value>> \
1859        [itcl::code $this AdjustSetting -range]
1860
1861    itk_component add l_max {
1862        label $inner.l_max -text "Max" -font "Arial 9"
1863    }
1864    itk_component add max {
1865        Rappture::Gauge $inner.max -font "Arial 9" \
1866            -validatecommand [itcl::code $this LegendRangeValidate "" vmax]
1867    }
1868    bind $itk_component(max) <<Value>> \
1869        [itcl::code $this AdjustSetting -range]
1870
1871    $itk_component(min) configure -state disabled
1872    $itk_component(max) configure -state disabled
1873
1874    blt::table $inner \
1875        0,0 $inner.field_l      -anchor w -pady 2 \
1876        0,1 $inner.field        -anchor w -pady 2 -fill x \
1877        1,0 $inner.colormap_l   -anchor w -pady 2 \
1878        1,1 $inner.colormap     -anchor w -pady 2 -fill x \
1879        2,0 $inner.gshape_l     -anchor w -pady 2 \
1880        2,1 $inner.gshape       -anchor w -pady 2 -fill x \
1881        3,0 $inner.background_l -anchor w -pady 2 \
1882        3,1 $inner.background   -anchor w -pady 2 -fill x \
1883        4,0 $inner.scaleMode_l  -anchor w -pady 2 \
1884        4,1 $inner.scaleMode    -anchor w -pady 2 -fill x \
1885        5,0 $inner.gscale_l     -anchor w -pady 2 \
1886        5,1 $inner.gscale       -anchor w -pady 2 -fill x \
1887        6,0 $inner.normscale    -anchor w -pady 2 -cspan 2 \
1888        7,0 $inner.gorient      -anchor w -pady 2 -cspan 2 \
1889        8,0 $inner.wireframe    -anchor w -pady 2 -cspan 2 \
1890        9,0 $inner.lighting     -anchor w -pady 2 -cspan 2 \
1891        10,0 $inner.edges       -anchor w -pady 2 -cspan 2 \
1892        11,0 $inner.outline     -anchor w -pady 2 -cspan 2 \
1893        12,0 $inner.legend      -anchor w -pady 2 \
1894        13,0 $inner.opacity_l   -anchor w -pady 2 \
1895        13,1 $inner.opacity     -anchor w -pady 2 -fill x \
1896        14,0 $inner.crange      -anchor w -pady 2 -cspan 2 \
1897        15,0 $inner.l_min       -anchor w -pady 2 \
1898        15,1 $inner.min         -anchor w -pady 2 -fill x \
1899        16,0 $inner.l_max       -anchor w -pady 2 \
1900        16,1 $inner.max         -anchor w -pady 2 -fill x \
1901
1902    blt::table configure $inner r* c* -resize none
1903    blt::table configure $inner r17 c1 -resize expand
1904}
1905
1906itcl::body Rappture::VtkGlyphViewer::BuildAxisTab {} {
1907
1908    set fg [option get $itk_component(hull) font Font]
1909    #set bfg [option get $itk_component(hull) boldFont Font]
1910
1911    set inner [$itk_component(main) insert end \
1912        -title "Axis Settings" \
1913        -icon [Rappture::icon axis2]]
1914    $inner configure -borderwidth 4
1915
1916    checkbutton $inner.visible \
1917        -text "Axes" \
1918        -variable [itcl::scope _settings(-axesvisible)] \
1919        -command [itcl::code $this AdjustSetting -axesvisible] \
1920        -font "Arial 9"
1921
1922    checkbutton $inner.labels \
1923        -text "Axis Labels" \
1924        -variable [itcl::scope _settings(-axislabels)] \
1925        -command [itcl::code $this AdjustSetting -axislabels] \
1926        -font "Arial 9"
1927    label $inner.grid_l -text "Grid" -font "Arial 9"
1928    checkbutton $inner.xgrid \
1929        -text "X" \
1930        -variable [itcl::scope _settings(-xgrid)] \
1931        -command [itcl::code $this AdjustSetting -xgrid] \
1932        -font "Arial 9"
1933    checkbutton $inner.ygrid \
1934        -text "Y" \
1935        -variable [itcl::scope _settings(-ygrid)] \
1936        -command [itcl::code $this AdjustSetting -ygrid] \
1937        -font "Arial 9"
1938    checkbutton $inner.zgrid \
1939        -text "Z" \
1940        -variable [itcl::scope _settings(-zgrid)] \
1941        -command [itcl::code $this AdjustSetting -zgrid] \
1942        -font "Arial 9"
1943    checkbutton $inner.minorticks \
1944        -text "Minor Ticks" \
1945        -variable [itcl::scope _settings(-axisminorticks)] \
1946        -command [itcl::code $this AdjustSetting -axisminorticks] \
1947        -font "Arial 9"
1948
1949    label $inner.mode_l -text "Mode" -font "Arial 9"
1950
1951    itk_component add axisMode {
1952        Rappture::Combobox $inner.mode -width 10 -editable 0
1953    }
1954    $inner.mode choices insert end \
1955        "static_triad"    "static" \
1956        "closest_triad"   "closest" \
1957        "furthest_triad"  "farthest" \
1958        "outer_edges"     "outer"
1959    $itk_component(axisMode) value $_settings(-axismode)
1960    bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axismode]
1961
1962    blt::table $inner \
1963        0,0 $inner.visible    -anchor w -cspan 4 \
1964        1,0 $inner.labels     -anchor w -cspan 4 \
1965        2,0 $inner.minorticks -anchor w -cspan 4 \
1966        4,0 $inner.grid_l     -anchor w \
1967        4,1 $inner.xgrid      -anchor w \
1968        4,2 $inner.ygrid      -anchor w \
1969        4,3 $inner.zgrid      -anchor w \
1970        5,0 $inner.mode_l     -anchor w -padx { 2 0 } \
1971        5,1 $inner.mode       -fill x   -cspan 3
1972
1973    blt::table configure $inner r* c* -resize none
1974    blt::table configure $inner r7 c6 -resize expand
1975    blt::table configure $inner r3 -height 0.125i
1976}
1977
1978itcl::body Rappture::VtkGlyphViewer::BuildCameraTab {} {
1979    set inner [$itk_component(main) insert end \
1980        -title "Camera Settings" \
1981        -icon [Rappture::icon camera]]
1982    $inner configure -borderwidth 4
1983
1984    label $inner.view_l -text "view" -font "Arial 9"
1985    set f [frame $inner.view]
1986    foreach side { front back left right top bottom } {
1987        button $f.$side  -image [Rappture::icon view$side] \
1988            -command [itcl::code $this SetOrientation $side]
1989        Rappture::Tooltip::for $f.$side "Change the view to $side"
1990        pack $f.$side -side left
1991    }
1992
1993    blt::table $inner \
1994        0,0 $inner.view_l -anchor e -pady 2 \
1995        0,1 $inner.view -anchor w -pady 2
1996    blt::table configure $inner r0 -resize none
1997
1998    set labels { qx qy qz qw xpan ypan zoom }
1999    set row 1
2000    foreach tag $labels {
2001        label $inner.${tag}label -text $tag -font "Arial 9"
2002        entry $inner.${tag} -font "Arial 9"  -bg white \
2003            -textvariable [itcl::scope _view(-$tag)]
2004        bind $inner.${tag} <Return> \
2005            [itcl::code $this camera set -${tag}]
2006        bind $inner.${tag} <KP_Enter> \
2007            [itcl::code $this camera set -${tag}]
2008        blt::table $inner \
2009            $row,0 $inner.${tag}label -anchor e -pady 2 \
2010            $row,1 $inner.${tag} -anchor w -pady 2
2011        blt::table configure $inner r$row -resize none
2012        incr row
2013    }
2014    checkbutton $inner.ortho \
2015        -text "Orthographic Projection" \
2016        -variable [itcl::scope _view(-ortho)] \
2017        -command [itcl::code $this AdjustSetting -ortho] \
2018        -font "Arial 9"
2019    blt::table $inner \
2020            $row,0 $inner.ortho -cspan 2 -anchor w -pady 2
2021    blt::table configure $inner r$row -resize none
2022    incr row
2023
2024    blt::table configure $inner c* -resize none
2025    blt::table configure $inner c2 -resize expand
2026    blt::table configure $inner r$row -resize expand
2027}
2028
2029itcl::body Rappture::VtkGlyphViewer::BuildCutplanesTab {} {
2030
2031    set fg [option get $itk_component(hull) font Font]
2032
2033    set inner [$itk_component(main) insert end \
2034        -title "Cutplane Settings" \
2035        -icon [Rappture::icon cutbutton]]
2036
2037    $inner configure -borderwidth 4
2038
2039    checkbutton $inner.visible \
2040        -text "Cutplanes" \
2041        -variable [itcl::scope _settings(-cutplanesvisible)] \
2042        -command [itcl::code $this AdjustSetting -cutplanesvisible] \
2043        -font "Arial 9"
2044
2045    checkbutton $inner.wireframe \
2046        -text "Wireframe" \
2047        -variable [itcl::scope _settings(-cutplanewireframe)] \
2048        -command [itcl::code $this AdjustSetting -cutplanewireframe] \
2049        -font "Arial 9"
2050
2051    checkbutton $inner.lighting \
2052        -text "Enable Lighting" \
2053        -variable [itcl::scope _settings(-cutplanelighting)] \
2054        -command [itcl::code $this AdjustSetting -cutplanelighting] \
2055        -font "Arial 9"
2056
2057    checkbutton $inner.edges \
2058        -text "Edges" \
2059        -variable [itcl::scope _settings(-cutplaneedges)] \
2060        -command [itcl::code $this AdjustSetting -cutplaneedges] \
2061        -font "Arial 9"
2062
2063    checkbutton $inner.preinterp \
2064        -text "Interpolate Scalars" \
2065        -variable [itcl::scope _settings(-cutplanepreinterp)] \
2066        -command [itcl::code $this AdjustSetting -cutplanepreinterp] \
2067        -font "Arial 9"
2068
2069    label $inner.opacity_l -text "Opacity" -font "Arial 9"
2070    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
2071        -variable [itcl::scope _widget(-cutplaneopacity)] \
2072        -width 10 \
2073        -showvalue off \
2074        -command [itcl::code $this AdjustSetting -cutplaneopacity]
2075    $inner.opacity set [expr $_settings(-cutplaneopacity) * 100.0]
2076
2077    # X-value slicer...
2078    itk_component add xbutton {
2079        Rappture::PushButton $inner.xbutton \
2080            -onimage [Rappture::icon x-cutplane-red] \
2081            -offimage [Rappture::icon x-cutplane-red] \
2082            -command [itcl::code $this AdjustSetting -xcutplanevisible] \
2083            -variable [itcl::scope _settings(-xcutplanevisible)] \
2084    }
2085    Rappture::Tooltip::for $itk_component(xbutton) \
2086        "Toggle the X-axis cutplane on/off"
2087    $itk_component(xbutton) select
2088    itk_component add xposition {
2089        ::scale $inner.xval -from 100 -to 0 \
2090            -width 10 -orient vertical -showvalue 1 \
2091            -borderwidth 1 -highlightthickness 0 \
2092            -command [itcl::code $this EventuallySetCutplane x] \
2093            -variable [itcl::scope _settings(-xcutplaneposition)] \
2094            -foreground red2 -font "Arial 9 bold"
2095    } {
2096        usual
2097        ignore -borderwidth -highlightthickness -foreground -font -background
2098    }
2099    # Set the default cutplane value before disabling the scale.
2100    $itk_component(xposition) set 50
2101    $itk_component(xposition) configure -state disabled
2102    Rappture::Tooltip::for $itk_component(xposition) \
2103        "@[itcl::code $this Slice tooltip x]"
2104
2105    # Y-value slicer...
2106    itk_component add ybutton {
2107        Rappture::PushButton $inner.ybutton \
2108            -onimage [Rappture::icon y-cutplane-green] \
2109            -offimage [Rappture::icon y-cutplane-green] \
2110            -command [itcl::code $this AdjustSetting -ycutplanevisible] \
2111            -variable [itcl::scope _settings(-ycutplanevisible)] \
2112    }
2113    Rappture::Tooltip::for $itk_component(ybutton) \
2114        "Toggle the Y-axis cutplane on/off"
2115    $itk_component(ybutton) select
2116
2117    itk_component add yposition {
2118        ::scale $inner.yval -from 100 -to 0 \
2119            -width 10 -orient vertical -showvalue 1 \
2120            -borderwidth 1 -highlightthickness 0 \
2121            -command [itcl::code $this EventuallySetCutplane y] \
2122            -variable [itcl::scope _settings(-ycutplaneposition)] \
2123            -foreground green3 -font "Arial 9 bold"
2124    } {
2125        usual
2126        ignore -borderwidth -highlightthickness -foreground -font
2127    }
2128    Rappture::Tooltip::for $itk_component(yposition) \
2129        "@[itcl::code $this Slice tooltip y]"
2130    # Set the default cutplane value before disabling the scale.
2131    $itk_component(yposition) set 50
2132    $itk_component(yposition) configure -state disabled
2133
2134    # Z-value slicer...
2135    itk_component add zbutton {
2136        Rappture::PushButton $inner.zbutton \
2137            -onimage [Rappture::icon z-cutplane-blue] \
2138            -offimage [Rappture::icon z-cutplane-blue] \
2139            -command [itcl::code $this AdjustSetting -zcutplanevisible] \
2140            -variable [itcl::scope _settings(-zcutplanevisible)] \
2141    } {
2142        usual
2143        ignore -foreground
2144    }
2145    Rappture::Tooltip::for $itk_component(zbutton) \
2146        "Toggle the Z-axis cutplane on/off"
2147    $itk_component(zbutton) select
2148
2149    itk_component add zposition {
2150        ::scale $inner.zval -from 100 -to 0 \
2151            -width 10 -orient vertical -showvalue 1 \
2152            -borderwidth 1 -highlightthickness 0 \
2153            -command [itcl::code $this EventuallySetCutplane z] \
2154            -variable [itcl::scope _settings(-zcutplaneposition)] \
2155            -foreground blue3 -font "Arial 9 bold"
2156    } {
2157        usual
2158        ignore -borderwidth -highlightthickness -foreground -font
2159    }
2160    $itk_component(zposition) set 50
2161    $itk_component(zposition) configure -state disabled
2162    Rappture::Tooltip::for $itk_component(zposition) \
2163        "@[itcl::code $this Slice tooltip z]"
2164
2165    blt::table $inner \
2166        0,0 $inner.visible   -anchor w -pady 2 -cspan 3 \
2167        1,0 $inner.lighting  -anchor w -pady 2 -cspan 3 \
2168        2,0 $inner.wireframe -anchor w -pady 2 -cspan 3 \
2169        3,0 $inner.edges     -anchor w -pady 2 -cspan 3 \
2170        4,0 $inner.preinterp -anchor w -pady 2 -cspan 3 \
2171        5,0 $inner.opacity_l -anchor w -pady 2 -cspan 1 \
2172        5,1 $inner.opacity   -fill x   -pady 2 -cspan 3 \
2173        6,0 $inner.xbutton   -anchor w -padx 2 -pady 2 \
2174        7,0 $inner.ybutton   -anchor w -padx 2 -pady 2 \
2175        8,0 $inner.zbutton   -anchor w -padx 2 -pady 2 \
2176        6,1 $inner.xval      -fill y -rspan 4 \
2177        6,2 $inner.yval      -fill y -rspan 4 \
2178        6,3 $inner.zval      -fill y -rspan 4 \
2179
2180    blt::table configure $inner r* c* -resize none
2181    blt::table configure $inner r9 c4 -resize expand
2182}
2183
2184#
2185# camera --
2186#
2187itcl::body Rappture::VtkGlyphViewer::camera {option args} {
2188    switch -- $option {
2189        "show" {
2190            puts [array get _view]
2191        }
2192        "set" {
2193            set what [lindex $args 0]
2194            set x $_view($what)
2195            set code [catch { string is double $x } result]
2196            if { $code != 0 || !$result } {
2197                return
2198            }
2199            switch -- $what {
2200                "-ortho" {
2201                    if {$_view($what)} {
2202                        SendCmd "camera mode ortho"
2203                    } else {
2204                        SendCmd "camera mode persp"
2205                    }
2206                }
2207                "-xpan" - "-ypan" {
2208                    PanCamera
2209                }
2210                "-qx" - "-qy" - "-qz" - "-qw" {
2211                    set q [ViewToQuaternion]
2212                    $_arcball quaternion $q
2213                    EventuallyRotate $q
2214                }
2215                "-zoom" {
2216                    SendCmd "camera zoom $_view($what)"
2217                }
2218             }
2219        }
2220    }
2221}
2222
2223itcl::body Rappture::VtkGlyphViewer::GetVtkData { args } {
2224    set bytes ""
2225    foreach dataobj [get] {
2226        foreach cname [$dataobj components] {
2227            set tag $dataobj-$cname
2228            set contents [$dataobj vtkdata $cname]
2229            append bytes "$contents\n"
2230        }
2231    }
2232    return [list .vtk $bytes]
2233}
2234
2235itcl::body Rappture::VtkGlyphViewer::GetImage { args } {
2236    if { [image width $_image(download)] > 0 &&
2237         [image height $_image(download)] > 0 } {
2238        set bytes [$_image(download) data -format "jpeg -quality 100"]
2239        set bytes [Rappture::encoding::decode -as b64 $bytes]
2240        return [list .jpg $bytes]
2241    }
2242    return ""
2243}
2244
2245itcl::body Rappture::VtkGlyphViewer::BuildDownloadPopup { popup command } {
2246    Rappture::Balloon $popup \
2247        -title "[Rappture::filexfer::label downloadWord] as..."
2248    set inner [$popup component inner]
2249    label $inner.summary -text "" -anchor w
2250    radiobutton $inner.vtk_button -text "VTK data file" \
2251        -variable [itcl::scope _downloadPopup(format)] \
2252        -font "Arial 9 " \
2253        -value vtk
2254    Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
2255    radiobutton $inner.image_button -text "Image File" \
2256        -variable [itcl::scope _downloadPopup(format)] \
2257        -font "Arial 9 " \
2258        -value image
2259    Rappture::Tooltip::for $inner.image_button \
2260        "Save as digital image."
2261
2262    button $inner.ok -text "Save" \
2263        -highlightthickness 0 -pady 2 -padx 3 \
2264        -command $command \
2265        -compound left \
2266        -image [Rappture::icon download]
2267
2268    button $inner.cancel -text "Cancel" \
2269        -highlightthickness 0 -pady 2 -padx 3 \
2270        -command [list $popup deactivate] \
2271        -compound left \
2272        -image [Rappture::icon cancel]
2273
2274    blt::table $inner \
2275        0,0 $inner.summary -cspan 2  \
2276        1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
2277        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
2278        4,1 $inner.cancel -width .9i -fill y \
2279        4,0 $inner.ok -padx 2 -width .9i -fill y
2280    blt::table configure $inner r3 -height 4
2281    blt::table configure $inner r4 -pady 4
2282    raise $inner.image_button
2283    $inner.vtk_button invoke
2284    return $inner
2285}
2286
2287itcl::body Rappture::VtkGlyphViewer::SetObjectStyle { dataobj comp } {
2288    DebugTrace "Enter"
2289    # Parse style string.
2290    set tag $dataobj-$comp
2291    array set style {
2292        -color                  BCGYR
2293        -constcolor             white
2294        -colormode              vmag
2295        -cutplaneedges          0
2296        -cutplanelighting       1
2297        -cutplaneopacity        1.0
2298        -cutplanepreinterp      1
2299        -cutplanesvisible       0
2300        -cutplanewireframe      0
2301        -edgecolor              black
2302        -edges                  0
2303        -glyphsvisible          1
2304        -gscale                 1
2305        -lighting               1
2306        -linewidth              1.0
2307        -normscale              1
2308        -opacity                1.0
2309        -orientglyphs           1
2310        -outline                0
2311        -ptsize                 1.0
2312        -quality                1
2313        -scalemode              vmag
2314        -shape                  arrow
2315        -wireframe              0
2316        -xcutplaneposition      50
2317        -xcutplanevisible       1
2318        -ycutplaneposition      50
2319        -ycutplanevisible       1
2320        -zcutplaneposition      50
2321        -zcutplanevisible       1
2322    }
2323    set style(-constcolor) $itk_option(-plotforeground)
2324    set numComponents [$dataobj numComponents $comp]
2325    if {$numComponents == 3} {
2326        set style(-shape) "arrow"
2327        set style(-orientglyphs) 1
2328        set style(-scalemode) "vmag"
2329        set style(-colormode) "vmag"
2330    } else {
2331        set style(-shape) "sphere"
2332        set style(-orientglyphs) 0
2333        set style(-scalemode) "scalar"
2334        set style(-colormode) "scalar"
2335    }
2336    array set style [$dataobj style $comp]
2337    # Backwards compat with camel case style option
2338    if { [info exists style(-orientGlyphs)] } {
2339        set style(-orientglyphs) $style(-orientGlyphs)
2340        array unset style -orientGlyphs
2341    }
2342    # Backwards compat with camel case style option
2343    if { [info exists style(-scaleMode)] } {
2344        set style(-scalemode) $style(-scaleMode)
2345        array unset style -scaleMode
2346    }
2347
2348    # This is too complicated.  We want to set the colormap and opacity
2349    # for the dataset.  They can be the default values,
2350    # the style hints loaded with the dataset, or set by user controls.  As
2351    # datasets get loaded, they first use the defaults that are overidden
2352    # by the style hints.  If the user changes the global controls, then that
2353    # overrides everything else.  I don't know what it means when global
2354    # controls are specified as style hints by each dataset.  It complicates
2355    # the code to handle aberrant cases.
2356
2357    if { $_changed(-glyphedges) } {
2358        set style(-edges) $_settings(-glyphedges)
2359    }
2360    if { $_changed(-glyphlighting) } {
2361        set style(-lighting) $_settings(-glyphlighting)
2362    }
2363    if { $_changed(-glyphnormscale) } {
2364        set style(-normscale) $_settings(-glyphnormscale)
2365    }
2366    if { $_changed(-glyphopacity) } {
2367        set style(-opacity) $_settings(-glyphopacity)
2368    }
2369    if { $_changed(-glyphorient) } {
2370        set style(-orientglyphs) $_settings(-glyphorient)
2371    }
2372    if { $_changed(-glyphscale) } {
2373        set style(-gscale) $_settings(-glyphscale)
2374    }
2375    if { $_changed(-glyphwireframe) } {
2376        set style(-wireframe) $_settings(-glyphwireframe)
2377    }
2378    if { $_changed(-colormap) } {
2379        set style(-color) $_settings(-colormap)
2380    }
2381    if { $_currentColormap == "" } {
2382        $itk_component(colormap) value $style(-color)
2383    }
2384    foreach setting {-outline -glyphsvisible -cutplanesvisible \
2385                     -xcutplanevisible -ycutplanevisible -zcutplanevisible \
2386                     -xcutplaneposition -ycutplaneposition -zcutplaneposition \
2387                     -cutplaneedges -cutplanelighting -cutplaneopacity \
2388                     -cutplanepreinterp -cutplanewireframe} {
2389        if {$_changed($setting)} {
2390            # User-modified UI setting overrides style
2391            set style($setting) $_settings($setting)
2392        } else {
2393            # Set UI control to style setting (tool provided or default)
2394            set _settings($setting) $style($setting)
2395        }
2396    }
2397
2398    if 0 {
2399    SendCmd "cutplane add $tag"
2400    SendCmd "cutplane visible 0 $tag"
2401    foreach axis {x y z} {
2402        set pos [expr $style(-${axis}cutplaneposition) * 0.01]
2403        set visible $style(-${axis}cutplanevisible)
2404        SendCmd "cutplane slice $axis $pos $tag"
2405        SendCmd "cutplane axis $axis $visible $tag"
2406    }
2407    SendCmd "cutplane edges $style(-cutplaneedges) $tag"
2408    SendCmd "cutplane lighting $style(-cutplanelighting) $tag"
2409    SendCmd "cutplane opacity $style(-cutplaneopacity) $tag"
2410    set _widget(-cutplaneopacity) [expr $style(-cutplaneopacity) * 100]
2411    SendCmd "cutplane preinterp $style(-cutplanepreinterp) $tag"
2412    SendCmd "cutplane wireframe $style(-cutplanewireframe) $tag"
2413    SendCmd "cutplane visible $style(-cutplanesvisible) $tag"
2414    }
2415
2416    SendCmd "outline add $tag"
2417    SendCmd "outline color [Color2RGB $style(-constcolor)] $tag"
2418    SendCmd "outline visible $style(-outline) $tag"
2419
2420    SendCmd "glyphs add $style(-shape) $tag"
2421    set _settings(-glyphshape) $style(-shape)
2422    $itk_component(gshape) value $style(-shape)
2423    SendCmd "glyphs visible $style(-glyphsvisible) $tag"
2424    SendCmd "glyphs edges $style(-edges) $tag"
2425    set _settings(-glyphedges) $style(-edges)
2426
2427    # normscale=1 and gscale=1 are defaults
2428    if {$style(-normscale) != 1} {
2429        SendCmd "glyphs normscale $style(-normscale) $tag"
2430    }
2431    if {$style(-gscale) != 1} {
2432        SendCmd "glyphs gscale $style(-gscale) $tag"
2433    }
2434    set _settings(-glyphnormscale) $style(-normscale)
2435    set _settings(-glyphscale) $style(-gscale)
2436
2437    if {$style(-colormode) == "constant" || $style(-color) == "none"} {
2438        SendCmd "glyphs colormode constant {} $tag"
2439        set _settings(-colormapvisible) 0
2440        set _settings(-colormap) "none"
2441    } else {
2442        SendCmd "glyphs colormode $style(-colormode) $_curFldName $tag"
2443        set _settings(-colormapvisible) 1
2444        set _settings(-colormap) $style(-color)
2445        SetCurrentColormap $style(-color)
2446    }
2447    $itk_component(colormap) value $_settings(-colormap)
2448    set _colorMode $style(-colormode)
2449
2450    # constant color only used if colormode set to constant
2451    SendCmd "glyphs color [Color2RGB $style(-constcolor)] $tag"
2452    # Omitting field name for gorient and smode commands
2453    # defaults to active scalars or vectors depending on mode
2454    SendCmd "glyphs gorient $style(-orientglyphs) {} $tag"
2455    set _settings(-glyphorient) $style(-orientglyphs)
2456    SendCmd "glyphs smode $style(-scalemode) {} $tag"
2457    set _settings(-glyphscalemode) $style(-scalemode)
2458    $itk_component(scaleMode) value "[$itk_component(scaleMode) label $style(-scalemode)]"
2459    SendCmd "glyphs quality $style(-quality) $tag"
2460    SendCmd "glyphs lighting $style(-lighting) $tag"
2461    set _settings(-glyphlighting) $style(-lighting)
2462    SendCmd "glyphs linecolor [Color2RGB $style(-edgecolor)] $tag"
2463    SendCmd "glyphs linewidth $style(-linewidth) $tag"
2464    SendCmd "glyphs ptsize $style(-ptsize) $tag"
2465    SendCmd "glyphs opacity $style(-opacity) $tag"
2466    set _settings(-glyphopacity) $style(-opacity)
2467    set _widget(-glyphopacity) [expr $style(-opacity) * 100.0]
2468    SendCmd "glyphs wireframe $style(-wireframe) $tag"
2469    set _settings(-glyphwireframe) $style(-wireframe)
2470}
2471
2472itcl::body Rappture::VtkGlyphViewer::IsValidObject { dataobj } {
2473    if {[catch {$dataobj isa Rappture::Field} valid] != 0 || !$valid} {
2474        return 0
2475    }
2476    return 1
2477}
2478
2479#
2480# EnterLegend --
2481#
2482itcl::body Rappture::VtkGlyphViewer::EnterLegend { x y } {
2483    SetLegendTip $x $y
2484}
2485
2486#
2487# MotionLegend --
2488#
2489itcl::body Rappture::VtkGlyphViewer::MotionLegend { x y } {
2490    Rappture::Tooltip::tooltip cancel
2491    set c $itk_component(view)
2492    set cw [winfo width $c]
2493    set ch [winfo height $c]
2494    if { $x >= 0 && $x < $cw && $y >= 0 && $y < $ch } {
2495        SetLegendTip $x $y
2496    }
2497}
2498
2499#
2500# LeaveLegend --
2501#
2502itcl::body Rappture::VtkGlyphViewer::LeaveLegend { } {
2503    Rappture::Tooltip::tooltip cancel
2504    .rappturetooltip configure -icon ""
2505}
2506
2507# ----------------------------------------------------------------------
2508# USAGE: LegendPointToValue <x> <y>
2509#
2510# Convert an x,y point on the legend to a numeric field value.
2511# ----------------------------------------------------------------------
2512itcl::body Rappture::VtkGlyphViewer::LegendPointToValue { x y } {
2513    set fname $_curFldName
2514
2515    set font "Arial 8"
2516    set lineht [font metrics $font -linespace]
2517
2518    set ih [image height $_image(legend)]
2519    set iy [expr $y - ($lineht + 2)]
2520
2521    # Compute the value of the point
2522    if { [info exists _limits($fname)] } {
2523        if { $_settings(-customrange) } {
2524            set vmin [$itk_component(min) value]
2525            set vmax [$itk_component(max) value]
2526        } else {
2527            foreach { vmin vmax } $_limits($fname) break
2528        }
2529        set t [expr 1.0 - (double($iy) / double($ih-1))]
2530        set value [expr $t * ($vmax - $vmin) + $vmin]
2531    } else {
2532        set value 0.0
2533    }
2534    return $value
2535}
2536
2537#
2538# SetLegendTip --
2539#
2540itcl::body Rappture::VtkGlyphViewer::SetLegendTip { x y } {
2541    set fname $_curFldName
2542    set c $itk_component(view)
2543    set w [winfo width $c]
2544    set h [winfo height $c]
2545
2546    set font "Arial 8"
2547    set lineht [font metrics $font -linespace]
2548
2549    set ih [image height $_image(legend)]
2550    set iy [expr $y - ($lineht + 2)]
2551
2552    if { [string match "component*" $fname] } {
2553        set title ""
2554    } else {
2555        if { [info exists _fields($fname)] } {
2556            foreach { title units } $_fields($fname) break
2557            if { $units != "" } {
2558                set title [format "%s (%s)" $title $units]
2559            }
2560        } else {
2561            set title $fname
2562        }
2563    }
2564    # If there's a legend title, increase the offset by the line height.
2565    if { $title != "" } {
2566        incr iy -$lineht
2567    }
2568    # Make a swatch of the selected color
2569    if { [catch { $_image(legend) get 10 $iy } pixel] != 0 } {
2570        return
2571    }
2572    if { ![info exists _image(swatch)] } {
2573        set _image(swatch) [image create photo -width 24 -height 24]
2574    }
2575    set color [eval format "\#%02x%02x%02x" $pixel]
2576    $_image(swatch) put black  -to 0 0 23 23
2577    $_image(swatch) put $color -to 1 1 22 22
2578    .rappturetooltip configure -icon $_image(swatch)
2579
2580    # Compute the value of the point
2581    set value [LegendPointToValue $x $y]
2582
2583    # Setup the location of the tooltip
2584    set tx [expr $x + 15]
2585    set ty [expr $y - 5]
2586
2587    # Setup the text for the tooltip
2588    Rappture::Tooltip::text $c [format "$title %g" $value]
2589
2590    # Show the tooltip
2591    Rappture::Tooltip::tooltip show $c +$tx,+$ty
2592}
2593
2594# ----------------------------------------------------------------------
2595# USAGE: Slice move x|y|z <newval>
2596#
2597# Called automatically when the user drags the slider to move the
2598# cut plane that slices 3D data.  Gets the current value from the
2599# slider and moves the cut plane to the appropriate point in the
2600# data set.
2601# ----------------------------------------------------------------------
2602itcl::body Rappture::VtkGlyphViewer::Slice {option args} {
2603    switch -- $option {
2604        "move" {
2605            set axis [lindex $args 0]
2606            set newval [lindex $args 1]
2607            if {[llength $args] != 2} {
2608                error "wrong # args: should be \"Slice move x|y|z newval\""
2609            }
2610            set newpos [expr {0.01*$newval}]
2611            SendCmd "cutplane slice $axis $newpos"
2612        }
2613        "tooltip" {
2614            set axis [lindex $args 0]
2615            set val [$itk_component(${axis}position) get]
2616            return "Move the [string toupper $axis] cut plane.\nCurrently:  $axis = $val%"
2617        }
2618        default {
2619            error "bad option \"$option\": should be axis, move, or tooltip"
2620        }
2621    }
2622}
2623
2624#
2625# ReceiveLegend --
2626#
2627# Invoked automatically whenever the "legend" command comes in from
2628# the rendering server.  Indicates that binary image data with the
2629# specified <size> will follow.
2630#
2631itcl::body Rappture::VtkGlyphViewer::ReceiveLegend { colormap title min max size } {
2632    DebugTrace "Enter"
2633    set _title $title
2634    regsub {\(mag\)} $title "" _title
2635    if { [IsConnected] } {
2636        set bytes [ReceiveBytes $size]
2637        if { ![info exists _image(legend)] } {
2638            set _image(legend) [image create photo]
2639        }
2640        $_image(legend) configure -data $bytes
2641        #puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
2642        if { [catch {DrawLegend} errs] != 0 } {
2643            global errorInfo
2644            puts stderr "errs=$errs errorInfo=$errorInfo"
2645        }
2646    }
2647}
2648
2649#
2650# DrawLegend --
2651#
2652# Draws the legend on the canvas on the right side of the plot area.
2653#
2654itcl::body Rappture::VtkGlyphViewer::DrawLegend {} {
2655    set fname $_curFldName
2656    set c $itk_component(view)
2657    set w [winfo width $c]
2658    set h [winfo height $c]
2659    set font "Arial 8"
2660    set lineht [font metrics $font -linespace]
2661
2662    if { [string match "component*" $fname] } {
2663        set title ""
2664    } else {
2665        if { [info exists _fields($fname)] } {
2666            foreach { title units } $_fields($fname) break
2667            if { $units != "" } {
2668                set title [format "%s (%s)" $title $units]
2669            }
2670        } else {
2671            set title $fname
2672        }
2673    }
2674    set x [expr $w - 2]
2675    if { !$_settings(-legendvisible) } {
2676        $c delete legend
2677        return
2678    }
2679    if { [$c find withtag "legend"] == "" } {
2680        set y 2
2681        # If there's a legend title, create a text item for the title.
2682        $c create text $x $y \
2683            -anchor ne \
2684            -fill $itk_option(-plotforeground) -tags "title legend" \
2685            -font $font
2686        if { $title != "" } {
2687            incr y $lineht
2688        }
2689        $c create text $x $y \
2690            -anchor ne \
2691            -fill $itk_option(-plotforeground) -tags "vmax legend" \
2692            -font $font
2693        incr y $lineht
2694        $c create image $x $y \
2695            -anchor ne \
2696            -image $_image(legend) -tags "colormap legend"
2697        $c create rectangle $x $y 1 1 \
2698            -fill "" -outline "" -tags "sensor legend"
2699        $c create text $x [expr {$h-2}] \
2700            -anchor se \
2701            -fill $itk_option(-plotforeground) -tags "vmin legend" \
2702            -font $font
2703        $c bind sensor <Enter> [itcl::code $this EnterLegend %x %y]
2704        $c bind sensor <Leave> [itcl::code $this LeaveLegend]
2705        $c bind sensor <Motion> [itcl::code $this MotionLegend %x %y]
2706    }
2707    set x2 $x
2708    set iw [image width $_image(legend)]
2709    set ih [image height $_image(legend)]
2710    set x1 [expr $x2 - ($iw*12)/10]
2711
2712    $c bind title <ButtonPress> [itcl::code $this LegendTitleAction post]
2713    $c bind title <Enter> [itcl::code $this LegendTitleAction enter]
2714    $c bind title <Leave> [itcl::code $this LegendTitleAction leave]
2715    # Reset the item coordinates according the current size of the plot.
2716    $c itemconfigure title -text $title
2717    if { [info exists _limits($_curFldName)] } {
2718        if { $_settings(-customrange) } {
2719            set vmin [$itk_component(min) value]
2720            set vmax [$itk_component(max) value]
2721        } else {
2722            foreach { vmin vmax } $_limits($_curFldName) break
2723        }
2724        $c itemconfigure vmin -text [format %g $vmin]
2725        $c itemconfigure vmax -text [format %g $vmax]
2726    }
2727    set y 2
2728    # If there's a legend title, move the title to the correct position
2729    if { $title != "" } {
2730        $c itemconfigure title -text $title
2731        $c coords title $x $y
2732        incr y $lineht
2733        $c raise title
2734    }
2735    $c coords vmax $x $y
2736    incr y $lineht
2737    $c coords colormap $x $y
2738    $c coords sensor [expr $x - $iw] $y $x [expr $y + $ih]
2739    $c raise sensor
2740    $c coords vmin $x [expr {$h - 2}]
2741
2742    $c bind vmin <ButtonPress> [itcl::code $this LegendRangeAction popup vmin]
2743    $c bind vmin <Enter> [itcl::code $this LegendRangeAction enter vmin]
2744    $c bind vmin <Leave> [itcl::code $this LegendRangeAction leave vmin]
2745
2746    $c bind vmax <ButtonPress> [itcl::code $this LegendRangeAction popup vmax]
2747    $c bind vmax <Enter> [itcl::code $this LegendRangeAction enter vmax]
2748    $c bind vmax <Leave> [itcl::code $this LegendRangeAction leave vmax]
2749}
2750
2751# ----------------------------------------------------------------------
2752# USAGE: LegendTitleAction post
2753# USAGE: LegendTitleAction enter
2754# USAGE: LegendTitleAction leave
2755# USAGE: LegendTitleAction save
2756#
2757# Used internally to handle the dropdown list for the fields menu combobox.
2758# The post option is invoked when the field title is pressed to launch the
2759# dropdown.  The enter option is invoked when the user mouses over the field
2760# title. The leave option is invoked when the user moves the mouse away
2761# from the field title.  The save option is invoked whenever there is a
2762# selection from the list, to alert the visualization server.
2763# ----------------------------------------------------------------------
2764itcl::body Rappture::VtkGlyphViewer::LegendTitleAction {option} {
2765    set c $itk_component(view)
2766    switch -- $option {
2767        post {
2768            foreach { x1 y1 x2 y2 } [$c bbox title] break
2769            set cw [winfo width $itk_component(view)]
2770            set mw [winfo reqwidth $itk_component(fieldmenu)]
2771            set x1 [expr $cw - $mw]
2772            set x [expr $x1 + [winfo rootx $itk_component(view)]]
2773            set y [expr $y2 + [winfo rooty $itk_component(view)]]
2774            tk_popup $itk_component(fieldmenu) $x $y
2775        }
2776        enter {
2777            $c itemconfigure title -fill red
2778        }
2779        leave {
2780            $c itemconfigure title -fill $itk_option(-plotforeground)
2781        }
2782        save {
2783            $itk_component(field) value $_curFldLabel
2784            AdjustSetting -field
2785        }
2786        default {
2787            error "bad option \"$option\": should be post, enter, leave or save"
2788        }
2789    }
2790}
2791
2792# ----------------------------------------------------------------------
2793# USAGE: LegendRangeValidate <widget> <which> <value>
2794#
2795# Used internally to validate a legend range min/max value.
2796# Returns a boolean value telling if <value> was accepted (1) or rejected (0)
2797# If the value is rejected, a tooltip/warning message is popped up
2798# near the widget that asked for the validation, specified by <widget>
2799#
2800# <widget> is the widget where a tooltip/warning message should show up on
2801# <which> is either "vmin" or "vmax".
2802# <value> is the value to be validated.
2803# ----------------------------------------------------------------------
2804itcl::body Rappture::VtkGlyphViewer::LegendRangeValidate {widget which value} {
2805    #check for a valid value
2806    if {[string is double $value] != 1} {
2807        set msg "should be valid number"
2808        if {$widget != ""} {
2809            Rappture::Tooltip::cue $widget $msg
2810        } else {
2811            # error "bad value \"$value\": $msg"
2812            error $msg
2813        }
2814        return 0
2815    }
2816
2817    switch -- $which {
2818        vmin {
2819            # check for min > max
2820            if {$value > [$itk_component(max) value]} {
2821                set msg "min > max, change max first"
2822                if {$widget != ""} {
2823                    Rappture::Tooltip::cue $widget $msg
2824                } else {
2825                    # error "bad value \"$value\": $msg"
2826                    error $msg
2827                }
2828                return 0
2829            }
2830        }
2831        vmax {
2832            # check for max < min
2833            if {$value < [$itk_component(min) value]} {
2834                set msg "max < min, change min first"
2835                if {$widget != ""} {
2836                    Rappture::Tooltip::cue $widget $msg
2837                } else {
2838                    # error "bad value \"$value\": $msg"
2839                    error $msg
2840                }
2841                return 0
2842            }
2843        }
2844        default {
2845            error "bad option \"$which\": should be vmin, vmax"
2846        }
2847    }
2848}
2849
2850itcl::body Rappture::VtkGlyphViewer::MouseOver2Which {} {
2851    switch -- $_mouseOver {
2852        vmin {
2853            set which min
2854        }
2855        vmax {
2856            set which max
2857        }
2858        default {
2859            error "bad _mouseOver \"$_mouseOver\": should be vmin, vmax"
2860        }
2861    }
2862    return $which
2863}
2864
2865# ----------------------------------------------------------------------
2866# USAGE: LegendRangeAction enter <which>
2867# USAGE: LegendRangeAction leave <which>
2868#
2869# USAGE: LegendRangeAction popup <which>
2870# USAGE: LegendRangeAction activate
2871# USAGE: LegendRangeAction validate <value>
2872# USAGE: LegendRangeAction apply <value>
2873#
2874# Used internally to handle the mouseover and popup entry for the field range
2875# inputs.  The enter option is invoked when the user moves the mouse over the
2876# min or max field range. The leave option is invoked when the user moves the
2877# mouse away from the min or max field range. The popup option is invoked when
2878# the user click's on a field range. The popup option stores internally which
2879# widget is requesting a popup ( in the _mouseOver variable) and calls the
2880# activate command of the widget. The widget's activate command calls back to
2881# this method to get the xywh dimensions of the popup editor. After the user
2882# changes focus or sets the value in the editor, the editor calls this methods
2883# validate and apply options to set the value.
2884# ----------------------------------------------------------------------
2885itcl::body Rappture::VtkGlyphViewer::LegendRangeAction {option args} {
2886    set c $itk_component(view)
2887
2888    switch -- $option {
2889        enter {
2890            set which [lindex $args 0]
2891            $c itemconfigure $which -fill red
2892        }
2893        leave {
2894            set which [lindex $args 0]
2895            $c itemconfigure $which -fill $itk_option(-plotforeground)
2896        }
2897        popup {
2898            DisableMouseRotationBindings
2899            set which [lindex $args 0]
2900            set _mouseOver $which
2901            $itk_component(editor) activate
2902        }
2903        activate {
2904            foreach { x1 y1 x2 y2 } [$c bbox $_mouseOver] break
2905            set which [MouseOver2Which]
2906            set info(text) [$itk_component($which) value]
2907            set info(x) [expr $x1 + [winfo rootx $c]]
2908            set info(y) [expr $y1 + [winfo rooty $c]]
2909            set info(w) [expr $x2 - $x1]
2910            set info(h) [expr $y2 - $y1]
2911            return [array get info]
2912        }
2913        validate {
2914            if {[llength $args] != 1} {
2915                error "wrong # args: should be \"editor validate value\""
2916            }
2917
2918            set value [lindex $args 0]
2919            if {[LegendRangeValidate $itk_component(editor) $_mouseOver $value] == 0} {
2920                return 0
2921            }
2922
2923            # value was good, apply it
2924            # reset the mouse rotation bindings
2925            SetupMouseRotationBindings
2926        }
2927        apply {
2928            if {[llength $args] != 1} {
2929                error "wrong # args: should be \"editor apply value\""
2930            }
2931            set value [string trim [lindex $args 0]]
2932
2933            set which [MouseOver2Which]
2934
2935            # only set custom range if value changed
2936            if {[$itk_component($which) value] != $value} {
2937                # set the flag stating the custom range came from the legend
2938                # change the value in the gauge
2939                # turn on crange to enable the labels and gauges
2940                # call AdjustSetting -range (inside ToggleCustomRange)
2941                # to update drawing and legend
2942                set _customRangeClick 0
2943                $itk_component($which) value $value
2944                $itk_component(crange) select
2945                ToggleCustomRange
2946            }
2947        }
2948        default {
2949            error "bad option \"$option\": should be enter, leave, activate, validate, apply"
2950        }
2951    }
2952}
2953
2954# ----------------------------------------------------------------------
2955# USAGE: ToggleCustomRange
2956#
2957# Called whenever the custom range is turned on or off. Used to save
2958# the custom min and custom max set by the user. When the -customrange
2959# setting is turned on, the range min and range max gauges are set
2960# with the last value set by the user, or the default range if no
2961# previous min and max were set.
2962#
2963# When the custom range is turned on, we check how it was turned on
2964# by querying _customRangeClick. If the variable is 1, this means
2965# the user clicked the crange checkbutton and we should pull the
2966# custom range values from our backup variables. If the variable is 0,
2967# the custom range was enabled through the user manipulating the
2968# min and max value in the legend.
2969# ----------------------------------------------------------------------
2970itcl::body Rappture::VtkGlyphViewer::ToggleCustomRange {args} {
2971    if { ! $_settings(-customrange) } {
2972        # custom range was turned off
2973
2974        # disable the min/max labels and gauge widgets
2975        $itk_component(l_min) configure -state disabled
2976        $itk_component(min) configure -state disabled
2977        $itk_component(l_max) configure -state disabled
2978        $itk_component(max) configure -state disabled
2979
2980        # backup the custom range
2981        set _settings(-customrangemin) [$itk_component(min) value]
2982        set _settings(-customrangemax) [$itk_component(max) value]
2983
2984        # set the gauges to dataset's min and max
2985        foreach { vmin vmax } $_limits($_curFldName) break
2986        SetMinMaxGauges $vmin $vmax
2987    } else {
2988        # custom range was turned on
2989
2990        # enable the min/max labels and gauge widgets
2991        $itk_component(l_min) configure -state normal
2992        $itk_component(min) configure -state normal
2993        $itk_component(l_max) configure -state normal
2994        $itk_component(max) configure -state normal
2995
2996        # if the custom range is being turned on by clicking the
2997        # checkbox, restore the min and max gauges from the backup
2998        # variables. otherwise, new values for the min and max
2999        # widgets will be set later from the legend's editor.
3000        if { $_customRangeClick } {
3001            SetMinMaxGauges $_settings(-customrangemin) $_settings(-customrangemax)
3002        }
3003
3004        # reset the click flag
3005        set _customRangeClick 1
3006    }
3007    AdjustSetting -range
3008}
3009
3010# ----------------------------------------------------------------------
3011# USAGE: SetMinMaxGauges <min> <max>
3012#
3013# Set the min and max gauges in the correct order, avoiding the
3014# error where you try to set the min > max before updating the max or
3015# set the max < min before updating the min.
3016#
3017# There are five range cases to consider with our current range validation.
3018# For example:
3019# [2,3] -> [0,1]       : update min first, max last
3020# [2,3] -> [4,5]       : update max first, min last
3021# [2,3] -> [0,2.5]     : update min or max first
3022# [2,3] -> [2.5,5]     : update min or max first
3023# [2,3] -> [2.25,2.75] : update min or max first
3024#
3025# In 4 of the cases we can update min first and max last, so we only
3026# need to check the case where old max < new min, where we update
3027# max first and min last.
3028# ----------------------------------------------------------------------
3029itcl::body Rappture::VtkGlyphViewer::SetMinMaxGauges {min max} {
3030
3031    if { [$itk_component(max) value] < $min} {
3032        # old max < new min
3033        # shift range toward right
3034        # extend max first, then update min
3035        $itk_component(max) value $max
3036        $itk_component(min) value $min
3037    } else {
3038        # extend min first, then update max
3039        $itk_component(min) value $min
3040        $itk_component(max) value $max
3041    }
3042}
3043
3044#
3045# SetCurrentColormap --
3046#
3047itcl::body Rappture::VtkGlyphViewer::SetCurrentColormap { name } {
3048    # Keep track of the colormaps that we build.
3049    if { ![info exists _colormaps($name)] } {
3050        BuildColormap $name
3051        set _colormaps($name) 1
3052    }
3053    set _currentColormap $name
3054    SendCmd "glyphs colormap $_currentColormap"
3055    #SendCmd "cutplane colormap $_currentColormap"
3056}
3057
3058#
3059# BuildColormap --
3060#
3061# Build the designated colormap on the server.
3062#
3063itcl::body Rappture::VtkGlyphViewer::BuildColormap { name } {
3064    set cmap [ColorsToColormap $name]
3065    if { [llength $cmap] == 0 } {
3066        set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0"
3067    }
3068    set amap "0.0 1.0 1.0 1.0"
3069    SendCmd "colormap add $name { $cmap } { $amap }"
3070}
3071
3072itcl::body Rappture::VtkGlyphViewer::SetOrientation { side } {
3073    array set positions {
3074        front "1 0 0 0"
3075        back  "0 0 1 0"
3076        left  "0.707107 0 -0.707107 0"
3077        right "0.707107 0 0.707107 0"
3078        top   "0.707107 -0.707107 0 0"
3079        bottom "0.707107 0.707107 0 0"
3080    }
3081    foreach name { -qw -qx -qy -qz } value $positions($side) {
3082        set _view($name) $value
3083    }
3084    set q [ViewToQuaternion]
3085    $_arcball quaternion $q
3086    SendCmd "camera orient $q"
3087    SendCmd "camera reset"
3088    set _view(-xpan) 0
3089    set _view(-ypan) 0
3090    set _view(-zoom) 1.0
3091}
3092
3093itcl::body Rappture::VtkGlyphViewer::SetCurrentFieldName { dataobj } {
3094    set _first $dataobj
3095    $itk_component(field) choices delete 0 end
3096    $itk_component(fieldmenu) delete 0 end
3097    array unset _fields
3098    set _curFldName ""
3099    foreach cname [$_first components] {
3100        foreach fname [$_first fieldnames $cname] {
3101            if { [info exists _fields($fname)] } {
3102                continue
3103            }
3104            foreach { label units components } \
3105                [$_first fieldinfo $fname] break
3106            $itk_component(field) choices insert end "$fname" "$label"
3107            $itk_component(fieldmenu) add radiobutton -label "$label" \
3108                -value $label -variable [itcl::scope _curFldLabel] \
3109                -selectcolor red \
3110                -activebackground $itk_option(-plotbackground) \
3111                -activeforeground $itk_option(-plotforeground) \
3112                -font "Arial 8" \
3113                -command [itcl::code $this LegendTitleAction save]
3114            set _fields($fname) [list $label $units $components]
3115            if { $_curFldName == "" } {
3116                set _curFldName $fname
3117                set _curFldLabel $label
3118                set _curFldComp $components
3119            }
3120        }
3121    }
3122    $itk_component(field) value $_curFldLabel
3123    if { $_settings(-customrange) } {
3124        set limits [list [$itk_component(min) value] [$itk_component(max) value]]
3125        SendCmd "dataset maprange explicit $limits $_curFldName point_data $_curFldComp"
3126    } else {
3127        if { ![info exists _limits($_curFldName)] } {
3128            SendCmd "dataset maprange all"
3129        } else {
3130            set limits $_limits($_curFldName)
3131            SendCmd "dataset maprange explicit $limits $_curFldName point_data $_curFldComp"
3132        }
3133    }
3134}
Note: See TracBrowser for help on using the repository browser.