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

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

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