Changeset 3652


Ignore:
Timestamp:
May 15, 2013, 12:51:40 PM (11 years ago)
Author:
gah
Message:
 
Location:
branches/1.2/gui/scripts
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/1.2/gui/scripts/sequencedial.tcl

    r3330 r3652  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*-
     1 mode: tcl; indent-tabs-mode: nil -*-
    22# ----------------------------------------------------------------------
    33#  COMPONENT: Sequencedial - selector, like the dial on a car radio
    … …  
    7878    private method EventuallyRedraw {}
    7979    private variable _redrawPending 0
    80 
     80    private variable _afterId -1
    8181    private variable _values ""       ;# list of all values on the dial
    8282    private variable _val2label       ;# maps value => string label(s)
    … …  
    121121itcl::body Rappture::SequenceDial::destructor {} {
    122122    configure -variable ""  ;# remove variable trace
    123     EventuallyRedraw
     123    after cancel $_afterId
    124124}
    125125
    … …  
    155155itcl::body Rappture::SequenceDial::EventuallyRedraw {} {
    156156    if { !$_redrawPending } {
    157         after 150 [itcl::code $this _redraw]
     157        set _afterId [after 150 [itcl::code $this _redraw]]
    158158        event generate $itk_component(hull) <<Value>>
    159159        set _resizePending 1

  • branches/1.2/gui/scripts/vtkheightmapviewer.tcl

    r3587 r3652  
    2525option add *VtkHeightmapViewer.plotForeground white widgetDefault
    2626option add *VtkHeightmapViewer.font \
    27     -*-helvetica-medium-r-normal-*-12-* widgetDefault
     27-*-helvetica-medium-r-normal-*-12-* widgetDefault
    2828
    2929# must use this name -- plugs into Rappture::resources::load
    3030proc VtkHeightmapViewer_init_resources {} {
    31     Rappture::resources::register \
    32         vtkvis_server Rappture::VtkHeightmapViewer::SetServerList
     31Rappture::resources::register \
     32vtkvis_server Rappture::VtkHeightmapViewer::SetServerList
    3333}
    3434
    3535itcl::class Rappture::VtkHeightmapViewer {
    36     inherit Rappture::VisViewer
    37 
    38     itk_option define -plotforeground plotForeground Foreground ""
    39     itk_option define -plotbackground plotBackground Background ""
    40     itk_option define -mode mode Mode "contour"
    41 
    42     constructor { hostlist args } {
    43         Rappture::VisViewer::constructor $hostlist
    44     } {
    45         # defined below
    46     }
    47     destructor {
    48         # defined below
    49     }
    50     public proc SetServerList { namelist } {
    51         Rappture::VisViewer::SetServerList "vtkvis" $namelist
    52     }
    53     public method add {dataobj {settings ""}}
    54     public method camera {option args}
    55     public method delete {args}
    56     public method disconnect {}
    57     public method download {option args}
    58     public method get {args}
    59     public method isconnected {}
    60     public method limits3 { dataobj }
    61     public method parameters {title args} {
    62         # do nothing
    63     }
    64     public method scale {args}
    65 
    66     protected method Connect {}
    67     protected method CurrentDatasets {args}
    68     protected method Disconnect {}
    69     protected method DoResize {}
    70     protected method DoRotate {}
    71     protected method AdjustSetting {what {value ""}}
    72     protected method AdjustMode {}
    73     protected method InitSettings { args  }
    74     protected method Pan {option x y}
    75     protected method Pick {x y}
    76     protected method Rebuild {}
    77     protected method ReceiveDataset { args }
    78     protected method ReceiveImage { args }
    79     protected method ReceiveLegend { colormap title min max size }
    80     protected method Rotate {option x y}
    81     protected method Zoom {option}
    82    
    83     # The following methods are only used by this class.
    84     private method BuildAxisTab {}
    85     private method BuildCameraTab {}
    86     private method BuildColormap { name }
    87     private method BuildContourTab {}
    88     private method BuildDownloadPopup { widget command }
    89     private method Combo { option }
    90     private method ConvertToVtkData { dataobj comp }
    91     private method DrawLegend {}
    92     private method EnterLegend { x y }
    93     private method EventuallyRequestLegend {}
    94     private method EventuallyResize { w h }
    95     private method EventuallyRotate { q }
    96     private method GetImage { args }
    97     private method GetVtkData { args }
    98     private method IsValidObject { dataobj }
    99     private method LeaveLegend {}
    100     private method MotionLegend { x y }
    101     private method PanCamera {}
    102     private method RequestLegend {}
    103     private method SetCurrentColormap { color }
    104     private method SetLegendTip { x y }
    105     private method SetObjectStyle { dataobj comp }
    106     private method GetHeightmapScale {}
    107     private method ResetAxes {}
    108     private method SetOrientation { side }
    109 
    110     private variable _arcball ""
    111     private variable _dlist ""     ;    # list of data objects
    112     private variable _obj2datasets
    113     private variable _obj2ovride   ;    # maps dataobj => style override
    114     private variable _comp2scale;       # maps dataset to the heightmap scale.
    115     private variable _datasets     ;    # contains all the dataobj-component
    116                                    ;    # datasets in the server
    117     private variable _colormaps    ;    # contains all the colormaps
    118                                    ;    # in the server.
    119 
    120     # The name of the current colormap used.  The colormap is global to all
    121     # heightmaps displayed.
    122     private variable _currentColormap "" ;   
    123     private variable _currentNumIsolines "" ;   
    124     private variable _currentOpacity "" ;   
    125 
    126     private variable _click        ;    # info used for rotate operations
    127     private variable _limits       ;    # Holds overall limits for all dataobjs
    128                                         # using the viewer.
    129     private variable _view         ;    # view params for 3D view
    130     private variable _settings
    131     private variable _changed
    132     private variable _initialStyle "";  # First found style in dataobjects.
    133     private variable _reset 1;          # Indicates if camera needs to be reset
    134                                         # to starting position.
    135     private variable _beforeConnect 1;  # Indicates if camera needs to be reset
    136                                         # to starting position.
    137 
    138     private variable _first ""     ;    # This is the topmost dataset.
    139     private variable _start 0
    140     private variable _isolines
    141 
    142     common _downloadPopup;              # download options from popup
    143     private common _hardcopy
    144     private variable _width 0
    145     private variable _height 0
    146     private variable _legendWidth 0
    147     private variable _legendHeight 0
    148     private variable _resizePending 0
    149     private variable _rotatePending 0
    150     private variable _legendPending 0
    151     private variable _fieldNames {}
    152     private variable _fields
    153     private variable _curFldName ""
    154     private variable _curFldLabel ""
    155     private variable _colorMode "vmag";#  Mode of colormap (vmag or scalar)
     36inherit Rappture::VisViewer
     37
     38itk_option define -plotforeground plotForeground Foreground ""
     39itk_option define -plotbackground plotBackground Background ""
     40itk_option define -mode mode Mode "contour"
     41
     42constructor { hostlist args } {
     43Rappture::VisViewer::constructor $hostlist
     44} {
     45# defined below
     46}
     47destructor {
     48# defined below
     49}
     50public proc SetServerList { namelist } {
     51Rappture::VisViewer::SetServerList "vtkvis" $namelist
     52}
     53public method add {dataobj {settings ""}}
     54public method camera {option args}
     55public method delete {args}
     56public method disconnect {}
     57public method download {option args}
     58public method get {args}
     59public method isconnected {}
     60public method limits3 { dataobj }
     61public method parameters {title args} {
     62# do nothing
     63}
     64public method scale {args}
     65
     66protected method Connect {}
     67protected method CurrentDatasets {args}
     68protected method Disconnect {}
     69protected method DoResize {}
     70protected method DoRotate {}
     71protected method AdjustSetting {what {value ""}}
     72protected method AdjustMode {}
     73protected method InitSettings { args  }
     74protected method Pan {option x y}
     75protected method Pick {x y}
     76protected method Rebuild {}
     77protected method ReceiveDataset { args }
     78protected method ReceiveImage { args }
     79protected method ReceiveLegend { colormap title min max size }
     80protected method Rotate {option x y}
     81protected method Zoom {option}
     82
     83# The following methods are only used by this class.
     84private method BuildAxisTab {}
     85private method BuildCameraTab {}
     86private method BuildColormap { name }
     87private method BuildContourTab {}
     88private method BuildDownloadPopup { widget command }
     89private method Combo { option }
     90private method ConvertToVtkData { dataobj comp }
     91private method DrawLegend {}
     92private method EnterLegend { x y }
     93private method EventuallyRequestLegend {}
     94private method EventuallyResize { w h }
     95private method EventuallyRotate { q }
     96private method GetImage { args }
     97private method GetVtkData { args }
     98private method IsValidObject { dataobj }
     99private method LeaveLegend {}
     100private method MotionLegend { x y }
     101private method PanCamera {}
     102private method RequestLegend {}
     103private method SetCurrentColormap { color }
     104private method SetLegendTip { x y }
     105private method SetObjectStyle { dataobj comp }
     106private method GetHeightmapScale {}
     107private method ResetAxes {}
     108private method SetOrientation { side }
     109
     110private variable _arcball ""
     111private variable _dlist ""     ;    # list of data objects
     112private variable _obj2datasets
     113private variable _obj2ovride   ;    # maps dataobj => style override
     114private variable _comp2scale;   # maps dataset to the heightmap scale.
     115private variable _datasets     ;    # contains all the dataobj-component
     116                           ;    # datasets in the server
     117private variable _colormaps    ;    # contains all the colormaps
     118                           ;    # in the server.
     119
     120# The name of the current colormap used.  The colormap is global to all
     121# heightmaps displayed.
     122private variable _currentColormap "" ;   
     123private variable _currentNumIsolines "" ;   
     124private variable _currentOpacity "" ;   
     125
     126private variable _click        ;    # info used for rotate operations
     127private variable _limits       ;    # Holds overall limits for all dataobjs
     128                                # using the viewer.
     129private variable _view         ;    # view params for 3D view
     130private variable _settings
     131private variable _changed
     132private variable _initialStyle "";  # First found style in dataobjects.
     133private variable _reset 1;          # Indicates if camera needs to be reset
     134                                # to starting position.
     135private variable _beforeConnect 1;  # Indicates if camera needs to be reset
     136                                # to starting position.
     137
     138private variable _first ""     ;    # This is the topmost dataset.
     139private variable _start 0
     140private variable _isolines
     141
     142common _downloadPopup;              # download options from popup
     143private common _hardcopy
     144private variable _width 0
     145private variable _height 0
     146private variable _legendWidth 0
     147private variable _legendHeight 0
     148private variable _resizePending 0
     149private variable _rotatePending 0
     150private variable _legendPending 0
     151private variable _fieldNames {}
     152private variable _fields
     153private variable _curFldName ""
     154private variable _curFldLabel ""
     155private variable _colorMode "vmag";#  Mode of colormap (vmag or scalar)
    156156}
    157157
    158158itk::usual VtkHeightmapViewer {
    159     keep -background -foreground -cursor -font
    160     keep -plotbackground -plotforeground -mode
     159keep -background -foreground -cursor -font
     160keep -plotbackground -plotforeground -mode
    161161}
    162162
    … …  
    165165# ----------------------------------------------------------------------
    166166itcl::body Rappture::VtkHeightmapViewer::constructor {hostlist args} {
    167     set _serverType "vtkvis"
    168 
    169     EnableWaitDialog 900
    170     # Rebuild event
    171     $_dispatcher register !rebuild
    172     $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
    173 
    174     # Resize event
    175     $_dispatcher register !resize
    176     $_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
    177 
    178     # Rotate event
    179     $_dispatcher register !rotate
    180     $_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
    181 
    182     # Legend event
    183     $_dispatcher register !legend
    184     $_dispatcher dispatch $this !legend "[itcl::code $this RequestLegend]; list"
    185 
    186     #
    187     # Populate parser with commands handle incoming requests
    188     #
    189     $_parser alias image [itcl::code $this ReceiveImage]
    190     $_parser alias dataset [itcl::code $this ReceiveDataset]
    191     $_parser alias legend [itcl::code $this ReceiveLegend]
    192 
    193     # Initialize the view to some default parameters.
    194     array set _view {
    195         qw      0.36
    196         qx      0.25
    197         qy      0.50
    198         qz      0.70
    199         zoom    1.0
    200         xpan    0
    201         ypan    0
    202         ortho   1
    203     }
    204     set _arcball [blt::arcball create 100 100]
    205     set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
    206     $_arcball quaternion $q
    207 
    208     array set _settings {
    209         axisFlymode             "static"
    210         axisMinorTicks          1
    211         stretchToFit            0
    212         axisLabels              1
    213         axisVisible             1
    214         axisXGrid               0
    215         axisYGrid               0
    216         axisZGrid               0
    217         colormapVisible         1
    218         colormapDiscrete        0
    219         edges                   0
    220         field                   "Default"
    221         heightmapScale          50
    222         isHeightmap             0
    223         isolineColor            black
    224         isolinesVisible         1
    225         legendVisible           1
    226         lighting                1
    227         saveLighting            1
    228         numIsolines             10
    229         opacity                 100
    230         outline                 0
    231         wireframe               0
    232         saveOpacity             100
    233         saveOutline             0
    234     }
    235     array set _changed {
    236         opacity                 0
    237         colormap                0
    238         numIsolines             0
    239     }
    240     itk_component add view {
    241         canvas $itk_component(plotarea).view \
    242             -highlightthickness 0 -borderwidth 0
    243     } {
    244         usual
    245         ignore -highlightthickness -borderwidth -background
    246     }
    247 
    248     itk_component add fieldmenu {
    249         menu $itk_component(plotarea).menu \
    250             -relief flat \
    251             -tearoff no
    252     } {
    253         usual
    254         ignore -background -foreground -relief -tearoff
    255     }
    256     set c $itk_component(view)
    257     bind $c <Configure> [itcl::code $this EventuallyResize %w %h]
    258     bind $c <4> [itcl::code $this Zoom in 0.25]
    259     bind $c <5> [itcl::code $this Zoom out 0.25]
    260     bind $c <KeyPress-Left>  [list %W xview scroll 10 units]
    261     bind $c <KeyPress-Right> [list %W xview scroll -10 units]
    262     bind $c <KeyPress-Up>    [list %W yview scroll 10 units]
    263     bind $c <KeyPress-Down>  [list %W yview scroll -10 units]
    264     bind $c <Enter> "focus %W"
    265     bind $c <Control-F1> [itcl::code $this ToggleConsole]
    266 
    267     # Fix the scrollregion in case we go off screen
    268     $c configure -scrollregion [$c bbox all]
    269 
    270     set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
    271     set _map(cwidth) -1
    272     set _map(cheight) -1
    273     set _map(zoom) 1.0
    274     set _map(original) ""
    275 
    276     set f [$itk_component(main) component controls]
    277     itk_component add reset {
    278         button $f.reset -borderwidth 1 -padx 1 -pady 1 \
    279             -highlightthickness 0 \
    280             -image [Rappture::icon reset-view] \
    281             -command [itcl::code $this Zoom reset]
    282     } {
    283         usual
    284         ignore -highlightthickness
    285     }
    286     pack $itk_component(reset) -side top -padx 2 -pady 2
    287     Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
    288 
    289     itk_component add zoomin {
    290         button $f.zin -borderwidth 1 -padx 1 -pady 1 \
    291             -highlightthickness 0 \
    292             -image [Rappture::icon zoom-in] \
    293             -command [itcl::code $this Zoom in]
    294     } {
    295         usual
    296         ignore -highlightthickness
    297     }
    298     pack $itk_component(zoomin) -side top -padx 2 -pady 2
    299     Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
    300 
    301     itk_component add zoomout {
    302         button $f.zout -borderwidth 1 -padx 1 -pady 1 \
    303             -highlightthickness 0 \
    304             -image [Rappture::icon zoom-out] \
    305             -command [itcl::code $this Zoom out]
    306     } {
    307         usual
    308         ignore -highlightthickness
    309     }
    310     pack $itk_component(zoomout) -side top -padx 2 -pady 2
    311     Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
    312 
    313     itk_component add mode {
    314         Rappture::PushButton $f.mode \
    315             -onimage [Rappture::icon surface] \
    316             -offimage [Rappture::icon surface] \
    317             -variable [itcl::scope _settings(isHeightmap)] \
    318             -command [itcl::code $this AdjustSetting isHeightmap] \
    319     }
    320     Rappture::Tooltip::for $itk_component(mode) \
    321         "Toggle the surface/contour on/off"
    322     pack $itk_component(mode) -padx 2 -pady 2
    323 
    324     if { [catch {
    325         BuildContourTab
    326         BuildAxisTab
    327         BuildCameraTab
    328     } errs] != 0 } {
    329         global errorInfo
    330         puts stderr "errs=$errs errorInfo=$errorInfo"
    331     }
    332     set _image(legend) [image create photo]
    333 
    334     # Hack around the Tk panewindow.  The problem is that the requested
    335     # size of the 3d view isn't set until an image is retrieved from
    336     # the server.  So the panewindow uses the tiny size.
    337     set w 10000
    338     pack forget $itk_component(view)
    339     blt::table $itk_component(plotarea) \
    340         0,0 $itk_component(view) -fill both -reqwidth $w
    341     blt::table configure $itk_component(plotarea) c1 -resize none
    342 
    343     # Bindings for panning via mouse
    344     bind $itk_component(view) <ButtonPress-2> \
    345         [itcl::code $this Pan click %x %y]
    346     bind $itk_component(view) <B2-Motion> \
    347         [itcl::code $this Pan drag %x %y]
    348     bind $itk_component(view) <ButtonRelease-2> \
    349         [itcl::code $this Pan release %x %y]
    350 
    351     #bind $itk_component(view) <ButtonRelease-3> \
    352     #    [itcl::code $this Pick %x %y]
    353 
    354     # Bindings for panning via keyboard
    355     bind $itk_component(view) <KeyPress-Left> \
    356         [itcl::code $this Pan set -10 0]
    357     bind $itk_component(view) <KeyPress-Right> \
    358         [itcl::code $this Pan set 10 0]
    359     bind $itk_component(view) <KeyPress-Up> \
    360         [itcl::code $this Pan set 0 -10]
    361     bind $itk_component(view) <KeyPress-Down> \
    362         [itcl::code $this Pan set 0 10]
    363     bind $itk_component(view) <Shift-KeyPress-Left> \
    364         [itcl::code $this Pan set -2 0]
    365     bind $itk_component(view) <Shift-KeyPress-Right> \
    366         [itcl::code $this Pan set 2 0]
    367     bind $itk_component(view) <Shift-KeyPress-Up> \
    368         [itcl::code $this Pan set 0 -2]
    369     bind $itk_component(view) <Shift-KeyPress-Down> \
    370         [itcl::code $this Pan set 0 2]
    371 
    372     # Bindings for zoom via keyboard
    373     bind $itk_component(view) <KeyPress-Prior> \
    374         [itcl::code $this Zoom out]
    375     bind $itk_component(view) <KeyPress-Next> \
    376         [itcl::code $this Zoom in]
    377 
    378     bind $itk_component(view) <Enter> "focus $itk_component(view)"
    379 
    380     if {[string equal "x11" [tk windowingsystem]]} {
    381         # Bindings for zoom via mouse
    382         bind $itk_component(view) <4> [itcl::code $this Zoom out]
    383         bind $itk_component(view) <5> [itcl::code $this Zoom in]
    384     }
    385 
    386     set _image(download) [image create photo]
    387 
    388     eval itk_initialize $args
    389     Connect
    390     set _beforeConnect 0
     167set _serverType "vtkvis"
     168
     169EnableWaitDialog 900
     170# Rebuild event
     171$_dispatcher register !rebuild
     172$_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
     173
     174# Resize event
     175$_dispatcher register !resize
     176$_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
     177
     178# Rotate event
     179$_dispatcher register !rotate
     180$_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
     181
     182# Legend event
     183$_dispatcher register !legend
     184$_dispatcher dispatch $this !legend "[itcl::code $this RequestLegend]; list"
     185
     186#
     187# Populate parser with commands handle incoming requests
     188#
     189$_parser alias image [itcl::code $this ReceiveImage]
     190$_parser alias dataset [itcl::code $this ReceiveDataset]
     191$_parser alias legend [itcl::code $this ReceiveLegend]
     192
     193# Initialize the view to some default parameters.
     194array set _view {
     195qw      0.36
     196qx      0.25
     197qy      0.50
     198qz      0.70
     199zoom    1.0
     200xpan    0
     201ypan    0
     202ortho   1
     203}
     204set _arcball [blt::arcball create 100 100]
     205set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
     206$_arcball quaternion $q
     207
     208array set _settings {
     209axisFlymode             "static"
     210axisMinorTicks          1
     211stretchToFit            0
     212axisLabels              1
     213axisVisible             1
     214axisXGrid               0
     215axisYGrid               0
     216axisZGrid               0
     217colormapVisible         1
     218colormapDiscrete        0
     219edges                   0
     220field                   "Default"
     221heightmapScale          50
     222isHeightmap             0
     223isolineColor            black
     224isolinesVisible         1
     225legendVisible           1
     226lighting                1
     227saveLighting            1
     228numIsolines             10
     229opacity                 100
     230outline                 0
     231wireframe               0
     232saveOpacity             100
     233saveOutline             0
     234}
     235array set _changed {
     236opacity                 0
     237colormap                0
     238numIsolines             0
     239}
     240itk_component add view {
     241canvas $itk_component(plotarea).view \
     242    -highlightthickness 0 -borderwidth 0
     243} {
     244usual
     245ignore -highlightthickness -borderwidth -background
     246}
     247
     248itk_component add fieldmenu {
     249menu $itk_component(plotarea).menu \
     250    -relief flat \
     251    -tearoff no
     252} {
     253usual
     254ignore -background -foreground -relief -tearoff
     255}
     256set c $itk_component(view)
     257bind $c <Configure> [itcl::code $this EventuallyResize %w %h]
     258bind $c <4> [itcl::code $this Zoom in 0.25]
     259bind $c <5> [itcl::code $this Zoom out 0.25]
     260bind $c <KeyPress-Left>  [list %W xview scroll 10 units]
     261bind $c <KeyPress-Right> [list %W xview scroll -10 units]
     262bind $c <KeyPress-Up>    [list %W yview scroll 10 units]
     263bind $c <KeyPress-Down>  [list %W yview scroll -10 units]
     264bind $c <Enter> "focus %W"
     265bind $c <Control-F1> [itcl::code $this ToggleConsole]
     266
     267# Fix the scrollregion in case we go off screen
     268$c configure -scrollregion [$c bbox all]
     269
     270set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
     271set _map(cwidth) -1
     272set _map(cheight) -1
     273set _map(zoom) 1.0
     274set _map(original) ""
     275
     276set f [$itk_component(main) component controls]
     277itk_component add reset {
     278button $f.reset -borderwidth 1 -padx 1 -pady 1 \
     279    -highlightthickness 0 \
     280    -image [Rappture::icon reset-view] \
     281    -command [itcl::code $this Zoom reset]
     282} {
     283usual
     284ignore -highlightthickness
     285}
     286pack $itk_component(reset) -side top -padx 2 -pady 2
     287Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
     288
     289itk_component add zoomin {
     290button $f.zin -borderwidth 1 -padx 1 -pady 1 \
     291    -highlightthickness 0 \
     292    -image [Rappture::icon zoom-in] \
     293    -command [itcl::code $this Zoom in]
     294} {
     295usual
     296ignore -highlightthickness
     297}
     298pack $itk_component(zoomin) -side top -padx 2 -pady 2
     299Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
     300
     301itk_component add zoomout {
     302button $f.zout -borderwidth 1 -padx 1 -pady 1 \
     303    -highlightthickness 0 \
     304    -image [Rappture::icon zoom-out] \
     305    -command [itcl::code $this Zoom out]
     306} {
     307usual
     308ignore -highlightthickness
     309}
     310pack $itk_component(zoomout) -side top -padx 2 -pady 2
     311Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
     312
     313itk_component add mode {
     314Rappture::PushButton $f.mode \
     315    -onimage [Rappture::icon surface] \
     316    -offimage [Rappture::icon surface] \
     317    -variable [itcl::scope _settings(isHeightmap)] \
     318    -command [itcl::code $this AdjustSetting isHeightmap] \
     319}
     320Rappture::Tooltip::for $itk_component(mode) \
     321"Toggle the surface/contour on/off"
     322pack $itk_component(mode) -padx 2 -pady 2
     323
     324if { [catch {
     325BuildContourTab
     326BuildAxisTab
     327BuildCameraTab
     328} errs] != 0 } {
     329global errorInfo
     330puts stderr "errs=$errs errorInfo=$errorInfo"
     331}
     332set _image(legend) [image create photo]
     333
     334# Hack around the Tk panewindow.  The problem is that the requested
     335# size of the 3d view isn't set until an image is retrieved from
     336# the server.  So the panewindow uses the tiny size.
     337set w 10000
     338pack forget $itk_component(view)
     339blt::table $itk_component(plotarea) \
     3400,0 $itk_component(view) -fill both -reqwidth $w
     341blt::table configure $itk_component(plotarea) c1 -resize none
     342
     343# Bindings for panning via mouse
     344bind $itk_component(view) <ButtonPress-2> \
     345[itcl::code $this Pan click %x %y]
     346bind $itk_component(view) <B2-Motion> \
     347[itcl::code $this Pan drag %x %y]
     348bind $itk_component(view) <ButtonRelease-2> \
     349[itcl::code $this Pan release %x %y]
     350
     351#bind $itk_component(view) <ButtonRelease-3> \
     352#    [itcl::code $this Pick %x %y]
     353
     354# Bindings for panning via keyboard
     355bind $itk_component(view) <KeyPress-Left> \
     356[itcl::code $this Pan set -10 0]
     357bind $itk_component(view) <KeyPress-Right> \
     358[itcl::code $this Pan set 10 0]
     359bind $itk_component(view) <KeyPress-Up> \
     360[itcl::code $this Pan set 0 -10]
     361bind $itk_component(view) <KeyPress-Down> \
     362[itcl::code $this Pan set 0 10]
     363bind $itk_component(view) <Shift-KeyPress-Left> \
     364[itcl::code $this Pan set -2 0]
     365bind $itk_component(view) <Shift-KeyPress-Right> \
     366[itcl::code $this Pan set 2 0]
     367bind $itk_component(view) <Shift-KeyPress-Up> \
     368[itcl::code $this Pan set 0 -2]
     369bind $itk_component(view) <Shift-KeyPress-Down> \
     370[itcl::code $this Pan set 0 2]
     371
     372# Bindings for zoom via keyboard
     373bind $itk_component(view) <KeyPress-Prior> \
     374[itcl::code $this Zoom out]
     375bind $itk_component(view) <KeyPress-Next> \
     376[itcl::code $this Zoom in]
     377
     378bind $itk_component(view) <Enter> "focus $itk_component(view)"
     379
     380if {[string equal "x11" [tk windowingsystem]]} {
     381# Bindings for zoom via mouse
     382bind $itk_component(view) <4> [itcl::code $this Zoom out]
     383bind $itk_component(view) <5> [itcl::code $this Zoom in]
     384}
     385
     386set _image(download) [image create photo]
     387
     388eval itk_initialize $args
     389Connect
     390set _beforeConnect 0
    391391}
    392392
    … …  
    395395# ----------------------------------------------------------------------
    396396itcl::body Rappture::VtkHeightmapViewer::destructor {} {
    397     Disconnect
    398     image delete $_image(plot)
    399     image delete $_image(download)
    400     catch { blt::arcball destroy $_arcball }
     397Disconnect
     398image delete $_image(plot)
     399image delete $_image(download)
     400catch { blt::arcball destroy $_arcball }
    401401}
    402402
    403403itcl::body Rappture::VtkHeightmapViewer::DoResize {} {
    404     if { $_width < 2 } {
    405         set _width 500
    406     }
    407     if { $_height < 2 } {
    408         set _height 500
    409     }
    410     set _start [clock clicks -milliseconds]
    411     SendCmd "screen size [expr $_width - 20] $_height"
    412 
    413     set font "Arial 8"
    414     set lh [font metrics $font -linespace]
    415     set h [expr {$_height - 2 * ($lh + 2)}]
    416     if { $h != $_legendHeight } {
    417         EventuallyRequestLegend
    418     } else {
    419         DrawLegend
    420     }
    421     set _resizePending 0
     404if { $_width < 2 } {
     405set _width 500
     406}
     407if { $_height < 2 } {
     408set _height 500
     409}
     410set _start [clock clicks -milliseconds]
     411SendCmd "screen size [expr $_width - 20] $_height"
     412
     413set font "Arial 8"
     414set lh [font metrics $font -linespace]
     415set h [expr {$_height - 2 * ($lh + 2)}]
     416if { $h != $_legendHeight } {
     417EventuallyRequestLegend
     418} else {
     419DrawLegend
     420}
     421set _resizePending 0
    422422}
    423423
    424424itcl::body Rappture::VtkHeightmapViewer::DoRotate {} {
    425     set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
    426     SendCmd "camera orient $q"
    427     set _rotatePending 0
     425set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
     426SendCmd "camera orient $q"
     427set _rotatePending 0
    428428}
    429429
    430430itcl::body Rappture::VtkHeightmapViewer::EventuallyRequestLegend {} {
    431     if { !$_legendPending } {
    432         set _legendPending 1
    433         $_dispatcher event -idle !legend
    434     }
     431if { !$_legendPending } {
     432set _legendPending 1
     433$_dispatcher event -idle !legend
     434}
    435435}
    436436
    437437itcl::body Rappture::VtkHeightmapViewer::EventuallyResize { w h } {
    438     set _width $w
    439     set _height $h
    440     $_arcball resize $w $h
    441     if { !$_resizePending } {
    442         set _resizePending 1
    443         $_dispatcher event -after 250 !resize
    444     }
     438set _width $w
     439set _height $h
     440$_arcball resize $w $h
     441if { !$_resizePending } {
     442set _resizePending 1
     443$_dispatcher event -after 250 !resize
     444}
    445445}
    446446
    … …  
    448448
    449449itcl::body Rappture::VtkHeightmapViewer::EventuallyRotate { q } {
    450     foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break
    451     if { !$_rotatePending } {
    452         set _rotatePending 1
    453         global rotate_delay
    454         $_dispatcher event -after $rotate_delay !rotate
    455     }
     450foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break
     451if { !$_rotatePending } {
     452set _rotatePending 1
     453global rotate_delay
     454$_dispatcher event -after $rotate_delay !rotate
     455}
    456456}
    457457
    … …  
    464464# ----------------------------------------------------------------------
    465465itcl::body Rappture::VtkHeightmapViewer::add {dataobj {settings ""}} {
    466     if { ![$dataobj isvalid] } {
    467         return;                         # Object doesn't contain valid data.
    468     }
    469     array set params {
    470         -color auto
    471         -width 1
    472         -linestyle solid
    473         -brightness 0
    474         -raise 0
    475         -description ""
    476         -param ""
    477         -type ""
    478     }
    479     array set params $settings
    480     set params(-description) ""
    481     set params(-param) ""
    482     foreach {opt val} $settings {
    483         if {![info exists params($opt)]} {
    484             error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
    485         }
    486         set params($opt) $val
    487     }
    488     if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
    489         # can't handle -autocolors yet
    490         set params(-color) white
    491     }
    492     set pos [lsearch -exact $dataobj $_dlist]
    493     if {$pos < 0} {
    494         lappend _dlist $dataobj
    495     }
    496     set _obj2ovride($dataobj-color) $params(-color)
    497     set _obj2ovride($dataobj-width) $params(-width)
    498     set _obj2ovride($dataobj-raise) $params(-raise)
    499     $_dispatcher event -idle !rebuild
     466if { ![$dataobj isvalid] } {
     467return;                         # Object doesn't contain valid data.
     468}
     469array set params {
     470-color auto
     471-width 1
     472-linestyle solid
     473-brightness 0
     474-raise 0
     475-description ""
     476-param ""
     477-type ""
     478}
     479array set params $settings
     480set params(-description) ""
     481set params(-param) ""
     482foreach {opt val} $settings {
     483if {![info exists params($opt)]} {
     484    error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
     485}
     486set params($opt) $val
     487}
     488if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
     489# can't handle -autocolors yet
     490set params(-color) white
     491}
     492set pos [lsearch -exact $dataobj $_dlist]
     493if {$pos < 0} {
     494lappend _dlist $dataobj
     495}
     496set _obj2ovride($dataobj-color) $params(-color)
     497set _obj2ovride($dataobj-width) $params(-width)
     498set _obj2ovride($dataobj-raise) $params(-raise)
     499$_dispatcher event -idle !rebuild
    500500}
    501501
    … …  
    510510# ----------------------------------------------------------------------
    511511itcl::body Rappture::VtkHeightmapViewer::delete {args} {
    512     if { [llength $args] == 0} {
    513         set args $_dlist
    514     }
    515     # Delete all specified dataobjs
    516     set changed 0
    517     foreach dataobj $args {
    518         set pos [lsearch -exact $_dlist $dataobj]
    519         if { $pos < 0 } {
    520             continue;                   # Don't know anything about it.
    521         }
    522         # Remove it from the dataobj list.
    523         set _dlist [lreplace $_dlist $pos $pos]
    524         array unset _obj2ovride $dataobj-*
    525         array unset _settings $dataobj-*
    526         # Append to the end of the dataobj list.
    527         #lappend _dlist $dataobj
    528         set changed 1
    529     }
    530     # If anything changed, then rebuild the plot
    531     if { $changed } {
    532         $_dispatcher event -idle !rebuild
    533     }
     512if { [llength $args] == 0} {
     513set args $_dlist
     514}
     515# Delete all specified dataobjs
     516set changed 0
     517foreach dataobj $args {
     518set pos [lsearch -exact $_dlist $dataobj]
     519if { $pos < 0 } {
     520    continue;                   # Don't know anything about it.
     521}
     522# Remove it from the dataobj list.
     523set _dlist [lreplace $_dlist $pos $pos]
     524array unset _obj2ovride $dataobj-*
     525array unset _settings $dataobj-*
     526# Append to the end of the dataobj list.
     527#lappend _dlist $dataobj
     528set changed 1
     529}
     530# If anything changed, then rebuild the plot
     531if { $changed } {
     532$_dispatcher event -idle !rebuild
     533}
    534534}
    535535
    … …  
    544544# ----------------------------------------------------------------------
    545545itcl::body Rappture::VtkHeightmapViewer::get {args} {
    546     if {[llength $args] == 0} {
    547         set args "-objects"
    548     }
    549     set op [lindex $args 0]
    550     switch -- $op {
    551         "-objects" {
    552             # put the dataobj list in order according to -raise options
    553             set dlist {}
    554             foreach dataobj $_dlist {
    555                 if { ![IsValidObject $dataobj] } {
    556                     continue
    557                 }
    558                 if {[info exists _obj2ovride($dataobj-raise)] &&
    559                     $_obj2ovride($dataobj-raise)} {
    560                     set dlist [linsert $dlist 0 $dataobj]
    561                 } else {
    562                     lappend dlist $dataobj
    563                 }
    564             }
    565             return $dlist
    566         }
    567         "-visible" {
    568             set dlist {}
    569             foreach dataobj $_dlist {
    570                 if { ![IsValidObject $dataobj] } {
    571                     continue
    572                 }
    573                 if { ![info exists _obj2ovride($dataobj-raise)] } {
    574                     # No setting indicates that the object isn't visible.
    575                     continue
    576                 }
    577                 # Otherwise use the -raise parameter to put the object to
    578                 # the front of the list.
    579                 if { $_obj2ovride($dataobj-raise) } {
    580                     set dlist [linsert $dlist 0 $dataobj]
    581                 } else {
    582                     lappend dlist $dataobj
    583                 }
    584             }
    585             return $dlist
    586         }           
    587         -image {
    588             if {[llength $args] != 2} {
    589                 error "wrong # args: should be \"get -image view\""
    590             }
    591             switch -- [lindex $args end] {
    592                 view {
    593                     return $_image(plot)
    594                 }
    595                 default {
    596                     error "bad image name \"[lindex $args end]\": should be view"
    597                 }
    598             }
    599         }
    600         default {
    601             error "bad option \"$op\": should be -objects or -image"
    602         }
    603     }
     546if {[llength $args] == 0} {
     547set args "-objects"
     548}
     549set op [lindex $args 0]
     550switch -- $op {
     551"-objects" {
     552    # put the dataobj list in order according to -raise options
     553    set dlist {}
     554    foreach dataobj $_dlist {
     555        if { ![IsValidObject $dataobj] } {
     556            continue
     557        }
     558        if {[info exists _obj2ovride($dataobj-raise)] &&
     559            $_obj2ovride($dataobj-raise)} {
     560            set dlist [linsert $dlist 0 $dataobj]
     561        } else {
     562            lappend dlist $dataobj
     563        }
     564    }
     565    return $dlist
     566}
     567"-visible" {
     568    set dlist {}
     569    foreach dataobj $_dlist {
     570        if { ![IsValidObject $dataobj] } {
     571            continue
     572        }
     573        if { ![info exists _obj2ovride($dataobj-raise)] } {
     574            # No setting indicates that the object isn't visible.
     575            continue
     576        }
     577        # Otherwise use the -raise parameter to put the object to
     578        # the front of the list.
     579        if { $_obj2ovride($dataobj-raise) } {
     580            set dlist [linsert $dlist 0 $dataobj]
     581        } else {
     582            lappend dlist $dataobj
     583        }
     584    }
     585    return $dlist
     586}           
     587-image {
     588    if {[llength $args] != 2} {
     589        error "wrong # args: should be \"get -image view\""
     590    }
     591    switch -- [lindex $args end] {
     592        view {
     593            return $_image(plot)
     594        }
     595        default {
     596            error "bad image name \"[lindex $args end]\": should be view"
     597        }
     598    }
     599}
     600default {
     601    error "bad option \"$op\": should be -objects or -image"
     602}
     603}
    604604}
    605605
    … …  
    614614#
    615615itcl::body Rappture::VtkHeightmapViewer::scale {args} {
    616     foreach dataobj $args {
    617         if { ![$dataobj isvalid] } {
    618             continue;                   # Object doesn't contain valid data.
    619         }
    620         foreach axis { x y } {
    621             set lim [$dataobj limits $axis]
    622             if { ![info exists _limits($axis)] } {
    623                 set _limits($axis) $lim
    624                 continue
    625             }
    626             foreach {min max} $lim break
    627             foreach {amin amax} $_limits($axis) break
    628             if { $amin > $min } {
    629                 set amin $min
    630             }
    631             if { $amax < $max } {
    632                 set amax $max
    633             }
    634             set _limits($axis) [list $amin $amax]
    635         }
    636         foreach { fname lim } [$dataobj fieldlimits] {
    637             if { ![info exists _limits($fname)] } {
    638                 set _limits($fname) $lim
    639                 continue
    640             }
    641             foreach {min max} $lim break
    642             foreach {fmin fmax} $_limits($fname) break
    643             if { $fmin > $min } {
    644                 set fmin $min
    645             }
    646             if { $fmax < $max } {
    647                 set fmax $max
    648             }
    649             set _limits($fname) [list $fmin $fmax]
    650         }
    651     }
     616foreach dataobj $args {
     617if { ![$dataobj isvalid] } {
     618    continue;                   # Object doesn't contain valid data.
     619}
     620foreach axis { x y } {
     621    set lim [$dataobj limits $axis]
     622    if { ![info exists _limits($axis)] } {
     623        set _limits($axis) $lim
     624        continue
     625    }
     626    foreach {min max} $lim break
     627    foreach {amin amax} $_limits($axis) break
     628    if { $amin > $min } {
     629        set amin $min
     630    }
     631    if { $amax < $max } {
     632        set amax $max
     633    }
     634    set _limits($axis) [list $amin $amax]
     635}
     636foreach { fname lim } [$dataobj fieldlimits] {
     637    if { ![info exists _limits($fname)] } {
     638        set _limits($fname) $lim
     639        continue
     640    }
     641    foreach {min max} $lim break
     642    foreach {fmin fmax} $_limits($fname) break
     643    if { $fmin > $min } {
     644        set fmin $min
     645    }
     646    if { $fmax < $max } {
     647        set fmax $max
     648    }
     649    set _limits($fname) [list $fmin $fmax]
     650}
     651}
    652652}
    653653
    … …  
    663663# ----------------------------------------------------------------------
    664664itcl::body Rappture::VtkHeightmapViewer::download {option args} {
    665     switch $option {
    666         coming {
    667             if {[catch {
    668                 blt::winop snap $itk_component(plotarea) $_image(download)
    669             }]} {
    670                 $_image(download) configure -width 1 -height 1
    671                 $_image(download) put #000000
    672             }
    673         }
    674         controls {
    675             set popup .vtkviewerdownload
    676             if { ![winfo exists .vtkviewerdownload] } {
    677                 set inner [BuildDownloadPopup $popup [lindex $args 0]]
    678             } else {
    679                 set inner [$popup component inner]
    680             }
    681             set _downloadPopup(image_controls) $inner.image_frame
    682             set num [llength [get]]
    683             set num [expr {($num == 1) ? "1 result" : "$num results"}]
    684             set word [Rappture::filexfer::label downloadWord]
    685             $inner.summary configure -text "$word $num in the following format:"
    686             update idletasks            ;# Fix initial sizes
    687             return $popup
    688         }
    689         now {
    690             set popup .vtkviewerdownload
    691             if {[winfo exists .vtkviewerdownload]} {
    692                 $popup deactivate
    693             }
    694             switch -- $_downloadPopup(format) {
    695                 "image" {
    696                     return [$this GetImage [lindex $args 0]]
    697                 }
    698                 "vtk" {
    699                     return [$this GetVtkData [lindex $args 0]]
    700                 }
    701             }
    702             return ""
    703         }
    704         default {
    705             error "bad option \"$option\": should be coming, controls, now"
    706         }
    707     }
     665switch $option {
     666coming {
     667    if {[catch {
     668        blt::winop snap $itk_component(plotarea) $_image(download)
     669    }]} {
     670        $_image(download) configure -width 1 -height 1
     671        $_image(download) put #000000
     672    }
     673}
     674controls {
     675    set popup .vtkviewerdownload
     676    if { ![winfo exists .vtkviewerdownload] } {
     677        set inner [BuildDownloadPopup $popup [lindex $args 0]]
     678    } else {
     679        set inner [$popup component inner]
     680    }
     681    set _downloadPopup(image_controls) $inner.image_frame
     682    set num [llength [get]]
     683    set num [expr {($num == 1) ? "1 result" : "$num results"}]
     684    set word [Rappture::filexfer::label downloadWord]
     685    $inner.summary configure -text "$word $num in the following format:"
     686    update idletasks            ;# Fix initial sizes
     687    return $popup
     688}
     689now {
     690    set popup .vtkviewerdownload
     691    if {[winfo exists .vtkviewerdownload]} {
     692        $popup deactivate
     693    }
     694    switch -- $_downloadPopup(format) {
     695        "image" {
     696            return [$this GetImage [lindex $args 0]]
     697        }
     698        "vtk" {
     699            return [$this GetVtkData [lindex $args 0]]
     700        }
     701    }
     702    return ""
     703}
     704default {
     705    error "bad option \"$option\": should be coming, controls, now"
     706}
     707}
    708708}
    709709
    … …  
    716716# ----------------------------------------------------------------------
    717717itcl::body Rappture::VtkHeightmapViewer::Connect {} {
    718     global readyForNextFrame
    719     set readyForNextFrame 1
    720     set _reset 1
    721     set _hosts [GetServerList "vtkvis"]
    722     if { "" == $_hosts } {
    723         return 0
    724     }
    725     set result [VisViewer::Connect $_hosts]
    726     if { $result } {
    727         set w [winfo width $itk_component(view)]
    728         set h [winfo height $itk_component(view)]
    729         EventuallyResize $w $h
    730     }
    731     return $result
     718global readyForNextFrame
     719set readyForNextFrame 1
     720set _reset 1
     721set _hosts [GetServerList "vtkvis"]
     722if { "" == $_hosts } {
     723return 0
     724}
     725set result [VisViewer::Connect $_hosts]
     726if { $result } {
     727set w [winfo width $itk_component(view)]
     728set h [winfo height $itk_component(view)]
     729EventuallyResize $w $h
     730}
     731return $result
    732732}
    733733
    … …  
    738738#
    739739itcl::body Rappture::VtkHeightmapViewer::isconnected {} {
    740     return [VisViewer::IsConnected]
     740return [VisViewer::IsConnected]
    741741}
    742742
    … …  
    745745#
    746746itcl::body Rappture::VtkHeightmapViewer::disconnect {} {
    747     Disconnect
    748     set _reset 1
     747Disconnect
     748set _reset 1
    749749}
    750750
    … …  
    756756#
    757757itcl::body Rappture::VtkHeightmapViewer::Disconnect {} {
    758     VisViewer::Disconnect
    759 
    760     $_dispatcher cancel !rebuild
    761     $_dispatcher cancel !resize
    762     $_dispatcher cancel !rotate
    763     $_dispatcher cancel !legend
    764     # disconnected -- no more data sitting on server
    765     array unset _datasets
    766     array unset _data
    767     array unset _colormaps
    768     array unset _obj2datasets
    769     global readyForNextFrame
    770     set readyForNextFrame 1
     758VisViewer::Disconnect
     759
     760$_dispatcher cancel !rebuild
     761$_dispatcher cancel !resize
     762$_dispatcher cancel !rotate
     763$_dispatcher cancel !legend
     764# disconnected -- no more data sitting on server
     765array unset _datasets
     766array unset _data
     767array unset _colormaps
     768array unset _obj2datasets
     769global readyForNextFrame
     770set readyForNextFrame 1
    771771}
    772772
    … …  
    779779# ----------------------------------------------------------------------
    780780itcl::body Rappture::VtkHeightmapViewer::ReceiveImage { args } {
    781     global readyForNextFrame
    782     set readyForNextFrame 1
    783     array set info {
    784         -token "???"
    785         -bytes 0
    786         -type image
    787     }
    788     array set info $args
    789     set bytes [ReceiveBytes $info(-bytes)]
    790     if { $info(-type) == "image" } {
    791         if 0 {
    792             set f [open "last.ppm" "w"]
    793             puts $f $bytes
    794             close $f
    795         }
    796         $_image(plot) configure -data $bytes
    797         set time [clock seconds]
    798         set date [clock format $time]
    799         #puts stderr "$date: received image [image width $_image(plot)]x[image height $_image(plot)] image>"       
    800         if { $_start > 0 } {
    801             set finish [clock clicks -milliseconds]
    802             #puts stderr "round trip time [expr $finish -$_start] milliseconds"
    803             set _start 0
    804         }
    805     } elseif { $info(type) == "print" } {
    806         set tag $this-print-$info(-token)
    807         set _hardcopy($tag) $bytes
    808     }
     781global readyForNextFrame
     782set readyForNextFrame 1
     783array set info {
     784-token "???"
     785-bytes 0
     786-type image
     787}
     788array set info $args
     789set bytes [ReceiveBytes $info(-bytes)]
     790if { $info(-type) == "image" } {
     791if 0 {
     792    set f [open "last.ppm" "w"]
     793    puts $f $bytes
     794    close $f
     795}
     796$_image(plot) configure -data $bytes
     797set time [clock seconds]
     798set date [clock format $time]
     799#puts stderr "$date: received image [image width $_image(plot)]x[image height $_image(plot)] image>"       
     800if { $_start > 0 } {
     801    set finish [clock clicks -milliseconds]
     802    #puts stderr "round trip time [expr $finish -$_start] milliseconds"
     803    set _start 0
     804}
     805} elseif { $info(type) == "print" } {
     806set tag $this-print-$info(-token)
     807set _hardcopy($tag) $bytes
     808}
    809809}
    810810
    … …  
    813813#
    814814itcl::body Rappture::VtkHeightmapViewer::ReceiveDataset { args } {
    815     if { ![isconnected] } {
    816         return
    817     }
    818     set option [lindex $args 0]
     815if { ![isconnected] } {
     816return
     817}
     818set option [lindex $args 0]
     819switch -- $option {
     820"scalar" {
     821    set option [lindex $args 1]
    819822    switch -- $option {
    820         "scalar" {
    821             set option [lindex $args 1]
    822             switch -- $option {
    823                 "world" {
    824                     foreach { x y z value tag } [lrange $args 2 end] break
    825                 }
    826                 "pixel" {
    827                     foreach { x y value tag } [lrange $args 2 end] break
    828                 }
    829             }
    830         }
    831         "vector" {
    832             set option [lindex $args 1]
    833             switch -- $option {
    834                 "world" {
    835                     foreach { x y z vx vy vz tag } [lrange $args 2 end] break
    836                 }
    837                 "pixel" {
    838                     foreach { x y vx vy vz tag } [lrange $args 2 end] break
    839                 }
    840             }
    841         }
    842         "names" {
    843             foreach { name } [lindex $args 1] {
    844                 #puts stderr "Dataset: $name"
    845             }
    846         }
    847         default {
    848             error "unknown dataset option \"$option\" from server"
    849         }
    850     }
     823        "world" {
     824            foreach { x y z value tag } [lrange $args 2 end] break
     825        }
     826        "pixel" {
     827            foreach { x y value tag } [lrange $args 2 end] break
     828        }
     829    }
     830}
     831"vector" {
     832    set option [lindex $args 1]
     833    switch -- $option {
     834        "world" {
     835            foreach { x y z vx vy vz tag } [lrange $args 2 end] break
     836        }
     837        "pixel" {
     838            foreach { x y vx vy vz tag } [lrange $args 2 end] break
     839        }
     840    }
     841}
     842"names" {
     843    foreach { name } [lindex $args 1] {
     844        #puts stderr "Dataset: $name"
     845    }
     846}
     847default {
     848    error "unknown dataset option \"$option\" from server"
     849}
     850}
    851851}
    852852
    … …  
    859859# ----------------------------------------------------------------------
    860860itcl::body Rappture::VtkHeightmapViewer::Rebuild {} {
    861     set w [winfo width $itk_component(view)]
    862     set h [winfo height $itk_component(view)]
    863     if { $w < 2 || $h < 2 } {
    864         $_dispatcher event -idle !rebuild
    865         return
    866     }
    867 
    868     if { $_reset && $_reportClientInfo }  {
    869         # Tell the server the name of the tool, the version, and dataset
    870         # that we are rendering.  Have to do it here because we don't know
    871         # what data objects are using the renderer until be get here.
    872         global env
    873        
    874         set info {}
    875         set user "???"
    876         if { [info exists env(USER)] } {
    877             set user $env(USER)
    878         }
    879         set session "???"
    880         if { [info exists env(SESSION)] } {
    881             set session $env(SESSION)
    882         }
    883         lappend info "hub" [exec hostname]
    884         lappend info "client" "vtkheightmapviewer"
    885         lappend info "user" $user
    886         lappend info "session" $session
    887         SendCmd "clientinfo [list $info]"
    888     }
    889 
    890     # Turn on buffering of commands to the server.  We don't want to
    891     # be preempted by a server disconnect/reconnect (which automatically
    892     # generates a new call to Rebuild).   
    893     StartBufferingCommands
    894 
    895     if { $_width != $w || $_height != $h || $_reset } {
    896         set _width $w
    897         set _height $h
    898         $_arcball resize $w $h
    899         DoResize
    900         if { $_settings(stretchToFit) } {
    901             AdjustSetting stretchToFit
    902         }
    903     }
    904     if { $_reset } {
    905         InitSettings isHeightmap background
    906         #
    907         # Reset the camera and other view parameters
    908         #
    909         SendCmd "axis color all [Color2RGB $itk_option(-plotforeground)]"
    910 
    911         # Let's see how this goes.  I think it's preferable to overloading the
    912         # axis title with the exponent.
    913         SendCmd "axis exp 0 0 0 1"
    914 
    915         SendCmd "axis lrot z 90"
    916         set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
    917         $_arcball quaternion $q
    918         if {$_settings(isHeightmap) } {
    919             if { $_view(ortho)} {
    920                 SendCmd "camera mode ortho"
    921             } else {
    922                 SendCmd "camera mode persp"
    923             }
    924             DoRotate
    925             SendCmd "camera reset"
    926         }
    927         PanCamera
    928         StopBufferingCommands
    929         SendCmd "imgflush"
    930         StartBufferingCommands
    931     }
    932 
    933     set _first ""
    934     # Start off with no datasets are visible.
    935     SendCmd "dataset visible 0"
    936     set scale [GetHeightmapScale]
    937     foreach dataobj [get -objects] {
    938         if { [info exists _obj2ovride($dataobj-raise)] &&  $_first == "" } {
    939             set _first $dataobj
    940         }
    941         set _obj2datasets($dataobj) ""
    942         foreach comp [$dataobj components] {
    943             set tag $dataobj-$comp
    944             if { ![info exists _datasets($tag)] } {
    945                 set bytes [$dataobj vtkdata $comp]
    946                 if 0 {
    947                     set f [open /tmp/vtkheightmap.vtk "w"]
    948                     puts $f $bytes
    949                     close $f
    950                 }
    951                 set length [string length $bytes]
    952                 if { $_reportClientInfo }  {
    953                     set info {}
    954                     lappend info "tool_id"       [$dataobj hints toolId]
    955                     lappend info "tool_name"     [$dataobj hints toolName]
    956                     lappend info "tool_version"  [$dataobj hints toolRevision]
    957                     lappend info "tool_title"    [$dataobj hints toolTitle]
    958                     lappend info "dataset_label" [$dataobj hints label]
    959                     lappend info "dataset_size"  $length
    960                     lappend info "dataset_tag"   $tag
    961                     SendCmd [list "clientinfo" $info]
    962                 }
    963                 SendCmd "dataset add $tag data follows $length"
    964                 append _outbuf $bytes
    965                 set _datasets($tag) 1
    966                 SetObjectStyle $dataobj $comp
    967             }
    968             lappend _obj2datasets($dataobj) $tag
    969             if { [info exists _obj2ovride($dataobj-raise)] } {
    970                 # Setting dataset visible enables outline
    971                 # and heightmap
    972                 SendCmd "dataset visible 1 $tag"
    973             }
    974             if { ![info exists _comp2scale($tag)] ||
    975                  $_comp2scale($tag) != $scale } {
    976                 SendCmd "heightmap heightscale $scale $tag"
    977                 set _comp2scale($tag) $scale
     861set w [winfo width $itk_component(view)]
     862set h [winfo height $itk_component(view)]
     863if { $w < 2 || $h < 2 } {
     864$_dispatcher event -idle !rebuild
     865return
     866}
     867
     868if { $_reset && $_reportClientInfo }  {
     869# Tell the server the name of the tool, the version, and dataset
     870# that we are rendering.  Have to do it here because we don't know
     871# what data objects are using the renderer until be get here.
     872global env
     873
     874set info {}
     875set user "???"
     876if { [info exists env(USER)] } {
     877    set user $env(USER)
     878}
     879set session "???"
     880if { [info exists env(SESSION)] } {
     881    set session $env(SESSION)
     882}
     883lappend info "hub" [exec hostname]
     884lappend info "client" "vtkheightmapviewer"
     885lappend info "user" $user
     886lappend info "session" $session
     887SendCmd "clientinfo [list $info]"
     888}
     889
     890# Turn on buffering of commands to the server.  We don't want to
     891# be preempted by a server disconnect/reconnect (which automatically
     892# generates a new call to Rebuild).   
     893StartBufferingCommands
     894
     895if { $_width != $w || $_height != $h || $_reset } {
     896set _width $w
     897set _height $h
     898$_arcball resize $w $h
     899DoResize
     900if { $_settings(stretchToFit) } {
     901    AdjustSetting stretchToFit
     902}
     903}
     904if { $_reset } {
     905InitSettings isHeightmap background
     906#
     907# Reset the camera and other view parameters
     908#
     909SendCmd "axis color all [Color2RGB $itk_option(-plotforeground)]"
     910
     911# Let's see how this goes.  I think it's preferable to overloading the
     912# axis title with the exponent.
     913SendCmd "axis exp 0 0 0 1"
     914
     915SendCmd "axis lrot z 90"
     916set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
     917$_arcball quaternion $q
     918if {$_settings(isHeightmap) } {
     919    if { $_view(ortho)} {
     920        SendCmd "camera mode ortho"
     921    } else {
     922        SendCmd "camera mode persp"
     923    }
     924    DoRotate
     925    SendCmd "camera reset"
     926}
     927PanCamera
     928StopBufferingCommands
     929SendCmd "imgflush"
     930StartBufferingCommands
     931}
     932
     933set _first ""
     934# Start off with no datasets are visible.
     935SendCmd "dataset visible 0"
     936set scale [GetHeightmapScale]
     937foreach dataobj [get -objects] {
     938if { [info exists _obj2ovride($dataobj-raise)] &&  $_first == "" } {
     939    set _first $dataobj
     940}
     941set _obj2datasets($dataobj) ""
     942foreach comp [$dataobj components] {
     943    set tag $dataobj-$comp
     944    if { ![info exists _datasets($tag)] } {
     945        set bytes [$dataobj vtkdata $comp]
     946        if 0 {
     947            set f [open /tmp/vtkheightmap.vtk "w"]
     948            puts $f $bytes
     949            close $f
     950        }
     951        set length [string length $bytes]
     952        if { $_reportClientInfo }  {
     953            set info {}
     954            lappend info "tool_id"       [$dataobj hints toolId]
     955            lappend info "tool_name"     [$dataobj hints toolName]
     956            lappend info "tool_version"  [$dataobj hints toolRevision]
     957            lappend info "tool_title"    [$dataobj hints toolTitle]
     958            lappend info "dataset_label" [$dataobj hints label]
     959            lappend info "dataset_size"  $length
     960            lappend info "dataset_tag"   $tag
     961            SendCmd [list "clientinfo" $info]
     962        }
     963        SendCmd "dataset add $tag data follows $length"
     964        append _outbuf $bytes
     965        set _datasets($tag) 1
     966        SetObjectStyle $dataobj $comp
     967    }
     968    lappend _obj2datasets($dataobj) $tag
     969    if { [info exists _obj2ovride($dataobj-raise)] } {
     970        # Setting dataset visible enables outline
     971        # and heightmap
     972        SendCmd "dataset visible 1 $tag"
     973    }
     974    if { ![info exists _comp2scale($tag)] ||
     975         $_comp2scale($tag) != $scale } {
     976        SendCmd "heightmap heightscale $scale $tag"
     977        set _comp2scale($tag) $scale
     978    }
     979}
     980}
     981if { $_first != ""  } {
     982$itk_component(field) choices delete 0 end
     983$itk_component(fieldmenu) delete 0 end
     984array unset _fields
     985set _curFldName ""
     986foreach cname [$_first components] {
     987    foreach fname [$_first fieldnames $cname] {
     988        if { [info exists _fields($fname)] } {
     989            continue
     990        }
     991        foreach { label units components } \
     992            [$_first fieldinfo $fname] break
     993        $itk_component(field) choices insert end "$fname" "$label"
     994        $itk_component(fieldmenu) add radiobutton -label "$label" \
     995            -value $label -variable [itcl::scope _curFldLabel] \
     996            -selectcolor red \
     997            -activebackground $itk_option(-plotbackground) \
     998            -activeforeground $itk_option(-plotforeground) \
     999            -font "Arial 8" \
     1000            -command [itcl::code $this Combo invoke]
     1001        set _fields($fname) [list $label $units $components]
     1002        if { $_curFldName == "" } {
     1003            set _curFldName $fname
     1004            set _curFldLabel $label
     1005        }
     1006    }
     1007}
     1008$itk_component(field) value $_curFldLabel
     1009}
     1010InitSettings stretchToFit outline
     1011
     1012if { $_reset } {
     1013SendCmd "axis tickpos outside"
     1014foreach axis { x y z } {
     1015    SendCmd "axis lformat $axis %g"
     1016}
     1017
     1018foreach axis { x y z } {
     1019    set label [$_first hints ${axis}label]
     1020    if { $label == "" } {
     1021        if {$axis == "z"} {
     1022            if { [string match "component*" $_curFldName] } {
     1023                set label [string toupper $axis]
     1024            } else {
     1025                set label $_curFldLabel
    9781026            }
    979         }
    980     }
    981     if { $_first != ""  } {
    982         $itk_component(field) choices delete 0 end
    983         $itk_component(fieldmenu) delete 0 end
    984         array unset _fields
    985         set _curFldName ""
    986         foreach cname [$_first components] {
    987             foreach fname [$_first fieldnames $cname] {
    988                 if { [info exists _fields($fname)] } {
    989                     continue
    990                 }
    991                 foreach { label units components } \
    992                     [$_first fieldinfo $fname] break
    993                 $itk_component(field) choices insert end "$fname" "$label"
    994                 $itk_component(fieldmenu) add radiobutton -label "$label" \
    995                     -value $label -variable [itcl::scope _curFldLabel] \
    996                     -selectcolor red \
    997                     -activebackground $itk_option(-plotbackground) \
    998                     -activeforeground $itk_option(-plotforeground) \
    999                     -font "Arial 8" \
    1000                     -command [itcl::code $this Combo invoke]
    1001                 set _fields($fname) [list $label $units $components]
    1002                 if { $_curFldName == "" } {
    1003                     set _curFldName $fname
    1004                     set _curFldLabel $label
    1005                 }
    1006             }
    1007         }
    1008         $itk_component(field) value $_curFldLabel
    1009     }
    1010     InitSettings stretchToFit outline
    1011 
    1012     if { $_reset } {
    1013         SendCmd "axis tickpos outside"
    1014         foreach axis { x y z } {
    1015             SendCmd "axis lformat $axis %g"
    1016         }
    1017        
    1018         foreach axis { x y z } {
    1019             set label [$_first hints ${axis}label]
    1020             if { $label == "" } {
    1021                 if {$axis == "z"} {
    1022                     if { [string match "component*" $_curFldName] } {
    1023                         set label [string toupper $axis]
    1024                     } else {
    1025                         set label $_curFldLabel
    1026                     }
    1027                 } else {
    1028                     set label [string toupper $axis]
    1029                 }
    1030             }
    1031             # May be a space in the axis label.
    1032             SendCmd [list axis name $axis $label]
    1033 
    1034             if {$axis == "z" && [$_first hints ${axis}units] == ""} {
    1035                 set units [lindex $_fields($_curFldName) 1]
    1036             } else {
    1037                 set units [$_first hints ${axis}units]
    1038             }
    1039             if { $units != "" } {
    1040                 # May be a space in the axis units.
    1041                 SendCmd [list axis units $axis $units]
    1042             }
    1043         }
    1044         #
    1045         # Reset the camera and other view parameters
    1046         #
    1047         SendCmd "axis color all [Color2RGB $itk_option(-plotforeground)]"
    1048         SendCmd "outline color [Color2RGB $itk_option(-plotforeground)]"
    1049         ResetAxes
    1050         set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
    1051         $_arcball quaternion $q
    1052         if {$_settings(isHeightmap) } {
    1053             if { $_view(ortho)} {
    1054                 SendCmd "camera mode ortho"
    1055             } else {
    1056                 SendCmd "camera mode persp"
    1057             }
    1058             DoRotate
    1059             SendCmd "camera reset"
    1060         }
    1061         PanCamera
    1062         InitSettings axisXGrid axisYGrid axisZGrid \
    1063             axisVisible axisLabels
    1064         InitSettings heightmapScale field isHeightmap
    1065         if { [array size _fields] < 2 } {
    1066             blt::table forget $itk_component(field) $itk_component(field_l)
    1067         }
    1068         RequestLegend
    1069         set _reset 0
    1070     }
    1071     global readyForNextFrame
    1072     set readyForNextFrame 0;            # Don't advance to the next frame
    1073 
    1074     # Actually write the commands to the server socket.  If it fails, we don't
    1075     # care.  We're finished here.
    1076     blt::busy hold $itk_component(hull)
    1077     StopBufferingCommands
    1078     blt::busy release $itk_component(hull)
     1027        } else {
     1028            set label [string toupper $axis]
     1029        }
     1030    }
     1031    # May be a space in the axis label.
     1032    SendCmd [list axis name $axis $label]
     1033
     1034    if {$axis == "z" && [$_first hints ${axis}units] == ""} {
     1035        set units [lindex $_fields($_curFldName) 1]
     1036    } else {
     1037        set units [$_first hints ${axis}units]
     1038    }
     1039    if { $units != "" } {
     1040        # May be a space in the axis units.
     1041        SendCmd [list axis units $axis $units]
     1042    }
     1043}
     1044#
     1045# Reset the camera and other view parameters
     1046#
     1047SendCmd "axis color all [Color2RGB $itk_option(-plotforeground)]"
     1048SendCmd "outline color [Color2RGB $itk_option(-plotforeground)]"
     1049ResetAxes
     1050set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
     1051$_arcball quaternion $q
     1052if {$_settings(isHeightmap) } {
     1053    if { $_view(ortho)} {
     1054        SendCmd "camera mode ortho"
     1055    } else {
     1056        SendCmd "camera mode persp"
     1057    }
     1058    DoRotate
     1059    SendCmd "camera reset"
     1060}
     1061PanCamera
     1062InitSettings axisXGrid axisYGrid axisZGrid \
     1063    axisVisible axisLabels
     1064InitSettings heightmapScale field isHeightmap
     1065if { [array size _fields] < 2 } {
     1066    catch {
     1067        blt::table forget $itk_component(field) $itk_component(field_l)
     1068    }
     1069}
     1070RequestLegend
     1071set _reset 0
     1072}
     1073global readyForNextFrame
     1074set readyForNextFrame 0;                # Don't advance to the next frame
     1075
     1076# Actually write the commands to the server socket.  If it fails, we don't
     1077# care.  We're finished here.
     1078blt::busy hold $itk_component(hull)
     1079StopBufferingCommands
     1080blt::busy release $itk_component(hull)
    10791081}
    10801082
    … …  
    10871089# ----------------------------------------------------------------------
    10881090itcl::body Rappture::VtkHeightmapViewer::CurrentDatasets {args} {
    1089     set flag [lindex $args 0]
    1090     switch -- $flag {
    1091         "-all" {
    1092             if { [llength $args] > 1 } {
    1093                 error "CurrentDatasets: can't specify dataobj after \"-all\""
    1094             }
    1095             set dlist [get -objects]
    1096         }
    1097         "-visible" {
    1098             if { [llength $args] > 1 } {
    1099                 set dlist {}
    1100                 set args [lrange $args 1 end]
    1101                 foreach dataobj $args {
    1102                     if { [info exists _obj2ovride($dataobj-raise)] } {
    1103                         lappend dlist $dataobj
    1104                     }
    1105                 }
    1106             } else {
    1107                 set dlist [get -visible]
    1108             }
    1109         }           
    1110         default {
    1111             set dlist $args
    1112         }
    1113     }
    1114     set rlist ""
    1115     foreach dataobj $dlist {
    1116         foreach comp [$dataobj components] {
    1117             set tag $dataobj-$comp
    1118             if { [info exists _datasets($tag)] && $_datasets($tag) } {
    1119                 lappend rlist $tag
    1120             }
    1121         }
    1122     }
    1123     return $rlist
     1091set flag [lindex $args 0]
     1092switch -- $flag {
     1093"-all" {
     1094    if { [llength $args] > 1 } {
     1095        error "CurrentDatasets: can't specify dataobj after \"-all\""
     1096    }
     1097    set dlist [get -objects]
     1098}
     1099"-visible" {
     1100    if { [llength $args] > 1 } {
     1101        set dlist {}
     1102        set args [lrange $args 1 end]
     1103        foreach dataobj $args {
     1104            if { [info exists _obj2ovride($dataobj-raise)] } {
     1105                lappend dlist $dataobj
     1106            }
     1107        }
     1108    } else {
     1109        set dlist [get -visible]
     1110    }
     1111}           
     1112default {
     1113    set dlist $args
     1114}
     1115}
     1116set rlist ""
     1117foreach dataobj $dlist {
     1118foreach comp [$dataobj components] {
     1119    set tag $dataobj-$comp
     1120    if { [info exists _datasets($tag)] && $_datasets($tag) } {
     1121        lappend rlist $tag
     1122    }
     1123}
     1124}
     1125return $rlist
    11241126}
    11251127
    … …  
    11331135# ----------------------------------------------------------------------
    11341136itcl::body Rappture::VtkHeightmapViewer::Zoom {option} {
    1135     switch -- $option {
    1136         "in" {
    1137             set _view(zoom) [expr {$_view(zoom)*1.25}]
    1138             SendCmd "camera zoom $_view(zoom)"
    1139         }
    1140         "out" {
    1141             set _view(zoom) [expr {$_view(zoom)*0.8}]
    1142             SendCmd "camera zoom $_view(zoom)"
    1143         }
    1144         "reset" {
    1145             array set _view {
    1146                 qw      0.36
    1147                 qx      0.25
    1148                 qy      0.50
    1149                 qz      0.70
    1150                 zoom    1.0
    1151                 xpan    0
    1152                 ypan    0
    1153             }
    1154             if { $_first != "" } {
    1155                 set location [$_first hints camera]
    1156                 if { $location != "" } {
    1157                     array set _view $location
    1158                 }
    1159             }
    1160             set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
    1161             $_arcball quaternion $q
    1162             if {$_settings(isHeightmap) } {
    1163                 DoRotate
    1164             }
    1165             SendCmd "camera reset"
    1166         }
    1167     }
     1137switch -- $option {
     1138"in" {
     1139    set _view(zoom) [expr {$_view(zoom)*1.25}]
     1140    SendCmd "camera zoom $_view(zoom)"
     1141}
     1142"out" {
     1143    set _view(zoom) [expr {$_view(zoom)*0.8}]
     1144    SendCmd "camera zoom $_view(zoom)"
     1145}
     1146"reset" {
     1147    array set _view {
     1148        qw      0.36
     1149        qx      0.25
     1150        qy      0.50
     1151        qz      0.70
     1152        zoom    1.0
     1153        xpan    0
     1154        ypan    0
     1155    }
     1156    if { $_first != "" } {
     1157        set location [$_first hints camera]
     1158        if { $location != "" } {
     1159            array set _view $location
     1160        }
     1161    }
     1162    set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
     1163    $_arcball quaternion $q
     1164    if {$_settings(isHeightmap) } {
     1165        DoRotate
     1166    }
     1167    SendCmd "camera reset"
     1168}
     1169}
    11681170}
    11691171
    11701172itcl::body Rappture::VtkHeightmapViewer::PanCamera {} {
    1171     set x $_view(xpan)
    1172     set y $_view(ypan)
    1173     SendCmd "camera pan $x $y"
     1173set x $_view(xpan)
     1174set y $_view(ypan)
     1175SendCmd "camera pan $x $y"
    11741176}
    11751177
    … …  
    11841186# ----------------------------------------------------------------------
    11851187itcl::body Rappture::VtkHeightmapViewer::Rotate {option x y} {
    1186     switch -- $option {
    1187         "click" {
    1188             $itk_component(view) configure -cursor fleur
    1189             set _click(x) $x
    1190             set _click(y) $y
    1191         }
    1192         "drag" {
    1193             if {[array size _click] == 0} {
    1194                 Rotate click $x $y
    1195             } else {
    1196                 set w [winfo width $itk_component(view)]
    1197                 set h [winfo height $itk_component(view)]
    1198                 if {$w <= 0 || $h <= 0} {
    1199                     return
    1200                 }
    1201 
    1202                 if {[catch {
    1203                     # this fails sometimes for no apparent reason
    1204                     set dx [expr {double($x-$_click(x))/$w}]
    1205                     set dy [expr {double($y-$_click(y))/$h}]
    1206                 }]} {
    1207                     return
    1208                 }
    1209                 if { $dx == 0 && $dy == 0 } {
    1210                     return
    1211                 }
    1212                 set q [$_arcball rotate $x $y $_click(x) $_click(y)]
    1213                 EventuallyRotate $q
    1214                 set _click(x) $x
    1215                 set _click(y) $y
    1216             }
    1217         }
    1218         "release" {
    1219             Rotate drag $x $y
    1220             $itk_component(view) configure -cursor ""
    1221             catch {unset _click}
    1222         }
    1223         default {
    1224             error "bad option \"$option\": should be click, drag, release"
    1225         }
    1226     }
     1188switch -- $option {
     1189"click" {
     1190    $itk_component(view) configure -cursor fleur
     1191    set _click(x) $x
     1192    set _click(y) $y
     1193}
     1194"drag" {
     1195    if {[array size _click] == 0} {
     1196        Rotate click $x $y
     1197    } else {
     1198        set w [winfo width $itk_component(view)]
     1199        set h [winfo height $itk_component(view)]
     1200        if {$w <= 0 || $h <= 0} {
     1201            return
     1202        }
     1203
     1204        if {[catch {
     1205            # this fails sometimes for no apparent reason
     1206            set dx [expr {double($x-$_click(x))/$w}]
     1207            set dy [expr {double($y-$_click(y))/$h}]
     1208        }]} {
     1209            return
     1210        }
     1211        if { $dx == 0 && $dy == 0 } {
     1212            return
     1213        }
     1214        set q [$_arcball rotate $x $y $_click(x) $_click(y)]
     1215        EventuallyRotate $q
     1216        set _click(x) $x
     1217        set _click(y) $y
     1218    }
     1219}
     1220"release" {
     1221    Rotate drag $x $y
     1222    $itk_component(view) configure -cursor ""
     1223    catch {unset _click}
     1224}
     1225default {
     1226    error "bad option \"$option\": should be click, drag, release"
     1227}
     1228}
    12271229}
    12281230
    12291231itcl::body Rappture::VtkHeightmapViewer::Pick {x y} {
    1230     foreach tag [CurrentDatasets -visible] {
    1231         SendCmd "dataset getscalar pixel $x $y $tag"
    1232     }
     1232foreach tag [CurrentDatasets -visible] {
     1233SendCmd "dataset getscalar pixel $x $y $tag"
     1234}
    12331235}
    12341236
    … …  
    12421244# ----------------------------------------------------------------------
    12431245itcl::body Rappture::VtkHeightmapViewer::Pan {option x y} {
    1244     switch -- $option {
    1245         "set" {
    1246             set w [winfo width $itk_component(view)]
    1247             set h [winfo height $itk_component(view)]
    1248             set x [expr $x / double($w)]
    1249             set y [expr $y / double($h)]
    1250             set _view(xpan) [expr $_view(xpan) + $x]
    1251             set _view(ypan) [expr $_view(ypan) + $y]
    1252             PanCamera
    1253             return
    1254         }
    1255         "click" {
    1256             set _click(x) $x
    1257             set _click(y) $y
    1258             $itk_component(view) configure -cursor hand1
    1259         }
    1260         "drag" {
    1261             if { ![info exists _click(x)] } {
    1262                 set _click(x) $x
    1263             }
    1264             if { ![info exists _click(y)] } {
    1265                 set _click(y) $y
    1266             }
    1267             set w [winfo width $itk_component(view)]
    1268             set h [winfo height $itk_component(view)]
    1269             set dx [expr ($_click(x) - $x)/double($w)]
    1270             set dy [expr ($_click(y) - $y)/double($h)]
    1271             set _click(x) $x
    1272             set _click(y) $y
    1273             set _view(xpan) [expr $_view(xpan) - $dx]
    1274             set _view(ypan) [expr $_view(ypan) - $dy]
    1275             PanCamera
    1276         }
    1277         "release" {
    1278             Pan drag $x $y
    1279             $itk_component(view) configure -cursor ""
    1280         }
    1281         default {
    1282             error "unknown option \"$option\": should set, click, drag, or release"
    1283         }
    1284     }
     1246switch -- $option {
     1247"set" {
     1248    set w [winfo width $itk_component(view)]
     1249    set h [winfo height $itk_component(view)]
     1250    set x [expr $x / double($w)]
     1251    set y [expr $y / double($h)]
     1252    set _view(xpan) [expr $_view(xpan) + $x]
     1253    set _view(ypan) [expr $_view(ypan) + $y]
     1254    PanCamera
     1255    return
     1256}
     1257"click" {
     1258    set _click(x) $x
     1259    set _click(y) $y
     1260    $itk_component(view) configure -cursor hand1
     1261}
     1262"drag" {
     1263    if { ![info exists _click(x)] } {
     1264        set _click(x) $x
     1265    }
     1266    if { ![info exists _click(y)] } {
     1267        set _click(y) $y
     1268    }
     1269    set w [winfo width $itk_component(view)]
     1270    set h [winfo height $itk_component(view)]
     1271    set dx [expr ($_click(x) - $x)/double($w)]
     1272    set dy [expr ($_click(y) - $y)/double($h)]
     1273    set _click(x) $x
     1274    set _click(y) $y
     1275    set _view(xpan) [expr $_view(xpan) - $dx]
     1276    set _view(ypan) [expr $_view(ypan) - $dy]
     1277    PanCamera
     1278}
     1279"release" {
     1280    Pan drag $x $y
     1281    $itk_component(view) configure -cursor ""
     1282}
     1283default {
     1284    error "unknown option \"$option\": should set, click, drag, or release"
     1285}
     1286}
    12851287}
    12861288
    … …  
    12931295# ----------------------------------------------------------------------
    12941296itcl::body Rappture::VtkHeightmapViewer::InitSettings { args } {
    1295     foreach spec $args {
    1296         if { [info exists _settings($_first-$spec)] } {
    1297             # Reset global setting with dataobj specific setting
    1298             set _settings($spec) $_settings($_first-$spec)
    1299         }
    1300         AdjustSetting $spec
    1301     }
     1297foreach spec $args {
     1298if { [info exists _settings($_first-$spec)] } {
     1299    # Reset global setting with dataobj specific setting
     1300    set _settings($spec) $_settings($_first-$spec)
     1301}
     1302AdjustSetting $spec
     1303}
    13021304}
    13031305
    … …  
    13101312#
    13111313itcl::body Rappture::VtkHeightmapViewer::AdjustSetting {what {value ""}} {
    1312     if { $_beforeConnect } {
    1313         return
    1314     }
    1315     switch -- $what {
    1316         "axisFlymode" {
    1317             set mode [$itk_component(axisflymode) value]
    1318             set mode [$itk_component(axisflymode) translate $mode]
    1319             set _settings($what) $mode
    1320             SendCmd "axis flymode $mode"
    1321         }
    1322         "axisLabels" {
    1323             set bool $_settings(axisLabels)
    1324             SendCmd "axis labels all $bool"
    1325         }
    1326         "axisMinorTicks" {
    1327             set bool $_settings(axisMinorTicks)
    1328             foreach axis { x y z } {
    1329                 SendCmd "axis minticks ${axis} $bool"
    1330             }
    1331         }
    1332         "axisVisible" {
    1333             set bool $_settings(axisVisible)
    1334             SendCmd "axis visible all $bool"
    1335         }
    1336         "axisXGrid" - "axisYGrid" - "axisZGrid" {
    1337             set axis [string tolower [string range $what 4 4]]
    1338             set bool $_settings($what)
    1339             SendCmd "axis grid $axis $bool"
    1340         }
    1341         "background" {
    1342             set bgcolor [$itk_component(background) value]
    1343             array set fgcolors {
    1344                 "black" "white"
    1345                 "white" "black"
    1346                 "grey"  "black"
    1347             }
    1348             configure -plotbackground $bgcolor \
    1349                 -plotforeground $fgcolors($bgcolor)
    1350             $itk_component(view) delete "legend"
    1351             DrawLegend
    1352         }
    1353         "colormap" {
    1354             set _changed(colormap) 1
    1355             StartBufferingCommands
    1356             set color [$itk_component(colormap) value]
    1357             set _settings(colormap) $color
    1358             if { $color == "none" } {
    1359                 if { $_settings(colormapVisible) } {
    1360                     SendCmd "heightmap surface 0"
    1361                     set _settings(colormapVisible) 0
    1362                 }
    1363             } else {
    1364                 if { !$_settings(colormapVisible) } {
    1365                     SendCmd "heightmap surface 1"
    1366                     set _settings(colormapVisible) 1
    1367                 }
    1368                 SetCurrentColormap $color
    1369                 if {$_settings(colormapDiscrete)} {
    1370                     set numColors [expr $_settings(numIsolines) - 1]
    1371                     SendCmd "colormap res $numColors $color"
    1372                 }
    1373             }
    1374             StopBufferingCommands
    1375             EventuallyRequestLegend
    1376         }
    1377         "colormapVisible" {
    1378             set bool $_settings($what)
    1379             SendCmd "heightmap surface $bool"
    1380         }
    1381         "colormapDiscrete" {
    1382             set bool $_settings($what)
    1383             set numColors [expr $_settings(numIsolines) - 1]
    1384             StartBufferingCommands
    1385             if {$bool} {
    1386                 SendCmd "colormap res $numColors"
    1387                 # Discrete colormap requires preinterp on
    1388                 SendCmd "heightmap preinterp on"
    1389             } else {
    1390                 SendCmd "colormap res default"
    1391                 # FIXME: add setting for preinterp (default on)
    1392                 SendCmd "heightmap preinterp on"
    1393             }
    1394             StopBufferingCommands
    1395             EventuallyRequestLegend
    1396         }
    1397         "edges" {
    1398             set bool $_settings(edges)
    1399             SendCmd "heightmap edges $bool"
    1400         }
    1401         "field" {
    1402             set label [$itk_component(field) value]
    1403             set fname [$itk_component(field) translate $label]
    1404             set _settings(field) $fname
    1405             if { [info exists _fields($fname)] } {
    1406                 foreach { label units components } $_fields($fname) break
    1407                 if { $components > 1 } {
    1408                     set _colorMode vmag
    1409                 } else {
    1410                     set _colorMode scalar
    1411                 }
    1412                 set _curFldName $fname
    1413                 set _curFldLabel $label
    1414             } else {
    1415                 puts stderr "unknown field \"$fname\""
    1416                 return
    1417             }
    1418             set label [$_first hints zlabel]
    1419             if { $label == "" } {
    1420                 if { [string match "component*" $_curFldName] } {
    1421                     set label Z
    1422                 } else {
    1423                     set label $_curFldLabel
    1424                 }
    1425             }
    1426             # May be a space in the axis label.
    1427             SendCmd [list axis name z $label]
    1428 
    1429             if { [$_first hints zunits] == "" } {
    1430                 set units [lindex $_fields($_curFldName) 1]
    1431             } else {
    1432                 set units [$_first hints zunits]
    1433             }
    1434             if { $units != "" } {
    1435                 # May be a space in the axis units.
    1436                 SendCmd [list axis units z $units]
    1437             }
    1438             # Get the new limits because the field changed.
    1439             ResetAxes
    1440             SendCmd "dataset scalar $_curFldName"
    1441             SendCmd "heightmap colormode scalar $_curFldName"
    1442             SendCmd "camera reset"
    1443             DrawLegend
    1444         }
    1445         "heightmapScale" {
    1446             if { $_settings(isHeightmap) } {
    1447                 set scale [GetHeightmapScale]
    1448                 # Have to set the datasets individually because we are
    1449                 # tracking them in _comp2scale.
    1450                 foreach dataset [CurrentDatasets -all] {
    1451                     SendCmd "heightmap heightscale $scale $dataset"
    1452                     set _comp2scale($dataset) $scale
    1453                 }
    1454                 ResetAxes
    1455             }
    1456         }
    1457         "isHeightmap" {
    1458             set bool $_settings(isHeightmap)
    1459             set c $itk_component(view)
    1460             StartBufferingCommands
    1461             # Fix heightmap scale: 0 for contours, 1 for heightmaps.
    1462             if { $bool } {
    1463                 set _settings(heightmapScale) 50
    1464                 set _settings(opacity) $_settings(saveOpacity)
    1465                 set _settings(lighting) $_settings(saveLighting)
    1466                 set _settings(outline) 0
    1467             } else {
    1468                 set _settings(heightmapScale) 0
    1469                 set _settings(lighting) 0
    1470                 set _settings(opacity) 100
    1471                 set _settings(outline)  $_settings(saveOutline)
    1472             }
    1473             AdjustSetting lighting
    1474             AdjustSetting opacity
    1475             AdjustSetting outline
    1476             set scale [GetHeightmapScale]
    1477             # Have to set the datasets individually because we are
    1478             # tracking them in _comp2scale.
    1479             foreach dataset [CurrentDatasets -all] {
    1480                 SendCmd "heightmap heightscale $scale $dataset"
    1481                 set _comp2scale($dataset) $scale
    1482             }
    1483             if { $bool } {
    1484                 $itk_component(lighting) configure -state normal
    1485                 $itk_component(opacity) configure -state normal
    1486                 $itk_component(scale) configure -state normal
    1487                 $itk_component(opacity_l) configure -state normal
    1488                 $itk_component(scale_l) configure -state normal
    1489                 $itk_component(outline) configure -state disabled
    1490                 if {$_view(ortho)} {
    1491                     SendCmd "camera mode ortho"
    1492                 } else {
    1493                     SendCmd "camera mode persp"
    1494                 }
    1495             } else {
    1496                 $itk_component(lighting) configure -state disabled
    1497                 $itk_component(opacity) configure -state disabled
    1498                 $itk_component(scale) configure -state disabled
    1499                 $itk_component(opacity_l) configure -state disabled
    1500                 $itk_component(scale_l) configure -state disabled
    1501                 $itk_component(outline) configure -state normal
    1502                 SendCmd "camera mode image"
    1503             }
    1504             if {$_settings(stretchToFit)} {
    1505                 if {$scale == 0} {
    1506                     SendCmd "camera aspect window"
    1507                 } else {
    1508                     SendCmd "camera aspect square"
    1509                 }
    1510             }
    1511             ResetAxes
    1512             if { $bool } {
    1513                 set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
    1514                 $_arcball quaternion $q
    1515                 SendCmd "camera orient $q"
    1516             } else {
    1517                 bind $c <ButtonPress-1> {}
    1518                 bind $c <B1-Motion> {}
    1519                 bind $c <ButtonRelease-1> {}
    1520             }
    1521             SendCmd "camera reset"
    1522             # Fix the mouse bindings for rotation/panning and the
    1523             # camera mode. Ideally we'd create a bindtag for these.
    1524             if { $bool } {
    1525                 # Bindings for rotation via mouse
    1526                 bind $c <ButtonPress-1> \
    1527                     [itcl::code $this Rotate click %x %y]
    1528                 bind $c <B1-Motion> \
    1529                     [itcl::code $this Rotate drag %x %y]
    1530                 bind $c <ButtonRelease-1> \
    1531                     [itcl::code $this Rotate release %x %y]
    1532             }
    1533             StopBufferingCommands
    1534         }
    1535         "isolineColor" {
    1536             set color [$itk_component(isolinecolor) value]
    1537             if { $color == "none" } {
    1538                 if { $_settings(isolinesVisible) } {
    1539                     SendCmd "heightmap isolines 0"
    1540                     set _settings(isolinesVisible) 0
    1541                 }
    1542             } else {
    1543                 if { !$_settings(isolinesVisible) } {
    1544                     SendCmd "heightmap isolines 1"
    1545                     set _settings(isolinesVisible) 1
    1546                 }
    1547                 SendCmd "heightmap isolinecolor [Color2RGB $color]"
    1548             }
    1549             DrawLegend
    1550         }
    1551         "isolinesVisible" {
    1552             set bool $_settings($what)
    1553             SendCmd "heightmap isolines $bool"
    1554             DrawLegend
    1555         }
    1556         "legendVisible" {
    1557             if { !$_settings($what) } {
    1558                 $itk_component(view) delete legend
    1559             }
    1560             DrawLegend
    1561         }
    1562         "lighting" {
    1563             if { $_settings(isHeightmap) } {
    1564                 set _settings(saveLighting) $_settings(lighting)
    1565                 set bool $_settings($what)
    1566                 SendCmd "heightmap lighting $bool"
    1567             } else {
    1568                 SendCmd "heightmap lighting 0"
    1569             }
    1570         }
    1571         "numIsolines" {
    1572             set _changed(numIsolines) 1
    1573             set _settings(numIsolines) [$itk_component(numisolines) value]
    1574             set _currentNumIsolines $_settings(numIsolines)
    1575             SendCmd "heightmap numcontours $_settings(numIsolines)"
    1576             if {$_settings(colormapDiscrete)} {
    1577                 set numColors [expr $_settings(numIsolines) - 1]
    1578                 SendCmd "colormap res $numColors"
    1579                 EventuallyRequestLegend
    1580             } else {
    1581                 DrawLegend
    1582             }
    1583         }
    1584         "opacity" {
    1585             set _changed(opacity) 1
    1586             if { $_settings(isHeightmap) } {
    1587                 set _settings(saveOpacity) $_settings(opacity)
    1588                 set val $_settings(opacity)
    1589                 set sval [expr { 0.01 * double($val) }]
    1590                 SendCmd "heightmap opacity $sval"
    1591             } else {
    1592                 SendCmd "heightmap opacity 1"
    1593             }
    1594         }
    1595         "outline" {
    1596             if { $_settings(isHeightmap) } {
    1597                 SendCmd "outline visible 0"
    1598             } else {
    1599                 set _settings(saveOutline) $_settings(outline)
    1600                 set bool $_settings(outline)
    1601                 SendCmd "outline visible $bool"
    1602             }
    1603         }
    1604         "stretchToFit" {
    1605             set bool $_settings($what)
    1606             if { $bool } {
    1607                 set heightScale [GetHeightmapScale]
    1608                 if {$heightScale == 0} {
    1609                     SendCmd "camera aspect window"
    1610                 } else {
    1611                     SendCmd "camera aspect square"
    1612                 }
    1613             } else {
    1614                 SendCmd "camera aspect native"
    1615             }
    1616         }
    1617         "wireframe" {
    1618             set bool $_settings($what)
    1619             SendCmd "heightmap wireframe $bool"
    1620         }
    1621         default {
    1622             error "don't know how to fix $what"
    1623         }
    1624     }
     1314if { $_beforeConnect } {
     1315return
     1316}
     1317switch -- $what {
     1318"axisFlymode" {
     1319    set mode [$itk_component(axisflymode) value]
     1320    set mode [$itk_component(axisflymode) translate $mode]
     1321    set _settings($what) $mode
     1322    SendCmd "axis flymode $mode"
     1323}
     1324"axisLabels" {
     1325    set bool $_settings(axisLabels)
     1326    SendCmd "axis labels all $bool"
     1327}
     1328"axisMinorTicks" {
     1329    set bool $_settings(axisMinorTicks)
     1330    foreach axis { x y z } {
     1331        SendCmd "axis minticks ${axis} $bool"
     1332    }
     1333}
     1334"axisVisible" {
     1335    set bool $_settings(axisVisible)
     1336    SendCmd "axis visible all $bool"
     1337}
     1338"axisXGrid" - "axisYGrid" - "axisZGrid" {
     1339    set axis [string tolower [string range $what 4 4]]
     1340    set bool $_settings($what)
     1341    SendCmd "axis grid $axis $bool"
     1342}
     1343"background" {
     1344    set bgcolor [$itk_component(background) value]
     1345    array set fgcolors {
     1346        "black" "white"
     1347        "white" "black"
     1348        "grey"  "black"
     1349    }
     1350    configure -plotbackground $bgcolor \
     1351        -plotforeground $fgcolors($bgcolor)
     1352    $itk_component(view) delete "legend"
     1353    DrawLegend
     1354}
     1355"colormap" {
     1356    set _changed(colormap) 1
     1357    StartBufferingCommands
     1358    set color [$itk_component(colormap) value]
     1359    set _settings(colormap) $color
     1360    if { $color == "none" } {
     1361        if { $_settings(colormapVisible) } {
     1362            SendCmd "heightmap surface 0"
     1363            set _settings(colormapVisible) 0
     1364        }
     1365    } else {
     1366        if { !$_settings(colormapVisible) } {
     1367            SendCmd "heightmap surface 1"
     1368            set _settings(colormapVisible) 1
     1369        }
     1370        SetCurrentColormap $color
     1371        if {$_settings(colormapDiscrete)} {
     1372            set numColors [expr $_settings(numIsolines) - 1]
     1373            SendCmd "colormap res $numColors $color"
     1374        }
     1375    }
     1376    StopBufferingCommands
     1377    EventuallyRequestLegend
     1378}
     1379"colormapVisible" {
     1380    set bool $_settings($what)
     1381    SendCmd "heightmap surface $bool"
     1382}
     1383"colormapDiscrete" {
     1384    set bool $_settings($what)
     1385    set numColors [expr $_settings(numIsolines) - 1]
     1386    StartBufferingCommands
     1387    if {$bool} {
     1388        SendCmd "colormap res $numColors"
     1389        # Discrete colormap requires preinterp on
     1390        SendCmd "heightmap preinterp on"
     1391    } else {
     1392        SendCmd "colormap res default"
     1393        # FIXME: add setting for preinterp (default on)
     1394        SendCmd "heightmap preinterp on"
     1395    }
     1396    StopBufferingCommands
     1397    EventuallyRequestLegend
     1398}
     1399"edges" {
     1400    set bool $_settings(edges)
     1401    SendCmd "heightmap edges $bool"
     1402}
     1403"field" {
     1404    set label [$itk_component(field) value]
     1405    set fname [$itk_component(field) translate $label]
     1406    set _settings(field) $fname
     1407    if { [info exists _fields($fname)] } {
     1408        foreach { label units components } $_fields($fname) break
     1409        if { $components > 1 } {
     1410            set _colorMode vmag
     1411        } else {
     1412            set _colorMode scalar
     1413        }
     1414        set _curFldName $fname
     1415        set _curFldLabel $label
     1416    } else {
     1417        puts stderr "unknown field \"$fname\""
     1418        return
     1419    }
     1420    set label [$_first hints zlabel]
     1421    if { $label == "" } {
     1422        if { [string match "component*" $_curFldName] } {
     1423            set label Z
     1424        } else {
     1425            set label $_curFldLabel
     1426        }
     1427    }
     1428    # May be a space in the axis label.
     1429    SendCmd [list axis name z $label]
     1430
     1431    if { [$_first hints zunits] == "" } {
     1432        set units [lindex $_fields($_curFldName) 1]
     1433    } else {
     1434        set units [$_first hints zunits]
     1435    }
     1436    if { $units != "" } {
     1437        # May be a space in the axis units.
     1438        SendCmd [list axis units z $units]
     1439    }
     1440    # Get the new limits because the field changed.
     1441    ResetAxes
     1442    SendCmd "dataset scalar $_curFldName"
     1443    SendCmd "heightmap colormode scalar $_curFldName"
     1444    SendCmd "camera reset"
     1445    DrawLegend
     1446}
     1447"heightmapScale" {
     1448    if { $_settings(isHeightmap) } {
     1449        set scale [GetHeightmapScale]
     1450        # Have to set the datasets individually because we are
     1451        # tracking them in _comp2scale.
     1452        foreach dataset [CurrentDatasets -all] {
     1453            SendCmd "heightmap heightscale $scale $dataset"
     1454            set _comp2scale($dataset) $scale
     1455        }
     1456        ResetAxes
     1457    }
     1458}
     1459"isHeightmap" {
     1460    set bool $_settings(isHeightmap)
     1461    set c $itk_component(view)
     1462    StartBufferingCommands
     1463    # Fix heightmap scale: 0 for contours, 1 for heightmaps.
     1464    if { $bool } {
     1465        set _settings(heightmapScale) 50
     1466        set _settings(opacity) $_settings(saveOpacity)
     1467        set _settings(lighting) $_settings(saveLighting)
     1468        set _settings(outline) 0
     1469    } else {
     1470        set _settings(heightmapScale) 0
     1471        set _settings(lighting) 0
     1472        set _settings(opacity) 100
     1473        set _settings(outline)  $_settings(saveOutline)
     1474    }
     1475    AdjustSetting lighting
     1476    AdjustSetting opacity
     1477    AdjustSetting outline
     1478    set scale [GetHeightmapScale]
     1479    # Have to set the datasets individually because we are
     1480    # tracking them in _comp2scale.
     1481    foreach dataset [CurrentDatasets -all] {
     1482        SendCmd "heightmap heightscale $scale $dataset"
     1483        set _comp2scale($dataset) $scale
     1484    }
     1485    if { $bool } {
     1486        $itk_component(lighting) configure -state normal
     1487        $itk_component(opacity) configure -state normal
     1488        $itk_component(scale) configure -state normal
     1489        $itk_component(opacity_l) configure -state normal
     1490        $itk_component(scale_l) configure -state normal
     1491        $itk_component(outline) configure -state disabled
     1492        if {$_view(ortho)} {
     1493            SendCmd "camera mode ortho"
     1494        } else {
     1495            SendCmd "camera mode persp"
     1496        }
     1497    } else {
     1498        $itk_component(lighting) configure -state disabled
     1499        $itk_component(opacity) configure -state disabled
     1500        $itk_component(scale) configure -state disabled
     1501        $itk_component(opacity_l) configure -state disabled
     1502        $itk_component(scale_l) configure -state disabled
     1503        $itk_component(outline) configure -state normal
     1504        SendCmd "camera mode image"
     1505    }
     1506    if {$_settings(stretchToFit)} {
     1507        if {$scale == 0} {
     1508            SendCmd "camera aspect window"
     1509        } else {
     1510            SendCmd "camera aspect square"
     1511        }
     1512    }
     1513    ResetAxes
     1514    if { $bool } {
     1515        set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
     1516        $_arcball quaternion $q
     1517        SendCmd "camera orient $q"
     1518    } else {
     1519        bind $c <ButtonPress-1> {}
     1520        bind $c <B1-Motion> {}
     1521        bind $c <ButtonRelease-1> {}
     1522    }
     1523    SendCmd "camera reset"
     1524    # Fix the mouse bindings for rotation/panning and the
     1525    # camera mode. Ideally we'd create a bindtag for these.
     1526    if { $bool } {
     1527        # Bindings for rotation via mouse
     1528        bind $c <ButtonPress-1> \
     1529            [itcl::code $this Rotate click %x %y]
     1530        bind $c <B1-Motion> \
     1531            [itcl::code $this Rotate drag %x %y]
     1532        bind $c <ButtonRelease-1> \
     1533            [itcl::code $this Rotate release %x %y]
     1534    }
     1535    StopBufferingCommands
     1536}
     1537"isolineColor" {
     1538    set color [$itk_component(isolinecolor) value]
     1539    if { $color == "none" } {
     1540        if { $_settings(isolinesVisible) } {
     1541            SendCmd "heightmap isolines 0"
     1542            set _settings(isolinesVisible) 0
     1543        }
     1544    } else {
     1545        if { !$_settings(isolinesVisible) } {
     1546            SendCmd "heightmap isolines 1"
     1547            set _settings(isolinesVisible) 1
     1548        }
     1549        SendCmd "heightmap isolinecolor [Color2RGB $color]"
     1550    }
     1551    DrawLegend
     1552}
     1553"isolinesVisible" {
     1554    set bool $_settings($what)
     1555    SendCmd "heightmap isolines $bool"
     1556    DrawLegend
     1557}
     1558"legendVisible" {
     1559    if { !$_settings($what) } {
     1560        $itk_component(view) delete legend
     1561    }
     1562    DrawLegend
     1563}
     1564"lighting" {
     1565    if { $_settings(isHeightmap) } {
     1566        set _settings(saveLighting) $_settings(lighting)
     1567        set bool $_settings($what)
     1568        SendCmd "heightmap lighting $bool"
     1569    } else {
     1570        SendCmd "heightmap lighting 0"
     1571    }
     1572}
     1573"numIsolines" {
     1574    set _changed(numIsolines) 1
     1575    set _settings(numIsolines) [$itk_component(numisolines) value]
     1576    set _currentNumIsolines $_settings(numIsolines)
     1577    SendCmd "heightmap numcontours $_settings(numIsolines)"
     1578    if {$_settings(colormapDiscrete)} {
     1579        set numColors [expr $_settings(numIsolines) - 1]
     1580        SendCmd "colormap res $numColors"
     1581        EventuallyRequestLegend
     1582    } else {
     1583        DrawLegend
     1584    }
     1585}
     1586"opacity" {
     1587    set _changed(opacity) 1
     1588    if { $_settings(isHeightmap) } {
     1589        set _settings(saveOpacity) $_settings(opacity)
     1590        set val $_settings(opacity)
     1591        set sval [expr { 0.01 * double($val) }]
     1592        SendCmd "heightmap opacity $sval"
     1593    } else {
     1594        SendCmd "heightmap opacity 1"
     1595    }
     1596}
     1597"outline" {
     1598    if { $_settings(isHeightmap) } {
     1599        SendCmd "outline visible 0"
     1600    } else {
     1601        set _settings(saveOutline) $_settings(outline)
     1602        set bool $_settings(outline)
     1603        SendCmd "outline visible $bool"
     1604    }
     1605}
     1606"stretchToFit" {
     1607    set bool $_settings($what)
     1608    if { $bool } {
     1609        set heightScale [GetHeightmapScale]
     1610        if {$heightScale == 0} {
     1611            SendCmd "camera aspect window"
     1612        } else {
     1613            SendCmd "camera aspect square"
     1614        }
     1615    } else {
     1616        SendCmd "camera aspect native"
     1617    }
     1618}
     1619"wireframe" {
     1620    set bool $_settings($what)
     1621    SendCmd "heightmap wireframe $bool"
     1622}
     1623default {
     1624    error "don't know how to fix $what"
     1625}
     1626}
    16251627}
    16261628
Note: See TracChangeset for help on using the changeset viewer.