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

Last change on this file since 2417 was 2417, checked in by ldelgass, 13 years ago

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