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

Last change on this file since 2414 was 2414, checked in by ldelgass, 11 years ago

Opacity slider uses 0-100 scale, so set initial _setting opacity to 100 instead
of 1 so that slider is initialized to fully opaque.

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