source: trunk/gui/scripts/vtkviewer2.tcl @ 2385

Last change on this file since 2385 was 2385, checked in by gah, 13 years ago
File size: 48.5 KB
Line 
1
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-2005  Purdue Research Foundation
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 { colormap }
60    public method sendto { string }
61    public method parameters {title args} {
62        # do nothing
63    }
64    public method scale {args}
65
66    protected method Connect {}
67    protected method CurrentDatasets {args}
68    protected method Disconnect {}
69    protected method DoResize {}
70    protected method FixSettings {what {value ""}}
71    protected method Pan {option x y}
72    protected method Rebuild {}
73    protected method ReceiveDataset { args }
74    protected method ReceiveImage { args }
75    protected method Rotate {option x y}
76    protected method SendCmd {string}
77    protected method Zoom {option}
78
79    # The following methods are only used by this class.
80    private method BuildCameraTab {}
81    private method BuildViewTab {}
82    private method BuildAxisTab {}
83    private method BuildColormap { colormap dataobj comp }
84    private method EventuallyResize { w h }
85    private method SetStyles { dataobj comp }
86    private method PanCamera {}
87    private method ConvertToVtkData { dataobj comp }
88    private method GetImage { args }
89    private method GetVtkData { args }
90    private method BuildDownloadPopup { widget command }
91    private method SetObjectStyle { dataobj comp }
92    private method IsValidObject { dataobj }
93
94    private variable _arcball ""
95    private variable _outbuf       ;# buffer for outgoing commands
96
97    private variable _dlist ""     ;# list of data objects
98    private variable _allDataObjs
99    private variable _obj2datasets
100    private variable _obj2ovride   ;# maps dataobj => style override
101    private variable _datasets     ;# contains all the dataobj-component
102                                   ;# datasets in the server
103    private variable _colormaps    ;# contains all the colormaps
104                                   ;# in the server.
105    private variable _dataset2style    ;# maps dataobj-component to transfunc
106    private variable _style2datasets   ;# maps tf back to list of
107                                    # dataobj-components using the tf.
108
109    private variable _click        ;# info used for rotate operations
110    private variable _limits       ;# autoscale min/max for all axes
111    private variable _view         ;# view params for 3D view
112    private common   _settings
113    private variable _reset 1      ;# indicates if camera needs to be reset
114                                    # to starting position.
115
116    # Array of transfer functions in server.  If 0 the transfer has been
117    # defined but not loaded.  If 1 the transfer function has been named
118    # and loaded.
119    private variable _first ""     ;# This is the topmost dataset.
120    private variable _start 0
121    private variable _buffering 0
122   
123    # This indicates which isomarkers and transfer function to use when
124    # changing markers, opacity, or thickness.
125    common _downloadPopup          ;# download options from popup
126    private common _hardcopy
127    private variable _width 0
128    private variable _height 0
129    private variable _resizePending 0
130    private variable _outline
131}
132
133itk::usual VtkViewer {
134    keep -background -foreground -cursor -font
135    keep -plotbackground -plotforeground
136}
137
138# ----------------------------------------------------------------------
139# CONSTRUCTOR
140# ----------------------------------------------------------------------
141itcl::body Rappture::VtkViewer::constructor {hostlist args} {
142    if {[catch {info level -1} caller]} {
143        puts stderr "Enter constructor"
144    } else {
145        puts stderr "Enter constructor: $caller"
146    }
147
148    # Rebuild event
149    $_dispatcher register !rebuild
150    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
151
152    # Resize event
153    $_dispatcher register !resize
154    $_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
155
156    set _outbuf ""
157
158    #
159    # Populate parser with commands handle incoming requests
160    #
161    $_parser alias image [itcl::code $this ReceiveImage]
162    $_parser alias dataset [itcl::code $this ReceiveDataset]
163
164    array set _outline {
165        id -1
166        afterId -1
167        x1 -1
168        y1 -1
169        x2 -1
170        y2 -1
171    }
172    # Initialize the view to some default parameters.
173    array set _view {
174        qx              0
175        qy              0
176        qz              0
177        qw              1
178        zoom            1.0
179        pan-x           0
180        pan-y           0
181        zoom-x          1.0
182        zoom-y          1.0
183    }
184    set _arcball [blt::arcball create 100 100]
185    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
186    $_arcball quaternion $q
187
188    set _limits(vmin) 0.0
189    set _limits(vmax) 1.0
190
191    array set _settings [subst {
192        $this-axes              1
193        $this-edges             1
194        $this-lighting          1
195        $this-opacity           1
196        $this-volume            1
197        $this-wireframe         0
198        $this-grid-x            0
199        $this-grid-y            0
200        $this-grid-z            0
201    }]
202
203    itk_component add view {
204        canvas $itk_component(plotarea).view \
205            -highlightthickness 0 -borderwidth 0
206    } {
207        usual
208        ignore -highlightthickness -borderwidth  -background
209    }
210
211    set c $itk_component(view)
212    bind $c <Configure> [itcl::code $this EventuallyResize %w %h]
213    bind $c <4> [itcl::code $this Zoom in 0.25]
214    bind $c <5> [itcl::code $this Zoom out 0.25]
215    bind $c <KeyPress-Left>  [list %W xview scroll 10 units]
216    bind $c <KeyPress-Right> [list %W xview scroll -10 units]
217    bind $c <KeyPress-Up>    [list %W yview scroll 10 units]
218    bind $c <KeyPress-Down>  [list %W yview scroll -10 units]
219    bind $c <Enter> "focus %W"
220
221    # Fix the scrollregion in case we go off screen
222    $c configure -scrollregion [$c bbox all]
223
224    set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
225    set _map(cwidth) -1
226    set _map(cheight) -1
227    set _map(zoom) 1.0
228    set _map(original) ""
229
230    set f [$itk_component(main) component controls]
231    itk_component add reset {
232        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
233            -highlightthickness 0 \
234            -image [Rappture::icon reset-view] \
235            -command [itcl::code $this Zoom reset]
236    } {
237        usual
238        ignore -highlightthickness
239    }
240    pack $itk_component(reset) -side top -padx 2 -pady 2
241    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
242
243    itk_component add zoomin {
244        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
245            -highlightthickness 0 \
246            -image [Rappture::icon zoom-in] \
247            -command [itcl::code $this Zoom in]
248    } {
249        usual
250        ignore -highlightthickness
251    }
252    pack $itk_component(zoomin) -side top -padx 2 -pady 2
253    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
254
255    itk_component add zoomout {
256        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
257            -highlightthickness 0 \
258            -image [Rappture::icon zoom-out] \
259            -command [itcl::code $this Zoom out]
260    } {
261        usual
262        ignore -highlightthickness
263    }
264    pack $itk_component(zoomout) -side top -padx 2 -pady 2
265    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
266
267    BuildViewTab
268    BuildAxisTab
269    BuildCameraTab
270
271    # Hack around the Tk panewindow.  The problem is that the requested
272    # size of the 3d view isn't set until an image is retrieved from
273    # the server.  So the panewindow uses the tiny size.
274    set w 10000
275    pack forget $itk_component(view)
276    blt::table $itk_component(plotarea) \
277        0,0 $itk_component(view) -fill both -reqwidth $w
278    blt::table configure $itk_component(plotarea) c1 -resize none
279
280    # Bindings for rotation via mouse
281    bind $itk_component(view) <ButtonPress-1> \
282        [itcl::code $this Rotate click %x %y]
283    bind $itk_component(view) <B1-Motion> \
284        [itcl::code $this Rotate drag %x %y]
285    bind $itk_component(view) <ButtonRelease-1> \
286        [itcl::code $this Rotate release %x %y]
287    bind $itk_component(view) <Configure> \
288        [itcl::code $this EventuallyResize %w %h]
289
290    if 0 {
291    bind $itk_component(view) <Configure> \
292        [itcl::code $this EventuallyResize %w %h]
293    }
294    # Bindings for panning via mouse
295    bind $itk_component(view) <ButtonPress-2> \
296        [itcl::code $this Pan click %x %y]
297    bind $itk_component(view) <B2-Motion> \
298        [itcl::code $this Pan drag %x %y]
299    bind $itk_component(view) <ButtonRelease-2> \
300        [itcl::code $this Pan release %x %y]
301
302    # Bindings for panning via keyboard
303    bind $itk_component(view) <KeyPress-Left> \
304        [itcl::code $this Pan set -10 0]
305    bind $itk_component(view) <KeyPress-Right> \
306        [itcl::code $this Pan set 10 0]
307    bind $itk_component(view) <KeyPress-Up> \
308        [itcl::code $this Pan set 0 -10]
309    bind $itk_component(view) <KeyPress-Down> \
310        [itcl::code $this Pan set 0 10]
311    bind $itk_component(view) <Shift-KeyPress-Left> \
312        [itcl::code $this Pan set -2 0]
313    bind $itk_component(view) <Shift-KeyPress-Right> \
314        [itcl::code $this Pan set 2 0]
315    bind $itk_component(view) <Shift-KeyPress-Up> \
316        [itcl::code $this Pan set 0 -2]
317    bind $itk_component(view) <Shift-KeyPress-Down> \
318        [itcl::code $this Pan set 0 2]
319
320    # Bindings for zoom via keyboard
321    bind $itk_component(view) <KeyPress-Prior> \
322        [itcl::code $this Zoom out]
323    bind $itk_component(view) <KeyPress-Next> \
324        [itcl::code $this Zoom in]
325
326    bind $itk_component(view) <Enter> "focus $itk_component(view)"
327
328    if {[string equal "x11" [tk windowingsystem]]} {
329        # Bindings for zoom via mouse
330        bind $itk_component(view) <4> [itcl::code $this Zoom out]
331        bind $itk_component(view) <5> [itcl::code $this Zoom in]
332    }
333
334    set _image(download) [image create photo]
335
336    eval itk_initialize $args
337
338    Connect
339}
340
341# ----------------------------------------------------------------------
342# DESTRUCTOR
343# ----------------------------------------------------------------------
344itcl::body Rappture::VtkViewer::destructor {} {
345    Disconnect
346    $_dispatcher cancel !rebuild
347    $_dispatcher cancel !resize
348    image delete $_image(plot)
349    image delete $_image(download)
350    array unset _settings $this-*
351    catch { blt::arcball destroy $_arcball}
352}
353
354itcl::body Rappture::VtkViewer::DoResize {} {
355    if { $_width < 2 } {
356        set _width 500
357    }
358    if { $_height < 2 } {
359        set _height 500
360    }
361    puts stderr "screen size $_width $_height"
362    set _start [clock clicks -milliseconds]
363    SendCmd "screen size $_width $_height"
364    set _resizePending 0
365}
366
367itcl::body Rappture::VtkViewer::EventuallyResize { w h } {
368    puts stderr "EventuallyResize $w $h"
369    set _width $w
370    set _height $h
371    $_arcball resize $w $h
372    if { !$_resizePending } {
373        $_dispatcher event -after 400 !resize
374        set _resizePending 1
375    }
376}
377
378# ----------------------------------------------------------------------
379# USAGE: add <dataobj> ?<settings>?
380#
381# Clients use this to add a data object to the plot.  The optional
382# <settings> are used to configure the plot.  Allowed settings are
383# -color, -brightness, -width, -linestyle, and -raise.
384# ----------------------------------------------------------------------
385itcl::body Rappture::VtkViewer::add {dataobj {settings ""}} {
386    array set params {
387        -color auto
388        -width 1
389        -linestyle solid
390        -brightness 0
391        -raise 0
392        -description ""
393        -param ""
394        -type ""
395    }
396    array set params $settings
397    set params(-description) ""
398    set params(-param) ""
399    foreach {opt val} $settings {
400        if {![info exists params($opt)]} {
401            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
402        }
403        set params($opt) $val
404    }
405    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
406        # can't handle -autocolors yet
407        set params(-color) black
408    }
409    set pos [lsearch -exact $dataobj $_dlist]
410    if {$pos < 0} {
411        lappend _dlist $dataobj
412    }
413    set _allDataObjs($dataobj) 1
414    set _obj2ovride($dataobj-color) $params(-color)
415    set _obj2ovride($dataobj-width) $params(-width)
416    set _obj2ovride($dataobj-raise) $params(-raise)
417    $_dispatcher event -idle !rebuild
418}
419
420
421# ----------------------------------------------------------------------
422# USAGE: delete ?<dataobj1> <dataobj2> ...?
423#
424#       Clients use this to delete a dataobj from the plot.  If no dataobjs
425#       are specified, then all dataobjs are deleted.  No data objects are
426#       deleted.  They are only removed from the display list.
427#
428# ----------------------------------------------------------------------
429itcl::body Rappture::VtkViewer::delete {args} {
430    if { [llength $args] == 0} {
431        set args $_dlist
432    }
433    # Delete all specified dataobjs
434    set changed 0
435    foreach dataobj $args {
436        set pos [lsearch -exact $_dlist $dataobj]
437        if { $pos < 0 } {
438            continue;                   # Don't know anything about it.
439        }
440        # Remove it from the dataobj list.
441        set _dlist [lreplace $_dlist $pos $pos]
442        foreach comp [$dataobj components] {
443            SendCmd "dataset visible 0 $dataobj-$comp"
444        }
445        array unset _obj2ovride $dataobj-*
446        # Append to the end of the dataobj list.
447        lappend _dlist $dataobj
448        set changed 1
449    }
450    # If anything changed, then rebuild the plot
451    if { $changed } {
452        $_dispatcher event -idle !rebuild
453    }
454}
455
456# ----------------------------------------------------------------------
457# USAGE: get ?-objects?
458# USAGE: get ?-visible?
459# USAGE: get ?-image view?
460#
461# Clients use this to query the list of objects being plotted, in
462# order from bottom to top of this result.  The optional "-image"
463# flag can also request the internal images being shown.
464# ----------------------------------------------------------------------
465itcl::body Rappture::VtkViewer::get {args} {
466    if {[llength $args] == 0} {
467        set args "-objects"
468    }
469
470    set op [lindex $args 0]
471    switch -- $op {
472        "-objects" {
473            # put the dataobj list in order according to -raise options
474            set dlist {}
475            foreach dataobj $_dlist {
476                if { ![IsValidObject $dataobj] } {
477                    continue
478                }
479                if {[info exists _obj2ovride($dataobj-raise)] &&
480                    $_obj2ovride($dataobj-raise)} {
481                    set dlist [linsert $dlist 0 $dataobj]
482                } else {
483                    lappend dlist $dataobj
484                }
485            }
486            return $dlist
487        }
488        "-visible" {
489            set dlist {}
490            foreach dataobj $_dlist {
491                if { ![IsValidObject $dataobj] } {
492                    continue
493                }
494                if { ![info exists _obj2ovride($dataobj-raise)] } {
495                    # No setting indicates that the object isn't invisible.
496                    continue
497                }
498                # Otherwise use the -raise parameter to put the object to
499                # the front of the list.
500                if { $_obj2ovride($dataobj-raise) } {
501                    set dlist [linsert $dlist 0 $dataobj]
502                } else {
503                    lappend dlist $dataobj
504                }
505            }
506            return $dlist
507        }           
508        -image {
509            if {[llength $args] != 2} {
510                error "wrong # args: should be \"get -image view\""
511            }
512            switch -- [lindex $args end] {
513                view {
514                    return $_image(plot)
515                }
516                default {
517                    error "bad image name \"[lindex $args end]\": should be view"
518                }
519            }
520        }
521        default {
522            error "bad option \"$op\": should be -objects or -image"
523        }
524    }
525}
526
527# ----------------------------------------------------------------------
528# USAGE: scale ?<data1> <data2> ...?
529#
530# Sets the default limits for the overall plot according to the
531# limits of the data for all of the given <data> objects.  This
532# accounts for all objects--even those not showing on the screen.
533# Because of this, the limits are appropriate for all objects as
534# the user scans through data in the ResultSet viewer.
535# ----------------------------------------------------------------------
536itcl::body Rappture::VtkViewer::scale {args} {
537    array unset _limits
538    foreach dataobj $args {
539        array set bounds [limits $dataobj]
540        if {![info exists _limits(xmin)] || $_limits(xmin) > $bounds(xmin)} {
541            set _limits(xmin) $bounds(xmin)
542        }
543        if {![info exists _limits(xmax)] || $_limits(xmax) < $bounds(xmax)} {
544            set _limits(xmax) $bounds(xmax)
545        }
546
547        if {![info exists _limits(ymin)] || $_limits(ymin) > $bounds(ymin)} {
548            set _limits(ymin) $bounds(ymin)
549        }
550        if {![info exists _limits(ymax)] || $_limits(ymax) < $bounds(ymax)} {
551            set _limits(ymax) $bounds(ymax)
552        }
553
554        if {![info exists _limits(zmin)] || $_limits(zmin) > $bounds(zmin)} {
555            set _limits(zmin) $bounds(zmin)
556        }
557        if {![info exists _limits(zmax)] || $_limits(zmax) < $bounds(zmax)} {
558            set _limits(zmax) $bounds(zmax)
559        }
560    }
561}
562
563# ----------------------------------------------------------------------
564# USAGE: download coming
565# USAGE: download controls <downloadCommand>
566# USAGE: download now
567#
568# Clients use this method to create a downloadable representation
569# of the plot.  Returns a list of the form {ext string}, where
570# "ext" is the file extension (indicating the type of data) and
571# "string" is the data itself.
572# ----------------------------------------------------------------------
573itcl::body Rappture::VtkViewer::download {option args} {
574    switch $option {
575        coming {
576            if {[catch {
577                blt::winop snap $itk_component(plotarea) $_image(download)
578            }]} {
579                $_image(download) configure -width 1 -height 1
580                $_image(download) put #000000
581            }
582        }
583        controls {
584            set popup .vtkviewerdownload
585            if { ![winfo exists .vtkviewerdownload] } {
586                set inner [BuildDownloadPopup $popup [lindex $args 0]]
587            } else {
588                set inner [$popup component inner]
589            }
590            set _downloadPopup(image_controls) $inner.image_frame
591            set num [llength [get]]
592            set num [expr {($num == 1) ? "1 result" : "$num results"}]
593            set word [Rappture::filexfer::label downloadWord]
594            $inner.summary configure -text "$word $num in the following format:"
595            update idletasks            ;# Fix initial sizes
596            return $popup
597        }
598        now {
599            set popup .vtkviewerdownload
600            if {[winfo exists .vtkviewerdownload]} {
601                $popup deactivate
602            }
603            switch -- $_downloadPopup(format) {
604                "image" {
605                    return [$this GetImage [lindex $args 0]]
606                }
607                "vtk" {
608                    return [$this GetVtkData [lindex $args 0]]
609                }
610            }
611            return ""
612        }
613        default {
614            error "bad option \"$option\": should be coming, controls, now"
615        }
616    }
617}
618
619# ----------------------------------------------------------------------
620# USAGE: Connect ?<host:port>,<host:port>...?
621#
622# Clients use this method to establish a connection to a new
623# server, or to reestablish a connection to the previous server.
624# Any existing connection is automatically closed.
625# ----------------------------------------------------------------------
626itcl::body Rappture::VtkViewer::Connect {} {
627    puts stderr "Enter Connect: [info level -1]"
628    set _hosts [GetServerList "vtkvis"]
629    if { "" == $_hosts } {
630        return 0
631    }
632    set result [VisViewer::Connect $_hosts]
633    if { $result } {
634        puts stderr "Connected to $_hostname sid=$_sid"
635        set w [winfo width $itk_component(view)]
636        set h [winfo height $itk_component(view)]
637        EventuallyResize $w $h
638    }
639    return $result
640}
641
642#
643# isconnected --
644#
645#       Indicates if we are currently connected to the visualization server.
646#
647itcl::body Rappture::VtkViewer::isconnected {} {
648    return [VisViewer::IsConnected]
649}
650
651#
652# disconnect --
653#
654itcl::body Rappture::VtkViewer::disconnect {} {
655    Disconnect
656    set _reset 1
657}
658
659#
660# Disconnect --
661#
662#       Clients use this method to disconnect from the current rendering
663#       server.
664#
665itcl::body Rappture::VtkViewer::Disconnect {} {
666    VisViewer::Disconnect
667
668    # disconnected -- no more data sitting on server
669    set _outbuf ""
670    array unset _datasets
671    array unset _data
672    array unset _colormaps
673}
674
675#
676# sendto --
677#
678itcl::body Rappture::VtkViewer::sendto { bytes } {
679    SendBytes "$bytes\n"
680}
681
682#
683# SendCmd
684#
685#       Send commands off to the rendering server.  If we're currently
686#       sending data objects to the server, buffer the commands to be
687#       sent later.
688#
689itcl::body Rappture::VtkViewer::SendCmd {string} {
690    if { $_buffering } {
691        append _outbuf $string "\n"
692    } else {
693        foreach line [split $string \n] {
694            SendEcho >>line $line
695        }
696        SendBytes "$string\n"
697    }
698}
699
700# ----------------------------------------------------------------------
701# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
702#
703# Invoked automatically whenever the "image" command comes in from
704# the rendering server.  Indicates that binary image data with the
705# specified <size> will follow.
706# ----------------------------------------------------------------------
707itcl::body Rappture::VtkViewer::ReceiveImage { args } {
708    array set info {
709        -token "???"
710        -bytes 0
711        -type image
712    }
713    array set info $args
714    set bytes [ReceiveBytes $info(-bytes)]
715    ReceiveEcho <<line "<read $info(-bytes) bytes"
716    if { $info(-type) == "image" } {
717        if 1 {
718            set f [open "last.ppm" "w"]
719            puts $f $bytes
720            close $f
721        }
722        $_image(plot) configure -data $bytes
723        set time [clock seconds]
724        set date [clock format $time]
725        puts stderr "$date: received image [image width $_image(plot)]x[image height $_image(plot)] image>"       
726        if { $_start > 0 } {
727            set finish [clock clicks -milliseconds]
728            puts stderr "round trip time [expr $finish -$_start] milliseconds"
729            set _start 0
730        }
731    } elseif { $info(type) == "print" } {
732        set tag $this-print-$info(-token)
733        set _hardcopy($tag) $bytes
734    }
735}
736
737#
738# ReceiveDataset --
739#
740itcl::body Rappture::VtkViewer::ReceiveDataset { args } {
741    if { ![isconnected] } {
742        return
743    }
744    set option [lindex $args 0]
745    switch -- $option {
746        "value" {
747            set option [lindex $args 1]
748            switch -- $option {
749                "world" {
750                    foreach { x y z value } [lrange $args 2 end] break
751                }
752                "pixel" {
753                    foreach { x y value } [lrange $args 2 end] break
754                }
755            }
756        }
757        default {
758            error "unknown dataset option \"$option\" from server"
759        }
760    }
761}
762
763# ----------------------------------------------------------------------
764# USAGE: Rebuild
765#
766# Called automatically whenever something changes that affects the
767# data in the widget.  Clears any existing data and rebuilds the
768# widget to display new data.
769# ----------------------------------------------------------------------
770itcl::body Rappture::VtkViewer::Rebuild {} {
771
772    set w [winfo width $itk_component(view)]
773    set h [winfo height $itk_component(view)]
774    if { $w < 2 || $h < 2 } {
775        $_dispatcher event -idle !rebuild
776        return
777    }
778
779    # Turn on buffering of commands to the server.  We don't want to
780    # be preempted by a server disconnect/reconnect (which automatically
781    # generates a new call to Rebuild).   
782    set _buffering 1
783
784    set _width $w
785    set _height $h
786    $_arcball resize $w $h
787    DoResize
788   
789    set _limits(vmin) ""
790    set _limits(vmax) ""
791    set _first ""
792    foreach dataobj [get -objects] {
793        if { [info exists _obj2ovride($dataobj-raise)] &&  $_first == "" } {
794            set _first $dataobj
795        }
796        set _obj2datasets($dataobj) ""
797        foreach comp [$dataobj components] {
798            set tag $dataobj-$comp
799            if { ![info exists _datasets($tag)] } {
800                set bytes [$dataobj data $comp]
801                set length [string length $bytes]
802                append _outbuf "dataset add $tag data follows $length\n"
803                append _outbuf $bytes
804                append _outbuf "polydata add $tag\n"
805                set _datasets($tag) 1
806            }
807            lappend _obj2datasets($dataobj) $tag
808            SetObjectStyle $dataobj $comp
809            if { [info exists _obj2ovride($dataobj-raise)] } {
810                SendCmd "dataset visible 1 $tag"
811            } else {
812                SendCmd "dataset visible 0 $tag"
813            }
814        }
815    }
816    #
817    # Reset the camera and other view parameters
818    #
819    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
820    $_arcball quaternion $q
821    SendCmd "camera orient $q"
822    PanCamera
823    SendCmd "camera mode persp"
824    if { $_reset || $_first == "" } {
825        Zoom reset
826        set _reset 0
827    }
828    FixSettings opacity
829    FixSettings grid-x
830    FixSettings grid-y
831    FixSettings grid-z
832    FixSettings volume
833    FixSettings lighting
834    FixSettings axes
835    FixSettings edges
836    FixSettings axismode
837
838    if {"" != $_first} {
839        set location [$_first hints camera]
840        if { $location != "" } {
841            array set view $location
842        }
843    }
844
845    set _buffering 0;                        # Turn off buffering.
846
847    # Actually write the commands to the server socket.  If it fails, we don't
848    # care.  We're finished here.
849    blt::busy hold $itk_component(hull)
850    SendBytes $_outbuf;                       
851    blt::busy release $itk_component(hull)
852    set _outbuf "";                        # Clear the buffer.               
853}
854
855# ----------------------------------------------------------------------
856# USAGE: CurrentDatasets ?-all -visible? ?dataobjs?
857#
858# Returns a list of server IDs for the current datasets being displayed.  This
859# is normally a single ID, but it might be a list of IDs if the current data
860# object has multiple components.
861# ----------------------------------------------------------------------
862itcl::body Rappture::VtkViewer::CurrentDatasets {args} {
863    set flag [lindex $args 0]
864    switch -- $flag {
865        "-all" {
866            if { [llength $args] > 1 } {
867                error "CurrentDatasets: can't specify dataobj after \"-all\""
868            }
869            set dlist [get -objects]
870        }
871        "-visible" {
872            if { [llength $args] > 1 } {
873                set dlist {}
874                set args [lrange $args 1 end]
875                foreach dataobj $args {
876                    if { [info exists _obj2ovride($dataobj-raise)] } {
877                        lappend dlist $dataobj
878                    }
879                }
880            } else {
881                set dlist [get -visible]
882            }
883        }           
884        default {
885            set dlist $args
886        }
887    }
888    set rlist ""
889    foreach dataobj $dlist {
890        foreach comp [$dataobj components] {
891            set tag $dataobj-$comp
892            if { [info exists _datasets($tag)] && $_datasets($tag) } {
893                lappend rlist $tag
894            }
895        }
896    }
897    return $rlist
898}
899
900# ----------------------------------------------------------------------
901# USAGE: Zoom in
902# USAGE: Zoom out
903# USAGE: Zoom reset
904#
905# Called automatically when the user clicks on one of the zoom
906# controls for this widget.  Changes the zoom for the current view.
907# ----------------------------------------------------------------------
908itcl::body Rappture::VtkViewer::Zoom {option} {
909    switch -- $option {
910        "in" {
911            set _view(zoom) [expr {$_view(zoom)*1.25}]
912            SendCmd "camera zoom $_view(zoom)"
913        }
914        "out" {
915            set _view(zoom) [expr {$_view(zoom)*0.8}]
916            SendCmd "camera zoom $_view(zoom)"
917        }
918        "reset" {
919            array set _view {
920                qx      0
921                qy      0
922                qz      0
923                qw      1
924                zoom    1.0
925                pan-x   0
926                pan-y   0
927                zoom-x  1.0
928                zoom-y  1.0
929            }
930            SendCmd "camera reset all"
931            if { $_first != "" } {
932                set location [$_first hints camera]
933                if { $location != "" } {
934                    array set _view $location
935                }
936            }
937            set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
938            $_arcball quaternion $q
939            SendCmd "camera orient $q"
940            PanCamera
941        }
942    }
943}
944
945itcl::body Rappture::VtkViewer::PanCamera {} {
946#    set w [winfo width $itk_component(view)]
947#    set h [winfo height $itk_component(view)]
948#    set x [expr ($_view(pan-x)) / $w]
949#    set y [expr ($_view(pan-y)) / $h]
950#    set x [expr $x * $_limits(xmax) - $_limits(xmin)]
951#    set y [expr $y * $_limits(ymax) - $_limits(ymin)]
952    set x $_view(pan-x)
953    set y $_view(pan-y)
954    SendCmd "camera pan $x $y"
955}
956
957
958# ----------------------------------------------------------------------
959# USAGE: Rotate click <x> <y>
960# USAGE: Rotate drag <x> <y>
961# USAGE: Rotate release <x> <y>
962#
963# Called automatically when the user clicks/drags/releases in the
964# plot area.  Moves the plot according to the user's actions.
965# ----------------------------------------------------------------------
966itcl::body Rappture::VtkViewer::Rotate {option x y} {
967    switch -- $option {
968        "click" {
969            $itk_component(view) configure -cursor fleur
970            set _click(x) $x
971            set _click(y) $y
972        }
973        "drag" {
974            if {[array size _click] == 0} {
975                Rotate click $x $y
976            } else {
977                set w [winfo width $itk_component(view)]
978                set h [winfo height $itk_component(view)]
979                if {$w <= 0 || $h <= 0} {
980                    return
981                }
982
983                if {[catch {
984                    # this fails sometimes for no apparent reason
985                    set dx [expr {double($x-$_click(x))/$w}]
986                    set dy [expr {double($y-$_click(y))/$h}]
987                }]} {
988                    return
989                }
990                if { $dx == 0 && $dy == 0 } {
991                    return
992                }
993                set q [$_arcball rotate $x $y $_click(x) $_click(y)]
994                foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break
995                SendCmd "camera orient $q"
996                set _click(x) $x
997                set _click(y) $y
998            }
999        }
1000        "release" {
1001            Rotate drag $x $y
1002            $itk_component(view) configure -cursor ""
1003            catch {unset _click}
1004        }
1005        default {
1006            error "bad option \"$option\": should be click, drag, release"
1007        }
1008    }
1009}
1010
1011# ----------------------------------------------------------------------
1012# USAGE: $this Pan click x y
1013#        $this Pan drag x y
1014#        $this Pan release x y
1015#
1016# Called automatically when the user clicks on one of the zoom
1017# controls for this widget.  Changes the zoom for the current view.
1018# ----------------------------------------------------------------------
1019itcl::body Rappture::VtkViewer::Pan {option x y} {
1020    switch -- $option {
1021        "set" {
1022            set w [winfo width $itk_component(view)]
1023            set h [winfo height $itk_component(view)]
1024            set x [expr $x / double($w)]
1025            set y [expr $y / double($h)]
1026            set _view(pan-x) [expr $_view(pan-x) + $x]
1027            set _view(pan-y) [expr $_view(pan-y) + $y]
1028            PanCamera
1029            return
1030        }
1031        "click" {
1032            set _click(x) $x
1033            set _click(y) $y
1034            $itk_component(view) configure -cursor hand1
1035        }
1036        "drag" {
1037            set w [winfo width $itk_component(view)]
1038            set h [winfo height $itk_component(view)]
1039            set dx [expr ($_click(x) - $x)/double($w)]
1040            set dy [expr ($_click(y) - $y)/double($h)]
1041            set _click(x) $x
1042            set _click(y) $y
1043            set _view(pan-x) [expr $_view(pan-x) - $dx]
1044            set _view(pan-y) [expr $_view(pan-y) - $dy]
1045            PanCamera
1046        }
1047        "release" {
1048            Pan drag $x $y
1049            $itk_component(view) configure -cursor ""
1050        }
1051        default {
1052            error "unknown option \"$option\": should set, click, drag, or release"
1053        }
1054    }
1055}
1056
1057# ----------------------------------------------------------------------
1058# USAGE: FixSettings <what> ?<value>?
1059#
1060# Used internally to update rendering settings whenever parameters
1061# change in the popup settings panel.  Sends the new settings off
1062# to the back end.
1063# ----------------------------------------------------------------------
1064itcl::body Rappture::VtkViewer::FixSettings {what {value ""}} {
1065    switch -- $what {
1066        "opacity" {
1067            if {[isconnected]} {
1068                set val $_settings($this-opacity)
1069                set sval [expr { 0.01 * double($val) }]
1070                foreach dataset [CurrentDatasets -visible $_first] {
1071                    SendCmd "polydata opacity $sval $dataset"
1072                }
1073            }
1074        }
1075        "wireframe" {
1076            if {[isconnected]} {
1077                set bool $_settings($this-wireframe)
1078                foreach dataset [CurrentDatasets -visible $_first] {
1079                    SendCmd "polydata wireframe $bool $dataset"
1080                }
1081            }
1082        }
1083        "volume" {
1084            if {[isconnected]} {
1085                set bool $_settings($this-volume)
1086                foreach dataset [CurrentDatasets -visible $_first] {
1087                    SendCmd "polydata visible $bool $dataset"
1088                }
1089            }
1090        }
1091        "lighting" {
1092            if {[isconnected]} {
1093                set bool $_settings($this-lighting)
1094                foreach dataset [CurrentDatasets -visible $_first] {
1095                    SendCmd "polydata lighting $bool $dataset"
1096                }
1097            }
1098        }
1099        "grid-x" {
1100            if {[isconnected]} {
1101                set bool $_settings($this-grid-x)
1102                SendCmd "axis grid x $bool"
1103            }
1104        }
1105        "grid-y" {
1106            if {[isconnected]} {
1107                set bool $_settings($this-grid-y)
1108                SendCmd "axis grid y $bool"
1109            }
1110        }
1111        "grid-z" {
1112            if {[isconnected]} {
1113                set bool $_settings($this-grid-z)
1114                SendCmd "axis grid z $bool"
1115            }
1116        }
1117        "edges" {
1118            if {[isconnected]} {
1119                set bool $_settings($this-edges)
1120                foreach dataset [CurrentDatasets -visible $_first] {
1121                    SendCmd "polydata edges $bool $dataset"
1122                }
1123            }
1124        }
1125        "axes" {
1126            if { [isconnected] } {
1127                set bool $_settings($this-axes)
1128                SendCmd "axis visible all $bool"
1129            }
1130        }
1131        "axismode" {
1132            if { [isconnected] } {
1133                set mode [$itk_component(axismode) value]
1134                set mode [$itk_component(axismode) translate $mode]
1135                SendCmd "axis flymode $mode"
1136            }
1137        }
1138        default {
1139            error "don't know how to fix $what"
1140        }
1141    }
1142}
1143
1144#
1145# SetStyles --
1146#
1147itcl::body Rappture::VtkViewer::SetStyles { dataobj comp } {
1148    array set style {
1149        -color rainbow
1150        -levels 6
1151        -opacity 1.0
1152    }
1153    set tag $dataobj-$comp
1154    array set style [lindex [$dataobj components -style $comp] 0]
1155    set colormap "$style(-color):$style(-levels):$style(-opacity)"
1156    if { [info exists _colormaps($colormap)] } {
1157        puts stderr "Colormap $colormap already built"
1158    }
1159    if { ![info exists _dataset2style($tag)] } {
1160        set _dataset2style($tag) $colormap
1161        lappend _style2datasets($colormap) $tag
1162    }
1163    if { ![info exists _colormaps($colormap)] } {
1164        # Build the pseudo colormap if it doesn't exist.
1165        BuildColormap $colormap $dataobj $comp
1166        set _colormaps($colormap) 1
1167    }
1168    #SendCmd "polydata add $style(-levels) $tag\n"
1169    SendCmd "pseudocolor colormap $colormap $tag"
1170    return $colormap
1171}
1172
1173#
1174# BuildColormap --
1175#
1176itcl::body Rappture::VtkViewer::BuildColormap { colormap dataobj comp } {
1177    array set style {
1178        -color rainbow
1179        -levels 6
1180        -opacity 1.0
1181    }
1182    array set style [lindex [$dataobj components -style $comp] 0]
1183
1184    if {$style(-color) == "rainbow"} {
1185        set style(-color) "white:yellow:green:cyan:blue:magenta"
1186    }
1187    set clist [split $style(-color) :]
1188    set cmap {}
1189    for {set i 0} {$i < [llength $clist]} {incr i} {
1190        set x [expr {double($i)/([llength $clist]-1)}]
1191        set color [lindex $clist $i]
1192        append cmap "$x [Color2RGB $color] "
1193    }
1194    if { [llength $cmap] == 0 } {
1195        set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0"
1196    }
1197    set tag $this-$colormap
1198    if { ![info exists _settings($tag-opacity)] } {
1199        set _settings($tag-opacity) $style(-opacity)
1200    }
1201    set max $_settings($tag-opacity)
1202
1203    set wmap "0.0 1.0 1.0 1.0"
1204    SendCmd "colormap add $colormap { $cmap } { $wmap }"
1205}
1206
1207# ----------------------------------------------------------------------
1208# CONFIGURATION OPTION: -plotbackground
1209# ----------------------------------------------------------------------
1210itcl::configbody Rappture::VtkViewer::plotbackground {
1211    if { [isconnected] } {
1212        foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1213        SendCmd "screen bgcolor $r $g $b"
1214    }
1215}
1216
1217# ----------------------------------------------------------------------
1218# CONFIGURATION OPTION: -plotforeground
1219# ----------------------------------------------------------------------
1220itcl::configbody Rappture::VtkViewer::plotforeground {
1221    if { [isconnected] } {
1222        foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1223        #fix this!
1224        #SendCmd "color background $r $g $b"
1225    }
1226}
1227
1228itcl::body Rappture::VtkViewer::limits { dataobj } {
1229
1230    array unset _limits $dataobj-*
1231    foreach comp [$dataobj components] {
1232        set tag $dataobj-$comp
1233        if { ![info exists _limits($tag)] } {
1234            set data [$dataobj data $comp]
1235            set arr [vtkCharArray $tag-xvtkCharArray]
1236            $arr SetArray $data [string length $data] 1
1237            set reader [vtkPolyDataReader $tag-xvtkPolyDataReader]
1238            $reader SetInputArray $arr
1239            $reader ReadFromInputStringOn
1240            set mapper [vtkPolyDataMapper $tag-xvtkPolyDataMapper]
1241            $mapper SetInput [$reader GetOutput]
1242            set actor [vtkActor $tag-xvthActor]
1243            $actor SetMapper $mapper
1244            set _limits($tag) [$actor GetBounds]
1245            rename $actor ""
1246            rename $reader ""
1247            rename $arr ""
1248            rename $mapper ""
1249        }
1250        foreach { xMin xMax yMin yMax zMin zMax} $_limits($tag) break
1251        if {![info exists limits(xmin)] || $limits(xmin) > $xMin} {
1252            set limits(xmin) $xMin
1253        }
1254        if {![info exists limits(xmax)] || $limits(xmax) < $xMax} {
1255            set limits(xmax) $xMax
1256        }
1257        if {![info exists limits(ymin)] || $limits(ymin) > $yMin} {
1258            set limits(ymin) $xMin
1259        }
1260        if {![info exists limits(ymax)] || $limits(ymax) < $yMax} {
1261            set limits(ymax) $yMax
1262        }
1263        if {![info exists limits(zmin)] || $limits(zmin) > $zMin} {
1264            set limits(zmin) $zMin
1265        }
1266        if {![info exists limits(zmax)] || $limits(zmax) < $zMax} {
1267            set limits(zmax) $zMax
1268        }
1269    }
1270    return [array get limits]
1271}
1272
1273
1274itcl::body Rappture::VtkViewer::BuildViewTab {} {
1275
1276    set fg [option get $itk_component(hull) font Font]
1277    #set bfg [option get $itk_component(hull) boldFont Font]
1278
1279    set inner [$itk_component(main) insert end \
1280        -title "View Settings" \
1281        -icon [Rappture::icon wrench]]
1282    $inner configure -borderwidth 4
1283
1284    checkbutton $inner.wireframe \
1285        -text "Wireframe" \
1286        -variable [itcl::scope _settings($this-wireframe)] \
1287        -command [itcl::code $this FixSettings wireframe] \
1288        -font "Arial 9"
1289
1290    checkbutton $inner.axes \
1291        -text "Axes" \
1292        -variable [itcl::scope _settings($this-axes)] \
1293        -command [itcl::code $this FixSettings axes] \
1294        -font "Arial 9"
1295
1296    checkbutton $inner.volume \
1297        -text "Volume" \
1298        -variable [itcl::scope _settings($this-volume)] \
1299        -command [itcl::code $this FixSettings volume] \
1300        -font "Arial 9"
1301
1302    checkbutton $inner.lighting \
1303        -text "Lighting" \
1304        -variable [itcl::scope _settings($this-lighting)] \
1305        -command [itcl::code $this FixSettings lighting] \
1306        -font "Arial 9"
1307
1308    checkbutton $inner.edges \
1309        -text "Edges" \
1310        -variable [itcl::scope _settings($this-edges)] \
1311        -command [itcl::code $this FixSettings edges] \
1312        -font "Arial 9"
1313
1314    label $inner.clear -text "Clear" -font "Arial 9"
1315    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1316        -variable [itcl::scope _settings($this-opacity)] \
1317        -width 10 \
1318        -showvalue off -command [itcl::code $this FixSettings opacity]
1319    label $inner.opaque -text "Opaque" -font "Arial 9"
1320
1321    blt::table $inner \
1322        0,0 $inner.axes -columnspan 4 -anchor w -pady 2 \
1323        1,0 $inner.volume -columnspan 4 -anchor w -pady 2 \
1324        2,0 $inner.wireframe -columnspan 4 -anchor w -pady 2 \
1325        3,0 $inner.lighting  -columnspan 4 -anchor w \
1326        4,0 $inner.edges -columnspan 4 -anchor w -pady 2 \
1327        5,0 $inner.clear -anchor e -pady 2 \
1328        6,1 $inner.opacity -columnspan 2 -pady 2 -fill x\
1329        6,3 $inner.opaque -anchor w -pady 2
1330
1331    blt::table configure $inner r* -resize none
1332    blt::table configure $inner r7 -resize expand
1333}
1334
1335itcl::body Rappture::VtkViewer::BuildAxisTab {} {
1336
1337    set fg [option get $itk_component(hull) font Font]
1338    #set bfg [option get $itk_component(hull) boldFont Font]
1339
1340    set inner [$itk_component(main) insert end \
1341        -title "Axis Settings" \
1342        -icon [Rappture::icon cog]]
1343    $inner configure -borderwidth 4
1344
1345    checkbutton $inner.axes \
1346        -text "Visible" \
1347        -variable [itcl::scope _settings($this-axes)] \
1348        -command [itcl::code $this FixSettings axes] \
1349        -font "Arial 9"
1350
1351    label $inner.grid -text "Grid" -font "Arial 9"
1352    set f [frame $inner.gridf]
1353    checkbutton $f.x \
1354        -text "X" \
1355        -variable [itcl::scope _settings($this-grid-x)] \
1356        -command [itcl::code $this FixSettings grid-x] \
1357        -font "Arial 9"
1358    checkbutton $f.y \
1359        -text "Y" \
1360        -variable [itcl::scope _settings($this-grid-y)] \
1361        -command [itcl::code $this FixSettings grid-y] \
1362        -font "Arial 9"
1363    checkbutton $f.z \
1364        -text "Z" \
1365        -variable [itcl::scope _settings($this-grid-z)] \
1366        -command [itcl::code $this FixSettings grid-z] \
1367        -font "Arial 9"
1368    pack $f.x $f.y $f.z -side left
1369
1370    label $inner.axismode -text "Mode" \
1371        -font "Arial 9"
1372
1373    itk_component add axismode {
1374        Rappture::Combobox $inner.axismode_combo -width 10 -editable no
1375    }
1376    $inner.axismode_combo choices insert end \
1377        "static_triad"    "static" \
1378        "closest_triad"   "closest" \
1379        "furthest_triad"  "furthest" \
1380        "outer_edges"     "outer"         
1381    $itk_component(axismode) value "outer"
1382    bind $inner.axismode_combo <<Value>> [itcl::code $this FixSettings axismode]
1383
1384    blt::table $inner \
1385        0,0 $inner.axes -columnspan 4 -anchor w -pady 2 \
1386        1,0 $inner.axismode -anchor w -pady 2 \
1387        1,1 $inner.axismode_combo -cspan 3 -anchor w -pady 2 \
1388        2,0 $inner.grid -anchor w -pady 2 \
1389        2,1 $inner.gridf -anchor w -cspan 3 -fill x
1390
1391    blt::table configure $inner r* -resize none
1392    blt::table configure $inner r3 -resize expand
1393}
1394
1395itcl::body Rappture::VtkViewer::BuildCameraTab {} {
1396    set inner [$itk_component(main) insert end \
1397        -title "Camera Settings" \
1398        -icon [Rappture::icon camera]]
1399    $inner configure -borderwidth 4
1400
1401    set labels { qx qy qz qw pan-x pan-y zoom }
1402    set row 0
1403    foreach tag $labels {
1404        label $inner.${tag}label -text $tag -font "Arial 9"
1405        entry $inner.${tag} -font "Arial 9"  -bg white \
1406            -textvariable [itcl::scope _view($tag)]
1407        bind $inner.${tag} <KeyPress-Return> \
1408            [itcl::code $this camera set ${tag}]
1409        blt::table $inner \
1410            $row,0 $inner.${tag}label -anchor e -pady 2 \
1411            $row,1 $inner.${tag} -anchor w -pady 2
1412        blt::table configure $inner r$row -resize none
1413        incr row
1414    }
1415    blt::table configure $inner c0 c1 -resize none
1416    blt::table configure $inner c2 -resize expand
1417    blt::table configure $inner r$row -resize expand
1418}
1419
1420
1421#
1422#  camera --
1423#
1424itcl::body Rappture::VtkViewer::camera {option args} {
1425    switch -- $option {
1426        "show" {
1427            puts [array get _view]
1428        }
1429        "set" {
1430            set who [lindex $args 0]
1431            set x $_view($who)
1432            set code [catch { string is double $x } result]
1433            if { $code != 0 || !$result } {
1434                set x _view($who)
1435                return
1436            }
1437            switch -- $who {
1438                "pan-x" - "pan-y" {
1439                    PanCamera
1440                }
1441                "qx" - "qy" - "qz" - "qw" {
1442                    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1443                    $_arcball quaternion $q
1444                    SendCmd "camera orient $q"
1445                }
1446                "zoom" {
1447                    SendCmd "camera zoom $_view(zoom)"
1448                }
1449            }
1450        }
1451    }
1452}
1453
1454itcl::body Rappture::VtkViewer::ConvertToVtkData { dataobj comp } {
1455    foreach { x1 x2 xN y1 y2 yN } [$dataobj mesh $comp] break
1456    set values [$dataobj values $comp]
1457    append out "# vtk DataFile Version 2.0 \n"
1458    append out "Test data \n"
1459    append out "ASCII \n"
1460    append out "DATASET STRUCTURED_POINTS \n"
1461    append out "DIMENSIONS $xN $yN 1 \n"
1462    append out "ORIGIN 0 0 0 \n"
1463    append out "SPACING 1 1 1 \n"
1464    append out "POINT_DATA [expr $xN * $yN] \n"
1465    append out "SCALARS field float 1 \n"
1466    append out "LOOKUP_TABLE default \n"
1467    append out [join $values "\n"]
1468    append out "\n"
1469    return $out
1470}
1471
1472
1473itcl::body Rappture::VtkViewer::GetVtkData { args } {
1474    set bytes ""
1475    foreach dataobj [get] {
1476        foreach comp [$dataobj components] {
1477            set tag $dataobj-$comp
1478            set contents [ConvertToVtkData $dataobj $comp]
1479            append bytes "$contents\n\n"
1480        }
1481    }
1482    return [list .txt $bytes]
1483}
1484
1485itcl::body Rappture::VtkViewer::GetImage { args } {
1486    if { [image width $_image(download)] > 0 &&
1487         [image height $_image(download)] > 0 } {
1488        set bytes [$_image(download) data -format "jpeg -quality 100"]
1489        set bytes [Rappture::encoding::decode -as b64 $bytes]
1490        return [list .jpg $bytes]
1491    }
1492    return ""
1493}
1494
1495itcl::body Rappture::VtkViewer::BuildDownloadPopup { popup command } {
1496    Rappture::Balloon $popup \
1497        -title "[Rappture::filexfer::label downloadWord] as..."
1498    set inner [$popup component inner]
1499    label $inner.summary -text "" -anchor w
1500    radiobutton $inner.vtk_button -text "VTK data file" \
1501        -variable [itcl::scope _downloadPopup(format)] \
1502        -font "Helvetica 9 " \
1503        -value vtk 
1504    Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
1505    radiobutton $inner.image_button -text "Image File" \
1506        -variable [itcl::scope _downloadPopup(format)] \
1507        -value image
1508    Rappture::Tooltip::for $inner.image_button \
1509        "Save as digital image."
1510
1511    button $inner.ok -text "Save" \
1512        -highlightthickness 0 -pady 2 -padx 3 \
1513        -command $command \
1514        -compound left \
1515        -image [Rappture::icon download]
1516
1517    button $inner.cancel -text "Cancel" \
1518        -highlightthickness 0 -pady 2 -padx 3 \
1519        -command [list $popup deactivate] \
1520        -compound left \
1521        -image [Rappture::icon cancel]
1522
1523    blt::table $inner \
1524        0,0 $inner.summary -cspan 2  \
1525        1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
1526        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
1527        4,1 $inner.cancel -width .9i -fill y \
1528        4,0 $inner.ok -padx 2 -width .9i -fill y
1529    blt::table configure $inner r3 -height 4
1530    blt::table configure $inner r4 -pady 4
1531    raise $inner.image_button
1532    $inner.vtk_button invoke
1533    return $inner
1534}
1535
1536itcl::body Rappture::VtkViewer::SetObjectStyle { dataobj comp } {
1537    array set props {
1538        -color \#6666FF
1539        -edgevisibility 1
1540        -edgecolor black
1541        -linewidth 1.0
1542        -opacity 1.0
1543        -wireframe 0
1544        -lighting 1
1545    }
1546    # Parse style string.
1547    set style [$dataobj style $comp]
1548    set tag $dataobj-$comp
1549    array set props $style
1550    SendCmd "polydata color [Color2RGB $props(-color)] $tag"
1551    SendCmd "polydata edges $props(-edgevisibility) $tag"
1552    SendCmd "polydata lighting $props(-lighting) $tag"
1553    SendCmd "polydata linecolor [Color2RGB $props(-edgecolor)] $tag"
1554    SendCmd "polydata linewidth $props(-linewidth) $tag"
1555    SendCmd "polydata opacity $props(-opacity) $tag"
1556    if { $dataobj != $_first } {
1557        set props(-wireframe) 1
1558    }
1559    SendCmd "polydata wireframe $props(-wireframe) $tag"
1560    set _settings($this-opacity) [expr $props(-opacity) * 100.0]
1561}
1562
1563itcl::body Rappture::VtkViewer::IsValidObject { dataobj } {
1564    if {[catch {$dataobj isa Rappture::Scene} valid] != 0 || !$valid} {
1565        return 0
1566    }
1567    return 1
1568}
Note: See TracBrowser for help on using the repository browser.