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

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

remove unused limits methods

File size: 109.8 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_version"  [$dataobj hints toolRevision]
1065                    lappend info "tool_title"    [$dataobj hints toolTitle]
1066                    lappend info "dataset_label" [$dataobj hints label]
1067                    lappend info "dataset_size"  $length
1068                    lappend info "dataset_tag"   $tag
1069                    SendCmd [list "clientinfo" $info]
1070                }
1071                SendCmd "dataset add $tag data follows $length"
1072                append _outbuf $bytes
1073                set _datasets($tag) 1
1074                SetObjectStyle $dataobj $comp
1075            }
1076            lappend _obj2datasets($dataobj) $tag
1077            set type [$dataobj type $comp]
1078            if { [info exists _obj2ovride($dataobj-raise)] } {
1079                SendCmd "$type visible 1 $tag"
1080                SetOpacity $tag
1081            }
1082        }
1083    }
1084    if {"" != $_first} {
1085        set location [$_first hints camera]
1086        if { $location != "" } {
1087            array set view $location
1088        }
1089
1090        foreach axis { x y z } {
1091            set label [$_first hints ${axis}label]
1092            if { $label != "" } {
1093                SendCmd [list axis name $axis $label]
1094            }
1095            set units [$_first hints ${axis}units]
1096            if { $units != "" } {
1097                SendCmd [list axis units $axis $units]
1098            }
1099        }
1100    }
1101    if { $_haveGlyphs } {
1102        InitSettings glyphs-outline
1103    }
1104    if { $_haveMolecules } {
1105        InitSettings molecule-outline
1106    }
1107    if { $_havePolydata } {
1108        InitSettings polydata-outline
1109    }
1110    if { $_reset } {
1111        if { $_haveGlyphs } {
1112            InitSettings glyphs-edges glyphs-lighting glyphs-opacity \
1113                glyphs-visible glyphs-wireframe
1114        }
1115        if { $_havePolydata } {
1116            InitSettings polydata-edges polydata-lighting polydata-opacity \
1117                polydata-visible polydata-wireframe
1118        }
1119        if { $_haveMolecules } {
1120            InitSettings molecule-edges molecule-lighting molecule-opacity \
1121                molecule-visible molecule-wireframe molecule-labels
1122        }
1123
1124        set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1125        $_arcball quaternion $q
1126        SendCmd "camera reset"
1127        if { $_view(ortho)} {
1128            SendCmd "camera mode ortho"
1129        } else {
1130            SendCmd "camera mode persp"
1131        }
1132        DoRotate
1133        PanCamera
1134        Zoom reset
1135    }
1136
1137    if { $_haveMolecules } {
1138        #InitSettings molecule-representation
1139    }
1140    set _reset 0
1141    global readyForNextFrame
1142    set readyForNextFrame 0;            # Don't advance to the next frame
1143                                        # until we get an image.
1144
1145    # Actually write the commands to the server socket.  If it fails, we don't
1146    # care.  We're finished here.
1147    blt::busy hold $itk_component(hull)
1148    StopBufferingCommands
1149    blt::busy release $itk_component(hull)
1150}
1151
1152# ----------------------------------------------------------------------
1153# USAGE: CurrentDatasets ?-all -visible? ?dataobjs?
1154#
1155# Returns a list of server IDs for the current datasets being displayed.  This
1156# is normally a single ID, but it might be a list of IDs if the current data
1157# object has multiple components.
1158# ----------------------------------------------------------------------
1159itcl::body Rappture::VtkViewer::CurrentDatasets {args} {
1160    set flag [lindex $args 0]
1161    switch -- $flag {
1162        "-all" {
1163            if { [llength $args] > 1 } {
1164                error "CurrentDatasets: can't specify dataobj after \"-all\""
1165            }
1166            set dlist [get -objects]
1167        }
1168        "-visible" {
1169            if { [llength $args] > 1 } {
1170                set dlist {}
1171                set args [lrange $args 1 end]
1172                foreach dataobj $args {
1173                    if { [info exists _obj2ovride($dataobj-raise)] } {
1174                        lappend dlist $dataobj
1175                    }
1176                }
1177            } else {
1178                set dlist [get -visible]
1179            }
1180        }           
1181        default {
1182            set dlist $args
1183        }
1184    }
1185    set rlist ""
1186    foreach dataobj $dlist {
1187        foreach comp [$dataobj components] {
1188            set tag $dataobj-$comp
1189            if { [info exists _datasets($tag)] && $_datasets($tag) } {
1190                lappend rlist $tag
1191            }
1192        }
1193    }
1194    return $rlist
1195}
1196
1197# ----------------------------------------------------------------------
1198# USAGE: Zoom in
1199# USAGE: Zoom out
1200# USAGE: Zoom reset
1201#
1202# Called automatically when the user clicks on one of the zoom
1203# controls for this widget.  Changes the zoom for the current view.
1204# ----------------------------------------------------------------------
1205itcl::body Rappture::VtkViewer::Zoom {option} {
1206    switch -- $option {
1207        "in" {
1208            set _view(zoom) [expr {$_view(zoom)*1.25}]
1209            SendCmd "camera zoom $_view(zoom)"
1210        }
1211        "out" {
1212            set _view(zoom) [expr {$_view(zoom)*0.8}]
1213            SendCmd "camera zoom $_view(zoom)"
1214        }
1215        "reset" {
1216            array set _view {
1217                qw      0.853553
1218                qx      -0.353553
1219                qy      0.353553
1220                qz      0.146447
1221                zoom    1.0
1222                xpan    0
1223                ypan    0
1224            }
1225            if { $_first != "" } {
1226                set location [$_first hints camera]
1227                if { $location != "" } {
1228                    array set _view $location
1229                }
1230            }
1231            set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1232            $_arcball quaternion $q
1233            DoRotate
1234            SendCmd "camera reset"
1235        }
1236    }
1237}
1238
1239itcl::body Rappture::VtkViewer::PanCamera {} {
1240    set x $_view(xpan)
1241    set y $_view(ypan)
1242    SendCmd "camera pan $x $y"
1243}
1244
1245# ----------------------------------------------------------------------
1246# USAGE: Rotate click <x> <y>
1247# USAGE: Rotate drag <x> <y>
1248# USAGE: Rotate release <x> <y>
1249#
1250# Called automatically when the user clicks/drags/releases in the
1251# plot area.  Moves the plot according to the user's actions.
1252# ----------------------------------------------------------------------
1253itcl::body Rappture::VtkViewer::Rotate {option x y} {
1254    switch -- $option {
1255        "click" {
1256            $itk_component(view) configure -cursor fleur
1257            set _click(x) $x
1258            set _click(y) $y
1259        }
1260        "drag" {
1261            if {[array size _click] == 0} {
1262                Rotate click $x $y
1263            } else {
1264                set w [winfo width $itk_component(view)]
1265                set h [winfo height $itk_component(view)]
1266                if {$w <= 0 || $h <= 0} {
1267                    return
1268                }
1269
1270                if {[catch {
1271                    # this fails sometimes for no apparent reason
1272                    set dx [expr {double($x-$_click(x))/$w}]
1273                    set dy [expr {double($y-$_click(y))/$h}]
1274                }]} {
1275                    return
1276                }
1277                if { $dx == 0 && $dy == 0 } {
1278                    return
1279                }
1280                set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1281                EventuallyRotate $q
1282                set _click(x) $x
1283                set _click(y) $y
1284            }
1285        }
1286        "release" {
1287            Rotate drag $x $y
1288            $itk_component(view) configure -cursor ""
1289            catch {unset _click}
1290        }
1291        default {
1292            error "bad option \"$option\": should be click, drag, release"
1293        }
1294    }
1295}
1296
1297itcl::body Rappture::VtkViewer::Pick {x y} {
1298    foreach tag [CurrentDatasets -visible] {
1299        SendCmd "dataset getscalar pixel $x $y $tag"
1300    }
1301}
1302
1303# ----------------------------------------------------------------------
1304# USAGE: $this Pan click x y
1305#        $this Pan drag x y
1306#        $this Pan release x y
1307#
1308# Called automatically when the user clicks on one of the zoom
1309# controls for this widget.  Changes the zoom for the current view.
1310# ----------------------------------------------------------------------
1311itcl::body Rappture::VtkViewer::Pan {option x y} {
1312    switch -- $option {
1313        "set" {
1314            set w [winfo width $itk_component(view)]
1315            set h [winfo height $itk_component(view)]
1316            set x [expr $x / double($w)]
1317            set y [expr $y / double($h)]
1318            set _view(xpan) [expr $_view(xpan) + $x]
1319            set _view(ypan) [expr $_view(ypan) + $y]
1320            PanCamera
1321            return
1322        }
1323        "click" {
1324            set _click(x) $x
1325            set _click(y) $y
1326            $itk_component(view) configure -cursor hand1
1327        }
1328        "drag" {
1329            if { ![info exists _click(x)] } {
1330                set _click(x) $x
1331            }
1332            if { ![info exists _click(y)] } {
1333                set _click(y) $y
1334            }
1335            set w [winfo width $itk_component(view)]
1336            set h [winfo height $itk_component(view)]
1337            set dx [expr ($_click(x) - $x)/double($w)]
1338            set dy [expr ($_click(y) - $y)/double($h)]
1339            set _click(x) $x
1340            set _click(y) $y
1341            set _view(xpan) [expr $_view(xpan) - $dx]
1342            set _view(ypan) [expr $_view(ypan) - $dy]
1343            PanCamera
1344        }
1345        "release" {
1346            Pan drag $x $y
1347            $itk_component(view) configure -cursor ""
1348        }
1349        default {
1350            error "unknown option \"$option\": should set, click, drag, or release"
1351        }
1352    }
1353}
1354
1355# ----------------------------------------------------------------------
1356# USAGE: InitSettings <what> ?<value>?
1357#
1358# Used internally to update rendering settings whenever parameters
1359# change in the popup settings panel.  Sends the new settings off
1360# to the back end.
1361# ----------------------------------------------------------------------
1362itcl::body Rappture::VtkViewer::InitSettings { args } {
1363    foreach setting $args {
1364        AdjustSetting $setting
1365    }
1366}
1367
1368#
1369# AdjustSetting --
1370#
1371#       Changes/updates a specific setting in the widget.  There are
1372#       usually user-setable option.  Commands are sent to the render
1373#       server.
1374#
1375itcl::body Rappture::VtkViewer::AdjustSetting {what {value ""}} {
1376    if { ![isconnected] } {
1377        return
1378    }
1379    switch -- $what {
1380        "glyphs-opacity" {
1381            foreach dataset [CurrentDatasets -visible $_first] {
1382                foreach { dataobj comp } [split $dataset -] break
1383                if { [$dataobj type $comp] == "glyphs" } {
1384                    SetOpacity $dataset
1385                }
1386            }
1387        }
1388        "glyphs-outline" {
1389            set bool $_settings($what)
1390            foreach dataset [CurrentDatasets -visible $_first] {
1391                foreach { dataobj comp } [split $dataset -] break
1392                set type [$dataobj type $comp]
1393                if { $type == "glyphs" } {
1394                    SendCmd "outline visible $bool $dataset"
1395                }
1396            }
1397        }
1398        "glyphs-wireframe" {
1399            set bool $_settings($what)
1400            foreach dataset [CurrentDatasets -visible $_first] {
1401                foreach { dataobj comp } [split $dataset -] break
1402                set type [$dataobj type $comp]
1403                if { $type == "glyphs" } {
1404                    SendCmd "$type wireframe $bool $dataset"
1405                }
1406            }
1407        }
1408        "glyphs-visible" {
1409            set bool $_settings($what)
1410            foreach dataset [CurrentDatasets -visible $_first] {
1411                foreach { dataobj comp } [split $dataset -] break
1412                set type [$dataobj type $comp]
1413                if { $type == "glyphs" } {
1414                    SendCmd "$type visible $bool $dataset"
1415                }
1416            }
1417        }
1418        "glyphs-lighting" {
1419            set bool $_settings($what)
1420            foreach dataset [CurrentDatasets -visible $_first] {
1421                foreach { dataobj comp } [split $dataset -] break
1422                set type [$dataobj type $comp]
1423                if { $type == "glyphs" } {
1424                    SendCmd "$type lighting $bool $dataset"
1425                }
1426            }
1427        }
1428        "glyphs-edges" {
1429            set bool $_settings($what)
1430            foreach dataset [CurrentDatasets -visible $_first] {
1431                foreach { dataobj comp } [split $dataset -] break
1432                set type [$dataobj type $comp]
1433                if { $type == "glyphs" } {
1434                    SendCmd "$type edges $bool $dataset"
1435                }
1436            }
1437        }
1438        "glyphs-palette" {
1439            set palette [$itk_component(glyphspalette) value]
1440            set _settings($what) $palette
1441            foreach dataset [CurrentDatasets -visible $_first] {
1442                foreach {dataobj comp} [split $dataset -] break
1443                set type [$dataobj type $comp]
1444                if { $type == "glyphs" } {
1445                    ChangeColormap $dataobj $comp $palette
1446                    # FIXME: fill in current selected fieldname
1447                    #SendCmd "glyphs colormode scalar {} $dataset"
1448                }
1449            }
1450            set _legendPending 1
1451        }
1452        "polydata-opacity" {
1453            foreach dataset [CurrentDatasets -visible $_first] {
1454                foreach { dataobj comp } [split $dataset -] break
1455                if { [$dataobj type $comp] == "polydata" } {
1456                    SetOpacity $dataset
1457                }
1458            }
1459        }
1460        "polydata-outline" {
1461            set bool $_settings($what)
1462            foreach dataset [CurrentDatasets -visible $_first] {
1463                foreach { dataobj comp } [split $dataset -] break
1464                set type [$dataobj type $comp]
1465                if { $type == "polydata" } {
1466                    SendCmd "outline visible $bool $dataset"
1467                }
1468            }
1469        }
1470        "polydata-wireframe" {
1471            set bool $_settings($what)
1472            foreach dataset [CurrentDatasets -visible $_first] {
1473                foreach { dataobj comp } [split $dataset -] break
1474                set type [$dataobj type $comp]
1475                if { $type == "polydata" } {
1476                    SendCmd "$type wireframe $bool $dataset"
1477                }
1478            }
1479        }
1480        "polydata-visible" {
1481            set bool $_settings($what)
1482            foreach dataset [CurrentDatasets -visible $_first] {
1483                foreach { dataobj comp } [split $dataset -] break
1484                set type [$dataobj type $comp]
1485                if { $type == "polydata" } {
1486                    SendCmd "$type visible $bool $dataset"
1487                }
1488            }
1489        }
1490        "polydata-lighting" {
1491            set bool $_settings($what)
1492            foreach dataset [CurrentDatasets -visible $_first] {
1493                foreach { dataobj comp } [split $dataset -] break
1494                set type [$dataobj type $comp]
1495                if { $type == "polydata" } {
1496                    SendCmd "$type lighting $bool $dataset"
1497                }
1498            }
1499        }
1500        "polydata-edges" {
1501            set bool $_settings($what)
1502            foreach dataset [CurrentDatasets -visible $_first] {
1503                foreach { dataobj comp } [split $dataset -] break
1504                set type [$dataobj type $comp]
1505                if { $type == "polydata" } {
1506                    SendCmd "$type edges $bool $dataset"
1507                }
1508            }
1509        }
1510        "polydata-palette" {
1511            set palette [$itk_component(meshpalette) value]
1512            set _settings($what) $palette
1513            foreach dataset [CurrentDatasets -visible $_first] {
1514                foreach {dataobj comp} [split $dataset -] break
1515                set type [$dataobj type $comp]
1516                if { $type == "polydata" } {
1517                    ChangeColormap $dataobj $comp $palette
1518                    # FIXME: fill in current selected fieldname
1519                    #SendCmd "polydata colormode scalar {} $dataset"
1520                }
1521            }
1522            set _legendPending 1
1523        }
1524        "molecule-opacity" {
1525            foreach dataset [CurrentDatasets -visible $_first] {
1526                foreach { dataobj comp } [split $dataset -] break
1527                if { [$dataobj type $comp] == "molecule" } {
1528                    SetOpacity $dataset
1529                }
1530            }
1531        }
1532        "molecule-outline" {
1533            set bool $_settings($what)
1534            foreach dataset [CurrentDatasets -visible $_first] {
1535                foreach { dataobj comp } [split $dataset -] break
1536                set type [$dataobj type $comp]
1537                if { $type == "molecule" } {
1538                    SendCmd "outline visible $bool $dataset"
1539                }
1540            }
1541        }
1542        "molecule-wireframe" {
1543            set bool $_settings($what)
1544            foreach dataset [CurrentDatasets -visible $_first] {
1545                foreach { dataobj comp } [split $dataset -] break
1546                set type [$dataobj type $comp]
1547                if { $type == "molecule" } {
1548                    SendCmd "molecule wireframe $bool $dataset"
1549                }
1550            }
1551        }
1552        "molecule-visible" {
1553            set bool $_settings($what)
1554            foreach dataset [CurrentDatasets -visible $_first] {
1555                foreach { dataobj comp } [split $dataset -] break
1556                set type [$dataobj type $comp]
1557                if { $type == "molecule" } {
1558                    SendCmd "molecule visible $bool $dataset"
1559                }
1560            }
1561        }
1562        "molecule-lighting" {
1563            set bool $_settings($what)
1564            foreach dataset [CurrentDatasets -visible $_first] {
1565                foreach { dataobj comp } [split $dataset -] break
1566                set type [$dataobj type $comp]
1567                if { $type == "molecule" } {
1568                    SendCmd "molecule lighting $bool $dataset"
1569                }
1570            }
1571        }
1572        "molecule-edges" {
1573            set bool $_settings($what)
1574            foreach dataset [CurrentDatasets -visible $_first] {
1575                foreach { dataobj comp } [split $dataset -] break
1576                set type [$dataobj type $comp]
1577                if { $type == "molecule" } {
1578                    SendCmd "molecule edges $bool $dataset"
1579                }
1580            }
1581        }
1582        "molecule-palette" {
1583            set palette [$itk_component(moleculepalette) value]
1584            set _settings($what) $palette
1585            foreach dataset [CurrentDatasets -visible $_first] {
1586                foreach {dataobj comp} [split $dataset -] break
1587                set type [$dataobj type $comp]
1588                if { $type == "molecule" } {
1589                    ChangeColormap $dataobj $comp $palette
1590                    if { $palette == "elementDefault" } {
1591                        SendCmd "molecule colormode by_elements element $dataset"
1592                    } else {
1593                        # FIXME: Set the chosen scalar field name here
1594                        SendCmd "molecule colormode scalar {} $dataset"
1595                    }
1596                }
1597            }
1598            set _legendPending 1
1599        }
1600        "molecule-representation" {
1601            set value [$itk_component(representation) value]
1602            set value [$itk_component(representation) translate $value]
1603            switch -- $value {
1604                "ballandstick" {
1605                    set _settings(molecule-rscale) covalent
1606                    set _settings(molecule-atoms-visible) 1
1607                    set _settings(molecule-bonds-visible) 1
1608                    set _settings(molecule-bondstyle) cylinder
1609                    set _settings(molecule-atomscale) 0.3
1610                    set _settings(molecule-bondscale) 0.075
1611                }
1612                "balls" - "spheres" {
1613                    set _settings(molecule-rscale) covalent
1614                    set _settings(molecule-atoms-visible) 1
1615                    set _settings(molecule-bonds-visible) 0
1616                    set _settings(molecule-bondstyle) cylinder
1617                    set _settings(molecule-atomscale) 0.3
1618                    set _settings(molecule-bondscale) 0.075
1619                }
1620                "sticks" {
1621                    set _settings(molecule-rscale) none
1622                    set _settings(molecule-atoms-visible) 1
1623                    set _settings(molecule-bonds-visible) 1
1624                    set _settings(molecule-bondstyle) cylinder
1625                    set _settings(molecule-atomscale) 0.075
1626                    set _settings(molecule-bondscale) 0.075
1627                }
1628                "spacefilling" {
1629                    set _settings(molecule-rscale) van_der_waals
1630                    set _settings(molecule-atoms-visible) 1
1631                    set _settings(molecule-bonds-visible) 0
1632                    set _settings(molecule-bondstyle) cylinder
1633                    set _settings(molecule-atomscale) 1.0
1634                    set _settings(molecule-bondscale) 0.075
1635                }
1636                "rods"  {
1637                    set _settings(molecule-rscale) none
1638                    set _settings(molecule-atoms-visible) 1
1639                    set _settings(molecule-bonds-visible) 1
1640                    set _settings(molecule-bondstyle) cylinder
1641                    set _settings(molecule-atomscale) 0.1
1642                    set _settings(molecule-bondscale) 0.1
1643                }
1644                "wireframe" - "lines" {
1645                    set _settings(molecule-rscale) none
1646                    set _settings(molecule-atoms-visible) 0
1647                    set _settings(molecule-bonds-visible) 1
1648                    set _settings(molecule-bondstyle) line
1649                    set _settings(molecule-atomscale) 1.0
1650                    set _settings(molecule-bondscale) 1.0
1651                }
1652                default {
1653                    error "unknown representation $value"
1654                }
1655            }
1656            $itk_component(rscale) value [$itk_component(rscale) label $_settings(molecule-rscale)]
1657            switch -- $value {
1658                "ballandstick" - "balls" - "spheres" {
1659                    $itk_component(rscale) configure -state normal
1660                }
1661                default {
1662                    $itk_component(rscale) configure -state disabled
1663                }
1664            }
1665            foreach dataset [CurrentDatasets -all] {
1666                foreach {dataobj comp} [split $dataset -] break
1667                set type [$dataobj type $comp]
1668                if { $type == "molecule" } {
1669                    StartBufferingCommands
1670                    SendCmd [subst {molecule rscale $_settings(molecule-rscale) $dataset}]
1671                    SendCmd [subst {molecule ascale $_settings(molecule-atomscale) $dataset}]
1672                    SendCmd [subst {molecule bscale $_settings(molecule-bondscale) $dataset}]
1673                    SendCmd [subst {molecule bstyle $_settings(molecule-bondstyle) $dataset}]
1674                    SendCmd [subst {molecule atoms $_settings(molecule-atoms-visible) $dataset}]
1675                    SendCmd [subst {molecule bonds $_settings(molecule-bonds-visible) $dataset}]
1676                    StopBufferingCommands
1677                }
1678            }
1679        }
1680        "molecule-rscale" {
1681            set value [$itk_component(rscale) value]
1682            set value [$itk_component(rscale) translate $value]
1683            set _settings($what) $value
1684            foreach dataset [CurrentDatasets -visible $_first] {
1685                foreach {dataobj comp} [split $dataset -] break
1686                set type [$dataobj type $comp]
1687                if { $type == "molecule" } {
1688                    SendCmd [subst {molecule rscale $_settings($what) $dataset}]
1689                }
1690            }
1691        }
1692        "molecule-labels" {
1693            set bool $_settings($what)
1694            foreach dataset [CurrentDatasets -visible $_first] {
1695               foreach { dataobj comp } [split $dataset -] break
1696               set type [$dataobj type $comp]
1697               if { $type == "molecule" } {
1698                   SendCmd "molecule labels $bool $dataset"
1699               }
1700            }
1701        }
1702        "axis-visible" {
1703            set bool $_axis(visible)
1704            SendCmd "axis visible all $bool"
1705        }
1706        "axis-labels" {
1707            set bool $_axis(labels)
1708            SendCmd "axis labels all $bool"
1709        }
1710        "axis-minorticks" {
1711            set bool $_axis(minorticks)
1712            SendCmd "axis minticks all $bool"
1713        }
1714        "axis-xgrid" {
1715            set bool $_axis(xgrid)
1716            SendCmd "axis grid x $bool"
1717        }
1718        "axis-ygrid" {
1719            set bool $_axis(ygrid)
1720            SendCmd "axis grid y $bool"
1721        }
1722        "axis-zgrid" {
1723            set bool $_axis(zgrid)
1724            SendCmd "axis grid z $bool"
1725        }
1726        "axis-mode" {
1727            set mode [$itk_component(axismode) value]
1728            set mode [$itk_component(axismode) translate $mode]
1729            SendCmd "axis flymode $mode"
1730        }
1731        "axis-xcutaway" - "axis-ycutaway" - "axis-zcutaway" {
1732            set axis [string range $what 5 5]
1733            set bool $_axis(${axis}cutaway)
1734            if { $bool } {
1735                set pos [expr $_axis(${axis}position) * 0.01]
1736                set dir $_axis(${axis}direction)
1737                $itk_component(${axis}CutScale) configure -state normal \
1738                    -troughcolor white
1739                SendCmd "renderer clipplane $axis $pos $dir"
1740            } else {
1741                $itk_component(${axis}CutScale) configure -state disabled \
1742                    -troughcolor grey82
1743                SendCmd "renderer clipplane $axis 1 -1"
1744            }
1745        }
1746        "axis-xposition" - "axis-yposition" - "axis-zposition" -
1747        "axis-xdirection" - "axis-ydirection" - "axis-zdirection" {
1748            set axis [string range $what 5 5]
1749            #set dir $_axis(${axis}direction)
1750            set pos [expr $_axis(${axis}position) * 0.01]
1751            SendCmd "renderer clipplane ${axis} $pos -1"
1752        }
1753        default {
1754            error "don't know how to fix $what"
1755        }
1756    }
1757}
1758
1759#
1760# RequestLegend --
1761#
1762#       Request a new legend from the server.  The size of the legend
1763#       is determined from the height of the canvas.  It will be rotated
1764#       to be vertical when drawn.
1765#
1766itcl::body Rappture::VtkViewer::RequestLegend {} {
1767    set font "Arial 8"
1768    set lineht [font metrics $font -linespace]
1769    set w 12
1770    set h [expr {$_height - 2 * ($lineht + 2)}]
1771    if { $h < 1 } {
1772        return
1773    }
1774    # Set the legend on the first dataset.
1775    foreach dataset [CurrentDatasets -visible] {
1776        foreach {dataobj comp} [split $dataset -] break
1777        if { [info exists _dataset2style($dataset)] } {
1778            SendCmd "legend $_dataset2style($dataset) vmag {} {} $w $h 0"
1779            break;
1780        }
1781    }
1782}
1783
1784#
1785# ChangeColormap --
1786#
1787itcl::body Rappture::VtkViewer::ChangeColormap {dataobj comp color} {
1788    set tag $dataobj-$comp
1789    if { ![info exist _style($tag)] } {
1790        error "no initial colormap"
1791    }
1792    array set style $_style($tag)
1793    set style(-color) $color
1794    set _style($tag) [array get style]
1795    SetColormap $dataobj $comp
1796}
1797
1798#
1799# SetColormap --
1800#
1801itcl::body Rappture::VtkViewer::SetColormap { dataobj comp } {
1802    array set style {
1803        -color BCGYR
1804        -levels 6
1805        -opacity 1.0
1806    }
1807    if {[$dataobj type $comp] == "molecule"} {
1808        set style(-color) elementDefault
1809    }
1810    set tag $dataobj-$comp
1811    if { ![info exists _initialStyle($tag)] } {
1812        # Save the initial component style.
1813        set _initialStyle($tag) [$dataobj style $comp]
1814    }
1815
1816    # Override defaults with initial style defined in xml.
1817    array set style $_initialStyle($tag)
1818
1819    if { ![info exists _style($tag)] } {
1820        set _style($tag) [array get style]
1821    }
1822    # Override initial style with current style.
1823    array set style $_style($tag)
1824
1825    if { $style(-color) == "elementDefault" } {
1826        set name "$style(-color)"
1827    } else {
1828        set name "$style(-color):$style(-levels):$style(-opacity)"
1829    }
1830    if { ![info exists _colormaps($name)] } {
1831        BuildColormap $name [array get style]
1832        set _colormaps($name) 1
1833    }
1834    if { ![info exists _dataset2style($tag)] ||
1835         $_dataset2style($tag) != $name } {
1836        set _dataset2style($tag) $name
1837        switch -- [$dataobj type $comp] {
1838            "polydata" {
1839                SendCmd "polydata colormap $name $tag"
1840            }
1841            "glyphs" {
1842                SendCmd "glyphs colormap $name $tag"
1843            }
1844            "molecule" {
1845                SendCmd "molecule colormap $name $tag"
1846            }
1847        }
1848    }
1849}
1850
1851#
1852# BuildColormap --
1853#
1854itcl::body Rappture::VtkViewer::BuildColormap { name styles } {
1855    if { $name ==  "elementDefault" } {
1856        return
1857    }
1858    array set style $styles
1859    set cmap [ColorsToColormap $style(-color)]
1860    if { [llength $cmap] == 0 } {
1861        set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0"
1862    }
1863    if { ![info exists _settings(polydata-opacity)] } {
1864        set _settings(polydata-opacity) $style(-opacity)
1865    }
1866    set max $_settings(polydata-opacity)
1867
1868    set wmap "0.0 1.0 1.0 1.0"
1869    SendCmd "colormap add $name { $cmap } { $wmap }"
1870}
1871
1872# ----------------------------------------------------------------------
1873# CONFIGURATION OPTION: -plotbackground
1874# ----------------------------------------------------------------------
1875itcl::configbody Rappture::VtkViewer::plotbackground {
1876    if { [isconnected] } {
1877        foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1878        SendCmd "screen bgcolor $r $g $b"
1879    }
1880}
1881
1882# ----------------------------------------------------------------------
1883# CONFIGURATION OPTION: -plotforeground
1884# ----------------------------------------------------------------------
1885itcl::configbody Rappture::VtkViewer::plotforeground {
1886    if { [isconnected] } {
1887        foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1888        #fix this!
1889        #SendCmd "color background $r $g $b"
1890    }
1891}
1892
1893itcl::body Rappture::VtkViewer::limits { dataobj } {
1894    foreach comp [$dataobj components] {
1895        set tag $dataobj-$comp
1896        if { ![info exists _limits($tag)] } {
1897            set data [$dataobj data $comp]
1898            if { $data == "" } {
1899                continue
1900            }
1901            set tmpfile file[pid].vtk
1902            set f [open "$tmpfile" "w"]
1903            fconfigure $f -translation binary -encoding binary
1904            puts $f $data
1905            close $f
1906            set reader [vtkDataSetReader $tag-xvtkDataSetReader]
1907            $reader SetFileName $tmpfile
1908set debug 0
1909            if {$debug} {
1910                # Only needed for debug output below
1911                $reader ReadAllNormalsOn
1912                $reader ReadAllTCoordsOn
1913                $reader ReadAllScalarsOn
1914                $reader ReadAllColorScalarsOn
1915                $reader ReadAllVectorsOn
1916                $reader ReadAllTensorsOn
1917                $reader ReadAllFieldsOn
1918            }
1919            $reader Update
1920            file delete $tmpfile
1921            set output [$reader GetOutput]
1922            if { $output == "" } {
1923                # Invalid VTK file -- loader failed to parse
1924                continue
1925            }
1926            set _limits($tag) [$output GetBounds]
1927            if {$debug} {
1928                puts stderr "\#scalars=[$reader GetNumberOfScalarsInFile]"
1929                puts stderr "\#vectors=[$reader GetNumberOfVectorsInFile]"
1930                puts stderr "\#tensors=[$reader GetNumberOfTensorsInFile]"
1931                puts stderr "\#normals=[$reader GetNumberOfNormalsInFile]"
1932                puts stderr "\#tcoords=[$reader GetNumberOfTCoordsInFile]"
1933                puts stderr "\#fielddata=[$reader GetNumberOfFieldDataInFile]"
1934                puts stderr "fielddataname=[$reader GetFieldDataNameInFile 0]"
1935                set pointData [$output GetPointData]
1936                if { $pointData != ""} {
1937                    puts stderr "point \#arrays=[$pointData GetNumberOfArrays]"
1938                    puts stderr "point \#components=[$pointData GetNumberOfComponents]"
1939                    puts stderr "point \#tuples=[$pointData GetNumberOfTuples]"
1940                    puts stderr "point scalars=[$pointData GetScalars]"
1941                    puts stderr "point vectors=[$pointData GetVectors]"
1942                }
1943                set cellData [$output GetCellData]
1944                if { $cellData != ""} {
1945                    puts stderr "cell \#arrays=[$cellData GetNumberOfArrays]"
1946                    puts stderr "cell \#components=[$cellData GetNumberOfComponents]"
1947                    puts stderr "cell \#tuples=[$cellData GetNumberOfTuples]"
1948                    puts stderr "cell scalars=[$cellData GetScalars]"
1949                    puts stderr "cell vectors=[$cellData GetVectors]"
1950                }
1951                set fieldData [$output GetFieldData]
1952                if { $fieldData != ""} {
1953                    puts stderr "field \#arrays=[$fieldData GetNumberOfArrays]"
1954                    puts stderr "field \#components=[$fieldData GetNumberOfComponents]"
1955                    puts stderr "field \#tuples=[$fieldData GetNumberOfTuples]"
1956                }
1957            }
1958            rename $output ""
1959            rename $reader ""
1960        }
1961        foreach { xMin xMax yMin yMax zMin zMax} $_limits($tag) break
1962        if {![info exists limits(xmin)] || $limits(xmin) > $xMin} {
1963            set limits(xmin) $xMin
1964        }
1965        if {![info exists limits(xmax)] || $limits(xmax) < $xMax} {
1966            set limits(xmax) $xMax
1967        }
1968        if {![info exists limits(ymin)] || $limits(ymin) > $yMin} {
1969            set limits(ymin) $xMin
1970        }
1971        if {![info exists limits(ymax)] || $limits(ymax) < $yMax} {
1972            set limits(ymax) $yMax
1973        }
1974        if {![info exists limits(zmin)] || $limits(zmin) > $zMin} {
1975            set limits(zmin) $zMin
1976        }
1977        if {![info exists limits(zmax)] || $limits(zmax) < $zMax} {
1978            set limits(zmax) $zMax
1979        }
1980    }
1981    return [array get limits]
1982}
1983
1984itcl::body Rappture::VtkViewer::BuildGlyphsTab {} {
1985
1986    set fg [option get $itk_component(hull) font Font]
1987    #set bfg [option get $itk_component(hull) boldFont Font]
1988
1989    set inner [$itk_component(main) insert 0 \
1990        -title "Glyph Settings" \
1991        -icon [Rappture::icon volume-on]]
1992    $inner configure -borderwidth 4
1993
1994    checkbutton $inner.glyphs \
1995        -text "Show Glyphs" \
1996        -variable [itcl::scope _settings(glyphs-visible)] \
1997        -command [itcl::code $this AdjustSetting glyphs-visible] \
1998        -font "Arial 9" -anchor w
1999
2000    checkbutton $inner.outline \
2001        -text "Show Outline" \
2002        -variable [itcl::scope _settings(glyphs-outline)] \
2003        -command [itcl::code $this AdjustSetting glyphs-outline] \
2004        -font "Arial 9" -anchor w
2005
2006    checkbutton $inner.wireframe \
2007        -text "Show Wireframe" \
2008        -variable [itcl::scope _settings(glyphs-wireframe)] \
2009        -command [itcl::code $this AdjustSetting glyphs-wireframe] \
2010        -font "Arial 9" -anchor w
2011
2012    checkbutton $inner.lighting \
2013        -text "Enable Lighting" \
2014        -variable [itcl::scope _settings(glyphs-lighting)] \
2015        -command [itcl::code $this AdjustSetting glyphs-lighting] \
2016        -font "Arial 9" -anchor w
2017
2018    checkbutton $inner.edges \
2019        -text "Show Edges" \
2020        -variable [itcl::scope _settings(glyphs-edges)] \
2021        -command [itcl::code $this AdjustSetting glyphs-edges] \
2022        -font "Arial 9" -anchor w
2023
2024    label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w
2025    itk_component add glyphspalette {
2026        Rappture::Combobox $inner.palette -width 10 -editable no
2027    }
2028    $inner.palette choices insert end [GetColormapList]
2029    $itk_component(glyphspalette) value "BCGYR"
2030    bind $inner.palette <<Value>> \
2031        [itcl::code $this AdjustSetting glyphs-palette]
2032
2033    label $inner.opacity_l -text "Opacity" -font "Arial 9" -anchor w
2034    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
2035        -variable [itcl::scope _settings(glyphs-opacity)] \
2036        -width 10 \
2037        -showvalue off \
2038        -command [itcl::code $this EventuallySetGlyphsOpacity]
2039    $inner.opacity set $_settings(glyphs-opacity)
2040
2041    blt::table $inner \
2042        0,0 $inner.glyphs    -cspan 2  -anchor w -pady 2 \
2043        1,0 $inner.outline   -cspan 2  -anchor w -pady 2 \
2044        2,0 $inner.wireframe -cspan 2  -anchor w -pady 2 \
2045        3,0 $inner.lighting  -cspan 2  -anchor w -pady 2 \
2046        4,0 $inner.edges     -cspan 2  -anchor w -pady 2 \
2047        5,0 $inner.opacity_l -anchor w -pady 2 \
2048        5,1 $inner.opacity   -fill x   -pady 2 \
2049        6,0 $inner.palette_l -anchor w -pady 2 \
2050        6,1 $inner.palette   -fill x   -pady 2 
2051
2052    blt::table configure $inner r* c* -resize none
2053    blt::table configure $inner r8 c1 -resize expand
2054}
2055
2056itcl::body Rappture::VtkViewer::BuildPolydataTab {} {
2057
2058    set fg [option get $itk_component(hull) font Font]
2059    #set bfg [option get $itk_component(hull) boldFont Font]
2060
2061    set inner [$itk_component(main) insert 0 \
2062        -title "Mesh Settings" \
2063        -icon [Rappture::icon mesh]]
2064    $inner configure -borderwidth 4
2065
2066    checkbutton $inner.mesh \
2067        -text "Show Mesh" \
2068        -variable [itcl::scope _settings(polydata-visible)] \
2069        -command [itcl::code $this AdjustSetting polydata-visible] \
2070        -font "Arial 9" -anchor w
2071
2072    checkbutton $inner.outline \
2073        -text "Show Outline" \
2074        -variable [itcl::scope _settings(polydata-outline)] \
2075        -command [itcl::code $this AdjustSetting polydata-outline] \
2076        -font "Arial 9" -anchor w
2077
2078    checkbutton $inner.wireframe \
2079        -text "Show Wireframe" \
2080        -variable [itcl::scope _settings(polydata-wireframe)] \
2081        -command [itcl::code $this AdjustSetting polydata-wireframe] \
2082        -font "Arial 9" -anchor w
2083
2084    checkbutton $inner.lighting \
2085        -text "Enable Lighting" \
2086        -variable [itcl::scope _settings(polydata-lighting)] \
2087        -command [itcl::code $this AdjustSetting polydata-lighting] \
2088        -font "Arial 9" -anchor w
2089
2090    checkbutton $inner.edges \
2091        -text "Show Edges" \
2092        -variable [itcl::scope _settings(polydata-edges)] \
2093        -command [itcl::code $this AdjustSetting polydata-edges] \
2094        -font "Arial 9" -anchor w
2095
2096    label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w
2097    itk_component add meshpalette {
2098        Rappture::Combobox $inner.palette -width 10 -editable no
2099    }
2100    $inner.palette choices insert end [GetColormapList]
2101    $itk_component(meshpalette) value "BCGYR"
2102    bind $inner.palette <<Value>> \
2103        [itcl::code $this AdjustSetting polydata-palette]
2104
2105    label $inner.opacity_l -text "Opacity" -font "Arial 9" -anchor w
2106    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
2107        -variable [itcl::scope _settings(polydata-opacity)] \
2108        -width 10 \
2109        -showvalue off \
2110        -command [itcl::code $this EventuallySetPolydataOpacity]
2111    $inner.opacity set $_settings(polydata-opacity)
2112
2113    blt::table $inner \
2114        0,0 $inner.mesh      -cspan 2  -anchor w -pady 2 \
2115        1,0 $inner.outline   -cspan 2  -anchor w -pady 2 \
2116        2,0 $inner.wireframe -cspan 2  -anchor w -pady 2 \
2117        3,0 $inner.lighting  -cspan 2  -anchor w -pady 2 \
2118        4,0 $inner.edges     -cspan 2  -anchor w -pady 2 \
2119        5,0 $inner.opacity_l -anchor w -pady 2 \
2120        5,1 $inner.opacity   -fill x   -pady 2 \
2121        6,0 $inner.palette_l -anchor w -pady 2 \
2122        6,1 $inner.palette   -fill x   -pady 2 
2123
2124    blt::table configure $inner r* c* -resize none
2125    blt::table configure $inner r8 c1 -resize expand
2126}
2127
2128itcl::body Rappture::VtkViewer::BuildAxisTab {} {
2129
2130    set fg [option get $itk_component(hull) font Font]
2131    #set bfg [option get $itk_component(hull) boldFont Font]
2132
2133    set inner [$itk_component(main) insert end \
2134        -title "Axis Settings" \
2135        -icon [Rappture::icon axis2]]
2136    $inner configure -borderwidth 4
2137
2138    checkbutton $inner.visible \
2139        -text "Axes" \
2140        -variable [itcl::scope _axis(visible)] \
2141        -command [itcl::code $this AdjustSetting axis-visible] \
2142        -font "Arial 9"
2143
2144    checkbutton $inner.labels \
2145        -text "Axis Labels" \
2146        -variable [itcl::scope _axis(labels)] \
2147        -command [itcl::code $this AdjustSetting axis-labels] \
2148        -font "Arial 9"
2149    label $inner.grid_l -text "Grid" -font "Arial 9"
2150    checkbutton $inner.xgrid \
2151        -text "X" \
2152        -variable [itcl::scope _axis(xgrid)] \
2153        -command [itcl::code $this AdjustSetting axis-xgrid] \
2154        -font "Arial 9"
2155    checkbutton $inner.ygrid \
2156        -text "Y" \
2157        -variable [itcl::scope _axis(ygrid)] \
2158        -command [itcl::code $this AdjustSetting axis-ygrid] \
2159        -font "Arial 9"
2160    checkbutton $inner.zgrid \
2161        -text "Z" \
2162        -variable [itcl::scope _axis(zgrid)] \
2163        -command [itcl::code $this AdjustSetting axis-zgrid] \
2164        -font "Arial 9"
2165    checkbutton $inner.minorticks \
2166        -text "Minor Ticks" \
2167        -variable [itcl::scope _axis(minorticks)] \
2168        -command [itcl::code $this AdjustSetting axis-minorticks] \
2169        -font "Arial 9"
2170
2171    label $inner.mode_l -text "Mode" -font "Arial 9"
2172
2173    itk_component add axismode {
2174        Rappture::Combobox $inner.mode -width 10 -editable no
2175    }
2176    $inner.mode choices insert end \
2177        "static_triad"    "static" \
2178        "closest_triad"   "closest" \
2179        "furthest_triad"  "farthest" \
2180        "outer_edges"     "outer"         
2181    $itk_component(axismode) value "static"
2182    bind $inner.mode <<Value>> [itcl::code $this AdjustSetting axis-mode]
2183
2184    blt::table $inner \
2185        0,0 $inner.visible -anchor w -cspan 4 \
2186        1,0 $inner.labels  -anchor w -cspan 4 \
2187        2,0 $inner.minorticks  -anchor w -cspan 4 \
2188        4,0 $inner.grid_l  -anchor w \
2189        4,1 $inner.xgrid   -anchor w \
2190        4,2 $inner.ygrid   -anchor w \
2191        4,3 $inner.zgrid   -anchor w \
2192        5,0 $inner.mode_l  -anchor w -padx { 2 0 } \
2193        5,1 $inner.mode    -fill x   -cspan 3
2194
2195    blt::table configure $inner r* c* -resize none
2196    blt::table configure $inner r7 c6 -resize expand
2197    blt::table configure $inner r3 -height 0.125i
2198}
2199
2200itcl::body Rappture::VtkViewer::BuildCameraTab {} {
2201    set inner [$itk_component(main) insert end \
2202        -title "Camera Settings" \
2203        -icon [Rappture::icon camera]]
2204    $inner configure -borderwidth 4
2205
2206    label $inner.view_l -text "view" -font "Arial 9"
2207    set f [frame $inner.view]
2208    foreach side { front back left right top bottom } {
2209        button $f.$side  -image [Rappture::icon view$side] \
2210            -command [itcl::code $this SetOrientation $side]
2211        Rappture::Tooltip::for $f.$side "Change the view to $side"
2212        pack $f.$side -side left
2213    }
2214
2215    blt::table $inner \
2216        0,0 $inner.view_l -anchor e -pady 2 \
2217        0,1 $inner.view -anchor w -pady 2
2218
2219    set labels { qx qy qz qw xpan ypan zoom }
2220    set row 1
2221    foreach tag $labels {
2222        label $inner.${tag}label -text $tag -font "Arial 9"
2223        entry $inner.${tag} -font "Arial 9"  -bg white \
2224            -textvariable [itcl::scope _view($tag)]
2225        bind $inner.${tag} <KeyPress-Return> \
2226            [itcl::code $this camera set ${tag}]
2227        blt::table $inner \
2228            $row,0 $inner.${tag}label -anchor e -pady 2 \
2229            $row,1 $inner.${tag} -anchor w -pady 2
2230        blt::table configure $inner r$row -resize none
2231        incr row
2232    }
2233    checkbutton $inner.ortho \
2234        -text "Orthographic Projection" \
2235        -variable [itcl::scope _view(ortho)] \
2236        -command [itcl::code $this camera set ortho] \
2237        -font "Arial 9"
2238    blt::table $inner \
2239            $row,0 $inner.ortho -cspan 2 -anchor w -pady 2
2240    blt::table configure $inner r$row -resize none
2241    incr row
2242
2243    blt::table configure $inner c* r* -resize none
2244    blt::table configure $inner c2 -resize expand
2245    blt::table configure $inner r$row -resize expand
2246}
2247
2248itcl::body Rappture::VtkViewer::BuildCutawayTab {} {
2249
2250    set fg [option get $itk_component(hull) font Font]
2251   
2252    set inner [$itk_component(main) insert end \
2253        -title "Cutaway Along Axis" \
2254        -icon [Rappture::icon cutbutton]]
2255
2256    $inner configure -borderwidth 4
2257
2258    # X-value slicer...
2259    itk_component add xCutButton {
2260        Rappture::PushButton $inner.xbutton \
2261            -onimage [Rappture::icon x-cutplane] \
2262            -offimage [Rappture::icon x-cutplane] \
2263            -command [itcl::code $this AdjustSetting axis-xcutaway] \
2264            -variable [itcl::scope _axis(xcutaway)]
2265    }
2266    Rappture::Tooltip::for $itk_component(xCutButton) \
2267        "Toggle the X-axis cutaway on/off"
2268
2269    itk_component add xCutScale {
2270        ::scale $inner.xval -from 100 -to 0 \
2271            -width 10 -orient vertical -showvalue yes \
2272            -borderwidth 1 -highlightthickness 0 \
2273            -command [itcl::code $this Slice move x] \
2274            -variable [itcl::scope _axis(xposition)]
2275    } {
2276        usual
2277        ignore -borderwidth -highlightthickness
2278    }
2279    # Set the default cutaway value before disabling the scale.
2280    $itk_component(xCutScale) set 100
2281    $itk_component(xCutScale) configure -state disabled
2282    Rappture::Tooltip::for $itk_component(xCutScale) \
2283        "@[itcl::code $this Slice tooltip x]"
2284
2285    itk_component add xDirButton {
2286        Rappture::PushButton $inner.xdir \
2287            -onimage [Rappture::icon arrow-down] \
2288            -onvalue -1 \
2289            -offimage [Rappture::icon arrow-up] \
2290            -offvalue 1 \
2291            -command [itcl::code $this AdjustSetting axis-xdirection] \
2292            -variable [itcl::scope _axis(xdirection)]
2293    }
2294    set _axis(xdirection) -1
2295    Rappture::Tooltip::for $itk_component(xDirButton) \
2296        "Toggle the direction of the X-axis cutaway"
2297
2298    # Y-value slicer...
2299    itk_component add yCutButton {
2300        Rappture::PushButton $inner.ybutton \
2301            -onimage [Rappture::icon y-cutplane] \
2302            -offimage [Rappture::icon y-cutplane] \
2303            -command [itcl::code $this AdjustSetting axis-ycutaway] \
2304            -variable [itcl::scope _axis(ycutaway)]
2305    }
2306    Rappture::Tooltip::for $itk_component(yCutButton) \
2307        "Toggle the Y-axis cutaway on/off"
2308
2309    itk_component add yCutScale {
2310        ::scale $inner.yval -from 100 -to 0 \
2311            -width 10 -orient vertical -showvalue yes \
2312            -borderwidth 1 -highlightthickness 0 \
2313            -command [itcl::code $this Slice move y] \
2314            -variable [itcl::scope _axis(yposition)]
2315    } {
2316        usual
2317        ignore -borderwidth -highlightthickness
2318    }
2319    Rappture::Tooltip::for $itk_component(yCutScale) \
2320        "@[itcl::code $this Slice tooltip y]"
2321    # Set the default cutaway value before disabling the scale.
2322    $itk_component(yCutScale) set 100
2323    $itk_component(yCutScale) configure -state disabled
2324
2325    itk_component add yDirButton {
2326        Rappture::PushButton $inner.ydir \
2327            -onimage [Rappture::icon arrow-down] \
2328            -onvalue -1 \
2329            -offimage [Rappture::icon arrow-up] \
2330            -offvalue 1 \
2331            -command [itcl::code $this AdjustSetting axis-ydirection] \
2332            -variable [itcl::scope _axis(ydirection)]
2333    }
2334    Rappture::Tooltip::for $itk_component(yDirButton) \
2335        "Toggle the direction of the Y-axis cutaway"
2336    set _axis(ydirection) -1
2337
2338    # Z-value slicer...
2339    itk_component add zCutButton {
2340        Rappture::PushButton $inner.zbutton \
2341            -onimage [Rappture::icon z-cutplane] \
2342            -offimage [Rappture::icon z-cutplane] \
2343            -command [itcl::code $this AdjustSetting axis-zcutaway] \
2344            -variable [itcl::scope _axis(zcutaway)]
2345    }
2346    Rappture::Tooltip::for $itk_component(zCutButton) \
2347        "Toggle the Z-axis cutaway on/off"
2348
2349    itk_component add zCutScale {
2350        ::scale $inner.zval -from 100 -to 0 \
2351            -width 10 -orient vertical -showvalue yes \
2352            -borderwidth 1 -highlightthickness 0 \
2353            -command [itcl::code $this Slice move z] \
2354            -variable [itcl::scope _axis(zposition)]
2355    } {
2356        usual
2357        ignore -borderwidth -highlightthickness
2358    }
2359    $itk_component(zCutScale) set 100
2360    $itk_component(zCutScale) configure -state disabled
2361    Rappture::Tooltip::for $itk_component(zCutScale) \
2362        "@[itcl::code $this Slice tooltip z]"
2363
2364    itk_component add zDirButton {
2365        Rappture::PushButton $inner.zdir \
2366            -onimage [Rappture::icon arrow-down] \
2367            -onvalue -1 \
2368            -offimage [Rappture::icon arrow-up] \
2369            -offvalue 1 \
2370            -command [itcl::code $this AdjustSetting axis-zdirection] \
2371            -variable [itcl::scope _axis(zdirection)]
2372    }
2373    set _axis(zdirection) -1
2374    Rappture::Tooltip::for $itk_component(zDirButton) \
2375        "Toggle the direction of the Z-axis cutaway"
2376
2377    blt::table $inner \
2378        0,0 $itk_component(xCutButton)  -anchor e -padx 2 -pady 2 \
2379        1,0 $itk_component(xCutScale)   -fill y \
2380        0,1 $itk_component(yCutButton)  -anchor e -padx 2 -pady 2 \
2381        1,1 $itk_component(yCutScale)   -fill y \
2382        0,2 $itk_component(zCutButton)  -anchor e -padx 2 -pady 2 \
2383        1,2 $itk_component(zCutScale)   -fill y \
2384
2385    blt::table configure $inner r* c* -resize none
2386    blt::table configure $inner r1 c3 -resize expand
2387}
2388
2389itcl::body Rappture::VtkViewer::BuildMoleculeTab {} {
2390    set fg [option get $itk_component(hull) font Font]
2391
2392    set inner [$itk_component(main) insert 0 \
2393        -title "Molecule Settings" \
2394        -icon [Rappture::icon molecule]]
2395    $inner configure -borderwidth 4
2396
2397    checkbutton $inner.molecule \
2398        -text "Show Molecule" \
2399        -variable [itcl::scope _settings(molecule-visible)] \
2400        -command [itcl::code $this AdjustSetting molecule-visible] \
2401        -font "Arial 9"
2402
2403    checkbutton $inner.outline \
2404        -text "Show Outline" \
2405        -variable [itcl::scope _settings(molecule-outline)] \
2406        -command [itcl::code $this AdjustSetting molecule-outline] \
2407        -font "Arial 9"
2408
2409    checkbutton $inner.label \
2410        -text "Show Atom Labels" \
2411        -variable [itcl::scope _settings(molecule-labels)] \
2412        -command [itcl::code $this AdjustSetting molecule-labels] \
2413        -font "Arial 9"
2414
2415    checkbutton $inner.wireframe \
2416        -text "Show Wireframe" \
2417        -variable [itcl::scope _settings(molecule-wireframe)] \
2418        -command [itcl::code $this AdjustSetting molecule-wireframe] \
2419        -font "Arial 9"
2420
2421    checkbutton $inner.lighting \
2422        -text "Enable Lighting" \
2423        -variable [itcl::scope _settings(molecule-lighting)] \
2424        -command [itcl::code $this AdjustSetting molecule-lighting] \
2425        -font "Arial 9"
2426
2427    checkbutton $inner.edges \
2428        -text "Show Edges" \
2429        -variable [itcl::scope _settings(molecule-edges)] \
2430        -command [itcl::code $this AdjustSetting molecule-edges] \
2431        -font "Arial 9"
2432
2433    label $inner.rep_l -text "Molecule Representation" \
2434        -font "Arial 9"
2435
2436    itk_component add representation {
2437        Rappture::Combobox $inner.rep -width 20 -editable no
2438    }
2439    $inner.rep choices insert end \
2440        "ballandstick"  "Ball and Stick" \
2441        "spheres"       "Spheres"        \
2442        "sticks"        "Sticks"         \
2443        "rods"          "Rods"           \
2444        "wireframe"     "Wireframe"      \
2445        "spacefilling"  "Space Filling"
2446
2447    bind $inner.rep <<Value>> \
2448        [itcl::code $this AdjustSetting molecule-representation]
2449    $inner.rep value "Ball and Stick"
2450
2451    label $inner.rscale_l -text "Atom Radii" \
2452        -font "Arial 9"
2453
2454    itk_component add rscale {
2455        Rappture::Combobox $inner.rscale -width 20 -editable no
2456    }
2457    $inner.rscale choices insert end \
2458        "atomic"        "Atomic"   \
2459        "covalent"      "Covalent" \
2460        "van_der_waals" "VDW"      \
2461        "none"          "Constant"
2462
2463    bind $inner.rscale <<Value>> \
2464        [itcl::code $this AdjustSetting molecule-rscale]
2465    $inner.rscale value "Covalent"
2466
2467    label $inner.palette_l -text "Palette" -font "Arial 9"
2468    itk_component add moleculepalette {
2469        Rappture::Combobox $inner.palette -width 10 -editable no
2470    }
2471    $inner.palette choices insert end [GetColormapList -includeElementDefault]
2472    $itk_component(moleculepalette) value "elementDefault"
2473    bind $inner.palette <<Value>> \
2474        [itcl::code $this AdjustSetting molecule-palette]
2475
2476    label $inner.atomscale_l -text "Atom Scale" -font "Arial 9"
2477    ::scale $inner.atomscale -width 15 -font "Arial 7" \
2478        -from 0.025 -to 2.0 -resolution 0.025 -label "" \
2479        -showvalue true -orient horizontal \
2480        -command [itcl::code $this EventuallySetAtomScale] \
2481        -variable [itcl::scope _settings(molecule-atomscale)]
2482    $inner.atomscale set $_settings(molecule-atomscale)
2483    Rappture::Tooltip::for $inner.atomscale \
2484        "Adjust relative scale of atoms (spheres or balls)."
2485
2486    label $inner.bondscale_l -text "Bond Scale" -font "Arial 9"
2487    ::scale $inner.bondscale -width 15 -font "Arial 7" \
2488        -from 0.005 -to 0.3 -resolution 0.005 -label "" \
2489        -showvalue true -orient horizontal \
2490        -command [itcl::code $this EventuallySetBondScale] \
2491        -variable [itcl::scope _settings(molecule-bondscale)]
2492    Rappture::Tooltip::for $inner.bondscale \
2493        "Adjust scale of bonds (sticks)."
2494    $inner.bondscale set $_settings(molecule-bondscale)
2495
2496    label $inner.opacity_l -text "Opacity" -font "Arial 9"
2497    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
2498        -variable [itcl::scope _settings(molecule-opacity)] \
2499        -width 15 -font "Arial 7" \
2500        -showvalue on \
2501        -command [itcl::code $this EventuallySetMoleculeOpacity]
2502
2503    label $inner.quality_l -text "Quality" -font "Arial 9"
2504    ::scale $inner.quality -width 15 -font "Arial 7" \
2505        -from 0.0 -to 10.0 -resolution 0.1 -label "" \
2506        -showvalue true -orient horizontal \
2507        -command [itcl::code $this EventuallySetMoleculeQuality] \
2508        -variable [itcl::scope _settings(molecule-quality)]
2509    Rappture::Tooltip::for $inner.quality \
2510        "Adjust tesselation quality"
2511    $inner.quality set $_settings(molecule-quality)
2512
2513    blt::table $inner \
2514        0,0 $inner.molecule     -anchor w -pady {1 0} \
2515        1,0 $inner.outline      -anchor w -pady {1 0} \
2516        2,0 $inner.label        -anchor w -pady {1 0} \
2517        3,0 $inner.edges        -anchor w -pady {1 0} \
2518        4,0 $inner.rep_l        -anchor w -pady { 2 0 } \
2519        5,0 $inner.rep          -fill x    -pady 2 \
2520        6,0 $inner.rscale_l     -anchor w -pady { 2 0 } \
2521        7,0 $inner.rscale       -fill x    -pady 2 \
2522        8,0 $inner.palette_l    -anchor w  -pady 0 \
2523        9,0 $inner.palette      -fill x    -padx 2 \
2524        10,0 $inner.atomscale_l  -anchor w -pady {3 0} \
2525        11,0 $inner.atomscale   -fill x    -padx 2 \
2526        12,0 $inner.bondscale_l -anchor w -pady {3 0} \
2527        13,0 $inner.bondscale   -fill x   -padx 2 \
2528        14,0 $inner.opacity_l   -anchor w -pady {3 0} \
2529        15,0 $inner.opacity     -fill x    -padx 2 \
2530        16,0 $inner.quality_l   -anchor w -pady {3 0} \
2531        17,0 $inner.quality     -fill x    -padx 2
2532   
2533    blt::table configure $inner r* -resize none
2534    blt::table configure $inner r18 -resize expand
2535}
2536
2537#
2538#  camera --
2539#
2540itcl::body Rappture::VtkViewer::camera {option args} {
2541    switch -- $option {
2542        "show" {
2543            puts [array get _view]
2544        }
2545        "set" {
2546            set who [lindex $args 0]
2547            set x $_view($who)
2548            set code [catch { string is double $x } result]
2549            if { $code != 0 || !$result } {
2550                return
2551            }
2552            switch -- $who {
2553                "ortho" {
2554                    if {$_view(ortho)} {
2555                        SendCmd "camera mode ortho"
2556                    } else {
2557                        SendCmd "camera mode persp"
2558                    }
2559                }
2560                "xpan" - "ypan" {
2561                    PanCamera
2562                }
2563                "qx" - "qy" - "qz" - "qw" {
2564                    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
2565                    $_arcball quaternion $q
2566                    EventuallyRotate $q
2567                }
2568                "zoom" {
2569                    SendCmd "camera zoom $_view(zoom)"
2570                }
2571            }
2572        }
2573    }
2574}
2575
2576itcl::body Rappture::VtkViewer::GetVtkData { args } {
2577    set bytes ""
2578    foreach dataobj [get] {
2579        foreach comp [$dataobj components] {
2580            set tag $dataobj-$comp
2581            set contents [$dataobj data $comp]
2582            append bytes "$contents\n"
2583        }
2584    }
2585    return [list .vtk $bytes]
2586}
2587
2588itcl::body Rappture::VtkViewer::GetImage { args } {
2589    if { [image width $_image(download)] > 0 &&
2590         [image height $_image(download)] > 0 } {
2591        set bytes [$_image(download) data -format "jpeg -quality 100"]
2592        set bytes [Rappture::encoding::decode -as b64 $bytes]
2593        return [list .jpg $bytes]
2594    }
2595    return ""
2596}
2597
2598itcl::body Rappture::VtkViewer::BuildDownloadPopup { popup command } {
2599    Rappture::Balloon $popup \
2600        -title "[Rappture::filexfer::label downloadWord] as..."
2601    set inner [$popup component inner]
2602    label $inner.summary -text "" -anchor w
2603    radiobutton $inner.vtk_button -text "VTK data file" \
2604        -variable [itcl::scope _downloadPopup(format)] \
2605        -font "Helvetica 9 " \
2606        -value vtk 
2607    Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
2608    radiobutton $inner.image_button -text "Image File" \
2609        -variable [itcl::scope _downloadPopup(format)] \
2610        -value image
2611    Rappture::Tooltip::for $inner.image_button \
2612        "Save as digital image."
2613
2614    button $inner.ok -text "Save" \
2615        -highlightthickness 0 -pady 2 -padx 3 \
2616        -command $command \
2617        -compound left \
2618        -image [Rappture::icon download]
2619
2620    button $inner.cancel -text "Cancel" \
2621        -highlightthickness 0 -pady 2 -padx 3 \
2622        -command [list $popup deactivate] \
2623        -compound left \
2624        -image [Rappture::icon cancel]
2625
2626    blt::table $inner \
2627        0,0 $inner.summary -cspan 2  \
2628        1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
2629        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
2630        4,1 $inner.cancel -width .9i -fill y \
2631        4,0 $inner.ok -padx 2 -width .9i -fill y
2632    blt::table configure $inner r3 -height 4
2633    blt::table configure $inner r4 -pady 4
2634    raise $inner.image_button
2635    $inner.vtk_button invoke
2636    return $inner
2637}
2638
2639itcl::body Rappture::VtkViewer::SetObjectStyle { dataobj comp } {
2640    # Parse style string.
2641    set tag $dataobj-$comp
2642    set type [$dataobj type $comp]
2643    set style [$dataobj style $comp]
2644    if { $dataobj != $_first } {
2645        set settings(-wireframe) 1
2646    }
2647    switch -- $type {
2648        "glyphs" {
2649            array set settings {
2650                -color white
2651                -edgecolor black
2652                -edges 0
2653                -gscale 1
2654                -lighting 1
2655                -linewidth 1.0
2656                -normscale 0
2657                -opacity 1.0
2658                -orientGlyphs 0
2659                -outline 0
2660                -ptsize 1.0
2661                -quality 1
2662                -scaleMode "vcomp"
2663                -shape "sphere"
2664                -visible 1
2665                -wireframe 0
2666            }
2667            array set settings $style
2668            set shape [$dataobj shape $comp]
2669            if {$shape != ""} {
2670                set settings(-shape) $shape
2671            }
2672            SendCmd "outline add $tag"
2673            SendCmd "outline color [Color2RGB $settings(-color)] $tag"
2674            SendCmd "outline visible $settings(-outline) $tag"
2675            set _settings(glyphs-outline) $settings(-outline)
2676
2677            SendCmd "glyphs add $settings(-shape) $tag"
2678            SendCmd "glyphs normscale $settings(-normscale) $tag"
2679            SendCmd "glyphs gscale $settings(-gscale) $tag"
2680            SendCmd "glyphs wireframe $settings(-wireframe) $tag"
2681            SendCmd "glyphs color [Color2RGB $settings(-color)] $tag"
2682            #SendCmd "glyphs colormode constant {} $tag"
2683            # Omitting field name for gorient and smode commands
2684            # defaults to active scalars or vectors depending on mode
2685            SendCmd "glyphs gorient $settings(-orientGlyphs) {} $tag"
2686            SendCmd "glyphs smode $settings(-scaleMode) {} $tag"
2687            SendCmd "glyphs edges $settings(-edges) $tag"
2688            SendCmd "glyphs linecolor [Color2RGB $settings(-edgecolor)] $tag"
2689            SendCmd "glyphs linewidth $settings(-linewidth) $tag"
2690            SendCmd "glyphs ptsize $settings(-ptsize) $tag"
2691            SendCmd "glyphs quality $settings(-quality) $tag"
2692            SendCmd "glyphs lighting $settings(-lighting) $tag"
2693            SendCmd "glyphs opacity $settings(-opacity) $tag"
2694            set _settings(glyphs-opacity) [expr 100.0 * $settings(-opacity)]
2695            SendCmd "glyphs visible $settings(-visible) $tag"
2696            set _settings(glyphs-wireframe) $settings(-wireframe)
2697        }
2698        "molecule" {
2699            array set settings {
2700                -atomscale 0.3
2701                -atomsvisible 1
2702                -bondscale 0.075
2703                -bondstyle "cylinder"
2704                -bondsvisible 1
2705                -color "elementDefault"
2706                -edgecolor black
2707                -edges 0
2708                -labels 0
2709                -lighting 1
2710                -linewidth 1.0
2711                -opacity 1.0
2712                -outline 0
2713                -quality 1.0
2714                -representation ""
2715                -rscale "covalent"
2716                -visible 1
2717                -wireframe 0
2718            }
2719            array set settings $style
2720
2721            SendCmd "outline add $tag"
2722            SendCmd "outline color [Color2RGB white] $tag"
2723            SendCmd "outline visible $settings(-outline) $tag"
2724            set _settings(molecule-outline) $settings(-outline)
2725
2726            SendCmd "molecule add $tag"
2727            if {$settings(-representation) != ""} {
2728                switch -- $settings(-representation) {
2729                    "ballandstick" {
2730                        set _settings(molecule-rscale) covalent
2731                        set _settings(molecule-atoms-visible) 1
2732                        set _settings(molecule-bonds-visible) 1
2733                        set _settings(molecule-bondstyle) cylinder
2734                        set _settings(molecule-atomscale) 0.3
2735                        set _settings(molecule-bondscale) 0.075
2736                    }
2737                    "balls" - "spheres" {
2738                        set _settings(molecule-rscale) covalent
2739                        set _settings(molecule-atoms-visible) 1
2740                        set _settings(molecule-bonds-visible) 0
2741                        set _settings(molecule-bondstyle) cylinder
2742                        set _settings(molecule-atomscale) 0.3
2743                        set _settings(molecule-bondscale) 0.075
2744                    }
2745                    "sticks" {
2746                        set _settings(molecule-rscale) none
2747                        set _settings(molecule-atoms-visible) 1
2748                        set _settings(molecule-bonds-visible) 1
2749                        set _settings(molecule-bondstyle) cylinder
2750                        set _settings(molecule-atomscale) 0.075
2751                        set _settings(molecule-bondscale) 0.075
2752                    }
2753                    "spacefilling" {
2754                        set _settings(molecule-rscale) van_der_waals
2755                        set _settings(molecule-atoms-visible) 1
2756                        set _settings(molecule-bonds-visible) 0
2757                        set _settings(molecule-bondstyle) cylinder
2758                        set _settings(molecule-atomscale) 1.0
2759                        set _settings(molecule-bondscale) 0.075
2760                    }
2761                    "rods"  {
2762                        set _settings(molecule-rscale) none
2763                        set _settings(molecule-atoms-visible) 1
2764                        set _settings(molecule-bonds-visible) 1
2765                        set _settings(molecule-bondstyle) cylinder
2766                        set _settings(molecule-atomscale) 0.1
2767                        set _settings(molecule-bondscale) 0.1
2768                    }
2769                    "wireframe" - "lines" {
2770                        set _settings(molecule-rscale) none
2771                        set _settings(molecule-atoms-visible) 0
2772                        set _settings(molecule-bonds-visible) 1
2773                        set _settings(molecule-bondstyle) line
2774                        set _settings(molecule-atomscale) 1.0
2775                        set _settings(molecule-bondscale) 1.0
2776                    }
2777                    default {
2778                        error "unknown representation $value"
2779                    }
2780                }
2781                SendCmd "molecule rscale $_settings(molecule-rscale) $tag"
2782                SendCmd "molecule atoms $_settings(molecule-atoms-visible) $tag"
2783                SendCmd "molecule bonds $_settings(molecule-bonds-visible) $tag"
2784                SendCmd "molecule bstyle $_settings(molecule-bondstyle) $tag"
2785                SendCmd "molecule ascale $_settings(molecule-atomscale) $tag"
2786                SendCmd "molecule bscale $_settings(molecule-bondscale) $tag"
2787                $itk_component(representation) value [$itk_component(representation) label $settings(-representation)]
2788                $itk_component(rscale) value [$itk_component(rscale) label $_settings(molecule-rscale)]
2789                switch -- $settings(-representation) {
2790                    "ballandstick" - "balls" - "spheres" {
2791                        $itk_component(rscale) configure -state normal
2792                    }
2793                    default {
2794                        $itk_component(rscale) configure -state disabled
2795                    }
2796                }
2797            } else {
2798                SendCmd "molecule rscale $settings(-rscale) $tag"
2799                set _settings(molecule-rscale) $settings(-rscale)
2800                SendCmd "molecule atoms $settings(-atomsvisible) $tag"
2801                set _settings(molecule-atoms-visible) $settings(-atomsvisible)
2802                SendCmd "molecule bonds $settings(-bondsvisible) $tag"
2803                set _settings(molecule-bonds-visible) $settings(-bondsvisible)
2804                SendCmd "molecule bstyle $settings(-bondstyle) $tag"
2805                set _settings(molecule-bondstyle) $settings(-bondstyle)
2806                SendCmd "molecule ascale $settings(-atomscale) $tag"
2807                set _settings(molecule-atomscale) $settings(-atomscale)
2808                SendCmd "molecule bscale $settings(-bondscale) $tag"
2809                set _settings(molecule-bondscale) $settings(-bondscale)
2810            }
2811            SendCmd "molecule labels $settings(-labels) $tag"
2812            set _settings(molecule-labels) $settings(-labels)
2813            SendCmd "molecule linecolor [Color2RGB $settings(-edgecolor)] $tag"
2814            SendCmd "molecule linewidth $settings(-linewidth) $tag"
2815            SendCmd "molecule edges $settings(-edges) $tag"
2816            set _settings(molecule-edges) $settings(-edges)
2817            SendCmd "molecule lighting $settings(-lighting) $tag"
2818            set _settings(molecule-lighting) $settings(-lighting)
2819            SendCmd "molecule aquality $settings(-quality) $tag"
2820            SendCmd "molecule bquality $settings(-quality) $tag"
2821            set _settings(molecule-quality) $settings(-quality)
2822            SendCmd "molecule visible $settings(-visible) $tag"
2823            set _settings(molecule-visible) $settings(-visible)
2824            set _haveMolecules 1
2825        }
2826        "polydata" {
2827            array set settings {
2828                -cloudstyle "mesh"
2829                -color white
2830                -edgecolor black
2831                -edges 1
2832                -lighting 1
2833                -linewidth 1.0
2834                -opacity 1.0
2835                -outline 0
2836                -visible 1
2837                -wireframe 0
2838            }
2839            array set settings $style
2840
2841            SendCmd "outline add $tag"
2842            SendCmd "outline color [Color2RGB $settings(-color)] $tag"
2843            SendCmd "outline visible $settings(-outline) $tag"
2844            set _settings(polydata-outline) $settings(-outline)
2845
2846            SendCmd "polydata add $tag"
2847            SendCmd "polydata visible $settings(-visible) $tag"
2848            set _settings(polydata-visible) $settings(-visible)
2849            SendCmd "polydata edges $settings(-edges) $tag"
2850            set _settings(polydata-edges) $settings(-edges)
2851            SendCmd "polydata cloudstyle $settings(-cloudstyle) $tag"
2852            SendCmd "polydata color [Color2RGB $settings(-color)] $tag"
2853            #SendCmd "polydata colormode constant {} $tag"
2854            SendCmd "polydata lighting $settings(-lighting) $tag"
2855            set _settings(polydata-lighting) $settings(-lighting)
2856            SendCmd "polydata linecolor [Color2RGB $settings(-edgecolor)] $tag"
2857            SendCmd "polydata linewidth $settings(-linewidth) $tag"
2858            SendCmd "polydata opacity $settings(-opacity) $tag"
2859            set _settings(polydata-opacity) [expr 100.0 * $settings(-opacity)]
2860            SendCmd "polydata wireframe $settings(-wireframe) $tag"
2861            set _settings(polydata-wireframe) $settings(-wireframe)
2862            set havePolyData 1
2863        }
2864    }
2865    SetColormap $dataobj $comp
2866}
2867
2868itcl::body Rappture::VtkViewer::IsValidObject { dataobj } {
2869    if {[catch {$dataobj isa Rappture::Drawing} valid] != 0 || !$valid} {
2870        return 0
2871    }
2872    return 1
2873}
2874
2875# ----------------------------------------------------------------------
2876# USAGE: ReceiveLegend <colormap> <title> <vmin> <vmax> <size>
2877#
2878# Invoked automatically whenever the "legend" command comes in from
2879# the rendering server.  Indicates that binary image data with the
2880# specified <size> will follow.
2881# ----------------------------------------------------------------------
2882itcl::body Rappture::VtkViewer::ReceiveLegend { colormap title vmin vmax size } {
2883    set _limits(vmin) $vmin
2884    set _limits(vmax) $vmax
2885    set _title $title
2886    if { [IsConnected] } {
2887        set bytes [ReceiveBytes $size]
2888        if { ![info exists _image(legend)] } {
2889            set _image(legend) [image create photo]
2890        }
2891        $_image(legend) configure -data $bytes
2892        DrawLegend
2893    }
2894}
2895
2896#
2897# DrawLegend --
2898#
2899#       Draws the legend in it's own canvas which resides to the right
2900#       of the contour plot area.
2901#
2902itcl::body Rappture::VtkViewer::DrawLegend {} {
2903    set c $itk_component(view)
2904    set w [winfo width $c]
2905    set h [winfo height $c]
2906    set font "Arial 8"
2907    set lineht [font metrics $font -linespace]
2908   
2909    if { $_settings(legend) } {
2910        set x [expr $w - 2]
2911        if { [$c find withtag "legend"] == "" } {
2912            $c create image $x [expr {$lineht+2}] \
2913                -anchor ne \
2914                -image $_image(legend) -tags "colormap legend"
2915            $c create text $x 2 \
2916                -anchor ne \
2917                -fill $itk_option(-plotforeground) -tags "vmax legend" \
2918                -font $font
2919            $c create text $x [expr {$h-2}] \
2920                -anchor se \
2921                -fill $itk_option(-plotforeground) -tags "vmin legend" \
2922                -font $font
2923            #$c bind colormap <Enter> [itcl::code $this EnterLegend %x %y]
2924            $c bind colormap <Leave> [itcl::code $this LeaveLegend]
2925            $c bind colormap <Motion> [itcl::code $this MotionLegend %x %y]
2926        }
2927        # Reset the item coordinates according the current size of the plot.
2928        $c coords colormap $x [expr {$lineht+2}]
2929        if { $_limits(vmin) != "" } {
2930            $c itemconfigure vmin -text [format %g $_limits(vmin)]
2931        }
2932        if { $_limits(vmax) != "" } {
2933            $c itemconfigure vmax -text [format %g $_limits(vmax)]
2934        }
2935        $c coords vmin $x [expr {$h-2}]
2936        $c coords vmax $x 2
2937    }
2938}
2939
2940#
2941# EnterLegend --
2942#
2943itcl::body Rappture::VtkViewer::EnterLegend { x y } {
2944    SetLegendTip $x $y
2945}
2946
2947#
2948# MotionLegend --
2949#
2950itcl::body Rappture::VtkViewer::MotionLegend { x y } {
2951    Rappture::Tooltip::tooltip cancel
2952    set c $itk_component(view)
2953    SetLegendTip $x $y
2954}
2955
2956#
2957# LeaveLegend --
2958#
2959itcl::body Rappture::VtkViewer::LeaveLegend { } {
2960    Rappture::Tooltip::tooltip cancel
2961    .rappturetooltip configure -icon ""
2962}
2963
2964#
2965# SetLegendTip --
2966#
2967itcl::body Rappture::VtkViewer::SetLegendTip { x y } {
2968    set c $itk_component(view)
2969    set w [winfo width $c]
2970    set h [winfo height $c]
2971    set font "Arial 8"
2972    set lineht [font metrics $font -linespace]
2973   
2974    set imgHeight [image height $_image(legend)]
2975    set coords [$c coords colormap]
2976    set imgX [expr $w - [image width $_image(legend)] - 2]
2977    set imgY [expr $y - $lineht - 2]
2978
2979    # Make a swatch of the selected color
2980    if { [catch { $_image(legend) get 10 $imgY } pixel] != 0 } {
2981        return
2982    }
2983    if { ![info exists _image(swatch)] } {
2984        set _image(swatch) [image create photo -width 24 -height 24]
2985    }
2986    set color [eval format "\#%02x%02x%02x" $pixel]
2987    $_image(swatch) put black  -to 0 0 23 23
2988    $_image(swatch) put $color -to 1 1 22 22
2989    .rappturetooltip configure -icon $_image(swatch)
2990
2991    # Compute the value of the point
2992    set t [expr 1.0 - (double($imgY) / double($imgHeight-1))]
2993    set value [expr $t * ($_limits(vmax) - $_limits(vmin)) + $_limits(vmin)]
2994    set tipx [expr $x + 15]
2995    set tipy [expr $y - 5]
2996    Rappture::Tooltip::text $c "$_title $value"
2997    Rappture::Tooltip::tooltip show $c +$tipx,+$tipy   
2998}
2999
3000# ----------------------------------------------------------------------
3001# USAGE: Slice move x|y|z <newval>
3002#
3003# Called automatically when the user drags the slider to move the
3004# cut plane that slices 3D data.  Gets the current value from the
3005# slider and moves the cut plane to the appropriate point in the
3006# data set.
3007# ----------------------------------------------------------------------
3008itcl::body Rappture::VtkViewer::Slice {option args} {
3009    switch -- $option {
3010        "move" {
3011            set axis [lindex $args 0]
3012            set newval [lindex $args 1]
3013            if {[llength $args] != 2} {
3014                error "wrong # args: should be \"Slice move x|y|z newval\""
3015            }
3016            set newpos [expr {0.01*$newval}]
3017            SendCmd "renderer clipplane $axis $newpos -1"
3018        }
3019        "tooltip" {
3020            set axis [lindex $args 0]
3021            set val [$itk_component(${axis}CutScale) get]
3022            return "Move the [string toupper $axis] cut plane.\nCurrently:  $axis = $val%"
3023        }
3024        default {
3025            error "bad option \"$option\": should be axis, move, or tooltip"
3026        }
3027    }
3028}
3029
3030itcl::body Rappture::VtkViewer::SetOrientation { side } {
3031    array set positions {
3032        front "1 0 0 0"
3033        back  "0 0 1 0"
3034        left  "0.707107 0 -0.707107 0"
3035        right "0.707107 0 0.707107 0"
3036        top   "0.707107 -0.707107 0 0"
3037        bottom "0.707107 0.707107 0 0"
3038    }
3039    foreach name { qw qx qy qz } value $positions($side) {
3040        set _view($name) $value
3041    }
3042    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
3043    $_arcball quaternion $q
3044    SendCmd "camera orient $q"
3045    SendCmd "camera reset"
3046    set _view(xpan) 0
3047    set _view(ypan) 0
3048    set _view(zoom) 1.0
3049}
3050
3051itcl::body Rappture::VtkViewer::SetOpacity { dataset } {
3052    foreach {dataobj comp} [split $dataset -] break
3053    set type [$dataobj type $comp]
3054    set val $_settings($type-opacity)
3055    set sval [expr { 0.01 * double($val) }]
3056    if { !$_obj2ovride($dataobj-raise) } {
3057        # This is wrong.  Need to figure out why raise isn't set with 1
3058        #set sval [expr $sval * .6]
3059    }
3060    SendCmd "$type opacity $sval $dataset"
3061}
Note: See TracBrowser for help on using the repository browser.