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

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

merge r6235:6236 from trunk (streamlines scaling)

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