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

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

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