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

Last change on this file since 4638 was 4638, checked in by ldelgass, 7 years ago

Fix typo

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