source: trunk/gui/scripts/vtkisosurfaceviewer.tcl @ 4381

Last change on this file since 4381 was 4381, checked in by ldelgass, 10 years ago

opacity style setting fixes for VTK viewers (expect vtkvolumeviewer which does
not yet support the style setting). Also note that nanovisviewer (and
flowvisviewer?) have a regression which changes the -opacity style to [0,100]
instead of [0,1]

File size: 86.4 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: vtkisosurfaceviewer - Vtk 3D contour object viewer
4#
5#  It connects to the Vtk server running on a rendering farm,
6#  transmits data, and displays the results.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2005  Purdue Research Foundation
10#
11#  See the file "license.terms" for information on usage and
12#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13# ======================================================================
14package require Itk
15package require BLT
16#package require Img
17
18option add *VtkIsosurfaceViewer.width 4i widgetDefault
19option add *VtkIsosurfaceViewer*cursor crosshair widgetDefault
20option add *VtkIsosurfaceViewer.height 4i widgetDefault
21option add *VtkIsosurfaceViewer.foreground black widgetDefault
22option add *VtkIsosurfaceViewer.controlBackground gray widgetDefault
23option add *VtkIsosurfaceViewer.controlDarkBackground #999999 widgetDefault
24option add *VtkIsosurfaceViewer.plotBackground black widgetDefault
25option add *VtkIsosurfaceViewer.plotForeground white widgetDefault
26option add *VtkIsosurfaceViewer.font \
27    -*-helvetica-medium-r-normal-*-12-* widgetDefault
28
29# must use this name -- plugs into Rappture::resources::load
30proc VtkIsosurfaceViewer_init_resources {} {
31    Rappture::resources::register \
32        vtkvis_server Rappture::VtkIsosurfaceViewer::SetServerList
33}
34
35itcl::class Rappture::VtkIsosurfaceViewer {
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 parameters {title args} {
61        # do nothing
62    }
63    public method scale {args}
64
65    protected method Connect {}
66    protected method CurrentDatasets {args}
67    protected method Disconnect {}
68    protected method DoResize {}
69    protected method DoRotate {}
70    protected method AdjustSetting {what {value ""}}
71    protected method InitSettings { args  }
72    protected method Pan {option x y}
73    protected method Pick {x y}
74    protected method Rebuild {}
75    protected method ReceiveDataset { args }
76    protected method ReceiveImage { args }
77    protected method ReceiveLegend { colormap title vmin vmax size }
78    protected method Rotate {option x y}
79    protected method Zoom {option}
80
81    # The following methods are only used by this class.
82    private method BuildAxisTab {}
83    private method BuildCameraTab {}
84    private method BuildColormap { name }
85    private method BuildCutplaneTab {}
86    private method BuildDownloadPopup { widget command }
87    private method BuildIsosurfaceTab {}
88    private method Combo { option }
89    private method DrawLegend {}
90    private method EnterLegend { x y }
91    private method EventuallyResize { w h }
92    private method EventuallyRotate { q }
93    private method EventuallyRequestLegend {}
94    private method EventuallySetCutplane { axis args }
95    private method GetImage { args }
96    private method GetVtkData { args }
97    private method IsValidObject { dataobj }
98    private method LeaveLegend {}
99    private method MotionLegend { x y }
100    private method PanCamera {}
101    private method RequestLegend {}
102    private method SetLegendTip { x y }
103    private method SetObjectStyle { dataobj comp }
104    private method Slice {option args}
105    private method SetCurrentColormap { color }
106    private method SetOrientation { side }
107    private method UpdateContourList {}
108
109    private variable _arcball ""
110
111    private variable _dlist ""     ;    # list of data objects
112    private variable _obj2datasets
113    private variable _obj2ovride   ;    # maps dataobj => style override
114    private variable _datasets     ;    # contains all the dataobj-component
115                                   ;    # datasets in the server
116    private variable _colormaps    ;    # contains all the colormaps
117                                   ;    # in the server.
118    # The name of the current colormap used.  The colormap is global to all
119    # heightmaps displayed.
120    private variable _currentColormap ""
121    private variable _currentNumContours -1
122
123    private variable _dataset2style    ;# maps dataobj-component to transfunc
124
125    private variable _click        ;    # info used for rotate operations
126    private variable _limits       ;    # autoscale min/max for all axes
127    private variable _view         ;    # view params for 3D view
128    private variable _settings
129    private variable _style;            # Array of current component styles.
130    private variable _changed
131    private variable _initialStyle;     # Array of initial component styles.
132    private variable _reset 1;          # indicates if camera needs to be reset
133                                        # to starting position.
134
135    private variable _first ""     ;    # This is the topmost dataset.
136    private variable _start 0
137    private variable _title ""
138    private variable _isolines
139    private variable _contourList ""
140
141    common _downloadPopup;              # download options from popup
142    private common _hardcopy
143    private variable _width 0
144    private variable _height 0
145    private variable _resizePending 0
146    private variable _rotatePending 0
147    private variable _cutplanePending 0
148    private variable _legendPending 0
149    private variable _field      ""
150    private variable _colorMode "scalar";       #  Mode of colormap (vmag or scalar)
151    private variable _fieldNames {}
152    private variable _fields
153    private variable _curFldName ""
154    private variable _curFldLabel ""
155}
156
157itk::usual VtkIsosurfaceViewer {
158    keep -background -foreground -cursor -font
159    keep -plotbackground -plotforeground
160}
161
162# ----------------------------------------------------------------------
163# CONSTRUCTOR
164# ----------------------------------------------------------------------
165itcl::body Rappture::VtkIsosurfaceViewer::constructor {hostlist args} {
166    package require vtk
167    set _serverType "vtkvis"
168
169    # Rebuild event
170    $_dispatcher register !rebuild
171    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
172
173    # Resize event
174    $_dispatcher register !resize
175    $_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
176
177    # Rotate event
178    $_dispatcher register !rotate
179    $_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
180
181    # Legend event
182    $_dispatcher register !legend
183    $_dispatcher dispatch $this !legend "[itcl::code $this RequestLegend]; list"
184
185    # X-Cutplane event
186    $_dispatcher register !xcutplane
187    $_dispatcher dispatch $this !xcutplane \
188        "[itcl::code $this AdjustSetting -xcutplaneposition]; list"
189
190    # Y-Cutplane event
191    $_dispatcher register !ycutplane
192    $_dispatcher dispatch $this !ycutplane \
193        "[itcl::code $this AdjustSetting -ycutplaneposition]; list"
194
195    # Z-Cutplane event
196    $_dispatcher register !zcutplane
197    $_dispatcher dispatch $this !zcutplane \
198        "[itcl::code $this AdjustSetting -zcutplaneposition]; list"
199
200    #
201    # Populate parser with commands handle incoming requests
202    #
203    $_parser alias image [itcl::code $this ReceiveImage]
204    $_parser alias dataset [itcl::code $this ReceiveDataset]
205    $_parser alias legend [itcl::code $this ReceiveLegend]
206
207    # Initialize the view to some default parameters.
208    array set _view {
209        qw              0.853553
210        qx              -0.353553
211        qy              0.353553
212        qz              0.146447
213        zoom            1.0
214        xpan            0
215        ypan            0
216        ortho           0
217    }
218    set _arcball [blt::arcball create 100 100]
219    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
220    $_arcball quaternion $q
221
222    array set _settings {
223        -axesvisible                    1
224        -axislabelsvisible              1
225        -background                     black
226        -colormap                       BCGYR
227        -colormapvisible                1
228        -cutplaneedges                  0
229        -cutplanelighting               1
230        -cutplaneopacity                100
231        -cutplanepreinterp              1
232        -cutplanesvisible               0
233        -cutplanewireframe              0
234        -field                          "Default"
235        -isolinecolor                   white
236        -isosurfaceedges                0
237        -isosurfacelighting             1
238        -isosurfaceopacity              60
239        -isosurfacevisible              1
240        -isosurfacewireframe            0
241        -legendvisible                  1
242        -numcontours                    10
243        -outline                        0
244        -xaxisgrid                      0
245        -xcutplaneposition              50
246        -xcutplanevisible               1
247        -yaxisgrid                      0
248        -ycutplaneposition              50
249        -ycutplanevisible               1
250        -zaxisgrid                      0
251        -zcutplaneposition              50
252        -zcutplanevisible               1
253    }
254    array set _changed {
255        -isosurfaceopacity       0
256        -colormap                0
257        -numcontours             0
258    }
259
260    itk_component add view {
261        canvas $itk_component(plotarea).view \
262            -highlightthickness 0 -borderwidth 0
263    } {
264        usual
265        ignore -highlightthickness -borderwidth  -background
266    }
267
268    itk_component add fieldmenu {
269        menu $itk_component(plotarea).menu -bg black -fg white -relief flat \
270            -tearoff 0
271    } {
272        usual
273        ignore -background -foreground -relief -tearoff
274    }
275    set c $itk_component(view)
276    bind $c <Configure> [itcl::code $this EventuallyResize %w %h]
277    bind $c <4> [itcl::code $this Zoom in 0.25]
278    bind $c <5> [itcl::code $this Zoom out 0.25]
279    bind $c <KeyPress-Left>  [list %W xview scroll 10 units]
280    bind $c <KeyPress-Right> [list %W xview scroll -10 units]
281    bind $c <KeyPress-Up>    [list %W yview scroll 10 units]
282    bind $c <KeyPress-Down>  [list %W yview scroll -10 units]
283    bind $c <Enter> "focus %W"
284    bind $c <Control-F1> [itcl::code $this ToggleConsole]
285
286    # Fix the scrollregion in case we go off screen
287    $c configure -scrollregion [$c bbox all]
288
289    set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
290    set _map(cwidth) -1
291    set _map(cheight) -1
292    set _map(zoom) 1.0
293    set _map(original) ""
294
295    set f [$itk_component(main) component controls]
296    itk_component add reset {
297        button $f.reset -borderwidth 1 -padx 1 -pady 1 \
298            -highlightthickness 0 \
299            -image [Rappture::icon reset-view] \
300            -command [itcl::code $this Zoom reset]
301    } {
302        usual
303        ignore -highlightthickness
304    }
305    pack $itk_component(reset) -side top -padx 2 -pady 2
306    Rappture::Tooltip::for $itk_component(reset) \
307        "Reset the view to the default zoom level"
308
309    itk_component add zoomin {
310        button $f.zin -borderwidth 1 -padx 1 -pady 1 \
311            -highlightthickness 0 \
312            -image [Rappture::icon zoom-in] \
313            -command [itcl::code $this Zoom in]
314    } {
315        usual
316        ignore -highlightthickness
317    }
318    pack $itk_component(zoomin) -side top -padx 2 -pady 2
319    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
320
321    itk_component add zoomout {
322        button $f.zout -borderwidth 1 -padx 1 -pady 1 \
323            -highlightthickness 0 \
324            -image [Rappture::icon zoom-out] \
325            -command [itcl::code $this Zoom out]
326    } {
327        usual
328        ignore -highlightthickness
329    }
330    pack $itk_component(zoomout) -side top -padx 2 -pady 2
331    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
332
333    itk_component add contour {
334        Rappture::PushButton $f.contour \
335            -onimage [Rappture::icon volume-on] \
336            -offimage [Rappture::icon volume-off] \
337            -variable [itcl::scope _settings(-isosurfacevisible)] \
338            -command [itcl::code $this AdjustSetting -isosurfacevisible]
339    }
340    $itk_component(contour) select
341    Rappture::Tooltip::for $itk_component(contour) \
342        "Hide the isosurface"
343    pack $itk_component(contour) -padx 2 -pady 2
344
345    itk_component add cutplane {
346        Rappture::PushButton $f.cutplane \
347            -onimage [Rappture::icon cutbutton] \
348            -offimage [Rappture::icon cutbutton] \
349            -variable [itcl::scope _settings(-cutplanesvisible)] \
350            -command [itcl::code $this AdjustSetting -cutplanesvisible]
351    }
352    Rappture::Tooltip::for $itk_component(cutplane) \
353        "Show the cutplanes"
354    pack $itk_component(cutplane) -padx 2 -pady 2
355
356
357    if { [catch {
358        BuildIsosurfaceTab
359        BuildCutplaneTab
360        BuildAxisTab
361        BuildCameraTab
362    } errs] != 0 } {
363        puts stderr errs=$errs
364    }
365    # Legend
366
367    set _image(legend) [image create photo]
368    itk_component add legend {
369        canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0
370    } {
371        usual
372        ignore -highlightthickness
373        rename -background -plotbackground plotBackground Background
374    }
375
376    # Hack around the Tk panewindow.  The problem is that the requested
377    # size of the 3d view isn't set until an image is retrieved from
378    # the server.  So the panewindow uses the tiny size.
379    set w 10000
380    pack forget $itk_component(view)
381    blt::table $itk_component(plotarea) \
382        0,0 $itk_component(view) -fill both -reqwidth $w
383    blt::table configure $itk_component(plotarea) c1 -resize none
384
385    # Bindings for rotation via mouse
386    bind $itk_component(view) <ButtonPress-1> \
387        [itcl::code $this Rotate click %x %y]
388    bind $itk_component(view) <B1-Motion> \
389        [itcl::code $this Rotate drag %x %y]
390    bind $itk_component(view) <ButtonRelease-1> \
391        [itcl::code $this Rotate release %x %y]
392
393    # Bindings for panning via mouse
394    bind $itk_component(view) <ButtonPress-2> \
395        [itcl::code $this Pan click %x %y]
396    bind $itk_component(view) <B2-Motion> \
397        [itcl::code $this Pan drag %x %y]
398    bind $itk_component(view) <ButtonRelease-2> \
399        [itcl::code $this Pan release %x %y]
400
401    #bind $itk_component(view) <ButtonRelease-3> \
402    #    [itcl::code $this Pick %x %y]
403
404    # Bindings for panning via keyboard
405    bind $itk_component(view) <KeyPress-Left> \
406        [itcl::code $this Pan set -10 0]
407    bind $itk_component(view) <KeyPress-Right> \
408        [itcl::code $this Pan set 10 0]
409    bind $itk_component(view) <KeyPress-Up> \
410        [itcl::code $this Pan set 0 -10]
411    bind $itk_component(view) <KeyPress-Down> \
412        [itcl::code $this Pan set 0 10]
413    bind $itk_component(view) <Shift-KeyPress-Left> \
414        [itcl::code $this Pan set -2 0]
415    bind $itk_component(view) <Shift-KeyPress-Right> \
416        [itcl::code $this Pan set 2 0]
417    bind $itk_component(view) <Shift-KeyPress-Up> \
418        [itcl::code $this Pan set 0 -2]
419    bind $itk_component(view) <Shift-KeyPress-Down> \
420        [itcl::code $this Pan set 0 2]
421
422    # Bindings for zoom via keyboard
423    bind $itk_component(view) <KeyPress-Prior> \
424        [itcl::code $this Zoom out]
425    bind $itk_component(view) <KeyPress-Next> \
426        [itcl::code $this Zoom in]
427
428    bind $itk_component(view) <Enter> "focus $itk_component(view)"
429
430    if {[string equal "x11" [tk windowingsystem]]} {
431        # Bindings for zoom via mouse
432        bind $itk_component(view) <4> [itcl::code $this Zoom out]
433        bind $itk_component(view) <5> [itcl::code $this Zoom in]
434    }
435
436    set _image(download) [image create photo]
437
438    eval itk_initialize $args
439
440    EnableWaitDialog 500
441    Connect
442    update
443}
444
445# ----------------------------------------------------------------------
446# DESTRUCTOR
447# ----------------------------------------------------------------------
448itcl::body Rappture::VtkIsosurfaceViewer::destructor {} {
449    Disconnect
450    image delete $_image(plot)
451    image delete $_image(download)
452    catch { blt::arcball destroy $_arcball }
453}
454
455itcl::body Rappture::VtkIsosurfaceViewer::DoResize {} {
456    if { $_width < 2 } {
457        set _width 500
458    }
459    if { $_height < 2 } {
460        set _height 500
461    }
462    set _start [clock clicks -milliseconds]
463    SendCmd "screen size $_width $_height"
464
465    EventuallyRequestLegend
466    set _resizePending 0
467}
468
469itcl::body Rappture::VtkIsosurfaceViewer::DoRotate {} {
470    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
471    SendCmd "camera orient $q"
472    set _rotatePending 0
473}
474
475itcl::body Rappture::VtkIsosurfaceViewer::EventuallyRequestLegend {} {
476    if { !$_legendPending } {
477        set _legendPending 1
478        $_dispatcher event -idle !legend
479    }
480}
481
482itcl::body Rappture::VtkIsosurfaceViewer::EventuallyResize { w h } {
483    set _width $w
484    set _height $h
485    $_arcball resize $w $h
486    if { !$_resizePending } {
487        set _resizePending 1
488        $_dispatcher event -after 400 !resize
489    }
490}
491
492set rotate_delay 100
493
494itcl::body Rappture::VtkIsosurfaceViewer::EventuallyRotate { q } {
495    foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break
496    if { !$_rotatePending } {
497        set _rotatePending 1
498        global rotate_delay
499        $_dispatcher event -after $rotate_delay !rotate
500    }
501}
502
503itcl::body Rappture::VtkIsosurfaceViewer::EventuallySetCutplane { axis args } {
504    if { !$_cutplanePending } {
505        set _cutplanePending 1
506        $_dispatcher event -after 100 !${axis}cutplane
507    }
508}
509
510# ----------------------------------------------------------------------
511# USAGE: add <dataobj> ?<settings>?
512#
513# Clients use this to add a data object to the plot.  The optional
514# <settings> are used to configure the plot.  Allowed settings are
515# -color, -brightness, -width, -linestyle, and -raise.
516# ----------------------------------------------------------------------
517itcl::body Rappture::VtkIsosurfaceViewer::add {dataobj {settings ""}} {
518    if { ![$dataobj isvalid] } {
519        return;                         # Object doesn't contain valid data.
520    }
521    array set params {
522        -color auto
523        -width 1
524        -linestyle solid
525        -brightness 0
526        -raise 0
527        -description ""
528        -param ""
529        -type ""
530    }
531    array set params $settings
532    set params(-description) ""
533    set params(-param) ""
534    array set params $settings
535
536    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
537        # can't handle -autocolors yet
538        set params(-color) black
539    }
540    set pos [lsearch -exact $_dlist $dataobj]
541    if {$pos < 0} {
542        lappend _dlist $dataobj
543    }
544    set _obj2ovride($dataobj-color) $params(-color)
545    set _obj2ovride($dataobj-width) $params(-width)
546    set _obj2ovride($dataobj-raise) $params(-raise)
547    $_dispatcher event -idle !rebuild
548}
549
550
551# ----------------------------------------------------------------------
552# USAGE: delete ?<dataobj1> <dataobj2> ...?
553#
554#       Clients use this to delete a dataobj from the plot.  If no dataobjs
555#       are specified, then all dataobjs are deleted.  No data objects are
556#       deleted.  They are only removed from the display list.
557#
558# ----------------------------------------------------------------------
559itcl::body Rappture::VtkIsosurfaceViewer::delete {args} {
560    if { [llength $args] == 0} {
561        set args $_dlist
562    }
563    # Delete all specified dataobjs
564    set changed 0
565    foreach dataobj $args {
566        set pos [lsearch -exact $_dlist $dataobj]
567        if { $pos < 0 } {
568            continue;                   # Don't know anything about it.
569        }
570        # Remove it from the dataobj list.
571        set _dlist [lreplace $_dlist $pos $pos]
572        array unset _obj2ovride $dataobj-*
573        array unset _settings $dataobj-*
574        set changed 1
575    }
576    # If anything changed, then rebuild the plot
577    if { $changed } {
578        $_dispatcher event -idle !rebuild
579    }
580}
581
582# ----------------------------------------------------------------------
583# USAGE: get ?-objects?
584# USAGE: get ?-visible?
585# USAGE: get ?-image view?
586#
587# Clients use this to query the list of objects being plotted, in
588# order from bottom to top of this result.  The optional "-image"
589# flag can also request the internal images being shown.
590# ----------------------------------------------------------------------
591itcl::body Rappture::VtkIsosurfaceViewer::get {args} {
592    if {[llength $args] == 0} {
593        set args "-objects"
594    }
595
596    set op [lindex $args 0]
597    switch -- $op {
598        "-objects" {
599            # put the dataobj list in order according to -raise options
600            set dlist {}
601            foreach dataobj $_dlist {
602                if { ![IsValidObject $dataobj] } {
603                    continue
604                }
605                if {[info exists _obj2ovride($dataobj-raise)] &&
606                    $_obj2ovride($dataobj-raise)} {
607                    set dlist [linsert $dlist 0 $dataobj]
608                } else {
609                    lappend dlist $dataobj
610                }
611            }
612            return $dlist
613        }
614        "-visible" {
615            set dlist {}
616            foreach dataobj $_dlist {
617                if { ![IsValidObject $dataobj] } {
618                    continue
619                }
620                if { ![info exists _obj2ovride($dataobj-raise)] } {
621                    # No setting indicates that the object isn't visible.
622                    continue
623                }
624                # Otherwise use the -raise parameter to put the object to
625                # the front of the list.
626                if { $_obj2ovride($dataobj-raise) } {
627                    set dlist [linsert $dlist 0 $dataobj]
628                } else {
629                    lappend dlist $dataobj
630                }
631            }
632            return $dlist
633        }           
634        -image {
635            if {[llength $args] != 2} {
636                error "wrong # args: should be \"get -image view\""
637            }
638            switch -- [lindex $args end] {
639                view {
640                    return $_image(plot)
641                }
642                default {
643                    error "bad image name \"[lindex $args end]\": should be view"
644                }
645            }
646        }
647        default {
648            error "bad option \"$op\": should be -objects or -image"
649        }
650    }
651}
652
653# ----------------------------------------------------------------------
654# USAGE: scale ?<data1> <data2> ...?
655#
656# Sets the default limits for the overall plot according to the
657# limits of the data for all of the given <data> objects.  This
658# accounts for all objects--even those not showing on the screen.
659# Because of this, the limits are appropriate for all objects as
660# the user scans through data in the ResultSet viewer.
661# ----------------------------------------------------------------------
662itcl::body Rappture::VtkIsosurfaceViewer::scale { args } {
663    foreach dataobj $args {
664        if { ![$dataobj isvalid] } {
665            continue;                   # Object doesn't contain valid data.
666        }
667        foreach axis { x y z } {
668            set lim [$dataobj limits $axis]
669            if { ![info exists _limits($axis)] } {
670                set _limits($axis) $lim
671                continue
672            }
673            foreach {min max} $lim break
674            foreach {amin amax} $_limits($axis) break
675            if { $amin > $min } {
676                set amin $min
677            }
678            if { $amax < $max } {
679                set amax $max
680            }
681            set _limits($axis) [list $amin $amax]
682        }
683        foreach { fname lim } [$dataobj fieldlimits] {
684            if { ![info exists _limits($fname)] } {
685                set _limits($fname) $lim
686                continue
687            }
688            foreach {min max} $lim break
689            foreach {fmin fmax} $_limits($fname) break
690            if { $fmin > $min } {
691                set fmin $min
692            }
693            if { $fmax < $max } {
694                set fmax $max
695            }
696            set _limits($fname) [list $fmin $fmax]
697        }
698    }
699}
700
701# ----------------------------------------------------------------------
702# USAGE: download coming
703# USAGE: download controls <downloadCommand>
704# USAGE: download now
705#
706# Clients use this method to create a downloadable representation
707# of the plot.  Returns a list of the form {ext string}, where
708# "ext" is the file extension (indicating the type of data) and
709# "string" is the data itself.
710# ----------------------------------------------------------------------
711itcl::body Rappture::VtkIsosurfaceViewer::download {option args} {
712    switch $option {
713        coming {
714            if {[catch {
715                blt::winop snap $itk_component(plotarea) $_image(download)
716            }]} {
717                $_image(download) configure -width 1 -height 1
718                $_image(download) put #000000
719            }
720        }
721        controls {
722            set popup .vtkviewerdownload
723            if { ![winfo exists .vtkviewerdownload] } {
724                set inner [BuildDownloadPopup $popup [lindex $args 0]]
725            } else {
726                set inner [$popup component inner]
727            }
728            set _downloadPopup(image_controls) $inner.image_frame
729            set num [llength [get]]
730            set num [expr {($num == 1) ? "1 result" : "$num results"}]
731            set word [Rappture::filexfer::label downloadWord]
732            $inner.summary configure -text "$word $num in the following format:"
733            update idletasks            ;# Fix initial sizes
734            return $popup
735        }
736        now {
737            set popup .vtkviewerdownload
738            if {[winfo exists .vtkviewerdownload]} {
739                $popup deactivate
740            }
741            switch -- $_downloadPopup(format) {
742                "image" {
743                    return [$this GetImage [lindex $args 0]]
744                }
745                "vtk" {
746                    return [$this GetVtkData [lindex $args 0]]
747                }
748            }
749            return ""
750        }
751        default {
752            error "bad option \"$option\": should be coming, controls, now"
753        }
754    }
755}
756
757# ----------------------------------------------------------------------
758# USAGE: Connect ?<host:port>,<host:port>...?
759#
760# Clients use this method to establish a connection to a new
761# server, or to reestablish a connection to the previous server.
762# Any existing connection is automatically closed.
763# ----------------------------------------------------------------------
764itcl::body Rappture::VtkIsosurfaceViewer::Connect {} {
765    set _hosts [GetServerList "vtkvis"]
766    if { "" == $_hosts } {
767        return 0
768    }
769    set result [VisViewer::Connect $_hosts]
770    if { $result } {
771        if { $_reportClientInfo }  {
772            # Tell the server the viewer, hub, user and session.
773            # Do this immediately on connect before buffering any commands
774            global env
775
776            set info {}
777            set user "???"
778            if { [info exists env(USER)] } {
779                set user $env(USER)
780            }
781            set session "???"
782            if { [info exists env(SESSION)] } {
783                set session $env(SESSION)
784            }
785            lappend info "hub" [exec hostname]
786            lappend info "client" "vtkisosurfaceviewer"
787            lappend info "user" $user
788            lappend info "session" $session
789            SendCmd "clientinfo [list $info]"
790        }
791
792        set w [winfo width $itk_component(view)]
793        set h [winfo height $itk_component(view)]
794        EventuallyResize $w $h
795    }
796    return $result
797}
798
799#
800# isconnected --
801#
802#       Indicates if we are currently connected to the visualization server.
803#
804itcl::body Rappture::VtkIsosurfaceViewer::isconnected {} {
805    return [VisViewer::IsConnected]
806}
807
808#
809# disconnect --
810#
811itcl::body Rappture::VtkIsosurfaceViewer::disconnect {} {
812    Disconnect
813    set _reset 1
814}
815
816#
817# Disconnect --
818#
819#       Clients use this method to disconnect from the current rendering
820#       server.
821#
822itcl::body Rappture::VtkIsosurfaceViewer::Disconnect {} {
823    VisViewer::Disconnect
824
825    $_dispatcher cancel !rebuild
826    $_dispatcher cancel !resize
827    $_dispatcher cancel !rotate
828    $_dispatcher cancel !xcutplane
829    $_dispatcher cancel !ycutplane
830    $_dispatcher cancel !zcutplane
831    $_dispatcher cancel !legend
832    # disconnected -- no more data sitting on server
833    set _outbuf ""
834    array unset _datasets
835    array unset _data
836    array unset _colormaps
837    array unset _seeds
838    array unset _dataset2style
839    array unset _obj2datasets
840}
841
842# ----------------------------------------------------------------------
843# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
844#
845# Invoked automatically whenever the "image" command comes in from
846# the rendering server.  Indicates that binary image data with the
847# specified <size> will follow.
848# ----------------------------------------------------------------------
849itcl::body Rappture::VtkIsosurfaceViewer::ReceiveImage { args } {
850    array set info {
851        -token "???"
852        -bytes 0
853        -type image
854    }
855    array set info $args
856    set bytes [ReceiveBytes $info(-bytes)]
857    if { $info(-type) == "image" } {
858        if 0 {
859            set f [open "last.ppm" "w"]
860            puts $f $bytes
861            close $f
862        }
863        $_image(plot) configure -data $bytes
864        #set time [clock seconds]
865        #set date [clock format $time]
866        #set w [image width $_image(plot)]
867        #set h [image height $_image(plot)]
868        #puts stderr "$date: received image ${w}x${h} image"       
869        if { $_start > 0 } {
870            set finish [clock clicks -milliseconds]
871            #puts stderr "round trip time [expr $finish -$_start] milliseconds"
872            set _start 0
873        }
874    } elseif { $info(type) == "print" } {
875        set tag $this-print-$info(-token)
876        set _hardcopy($tag) $bytes
877    }
878}
879
880#
881# ReceiveDataset --
882#
883itcl::body Rappture::VtkIsosurfaceViewer::ReceiveDataset { args } {
884    if { ![isconnected] } {
885        return
886    }
887    set option [lindex $args 0]
888    switch -- $option {
889        "scalar" {
890            set option [lindex $args 1]
891            switch -- $option {
892                "world" {
893                    foreach { x y z value tag } [lrange $args 2 end] break
894                }
895                "pixel" {
896                    foreach { x y value tag } [lrange $args 2 end] break
897                }
898            }
899        }
900        "vector" {
901            set option [lindex $args 1]
902            switch -- $option {
903                "world" {
904                    foreach { x y z vx vy vz tag } [lrange $args 2 end] break
905                }
906                "pixel" {
907                    foreach { x y vx vy vz tag } [lrange $args 2 end] break
908                }
909            }
910        }
911        "names" {
912            foreach { name } [lindex $args 1] {
913                #puts stderr "Dataset: $name"
914            }
915        }
916        default {
917            error "unknown dataset option \"$option\" from server"
918        }
919    }
920}
921
922# ----------------------------------------------------------------------
923# USAGE: Rebuild
924#
925# Called automatically whenever something changes that affects the
926# data in the widget.  Clears any existing data and rebuilds the
927# widget to display new data.
928# ----------------------------------------------------------------------
929itcl::body Rappture::VtkIsosurfaceViewer::Rebuild {} {
930    set w [winfo width $itk_component(view)]
931    set h [winfo height $itk_component(view)]
932    if { $w < 2 || $h < 2 } {
933        $_dispatcher event -idle !rebuild
934        return
935    }
936
937    # Turn on buffering of commands to the server.  We don't want to
938    # be preempted by a server disconnect/reconnect (which automatically
939    # generates a new call to Rebuild).   
940    StartBufferingCommands
941
942    if { $_reset } {
943        set _width $w
944        set _height $h
945        $_arcball resize $w $h
946        DoResize
947        #
948        # Reset the camera and other view parameters
949        #
950        set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
951        $_arcball quaternion $q
952        if {$_view(ortho)} {
953            SendCmd "camera mode ortho"
954        } else {
955            SendCmd "camera mode persp"
956        }
957        DoRotate
958        PanCamera
959        set _first ""
960        InitSettings -xaxisgrid -yaxisgrid -zaxisgrid -axismode \
961            -axesvisible -axislabelsvisible
962        foreach axis { x y z } {
963            SendCmd "axis lformat $axis %g"
964        }
965        StopBufferingCommands
966        SendCmd "imgflush"
967        StartBufferingCommands
968    }
969    set _first ""
970    SendCmd "dataset visible 0"
971    foreach dataobj [get -objects] {
972        if { [info exists _obj2ovride($dataobj-raise)] &&  $_first == "" } {
973            set _first $dataobj
974        }
975        set _obj2datasets($dataobj) ""
976        foreach comp [$dataobj components] {
977            set tag $dataobj-$comp
978            if { ![info exists _datasets($tag)] } {
979                set bytes [$dataobj vtkdata $comp]
980                if 0 {
981                    set f [open "/tmp/isosurface.vtk" "w"]
982                    puts $f $bytes
983                    close $f
984                }
985                set length [string length $bytes]
986                if { $_reportClientInfo }  {
987                    set info {}
988                    lappend info "tool_id"       [$dataobj hints toolId]
989                    lappend info "tool_name"     [$dataobj hints toolName]
990                    lappend info "tool_version"  [$dataobj hints toolRevision]
991                    lappend info "tool_title"    [$dataobj hints toolTitle]
992                    lappend info "dataset_label" [$dataobj hints label]
993                    lappend info "dataset_size"  $length
994                    lappend info "dataset_tag"   $tag
995                    SendCmd "clientinfo [list $info]"
996                }
997                append _outbuf "dataset add $tag data follows $length\n"
998                append _outbuf $bytes
999                set _datasets($tag) 1
1000                SetObjectStyle $dataobj $comp
1001            }
1002            lappend _obj2datasets($dataobj) $tag
1003            if { [info exists _obj2ovride($dataobj-raise)] } {
1004                SendCmd "contour3d visible 1 $tag"
1005            }
1006        }
1007    }
1008
1009    if { $_first != "" } {
1010        $itk_component(field) choices delete 0 end
1011        $itk_component(fieldmenu) delete 0 end
1012        array unset _fields
1013        set _curFldName ""
1014        foreach cname [$_first components] {
1015            foreach fname [$_first fieldnames $cname] {
1016                if { [info exists _fields($fname)] } {
1017                    continue
1018                }
1019                foreach { label units components } \
1020                    [$_first fieldinfo $fname] break
1021                $itk_component(field) choices insert end "$fname" "$label"
1022                $itk_component(fieldmenu) add radiobutton -label "$label" \
1023                    -value $label -variable [itcl::scope _curFldLabel] \
1024                    -selectcolor red \
1025                    -activebackground $itk_option(-plotbackground) \
1026                    -activeforeground $itk_option(-plotforeground) \
1027                    -font "Arial 8" \
1028                    -command [itcl::code $this Combo invoke]
1029                set _fields($fname) [list $label $units $components]
1030                if { $_curFldName == "" } {
1031                    set _curFldName $fname
1032                    set _curFldLabel $label
1033                }
1034            }
1035        }
1036        $itk_component(field) value $_curFldLabel
1037    }
1038    InitSettings -cutplanesvisible -isosurfacevisible -outline
1039    if { $_reset } {
1040        # These are settings that rely on a dataset being loaded.
1041        InitSettings \
1042            -isosurfacelighting \
1043            -field \
1044            -isosurfacevisible \
1045            -isosurfaceedges -isosurfacelighting -isosurfaceopacity \
1046            -isosurfacewireframe \
1047            -cutplanesvisible \
1048            -xcutplaneposition -ycutplaneposition -zcutplaneposition \
1049            -xcutplanevisible -ycutplanevisible -zcutplanevisible \
1050            -cutplanepreinterp -numcontours
1051
1052        Zoom reset
1053        foreach axis { x y z } {
1054            # Another problem fixed by a <view>. We looking into a data
1055            # object for the name of the axes. This should be global to
1056            # the viewer itself.
1057            set label [$_first hints ${axis}label]
1058            if { $label == "" } {
1059                set label [string toupper $axis]
1060            }
1061            # May be a space in the axis label.
1062            SendCmd [list axis name $axis $label]
1063        }
1064        if { [array size _fields] < 2 } {
1065            blt::table forget $itk_component(field) $itk_component(field_l)
1066        }
1067        set _reset 0
1068    }
1069
1070    # Actually write the commands to the server socket.  If it fails, we don't
1071    # care.  We're finished here.
1072    blt::busy hold $itk_component(hull)
1073    StopBufferingCommands;              # Turn off buffering and send commands.
1074    blt::busy release $itk_component(hull)
1075}
1076
1077# ----------------------------------------------------------------------
1078# USAGE: CurrentDatasets ?-all -visible? ?dataobjs?
1079#
1080# Returns a list of server IDs for the current datasets being displayed.  This
1081# is normally a single ID, but it might be a list of IDs if the current data
1082# object has multiple components.
1083# ----------------------------------------------------------------------
1084itcl::body Rappture::VtkIsosurfaceViewer::CurrentDatasets {args} {
1085    set flag [lindex $args 0]
1086    switch -- $flag {
1087        "-all" {
1088            if { [llength $args] > 1 } {
1089                error "CurrentDatasets: can't specify dataobj after \"-all\""
1090            }
1091            set dlist [get -objects]
1092        }
1093        "-visible" {
1094            if { [llength $args] > 1 } {
1095                set dlist {}
1096                set args [lrange $args 1 end]
1097                foreach dataobj $args {
1098                    if { [info exists _obj2ovride($dataobj-raise)] } {
1099                        lappend dlist $dataobj
1100                    }
1101                }
1102            } else {
1103                set dlist [get -visible]
1104            }
1105        }           
1106        default {
1107            set dlist $args
1108        }
1109    }
1110    set rlist ""
1111    foreach dataobj $dlist {
1112        foreach comp [$dataobj components] {
1113            set tag $dataobj-$comp
1114            if { [info exists _datasets($tag)] && $_datasets($tag) } {
1115                lappend rlist $tag
1116            }
1117        }
1118    }
1119    return $rlist
1120}
1121
1122# ----------------------------------------------------------------------
1123# USAGE: Zoom in
1124# USAGE: Zoom out
1125# USAGE: Zoom reset
1126#
1127# Called automatically when the user clicks on one of the zoom
1128# controls for this widget.  Changes the zoom for the current view.
1129# ----------------------------------------------------------------------
1130itcl::body Rappture::VtkIsosurfaceViewer::Zoom {option} {
1131    switch -- $option {
1132        "in" {
1133            set _view(zoom) [expr {$_view(zoom)*1.25}]
1134            SendCmd "camera zoom $_view(zoom)"
1135        }
1136        "out" {
1137            set _view(zoom) [expr {$_view(zoom)*0.8}]
1138            SendCmd "camera zoom $_view(zoom)"
1139        }
1140        "reset" {
1141            array set _view {
1142                qw     0.853553
1143                qx     -0.353553
1144                qy     0.353553
1145                qz     0.146447
1146                zoom   1.0
1147                xpan   0
1148                ypan   0
1149            }
1150            if { $_first != "" } {
1151                set location [$_first hints camera]
1152                if { $location != "" } {
1153                    array set _view $location
1154                }
1155            }
1156            set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1157            $_arcball quaternion $q
1158            DoRotate
1159            SendCmd "camera reset"
1160        }
1161    }
1162}
1163
1164itcl::body Rappture::VtkIsosurfaceViewer::PanCamera {} {
1165    set x $_view(xpan)
1166    set y $_view(ypan)
1167    SendCmd "camera pan $x $y"
1168}
1169
1170
1171# ----------------------------------------------------------------------
1172# USAGE: Rotate click <x> <y>
1173# USAGE: Rotate drag <x> <y>
1174# USAGE: Rotate release <x> <y>
1175#
1176# Called automatically when the user clicks/drags/releases in the
1177# plot area.  Moves the plot according to the user's actions.
1178# ----------------------------------------------------------------------
1179itcl::body Rappture::VtkIsosurfaceViewer::Rotate {option x y} {
1180    switch -- $option {
1181        "click" {
1182            $itk_component(view) configure -cursor fleur
1183            set _click(x) $x
1184            set _click(y) $y
1185        }
1186        "drag" {
1187            if {[array size _click] == 0} {
1188                Rotate click $x $y
1189            } else {
1190                set w [winfo width $itk_component(view)]
1191                set h [winfo height $itk_component(view)]
1192                if {$w <= 0 || $h <= 0} {
1193                    return
1194                }
1195
1196                if {[catch {
1197                    # this fails sometimes for no apparent reason
1198                    set dx [expr {double($x-$_click(x))/$w}]
1199                    set dy [expr {double($y-$_click(y))/$h}]
1200                }]} {
1201                    return
1202                }
1203                if { $dx == 0 && $dy == 0 } {
1204                    return
1205                }
1206                set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1207                EventuallyRotate $q
1208                set _click(x) $x
1209                set _click(y) $y
1210            }
1211        }
1212        "release" {
1213            Rotate drag $x $y
1214            $itk_component(view) configure -cursor ""
1215            catch {unset _click}
1216        }
1217        default {
1218            error "bad option \"$option\": should be click, drag, release"
1219        }
1220    }
1221}
1222
1223itcl::body Rappture::VtkIsosurfaceViewer::Pick {x y} {
1224    foreach tag [CurrentDatasets -visible] {
1225        SendCmdNoSplash "dataset getscalar pixel $x $y $tag"
1226    }
1227}
1228
1229# ----------------------------------------------------------------------
1230# USAGE: $this Pan click x y
1231#        $this Pan drag x y
1232#        $this Pan release x y
1233#
1234# Called automatically when the user clicks on one of the zoom
1235# controls for this widget.  Changes the zoom for the current view.
1236# ----------------------------------------------------------------------
1237itcl::body Rappture::VtkIsosurfaceViewer::Pan {option x y} {
1238    switch -- $option {
1239        "set" {
1240            set w [winfo width $itk_component(view)]
1241            set h [winfo height $itk_component(view)]
1242            set x [expr $x / double($w)]
1243            set y [expr $y / double($h)]
1244            set _view(xpan) [expr $_view(xpan) + $x]
1245            set _view(ypan) [expr $_view(ypan) + $y]
1246            PanCamera
1247            return
1248        }
1249        "click" {
1250            set _click(x) $x
1251            set _click(y) $y
1252            $itk_component(view) configure -cursor hand1
1253        }
1254        "drag" {
1255            if { ![info exists _click(x)] } {
1256                set _click(x) $x
1257            }
1258            if { ![info exists _click(y)] } {
1259                set _click(y) $y
1260            }
1261            set w [winfo width $itk_component(view)]
1262            set h [winfo height $itk_component(view)]
1263            set dx [expr ($_click(x) - $x)/double($w)]
1264            set dy [expr ($_click(y) - $y)/double($h)]
1265            set _click(x) $x
1266            set _click(y) $y
1267            set _view(xpan) [expr $_view(xpan) - $dx]
1268            set _view(ypan) [expr $_view(ypan) - $dy]
1269            PanCamera
1270        }
1271        "release" {
1272            Pan drag $x $y
1273            $itk_component(view) configure -cursor ""
1274        }
1275        default {
1276            error "unknown option \"$option\": should set, click, drag, or release"
1277        }
1278    }
1279}
1280
1281# ----------------------------------------------------------------------
1282# USAGE: InitSettings <what> ?<value>?
1283#
1284# Used internally to update rendering settings whenever parameters
1285# change in the popup settings panel.  Sends the new settings off
1286# to the back end.
1287# ----------------------------------------------------------------------
1288itcl::body Rappture::VtkIsosurfaceViewer::InitSettings { args } {
1289    foreach spec $args {
1290        if { [info exists _settings($_first-$spec)] } {
1291            # Reset global setting with dataobj specific setting
1292            set _settings($spec) $_settings($_first-$spec)
1293        }
1294        AdjustSetting $spec
1295    }
1296}
1297
1298#
1299# AdjustSetting --
1300#
1301#       Changes/updates a specific setting in the widget.  There are
1302#       usually user-setable option.  Commands are sent to the render
1303#       server.
1304#
1305itcl::body Rappture::VtkIsosurfaceViewer::AdjustSetting {what {value ""}} {
1306    if { ![isconnected] } {
1307        return
1308    }
1309    switch -- $what {
1310        "-background" {
1311            set bgcolor [$itk_component(background) value]
1312            array set fgcolors {
1313                "black" "white"
1314                "white" "black"
1315                "grey"  "black"
1316            }
1317            configure -plotbackground $bgcolor \
1318                -plotforeground $fgcolors($bgcolor)
1319            $itk_component(view) delete "legend"
1320            DrawLegend
1321        }
1322        "-axesvisible" {
1323            set bool $_settings(-axesvisible)
1324            SendCmd "axis visible all $bool"
1325        }
1326        "-axislabelsvisible" {
1327            set bool $_settings(-axislabelsvisible)
1328            SendCmd "axis labels all $bool"
1329        }
1330        "-xaxisgrid" - "-yaxisgrid" - "-zaxisgrid" {
1331            set axis [string tolower [string range $what 1 1]]
1332            set bool $_settings($what)
1333            SendCmd "axis grid $axis $bool"
1334        }
1335        "-axismode" {
1336            set mode [$itk_component(axisMode) value]
1337            set mode [$itk_component(axisMode) translate $mode]
1338            set _settings($what) $mode
1339            SendCmd "axis flymode $mode"
1340        }
1341        "-cutplaneedges" {
1342            set bool $_settings($what)
1343            SendCmd "cutplane edges $bool"
1344        }
1345        "-cutplanesvisible" {
1346            set bool $_settings($what)
1347            SendCmd "cutplane visible $bool"
1348        }
1349        "-cutplanewireframe" {
1350            set bool $_settings($what)
1351            SendCmd "cutplane wireframe $bool"
1352        }
1353        "-cutplanelighting" {
1354            set bool $_settings($what)
1355            SendCmd "cutplane lighting $bool"
1356        }
1357        "-cutplaneopacity" {
1358            set val $_settings($what)
1359            set sval [expr { 0.01 * double($val) }]
1360            SendCmd "cutplane opacity $sval"
1361        }
1362        "-cutplanepreinterp" {
1363            set bool $_settings($what)
1364            SendCmd "cutplane preinterp $bool"
1365        }
1366        "-xcutplanevisible" - "-ycutplanevisible" - "-zcutplanevisible" {
1367            set axis [string tolower [string range $what 1 1]]
1368            set bool $_settings($what)
1369            if { $bool } {
1370                $itk_component(${axis}position) configure -state normal \
1371                    -troughcolor white
1372            } else {
1373                $itk_component(${axis}position) configure -state disabled \
1374                    -troughcolor grey82
1375            }
1376            SendCmd "cutplane axis $axis $bool"
1377        }
1378        "-xcutplaneposition" - "-ycutplaneposition" - "-zcutplaneposition" {
1379            set axis [string tolower [string range $what 1 1]]
1380            set pos [expr $_settings($what) * 0.01]
1381            SendCmd "cutplane slice ${axis} ${pos}"
1382            set _cutplanePending 0
1383        }
1384        "-colormap" {
1385            set _changed(-colormap) 1
1386            StartBufferingCommands
1387            set color [$itk_component(colormap) value]
1388            set _settings(-colormap) $color
1389            if { $color == "none" } {
1390                if { $_settings(-colormapvisible) } {
1391                    SendCmd "contour3d colormode constant {}"
1392                    set _settings(-colormapvisible) 0
1393                }
1394            } else {
1395                if { !$_settings(-colormapvisible) } {
1396                    SendCmd "contour3d colormode $_colorMode $_curFldName"
1397                    set _settings(-colormapvisible) 1
1398                }
1399                SetCurrentColormap $color
1400            }
1401            StopBufferingCommands
1402            EventuallyRequestLegend
1403        }
1404        "-numcontours" {
1405            set _settings($what) [$itk_component(numcontours) value]
1406            set _currentNumContours $_settings($what)
1407            UpdateContourList
1408            set _changed($what) 1
1409            SendCmd "contour3d contourlist [list $_contourList]"
1410            DrawLegend
1411        }
1412        "-isosurfacewireframe" {
1413            set bool $_settings($what)
1414            SendCmd "contour3d wireframe $bool"
1415        }
1416        "-isosurfacevisible" {
1417            set bool $_settings($what)
1418            SendCmd "contour3d visible 0"
1419            if { $bool } {
1420                foreach tag [CurrentDatasets -visible] {
1421                    SendCmd "contour3d visible $bool $tag"
1422                }
1423            }
1424            if { $bool } {
1425                Rappture::Tooltip::for $itk_component(contour) \
1426                    "Hide the isosurface"
1427            } else {
1428                Rappture::Tooltip::for $itk_component(contour) \
1429                    "Show the isosurface"
1430            }
1431            DrawLegend
1432        }
1433        "-isosurfacelighting" {
1434            set bool $_settings($what)
1435            SendCmd "contour3d lighting $bool"
1436        }
1437        "-isosurfaceedges" {
1438            set bool $_settings($what)
1439            SendCmd "contour3d edges $bool"
1440        }
1441        "-outline" {
1442            set bool $_settings($what)
1443            SendCmd "outline visible $bool"
1444        }
1445        "-isolinecolor" {
1446            set color [$itk_component(isolineColor) value]
1447            set _settings($what) $color
1448            DrawLegend
1449        }
1450        "-isosurfaceopacity" {
1451            set val $_settings($what)
1452            set sval [expr { 0.01 * double($val) }]
1453            SendCmd "contour3d opacity $sval"
1454        }
1455        "-field" {
1456            set label [$itk_component(field) value]
1457            set fname [$itk_component(field) translate $label]
1458            set _settings($what) $fname
1459            if { [info exists _fields($fname)] } {
1460                foreach { label units components } $_fields($fname) break
1461                if { $components > 1 } {
1462                    set _colorMode vmag
1463                } else {
1464                    set _colorMode scalar
1465                }
1466                set _curFldName $fname
1467                set _curFldLabel $label
1468            } else {
1469                puts stderr "unknown field \"$fname\""
1470                return
1471            }
1472            SendCmd "dataset scalar $_curFldName"
1473            if { ![info exists _limits($_curFldName)] } {
1474                SendCmd "dataset maprange all"
1475            } else {
1476                SendCmd "dataset maprange explicit $_limits($_curFldName) $_curFldName"
1477            }
1478            SendCmd "cutplane colormode $_colorMode $_curFldName"
1479            SendCmd "contour3d colormode $_colorMode $_curFldName"
1480            SendCmd "camera reset"
1481            UpdateContourList
1482            DrawLegend
1483        }
1484        "-legendvisible" {
1485            if { !$_settings($what) } {
1486                $itk_component(view) delete legend
1487            }
1488            DrawLegend
1489        }
1490        default {
1491            error "don't know how to fix $what"
1492        }
1493    }
1494}
1495
1496
1497#
1498# RequestLegend --
1499#
1500#       Request a new legend from the server.  The size of the legend
1501#       is determined from the height of the canvas. 
1502#
1503# This should be called when
1504#       1.  A new current colormap is set.
1505#       2.  Window is resized.
1506#       3.  The limits of the data have changed.  (Just need a redraw).
1507#       4.  Number of isolines have changed. (Just need a redraw).
1508#       5.  Legend becomes visible (Just need a redraw).
1509#
1510itcl::body Rappture::VtkIsosurfaceViewer::RequestLegend {} {
1511    set _legendPending 0
1512    if { ![info exists _fields($_curFldName)] } {
1513        return
1514    }
1515    set fname $_curFldName
1516    set font "Arial 8"
1517    set lineht [font metrics $font -linespace]
1518    set w 12
1519    set h [expr {$_height - 2 * ($lineht + 2)}]
1520    if { $h < 1 } {
1521        return
1522    }
1523    if { [string match "component*" $fname] } {
1524        set title ""
1525    } else {
1526        if { [info exists _fields($fname)] } {
1527            foreach { title units } $_fields($fname) break
1528            if { $units != "" } {
1529                set title [format "%s (%s)" $title $units]
1530            }
1531        } else {
1532            set title $fname
1533        }
1534    }
1535    # If there's a title too, subtract one more line
1536    if { $title != "" } {
1537        incr h -$lineht
1538    }
1539    # Set the legend on the first heightmap dataset.
1540    if { $_currentColormap != ""  } {
1541        set cmap $_currentColormap
1542        SendCmdNoWait "legend $cmap scalar $_curFldName {} $w $h 0"
1543    }
1544}
1545
1546# ----------------------------------------------------------------------
1547# CONFIGURATION OPTION: -plotbackground
1548# ----------------------------------------------------------------------
1549itcl::configbody Rappture::VtkIsosurfaceViewer::plotbackground {
1550    if { [isconnected] } {
1551        set rgb [Color2RGB $itk_option(-plotbackground)]
1552        SendCmd "screen bgcolor $rgb"
1553    }
1554}
1555
1556# ----------------------------------------------------------------------
1557# CONFIGURATION OPTION: -plotforeground
1558# ----------------------------------------------------------------------
1559itcl::configbody Rappture::VtkIsosurfaceViewer::plotforeground {
1560    if { [isconnected] } {
1561        set rgb [Color2RGB $itk_option(-plotforeground)]
1562        SendCmd "axis color all $rgb"
1563        SendCmd "outline color $rgb"
1564        SendCmd "cutplane color $rgb"
1565    }
1566}
1567
1568itcl::body Rappture::VtkIsosurfaceViewer::limits { dataobj } {
1569    foreach { limits(xmin) limits(xmax) } [$dataobj limits x] break
1570    foreach { limits(ymin) limits(ymax) } [$dataobj limits y] break
1571    foreach { limits(zmin) limits(zmax) } [$dataobj limits z] break
1572    foreach { limits(vmin) limits(vmax) } [$dataobj limits v] break
1573    return [array get limits]
1574}
1575
1576itcl::body Rappture::VtkIsosurfaceViewer::BuildIsosurfaceTab {} {
1577
1578    set fg [option get $itk_component(hull) font Font]
1579    #set bfg [option get $itk_component(hull) boldFont Font]
1580
1581    set inner [$itk_component(main) insert end \
1582        -title "Isosurface Settings" \
1583        -icon [Rappture::icon volume-on]]
1584    $inner configure -borderwidth 4
1585
1586    checkbutton $inner.contour \
1587        -text "Isosurfaces" \
1588        -variable [itcl::scope _settings(-isosurfacevisible)] \
1589        -command [itcl::code $this AdjustSetting -isosurfacevisible] \
1590        -font "Arial 9"
1591
1592    checkbutton $inner.wireframe \
1593        -text "Wireframe" \
1594        -variable [itcl::scope _settings(-isosurfacewireframe)] \
1595        -command [itcl::code $this AdjustSetting -isosurfacewireframe] \
1596        -font "Arial 9"
1597
1598    checkbutton $inner.lighting \
1599        -text "Enable Lighting" \
1600        -variable [itcl::scope _settings(-isosurfacelighting)] \
1601        -command [itcl::code $this AdjustSetting -isosurfacelighting] \
1602        -font "Arial 9"
1603
1604    checkbutton $inner.edges \
1605        -text "Edges" \
1606        -variable [itcl::scope _settings(-isosurfaceedges)] \
1607        -command [itcl::code $this AdjustSetting -isosurfaceedges] \
1608        -font "Arial 9"
1609
1610    checkbutton $inner.outline \
1611        -text "Outline" \
1612        -variable [itcl::scope _settings(-outline)] \
1613        -command [itcl::code $this AdjustSetting -outline] \
1614        -font "Arial 9"
1615
1616    checkbutton $inner.legend \
1617        -text "Legend" \
1618        -variable [itcl::scope _settings(-legendvisible)] \
1619        -command [itcl::code $this AdjustSetting -legendvisible] \
1620        -font "Arial 9"
1621
1622    label $inner.linecolor_l -text "Isolines" -font "Arial 9"
1623    itk_component add isolineColor {
1624        Rappture::Combobox $inner.linecolor -width 10 -editable 0
1625    }
1626    $inner.linecolor choices insert end \
1627        "black"              "black"            \
1628        "blue"               "blue"             \
1629        "cyan"               "cyan"             \
1630        "green"              "green"            \
1631        "grey"               "grey"             \
1632        "magenta"            "magenta"          \
1633        "orange"             "orange"           \
1634        "red"                "red"              \
1635        "white"              "white"            \
1636        "none"               "none"
1637
1638    $itk_component(isolineColor) value "white"
1639    bind $inner.linecolor <<Value>> \
1640        [itcl::code $this AdjustSetting -isolinecolor]
1641
1642    label $inner.background_l -text "Background" -font "Arial 9"
1643    itk_component add background {
1644        Rappture::Combobox $inner.background -width 10 -editable 0
1645    }
1646    $inner.background choices insert end \
1647        "black"              "black"            \
1648        "white"              "white"            \
1649        "grey"               "grey"             
1650
1651    $itk_component(background) value $_settings(-background)
1652    bind $inner.background <<Value>> \
1653        [itcl::code $this AdjustSetting -background]
1654
1655    label $inner.opacity_l -text "Opacity" -font "Arial 9"
1656    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1657        -variable [itcl::scope _settings(-isosurfaceopacity)] \
1658        -width 10 \
1659        -showvalue off \
1660        -command [itcl::code $this AdjustSetting -isosurfaceopacity]
1661
1662    itk_component add field_l {
1663        label $inner.field_l -text "Field" -font "Arial 9"
1664    } {
1665        ignore -font
1666    }
1667    itk_component add field {
1668        Rappture::Combobox $inner.field -width 10 -editable 0
1669    }
1670    bind $inner.field <<Value>> \
1671        [itcl::code $this AdjustSetting -field]
1672
1673    label $inner.colormap_l -text "Colormap" -font "Arial 9"
1674    itk_component add colormap {
1675        Rappture::Combobox $inner.colormap -width 10 -editable 0
1676    }
1677    $inner.colormap choices insert end [GetColormapList]
1678
1679    $itk_component(colormap) value "BCGYR"
1680    bind $inner.colormap <<Value>> \
1681        [itcl::code $this AdjustSetting -colormap]
1682
1683    label $inner.numcontours_l -text "Number of Isosurfaces" -font "Arial 9"
1684    itk_component add numcontours {
1685        Rappture::Spinint $inner.numcontours \
1686            -min 0 -max 50 -font "arial 9"
1687    }
1688    $itk_component(numcontours) value $_settings(-numcontours)
1689    bind $itk_component(numcontours) <<Value>> \
1690        [itcl::code $this AdjustSetting -numcontours]
1691
1692    blt::table $inner \
1693        0,0 $inner.field_l   -anchor w -pady 2  \
1694        0,1 $inner.field     -anchor w -pady 2  -fill x \
1695        1,0 $inner.colormap_l -anchor w -pady 2  \
1696        1,1 $inner.colormap   -anchor w -pady 2  -fill x \
1697        2,0 $inner.linecolor_l  -anchor w -pady 2  \
1698        2,1 $inner.linecolor    -anchor w -pady 2 -fill x  \
1699        3,0 $inner.background_l -anchor w -pady 2 \
1700        3,1 $inner.background -anchor w -pady 2  -fill x \
1701        4,0 $inner.numcontours_l -anchor w -pady 2 \
1702        4,1 $inner.numcontours -anchor w -pady 2 \
1703        5,0 $inner.wireframe -anchor w -pady 2 -cspan 2 \
1704        6,0 $inner.lighting  -anchor w -pady 2 -cspan 2 \
1705        7,0 $inner.edges     -anchor w -pady 2 -cspan 2 \
1706        8,0 $inner.outline   -anchor w -pady 2 -cspan 2 \
1707        9,0 $inner.legend    -anchor w -pady 2 \
1708        10,0 $inner.opacity_l -anchor w -pady 2 \
1709        10,1 $inner.opacity   -fill x   -pady 2 -fill x \
1710
1711    blt::table configure $inner r* c* -resize none
1712    blt::table configure $inner r11 c1 -resize expand
1713}
1714
1715itcl::body Rappture::VtkIsosurfaceViewer::BuildAxisTab {} {
1716
1717    set fg [option get $itk_component(hull) font Font]
1718    #set bfg [option get $itk_component(hull) boldFont Font]
1719
1720    set inner [$itk_component(main) insert end \
1721        -title "Axis Settings" \
1722        -icon [Rappture::icon axis2]]
1723    $inner configure -borderwidth 4
1724
1725    checkbutton $inner.visible \
1726        -text "Show Axes" \
1727        -variable [itcl::scope _settings(-axesvisible)] \
1728        -command [itcl::code $this AdjustSetting -axesvisible] \
1729        -font "Arial 9"
1730
1731    checkbutton $inner.labels \
1732        -text "Show Axis Labels" \
1733        -variable [itcl::scope _settings(-axislabelsvisible)] \
1734        -command [itcl::code $this AdjustSetting -axislabelsvisible] \
1735        -font "Arial 9"
1736
1737    checkbutton $inner.gridx \
1738        -text "Show X Grid" \
1739        -variable [itcl::scope _settings(-xaxisgrid)] \
1740        -command [itcl::code $this AdjustSetting -xaxisgrid] \
1741        -font "Arial 9"
1742    checkbutton $inner.gridy \
1743        -text "Show Y Grid" \
1744        -variable [itcl::scope _settings(-yaxisgrid)] \
1745        -command [itcl::code $this AdjustSetting -yaxisgrid] \
1746        -font "Arial 9"
1747    checkbutton $inner.gridz \
1748        -text "Show Z Grid" \
1749        -variable [itcl::scope _settings(-zaxisgrid)] \
1750        -command [itcl::code $this AdjustSetting -zaxisgrid] \
1751        -font "Arial 9"
1752
1753    label $inner.mode_l -text "Mode" -font "Arial 9"
1754
1755    itk_component add axisMode {
1756        Rappture::Combobox $inner.mode -width 10 -editable 0
1757    }
1758    $inner.mode choices insert end \
1759        "static_triad"    "static" \
1760        "closest_triad"   "closest" \
1761        "furthest_triad"  "farthest" \
1762        "outer_edges"     "outer"         
1763    $itk_component(axisMode) value "static"
1764    bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axismode]
1765
1766    blt::table $inner \
1767        0,0 $inner.visible -anchor w -cspan 2 \
1768        1,0 $inner.labels  -anchor w -cspan 2 \
1769        2,0 $inner.gridx   -anchor w -cspan 2 \
1770        3,0 $inner.gridy   -anchor w -cspan 2 \
1771        4,0 $inner.gridz   -anchor w -cspan 2 \
1772        5,0 $inner.mode_l  -anchor w -cspan 2 -padx { 2 0 } \
1773        6,0 $inner.mode    -fill x   -cspan 2
1774
1775    blt::table configure $inner r* c* -resize none
1776    blt::table configure $inner r7 c1 -resize expand
1777}
1778
1779
1780itcl::body Rappture::VtkIsosurfaceViewer::BuildCameraTab {} {
1781    set inner [$itk_component(main) insert end \
1782        -title "Camera Settings" \
1783        -icon [Rappture::icon camera]]
1784    $inner configure -borderwidth 4
1785
1786    label $inner.view_l -text "view" -font "Arial 9"
1787    set f [frame $inner.view]
1788    foreach side { front back left right top bottom } {
1789        button $f.$side  -image [Rappture::icon view$side] \
1790            -command [itcl::code $this SetOrientation $side]
1791        Rappture::Tooltip::for $f.$side "Change the view to $side"
1792        pack $f.$side -side left
1793    }
1794
1795    blt::table $inner \
1796        0,0 $inner.view_l -anchor e -pady 2 \
1797        0,1 $inner.view -anchor w -pady 2
1798
1799    set labels { qx qy qz qw xpan ypan zoom }
1800    set row 1
1801    foreach tag $labels {
1802        label $inner.${tag}label -text $tag -font "Arial 9"
1803        entry $inner.${tag} -font "Arial 9"  -bg white \
1804            -textvariable [itcl::scope _view($tag)]
1805        bind $inner.${tag} <KeyPress-Return> \
1806            [itcl::code $this camera set ${tag}]
1807        blt::table $inner \
1808            $row,0 $inner.${tag}label -anchor e -pady 2 \
1809            $row,1 $inner.${tag} -anchor w -pady 2
1810        blt::table configure $inner r$row -resize none
1811        incr row
1812    }
1813    checkbutton $inner.ortho \
1814        -text "Orthographic Projection" \
1815        -variable [itcl::scope _view(ortho)] \
1816        -command [itcl::code $this camera set ortho] \
1817        -font "Arial 9"
1818    blt::table $inner \
1819            $row,0 $inner.ortho -cspan 2 -anchor w -pady 2
1820    blt::table configure $inner r$row -resize none
1821    incr row
1822
1823    blt::table configure $inner c* r* -resize none
1824    blt::table configure $inner c2 -resize expand
1825    blt::table configure $inner r$row -resize expand
1826}
1827
1828itcl::body Rappture::VtkIsosurfaceViewer::BuildCutplaneTab {} {
1829
1830    set fg [option get $itk_component(hull) font Font]
1831   
1832    set inner [$itk_component(main) insert end \
1833        -title "Cutplane Settings" \
1834        -icon [Rappture::icon cutbutton]]
1835
1836    $inner configure -borderwidth 4
1837
1838    checkbutton $inner.visible \
1839        -text "Cutplanes" \
1840        -variable [itcl::scope _settings(-cutplanesvisible)] \
1841        -command [itcl::code $this AdjustSetting -cutplanesvisible] \
1842        -font "Arial 9"
1843
1844    checkbutton $inner.wireframe \
1845        -text "Wireframe" \
1846        -variable [itcl::scope _settings(-cutplanewireframe)] \
1847        -command [itcl::code $this AdjustSetting -cutplanewireframe] \
1848        -font "Arial 9"
1849
1850    checkbutton $inner.lighting \
1851        -text "Enable Lighting" \
1852        -variable [itcl::scope _settings(-cutplanelighting)] \
1853        -command [itcl::code $this AdjustSetting -cutplanelighting] \
1854        -font "Arial 9"
1855
1856    checkbutton $inner.edges \
1857        -text "Edges" \
1858        -variable [itcl::scope _settings(-cutplaneedges)] \
1859        -command [itcl::code $this AdjustSetting -cutplaneedges] \
1860        -font "Arial 9"
1861
1862    checkbutton $inner.preinterp \
1863        -text "Interpolate Scalars" \
1864        -variable [itcl::scope _settings(-cutplanepreinterp)] \
1865        -command [itcl::code $this AdjustSetting -cutplanepreinterp] \
1866        -font "Arial 9"
1867
1868    label $inner.opacity_l -text "Opacity" -font "Arial 9"
1869    ::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1870        -variable [itcl::scope _settings(-cutplaneopacity)] \
1871        -width 10 \
1872        -showvalue off \
1873        -command [itcl::code $this AdjustSetting -cutplaneopacity]
1874    $inner.opacity set $_settings(-cutplaneopacity)
1875
1876    # X-value slicer...
1877    itk_component add xbutton {
1878        Rappture::PushButton $inner.xbutton \
1879            -onimage [Rappture::icon x-cutplane-red] \
1880            -offimage [Rappture::icon x-cutplane-red] \
1881            -command [itcl::code $this AdjustSetting -xcutplanevisible] \
1882            -variable [itcl::scope _settings(-xcutplanevisible)] \
1883    }
1884    Rappture::Tooltip::for $itk_component(xbutton) \
1885        "Toggle the X-axis cutplane on/off"
1886    $itk_component(xbutton) select
1887    itk_component add xposition {
1888        ::scale $inner.xval -from 100 -to 0 \
1889            -width 10 -orient vertical -showvalue 1 \
1890            -borderwidth 1 -highlightthickness 0 \
1891            -command [itcl::code $this EventuallySetCutplane x] \
1892            -variable [itcl::scope _settings(-xcutplaneposition)] \
1893            -foreground red2 -font "Arial 9 bold"
1894    } {
1895        usual
1896        ignore -borderwidth -highlightthickness -foreground -font -background
1897    }
1898    # Set the default cutplane value before disabling the scale.
1899    $itk_component(xposition) set 50
1900    $itk_component(xposition) configure -state disabled
1901    Rappture::Tooltip::for $itk_component(xposition) \
1902        "@[itcl::code $this Slice tooltip x]"
1903
1904    # Y-value slicer...
1905    itk_component add ybutton {
1906        Rappture::PushButton $inner.ybutton \
1907            -onimage [Rappture::icon y-cutplane-green] \
1908            -offimage [Rappture::icon y-cutplane-green] \
1909            -command [itcl::code $this AdjustSetting -ycutplanevisible] \
1910            -variable [itcl::scope _settings(-ycutplanevisible)] \
1911    }
1912    Rappture::Tooltip::for $itk_component(ybutton) \
1913        "Toggle the Y-axis cutplane on/off"
1914    $itk_component(ybutton) select
1915
1916    itk_component add yposition {
1917        ::scale $inner.yval -from 100 -to 0 \
1918            -width 10 -orient vertical -showvalue 1 \
1919            -borderwidth 1 -highlightthickness 0 \
1920            -command [itcl::code $this EventuallySetCutplane y] \
1921            -variable [itcl::scope _settings(-ycutplaneposition)] \
1922            -foreground green3 -font "Arial 9 bold"
1923    } {
1924        usual
1925        ignore -borderwidth -highlightthickness -foreground -font
1926    }
1927    Rappture::Tooltip::for $itk_component(yposition) \
1928        "@[itcl::code $this Slice tooltip y]"
1929    # Set the default cutplane value before disabling the scale.
1930    $itk_component(yposition) set 50
1931    $itk_component(yposition) configure -state disabled
1932
1933    # Z-value slicer...
1934    itk_component add zbutton {
1935        Rappture::PushButton $inner.zbutton \
1936            -onimage [Rappture::icon z-cutplane-blue] \
1937            -offimage [Rappture::icon z-cutplane-blue] \
1938            -command [itcl::code $this AdjustSetting -zcutplanevisible] \
1939            -variable [itcl::scope _settings(-zcutplanevisible)] \
1940    } {
1941        usual
1942        ignore -foreground
1943    }
1944    Rappture::Tooltip::for $itk_component(zbutton) \
1945        "Toggle the Z-axis cutplane on/off"
1946    $itk_component(zbutton) select
1947
1948    itk_component add zposition {
1949        ::scale $inner.zval -from 100 -to 0 \
1950            -width 10 -orient vertical -showvalue 1 \
1951            -borderwidth 1 -highlightthickness 0 \
1952            -command [itcl::code $this EventuallySetCutplane z] \
1953            -variable [itcl::scope _settings(-zcutplaneposition)] \
1954            -foreground blue3 -font "Arial 9 bold"
1955    } {
1956        usual
1957        ignore -borderwidth -highlightthickness -foreground -font
1958    }
1959    $itk_component(zposition) set 50
1960    $itk_component(zposition) configure -state disabled
1961    Rappture::Tooltip::for $itk_component(zposition) \
1962        "@[itcl::code $this Slice tooltip z]"
1963
1964    blt::table $inner \
1965        0,0 $inner.visible              -anchor w -pady 2 -cspan 3 \
1966        1,0 $inner.lighting             -anchor w -pady 2 -cspan 3 \
1967        2,0 $inner.wireframe            -anchor w -pady 2 -cspan 3 \
1968        3,0 $inner.edges                -anchor w -pady 2 -cspan 3 \
1969        4,0 $inner.preinterp            -anchor w -pady 2 -cspan 3 \
1970        5,0 $inner.opacity_l            -anchor w -pady 2 -cspan 1 \
1971        5,1 $inner.opacity              -fill x   -pady 2 -cspan 3 \
1972        6,0 $inner.xbutton              -anchor w -padx 2 -pady 2 \
1973        7,0 $inner.ybutton              -anchor w -padx 2 -pady 2 \
1974        8,0 $inner.zbutton              -anchor w -padx 2 -pady 2 \
1975        6,1 $inner.xval                 -fill y -rspan 4 \
1976        6,2 $inner.yval                 -fill y -rspan 4 \
1977        6,3 $inner.zval                 -fill y -rspan 4 \
1978
1979
1980    blt::table configure $inner r* c* -resize none
1981    blt::table configure $inner r9 c4 -resize expand
1982}
1983
1984
1985
1986#
1987#  camera --
1988#
1989itcl::body Rappture::VtkIsosurfaceViewer::camera {option args} {
1990    switch -- $option {
1991        "show" {
1992            puts [array get _view]
1993        }
1994        "set" {
1995            set who [lindex $args 0]
1996            set x $_view($who)
1997            set code [catch { string is double $x } result]
1998            if { $code != 0 || !$result } {
1999                return
2000            }
2001            switch -- $who {
2002                "ortho" {
2003                    if {$_view(ortho)} {
2004                        SendCmd "camera mode ortho"
2005                    } else {
2006                        SendCmd "camera mode persp"
2007                    }
2008                }
2009                "xpan" - "ypan" {
2010                    PanCamera
2011                }
2012                "qx" - "qy" - "qz" - "qw" {
2013                    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
2014                    $_arcball quaternion $q
2015                    EventuallyRotate $q
2016                }
2017                "zoom" {
2018                    SendCmd "camera zoom $_view(zoom)"
2019                }
2020             }
2021        }
2022    }
2023}
2024
2025itcl::body Rappture::VtkIsosurfaceViewer::GetVtkData { args } {
2026    set bytes ""
2027    foreach dataobj [get] {
2028        foreach cname [$dataobj components] {
2029            set tag $dataobj-$cname
2030            set contents [$dataobj vtkdata $cname]
2031            append bytes "$contents\n"
2032        }
2033    }
2034    return [list .vtk $bytes]
2035}
2036
2037itcl::body Rappture::VtkIsosurfaceViewer::GetImage { args } {
2038    if { [image width $_image(download)] > 0 &&
2039         [image height $_image(download)] > 0 } {
2040        set bytes [$_image(download) data -format "jpeg -quality 100"]
2041        set bytes [Rappture::encoding::decode -as b64 $bytes]
2042        return [list .jpg $bytes]
2043    }
2044    return ""
2045}
2046
2047itcl::body Rappture::VtkIsosurfaceViewer::BuildDownloadPopup { popup command } {
2048    Rappture::Balloon $popup \
2049        -title "[Rappture::filexfer::label downloadWord] as..."
2050    set inner [$popup component inner]
2051    label $inner.summary -text "" -anchor w
2052    radiobutton $inner.vtk_button -text "VTK data file" \
2053        -variable [itcl::scope _downloadPopup(format)] \
2054        -font "Arial 9 " \
2055        -value vtk 
2056    Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
2057    radiobutton $inner.image_button -text "Image File" \
2058        -variable [itcl::scope _downloadPopup(format)] \
2059        -font "Arial 9 " \
2060        -value image
2061    Rappture::Tooltip::for $inner.image_button \
2062        "Save as digital image."
2063
2064    button $inner.ok -text "Save" \
2065        -highlightthickness 0 -pady 2 -padx 3 \
2066        -command $command \
2067        -compound left \
2068        -image [Rappture::icon download]
2069
2070    button $inner.cancel -text "Cancel" \
2071        -highlightthickness 0 -pady 2 -padx 3 \
2072        -command [list $popup deactivate] \
2073        -compound left \
2074        -image [Rappture::icon cancel]
2075
2076    blt::table $inner \
2077        0,0 $inner.summary -cspan 2  \
2078        1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
2079        2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
2080        4,1 $inner.cancel -width .9i -fill y \
2081        4,0 $inner.ok -padx 2 -width .9i -fill y
2082    blt::table configure $inner r3 -height 4
2083    blt::table configure $inner r4 -pady 4
2084    raise $inner.image_button
2085    $inner.vtk_button invoke
2086    return $inner
2087}
2088
2089itcl::body Rappture::VtkIsosurfaceViewer::SetObjectStyle { dataobj comp } {
2090    # Parse style string.
2091    set tag $dataobj-$comp
2092    array set style {
2093        -color BCGYR
2094        -cutplanesvisible 0
2095        -edgecolor black
2096        -edges 0
2097        -isosurfacevisible 1
2098        -levels 10
2099        -lighting 1
2100        -linewidth 1.0
2101        -opacity 0.6
2102        -outline 0
2103        -wireframe 0
2104        -xcutplaneposition 50
2105        -xcutplanevisible 1
2106        -ycutplaneposition 50
2107        -ycutplanevisible 1
2108        -zcutplaneposition 50
2109        -zcutplanevisible 1
2110    }
2111    array set style [$dataobj style $comp]
2112    if { $dataobj != $_first || $style(-levels) == 1 } {
2113        set style(-opacity) 1
2114    }
2115    SendCmd "cutplane add $tag"
2116    SendCmd "cutplane visible 0 $tag"
2117
2118    # This is too complicated.  We want to set the colormap, number of
2119    # isolines and opacity for the dataset.  They can be the default values,
2120    # the style hints loaded with the dataset, or set by user controls.  As
2121    # datasets get loaded, they first use the defaults that are overidden
2122    # by the style hints.  If the user changes the global controls, then that
2123    # overrides everything else.  I don't know what it means when global
2124    # controls are specified as style hints by each dataset.  It complicates
2125    # the code to handle aberrant cases.
2126
2127    if { $_changed(-isosurfaceopacity) } {
2128        set style(-opacity) [expr $_settings(-isosurfaceopacity) * 0.01]
2129    }
2130    if { $_changed(-numcontours) } {
2131        set style(-levels) $_settings(-numcontours)
2132    }
2133    if { $_changed(-colormap) } {
2134        set style(-color) $_settings(-colormap)
2135    }
2136    if { $_currentColormap == "" } {
2137        SetCurrentColormap $style(-color)
2138        $itk_component(colormap) value $style(-color)
2139    }
2140    if { $_currentNumContours != $style(-levels) } {
2141        set _currentNumContours $style(-levels)
2142        set _settings(-numcontours) $_currentNumContours
2143        $itk_component(numcontours) value $_currentNumContours
2144        UpdateContourList
2145        DrawLegend
2146    }
2147    set _settings(-isosurfacevisible) $style(-isosurfacevisible)
2148    set _settings(-cutplanesvisible)  $style(-cutplanesvisible)
2149    set _settings(-xcutplanevisible)  $style(-xcutplanevisible)
2150    set _settings(-ycutplanevisible)  $style(-ycutplanevisible)
2151    set _settings(-zcutplanevisible)  $style(-zcutplanevisible)
2152    set _settings(-xcutplaneposition) $style(-xcutplaneposition)
2153    set _settings(-ycutplaneposition) $style(-ycutplaneposition)
2154    set _settings(-zcutplaneposition) $style(-zcutplaneposition)
2155 
2156    SendCmd [list contour3d add contourlist $_contourList $tag]
2157    SendCmd "contour3d edges $style(-edges) $tag"
2158    SendCmd "outline add $tag"
2159    SendCmd "outline color [Color2RGB $itk_option(-plotforeground)] $tag"
2160    SendCmd "outline visible $style(-outline) $tag"
2161    set _settings(-outline) $style(-outline)
2162    set _settings(-isosurfaceedges) $style(-edges)
2163    #SendCmd "contour3d color [Color2RGB $settings(-color)] $tag"
2164    SendCmd "contour3d lighting $style(-lighting) $tag"
2165    set _settings(-isosurfacelighting) $style(-lighting)
2166    SendCmd "contour3d linecolor [Color2RGB $style(-edgecolor)] $tag"
2167    SendCmd "contour3d linewidth $style(-linewidth) $tag"
2168    SendCmd "contour3d opacity $style(-opacity) $tag"
2169    set _settings(-isosurfaceopacity) [expr $style(-opacity) * 100.0]
2170    SetCurrentColormap $style(-color)
2171    SendCmd "contour3d wireframe $style(-wireframe) $tag"
2172    set _settings(-isosurfacewireframe) $style(-wireframe)
2173}
2174
2175itcl::body Rappture::VtkIsosurfaceViewer::IsValidObject { dataobj } {
2176    if {[catch {$dataobj isa Rappture::Field} valid] != 0 || !$valid} {
2177        return 0
2178    }
2179    return 1
2180}
2181
2182#
2183# EnterLegend --
2184#
2185itcl::body Rappture::VtkIsosurfaceViewer::EnterLegend { x y } {
2186    SetLegendTip $x $y
2187}
2188
2189#
2190# MotionLegend --
2191#
2192itcl::body Rappture::VtkIsosurfaceViewer::MotionLegend { x y } {
2193    Rappture::Tooltip::tooltip cancel
2194    set c $itk_component(view)
2195    set cw [winfo width $c]
2196    set ch [winfo height $c]
2197    if { $x >= 0 && $x < $cw && $y >= 0 && $y < $ch } {
2198        SetLegendTip $x $y
2199    }
2200}
2201
2202#
2203# LeaveLegend --
2204#
2205itcl::body Rappture::VtkIsosurfaceViewer::LeaveLegend { } {
2206    Rappture::Tooltip::tooltip cancel
2207    .rappturetooltip configure -icon ""
2208}
2209
2210#
2211# SetLegendTip --
2212#
2213itcl::body Rappture::VtkIsosurfaceViewer::SetLegendTip { x y } {
2214    set fname $_curFldName
2215    set c $itk_component(view)
2216    set w [winfo width $c]
2217    set h [winfo height $c]
2218
2219    set font "Arial 8"
2220    set lineht [font metrics $font -linespace]
2221   
2222    set ih [image height $_image(legend)]
2223    set iy [expr $y - ($lineht + 2)]
2224
2225    if { [string match "component*" $fname] } {
2226        set title ""
2227    } else {
2228        if { [info exists _fields($fname)] } {
2229            foreach { title units } $_fields($fname) break
2230            if { $units != "" } {
2231                set title [format "%s (%s)" $title $units]
2232            }
2233        } else {
2234            set title $fname
2235        }
2236    }
2237    # If there's a legend title, increase the offset by the line height.
2238    if { $title != "" } {
2239        incr iy -$lineht
2240    }
2241    # Make a swatch of the selected color
2242    if { [catch { $_image(legend) get 10 $iy } pixel] != 0 } {
2243        return
2244    }
2245    if { ![info exists _image(swatch)] } {
2246        set _image(swatch) [image create photo -width 24 -height 24]
2247    }
2248    set color [eval format "\#%02x%02x%02x" $pixel]
2249    $_image(swatch) put black  -to 0 0 23 23
2250    $_image(swatch) put $color -to 1 1 22 22
2251    .rappturetooltip configure -icon $_image(swatch)
2252
2253    # Compute the value of the point
2254    if { [info exists _limits($_curFldName)] } {
2255        foreach { vmin vmax } $_limits($_curFldName) break
2256        set t [expr 1.0 - (double($iy) / double($ih-1))]
2257        set value [expr $t * ($vmax - $vmin) + $vmin]
2258    } else {
2259        set value 0.0
2260    }
2261    set tx [expr $x + 15]
2262    set ty [expr $y - 5]
2263    if { [info exists _isolines($y)] } {
2264        Rappture::Tooltip::text $c [format "$title %g (isosurface)" $_isolines($y)]
2265    } else {
2266        Rappture::Tooltip::text $c [format "$title %g" $value]
2267    }
2268    Rappture::Tooltip::tooltip show $c +$tx,+$ty   
2269}
2270
2271
2272# ----------------------------------------------------------------------
2273# USAGE: Slice move x|y|z <newval>
2274#
2275# Called automatically when the user drags the slider to move the
2276# cut plane that slices 3D data.  Gets the current value from the
2277# slider and moves the cut plane to the appropriate point in the
2278# data set.
2279# ----------------------------------------------------------------------
2280itcl::body Rappture::VtkIsosurfaceViewer::Slice {option args} {
2281    switch -- $option {
2282        "move" {
2283            set axis [lindex $args 0]
2284            set newval [lindex $args 1]
2285            if {[llength $args] != 2} {
2286                error "wrong # args: should be \"Slice move x|y|z newval\""
2287            }
2288            set newpos [expr {0.01*$newval}]
2289            SendCmd "cutplane slice $axis $newpos"
2290        }
2291        "tooltip" {
2292            set axis [lindex $args 0]
2293            set val [$itk_component(${axis}position) get]
2294            return "Move the [string toupper $axis] cut plane.\nCurrently:  $axis = $val%"
2295        }
2296        default {
2297            error "bad option \"$option\": should be axis, move, or tooltip"
2298        }
2299    }
2300}
2301
2302#
2303# ReceiveLegend --
2304#
2305#       Invoked automatically whenever the "legend" command comes in from
2306#       the rendering server.  Indicates that binary image data with the
2307#       specified <size> will follow.
2308#
2309itcl::body Rappture::VtkIsosurfaceViewer::ReceiveLegend { colormap title min max size } {
2310    #puts stderr "ReceiveLegend colormap=$colormap title=$title range=$min,$max size=$size"
2311    set _title $title
2312    regsub {\(mag\)} $title "" _title
2313    if { [IsConnected] } {
2314        set bytes [ReceiveBytes $size]
2315        if { ![info exists _image(legend)] } {
2316            set _image(legend) [image create photo]
2317        }
2318        $_image(legend) configure -data $bytes
2319        #puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
2320        if { [catch {DrawLegend} errs] != 0 } {
2321            global errorInfo
2322            puts stderr "errs=$errs errorInfo=$errorInfo"
2323        }
2324    }
2325}
2326
2327#
2328# DrawLegend --
2329#
2330#       Draws the legend in the own canvas on the right side of the plot area.
2331#
2332itcl::body Rappture::VtkIsosurfaceViewer::DrawLegend {} {
2333    set fname $_curFldName
2334    set c $itk_component(view)
2335    set w [winfo width $c]
2336    set h [winfo height $c]
2337    set font "Arial 8"
2338    set lineht [font metrics $font -linespace]
2339   
2340    if { [string match "component*" $fname] } {
2341        set title ""
2342    } else {
2343        if { [info exists _fields($fname)] } {
2344            foreach { title units } $_fields($fname) break
2345            if { $units != "" } {
2346                set title [format "%s (%s)" $title $units]
2347            }
2348        } else {
2349            set title $fname
2350        }
2351    }
2352    set x [expr $w - 2]
2353    if { !$_settings(-legendvisible) } {
2354        $c delete legend
2355        return
2356    }
2357    if { [$c find withtag "legend"] == "" } {
2358        set y 2
2359        # If there's a legend title, create a text item for the title.
2360        $c create text $x $y \
2361            -anchor ne \
2362            -fill $itk_option(-plotforeground) -tags "title legend" \
2363            -font $font
2364        if { $title != "" } {
2365            incr y $lineht
2366        }
2367        $c create text $x $y \
2368            -anchor ne \
2369            -fill $itk_option(-plotforeground) -tags "vmax legend" \
2370            -font $font
2371        incr y $lineht
2372        $c create image $x $y \
2373            -anchor ne \
2374            -image $_image(legend) -tags "colormap legend"
2375        $c create rectangle $x $y 1 1 \
2376            -fill "" -outline "" -tags "sensor legend"
2377        $c create text $x [expr {$h-2}] \
2378            -anchor se \
2379            -fill $itk_option(-plotforeground) -tags "vmin legend" \
2380            -font $font
2381        $c bind sensor <Enter> [itcl::code $this EnterLegend %x %y]
2382        $c bind sensor <Leave> [itcl::code $this LeaveLegend]
2383        $c bind sensor <Motion> [itcl::code $this MotionLegend %x %y]
2384    }
2385    $c delete isoline
2386    set x2 $x
2387    set iw [image width $_image(legend)]
2388    set ih [image height $_image(legend)]
2389    set x1 [expr $x2 - ($iw*12)/10]
2390    set color $_settings(-isolinecolor)
2391    # Draw the isolines on the legend.
2392    array unset _isolines
2393    if { $color != "none"  && [info exists _limits($_curFldName)] &&
2394         $_settings(-numcontours) > 0 } {
2395
2396        foreach { vmin vmax } $_limits($_curFldName) break
2397        set range [expr double($vmax - $vmin)]
2398        if { $range <= 0.0 } {
2399            set range 1.0;              # Min is greater or equal to max.
2400        }
2401        set tags "isoline legend"
2402        set offset [expr 2 + $lineht]
2403        if { $title != "" } {
2404            incr offset $lineht
2405        }
2406        foreach value $_contourList {
2407            set norm [expr 1.0 - (($value - $vmin) / $range)]
2408            set y1 [expr int(round(($norm * $ih) + $offset))]
2409            for { set off 0 } { $off < 3 } { incr off } {
2410                set _isolines([expr $y1 + $off]) $value
2411                set _isolines([expr $y1 - $off]) $value
2412            }
2413            $c create line $x1 $y1 $x2 $y1 -fill $color -tags $tags
2414        }
2415    }
2416
2417    $c bind title <ButtonPress> [itcl::code $this Combo post]
2418    $c bind title <Enter> [itcl::code $this Combo activate]
2419    $c bind title <Leave> [itcl::code $this Combo deactivate]
2420    # Reset the item coordinates according the current size of the plot.
2421    $c itemconfigure title -text $title
2422    if { [info exists _limits($_curFldName)] } {
2423        foreach { vmin vmax } $_limits($_curFldName) break
2424        $c itemconfigure vmin -text [format %g $vmin]
2425        $c itemconfigure vmax -text [format %g $vmax]
2426    }
2427    set y 2
2428    # If there's a legend title, move the title to the correct position
2429    if { $title != "" } {
2430        $c itemconfigure title -text $title
2431        $c coords title $x $y
2432        incr y $lineht
2433        $c raise title
2434    }
2435    $c coords vmax $x $y
2436    incr y $lineht
2437    $c coords colormap $x $y
2438    $c coords sensor [expr $x - $iw] $y $x [expr $y + $ih]
2439    $c raise sensor
2440    $c coords vmin $x [expr {$h - 2}]
2441}
2442
2443# ----------------------------------------------------------------------
2444# USAGE: _dropdown post
2445# USAGE: _dropdown unpost
2446# USAGE: _dropdown select
2447#
2448# Used internally to handle the dropdown list for this combobox.  The
2449# post/unpost options are invoked when the list is posted or unposted
2450# to manage the relief of the controlling button.  The select option
2451# is invoked whenever there is a selection from the list, to assign
2452# the value back to the gauge.
2453# ----------------------------------------------------------------------
2454itcl::body Rappture::VtkIsosurfaceViewer::Combo {option} {
2455    set c $itk_component(view)
2456    switch -- $option {
2457        post {
2458            foreach { x1 y1 x2 y2 } [$c bbox title] break
2459            set cw [winfo width $itk_component(view)]
2460            set mw [winfo reqwidth $itk_component(fieldmenu)]
2461            set x1 [expr $cw - $mw]
2462            set x [expr $x1 + [winfo rootx $itk_component(view)]]
2463            set y [expr $y2 + [winfo rooty $itk_component(view)]]
2464            tk_popup $itk_component(fieldmenu) $x $y
2465        }
2466        activate {
2467            $c itemconfigure title -fill red
2468        }
2469        deactivate {
2470            $c itemconfigure title -fill $itk_option(-plotforeground)
2471        }
2472        invoke {
2473            $itk_component(field) value $_curFldLabel
2474            AdjustSetting -field
2475        }
2476        default {
2477            error "bad option \"$option\": should be post, unpost, select"
2478        }
2479    }
2480}
2481
2482#
2483# SetCurrentColormap --
2484#
2485itcl::body Rappture::VtkIsosurfaceViewer::SetCurrentColormap { name } {
2486    # Keep track of the colormaps that we build.
2487    if { ![info exists _colormaps($name)] } {
2488        BuildColormap $name
2489        set _colormaps($name) 1
2490    }
2491    set _currentColormap $name
2492    SendCmd "contour3d colormap $_currentColormap"
2493    SendCmd "cutplane colormap $_currentColormap"
2494}
2495
2496#
2497# BuildColormap --
2498#
2499#       Build the designated colormap on the server.
2500#
2501itcl::body Rappture::VtkIsosurfaceViewer::BuildColormap { name } {
2502    set cmap [ColorsToColormap $name]
2503    if { [llength $cmap] == 0 } {
2504        set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0"
2505    }
2506    set wmap "0.0 1.0 1.0 1.0"
2507    SendCmd "colormap add $name { $cmap } { $wmap }"
2508}
2509
2510itcl::body Rappture::VtkIsosurfaceViewer::SetOrientation { side } {
2511    array set positions {
2512        front "1 0 0 0"
2513        back  "0 0 1 0"
2514        left  "0.707107 0 -0.707107 0"
2515        right "0.707107 0 0.707107 0"
2516        top   "0.707107 -0.707107 0 0"
2517        bottom "0.707107 0.707107 0 0"
2518    }
2519    foreach name { qw qx qy qz } value $positions($side) {
2520        set _view($name) $value
2521    }
2522    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
2523    $_arcball quaternion $q
2524    SendCmd "camera orient $q"
2525    SendCmd "camera reset"
2526    set _view(xpan) 0
2527    set _view(ypan) 0
2528    set _view(zoom) 1.0
2529}
2530
2531itcl::body Rappture::VtkIsosurfaceViewer::UpdateContourList {} {
2532    if { ![info exists _limits($_curFldName)] } {
2533        return
2534    }
2535    if { $_currentNumContours < 1 } {
2536        set _contourList ""
2537        return
2538    }
2539    foreach { vmin vmax } $_limits($_curFldName) break
2540    set v [blt::vector create \#auto]
2541    $v seq $vmin $vmax [expr $_currentNumContours+2]
2542    $v delete end 0
2543    set _contourList [$v range 0 end]
2544    blt::vector destroy $v
2545}
2546
Note: See TracBrowser for help on using the repository browser.