Ignore:
Timestamp:
Feb 26, 2008, 7:19:02 PM (16 years ago)
Author:
gah
Message:

VisViewer? base class

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/heightmapviewer.tcl

    r839 r909  
    1212#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    1313# ======================================================================
     14
    1415package require Itk
    1516package require BLT
    … …  
    2728    -*-helvetica-medium-r-normal-*-12-* widgetDefault
    2829
     30# must use this name -- plugs into Rappture::resources::load
     31proc HeightmapViewer_init_resources {} {
     32    Rappture::resources::register \
     33        nanovis_server [list Rappture::VisViewer::SetServerList "nanovis"]
     34}
     35
    2936itcl::class Rappture::HeightmapViewer {
    30     inherit itk::Widget
     37    inherit Rappture::VisViewer
    3138
    3239    itk_option define -plotforeground plotForeground Foreground ""
    3340    itk_option define -plotbackground plotBackground Background ""
    3441    itk_option define -plotoutline plotOutline PlotOutline ""
    35     itk_option define -sendcommand sendCommand SendCommand ""
    36     itk_option define -receivecommand receiveCommand ReceiveCommand ""
    37 
    38     constructor {hostlist args} { # defined below }
    39     destructor { # defined below }
    40 
     42
     43    constructor { hostlist args } {
     44        Rappture::VisViewer::constructor $hostlist
     45    } {
     46        # defined below
     47    }
     48    destructor {
     49        # defined below
     50    }
     51
     52    public method isconnected {}
    4153    public method add {dataobj {settings ""}}
    4254    public method get {args}
    … …  
    4456    public method scale {args}
    4557    public method download {option args}
    46     public method parameters {title args} { # do nothing }
    47 
    48     public method connect {{hostlist ""}}
    49     public method disconnect {}
    50     public method isconnected {}
    51 
    52     protected method _send {args}
    53     protected method _send_text {string}
     58    public method parameters {title args} {
     59        # do nothing
     60    }
     61    protected method Connect {}
     62    protected method Disconnect {}
     63
     64    protected method _send {string}
    5465    protected method _send_dataobjs {}
    55     protected method _send_echo {channel {data ""}}
    56     protected method _receive {}
    5766    protected method _receive_image {option size}
    5867    protected method _receive_legend {ivol vmin vmax size}
    5968    protected method _receive_echo {channel {data ""}}
     69    protected method _receive_data {args}
    6070
    6171    protected method _rebuild {}
    62     protected method _currentHeightMapIds {{what -all}}
    6372    protected method _zoom {option}
    6473    protected method _move {option x y}
    65     protected method _probe {option args}
    6674
    6775    protected method _state {comp}
    6876    protected method _fixSettings {what {value ""}}
    69     protected method _fixLegend {}
    70     protected method _fixGrid {}
    71     protected method _fixAxes {}
    72     protected method _fixContourLines {}
    73     protected method _serverDown {}
    7477    protected method _getTransfuncData {dataobj comp}
    75     protected method _color2rgb {color}
    76     protected method _euler2xyz {theta phi psi}
    77 
    78     private variable _dispatcher "" ;# dispatcher for !events
    79 
    80     private variable _nvhosts ""   ;# list of hosts for nanovis server
    81     private variable _sid ""       ;# socket connection to nanovis server
    82     private variable _parser ""    ;# interpreter for incoming commands
    83     private variable _buffer       ;# buffer for incoming/outgoing commands
    84     private variable _image        ;# image displayed in plotting area
     78
     79
     80    private variable _outbuf       ;# buffer for outgoing commands
    8581
    8682    private variable _dlist ""     ;# list of data objects
    … …  
    8884    private variable _obj2style    ;# maps dataobj => style settings
    8985    private variable _obj2ovride   ;# maps dataobj => style override
    90     private variable _obj2id       ;# maps dataobj => volume ID in server
     86    private variable _obj2id       ;# maps dataobj => heightmap ID in server
     87    private variable _id2obj       ;# maps heightmap ID => dataobj in server
    9188    private variable _sendobjs ""  ;# list of data objs to send to server
    92 
     89    private variable _receiveids   ;# list of data responses from the server
    9390    private variable _click        ;# info used for _move operations
    9491    private variable _limits       ;# autoscale min/max for all axes
    9592    private variable _view         ;# view params for 3D view
    9693
    97     private common _showGrid       ;# Array indicates whether grid is on
    98     private common _showAxes       ;# Array indicates whether axis is on
     94    private common _settings      ;# Array used for checkbuttons and radiobuttons
     95                       
    9996}
    10097
    … …  
    108105# ----------------------------------------------------------------------
    109106itcl::body Rappture::HeightmapViewer::constructor {hostlist args} {
    110     Rappture::dispatcher _dispatcher
     107    # Draw legend event
    111108    $_dispatcher register !legend
    112     $_dispatcher dispatch $this !legend "[itcl::code $this _fixLegend]; list"
    113     $_dispatcher register !serverDown
    114     $_dispatcher dispatch $this !serverDown "[itcl::code $this _serverDown]; list"
    115 
    116     set _buffer(in) ""
    117     set _buffer(out) ""
     109    $_dispatcher dispatch $this !legend \
     110        "[itcl::code $this _fixSettings legend]; list"
     111    # Send dataobjs event
     112    $_dispatcher register !send_dataobjs
     113    $_dispatcher dispatch $this !send_dataobjs \
     114        "[itcl::code $this _send_dataobjs]; list"
     115    # Rebuild event
     116    $_dispatcher register !rebuild
     117    $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
     118
     119    set _outbuf ""
    118120
    119121    #
    120     # Create a parser to handle incoming requests
     122    # Populate parser with commands handle incoming requests
    121123    #
    122     set _parser [interp create -safe]
    123     foreach cmd [$_parser eval {info commands}] {
    124         $_parser hide $cmd
    125     }
    126124    $_parser alias image [itcl::code $this _receive_image]
    127125    $_parser alias legend [itcl::code $this _receive_legend]
    128 
    129     #
    130     # Set up the widgets in the main body
    131     #
    132     option add hull.width hull.height
    133     pack propagate $itk_component(hull) no
     126    $_parser alias data [itcl::code $this _receive_data]
    134127
    135128    set _view(theta) 45
    … …  
    141134    set _view(zfocus) 0
    142135    set _obj2id(count) 0
    143 
    144     itk_component add controls {
    145         frame $itk_interior.cntls
    146     } {
    147         usual
    148         rename -background -controlbackground controlBackground Background
    149     }
    150     pack $itk_component(controls) -side right -fill y
    151136
    152137    itk_component add zoom {
    … …  
    221206    set fg [option get $itk_component(hull) font Font]
    222207   
    223     set ::Rappture::HeightmapViewer::_showGrid($this) 1
     208    set ::Rappture::HeightmapViewer::_settings($this-grid) 1
    224209    ::checkbutton $inner.f.grid \
    225210        -text "Show Grid" \
    226         -variable ::Rappture::HeightmapViewer::_showGrid($this) \
    227         -command [itcl::code $this _fixGrid]
     211        -variable ::Rappture::HeightmapViewer::_settings($this-grid) \
     212        -command [itcl::code $this _fixSettings grid]
    228213    grid $inner.f.grid -row 0 -column 0 -sticky w
    229214
    230     set ::Rappture::HeightmapViewer::_showAxes($this) 1
     215    set ::Rappture::HeightmapViewer::_settings($this-axes) 1
    231216    ::checkbutton $inner.f.axes \
    232217        -text "Show Axes" \
    233         -variable ::Rappture::HeightmapViewer::_showAxes($this) \
    234         -command [itcl::code $this _fixAxes]
     218        -variable ::Rappture::HeightmapViewer::_settings($this-axes) \
     219        -command [itcl::code $this _fixSettings axes]
    235220    grid $inner.f.axes -row 1 -column 0 -sticky w
    236221
    237     set ::Rappture::HeightmapViewer::_showContourLines($this) 1
     222    set ::Rappture::HeightmapViewer::_settings($this-contourlines) 1
    238223    ::checkbutton $inner.f.contour \
    239224        -text "Show Contour Lines" \
    240         -variable ::Rappture::HeightmapViewer::_showContourLines($this) \
    241         -command [itcl::code $this _fixContourLines]
     225        -variable ::Rappture::HeightmapViewer::_settings($this-contourlines) \
     226        -command [itcl::code $this _fixSettings contourlines]
    242227    grid $inner.f.contour -row 2 -column 0 -sticky w
    243228
    244     #
    245     # RENDERING AREA
    246     #
    247     itk_component add area {
    248         frame $itk_interior.area
    249     }
    250     pack $itk_component(area) -expand yes -fill both
    251 
     229
     230    # Legend
    252231    set _image(legend) [image create photo]
    253232    itk_component add legend {
    … …  
    261240    bind $itk_component(legend) <Configure> \
    262241        [list $_dispatcher event -idle !legend]
    263 
    264     set _image(plot) [image create photo]
    265     itk_component add 3dview {
    266         label $itk_component(area).vol -image $_image(plot) \
    267             -highlightthickness 0
    268     } {
    269         usual
    270         ignore -highlightthickness
    271         rename -background -plotbackground plotBackground Background
    272     }
    273     pack $itk_component(3dview) -expand yes -fill both
    274242
    275243    # set up bindings for rotation
    … …  
    281249        [itcl::code $this _move release %x %y]
    282250    bind $itk_component(3dview) <Configure> \
    283         [itcl::code $this _send screen %w %h]
     251        [itcl::code $this _send "screen %w %h"]
    284252
    285253    set _image(download) [image create photo]
    … …  
    287255    eval itk_initialize $args
    288256
    289     connect $hostlist
     257    Connect
    290258}
    291259
    … …  
    295263itcl::body Rappture::HeightmapViewer::destructor {} {
    296264    set _sendobjs ""  ;# stop any send in progress
    297     after cancel [itcl::code $this _send_dataobjs]
    298     after cancel [itcl::code $this _rebuild]
     265    $_dispatcher cancel !rebuild
     266    $_dispatcher cancel !send_dataobjs
    299267    image delete $_image(plot)
    300268    image delete $_image(legend)
    301269    image delete $_image(download)
    302     interp delete $_parser
    303270}
    304271
    … …  
    337304        set _obj2ovride($dataobj-width) $params(-width)
    338305        set _obj2ovride($dataobj-raise) $params(-raise)
    339 
    340         after cancel [itcl::code $this _rebuild]
    341         after idle [itcl::code $this _rebuild]
     306        $_dispatcher event -idle !rebuild
    342307    }
    343308}
    … …  
    421386    # if anything changed, then rebuild the plot
    422387    if {$changed} {
    423         after cancel [itcl::code $this _rebuild]
    424         after idle [itcl::code $this _rebuild]
     388        $_dispatcher event -idle !rebuild
    425389    }
    426390}
    … …  
    505469
    506470# ----------------------------------------------------------------------
    507 # USAGE: connect ?<host:port>,<host:port>...?
     471# USAGE: Connect ?<host:port>,<host:port>...?
    508472#
    509473# Clients use this method to establish a connection to a new
    … …  
    511475# Any existing connection is automatically closed.
    512476# ----------------------------------------------------------------------
    513 itcl::body Rappture::HeightmapViewer::connect {{hostlist ""}} {
    514     disconnect
    515 
    516     if {"" != $hostlist} { set _nvhosts $hostlist }
    517 
    518     if {"" == $_nvhosts} {
     477itcl::body Rappture::HeightmapViewer::Connect {} {
     478    Disconnect
     479    set _hosts [GetServerList "nanovis"]
     480    if { "" == $_hosts } {
    519481        return 0
    520482    }
    521 
    522     blt::busy hold $itk_component(hull); update idletasks
    523 
    524     # HACK ALERT! punt on this for now
    525     set memorySize 10000
    526 
    527     #
    528     # Connect to the nanovis server.  Send the server some estimate
    529     # of the size of our job.  If it's too busy, that server may
    530     # forward us to another.
    531     #
    532     set try [split $_nvhosts ,]
    533     foreach {hostname port} [split [lindex $try 0] :] break
    534     set try [lrange $try 1 end]
    535 
    536     while {1} {
    537         _send_echo <<line "connecting to $hostname:$port..."
    538         if {[catch {socket $hostname $port} sid]} {
    539             if {[llength $try] == 0} {
    540                 return 0
    541             }
    542             foreach {hostname port} [split [lindex $try 0] :] break
    543             set try [lrange $try 1 end]
    544             continue
    545         }
    546         fconfigure $sid -translation binary -encoding binary
    547 
    548         # send memory requirement to the load balancer
    549         puts -nonewline $sid [binary format I $memorySize]
    550         flush $sid
    551 
    552         # read back a reconnection order
    553         set data [read $sid 4]
    554         if {[binary scan $data cccc b1 b2 b3 b4] != 4} {
    555             error "couldn't read redirection request"
    556         }
    557         set addr [format "%u.%u.%u.%u" \
    558             [expr {$b1 & 0xff}] \
    559             [expr {$b2 & 0xff}] \
    560             [expr {$b3 & 0xff}] \
    561             [expr {$b4 & 0xff}]]
    562         _receive_echo <<line $addr
    563 
    564         if {[string equal $addr "0.0.0.0"]} {
    565             fconfigure $sid -buffering line
    566             fileevent $sid readable [itcl::code $this _receive]
    567             set _sid $sid
    568             blt::busy release $itk_component(hull)
    569             return 1
    570         }
    571         set hostname $addr
    572     }
    573     blt::busy release $itk_component(hull)
    574 
    575     return 0
    576 }
    577 
    578 # ----------------------------------------------------------------------
    579 # USAGE: disconnect
     483    set result [VisViewer::Connect $_hosts]
     484    return $result
     485}
     486
     487# ----------------------------------------------------------------------
     488# USAGE: Disconnect
    580489#
    581490# Clients use this method to disconnect from the current rendering
    582491# server.
    583492# ----------------------------------------------------------------------
    584 itcl::body Rappture::HeightmapViewer::disconnect {} {
    585     if {"" != $_sid} {
    586         catch {close $_sid}
    587         set _sid ""
    588     }
    589 
    590     set _buffer(in) ""
    591     set _buffer(out) ""
    592 
     493itcl::body Rappture::HeightmapViewer::Disconnect {} {
     494    VisViewer::Disconnect
     495
     496    set _outbuf ""
    593497    # disconnected -- no more data sitting on server
    594498    catch {unset _obj2id}
     499    array unset _id2obj
    595500    set _obj2id(count) 0
     501    set _id2obj(cound) 0
    596502    set _sendobjs ""
    597503}
    … …  
    604510# ----------------------------------------------------------------------
    605511itcl::body Rappture::HeightmapViewer::isconnected {} {
    606     return [expr {"" != $_sid}]
    607 }
    608 
    609 # ----------------------------------------------------------------------
    610 # USAGE: _send <arg> <arg> ...
     512    return [VisViewer::IsConnected]
     513}
     514
     515# ----------------------------------------------------------------------
     516# USAGE: _send <string>
    611517#
    612518# Used internally to send commands off to the rendering server.
    613 # This is a more convenient form of _send_text, which actually
    614 # does the sending.
    615 # ----------------------------------------------------------------------
    616 itcl::body Rappture::HeightmapViewer::_send {args} {
    617     _send_text $args
    618 }
    619 
    620 # ----------------------------------------------------------------------
    621 # USAGE: _send_text <string>
    622 #
    623 # Used internally to send commands off to the rendering server.
    624 # ----------------------------------------------------------------------
    625 itcl::body Rappture::HeightmapViewer::_send_text {string} {
    626     if {"" == $_sid} {
     519# ----------------------------------------------------------------------
     520itcl::body Rappture::HeightmapViewer::_send {string} {
     521    if { ![isconnected] } {
    627522        $_dispatcher cancel !serverDown
    628523        set x [expr {[winfo rootx $itk_component(area)]+10}]
    … …  
    630525        Rappture::Tooltip::cue @$x,$y "Connecting..."
    631526
    632         if {[catch {connect} ok] == 0 && $ok} {
     527        set code [catch { Connect } ok]
     528        if { $code == 0 && $ok} {
    633529            set w [winfo width $itk_component(3dview)]
    634530            set h [winfo height $itk_component(3dview)]
    635531
    636             if {[catch {puts $_sid "screen $w $h"}]} {
    637                 disconnect
    638                 _receive_echo closed
    639                 $_dispatcher event -after 750 !serverDown
    640             } else {
    641                 _send_echo >>line "screen $w $h"
    642 
     532            if { [Send "screen $w $h"] } {
    643533                set _view(theta) 45
    644534                set _view(phi) 45
    645535                set _view(psi) 0
    646536                set _view(zoom) 1.0
    647                 after idle [itcl::code $this _rebuild]
     537                $_dispatcher event -idle !rebuild
    648538                Rappture::Tooltip::cue hide
    649539            }
    650             return
    651         }
    652         Rappture::Tooltip::cue @$x,$y "Can't connect to visualization server.  This may be a network problem.  Wait a few moments and try resetting the view."
    653         return
    654     }
    655     if {"" != $_sid} {
     540        } else {
     541            Rappture::Tooltip::cue @$x,$y "Can't connect to visualization server.  This may be a network problem.  Wait a few moments and try resetting the view."
     542        }
     543    } else {
    656544        # if we're transmitting objects, then buffer this command
    657545        if {[llength $_sendobjs] > 0} {
    658             append _buffer(out) $string "\n"
     546            append _outbuf $string "\n"
    659547        } else {
    660             if {[catch {puts $_sid $string}]} {
    661                 disconnect
    662                 _receive_echo closed
    663                 $_dispatcher event -after 750 !serverDown
    664             } else {
     548            if { [Send $string] } {
    665549                foreach line [split $string \n] {
    666                     _send_echo >>line $line
     550                    SendEcho >>line $line
    667551                }
    668552            }
    … …  
    689573            set length [string length $data]
    690574            set cmdstr "heightmap data follows $length"
    691             _send_echo >>line $cmdstr
    692             if {[catch {puts $_sid $cmdstr} err]} {
    693                 disconnect
    694                 $_dispatcher event -after 750 !serverDown
     575            if { ![Send $cmdstr] } {
    695576                return
    696577            }
    697 
    698578            while {[string length $data] > 0} {
    699579                update
    … …  
    701581                set chunk [string range $data 0 8095]
    702582                set data [string range $data 8096 end]
    703 
    704                 _send_echo >>line $chunk
    705                 if {[catch {puts -nonewline $_sid $chunk} err]} {
    706                     disconnect
    707                     $_dispatcher event -after 750 !serverDown
     583                if { ![Send $chunk -nonewline] } {
    708584                    return
    709585                }
    710                 catch {flush $_sid}
    711             }
    712             _send_echo >>line ""
    713             puts $_sid ""
    714 
    715             set _obj2id($dataobj-$comp) $_obj2id(count)
     586                Flush
     587            }
     588            Send ""
     589
     590            set id $_obj2id(count)
    716591            incr _obj2id(count)
     592            set _id2obj($id) [list $dataobj $comp]
     593            set _obj2id($dataobj-$comp) $id
     594            set _receiveids($id) 1
    717595
    718596            #
    … …  
    722600            foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
    723601            set cmdstr [list "transfunc" "define" $sname $cmap $wmap]
    724             _send_echo >>line $cmdstr
    725             if {[catch {puts $_sid $cmdstr} err]} {
    726                 disconnect
    727                 $_dispatcher event -after 750 !serverDown
     602            if {![Send $cmdstr]} {
    728603                return
    729604            }
    730 
    731605            set _obj2style($dataobj-$comp) $sname
    732606        }
    … …  
    740614        set axis [$first hints updir]
    741615        if {"" != $axis} {
    742             _send "up" $axis
     616            _send "up $axis"
    743617        }
    744618    }
    … …  
    746620    foreach key [array names _obj2id *-*] {
    747621        set state [string match $first-* $key]
    748         _send "heightmap" "data" "visible" $state $_obj2id($key)
     622        _send "heightmap data visible $state $_obj2id($key)"
    749623        if {[info exists _obj2style($key)]} {
    750             _send "heightmap" "transfunc" $_obj2style($key) $_obj2id($key)
    751         }
    752     }
    753 
     624            _send "heightmap transfunc $_obj2style($key) $_obj2id($key)"
     625        }
     626    }
    754627
    755628    # if there are any commands in the buffer, send them now that we're done
    756     _send_echo >>line $_buffer(out)
    757     if {[catch {puts $_sid $_buffer(out)} err]} {
    758         disconnect
    759         $_dispatcher event -after 750 !serverDown
    760     }
    761     set _buffer(out) ""
     629    Send $_outbuf
     630    set _outbuf ""
    762631
    763632    $_dispatcher event -idle !legend
    764 }
    765 
    766 # ----------------------------------------------------------------------
    767 # USAGE: _send_echo <channel> ?<data>?
    768 #
    769 # Used internally to echo sent data to clients interested in
    770 # this widget.  If the -sendcommand option is set, then it is
    771 # invoked in the global scope with the <channel> and <data> values
    772 # as arguments.  Otherwise, this does nothing.
    773 # ----------------------------------------------------------------------
    774 itcl::body Rappture::HeightmapViewer::_send_echo {channel {data ""}} {
    775     if {[string length $itk_option(-sendcommand)] > 0} {
    776         uplevel #0 $itk_option(-sendcommand) [list $channel $data]
    777     }
    778 }
    779 
    780 # ----------------------------------------------------------------------
    781 # USAGE: _receive
    782 #
    783 # Invoked automatically whenever a command is received from the
    784 # rendering server.  Reads the incoming command and executes it in
    785 # a safe interpreter to handle the action.
    786 # ----------------------------------------------------------------------
    787 itcl::body Rappture::HeightmapViewer::_receive {} {
    788     if {"" != $_sid} {
    789         if {[gets $_sid line] < 0} {
    790             disconnect
    791             _receive_echo closed
    792             $_dispatcher event -after 750 !serverDown
    793         } elseif {[string equal [string range $line 0 2] "nv>"]} {
    794             _receive_echo <<line $line
    795             append _buffer(in) [string range $line 3 end]
    796             if {[info complete $_buffer(in)]} {
    797                 set request $_buffer(in)
    798                 set _buffer(in) ""
    799                 $_parser eval $request
    800             }
    801         } else {
    802             # this shows errors coming back from the engine
    803             _receive_echo <<error $line
    804         }
    805     }
    806633}
    807634
    … …  
    814641# ----------------------------------------------------------------------
    815642itcl::body Rappture::HeightmapViewer::_receive_image {option size} {
    816     if {"" != $_sid} {
    817         set bytes [read $_sid $size]
     643    if {[isconnected]} {
     644        set bytes [Receive $size]
    818645        $_image(plot) configure -data $bytes
    819         _receive_echo <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>"
     646        ReceiveEcho <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>"
    820647    }
    821648}
    … …  
    829656# ----------------------------------------------------------------------
    830657itcl::body Rappture::HeightmapViewer::_receive_legend {ivol vmin vmax size} {
    831     if {"" != $_sid} {
    832         set bytes [read $_sid $size]
     658    if { [isconnected] } {
     659        set bytes [Receive $size]
    833660        $_image(legend) configure -data $bytes
    834         _receive_echo <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
     661        ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
    835662
    836663        set c $itk_component(legend)
    … …  
    841668                 -image $_image(legend) -tags transfunc
    842669
    843             $c bind transfunc <ButtonPress-1> \
    844                  [itcl::code $this _probe start %x %y]
    845             $c bind transfunc <B1-Motion> \
    846                  [itcl::code $this _probe update %x %y]
    847             $c bind transfunc <ButtonRelease-1> \
    848                  [itcl::code $this _probe end %x %y]
    849 
    850670            $c create text 10 [expr {$h-8}] -anchor sw \
    851671                 -fill $itk_option(-plotforeground) -tags vmin
    … …  
    853673                 -fill $itk_option(-plotforeground) -tags vmax
    854674        }
    855 
    856675        $c itemconfigure vmin -text $vmin
    857676        $c coords vmin 10 [expr {$h-8}]
    858 
    859677        $c itemconfigure vmax -text $vmax
    860678        $c coords vmax [expr {$w-10}] [expr {$h-8}]
    … …  
    863681
    864682# ----------------------------------------------------------------------
    865 # USAGE: _receive_echo <channel> ?<data>?
    866 #
    867 # Used internally to echo received data to clients interested in
    868 # this widget.  If the -receivecommand option is set, then it is
    869 # invoked in the global scope with the <channel> and <data> values
    870 # as arguments.  Otherwise, this does nothing.
    871 # ----------------------------------------------------------------------
    872 itcl::body Rappture::HeightmapViewer::_receive_echo {channel {data ""}} {
    873     if {[string length $itk_option(-receivecommand)] > 0} {
    874         uplevel #0 $itk_option(-receivecommand) [list $channel $data]
     683# USAGE: _receive_data <id> <vmin> <vmax>
     684#
     685# Invoked automatically whenever the "legend" command comes in from
     686# the rendering server.  Indicates that binary image data with the
     687# specified <size> will follow.
     688# ----------------------------------------------------------------------
     689itcl::body Rappture::HeightmapViewer::_receive_data { args } {
     690    if { [isconnected] } {
     691        array set info $args
     692        set id $info(id)
     693        foreach { dataobj comp } $_id2obj($id) break
     694        if { ![info exists _limits($dataobj-vmin] } {
     695            set _limits($dataobj-vmin) $info(min)
     696            set _limits($dataobj-vmax) $info(max)
     697        } else {
     698            if { $_limits($dataobj-vmin) > $info(min) } {
     699                set _limits($dataobj-vmin) $info(min)
     700            }
     701            if { $_limits($dataobj-vmax) > $info(max) } {
     702                set _limits($dataobj-vmax) $info(max)
     703            }
     704        }           
     705        set _limits(vmin) $info(vmin)
     706        set _limits(vmax) $info(vmax)
     707        lappend _sendobjs2 $dataobj
     708        unset _receiveids($info(id))
     709        if { [array size _receiveids] == 0 } {
     710            #$_dispatcher event -idle !send_transfuncs
     711        }
    875712    }
    876713}
    … …  
    906743    if {[llength $_sendobjs] > 0} {
    907744        # send off new data objects
    908         after idle [itcl::code $this _send_dataobjs]
     745        $_dispatcher event -idle !send_dataobjs
    909746    } else {
    910747        # nothing to send -- activate the proper volume
    … …  
    913750            set axis [$first hints updir]
    914751            if {"" != $axis} {
    915                 _send up $axis
     752                _send "up $axis"
    916753            }
    917754        }
    918755        foreach key [array names _obj2id *-*] {
    919756            set state [string match $first-* $key]
    920             _send "heightmap" "data" "visible" $state $_obj2id($key)
     757            _send "heightmap data visible $state $_obj2id($key)"
    921758            if {[info exists _obj2style($key)]} {
    922                 _send "heightmap" "transfunc" $_obj2style($key) $_obj2id($key)
     759                _send "heightmap transfunc $_obj2style($key) $_obj2id($key)"
    923760            }
    924761        }
    … …  
    929766    # Reset the camera and other view parameters
    930767    #
    931     eval _send camera angle [_euler2xyz $_view(theta) $_view(phi) $_view(psi)]
    932     _send camera zoom $_view(zoom)
     768    _send "camera angle [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]"
     769    _send "camera zoom $_view(zoom)"
    933770
    934771     if {"" == $itk_option(-plotoutline)} {
    935          eval _send "grid"  "linecolor" [_color2rgb $itk_option(-plotoutline)]
     772         _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
    936773     }
    937     _fixGrid
    938     _fixAxes
    939     _fixContourLines
    940 }
    941 
    942 # ----------------------------------------------------------------------
    943 # USAGE: _currentHeightMapIds ?-cutplanes?
    944 #
    945 # Returns a list of volume server IDs for the current volume being
    946 # displayed.  This is normally a single ID, but it might be a list
    947 # of IDs if the current data object has multiple components.
    948 # ----------------------------------------------------------------------
    949 itcl::body Rappture::HeightmapViewer::_currentHeightMapIds {{what -all}} {
    950     set rlist ""
    951 
    952     set first [lindex [get] 0]
    953     foreach key [array names _obj2id *-*] {
    954         if {[string match $first-* $key]} {
    955             array set style {
    956                 -cutplanes 1
    957             }
    958             foreach {dataobj comp} [split $key -] break
    959             array set style [lindex [$dataobj components -style $comp] 0]
    960 
    961             if {$what != "-cutplanes" || $style(-cutplanes)} {
    962                 lappend rlist $_obj2id($key)
    963             }
    964         }
    965     }
    966     return $rlist
     774    _fixSettings grid
     775    _fixSettings axes
     776    _fixSettings contourlines
    967777}
    968778
    … …  
    979789        in {
    980790            set _view(zoom) [expr {$_view(zoom)*1.25}]
    981             _send camera zoom $_view(zoom)
     791            _send "camera zoom $_view(zoom)"
    982792        }
    983793        out {
    984794            set _view(zoom) [expr {$_view(zoom)*0.8}]
    985             _send camera zoom $_view(zoom)
     795            _send "camera zoom $_view(zoom)"
    986796        }
    987797        reset {
    … …  
    990800            set _view(psi) 0
    991801            set _view(zoom) 1.0
    992             eval _send camera angle [_euler2xyz $_view(theta) $_view(phi) $_view(psi)]
    993             _send camera zoom $_view(zoom)
     802            set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
     803            _send "camera angle $xyz"
     804            _send "camera zoom $_view(zoom)"
    994805        }
    995806    }
    … …  
    1057868                set _view(phi) $phi
    1058869                set _view(psi) $psi
    1059                 eval _send camera angle [_euler2xyz $_view(theta) $_view(phi) $_view(psi)]
    1060 
     870                set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
     871                _send "camera angle $xyz"
    1061872                set _click(x) $x
    1062873                set _click(y) $y
    … …  
    1075886
    1076887# ----------------------------------------------------------------------
    1077 # USAGE: _probe start <x> <y>
    1078 # USAGE: _probe update <x> <y>
    1079 # USAGE: _probe end <x> <y>
    1080 #
    1081 # Used internally to handle the various probe operations, when the
    1082 # user clicks and drags on the legend area.  The probe changes the
    1083 # transfer function to highlight the area being selected in the
    1084 # legend.
    1085 # ----------------------------------------------------------------------
    1086 itcl::body Rappture::HeightmapViewer::_probe {option args} {
    1087     set c $itk_component(legend)
    1088     set w [winfo width $c]
    1089     set h [winfo height $c]
    1090     set y0 10
    1091     set y1 [expr {$y0+[image height $_image(legend)]-1}]
    1092 
    1093     set dataobj [lindex [get] 0]
    1094     if {"" == $dataobj} {
    1095         return
    1096     }
    1097     set comp [lindex [$dataobj components] 0]
    1098     if {![info exists _obj2style($dataobj-$comp)]} {
    1099         return
    1100     }
    1101 
    1102     switch -- $option {
    1103         start {
    1104             # create the probe marker on the legend
    1105             $c create rect 0 0 5 $h -width 3 \
    1106                 -outline black -fill "" -tags markerbg
    1107             $c create rect 0 0 5 $h -width 1 \
    1108                 -outline white -fill "" -tags marker
    1109 
    1110             # define a new transfer function
    1111             _send "transfunc" "define" "probe" {0 0 0 0 1 0 0 0} {0 0 1 0}
    1112             _send "heightmap" "transfunc" "probe" $_obj2id($dataobj-$comp)
    1113 
    1114             # now, probe this point
    1115             eval _probe update $args
    1116         }
    1117         update {
    1118             set x [lindex $args 0]
    1119             if {$x < 10} {set x 10}
    1120             if {$x > $w-10} {set x [expr {$w-10}]}
    1121             foreach tag {markerbg marker} {
    1122                 $c coords $tag [expr {$x-2}] [expr {$y0-2}] \
    1123                     [expr {$x+2}] [expr {$y1+2}]
    1124             }
    1125 
    1126             # value of the probe point, in the range 0-1
    1127             set val [expr {double($x-10)/($w-20)}]
    1128             set dl [expr {($val > 0.1) ? 0.1 : $val}]
    1129             set dr [expr {($val < 0.9) ? 0.1 : 1-$val}]
    1130 
    1131             # compute a transfer function for the probe value
    1132             foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
    1133             set wmap "0.0 0.0 [expr {$val-$dl}] 0.0 $val 1.0 [expr {$val+$dr}] 0.0 1.0 0.0"
    1134             _send transfunc define "probe" $cmap $wmap
    1135         }
    1136         end {
    1137             $c delete marker markerbg
    1138 
    1139             # put the volume back to its old transfer function
    1140              _send "heightmap" "transfunc" $_obj2style($dataobj-$comp) \
    1141                 $_obj2id($dataobj-$comp)
    1142         }
    1143         default {
    1144             error "bad option \"$option\": should be start, update, end"
    1145         }
    1146     }
    1147 }
    1148 
    1149 # ----------------------------------------------------------------------
    1150888# USAGE: _state <component>
    1151889#
    … …  
    1168906# to the back end.
    1169907# ----------------------------------------------------------------------
    1170 itcl::body Rappture::HeightmapViewer::_fixSettings {what {value ""}} {
    1171     set inner [$itk_component(controls).panel component inner]
     908itcl::body Rappture::HeightmapViewer::_fixSettings { what {value ""} } {
    1172909    switch -- $what {
    1173         light {
    1174             if {[isconnected]} {
    1175                 set val [$inner.scales.light get]
    1176                 set sval [expr {0.1*$val}]
    1177                 _send volume shading diffuse $sval
    1178 
    1179                 set sval [expr {sqrt($val+1.0)}]
    1180                 _send volume shading specular $sval
    1181             }
    1182         }
    1183         transp {
    1184             if {[isconnected]} {
    1185                 set val [$inner.scales.transp get]
    1186                 set sval [expr {0.2*$val+1}]
    1187                 _send volume shading opacity $sval
    1188             }
    1189         }
    1190         default {
    1191             error "don't know how to fix $what"
    1192         }
    1193     }
    1194 }
    1195 
    1196 # ----------------------------------------------------------------------
    1197 # USAGE: _fixLegend
    1198 #
    1199 # Used internally to update the legend area whenever it changes size
    1200 # or when the field changes.  Asks the server to send a new legend
    1201 # for the current field.
    1202 # ----------------------------------------------------------------------
    1203 itcl::body Rappture::HeightmapViewer::_fixLegend {} {
    1204     set lineht [font metrics $itk_option(-font) -linespace]
    1205     set w [expr {[winfo width $itk_component(legend)]-20}]
    1206     set h [expr {[winfo height $itk_component(legend)]-20-$lineht}]
    1207     set imap ""
    1208 
    1209     set dataobj [lindex [get] 0]
    1210     if {"" != $dataobj} {
    1211         set comp [lindex [$dataobj components] 0]
    1212         if {[info exists _obj2id($dataobj-$comp)]} {
    1213             set imap $_obj2id($dataobj-$comp)
    1214         }
    1215     }
    1216     if {$w > 0 && $h > 0 && "" != $imap} {
    1217         _send "heightmap" "legend" $imap $w $h
    1218     } else {
    1219         $itk_component(legend) delete all
    1220     }
    1221 }
    1222 
    1223 # ----------------------------------------------------------------------
    1224 # USAGE: _fixGrid
    1225 #
    1226 # Used internally to update the legend area whenever it changes size
    1227 # or when the field changes.  Asks the server to send a new legend
    1228 # for the current field.
    1229 # ----------------------------------------------------------------------
    1230 itcl::body Rappture::HeightmapViewer::_fixGrid {} {
    1231     if {[isconnected]} {
    1232         _send "grid" "visible" $::Rappture::HeightmapViewer::_showGrid($this)
    1233     }
    1234 }
    1235 
    1236 
    1237 # ----------------------------------------------------------------------
    1238 # USAGE: _fixAxes
    1239 # ----------------------------------------------------------------------
    1240 itcl::body Rappture::HeightmapViewer::_fixAxes {} {
    1241     if {[isconnected]} {
    1242         _send "axis" "visible" $::Rappture::HeightmapViewer::_showAxes($this)
    1243     }
    1244 }
    1245 
    1246 
    1247 # ----------------------------------------------------------------------
    1248 # USAGE: _fixLineContour
    1249 # ----------------------------------------------------------------------
    1250 itcl::body Rappture::HeightmapViewer::_fixContourLines {} {
    1251     if {[isconnected]} {
    1252         set dataobj [lindex [get] 0]
    1253         if {"" != $dataobj} {
    1254             set comp [lindex [$dataobj components] 0]
    1255             if {[info exists _obj2id($dataobj-$comp)]} {
    1256                 set i $_obj2id($dataobj-$comp)
    1257                 _send "heightmap" "linecontour" "visible" \
    1258                     $::Rappture::HeightmapViewer::_showContourLines($this) $i
     910        "legend" {
     911            set lineht [font metrics $itk_option(-font) -linespace]
     912            set w [expr {[winfo width $itk_component(legend)]-20}]
     913            set h [expr {[winfo height $itk_component(legend)]-20-$lineht}]
     914            set imap ""
     915           
     916            set dataobj [lindex [get] 0]
     917            if {"" != $dataobj} {
     918                set comp [lindex [$dataobj components] 0]
     919                if {[info exists _obj2id($dataobj-$comp)]} {
     920                    set imap $_obj2id($dataobj-$comp)
     921                }
     922            }
     923            if {$w > 0 && $h > 0 && "" != $imap} {
     924                _send "heightmap legend $imap $w $h"
     925            } else {
     926                $itk_component(legend) delete all
    1259927            }
    1260928        }
    1261     }
    1262 }
    1263 
    1264 
    1265 # ----------------------------------------------------------------------
    1266 # USAGE: _serverDown
    1267 #
    1268 # Used internally to let the user know when the connection to the
    1269 # visualization server has been lost.  Puts up a tip encouraging the user to
    1270 # press any control to reconnect. 
    1271 #
    1272 # ----------------------------------------------------------------------
    1273 itcl::body Rappture::HeightmapViewer::_serverDown {} {
    1274     set x [expr {[winfo rootx $itk_component(area)]+10}]
    1275     set y [expr {[winfo rooty $itk_component(area)]+10}]
    1276     Rappture::Tooltip::cue @$x,$y "Lost connection to visualization server.  This happens sometimes when there are too many users and the system runs out of memory.\n\nTo reconnect, reset the view or press any other control.  Your picture should come right back up."
     929        "grid" {
     930            if { [isconnected] } {
     931                _send "grid visible $_settings($this-grid)"
     932            }
     933        }
     934        "axes" {
     935            if { [isconnected] } {
     936                _send "axis visible $_settings($this-axes)"
     937            }
     938        }
     939        "contourlines" {
     940            if {[isconnected]} {
     941                set dataobj [lindex [get] 0]
     942                if {"" != $dataobj} {
     943                    set comp [lindex [$dataobj components] 0]
     944                    if {[info exists _obj2id($dataobj-$comp)]} {
     945                        set i $_obj2id($dataobj-$comp)
     946                        set bool $_settings($this-contourlines)
     947                        _send "heightmap linecontour visible $bool $i"
     948                    }
     949                }
     950            }
     951        }
     952        default {
     953            error "don't know how to fix $what: should be grid, axes, contourlines, or legend"
     954        }
     955    }
    1277956}
    1278957
    … …  
    1297976    }
    1298977    set clist [split $style(-color) :]
    1299     set cmap "0.0 [_color2rgb white] "
     978    set cmap "0.0 [Color2RGB white] "
    1300979    for {set i 0} {$i < [llength $clist]} {incr i} {
    1301980        set xval [expr {double($i+1)/([llength $clist]+1)}]
    1302981        set color [lindex $clist $i]
    1303         append cmap "$xval [_color2rgb $color] "
    1304     }
    1305     append cmap "1.0 [_color2rgb $color]"
     982        append cmap "$xval [Color2RGB $color] "
     983    }
     984    append cmap "1.0 [Color2RGB $color]"
    1306985
    1307986    set max $style(-opacity)
    … …  
    13291008
    13301009# ----------------------------------------------------------------------
    1331 # USAGE: _color2rgb <color>
    1332 #
    1333 # Used internally to convert a color name to a set of {r g b} values
    1334 # needed for the engine.  Each r/g/b component is scaled in the
    1335 # range 0-1.
    1336 # ----------------------------------------------------------------------
    1337 itcl::body Rappture::HeightmapViewer::_color2rgb {color} {
    1338     foreach {r g b} [winfo rgb $itk_component(hull) $color] break
    1339     set r [expr {$r/65535.0}]
    1340     set g [expr {$g/65535.0}]
    1341     set b [expr {$b/65535.0}]
    1342     return [list $r $g $b]
    1343 }
    1344 
    1345 # ----------------------------------------------------------------------
    1346 # USAGE: _euler2xyz <theta> <phi> <psi>
    1347 #
    1348 # Used internally to convert euler angles for the camera placement
    1349 # the to angles of rotation about the x/y/z axes, used by the engine.
    1350 # Returns a list:  {xangle, yangle, zangle}.
    1351 # ----------------------------------------------------------------------
    1352 itcl::body Rappture::HeightmapViewer::_euler2xyz {theta phi psi} {
    1353     set xangle [expr {$theta-90.0}]
    1354     set yangle [expr {180-$phi}]
    1355     set zangle $psi
    1356     return [list $xangle $yangle $zangle]
    1357 }
    1358 
    1359 # ----------------------------------------------------------------------
    13601010# CONFIGURATION OPTION: -plotbackground
    13611011# ----------------------------------------------------------------------
    13621012itcl::configbody Rappture::HeightmapViewer::plotbackground {
    1363     foreach {r g b} [_color2rgb $itk_option(-plotbackground)] break
     1013    foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
    13641014    #fix this!
    1365     #_send color background $r $g $b
     1015    #_send "color background $r $g $b"
    13661016}
    13671017
    … …  
    13701020# ----------------------------------------------------------------------
    13711021itcl::configbody Rappture::HeightmapViewer::plotforeground {
    1372     foreach {r g b} [_color2rgb $itk_option(-plotforeground)] break
     1022    foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
    13731023    #fix this!
    1374     #_send color background $r $g $b
     1024    #_send "color background $r $g $b"
    13751025}
    13761026
    … …  
    13801030itcl::configbody Rappture::HeightmapViewer::plotoutline {
    13811031    if {[isconnected]} {
    1382         eval _send "grid" "linecolor" [_color2rgb $itk_option(-plotoutline)]
    1383     }
    1384 }
     1032        _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
     1033    }
     1034}
Note: See TracChangeset for help on using the changeset viewer.