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

Last change on this file since 2414 was 2414, checked in by ldelgass, 11 years ago

Opacity slider uses 0-100 scale, so set initial _setting opacity to 100 instead
of 1 so that slider is initialized to fully opaque.

File size: 52.6 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    # If the first dataset already exists on the server, then make sure we
899    # display the proper transfer function in the legend.
900    set comp [lindex [$_first components] 0]
901    set _buffering 0;                        # Turn off buffering.
902
903    # Actually write the commands to the server socket.  If it fails, we don't
904    # care.  We're finished here.
905    blt::busy hold $itk_component(hull)
906    SendBytes $_outbuf;                       
907    blt::busy release $itk_component(hull)
908    set _outbuf "";                        # Clear the buffer.               
909}
910
911# ----------------------------------------------------------------------
912# USAGE: CurrentDatasets ?-cutplanes?
913#
914# Returns a list of server IDs for the current datasets being displayed.  This
915# is normally a single ID, but it might be a list of IDs if the current data
916# object has multiple components.
917# ----------------------------------------------------------------------
918itcl::body Rappture::VtkContourViewer::CurrentDatasets {{what -all}} {
919    set rlist ""
920    if { $_first == "" } {
921        return
922    }
923    foreach comp [$_first components] {
924        set tag $_first-$comp
925        if { [info exists _datasets($tag)] && $_datasets($tag) } {
926            lappend rlist $tag
927        }
928    }
929    return $rlist
930}
931
932# ----------------------------------------------------------------------
933# USAGE: Zoom in
934# USAGE: Zoom out
935# USAGE: Zoom reset
936#
937# Called automatically when the user clicks on one of the zoom
938# controls for this widget.  Changes the zoom for the current view.
939# ----------------------------------------------------------------------
940itcl::body Rappture::VtkContourViewer::Zoom {option} {
941    switch -- $option {
942        "in" {
943            set _view(zoom) [expr {$_view(zoom)*1.25}]
944            set _settings($this-zoom) $_view(zoom)
945            SendCmd "camera zoom $_view(zoom)"
946        }
947        "out" {
948            set _view(zoom) [expr {$_view(zoom)*0.8}]
949            set _settings($this-zoom) $_view(zoom)
950            SendCmd "camera zoom $_view(zoom)"
951        }
952        "reset" {
953            array set _view {
954                theta   45
955                phi     45
956                psi     0
957                zoom    1.0
958                pan-x   0
959                pan-y   0
960                zoom-x  1.0
961                zoom-y  1.0
962            }
963            if { $_first != "" } {
964                set location [$_first hints camera]
965                if { $location != "" } {
966                    array set _view $location
967                }
968            }
969            set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
970            #SendCmd "camera rotate $xyz"
971            PanCamera
972            set _settings($this-theta) $_view(theta)
973            set _settings($this-phi)   $_view(phi)
974            set _settings($this-psi)   $_view(psi)
975            set _settings($this-pan-x) $_view(pan-x)
976            set _settings($this-pan-y) $_view(pan-y)
977            set _settings($this-zoom)  $_view(zoom)
978            SendCmd "camera reset all"
979        }
980    }
981}
982
983itcl::body Rappture::VtkContourViewer::PanCamera {} {
984    #set x [expr ($_view(pan-x)) / $_limits(xrange)]
985    #set y [expr ($_view(pan-y)) / $_limits(yrange)]
986    set x $_view(pan-x)
987    set y $_view(pan-y)
988    SendCmd "camera pan $x $y"
989}
990
991
992# ----------------------------------------------------------------------
993# USAGE: Rotate click <x> <y>
994# USAGE: Rotate drag <x> <y>
995# USAGE: Rotate release <x> <y>
996#
997# Called automatically when the user clicks/drags/releases in the
998# plot area.  Moves the plot according to the user's actions.
999# ----------------------------------------------------------------------
1000itcl::body Rappture::VtkContourViewer::Rotate {option x y} {
1001    switch -- $option {
1002        click {
1003            $itk_component(view) configure -cursor fleur
1004            set _click(x) $x
1005            set _click(y) $y
1006            set _click(theta) $_view(theta)
1007            set _click(phi) $_view(phi)
1008        }
1009        drag {
1010            if {[array size _click] == 0} {
1011                Rotate click $x $y
1012            } else {
1013                set w [winfo width $itk_component(view)]
1014                set h [winfo height $itk_component(view)]
1015                if {$w <= 0 || $h <= 0} {
1016                    return
1017                }
1018
1019                if {[catch {
1020                    # this fails sometimes for no apparent reason
1021                    set dx [expr {double($x-$_click(x))/$w}]
1022                    set dy [expr {double($y-$_click(y))/$h}]
1023                }]} {
1024                    return
1025                }
1026
1027                #
1028                # Rotate the camera in 3D
1029                #
1030                if {$_view(psi) > 90 || $_view(psi) < -90} {
1031                    # when psi is flipped around, theta moves backwards
1032                    set dy [expr {-$dy}]
1033                }
1034                set theta [expr {$_view(theta) - $dy*180}]
1035                while {$theta < 0} { set theta [expr {$theta+180}] }
1036                while {$theta > 180} { set theta [expr {$theta-180}] }
1037
1038                if {abs($theta) >= 30 && abs($theta) <= 160} {
1039                    set phi [expr {$_view(phi) - $dx*360}]
1040                    while {$phi < 0} { set phi [expr {$phi+360}] }
1041                    while {$phi > 360} { set phi [expr {$phi-360}] }
1042                    set psi $_view(psi)
1043                } else {
1044                    set phi $_view(phi)
1045                    set psi [expr {$_view(psi) - $dx*360}]
1046                    while {$psi < -180} { set psi [expr {$psi+360}] }
1047                    while {$psi > 180} { set psi [expr {$psi-360}] }
1048                }
1049
1050                set _view(theta)        $theta
1051                set _view(phi)          $phi
1052                set _view(psi)          $psi
1053                set xyz [Euler2XYZ $theta $phi $psi]
1054                set _settings($this-theta) $_view(theta)
1055                set _settings($this-phi)   $_view(phi)
1056                set _settings($this-psi)   $_view(psi)
1057                #SendCmd "camera rotate $xyz"
1058                set _click(x) $x
1059                set _click(y) $y
1060            }
1061        }
1062        release {
1063            Rotate drag $x $y
1064            $itk_component(view) configure -cursor ""
1065            catch {unset _click}
1066        }
1067        default {
1068            error "bad option \"$option\": should be click, drag, release"
1069        }
1070    }
1071}
1072
1073# ----------------------------------------------------------------------
1074# USAGE: $this Pan click x y
1075#        $this Pan drag x y
1076#        $this Pan release x y
1077#
1078# Called automatically when the user clicks on one of the zoom
1079# controls for this widget.  Changes the zoom for the current view.
1080# ----------------------------------------------------------------------
1081itcl::body Rappture::VtkContourViewer::Pan {option x y} {
1082    # Experimental stuff
1083    set w [winfo width $itk_component(view)]
1084    set h [winfo height $itk_component(view)]
1085    if { $option == "set" } {
1086        set x [expr $x / double($w)]
1087        set y [expr $y / double($h)]
1088        set _view(pan-x) [expr $_view(pan-x) + $x]
1089        set _view(pan-y) [expr $_view(pan-y) + $y]
1090        PanCamera
1091        set _settings($this-pan-x) $_view(pan-x)
1092        set _settings($this-pan-y) $_view(pan-y)
1093        return
1094    }
1095    if { $option == "click" } {
1096        set _click(x) $x
1097        set _click(y) $y
1098        $itk_component(view) configure -cursor hand1
1099    }
1100    if { $option == "drag" || $option == "release" } {
1101        set dx [expr ($_click(x) - $x)/double($w)]
1102        set dy [expr ($_click(y) - $y)/double($h)]
1103        set _click(x) $x
1104        set _click(y) $y
1105        set _view(pan-x) [expr $_view(pan-x) - $dx]
1106        set _view(pan-y) [expr $_view(pan-y) - $dy]
1107        PanCamera
1108        set _settings($this-pan-x) $_view(pan-x)
1109        set _settings($this-pan-y) $_view(pan-y)
1110    }
1111    if { $option == "release" } {
1112        $itk_component(view) configure -cursor ""
1113    }
1114}
1115
1116# ----------------------------------------------------------------------
1117# USAGE: FixSettings <what> ?<value>?
1118#
1119# Used internally to update rendering settings whenever parameters
1120# change in the popup settings panel.  Sends the new settings off
1121# to the back end.
1122# ----------------------------------------------------------------------
1123itcl::body Rappture::VtkContourViewer::FixSettings {what {value ""}} {
1124    switch -- $what {
1125        "opacity" {
1126            if {[isconnected]} {
1127                set val $_settings($this-opacity)
1128                set sval [expr { 0.01 * double($val) }]
1129                foreach dataset [CurrentDatasets] {
1130                    SendCmd "pseudocolor opacity $sval $dataset"
1131                }
1132            }
1133        }
1134        "isolines" {
1135            if {[isconnected]} {
1136                set bool $_settings($this-isolines)
1137                foreach dataset [CurrentDatasets] {
1138                    SendCmd "contour2d visible $bool $dataset"
1139                }
1140            }
1141        }
1142        "edges" {
1143            if {[isconnected]} {
1144                set bool $_settings($this-edges)
1145                foreach dataset [CurrentDatasets] {
1146                    SendCmd "pseudocolor edges $bool $dataset"
1147                }
1148            }
1149        }
1150        "colormap" {
1151            if {[isconnected]} {
1152                set bool $_settings($this-colormap)
1153                if { $bool } {
1154                    set linecolor "0.0 0.0 0.0"
1155                    set opacity 0.0
1156                } else {
1157                    set linecolor "1.0 1.0 1.0"
1158                    set opacity 1.0
1159                }
1160                foreach dataset [CurrentDatasets] {
1161                    SendCmd "pseudocolor visible $bool $dataset"
1162                    SendCmd "contour2d linecolor $linecolor $dataset"
1163                    SendCmd "pseudocolor linecolor $linecolor $dataset"
1164                }
1165            }
1166        }
1167        "axes" {
1168            if { [isconnected] } {
1169                set bool $_settings($this-axes)
1170                SendCmd "axis visible all $bool"
1171            }
1172        }
1173        "legend" {
1174            if { $_settings($this-legend) } {
1175                blt::table $itk_component(plotarea) \
1176                    0,0 $itk_component(view) -fill both \
1177                    0,1 $itk_component(legend) -fill y
1178                blt::table configure $itk_component(plotarea) c1 -resize none
1179            } else {
1180                blt::table forget $itk_component(legend)
1181            }
1182        }
1183        default {
1184            error "don't know how to fix $what"
1185        }
1186    }
1187}
1188
1189
1190#
1191# SetStyles --
1192#
1193itcl::body Rappture::VtkContourViewer::SetStyles { dataobj comp } {
1194    array set style {
1195        -color rainbow
1196        -levels 6
1197        -opacity 1.0
1198    }
1199    set tag $dataobj-$comp
1200    array set style [lindex [$dataobj components -style $comp] 0]
1201    set colormap "$style(-color):$style(-levels):$style(-opacity)"
1202    if { [info exists _colormaps($colormap)] } {
1203        puts stderr "Colormap $colormap already built"
1204    }
1205    if { ![info exists _dataset2style($tag)] } {
1206        set _dataset2style($tag) $colormap
1207        lappend _style2datasets($colormap) $tag
1208    }
1209    if { ![info exists _colormaps($colormap)] } {
1210        # Build the pseudo colormap if it doesn't exist.
1211        BuildColormap $colormap $dataobj $comp
1212        set _colormaps($colormap) 1
1213    }
1214    SendCmd "contour2d add numcontours $style(-levels) $tag\n"
1215    SendCmd "pseudocolor colormap $colormap $tag"
1216    return $colormap
1217}
1218
1219#
1220# BuildColormap --
1221#
1222itcl::body Rappture::VtkContourViewer::BuildColormap { colormap dataobj comp } {
1223    puts stderr "BuildColormap $colormap"
1224    array set style {
1225        -color rainbow
1226        -levels 6
1227        -opacity 1.0
1228    }
1229    array set style [lindex [$dataobj components -style $comp] 0]
1230
1231    if {$style(-color) == "rainbow"} {
1232        set style(-color) "white:yellow:green:cyan:blue:magenta"
1233    }
1234    set clist [split $style(-color) :]
1235    set cmap {}
1236    for {set i 0} {$i < [llength $clist]} {incr i} {
1237        set x [expr {double($i)/([llength $clist]-1)}]
1238        set color [lindex $clist $i]
1239        append cmap "$x [Color2RGB $color] "
1240    }
1241    if { [llength $cmap] == 0 } {
1242        set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0"
1243    }
1244    set tag $this-$colormap
1245    if { ![info exists _settings($tag-opacity)] } {
1246        set _settings($tag-opacity) $style(-opacity)
1247    }
1248    set max $_settings($tag-opacity)
1249
1250    set wmap "0.0 1.0 1.0 1.0"
1251    SendCmd "colormap add $colormap { $cmap } { $wmap }"
1252}
1253
1254# ----------------------------------------------------------------------
1255# CONFIGURATION OPTION: -plotbackground
1256# ----------------------------------------------------------------------
1257itcl::configbody Rappture::VtkContourViewer::plotbackground {
1258    if { [isconnected] } {
1259        foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1260        SendCmd "screen bgcolor $r $g $b"
1261    }
1262}
1263
1264# ----------------------------------------------------------------------
1265# CONFIGURATION OPTION: -plotforeground
1266# ----------------------------------------------------------------------
1267itcl::configbody Rappture::VtkContourViewer::plotforeground {
1268    if { [isconnected] } {
1269        foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1270        #fix this!
1271        #SendCmd "color background $r $g $b"
1272    }
1273}
1274
1275itcl::body Rappture::VtkContourViewer::limits { colormap } {
1276    set _limits(min) 0.0
1277    set _limits(max) 1.0
1278    if { ![info exists _style2datasets($colormap)] } {
1279        return [array get _limits]
1280    }
1281    set min ""; set max ""
1282    foreach tag $_style2datasets($colormap) {
1283        if { ![info exists _datasets($tag)] } {
1284            continue
1285        }
1286        if { ![info exists _limits($tag-min)] } {
1287            continue
1288        }
1289        if { $min == "" || $min > $_limits($tag-min) } {
1290            set min $_limits($tag-min)
1291        }
1292        if { $max == "" || $max < $_limits($tag-max) } {
1293            set max $_limits($tag-max)
1294        }
1295    }
1296    if { $min != "" } {
1297        set _limits(min) $min
1298    }
1299    if { $max != "" } {
1300        set _limits(max) $max
1301    }
1302    return [array get _limits]
1303}
1304
1305
1306itcl::body Rappture::VtkContourViewer::BuildViewTab {} {
1307
1308    set fg [option get $itk_component(hull) font Font]
1309    #set bfg [option get $itk_component(hull) boldFont Font]
1310
1311    set inner [$itk_component(main) insert end \
1312        -title "View Settings" \
1313        -icon [Rappture::icon wrench]]
1314    $inner configure -borderwidth 4
1315
1316    checkbutton $inner.isolines \
1317        -text "Isolines" \
1318        -variable [itcl::scope _settings($this-isolines)] \
1319        -command [itcl::code $this FixSettings isolines] \
1320        -font "Arial 9"
1321
1322    checkbutton $inner.axes \
1323        -text "Axes" \
1324        -variable [itcl::scope _settings($this-axes)] \
1325        -command [itcl::code $this FixSettings axes] \
1326        -font "Arial 9"
1327
1328    checkbutton $inner.colormap \
1329        -text "Colormap" \
1330        -variable [itcl::scope _settings($this-colormap)] \
1331        -command [itcl::code $this FixSettings colormap] \
1332        -font "Arial 9"
1333
1334    checkbutton $inner.legend \
1335        -text "Legend" \
1336        -variable [itcl::scope _settings($this-legend)] \
1337        -command [itcl::code $this FixSettings legend] \
1338        -font "Arial 9"
1339
1340    checkbutton $inner.edges \
1341        -text "Edges" \
1342        -variable [itcl::scope _settings($this-edges)] \
1343        -command [itcl::code $this FixSettings edges] \
1344        -font "Arial 9"
1345
1346    label $inner.clear -text "Clear" -font "Arial 9"
1347    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1348        -variable [itcl::scope _settings($this-opacity)] \
1349        -width 10 \
1350        -showvalue off -command [itcl::code $this FixSettings opacity]
1351    label $inner.opaque -text "Opaque" -font "Arial 9"
1352
1353    blt::table $inner \
1354        0,0 $inner.axes -columnspan 4 -anchor w -pady 2 \
1355        1,0 $inner.colormap -columnspan 4 -anchor w -pady 2 \
1356        3,0 $inner.isolines -columnspan 4 -anchor w -pady 2 \
1357        4,0 $inner.legend  -columnspan 4 -anchor w \
1358        6,0 $inner.edges -columnspan 4 -anchor w -pady 2 \
1359        7,0 $inner.clear -anchor e -pady 2 \
1360        7,1 $inner.opacity -columnspan 2 -pady 2 -fill x\
1361        7,3 $inner.opaque -anchor w -pady 2
1362
1363    blt::table configure $inner r* -resize none
1364    blt::table configure $inner r8 -resize expand
1365}
1366
1367itcl::body Rappture::VtkContourViewer::BuildCameraTab {} {
1368    set inner [$itk_component(main) insert end \
1369        -title "Camera Settings" \
1370        -icon [Rappture::icon camera]]
1371    $inner configure -borderwidth 4
1372
1373    set labels { phi theta psi pan-x pan-y zoom }
1374    set row 0
1375    foreach tag $labels {
1376        label $inner.${tag}label -text $tag -font "Arial 9"
1377        entry $inner.${tag} -font "Arial 9"  -bg white \
1378            -textvariable [itcl::scope _settings($this-$tag)]
1379        bind $inner.${tag} <KeyPress-Return> \
1380            [itcl::code $this camera set ${tag}]
1381        blt::table $inner \
1382            $row,0 $inner.${tag}label -anchor e -pady 2 \
1383            $row,1 $inner.${tag} -anchor w -pady 2
1384        blt::table configure $inner r$row -resize none
1385        incr row
1386    }
1387    blt::table configure $inner c0 c1 -resize none
1388    blt::table configure $inner c2 -resize expand
1389    blt::table configure $inner r$row -resize expand
1390}
1391
1392
1393#
1394#  camera --
1395#
1396itcl::body Rappture::VtkContourViewer::camera {option args} {
1397    switch -- $option {
1398        "show" {
1399            puts [array get _view]
1400        }
1401        "set" {
1402            set who [lindex $args 0]
1403            set x $_settings($this-$who)
1404            set code [catch { string is double $x } result]
1405            if { $code != 0 || !$result } {
1406                set _settings($this-$who) $_view($who)
1407                return
1408            }
1409            switch -- $who {
1410                "pan-x" - "pan-y" {
1411                    set _view($who) $_settings($this-$who)
1412                    PanCamera
1413                }
1414                "phi" - "theta" - "psi" {
1415                    set _view($who) $_settings($this-$who)
1416                    set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
1417                    #SendCmd "camera rotate $xyz"
1418                }
1419                "zoom" {
1420                    set _view($who) $_settings($this-$who)
1421                    #SendCmd "camera zoom $_view(zoom)"
1422                }
1423            }
1424        }
1425    }
1426}
1427
1428itcl::body Rappture::VtkContourViewer::ConvertToVtkData { dataobj comp } {
1429    foreach { x1 x2 xN y1 y2 yN } [$dataobj mesh $comp] break
1430    set values [$dataobj values $comp]
1431    append out "# vtk DataFile Version 2.0 \n"
1432    append out "Test data \n"
1433    append out "ASCII \n"
1434    append out "DATASET STRUCTURED_POINTS \n"
1435    append out "DIMENSIONS $xN $yN 1 \n"
1436    append out "ORIGIN 0 0 0 \n"
1437    append out "SPACING 1 1 1 \n"
1438    append out "POINT_DATA [expr $xN * $yN] \n"
1439    append out "SCALARS field float 1 \n"
1440    append out "LOOKUP_TABLE default \n"
1441    append out [join $values "\n"]
1442    append out "\n"
1443    return $out
1444}
1445
1446#
1447# MarchingAnts --
1448#
1449#       Called from "after" timer events.  This routine is changes
1450#       the dash offset of the selection outline rectangle to simulate
1451#       marching ants.
1452#
1453itcl::body Rappture::VtkContourViewer::MarchingAnts {} {
1454    set c $itk_component(view)
1455    if { [winfo exists $c] && ![winfo viewable $c] } {
1456        KillSelectionRectangle
1457        return
1458    }
1459    $c itemconfigure $_outline(id) -dashoffset $_outline(offset)
1460    incr _outline(offset)
1461    set _outline(afterId) [after 100 [itcl::code $this MarchingAnts]]
1462}
1463
1464#
1465# BeginSelectionRectangle --
1466#
1467#       Called from ButtonPress-1 events.  This routine creates the
1468#       the selection outline rectangle.  It also clears the selection
1469#       in the sensor tree.
1470#
1471itcl::body Rappture::VtkContourViewer::BeginSelectionRectangle { x y } {
1472    set c $itk_component(view)
1473    set x [$c canvasx $x]
1474    set y [$c canvasy $y]
1475    if { $_outline(id) >= 0 } {
1476        after cancel $_outline(afterId)
1477        set _outline(afterId) -1
1478        $c delete $_outline(id)
1479        set _outline(id) -1
1480    }
1481    set _outline(offset) 0
1482    set _outline(x1) $x
1483    set _outline(y1) $y
1484    set _outline(id) \
1485        [$c create line $x $y $x $y -dash "4 4" -width 2 -fill black]
1486    MarchingAnts
1487}
1488
1489#
1490# AdjustSelectionRectangle --
1491#
1492#       Called from B1-Motion events.  This routine redraws the selection
1493#       outline rectangle and redraws the sensors using the "selected"
1494#       icon.
1495#
1496itcl::body Rappture::VtkContourViewer::AdjustSelectionRectangle { x y } {
1497    set c $itk_component(view)
1498    set x [$c canvasx $x]
1499    set y [$c canvasy $y]
1500    $c coords $_outline(id) $_outline(x1) $_outline(y1) $_outline(x1) $y \
1501        $x $y $x $_outline(y1) $_outline(x1) $_outline(y1)
1502    set _outline(x2) $x
1503    set _outline(y2) $y
1504}
1505
1506#
1507# KillSelectionRectangle --
1508#
1509#       Removes the outline rectangle and adjusts the sensor icon
1510#       according to the sensor's selected/deselected status.
1511#
1512itcl::body Rappture::VtkContourViewer::KillSelectionRectangle { } {
1513    after cancel $_outline(afterId)
1514    set _outline(afterId) -1
1515    set c $itk_component(view)
1516    $c delete $_outline(id)
1517    set _outline(id) -1
1518}
1519
1520#
1521# EndSelectionRectangle --
1522#
1523#       Called from the ButtonRelease event to finish the outline of the
1524#       selection rectangle.  If the outline is too small (less than 10
1525#       pixels in length or width) the outline is removed and the selection
1526#       is ignored.  Otherwise a popup menu is automatically generated and
1527#       displayed.
1528#
1529itcl::body Rappture::VtkContourViewer::EndSelectionRectangle { x y } {
1530    set c $itk_component(view)
1531    AdjustSelectionRectangle $x $y
1532    set cx [$c canvasx $x]
1533    set cy [$c canvasy $y]
1534    set cw [winfo width $c]
1535    set ch [winfo height $c]
1536    if { abs($_outline(x1) - $cx) < 10 && abs($_outline(y1) - $cy) < 10 }  {
1537        KillSelectionRectangle
1538    } else {
1539        set w [expr $_outline(x2) - $_outline(x1)]
1540        set h [expr $_outline(y2) - $_outline(y1)]
1541        # Convert the zoom
1542        set _view(zoom-x) [expr $cw / $w * $_view(zoom-x)]
1543        set _view(zoom-y) [expr $ch / $h * $_view(zoom-y)]
1544        set w [expr $w * $_view(zoom-x)]
1545        set h [expr $h * $_view(zoom-y)]
1546        SendCmd "camera ortho $_outline(x1) $_outline(y1) $w $h"
1547        KillSelectionRectangle
1548    }
1549}
1550
1551itcl::body Rappture::VtkContourViewer::GetVtkData { args } {
1552    set bytes ""
1553    foreach dataobj [get] {
1554        foreach comp [$dataobj components] {
1555            set tag $dataobj-$comp
1556            set contents [ConvertToVtkData $dataobj $comp]
1557            append bytes "$contents\n\n"
1558        }
1559    }
1560    return [list .txt $bytes]
1561}
1562
1563itcl::body Rappture::VtkContourViewer::GetImage { args } {
1564    if { [image width $_image(download)] > 0 &&
1565         [image height $_image(download)] > 0 } {
1566        set bytes [$_image(download) data -format "jpeg -quality 100"]
1567        set bytes [Rappture::encoding::decode -as b64 $bytes]
1568        return [list .jpg $bytes]
1569    }
1570    return ""
1571}
1572
1573itcl::body Rappture::VtkContourViewer::BuildDownloadPopup { popup command } {
1574    Rappture::Balloon $popup \
1575        -title "[Rappture::filexfer::label downloadWord] as..."
1576    set inner [$popup component inner]
1577    label $inner.summary -text "" -anchor w
1578    radiobutton $inner.vtk_button -text "VTK data file" \
1579        -variable [itcl::scope _downloadPopup(format)] \
1580        -font "Helvetica 9 " \
1581        -value vtk 
1582    Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
1583    radiobutton $inner.image_button -text "Image File" \
1584        -variable [itcl::scope _downloadPopup(format)] \
1585        -value image
1586    Rappture::Tooltip::for $inner.image_button \
1587        "Save as digital image."
1588
1589    button $inner.ok -text "Save" \
1590        -highlightthickness 0 -pady 2 -padx 3 \
1591        -command $command \
1592        -compound left \
1593        -image [Rappture::icon download]
1594
1595    button $inner.cancel -text "Cancel" \
1596        -highlightthickness 0 -pady 2 -padx 3 \
1597        -command [list $popup deactivate] \
1598        -compound left \
1599        -image [Rappture::icon cancel]
1600
1601    blt::table $inner \
1602        0,0 $inner.summary -cspan 2  \
1603        1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
1604        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
1605        4,1 $inner.cancel -width .9i -fill y \
1606        4,0 $inner.ok -padx 2 -width .9i -fill y
1607    blt::table configure $inner r3 -height 4
1608    blt::table configure $inner r4 -pady 4
1609    raise $inner.image_button
1610    $inner.vtk_button invoke
1611    return $inner
1612}
1613
Note: See TracBrowser for help on using the repository browser.