source: trunk/gui/scripts/vtkglyphviewer.tcl @ 5094

Last change on this file since 5094 was 5094, checked in by ldelgass, 5 years ago

Enable the wait animation in all nanovis and vtkvis viewers

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