Changeset 1437 for trunk/gui


Ignore:
Timestamp:
May 14, 2009 10:22:16 PM (15 years ago)
Author:
gah
Message:

adjust SendBytes? calls to not assume newline is appended (-nonewline)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/gui/scripts/heightmapviewer.tcl

    r1391 r1437  
    6464    protected method Disconnect {}
    6565
    66     protected method _send {string}
    67     protected method _send_dataobjs {}
     66    protected method SendCmd {string}
     67    protected method SendDataObjs {}
    6868    protected method ReceiveImage { args }
    69     private method _ReceiveLegend {tf vmin vmax size}
    70     private method _BuildViewTab {}
    71     private method _BuildCameraTab {}
    72     private method _PanCamera {}
    73     protected method _receive_echo {channel {data ""}}
    74 
    75     protected method _rebuild {}
    76     protected method _zoom {option}
    77     protected method _pan {option x y}
    78     protected method _rotate {option x y}
    79 
    80     protected method _state {comp}
    81     protected method _fixSettings {what {value ""}}
    82     protected method _getTransfuncData {dataobj comp}
     69    private method ReceiveLegend {tf vmin vmax size}
     70    private method BuildViewTab {}
     71    private method BuildCameraTab {}
     72    private method PanCamera {}
     73
     74    protected method Rebuild {}
     75    protected method Zoom {option}
     76    protected method Pan {option x y}
     77    protected method Rotate {option x y}
     78
     79    protected method State {comp}
     80    protected method FixSettings {what {value ""}}
     81    protected method GetTransfuncData {dataobj comp}
    8382    private method Resize { w h }
    8483
    85     private variable outbuf_       ;# buffer for outgoing commands
    86 
    87     private variable dlist_ ""     ;# list of data objects
    88     private variable obj2style_    ;# maps dataobj => style settings
    89     private variable obj2ovride_   ;# maps dataobj => style override
    90     private variable obj2id_       ;# maps dataobj => heightmap ID in server
    91     private variable id2obj_       ;# maps heightmap ID => dataobj in server
    92     private variable sendobjs_ ""  ;# list of data objs to send to server
    93     private variable receiveIds_   ;# list of data responses from the server
    94     private variable click_        ;# info used for _rotate operations
    95     private variable limits_       ;# autoscale min/max for all axes
    96     private variable view_         ;# view params for 3D view
    97     private common settings_      ;# Array used for checkbuttons and radiobuttons
    98     private common hardcopy_
     84    private variable _outbuf       ;# buffer for outgoing commands
     85
     86    private variable _dlist ""     ;# list of data objects
     87    private variable _obj2style    ;# maps dataobj => style settings
     88    private variable _obj2ovride   ;# maps dataobj => style override
     89    private variable _obj2id       ;# maps dataobj => heightmap ID in server
     90    private variable _id2obj       ;# maps heightmap ID => dataobj in server
     91    private variable _sendobjs ""  ;# list of data objs to send to server
     92    private variable _receiveIds   ;# list of data responses from the server
     93    private variable _click        ;# info used for Rotate operations
     94    private variable _limits       ;# autoscale min/max for all axes
     95    private variable _view         ;# view params for 3D view
     96    private common _settings       ;# Array of used for global variables
     97                                    # for checkbuttons and radiobuttons.
     98    private common _hardcopy
     99    private variable _buffering 0
    99100}
    100101
     
    111112    $_dispatcher register !legend
    112113    $_dispatcher dispatch $this !legend \
    113         "[itcl::code $this _fixSettings legend]; list"
     114        "[itcl::code $this FixSettings legend]; list"
    114115    # Send dataobjs event
    115116    $_dispatcher register !send_dataobjs
    116117    $_dispatcher dispatch $this !send_dataobjs \
    117         "[itcl::code $this _send_dataobjs]; list"
     118        "[itcl::code $this SendDataObjs]; list"
    118119    # Rebuild event
    119120    $_dispatcher register !rebuild
    120     $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
    121 
    122     set outbuf_ ""
     121    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
     122
     123    set _outbuf ""
    123124
    124125    #
     
    126127    #
    127128    $_parser alias image [itcl::code $this ReceiveImage]
    128     $_parser alias legend [itcl::code $this _ReceiveLegend]
     129    $_parser alias legend [itcl::code $this ReceiveLegend]
    129130
    130131    # Initialize the view to some default parameters.
    131     array set view_ {
     132    array set _view {
    132133        theta   45
    133134        phi     45
     
    137138        pan-y   0
    138139    }
    139     set obj2id_(count) 0
     140    set _obj2id(count) 0
    140141
    141142    set f [$itk_component(main) component controls]
     
    149150            -highlightthickness 0 \
    150151            -image [Rappture::icon reset-view] \
    151             -command [itcl::code $this _zoom reset]
     152            -command [itcl::code $this Zoom reset]
    152153    } {
    153154        usual
     
    161162            -highlightthickness 0 \
    162163            -image [Rappture::icon zoom-in] \
    163             -command [itcl::code $this _zoom in]
     164            -command [itcl::code $this Zoom in]
    164165    } {
    165166        usual
     
    173174            -highlightthickness 0 \
    174175            -image [Rappture::icon zoom-out] \
    175             -command [itcl::code $this _zoom out]
     176            -command [itcl::code $this Zoom out]
    176177    } {
    177178        usual
     
    181182    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
    182183
    183     _BuildViewTab
    184     _BuildCameraTab
     184    BuildViewTab
     185    BuildCameraTab
    185186
    186187    # Legend
     
    203204    # Bindings for rotation via mouse
    204205    bind $itk_component(3dview) <ButtonPress-1> \
    205         [itcl::code $this _rotate click %x %y]
     206        [itcl::code $this Rotate click %x %y]
    206207    bind $itk_component(3dview) <B1-Motion> \
    207         [itcl::code $this _rotate drag %x %y]
     208        [itcl::code $this Rotate drag %x %y]
    208209    bind $itk_component(3dview) <ButtonRelease-1> \
    209         [itcl::code $this _rotate release %x %y]
     210        [itcl::code $this Rotate release %x %y]
    210211    bind $itk_component(3dview) <Configure> \
    211212        [itcl::code $this Resize %w %h]
     
    213214    # Bindings for panning via mouse
    214215    bind $itk_component(3dview) <ButtonPress-2> \
    215         [itcl::code $this _pan click %x %y]
     216        [itcl::code $this Pan click %x %y]
    216217    bind $itk_component(3dview) <B2-Motion> \
    217         [itcl::code $this _pan drag %x %y]
     218        [itcl::code $this Pan drag %x %y]
    218219    bind $itk_component(3dview) <ButtonRelease-2> \
    219         [itcl::code $this _pan release %x %y]
     220        [itcl::code $this Pan release %x %y]
    220221
    221222    # Bindings for panning via keyboard
    222223    bind $itk_component(3dview) <KeyPress-Left> \
    223         [itcl::code $this _pan set -10 0]
     224        [itcl::code $this Pan set -10 0]
    224225    bind $itk_component(3dview) <KeyPress-Right> \
    225         [itcl::code $this _pan set 10 0]
     226        [itcl::code $this Pan set 10 0]
    226227    bind $itk_component(3dview) <KeyPress-Up> \
    227         [itcl::code $this _pan set 0 -10]
     228        [itcl::code $this Pan set 0 -10]
    228229    bind $itk_component(3dview) <KeyPress-Down> \
    229         [itcl::code $this _pan set 0 10]
     230        [itcl::code $this Pan set 0 10]
    230231    bind $itk_component(3dview) <Shift-KeyPress-Left> \
    231         [itcl::code $this _pan set -2 0]
     232        [itcl::code $this Pan set -2 0]
    232233    bind $itk_component(3dview) <Shift-KeyPress-Right> \
    233         [itcl::code $this _pan set 2 0]
     234        [itcl::code $this Pan set 2 0]
    234235    bind $itk_component(3dview) <Shift-KeyPress-Up> \
    235         [itcl::code $this _pan set 0 -2]
     236        [itcl::code $this Pan set 0 -2]
    236237    bind $itk_component(3dview) <Shift-KeyPress-Down> \
    237         [itcl::code $this _pan set 0 2]
     238        [itcl::code $this Pan set 0 2]
    238239
    239240    # Bindings for zoom via keyboard
    240241    bind $itk_component(3dview) <KeyPress-Prior> \
    241         [itcl::code $this _zoom out]
     242        [itcl::code $this Zoom out]
    242243    bind $itk_component(3dview) <KeyPress-Next> \
    243         [itcl::code $this _zoom in]
     244        [itcl::code $this Zoom in]
    244245
    245246    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
     
    247248    if {[string equal "x11" [tk windowingsystem]]} {
    248249        # Bindings for zoom via mouse
    249         bind $itk_component(3dview) <4> [itcl::code $this _zoom out]
    250         bind $itk_component(3dview) <5> [itcl::code $this _zoom in]
     250        bind $itk_component(3dview) <4> [itcl::code $this Zoom out]
     251        bind $itk_component(3dview) <5> [itcl::code $this Zoom in]
    251252    }
    252253
     
    260261# ----------------------------------------------------------------------
    261262itcl::body Rappture::HeightmapViewer::destructor {} {
    262     set sendobjs_ ""  ;# stop any send in progress
     263    set _sendobjs ""  ;# stop any send in progress
    263264    $_dispatcher cancel !rebuild
    264265    $_dispatcher cancel !send_dataobjs
     
    297298    set location [$dataobj hints camera]
    298299    if { $location != "" } {
    299         array set view_ $location
    300     }
    301     set pos [lsearch -exact $dataobj $dlist_]
     300        array set _view $location
     301    }
     302    set pos [lsearch -exact $dataobj $_dlist]
    302303    if {$pos < 0} {
    303         lappend dlist_ $dataobj
    304         set obj2ovride_($dataobj-color) $params(-color)
    305         set obj2ovride_($dataobj-width) $params(-width)
    306         set obj2ovride_($dataobj-raise) $params(-raise)
     304        lappend _dlist $dataobj
     305        set _obj2ovride($dataobj-color) $params(-color)
     306        set _obj2ovride($dataobj-width) $params(-width)
     307        set _obj2ovride($dataobj-raise) $params(-raise)
    307308        $_dispatcher event -idle !rebuild
    308309    }
     
    326327      -objects {
    327328        # put the dataobj list in order according to -raise options
    328         set dlist $dlist_
     329        set dlist $_dlist
    329330        foreach obj $dlist {
    330             if { [info exists obj2ovride_($obj-raise)] &&
    331                  $obj2ovride_($obj-raise)} {
     331            if { [info exists _obj2ovride($obj-raise)] &&
     332                 $_obj2ovride($obj-raise)} {
    332333                set i [lsearch -exact $dlist $obj]
    333334                if {$i >= 0} {
     
    369370itcl::body Rappture::HeightmapViewer::delete { args } {
    370371    if {[llength $args] == 0} {
    371         set args $dlist_
     372        set args $_dlist
    372373    }
    373374
     
    375376    set changed 0
    376377    foreach dataobj $args {
    377         set pos [lsearch -exact $dlist_ $dataobj]
     378        set pos [lsearch -exact $_dlist $dataobj]
    378379        if {$pos >= 0} {
    379             set dlist_ [lreplace $dlist_ $pos $pos]
    380             foreach key [array names obj2ovride_ $dataobj-*] {
    381                 unset obj2ovride_($key)
     380            set _dlist [lreplace $_dlist $pos $pos]
     381            foreach key [array names _obj2ovride $dataobj-*] {
     382                unset _obj2ovride($key)
    382383            }
    383384            set changed 1
     
    402403itcl::body Rappture::HeightmapViewer::scale { args } {
    403404    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
    404         set limits_($val) ""
     405        set _limits($val) ""
    405406    }
    406407    foreach obj $args {
     
    408409            foreach {min max} [$obj limits $axis] break
    409410            if {"" != $min && "" != $max} {
    410                 if {"" == $limits_(${axis}min)} {
    411                     set limits_(${axis}min) $min
    412                     set limits_(${axis}max) $max
     411                if {"" == $_limits(${axis}min)} {
     412                    set _limits(${axis}min) $min
     413                    set _limits(${axis}max) $max
    413414                } else {
    414                     if {$min < $limits_(${axis}min)} {
    415                         set limits_(${axis}min) $min
     415                    if {$min < $_limits(${axis}min)} {
     416                        set _limits(${axis}min) $min
    416417                    }
    417                     if {$max > $limits_(${axis}max)} {
    418                         set limits_(${axis}max) $max
     418                    if {$max > $_limits(${axis}max)} {
     419                        set _limits(${axis}max) $max
    419420                    }
    420421                }
    421                 set limits_(${axis}range) [expr {$max - $min}]
     422                set _limits(${axis}range) [expr {$max - $min}]
    422423            }
    423424        }
     
    490491    VisViewer::Disconnect
    491492
    492     set outbuf_ ""
     493    set _outbuf ""
    493494    # disconnected -- no more data sitting on server
    494     catch {unset obj2id_}
    495     array unset id2obj_
    496     set obj2id_(count) 0
    497     set id2obj_(cound) 0
    498     set sendobjs_ ""
    499 }
    500 
    501 #
    502 # _send
     495    catch {unset _obj2id}
     496    array unset _id2obj
     497    set _obj2id(count) 0
     498    set _id2obj(cound) 0
     499    set _sendobjs ""
     500}
     501
     502#
     503# SendCmd
    503504#
    504505#       Send commands off to the rendering server.  If we're currently
     
    506507#       sent later.
    507508#
    508 itcl::body Rappture::HeightmapViewer::_send {string} {
    509     if {[llength $sendobjs_] > 0} {
    510         append outbuf_ $string "\n"
     509itcl::body Rappture::NanovisViewer::SendCmd {string} {
     510    if { $_buffering } {
     511        append _outbuf $string "\n"
    511512    } else {
    512         if {[SendBytes $string]} {
    513             foreach line [split $string \n] {
    514                 SendEcho >>line $line
    515             }
    516         }
    517     }
    518 }
    519 
    520 # ----------------------------------------------------------------------
    521 # USAGE: _send_dataobjs
     513        foreach line [split $string \n] {
     514            SendEcho >>line $line
     515        }
     516        SendBytes "$string\n"
     517    }
     518}
     519
     520# ----------------------------------------------------------------------
     521# USAGE: SendDataObjs
    522522#
    523523# Used internally to send a series of volume objects off to the
     
    525525# between so the interface doesn't lock up.
    526526# ----------------------------------------------------------------------
    527 itcl::body Rappture::HeightmapViewer::_send_dataobjs {} {
     527itcl::body Rappture::HeightmapViewer::SendDataObjs {} {
    528528    blt::busy hold $itk_component(hull); update idletasks
    529529
    530530    # Reset the overall limits
    531     if { $sendobjs_ != "" } {
    532         set limits_(vmin) ""
    533         set limits_(vmax) ""
    534     }
    535     foreach dataobj $sendobjs_ {
     531    if { $_sendobjs != "" } {
     532        set _limits(vmin) ""
     533        set _limits(vmax) ""
     534    }
     535    foreach dataobj $_sendobjs {
    536536        foreach comp [$dataobj components] {
    537537            set data [$dataobj blob $comp]
    538538
    539539            foreach { vmin vmax }  [$dataobj limits v] break
    540             if { $limits_(vmin) == "" || $vmin < $limits_(vmin) } {
    541                 set limits_(vmin) $vmin
    542             }
    543             if { $limits_(vmax) == "" || $vmax > $limits_(vmax) } {
    544                 set limits_(vmax) $vmax
     540            if { $_limits(vmin) == "" || $vmin < $_limits(vmin) } {
     541                set _limits(vmin) $vmin
     542            }
     543            if { $_limits(vmax) == "" || $vmax > $_limits(vmax) } {
     544                set _limits(vmax) $vmax
    545545            }
    546546
    547547            # tell the engine to expect some data
    548548            set nbytes [string length $data]
    549             if { ![SendBytes "heightmap data follows $nbytes"] } {
     549            if { ![SendBytes "heightmap data follows $nbytes\n"] } {
    550550                return
    551551
     
    554554                return
    555555            }
    556             set id $obj2id_(count)
    557             incr obj2id_(count)
    558             set id2obj_($id) [list $dataobj $comp]
    559             set obj2id_($dataobj-$comp) $id
    560             set receiveIds_($id) 1
     556            set id $_obj2id(count)
     557            incr _obj2id(count)
     558            set _id2obj($id) [list $dataobj $comp]
     559            set _obj2id($dataobj-$comp) $id
     560            set _receiveIds($id) 1
    561561
    562562            #
     
    564564            # and make sure that it's defined on the server.
    565565            #
    566             foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
    567             set cmdstr [list "transfunc" "define" $sname $cmap $wmap]
    568             if {![SendBytes $cmdstr]} {
    569                 return
    570             }
    571             set obj2style_($dataobj-$comp) $sname
    572         }
    573     }
    574     set sendobjs_ ""
     566            foreach {sname cmap wmap} [GetTransfuncData $dataobj $comp] break
     567            SendCmd [list "transfunc" "define" $sname $cmap $wmap]
     568            set _obj2style($dataobj-$comp) $sname
     569        }
     570    }
     571    set _sendobjs ""
    575572    blt::busy release $itk_component(hull)
     573
     574    # Turn on buffering of commands to the server.  We don't want to
     575    # be preempted by a server disconnect/reconnect (which automatically
     576    # generates a new call to Rebuild).   
     577    set _buffering 1
    576578
    577579    # activate the proper volume
     
    580582        set axis [$first hints updir]
    581583        if {"" != $axis} {
    582             _send "up $axis"
    583         }
    584     }
    585 
    586     foreach key [array names obj2id_ *-*] {
     584            SendCmd "up $axis"
     585        }
     586    }
     587
     588    foreach key [array names _obj2id *-*] {
    587589        set state [string match $first-* $key]
    588         _send "heightmap data visible $state $obj2id_($key)"
    589         if {[info exists obj2style_($key)]} {
    590             _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
    591         }
    592     }
    593 
    594     # if there are any commands in the buffer, send them now that we're done
    595     SendBytes $outbuf_
    596     set outbuf_ ""
    597 
     590        SendCmd "heightmap data visible $state $_obj2id($key)"
     591        if {[info exists _obj2style($key)]} {
     592            SendCmd "heightmap transfunc $_obj2style($key) $_obj2id($key)"
     593        }
     594    }
     595
     596    # Actually write the commands to the server socket.  If it fails, we don't
     597    # care.  We're finished here.
     598    SendBytes $_outbuf;                 
     599    set _buffering 0;                   # Turn off buffering.
     600    set _outbuf "";                     # Clear the buffer.             
    598601    $_dispatcher event -idle !legend
    599602}
     
    621624    } elseif { $info(type) == "print" } {
    622625        set tag $this-print-$info(-token)
    623         set hardcopy_($tag) $bytes
    624     }
    625 }
    626 
    627 # ----------------------------------------------------------------------
    628 # USAGE: _ReceiveLegend <tf> <vmin> <vmax> <size>
     626        set _hardcopy($tag) $bytes
     627    }
     628}
     629
     630# ----------------------------------------------------------------------
     631# USAGE: ReceiveLegend <tf> <vmin> <vmax> <size>
    629632#
    630633# Invoked automatically whenever the "legend" command comes in from
     
    632635# specified <size> will follow.
    633636# ----------------------------------------------------------------------
    634 itcl::body Rappture::HeightmapViewer::_ReceiveLegend {tf vmin vmax size} {
     637itcl::body Rappture::HeightmapViewer::ReceiveLegend {tf vmin vmax size} {
    635638    if { [IsConnected] } {
    636639        set bytes [ReceiveBytes $size]
     
    664667
    665668# ----------------------------------------------------------------------
    666 # USAGE: _rebuild
     669# USAGE: Rebuild
    667670#
    668671# Called automatically whenever something changes that affects the
     
    670673# widget to display new data.
    671674# ----------------------------------------------------------------------
    672 itcl::body Rappture::HeightmapViewer::_rebuild {} {
     675itcl::body Rappture::HeightmapViewer::Rebuild {} {
    673676    # in the midst of sending data? then bail out
    674     if {[llength $sendobjs_] > 0} {
     677    if {[llength $_sendobjs] > 0} {
    675678        return
    676679    }
     680    # Turn on buffering of commands to the server.  We don't want to
     681    # be preempted by a server disconnect/reconnect (which automatically
     682    # generates a new call to Rebuild).   
     683    set _buffering 1
     684
    677685    # Find any new data that needs to be sent to the server.  Queue this up on
    678     # the sendobjs_ list, and send it out a little at a time.  Do this first,
     686    # the _sendobjs list, and send it out a little at a time.  Do this first,
    679687    # before we rebuild the rest.
    680688    foreach dataobj [get] {
    681689        set comp [lindex [$dataobj components] 0]
    682         if {![info exists obj2id_($dataobj-$comp)]} {
    683             set i [lsearch -exact $sendobjs_ $dataobj]
     690        if {![info exists _obj2id($dataobj-$comp)]} {
     691            set i [lsearch -exact $_sendobjs $dataobj]
    684692            if {$i < 0} {
    685                 lappend sendobjs_ $dataobj
    686             }
    687         }
    688     }
    689     if {[llength $sendobjs_] > 0} {
     693                lappend _sendobjs $dataobj
     694            }
     695        }
     696    }
     697    if {[llength $_sendobjs] > 0} {
    690698        # Send off new data objects
    691699        $_dispatcher event -idle !send_dataobjs
     
    696704            set axis [$first hints updir]
    697705            if {"" != $axis} {
    698                 _send "up $axis"
    699             }
    700         }
    701         foreach key [array names obj2id_ *-*] {
     706                SendCmd "up $axis"
     707            }
     708        }
     709        foreach key [array names _obj2id *-*] {
    702710            set state [string match $first-* $key]
    703             _send "heightmap data visible $state $obj2id_($key)"
    704             if {[info exists obj2style_($key)]} {
    705                 _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
     711            SendCmd "heightmap data visible $state $_obj2id($key)"
     712            if {[info exists _obj2style($key)]} {
     713                SendCmd "heightmap transfunc $_obj2style($key) $_obj2id($key)"
    706714            }
    707715        }
     
    715723
    716724    # Reset the camera and other view parameters
    717     set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
    718     _send "camera angle $xyz"
    719     _PanCamera
    720     _send "camera zoom $view_(zoom)"
     725    set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
     726    SendCmd "camera angle $xyz"
     727    PanCamera
     728    SendCmd "camera zoom $_view(zoom)"
    721729
    722730     if {"" == $itk_option(-plotoutline)} {
    723          _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
     731         SendCmd "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
    724732     }
    725     set settings_($this-theta) $view_(theta)
    726     set settings_($this-phi) $view_(phi)
    727     set settings_($this-psi) $view_(psi)
    728     set settings_($this-pan-x) $view_(pan-x)
    729     set settings_($this-pan-y) $view_(pan-y)
    730     set settings_($this-zoom) $view_(zoom)
    731 
    732     _fixSettings wireframe
    733     _fixSettings grid
    734     _fixSettings axes
    735     _fixSettings contourlines
    736 }
    737 
    738 # ----------------------------------------------------------------------
    739 # USAGE: _zoom in
    740 # USAGE: _zoom out
    741 # USAGE: _zoom reset
     733    set _settings($this-theta) $_view(theta)
     734    set _settings($this-phi) $_view(phi)
     735    set _settings($this-psi) $_view(psi)
     736    set _settings($this-pan-x) $_view(pan-x)
     737    set _settings($this-pan-y) $_view(pan-y)
     738    set _settings($this-zoom) $_view(zoom)
     739
     740    FixSettings wireframe
     741    FixSettings grid
     742    FixSettings axes
     743    FixSettings contourlines
     744
     745    # Actually write the commands to the server socket.  If it fails, we don't
     746    # care.  We're finished here.
     747    SendBytes $_outbuf;                 
     748    set _buffering 0;                   # Turn off buffering.
     749    set _outbuf "";                     # Clear the buffer.             
     750}
     751
     752# ----------------------------------------------------------------------
     753# USAGE: Zoom in
     754# USAGE: Zoom out
     755# USAGE: Zoom reset
    742756#
    743757# Called automatically when the user clicks on one of the zoom
    744758# controls for this widget.  Changes the zoom for the current view.
    745759# ----------------------------------------------------------------------
    746 itcl::body Rappture::HeightmapViewer::_zoom {option} {
     760itcl::body Rappture::HeightmapViewer::Zoom {option} {
    747761    switch -- $option {
    748762        "in" {
    749             set view_(zoom) [expr {$view_(zoom)*1.25}]
    750             set settings_($this-zoom) $view_(zoom)
     763            set _view(zoom) [expr {$_view(zoom)*1.25}]
     764            set _settings($this-zoom) $_view(zoom)
    751765        }
    752766        "out" {
    753             set view_(zoom) [expr {$view_(zoom)*0.8}]
    754             set settings_($this-zoom) $view_(zoom)
     767            set _view(zoom) [expr {$_view(zoom)*0.8}]
     768            set _settings($this-zoom) $_view(zoom)
    755769        }
    756770        "reset" {
    757             array set view_ {
     771            array set _view {
    758772                theta   45
    759773                phi     45
     
    767781                set location [$first hints camera]
    768782                if { $location != "" } {
    769                     array set view_ $location
     783                    array set _view $location
    770784                }
    771785            }
    772             set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
    773             _send "camera angle $xyz"
    774             _PanCamera
    775             set settings_($this-theta) $view_(theta)
    776             set settings_($this-phi) $view_(phi)
    777             set settings_($this-psi) $view_(psi)
    778             set settings_($this-pan-x) $view_(pan-x)
    779             set settings_($this-pan-y) $view_(pan-y)
    780             set settings_($this-zoom) $view_(zoom)
    781         }
    782     }
    783     _send "camera zoom $view_(zoom)"
    784 }
    785 
    786 # ----------------------------------------------------------------------
    787 # USAGE: $this _pan click x y
    788 #        $this _pan drag x y
    789 #        $this _pan release x y
     786            set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
     787            SendCmd "camera angle $xyz"
     788            PanCamera
     789            set _settings($this-theta) $_view(theta)
     790            set _settings($this-phi) $_view(phi)
     791            set _settings($this-psi) $_view(psi)
     792            set _settings($this-pan-x) $_view(pan-x)
     793            set _settings($this-pan-y) $_view(pan-y)
     794            set _settings($this-zoom) $_view(zoom)
     795        }
     796    }
     797    SendCmd "camera zoom $_view(zoom)"
     798}
     799
     800# ----------------------------------------------------------------------
     801# USAGE: $this Pan click x y
     802#        $this Pan drag x y
     803#        $this Pan release x y
    790804#
    791805# Called automatically when the user clicks on one of the zoom
    792806# controls for this widget.  Changes the zoom for the current view.
    793807# ----------------------------------------------------------------------
    794 itcl::body Rappture::HeightmapViewer::_pan {option x y} {
     808itcl::body Rappture::HeightmapViewer::Pan {option x y} {
    795809    # Experimental stuff
    796810    set w [winfo width $itk_component(3dview)]
    797811    set h [winfo height $itk_component(3dview)]
    798812    if { $option == "set" } {
    799         set x [expr ($x / double($w)) * $limits_(xrange)]
    800         set y [expr ($y / double($h)) * $limits_(yrange)]
    801         set view_(pan-x) [expr $view_(pan-x) + $x]
    802         set view_(pan-y) [expr $view_(pan-y) + $y]
    803         _PanCamera
    804         set settings_($this-pan-x) $view_(pan-x)
    805         set settings_($this-pan-y) $view_(pan-y)
     813        set x [expr ($x / double($w)) * $_limits(xrange)]
     814        set y [expr ($y / double($h)) * $_limits(yrange)]
     815        set _view(pan-x) [expr $_view(pan-x) + $x]
     816        set _view(pan-y) [expr $_view(pan-y) + $y]
     817        PanCamera
     818        set _settings($this-pan-x) $_view(pan-x)
     819        set _settings($this-pan-y) $_view(pan-y)
    806820        return
    807821    }
    808822    if { $option == "click" } {
    809         set click_(x) $x
    810         set click_(y) $y
     823        set _click(x) $x
     824        set _click(y) $y
    811825        $itk_component(3dview) configure -cursor hand1
    812826    }
    813827    if { $option == "drag" || $option == "release" } {
    814         set dx [expr (($click_(x) - $x)/double($w)) * $limits_(xrange)]
    815         set dy [expr (($click_(y) - $y)/double($h)) * $limits_(yrange)]
    816         set click_(x) $x
    817         set click_(y) $y
    818         set view_(pan-x) [expr $view_(pan-x) - $dx]
    819         set view_(pan-y) [expr $view_(pan-y) - $dy]
    820         _PanCamera
    821         set settings_($this-pan-x) $view_(pan-x)
    822         set settings_($this-pan-y) $view_(pan-y)
     828        set dx [expr (($_click(x) - $x)/double($w)) * $_limits(xrange)]
     829        set dy [expr (($_click(y) - $y)/double($h)) * $_limits(yrange)]
     830        set _click(x) $x
     831        set _click(y) $y
     832        set _view(pan-x) [expr $_view(pan-x) - $dx]
     833        set _view(pan-y) [expr $_view(pan-y) - $dy]
     834        PanCamera
     835        set _settings($this-pan-x) $_view(pan-x)
     836        set _settings($this-pan-y) $_view(pan-y)
    823837    }
    824838    if { $option == "release" } {
     
    827841}
    828842
    829 itcl::body Rappture::HeightmapViewer::_PanCamera {} {
    830     set x [expr ($view_(pan-x)) / $limits_(xrange)]
    831     set y [expr ($view_(pan-y)) / $limits_(yrange)]
    832     _send "camera pan $x $y"
    833 }
    834 
    835 # ----------------------------------------------------------------------
    836 # USAGE: _rotate click <x> <y>
    837 # USAGE: _rotate drag <x> <y>
    838 # USAGE: _rotate release <x> <y>
     843itcl::body Rappture::HeightmapViewer::PanCamera {} {
     844    set x [expr ($_view(pan-x)) / $_limits(xrange)]
     845    set y [expr ($_view(pan-y)) / $_limits(yrange)]
     846    SendCmd "camera pan $x $y"
     847}
     848
     849# ----------------------------------------------------------------------
     850# USAGE: Rotate click <x> <y>
     851# USAGE: Rotate drag <x> <y>
     852# USAGE: Rotate release <x> <y>
    839853#
    840854# Called automatically when the user clicks/drags/releases in the
    841855# plot area.  Moves the plot according to the user's actions.
    842856# ----------------------------------------------------------------------
    843 itcl::body Rappture::HeightmapViewer::_rotate {option x y} {
     857itcl::body Rappture::HeightmapViewer::Rotate {option x y} {
    844858    switch -- $option {
    845859        click {
    846860            $itk_component(3dview) configure -cursor fleur
    847             array set click_ [subst {
     861            array set _click [subst {
    848862                x       $x
    849863                y       $y
    850                 theta   $view_(theta)
    851                 phi     $view_(phi)
     864                theta   $_view(theta)
     865                phi     $_view(phi)
    852866            }]
    853867        }
    854868        drag {
    855             if {[array size click_] == 0} {
    856                 _rotate click $x $y
     869            if {[array size _click] == 0} {
     870                Rotate click $x $y
    857871            } else {
    858872                set w [winfo width $itk_component(3dview)]
     
    864878                if {[catch {
    865879                    # this fails sometimes for no apparent reason
    866                     set dx [expr {double($x-$click_(x))/$w}]
    867                     set dy [expr {double($y-$click_(y))/$h}]
     880                    set dx [expr {double($x-$_click(x))/$w}]
     881                    set dy [expr {double($y-$_click(y))/$h}]
    868882                }] != 0 } {
    869883                    return
     
    873887                # Rotate the camera in 3D
    874888                #
    875                 if {$view_(psi) > 90 || $view_(psi) < -90} {
     889                if {$_view(psi) > 90 || $_view(psi) < -90} {
    876890                    # when psi is flipped around, theta moves backwards
    877891                    set dy [expr {-$dy}]
    878892                }
    879                 set theta [expr {$view_(theta) - $dy*180}]
     893                set theta [expr {$_view(theta) - $dy*180}]
    880894                while {$theta < 0} { set theta [expr {$theta+180}] }
    881895                while {$theta > 180} { set theta [expr {$theta-180}] }
    882896
    883897                if {abs($theta) >= 30 && abs($theta) <= 160} {
    884                     set phi [expr {$view_(phi) - $dx*360}]
     898                    set phi [expr {$_view(phi) - $dx*360}]
    885899                    while {$phi < 0} { set phi [expr {$phi+360}] }
    886900                    while {$phi > 360} { set phi [expr {$phi-360}] }
    887                     set psi $view_(psi)
     901                    set psi $_view(psi)
    888902                } else {
    889                     set phi $view_(phi)
    890                     set psi [expr {$view_(psi) - $dx*360}]
     903                    set phi $_view(phi)
     904                    set psi [expr {$_view(psi) - $dx*360}]
    891905                    while {$psi < -180} { set psi [expr {$psi+360}] }
    892906                    while {$psi > 180} { set psi [expr {$psi-360}] }
    893907                }
    894908
    895                 set view_(theta)        $theta
    896                 set view_(phi)          $phi
    897                 set view_(psi)          $psi
    898                 set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
    899                 set settings_($this-theta) $view_(theta)
    900                 set settings_($this-phi) $view_(phi)
    901                 set settings_($this-psi) $view_(psi)
    902                 _send "camera angle $xyz"
    903                 set click_(x) $x
    904                 set click_(y) $y
     909                set _view(theta)        $theta
     910                set _view(phi)          $phi
     911                set _view(psi)          $psi
     912                set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
     913                set _settings($this-theta) $_view(theta)
     914                set _settings($this-phi) $_view(phi)
     915                set _settings($this-psi) $_view(psi)
     916                SendCmd "camera angle $xyz"
     917                set _click(x) $x
     918                set _click(y) $y
    905919            }
    906920        }
    907921        release {
    908             _rotate drag $x $y
     922            Rotate drag $x $y
    909923            $itk_component(3dview) configure -cursor ""
    910             catch {unset click_}
     924            catch {unset _click}
    911925        }
    912926        default {
     
    917931
    918932# ----------------------------------------------------------------------
    919 # USAGE: _state <component>
     933# USAGE: State <component>
    920934#
    921935# Used internally to determine the state of a toggle button.
     
    923937# Returns on/off for the state of the button.
    924938# ----------------------------------------------------------------------
    925 itcl::body Rappture::HeightmapViewer::_state {comp} {
     939itcl::body Rappture::HeightmapViewer::State {comp} {
    926940    if {[$itk_component($comp) cget -relief] == "sunken"} {
    927941        return "on"
     
    931945
    932946# ----------------------------------------------------------------------
    933 # USAGE: _fixSettings <what> ?<value>?
     947# USAGE: FixSettings <what> ?<value>?
    934948#
    935949# Used internally to update rendering settings whenever parameters
     
    937951# to the back end.
    938952# ----------------------------------------------------------------------
    939 itcl::body Rappture::HeightmapViewer::_fixSettings { what {value ""} } {
     953itcl::body Rappture::HeightmapViewer::FixSettings { what {value ""} } {
    940954    switch -- $what {
    941955        "legend" {
    942             if { $settings_($this-legend) } {
     956            if { $_settings($this-legend) } {
    943957                pack $itk_component(legend) -side left -fill y
    944958            } else {
     
    952966            if {"" != $dataobj} {
    953967                set comp [lindex [$dataobj components] 0]
    954                 if {[info exists obj2id_($dataobj-$comp)]} {
    955                     set imap $obj2id_($dataobj-$comp)
     968                if {[info exists _obj2id($dataobj-$comp)]} {
     969                    set imap $_obj2id($dataobj-$comp)
    956970                }
    957971            }
    958972            if {$w > 0 && $h > 0 && "" != $imap} {
    959                 _send "heightmap legend $imap $w $h"
     973                SendCmd "heightmap legend $imap $w $h"
    960974            } else {
    961975                $itk_component(legend) delete all
     
    964978        "grid" {
    965979            if { [IsConnected] } {
    966                 _send "grid visible $settings_($this-grid)"
     980                SendCmd "grid visible $_settings($this-grid)"
    967981            }
    968982        }
    969983        "axes" {
    970984            if { [IsConnected] } {
    971                 _send "axis visible $settings_($this-axes)"
     985                SendCmd "axis visible $_settings($this-axes)"
    972986            }
    973987        }
    974988        "wireframe" {
    975989            if { [IsConnected] } {
    976                 _send "heightmap polygon $settings_($this-wireframe)"
     990                SendCmd "heightmap polygon $_settings($this-wireframe)"
    977991            }
    978992        }
     
    982996                if {"" != $dataobj} {
    983997                    set comp [lindex [$dataobj components] 0]
    984                     if {[info exists obj2id_($dataobj-$comp)]} {
    985                         set i $obj2id_($dataobj-$comp)
    986                         set bool $settings_($this-contourlines)
    987                         _send "heightmap linecontour visible $bool $i"
     998                    if {[info exists _obj2id($dataobj-$comp)]} {
     999                        set i $_obj2id($dataobj-$comp)
     1000                        set bool $_settings($this-contourlines)
     1001                        SendCmd "heightmap linecontour visible $bool $i"
    9881002                    }
    9891003                }
     
    9971011
    9981012# ----------------------------------------------------------------------
    999 # USAGE: _getTransfuncData <dataobj> <comp>
     1013# USAGE: GetTransfuncData <dataobj> <comp>
    10001014#
    10011015# Used internally to compute the colormap and alpha map used to define
     
    10031017# Returns: name {v r g b ...} {v w ...}
    10041018# ----------------------------------------------------------------------
    1005 itcl::body Rappture::HeightmapViewer::_getTransfuncData {dataobj comp} {
     1019itcl::body Rappture::HeightmapViewer::GetTransfuncData {dataobj comp} {
    10061020    array set style {
    10071021        -color rainbow
     
    10181032    set color white
    10191033    set cmap "0.0 [Color2RGB $color] "
    1020     set range [expr $limits_(vmax) - $limits_(vmin)]
     1034    set range [expr $_limits(vmax) - $_limits(vmin)]
    10211035    for {set i 0} {$i < [llength $clist]} {incr i} {
    10221036        set xval [expr {double($i+1)/([llength $clist]+1)}]
     
    10601074    foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
    10611075    #fix this!
    1062     #_send "color background $r $g $b"
     1076    #SendCmd "color background $r $g $b"
    10631077}
    10641078
     
    10691083    foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
    10701084    #fix this!
    1071     #_send "color background $r $g $b"
     1085    #SendCmd "color background $r $g $b"
    10721086}
    10731087
     
    10771091itcl::configbody Rappture::HeightmapViewer::plotoutline {
    10781092    if {[IsConnected]} {
    1079         _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
     1093        SendCmd "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
    10801094    }
    10811095}
     
    10881102    switch -- $option {
    10891103        "show" {
    1090             puts [array get view_]
     1104            puts [array get _view]
    10911105        }
    10921106        "set" {
    10931107            set who [lindex $args 0]
    1094             set x $settings_($this-$who)
     1108            set x $_settings($this-$who)
    10951109            set code [catch { string is double $x } result]
    10961110            if { $code != 0 || !$result } {
    1097                 set settings_($this-$who) $view_($who)
     1111                set _settings($this-$who) $_view($who)
    10981112                return
    10991113            }
    11001114            switch -- $who {
    11011115                "pan-x" - "pan-y" {
    1102                     set view_($who) $settings_($this-$who)
    1103                     _PanCamera
     1116                    set _view($who) $_settings($this-$who)
     1117                    PanCamera
    11041118                }
    11051119                "phi" - "theta" - "psi" {
    1106                     set view_($who) $settings_($this-$who)
    1107                     set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
    1108                     _send "camera angle $xyz"
     1120                    set _view($who) $_settings($this-$who)
     1121                    set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
     1122                    SendCmd "camera angle $xyz"
    11091123                }
    11101124                "zoom" {
    1111                     set view_($who) $settings_($this-$who)
    1112                     _send "camera zoom $view_(zoom)"
     1125                    set _view($who) $_settings($this-$who)
     1126                    SendCmd "camera zoom $_view(zoom)"
    11131127                }
    11141128            }
     
    11171131}
    11181132
    1119 itcl::body Rappture::HeightmapViewer::_BuildViewTab {} {
     1133itcl::body Rappture::HeightmapViewer::BuildViewTab {} {
    11201134    set fg [option get $itk_component(hull) font Font]
    11211135
     
    11321146        legend          1
    11331147    } {
    1134         set settings_($this-$key) $value
     1148        set _settings($this-$key) $value
    11351149    }
    11361150
    11371151    checkbutton $inner.grid \
    11381152        -text "grid" \
    1139         -variable [itcl::scope settings_($this-grid)] \
    1140         -command [itcl::code $this _fixSettings grid] \
     1153        -variable [itcl::scope _settings($this-grid)] \
     1154        -command [itcl::code $this FixSettings grid] \
    11411155        -font "Arial 9"
    11421156    checkbutton $inner.axes \
    11431157        -text "axes" \
    1144         -variable ::Rappture::HeightmapViewer::settings_($this-axes) \
    1145         -command [itcl::code $this _fixSettings axes] \
     1158        -variable ::Rappture::HeightmapViewer::_settings($this-axes) \
     1159        -command [itcl::code $this FixSettings axes] \
    11461160        -font "Arial 9"
    11471161    checkbutton $inner.contourlines \
    11481162        -text "contour lines" \
    1149         -variable ::Rappture::HeightmapViewer::settings_($this-contourlines) \
    1150         -command [itcl::code $this _fixSettings contourlines]\
     1163        -variable ::Rappture::HeightmapViewer::_settings($this-contourlines) \
     1164        -command [itcl::code $this FixSettings contourlines]\
    11511165        -font "Arial 9"
    11521166    checkbutton $inner.wireframe \
    11531167        -text "wireframe" \
    11541168        -onvalue "wireframe" -offvalue "fill" \
    1155         -variable ::Rappture::HeightmapViewer::settings_($this-wireframe) \
    1156         -command [itcl::code $this _fixSettings wireframe]\
     1169        -variable ::Rappture::HeightmapViewer::_settings($this-wireframe) \
     1170        -command [itcl::code $this FixSettings wireframe]\
    11571171        -font "Arial 9"
    11581172    checkbutton $inner.legend \
    11591173        -text "legend" \
    1160         -variable ::Rappture::HeightmapViewer::settings_($this-legend) \
    1161         -command [itcl::code $this _fixSettings legend]\
     1174        -variable ::Rappture::HeightmapViewer::_settings($this-legend) \
     1175        -command [itcl::code $this FixSettings legend]\
    11621176        -font "Arial 9"
    11631177
     
    11771191}
    11781192
    1179 itcl::body Rappture::HeightmapViewer::_BuildCameraTab {} {
     1193itcl::body Rappture::HeightmapViewer::BuildCameraTab {} {
    11801194    set fg [option get $itk_component(hull) font Font]
    11811195
     
    11901204        label $inner.${tag}label -text $tag -font "Arial 9"
    11911205        entry $inner.${tag} -font "Arial 9" -bg white -width 10 \
    1192             -textvariable [itcl::scope settings_($this-$tag)]
     1206            -textvariable [itcl::scope _settings($this-$tag)]
    11931207        bind $inner.${tag} <KeyPress-Return> \
    11941208            [itcl::code $this camera set ${tag}]
     
    12061220itcl::body Rappture::HeightmapViewer::Resize { w h } {
    12071221    #puts stderr "w=$w h=$h"
    1208     _send "screen $w $h"
    1209 }
     1222    SendCmd "screen $w $h"
     1223}
Note: See TracChangeset for help on using the changeset viewer.