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

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