source: trunk/gui/scripts/vtkcontourviewer.tcl @ 2417

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

Remove some unused code from vtkcontourviewer.tcl that can cause an error on
a rebuild/reset if _first is empty. In vtkviewer.tcl, use camera reset
(without the 'all') flag to reset while keeping orientation.

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