Ignore:
Timestamp:
Mar 18, 2009, 2:59:21 PM (16 years ago)
Author:
gah
Message:

preliminary HQ output from molvisviewer; unexpand tabs; all jpeg generation at 100%

File:
1 edited

Legend:

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

    r1313 r1342  
    3232proc HeightmapViewer_init_resources {} {
    3333    Rappture::resources::register \
    34         nanovis_server Rappture::HeightmapViewer::SetServerList
     34        nanovis_server Rappture::HeightmapViewer::SetServerList
    3535}
    3636
     
    4343
    4444    constructor { hostlist args } {
    45         Rappture::VisViewer::constructor $hostlist
     45        Rappture::VisViewer::constructor $hostlist
    4646    } {
    47         # defined below
     47        # defined below
    4848    }
    4949    destructor {
    50         # defined below
     50        # defined below
    5151    }
    5252
    5353    public proc SetServerList { namelist } {
    54         Rappture::VisViewer::SetServerList "nanovis" $namelist
     54        Rappture::VisViewer::SetServerList "nanovis" $namelist
    5555    }
    5656    public method add {dataobj {settings ""}}
     
    6060    public method download {option args}
    6161    public method parameters {title args} {
    62         # do nothing
     62        # do nothing
    6363    }
    6464    public method drawer {what who}
     
    114114    $_dispatcher register !legend
    115115    $_dispatcher dispatch $this !legend \
    116         "[itcl::code $this _fixSettings legend]; list"
     116        "[itcl::code $this _fixSettings legend]; list"
    117117    # Send dataobjs event
    118118    $_dispatcher register !send_dataobjs
    119119    $_dispatcher dispatch $this !send_dataobjs \
    120         "[itcl::code $this _send_dataobjs]; list"
     120        "[itcl::code $this _send_dataobjs]; list"
    121121    # Rebuild event
    122122    $_dispatcher register !rebuild
     
    133133    # Initialize the view to some default parameters.
    134134    array set view_ {
    135         theta   45
    136         phi     45
    137         psi     0
    138         zoom    1.0
    139         pan-x   0
    140         pan-y   0
     135        theta   45
     136        phi     45
     137        psi     0
     138        zoom    1.0
     139        pan-x   0
     140        pan-y   0
    141141    }
    142142    set obj2id_(count) 0
    143143
    144144    itk_component add zoom {
    145         frame $itk_component(controls).zoom
     145        frame $itk_component(controls).zoom
    146146    } {
    147         usual
    148         rename -background -controlbackground controlBackground Background
     147        usual
     148        rename -background -controlbackground controlBackground Background
    149149    }
    150150    pack $itk_component(zoom) -side top
    151151
    152152    itk_component add reset {
    153         button $itk_component(zoom).reset \
    154             -borderwidth 1 -padx 1 -pady 1 \
    155             -image [Rappture::icon reset-view] \
    156             -command [itcl::code $this _zoom reset]
     153        button $itk_component(zoom).reset \
     154            -borderwidth 1 -padx 1 -pady 1 \
     155            -image [Rappture::icon reset-view] \
     156            -command [itcl::code $this _zoom reset]
    157157    } {
    158         usual
    159         ignore -borderwidth
    160         rename -highlightbackground -controlbackground controlBackground Background
     158        usual
     159        ignore -borderwidth
     160        rename -highlightbackground -controlbackground controlBackground Background
    161161    }
    162162    pack $itk_component(reset) -side top -padx 2 -pady { 2 0 }
     
    164164
    165165    itk_component add zoomin {
    166         button $itk_component(zoom).zin \
    167             -borderwidth 1 -padx 1 -pady 1 \
    168             -image [Rappture::icon zoom-in] \
    169             -command [itcl::code $this _zoom in]
     166        button $itk_component(zoom).zin \
     167            -borderwidth 1 -padx 1 -pady 1 \
     168            -image [Rappture::icon zoom-in] \
     169            -command [itcl::code $this _zoom in]
    170170    } {
    171         usual
    172         ignore -borderwidth
    173         rename -highlightbackground -controlbackground controlBackground Background
     171        usual
     172        ignore -borderwidth
     173        rename -highlightbackground -controlbackground controlBackground Background
    174174    }
    175175    pack $itk_component(zoomin) -side top -padx 2 -pady { 2 0 }
     
    177177
    178178    itk_component add zoomout {
    179         button $itk_component(zoom).zout \
    180             -borderwidth 1 -padx 1 -pady 1 \
    181             -image [Rappture::icon zoom-out] \
    182             -command [itcl::code $this _zoom out]
     179        button $itk_component(zoom).zout \
     180            -borderwidth 1 -padx 1 -pady 1 \
     181            -image [Rappture::icon zoom-out] \
     182            -command [itcl::code $this _zoom out]
    183183    } {
    184         usual
    185         ignore -borderwidth
    186         rename -highlightbackground -controlbackground controlBackground Background
     184        usual
     185        ignore -borderwidth
     186        rename -highlightbackground -controlbackground controlBackground Background
    187187    }
    188188    pack $itk_component(zoomout) -side top -padx 2 -pady { 2 0 }
     
    190190
    191191    itk_component add settings_button {
    192         label $itk_component(controls).settingsbutton \
    193             -borderwidth 1 -padx 1 -pady 1 \
    194             -relief "raised" -image [Rappture::icon wrench]
     192        label $itk_component(controls).settingsbutton \
     193            -borderwidth 1 -padx 1 -pady 1 \
     194            -relief "raised" -image [Rappture::icon wrench]
    195195    } {
    196         usual
    197         ignore -borderwidth
    198         rename -highlightbackground -controlbackground controlBackground \
     196        usual
     197        ignore -borderwidth
     198        rename -highlightbackground -controlbackground controlBackground \
    199199            Background
    200200    }
     
    204204        "Configure settings"
    205205    bind $itk_component(settings_button) <ButtonPress> \
    206         [itcl::code $this drawer toggle settings]
     206        [itcl::code $this drawer toggle settings]
    207207    pack $itk_component(settings_button) -side bottom \
    208208        -padx 2 -pady 2 -anchor e
    209209
    210210    itk_component add camera_button {
    211         label $itk_component(controls).camerabutton \
    212             -borderwidth 1 -padx 1 -pady 1 \
    213             -relief "raised" -image [Rappture::icon camera]
     211        label $itk_component(controls).camerabutton \
     212            -borderwidth 1 -padx 1 -pady 1 \
     213            -relief "raised" -image [Rappture::icon camera]
    214214    } {
    215         usual
    216         ignore -borderwidth
    217         rename -highlightbackground -controlbackground controlBackground \
     215        usual
     216        ignore -borderwidth
     217        rename -highlightbackground -controlbackground controlBackground \
    218218            Background
    219219    }
     
    221221        "Camera settings"
    222222    bind $itk_component(camera_button) <ButtonPress> \
    223         [itcl::code $this drawer toggle camera]
     223        [itcl::code $this drawer toggle camera]
    224224    pack $itk_component(camera_button) -side bottom \
    225225        -padx 2 -pady { 0 2 } -ipadx 1 -ipady 1
     
    231231    set _image(legend) [image create photo]
    232232    itk_component add legend {
    233         canvas $itk_component(area).legend -width 30 -highlightthickness 0
     233        canvas $itk_component(area).legend -width 30 -highlightthickness 0
    234234    } {
    235         usual
    236         ignore -highlightthickness
    237         rename -background -plotbackground plotBackground Background
     235        usual
     236        ignore -highlightthickness
     237        rename -background -plotbackground plotBackground Background
    238238    }
    239239    pack $itk_component(legend) -side right -fill y
    240240    pack $itk_component(3dview) -side left -expand yes -fill both
    241241    bind $itk_component(legend) <Configure> \
    242         [list $_dispatcher event -idle !legend]
     242        [list $_dispatcher event -idle !legend]
    243243
    244244    # Bindings for rotation via mouse
    245245    bind $itk_component(3dview) <ButtonPress-1> \
    246         [itcl::code $this _rotate click %x %y]
     246        [itcl::code $this _rotate click %x %y]
    247247    bind $itk_component(3dview) <B1-Motion> \
    248         [itcl::code $this _rotate drag %x %y]
     248        [itcl::code $this _rotate drag %x %y]
    249249    bind $itk_component(3dview) <ButtonRelease-1> \
    250         [itcl::code $this _rotate release %x %y]
     250        [itcl::code $this _rotate release %x %y]
    251251    bind $itk_component(3dview) <Configure> \
    252         [itcl::code $this _send "screen %w %h"]
     252        [itcl::code $this _send "screen %w %h"]
    253253
    254254    # Bindings for panning via mouse
    255255    bind $itk_component(3dview) <ButtonPress-2> \
    256         [itcl::code $this _pan click %x %y]
     256        [itcl::code $this _pan click %x %y]
    257257    bind $itk_component(3dview) <B2-Motion> \
    258         [itcl::code $this _pan drag %x %y]
     258        [itcl::code $this _pan drag %x %y]
    259259    bind $itk_component(3dview) <ButtonRelease-2> \
    260         [itcl::code $this _pan release %x %y]
     260        [itcl::code $this _pan release %x %y]
    261261
    262262    # Bindings for panning via keyboard
    263263    bind $itk_component(3dview) <KeyPress-Left> \
    264         [itcl::code $this _pan set -10 0]
     264        [itcl::code $this _pan set -10 0]
    265265    bind $itk_component(3dview) <KeyPress-Right> \
    266         [itcl::code $this _pan set 10 0]
     266        [itcl::code $this _pan set 10 0]
    267267    bind $itk_component(3dview) <KeyPress-Up> \
    268         [itcl::code $this _pan set 0 -10]
     268        [itcl::code $this _pan set 0 -10]
    269269    bind $itk_component(3dview) <KeyPress-Down> \
    270         [itcl::code $this _pan set 0 10]
     270        [itcl::code $this _pan set 0 10]
    271271    bind $itk_component(3dview) <Shift-KeyPress-Left> \
    272         [itcl::code $this _pan set -2 0]
     272        [itcl::code $this _pan set -2 0]
    273273    bind $itk_component(3dview) <Shift-KeyPress-Right> \
    274         [itcl::code $this _pan set 2 0]
     274        [itcl::code $this _pan set 2 0]
    275275    bind $itk_component(3dview) <Shift-KeyPress-Up> \
    276         [itcl::code $this _pan set 0 -2]
     276        [itcl::code $this _pan set 0 -2]
    277277    bind $itk_component(3dview) <Shift-KeyPress-Down> \
    278         [itcl::code $this _pan set 0 2]
     278        [itcl::code $this _pan set 0 2]
    279279
    280280    # Bindings for zoom via keyboard
    281281    bind $itk_component(3dview) <KeyPress-Prior> \
    282         [itcl::code $this _zoom out]
     282        [itcl::code $this _zoom out]
    283283    bind $itk_component(3dview) <KeyPress-Next> \
    284         [itcl::code $this _zoom in]
     284        [itcl::code $this _zoom in]
    285285
    286286    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
    287287
    288288    if {[string equal "x11" [tk windowingsystem]]} {
    289         # Bindings for zoom via mouse
    290         bind $itk_component(3dview) <4> [itcl::code $this _zoom out]
    291         bind $itk_component(3dview) <5> [itcl::code $this _zoom in]
     289        # Bindings for zoom via mouse
     290        bind $itk_component(3dview) <4> [itcl::code $this _zoom out]
     291        bind $itk_component(3dview) <5> [itcl::code $this _zoom in]
    292292    }
    293293
     
    320320itcl::body Rappture::HeightmapViewer::add {dataobj {settings ""}} {
    321321    array set params {
    322         -color auto
    323         -width 1
    324         -linestyle solid
    325         -brightness 0
    326         -raise 0
    327         -description ""
    328         -param ""
     322        -color auto
     323        -width 1
     324        -linestyle solid
     325        -brightness 0
     326        -raise 0
     327        -description ""
     328        -param ""
    329329    }
    330330    foreach {opt val} $settings {
    331         if {![info exists params($opt)]} {
    332             error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
    333         }
    334         set params($opt) $val
     331        if {![info exists params($opt)]} {
     332            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
     333        }
     334        set params($opt) $val
    335335    }
    336336    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
    337         # can't handle -autocolors yet
    338         set params(-color) black
     337        # can't handle -autocolors yet
     338        set params(-color) black
    339339    }
    340340    set location [$dataobj hints camera]
     
    344344    set pos [lsearch -exact $dataobj $dlist_]
    345345    if {$pos < 0} {
    346         lappend dlist_ $dataobj
    347         set obj2ovride_($dataobj-color) $params(-color)
    348         set obj2ovride_($dataobj-width) $params(-width)
    349         set obj2ovride_($dataobj-raise) $params(-raise)
    350         $_dispatcher event -idle !rebuild
     346        lappend dlist_ $dataobj
     347        set obj2ovride_($dataobj-color) $params(-color)
     348        set obj2ovride_($dataobj-width) $params(-width)
     349        set obj2ovride_($dataobj-raise) $params(-raise)
     350        $_dispatcher event -idle !rebuild
    351351    }
    352352}
     
    362362itcl::body Rappture::HeightmapViewer::get {args} {
    363363    if {[llength $args] == 0} {
    364         set args "-objects"
     364        set args "-objects"
    365365    }
    366366
     
    368368    switch -- $op {
    369369      -objects {
    370         # put the dataobj list in order according to -raise options
    371         set dlist $dlist_
    372         foreach obj $dlist {
    373             if { [info exists obj2ovride_($obj-raise)] &&
    374                 $obj2ovride_($obj-raise)} {
    375                 set i [lsearch -exact $dlist $obj]
    376                 if {$i >= 0} {
    377                     set dlist [lreplace $dlist $i $i]
    378                     lappend dlist $obj
    379                 }
    380             }
    381         }
    382         return $dlist
     370        # put the dataobj list in order according to -raise options
     371        set dlist $dlist_
     372        foreach obj $dlist {
     373            if { [info exists obj2ovride_($obj-raise)] &&
     374                $obj2ovride_($obj-raise)} {
     375                set i [lsearch -exact $dlist $obj]
     376                if {$i >= 0} {
     377                    set dlist [lreplace $dlist $i $i]
     378                    lappend dlist $obj
     379                }
     380            }
     381        }
     382        return $dlist
    383383      }
    384384      -image {
    385         if {[llength $args] != 2} {
    386             error "wrong # args: should be \"get -image 3dview|legend\""
    387         }
    388         switch -- [lindex $args end] {
    389             3dview {
    390                 return $_image(plot)
    391             }
    392             legend {
    393                 return $_image(legend)
    394             }
    395             default {
    396                 error "bad image name \"[lindex $args end]\": should be 3dview or legend"
    397             }
    398         }
     385        if {[llength $args] != 2} {
     386            error "wrong # args: should be \"get -image 3dview|legend\""
     387        }
     388        switch -- [lindex $args end] {
     389            3dview {
     390                return $_image(plot)
     391            }
     392            legend {
     393                return $_image(legend)
     394            }
     395            default {
     396                error "bad image name \"[lindex $args end]\": should be 3dview or legend"
     397            }
     398        }
    399399      }
    400400      default {
    401         error "bad option \"$op\": should be -objects or -image"
     401        error "bad option \"$op\": should be -objects or -image"
    402402      }
    403403    }
     
    412412itcl::body Rappture::HeightmapViewer::delete {args} {
    413413    if {[llength $args] == 0} {
    414         set args $dlist_
     414        set args $dlist_
    415415    }
    416416
     
    418418    set changed 0
    419419    foreach dataobj $args {
    420         set pos [lsearch -exact $dlist_ $dataobj]
    421         if {$pos >= 0} {
    422             set dlist_ [lreplace $dlist_ $pos $pos]
    423             foreach key [array names obj2ovride_ $dataobj-*] {
    424                 unset obj2ovride_($key)
    425             }
    426             set changed 1
    427         }
     420        set pos [lsearch -exact $dlist_ $dataobj]
     421        if {$pos >= 0} {
     422            set dlist_ [lreplace $dlist_ $pos $pos]
     423            foreach key [array names obj2ovride_ $dataobj-*] {
     424                unset obj2ovride_($key)
     425            }
     426            set changed 1
     427        }
    428428    }
    429429
    430430    # if anything changed, then rebuild the plot
    431431    if {$changed} {
    432         $_dispatcher event -idle !rebuild
     432        $_dispatcher event -idle !rebuild
    433433    }
    434434}
     
    445445itcl::body Rappture::HeightmapViewer::scale {args} {
    446446    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
    447         set limits_($val) ""
     447        set limits_($val) ""
    448448    }
    449449    foreach obj $args {
    450         foreach axis {x y z v} {
    451             foreach {min max} [$obj limits $axis] break
    452             if {"" != $min && "" != $max} {
    453                 if {"" == $limits_(${axis}min)} {
    454                     set limits_(${axis}min) $min
    455                     set limits_(${axis}max) $max
    456                 } else {
    457                     if {$min < $limits_(${axis}min)} {
    458                         set limits_(${axis}min) $min
    459                     }
    460                     if {$max > $limits_(${axis}max)} {
    461                         set limits_(${axis}max) $max
    462                     }
    463                 }
     450        foreach axis {x y z v} {
     451            foreach {min max} [$obj limits $axis] break
     452            if {"" != $min && "" != $max} {
     453                if {"" == $limits_(${axis}min)} {
     454                    set limits_(${axis}min) $min
     455                    set limits_(${axis}max) $max
     456                } else {
     457                    if {$min < $limits_(${axis}min)} {
     458                        set limits_(${axis}min) $min
     459                    }
     460                    if {$max > $limits_(${axis}max)} {
     461                        set limits_(${axis}max) $max
     462                    }
     463                }
    464464                set limits_(${axis}range) [expr {$max - $min}]
    465             }
    466         }
     465            }
     466        }
    467467    }
    468468}
     
    480480itcl::body Rappture::HeightmapViewer::download {option args} {
    481481    switch $option {
    482         coming {
    483             if {[catch {
    484                 blt::winop snap $itk_component(area) $_image(download)
    485             }]} {
    486                 $_image(download) configure -width 1 -height 1
    487                 $_image(download) put #000000
    488             }
    489         }
    490         controls {
    491             # no controls for this download yet
    492             return ""
    493         }
    494         now {
    495             #
    496             # Hack alert!  Need data in binary format,
    497             # so we'll save to a file and read it back.
    498             #
    499             set tmpfile /tmp/image[pid].jpg
    500             $_image(download) write $tmpfile -format jpeg
    501             set fid [open $tmpfile r]
    502             fconfigure $fid -encoding binary -translation binary
    503             set bytes [read $fid]
    504             close $fid
    505             file delete -force $tmpfile
    506 
    507             return [list .jpg $bytes]
    508         }
    509         default {
    510             error "bad option \"$option\": should be coming, controls, now"
    511         }
     482        coming {
     483            if {[catch {
     484                blt::winop snap $itk_component(area) $_image(download)
     485            }]} {
     486                $_image(download) configure -width 1 -height 1
     487                $_image(download) put #000000
     488            }
     489        }
     490        controls {
     491            # no controls for this download yet
     492            return ""
     493        }
     494        now {
     495            # Get image data (as base64) and decode back to binary.  This is
     496            # better than writing to temporary files.  When we switch the BLT
     497            # picture image it won't be necessary to decode the image data.
     498            set bytes [$_image(download) data -format "jpeg -quality 100"]
     499            set bytes [Rappture::encoding::decode -as b64 $bytes]
     500            return [list .jpg $bytes]
     501        }
     502        default {
     503            error "bad option \"$option\": should be coming, controls, now"
     504        }
    512505    }
    513506}
     
    524517    set _hosts [GetServerList "nanovis"]
    525518    if { "" == $_hosts } {
    526         return 0
     519        return 0
    527520    }
    528521    set result [VisViewer::Connect $_hosts]
     
    557550itcl::body Rappture::HeightmapViewer::_send {string} {
    558551    if {[llength $sendobjs_] > 0} {
    559         append outbuf_ $string "\n"
     552        append outbuf_ $string "\n"
    560553    } else {
    561         if {[SendBytes $string]} {
    562             foreach line [split $string \n] {
    563                 SendEcho >>line $line
    564             }
    565         }
     554        if {[SendBytes $string]} {
     555            foreach line [split $string \n] {
     556                SendEcho >>line $line
     557            }
     558        }
    566559    }
    567560}
     
    579572    # Reset the overall limits
    580573    if { $sendobjs_ != "" } {
    581         set limits_(vmin) ""
    582         set limits_(vmax) ""
     574        set limits_(vmin) ""
     575        set limits_(vmax) ""
    583576    }
    584577    foreach dataobj $sendobjs_ {
    585         foreach comp [$dataobj components] {
    586             set data [$dataobj blob $comp]
    587 
    588             foreach { vmin vmax }  [$dataobj limits v] break
    589             if { $limits_(vmin) == "" || $vmin < $limits_(vmin) } {
    590                 set limits_(vmin) $vmin
    591             }
    592             if { $limits_(vmax) == "" || $vmax > $limits_(vmax) } {
    593                 set limits_(vmax) $vmax
    594             }
    595 
    596             # tell the engine to expect some data
    597             set nbytes [string length $data]
    598             if { ![SendBytes "heightmap data follows $nbytes"] } {
    599                 return
    600 
    601             }
    602             if { ![SendBytes $data] } {
    603                 return
    604             }
    605             set id $obj2id_(count)
    606             incr obj2id_(count)
    607             set id2obj_($id) [list $dataobj $comp]
    608             set obj2id_($dataobj-$comp) $id
    609             set receiveIds_($id) 1
    610 
    611             #
    612             # Determine the transfer function needed for this volume
    613             # and make sure that it's defined on the server.
    614             #
    615             foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
    616             set cmdstr [list "transfunc" "define" $sname $cmap $wmap]
    617             if {![SendBytes $cmdstr]} {
    618                 return
    619             }
    620             set obj2style_($dataobj-$comp) $sname
    621         }
     578        foreach comp [$dataobj components] {
     579            set data [$dataobj blob $comp]
     580
     581            foreach { vmin vmax }  [$dataobj limits v] break
     582            if { $limits_(vmin) == "" || $vmin < $limits_(vmin) } {
     583                set limits_(vmin) $vmin
     584            }
     585            if { $limits_(vmax) == "" || $vmax > $limits_(vmax) } {
     586                set limits_(vmax) $vmax
     587            }
     588
     589            # tell the engine to expect some data
     590            set nbytes [string length $data]
     591            if { ![SendBytes "heightmap data follows $nbytes"] } {
     592                return
     593
     594            }
     595            if { ![SendBytes $data] } {
     596                return
     597            }
     598            set id $obj2id_(count)
     599            incr obj2id_(count)
     600            set id2obj_($id) [list $dataobj $comp]
     601            set obj2id_($dataobj-$comp) $id
     602            set receiveIds_($id) 1
     603
     604            #
     605            # Determine the transfer function needed for this volume
     606            # and make sure that it's defined on the server.
     607            #
     608            foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
     609            set cmdstr [list "transfunc" "define" $sname $cmap $wmap]
     610            if {![SendBytes $cmdstr]} {
     611                return
     612            }
     613            set obj2style_($dataobj-$comp) $sname
     614        }
    622615    }
    623616    set sendobjs_ ""
     
    627620    set first [lindex [get] 0]
    628621    if {"" != $first} {
    629         set axis [$first hints updir]
    630         if {"" != $axis} {
    631             _send "up $axis"
    632         }
     622        set axis [$first hints updir]
     623        if {"" != $axis} {
     624            _send "up $axis"
     625        }
    633626    }
    634627
    635628    foreach key [array names obj2id_ *-*] {
    636         set state [string match $first-* $key]
    637         _send "heightmap data visible $state $obj2id_($key)"
    638         if {[info exists obj2style_($key)]} {
    639             _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
    640         }
     629        set state [string match $first-* $key]
     630        _send "heightmap data visible $state $obj2id_($key)"
     631        if {[info exists obj2style_($key)]} {
     632            _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
     633        }
    641634    }
    642635
     
    657650itcl::body Rappture::HeightmapViewer::ReceiveImage {option size} {
    658651    if {[IsConnected]} {
    659         set bytes [ReceiveBytes $size]
    660         $_image(plot) configure -data $bytes
    661         ReceiveEcho <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>"
     652        set bytes [ReceiveBytes $size]
     653        $_image(plot) configure -data $bytes
     654        ReceiveEcho <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>"
    662655    }
    663656}
     
    672665itcl::body Rappture::HeightmapViewer::_ReceiveLegend {tf vmin vmax size} {
    673666    if { [IsConnected] } {
    674         set bytes [ReceiveBytes $size]
    675         ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
     667        set bytes [ReceiveBytes $size]
     668        ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
    676669        if 1 {
    677670        set src [image create photo -data $bytes]
     
    681674        $_image(legend) configure -data $bytes
    682675        }
    683         set c $itk_component(legend)
    684         set w [winfo width $c]
    685         set h [winfo height $c]
     676        set c $itk_component(legend)
     677        set w [winfo width $c]
     678        set h [winfo height $c]
    686679        set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
    687         if {"" == [$c find withtag transfunc]} {
    688             $c create image 0 [expr $lineht] -anchor ne \
    689                 -image $_image(legend) -tags transfunc
    690             $c create text 10 [expr {$h-8}] -anchor se \
    691                 -fill $itk_option(-plotforeground) -tags vmin
    692             $c create text [expr {$w-10}] [expr {$h-8}] -anchor ne \
    693                 -fill $itk_option(-plotforeground) -tags vmax
    694         }
     680        if {"" == [$c find withtag transfunc]} {
     681            $c create image 0 [expr $lineht] -anchor ne \
     682                -image $_image(legend) -tags transfunc
     683            $c create text 10 [expr {$h-8}] -anchor se \
     684                -fill $itk_option(-plotforeground) -tags vmin
     685            $c create text [expr {$w-10}] [expr {$h-8}] -anchor ne \
     686                -fill $itk_option(-plotforeground) -tags vmax
     687        }
    695688        $c coords transfunc [expr $w - 5] [expr $lineht]
    696         $c itemconfigure vmin -text $vmin
    697         $c itemconfigure vmax -text $vmax
    698         $c coords vmax [expr $w - 5] 2
    699         $c coords vmin [expr $w - 5] [expr $h - 2]
     689        $c itemconfigure vmin -text $vmin
     690        $c itemconfigure vmax -text $vmax
     691        $c coords vmax [expr $w - 5] 2
     692        $c coords vmin [expr $w - 5] [expr $h - 2]
    700693    }
    701694}
     
    711704    # in the midst of sending data? then bail out
    712705    if {[llength $sendobjs_] > 0} {
    713         return
     706        return
    714707    }
    715708    # Find any new data that needs to be sent to the server.  Queue this up on
     
    717710    # before we rebuild the rest.
    718711    foreach dataobj [get] {
    719         set comp [lindex [$dataobj components] 0]
    720         if {![info exists obj2id_($dataobj-$comp)]} {
    721             set i [lsearch -exact $sendobjs_ $dataobj]
    722             if {$i < 0} {
    723                 lappend sendobjs_ $dataobj
    724             }
    725         }
     712        set comp [lindex [$dataobj components] 0]
     713        if {![info exists obj2id_($dataobj-$comp)]} {
     714            set i [lsearch -exact $sendobjs_ $dataobj]
     715            if {$i < 0} {
     716                lappend sendobjs_ $dataobj
     717            }
     718        }
    726719    }
    727720    if {[llength $sendobjs_] > 0} {
    728         # Send off new data objects
    729         $_dispatcher event -idle !send_dataobjs
     721        # Send off new data objects
     722        $_dispatcher event -idle !send_dataobjs
    730723    } else {
    731         # Nothing to send -- activate the proper volume
    732         set first [lindex [get] 0]
    733         if {"" != $first} {
    734             set axis [$first hints updir]
    735             if {"" != $axis} {
    736                 _send "up $axis"
    737             }
    738         }
    739         foreach key [array names obj2id_ *-*] {
    740             set state [string match $first-* $key]
    741             _send "heightmap data visible $state $obj2id_($key)"
    742             if {[info exists obj2style_($key)]} {
    743                 _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
    744             }
    745         }
    746         $_dispatcher event -idle !legend
     724        # Nothing to send -- activate the proper volume
     725        set first [lindex [get] 0]
     726        if {"" != $first} {
     727            set axis [$first hints updir]
     728            if {"" != $axis} {
     729                _send "up $axis"
     730            }
     731        }
     732        foreach key [array names obj2id_ *-*] {
     733            set state [string match $first-* $key]
     734            _send "heightmap data visible $state $obj2id_($key)"
     735            if {[info exists obj2style_($key)]} {
     736                _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
     737            }
     738        }
     739        $_dispatcher event -idle !legend
    747740    }
    748741
     
    759752
    760753     if {"" == $itk_option(-plotoutline)} {
    761         _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
     754        _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
    762755     }
    763756    set settings_($this-theta) $view_(theta)
     
    784777itcl::body Rappture::HeightmapViewer::_zoom {option} {
    785778    switch -- $option {
    786         "in" {
    787             set view_(zoom) [expr {$view_(zoom)*1.25}]
     779        "in" {
     780            set view_(zoom) [expr {$view_(zoom)*1.25}]
    788781            set settings_($this-zoom) $view_(zoom)
    789         }
    790         "out" {
    791             set view_(zoom) [expr {$view_(zoom)*0.8}]
     782        }
     783        "out" {
     784            set view_(zoom) [expr {$view_(zoom)*0.8}]
    792785            set settings_($this-zoom) $view_(zoom)
    793         }
    794         "reset" {
    795             array set view_ {
    796                 theta   45
    797                 phi     45
    798                 psi     0
    799                 zoom    1.0
     786        }
     787        "reset" {
     788            array set view_ {
     789                theta   45
     790                phi     45
     791                psi     0
     792                zoom    1.0
    800793                pan-x   0
    801794                pan-y   0
    802             }
     795            }
    803796            set first [lindex [get] 0]
    804797            if { $first != "" } {
     
    808801                }
    809802            }
    810             set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
    811             _send "camera angle $xyz"
    812             _PanCamera
     803            set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
     804            _send "camera angle $xyz"
     805            _PanCamera
    813806            set settings_($this-theta) $view_(theta)
    814807            set settings_($this-phi) $view_(phi)
     
    817810            set settings_($this-pan-y) $view_(pan-y)
    818811            set settings_($this-zoom) $view_(zoom)
    819         }
     812        }
    820813    }
    821814    _send "camera zoom $view_(zoom)"
     
    842835        set settings_($this-pan-x) $view_(pan-x)
    843836        set settings_($this-pan-y) $view_(pan-y)
    844         return
     837        return
    845838    }
    846839    if { $option == "click" } {
    847         set click_(x) $x
    848         set click_(y) $y
    849         $itk_component(3dview) configure -cursor hand1
     840        set click_(x) $x
     841        set click_(y) $y
     842        $itk_component(3dview) configure -cursor hand1
    850843    }
    851844    if { $option == "drag" || $option == "release" } {
     
    861854    }
    862855    if { $option == "release" } {
    863         $itk_component(3dview) configure -cursor ""
     856        $itk_component(3dview) configure -cursor ""
    864857    }
    865858}
     
    881874itcl::body Rappture::HeightmapViewer::_rotate {option x y} {
    882875    switch -- $option {
    883         click {
    884             $itk_component(3dview) configure -cursor fleur
    885             array set click_ [subst {
    886                 x       $x
    887                 y       $y
    888                 theta   $view_(theta)
    889                 phi     $view_(phi)
    890             }]
    891         }
    892         drag {
    893             if {[array size click_] == 0} {
    894                 _rotate click $x $y
    895             } else {
    896                 set w [winfo width $itk_component(3dview)]
    897                 set h [winfo height $itk_component(3dview)]
    898                 if {$w <= 0 || $h <= 0} {
    899                     return
    900                 }
    901 
    902                 if {[catch {
    903                     # this fails sometimes for no apparent reason
    904                     set dx [expr {double($x-$click_(x))/$w}]
    905                     set dy [expr {double($y-$click_(y))/$h}]
    906                 }] != 0 } {
    907                     return
    908                 }
    909 
    910                 #
    911                 # Rotate the camera in 3D
    912                 #
    913                 if {$view_(psi) > 90 || $view_(psi) < -90} {
    914                     # when psi is flipped around, theta moves backwards
    915                     set dy [expr {-$dy}]
    916                 }
    917                 set theta [expr {$view_(theta) - $dy*180}]
    918                 while {$theta < 0} { set theta [expr {$theta+180}] }
    919                 while {$theta > 180} { set theta [expr {$theta-180}] }
    920 
    921                 if {abs($theta) >= 30 && abs($theta) <= 160} {
    922                     set phi [expr {$view_(phi) - $dx*360}]
    923                     while {$phi < 0} { set phi [expr {$phi+360}] }
    924                     while {$phi > 360} { set phi [expr {$phi-360}] }
    925                     set psi $view_(psi)
    926                 } else {
    927                     set phi $view_(phi)
    928                     set psi [expr {$view_(psi) - $dx*360}]
    929                     while {$psi < -180} { set psi [expr {$psi+360}] }
    930                     while {$psi > 180} { set psi [expr {$psi-360}] }
    931                 }
    932 
    933                 set view_(theta)        $theta
    934                 set view_(phi)          $phi
    935                 set view_(psi)          $psi
    936                 set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
     876        click {
     877            $itk_component(3dview) configure -cursor fleur
     878            array set click_ [subst {
     879                x       $x
     880                y       $y
     881                theta   $view_(theta)
     882                phi     $view_(phi)
     883            }]
     884        }
     885        drag {
     886            if {[array size click_] == 0} {
     887                _rotate click $x $y
     888            } else {
     889                set w [winfo width $itk_component(3dview)]
     890                set h [winfo height $itk_component(3dview)]
     891                if {$w <= 0 || $h <= 0} {
     892                    return
     893                }
     894
     895                if {[catch {
     896                    # this fails sometimes for no apparent reason
     897                    set dx [expr {double($x-$click_(x))/$w}]
     898                    set dy [expr {double($y-$click_(y))/$h}]
     899                }] != 0 } {
     900                    return
     901                }
     902
     903                #
     904                # Rotate the camera in 3D
     905                #
     906                if {$view_(psi) > 90 || $view_(psi) < -90} {
     907                    # when psi is flipped around, theta moves backwards
     908                    set dy [expr {-$dy}]
     909                }
     910                set theta [expr {$view_(theta) - $dy*180}]
     911                while {$theta < 0} { set theta [expr {$theta+180}] }
     912                while {$theta > 180} { set theta [expr {$theta-180}] }
     913
     914                if {abs($theta) >= 30 && abs($theta) <= 160} {
     915                    set phi [expr {$view_(phi) - $dx*360}]
     916                    while {$phi < 0} { set phi [expr {$phi+360}] }
     917                    while {$phi > 360} { set phi [expr {$phi-360}] }
     918                    set psi $view_(psi)
     919                } else {
     920                    set phi $view_(phi)
     921                    set psi [expr {$view_(psi) - $dx*360}]
     922                    while {$psi < -180} { set psi [expr {$psi+360}] }
     923                    while {$psi > 180} { set psi [expr {$psi-360}] }
     924                }
     925
     926                set view_(theta)        $theta
     927                set view_(phi)          $phi
     928                set view_(psi)          $psi
     929                set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
    937930                set settings_($this-theta) $view_(theta)
    938931                set settings_($this-phi) $view_(phi)
    939932                set settings_($this-psi) $view_(psi)
    940                 _send "camera angle $xyz"
    941                 set click_(x) $x
    942                 set click_(y) $y
    943             }
    944         }
    945         release {
    946             _rotate drag $x $y
    947             $itk_component(3dview) configure -cursor ""
    948             catch {unset click_}
    949         }
    950         default {
    951             error "bad option \"$option\": should be click, drag, release"
    952         }
     933                _send "camera angle $xyz"
     934                set click_(x) $x
     935                set click_(y) $y
     936            }
     937        }
     938        release {
     939            _rotate drag $x $y
     940            $itk_component(3dview) configure -cursor ""
     941            catch {unset click_}
     942        }
     943        default {
     944            error "bad option \"$option\": should be click, drag, release"
     945        }
    953946    }
    954947}
     
    963956itcl::body Rappture::HeightmapViewer::_state {comp} {
    964957    if {[$itk_component($comp) cget -relief] == "sunken"} {
    965         return "on"
     958        return "on"
    966959    }
    967960    return "off"
     
    977970itcl::body Rappture::HeightmapViewer::_fixSettings { what {value ""} } {
    978971    switch -- $what {
    979         "legend" {
     972        "legend" {
    980973            if { $settings_($this-legend) } {
    981974                pack $itk_component(legend) -side right -fill y
     
    983976                pack forget $itk_component(legend)
    984977            }
    985             set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
    986             set w [expr {[winfo height $itk_component(legend)] - 2*$lineht}]
    987             set h [expr {[winfo width $itk_component(legend)] - 16}]
    988             set imap ""
    989             set dataobj [lindex [get] 0]
    990             if {"" != $dataobj} {
    991                 set comp [lindex [$dataobj components] 0]
    992                 if {[info exists obj2id_($dataobj-$comp)]} {
    993                     set imap $obj2id_($dataobj-$comp)
    994                 }
    995             }
    996             if {$w > 0 && $h > 0 && "" != $imap} {
    997                 _send "heightmap legend $imap $w $h"
    998             } else {
    999                 $itk_component(legend) delete all
    1000             }
    1001         }
    1002         "grid" {
    1003             if { [IsConnected] } {
    1004                 _send "grid visible $settings_($this-grid)"
    1005             }
    1006         }
    1007         "axes" {
    1008             if { [IsConnected] } {
    1009                 _send "axis visible $settings_($this-axes)"
    1010             }
    1011         }
    1012         "wireframe" {
    1013             if { [IsConnected] } {
    1014                 _send "heightmap polygon $settings_($this-wireframe)"
    1015             }
    1016         }
    1017         "contourlines" {
    1018             if {[IsConnected]} {
    1019                 set dataobj [lindex [get] 0]
    1020                 if {"" != $dataobj} {
    1021                     set comp [lindex [$dataobj components] 0]
    1022                     if {[info exists obj2id_($dataobj-$comp)]} {
    1023                         set i $obj2id_($dataobj-$comp)
    1024                         set bool $settings_($this-contourlines)
    1025                         _send "heightmap linecontour visible $bool $i"
    1026                     }
    1027                 }
    1028             }
    1029         }
    1030         default {
    1031             error "don't know how to fix $what: should be grid, axes, contourlines, or legend"
    1032         }
     978            set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
     979            set w [expr {[winfo height $itk_component(legend)] - 2*$lineht}]
     980            set h [expr {[winfo width $itk_component(legend)] - 16}]
     981            set imap ""
     982            set dataobj [lindex [get] 0]
     983            if {"" != $dataobj} {
     984                set comp [lindex [$dataobj components] 0]
     985                if {[info exists obj2id_($dataobj-$comp)]} {
     986                    set imap $obj2id_($dataobj-$comp)
     987                }
     988            }
     989            if {$w > 0 && $h > 0 && "" != $imap} {
     990                _send "heightmap legend $imap $w $h"
     991            } else {
     992                $itk_component(legend) delete all
     993            }
     994        }
     995        "grid" {
     996            if { [IsConnected] } {
     997                _send "grid visible $settings_($this-grid)"
     998            }
     999        }
     1000        "axes" {
     1001            if { [IsConnected] } {
     1002                _send "axis visible $settings_($this-axes)"
     1003            }
     1004        }
     1005        "wireframe" {
     1006            if { [IsConnected] } {
     1007                _send "heightmap polygon $settings_($this-wireframe)"
     1008            }
     1009        }
     1010        "contourlines" {
     1011            if {[IsConnected]} {
     1012                set dataobj [lindex [get] 0]
     1013                if {"" != $dataobj} {
     1014                    set comp [lindex [$dataobj components] 0]
     1015                    if {[info exists obj2id_($dataobj-$comp)]} {
     1016                        set i $obj2id_($dataobj-$comp)
     1017                        set bool $settings_($this-contourlines)
     1018                        _send "heightmap linecontour visible $bool $i"
     1019                    }
     1020                }
     1021            }
     1022        }
     1023        default {
     1024            error "don't know how to fix $what: should be grid, axes, contourlines, or legend"
     1025        }
    10331026    }
    10341027}
     
    10431036itcl::body Rappture::HeightmapViewer::_getTransfuncData {dataobj comp} {
    10441037    array set style {
    1045         -color rainbow
    1046         -levels 6
    1047         -opacity 0.5
     1038        -color rainbow
     1039        -levels 6
     1040        -opacity 0.5
    10481041    }
    10491042    array set style [lindex [$dataobj components -style $comp] 0]
     
    10511044
    10521045    if {$style(-color) == "rainbow"} {
    1053         set style(-color) "white:yellow:green:cyan:blue:magenta"
     1046        set style(-color) "white:yellow:green:cyan:blue:magenta"
    10541047    }
    10551048    set clist [split $style(-color) :]
     
    10581051    set range [expr $limits_(vmax) - $limits_(vmin)]
    10591052    for {set i 0} {$i < [llength $clist]} {incr i} {
    1060         set xval [expr {double($i+1)/([llength $clist]+1)}]
    1061         set color [lindex $clist $i]
    1062         append cmap "$xval [Color2RGB $color] "
     1053        set xval [expr {double($i+1)/([llength $clist]+1)}]
     1054        set color [lindex $clist $i]
     1055        append cmap "$xval [Color2RGB $color] "
    10631056    }
    10641057    append cmap "1.0 [Color2RGB $color] "
     
    10681061    set wmap {}
    10691062    if {[string is int $levels]} {
    1070         lappend wmap 0.0 0.0
    1071         set delta [expr {0.125/($levels+1)}]
    1072         for {set i 1} {$i <= $levels} {incr i} {
    1073             # add spikes in the middle
    1074             set xval [expr {double($i)/($levels+1)}]
    1075             lappend wmap [expr {$xval-$delta-0.01}] 0.0
    1076             lappend wmap [expr {$xval-$delta}] $opacity
    1077             lappend wmap [expr {$xval+$delta}] $opacity
    1078             lappend wmap [expr {$xval+$delta+0.01}] 0.0
    1079         }
    1080         lappend wmap 1.0 0.0
     1063        lappend wmap 0.0 0.0
     1064        set delta [expr {0.125/($levels+1)}]
     1065        for {set i 1} {$i <= $levels} {incr i} {
     1066            # add spikes in the middle
     1067            set xval [expr {double($i)/($levels+1)}]
     1068            lappend wmap [expr {$xval-$delta-0.01}] 0.0
     1069            lappend wmap [expr {$xval-$delta}] $opacity
     1070            lappend wmap [expr {$xval+$delta}] $opacity
     1071            lappend wmap [expr {$xval+$delta+0.01}] 0.0
     1072        }
     1073        lappend wmap 1.0 0.0
    10811074    } else {
    1082         lappend wmap 0.0 0.0
    1083         set delta 0.05
    1084         foreach xval [split $levels ,] {
    1085             lappend wmap [expr {$xval-$delta}] 0.0
    1086             lappend $xval $opacity
    1087             lappend [expr {$xval+$delta}] 0.0
    1088         }
    1089         lappend wmap 1.0 0.0
     1075        lappend wmap 0.0 0.0
     1076        set delta 0.05
     1077        foreach xval [split $levels ,] {
     1078            lappend wmap [expr {$xval-$delta}] 0.0
     1079            lappend $xval $opacity
     1080            lappend [expr {$xval+$delta}] 0.0
     1081        }
     1082        lappend wmap 1.0 0.0
    10901083    }
    10911084    return [list $sname $cmap $wmap]
     
    11151108itcl::configbody Rappture::HeightmapViewer::plotoutline {
    11161109    if {[IsConnected]} {
    1117         _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
     1110        _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
    11181111    }
    11191112}
     
    11931186    label $inner.title -text "View Settings" -font "Arial 10 bold"
    11941187    checkbutton $inner.grid \
    1195         -text "grid" \
    1196         -variable [itcl::scope settings_($this-grid)] \
    1197         -command [itcl::code $this _fixSettings grid] \
     1188        -text "grid" \
     1189        -variable [itcl::scope settings_($this-grid)] \
     1190        -command [itcl::code $this _fixSettings grid] \
    11981191        -font "Arial 9"
    11991192    checkbutton $inner.axes \
    1200         -text "axes" \
    1201         -variable ::Rappture::HeightmapViewer::settings_($this-axes) \
    1202         -command [itcl::code $this _fixSettings axes] \
     1193        -text "axes" \
     1194        -variable ::Rappture::HeightmapViewer::settings_($this-axes) \
     1195        -command [itcl::code $this _fixSettings axes] \
    12031196        -font "Arial 9"
    12041197    checkbutton $inner.contourlines \
    1205         -text "contour lines" \
    1206         -variable ::Rappture::HeightmapViewer::settings_($this-contourlines) \
    1207         -command [itcl::code $this _fixSettings contourlines]\
     1198        -text "contour lines" \
     1199        -variable ::Rappture::HeightmapViewer::settings_($this-contourlines) \
     1200        -command [itcl::code $this _fixSettings contourlines]\
    12081201        -font "Arial 9"
    12091202    checkbutton $inner.wireframe \
    1210         -text "wireframe" \
     1203        -text "wireframe" \
    12111204        -onvalue "wireframe" -offvalue "fill" \
    1212         -variable ::Rappture::HeightmapViewer::settings_($this-wireframe) \
    1213         -command [itcl::code $this _fixSettings wireframe]\
     1205        -variable ::Rappture::HeightmapViewer::settings_($this-wireframe) \
     1206        -command [itcl::code $this _fixSettings wireframe]\
    12141207        -font "Arial 9"
    12151208    checkbutton $inner.legend \
    1216         -text "legend" \
    1217         -variable ::Rappture::HeightmapViewer::settings_($this-legend) \
    1218         -command [itcl::code $this _fixSettings legend]\
     1209        -text "legend" \
     1210        -variable ::Rappture::HeightmapViewer::settings_($this-legend) \
     1211        -command [itcl::code $this _fixSettings legend]\
    12191212        -font "Arial 9"
    12201213
Note: See TracChangeset for help on using the changeset viewer.