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

Last change on this file since 5092 was 5092, checked in by ldelgass, 6 years ago

Add update in Rebuild to allow initial canvas size to be set. We don't want to
do this in the constructor since that can cause an error when the add method is
called before the constructor returns.

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