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

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

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