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

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

merge fixes from trunk

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