source: trunk/gui/scripts/vtkviewer.tcl @ 4749

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

Fix reporting of tool info to render servers

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