Changeset 1479 for trunk


Ignore:
Timestamp:
May 30, 2009, 9:24:42 PM (15 years ago)
Author:
gah
Message:
 
Location:
trunk/gui/scripts
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/flowvisviewer.tcl

    r1473 r1479  
    127127    private variable _allDataObjs
    128128    private variable _obj2ovride   ;# maps dataobj => style override
    129     private variable _obj2id       ;# maps dataobj-component to volume ID
     129    private variable _serverObjs   ;# maps dataobj-component to volume ID
    130130                                    # in the server
    131     private variable _id2obj       ;# maps dataobj => volume ID in server
    132131    private variable _sendobjs ""  ;# list of data objs to send to server
    133132    private variable _recvObjs  ;# list of data objs to send to server
    … …  
    222221        pan-y   0
    223222    }
    224     set _obj2id(count) 0
    225     set _id2obj(count) 0
    226223    set _limits(vmin) 0.0
    227224    set _limits(vmax) 1.0
    … …  
    659656        if { $pos >= 0 } {
    660657            foreach comp [$dataobj components] {
    661                 if { [info exists obj2id($dataobj-$comp)] } {
    662                     set ivol $_obj2id($dataobj-$comp)
    663                     array unset _limits $ivol-*
    664                 }
     658                array unset _limits $dataobj-$comp-*
    665659            }
    666660            set _dlist [lreplace $_dlist $pos $pos]
    667661            array unset _obj2ovride $dataobj-*
    668662            array unset _obj2flow $dataobj-*
    669             array unset _obj2id $dataobj-*
     663            array unset _serverObjs $dataobj-*
    670664            array unset _obj2style $dataobj-*
    671665            set changed 1
    … …  
    678672            set list {}
    679673            foreach {dataobj comp} $_style2objs($tf) break
    680             if { [info exists _obj2id($dataobj-$comp)] } {
     674            if { [info exists _serverObjs($dataobj-$comp)] } {
    681675                lappend list $dataobj $comp
    682676            }
    … …  
    856850    # disconnected -- no more data sitting on server
    857851    set _outbuf ""
    858     catch {unset _obj2id}
    859     array unset _id2obj
    860     set _obj2id(count) 0
    861     set _id2obj(count) 0
     852    array unset _serverObjs
    862853    set _sendobjs ""
    863854}
    … …  
    908899                }
    909900            }
    910             if { ![SendBytes $cmd] } {
     901            f { ![SendBytes $cmd] } {
    911902                    puts stderr "can't send"
    912903                return
    … …  
    916907                return
    917908            }
    918             set ivol $_obj2id(count)
    919             incr _obj2id(count)
    920 
    921909            NameTransferFunc $dataobj $comp
    922910            set _recvObjs($dataobj-$comp) 1
    … …  
    962950    }
    963951
    964     if 0 {
    965     SendCmd "volume state 0"
    966     set vols {}
    967     foreach key [array names _obj2id $_first-*] {
    968         lappend vols $_obj2id($key)
    969     }
    970     if { $vols != ""  && $_settings($this-volume) } {
    971         SendCmd "volume state 1 $vols"
    972     }
    973     # sync the state of slicers
    974     set vols [CurrentVolumeIds -cutplanes]
    975     foreach axis {x y z} {
    976         SendCmd "cutplane state $_settings($this-${axis}cutplane) $axis $vols"
    977         set pos [expr {0.01*$_settings($this-${axis}cutposition)}]
    978         SendCmd "cutplane position $pos $axis $vols"
    979     }
    980 
    981     # Add this when we fix grid for volumes
    982     SendCmd "volume axis label x \"\""
    983     SendCmd "volume axis label y \"\""
    984     SendCmd "volume axis label z \"\""
    985     SendCmd "grid axisname x X eV"
    986     SendCmd "grid axisname y Y eV"
    987     SendCmd "grid axisname z Z eV"
    988     }
    989952    SendCmd "flow reset"
    990953
    … …  
    1028991        }
    1029992    }
    1030     ResizeLegend
     993    EventuallyResizeLegend
    1031994}
    1032995
    … …  
    10711034#       "Rebuild", "add", etc.
    10721035#
    1073 itcl::body Rappture::FlowvisViewer::ReceiveLegend { tf vmin vmax size } {
     1036itcl::body Rappture::FlowvisViewer::ReceiveLegend { tag vmin vmax size } {
    10741037    if { ![isconnected] } {
    10751038        return
    10761039    }
     1040    puts stderr "receive legend $tag $vmin $vmax $size"
    10771041    set bytes [ReceiveBytes $size]
    10781042    $_image(legend) configure -data $bytes
    … …  
    10821046    set w [winfo width $c]
    10831047    set h [winfo height $c]
    1084     #foreach { dataobj comp } $_id2obj($ivol) break
    10851048    set lx 10
    10861049    set ly [expr {$h - 1}]
    … …  
    10971060    }
    10981061    # Display the markers used by the active transfer function.
    1099     #set tf $_activeTf
    1100 
     1062    set tf $_obj2style($tag)
    11011063    array set limits [limits $tf]
    1102     $c itemconfigure vmin -text [format %.2g $limits(min)]
     1064    $c itemconfigure vmin -text [format %.2g $limits(vmin)]
    11031065    $c coords vmin $lx $ly
    11041066
    1105     $c itemconfigure vmax -text [format %.2g $limits(max)]
     1067    $c itemconfigure vmax -text [format %.2g $limits(vmax)]
    11061068    $c coords vmax [expr {$w-$lx}] $ly
    11071069
    … …  
    11381100    }
    11391101    # Arguments from server are name value pairs. Stuff them in an array.
    1140     array set info $args
    1141 
    1142     set ivol $info(id);         # Id of volume created by server.
    1143     set tag $info(tag)
     1102    array set values $args
     1103    set tag $values(tag)
    11441104    set parts [split $tag -]
    1145 
    1146     #
    1147     # Volumes don't exist until we're told about them.
    1148     #
    1149     set _id2obj($ivol) $parts
    11501105    set dataobj [lindex $parts 0]
    1151     set _obj2id($tag) $ivol
    1152     # It's a lie. There's no volume yet.
    1153     if { $_settings($this-volume) && $dataobj == $_first } {
    1154         SendCmd "volume state 1"
    1155     }
    1156     set _limits($ivol-min) $info(min);  # Minimum value of the volume.
    1157     set _limits($ivol-max) $info(max);  # Maximum value of the volume.
    1158     set _limits(vmin)      $info(vmin); # Overall minimum value.
    1159     set _limits(vmax)      $info(vmax); # Overall maximum value.
    1160 
     1106    set _serverObjs($tag) 0
     1107    set _limits($tag-min)  $values(min);  # Minimum value of the volume.
     1108    set _limits($tag-max)  $values(max);  # Maximum value of the volume.
    11611109    unset _recvObjs($tag)
    11621110    if { [array size _recvObjs] == 0 } {
    … …  
    11831131    }
    11841132
     1133    if 0 {
    11851134    # in the midst of sending data? then bail out
    11861135    if {[llength $_sendobjs] > 0} {
    … …  
    11881137        return
    11891138    }
    1190 
     1139    }
    11911140    # Turn on buffering of commands to the server.  We don't want to
    11921141    # be preempted by a server disconnect/reconnect (which automatically
    … …  
    11981147    EventuallyResize $w $h
    11991148
    1200     # Find any new data that needs to be sent to the server.  Queue this up on
    1201     # the _sendobjs list, and send it out a little at a time.  Do this first,
    1202     # before we rebuild the rest.
    12031149    foreach dataobj [get] {
    1204         set comp [lindex [$dataobj components] 0]
    1205         if {![info exists _obj2id($dataobj-$comp)]} {
    1206             if { [lsearch -exact $_sendobjs $dataobj] < 0 } {
    1207                 lappend _sendobjs $dataobj
    1208             }
    1209         }
    1210     }
     1150        foreach comp [$dataobj components] {
     1151            # Send the data as one huge base64-encoded mess -- yuck!
     1152            set data [$dataobj blob $comp]
     1153            set nbytes [string length $data]
     1154            set extents [$dataobj extents $comp]
     1155            # I have a field. Is a vector field or a volume field?
     1156            if { $extents == 1 } {
     1157                set cmd "volume data follows $nbytes $dataobj-$comp\n"
     1158            } else {
     1159                set cmd [FlowCmd $dataobj $comp $nbytes $extents]
     1160                if { $cmd == "" } {
     1161                    puts stderr "no command"
     1162                    continue
     1163                }
     1164            }
     1165            append _outbuf $cmd
     1166            append _outbuf $data
     1167            NameTransferFunc $dataobj $comp
     1168            set _recvObjs($dataobj-$comp) 1
     1169        }
     1170    }
     1171    set _sendobjs ""
    12111172
    12121173    #
    12131174    # Reset the camera and other view parameters
    12141175    #
    1215     FixSettings light
    1216     FixSettings transp
    12171176    FixSettings isosurface
    12181177    FixSettings grid
    12191178    FixSettings axes
    1220     FixSettings outline
     1179    # nothing to send -- activate the proper ivol
     1180    set _first [lindex [get] 0]
     1181    if {"" != $_first} {
     1182        FixSettings light
     1183        FixSettings transp
     1184        FixSettings outline
     1185
     1186        set axis [$_first hints updir]
     1187        if {"" != $axis} {
     1188            SendCmd "up $axis"
     1189        }
     1190        set location [$_first hints camera]
     1191        if { $location != "" } {
     1192            array set _view $location
     1193        }
     1194    }
     1195    set _settings($this-theta) $_view(theta)
     1196    set _settings($this-phi)   $_view(phi)
     1197    set _settings($this-psi)   $_view(psi)
     1198    set _settings($this-pan-x) $_view(pan-x)
     1199    set _settings($this-pan-y) $_view(pan-y)
     1200    set _settings($this-zoom)  $_view(zoom)
     1201
     1202    set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
     1203    SendCmd "camera angle $xyz"
     1204    PanCamera
     1205    SendCmd "camera zoom $_view(zoom)"
     1206
     1207    foreach dataobj [get] {
     1208        foreach comp [$dataobj components] {
     1209            NameTransferFunc $dataobj $comp
     1210        }
     1211    }
     1212
     1213    if {[llength $_sendobjs] > 0} {
     1214        # send off new data objects
     1215        $_dispatcher event -idle !send_dataobjs
     1216        puts stderr "more sendobjs "
     1217        return
     1218    }
     1219
    12211220    # nothing to send -- activate the proper ivol
    12221221    set _first [lindex [get] 0]
    … …  
    12301229            array set _view $location
    12311230        }
    1232     }
    1233     set _settings($this-theta) $_view(theta)
    1234     set _settings($this-phi)   $_view(phi)
    1235     set _settings($this-psi)   $_view(psi)
    1236     set _settings($this-pan-x) $_view(pan-x)
    1237     set _settings($this-pan-y) $_view(pan-y)
    1238     set _settings($this-zoom)  $_view(zoom)
    1239 
    1240     set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
    1241     SendCmd "camera angle $xyz"
    1242     PanCamera
    1243     SendCmd "camera zoom $_view(zoom)"
    1244 
    1245     if {[llength $_sendobjs] > 0} {
    1246         # send off new data objects
    1247         $_dispatcher event -idle !send_dataobjs
    1248         puts stderr "more sendobjs "
    1249         return
    1250     }
    1251 
    1252     # nothing to send -- activate the proper ivol
    1253     set _first [lindex [get] 0]
    1254     if {"" != $_first} {
    1255         set axis [$_first hints updir]
    1256         if {"" != $axis} {
    1257             SendCmd "up $axis"
    1258         }
    1259         set location [$_first hints camera]
    1260         if { $location != "" } {
    1261             array set _view $location
    1262         }
    1263         if { 0 && $_settings($this-volume) }  {
    1264             SendCmd "volume state 0"
    1265             foreach key [array names _obj2id $_first-*] {
    1266                 lappend vols $_obj2id($key)
    1267             }
    1268             SendCmd "volume state 1 $vols"
    1269         }
    1270         #
    1271         # The _obj2id and _id2style arrays may or may not have the right
    1272         # information.  It's possible for the server to know about volumes
    1273         # that the client has assumed it's deleted.  We could add checks.
    1274         # But this problem needs to be fixed not bandaided.
    12751231        set comp [lindex [$_first components] 0]
    1276         set ivol $_obj2id($_first-$comp)
    1277 
    1278     }
    1279     foreach dataobj [get] {
    1280         foreach comp [$_first components] {
    1281             NameTransferFunc $dataobj $comp
    1282         }
    1283     }
     1232        set _activeTf [lindex $_obj2style($_first-$comp) 0]
     1233    }
     1234
    12841235
    12851236    # sync the state of slicers
    … …  
    12911242    }
    12921243    SendCmd "volume data state $_settings($this-volume)"
    1293     $_dispatcher event -idle !legend
     1244    EventuallyResizeLegend
    12941245
    12951246    # Actually write the commands to the server socket.  If it fails, we don't
    12961247    # care.  We're finished here.
     1248    blt::busy hold $itk_component(hull); update idletasks
    12971249    SendBytes $_outbuf;                 
     1250    blt::busy release $itk_component(hull)
    12981251    set _buffering 0;                   # Turn off buffering.
    12991252    set _outbuf "";                     # Clear the buffer.             
    … …  
    13091262# ----------------------------------------------------------------------
    13101263itcl::body Rappture::FlowvisViewer::CurrentVolumeIds {{what -all}} {
    1311     set rlist ""
     1264    return ""
    13121265    if { $_first == "" } {
    13131266        return
    13141267    }
    1315     foreach key [array names _obj2id *-*] {
     1268    foreach key [array names _serverObjs *-*] {
    13161269        if {[string match $_first-* $key]} {
    13171270            array set style {
    … …  
    13201273            foreach {dataobj comp} [split $key -] break
    13211274            array set style [lindex [$dataobj components -style $comp] 0]
    1322 
    13231275            if {$what != "-cutplanes" || $style(-cutplanes)} {
    1324                 lappend rlist $_obj2id($key)
     1276                lappend rlist $_serverObjs($key)
    13251277            }
    13261278        }
    … …  
    16191571        light {
    16201572            if {[isconnected]} {
    1621                 set val $_settings($this-light)
    1622                 set sval [expr {0.1*$val}]
    1623                 SendCmd "volume shading diffuse $sval"
    1624                 set sval [expr {sqrt($val+1.0)}]
    1625                 SendCmd "volume shading specular $sval"
     1573                set comp [lindex [$_first components] 0]
     1574                set tag $_first-$comp
     1575                set diffuse [expr {0.1*$_settings($this-light)}]
     1576                set specular [expr {sqrt($_settings($this-light)+1.0)}]
     1577                SendCmd "$tag configure -diffuse $diffuse -specular $specular"
    16261578            }
    16271579        }
    16281580        transp {
    16291581            if {[isconnected]} {
    1630                 set val $_settings($this-transp)
    1631                 set sval [expr {0.2*$val+1}]
    1632                 SendCmd "volume shading opacity $sval"
     1582                set comp [lindex [$_first components] 0]
     1583                set tag $_first-$comp
     1584                set opacity [expr {0.2*$_settings($this-transp)+1}]
     1585                SendCmd "$tag configure -opacity $opacity"
    16331586            }
    16341587        }
    16351588        opacity {
    16361589            if {[isconnected] && $_activeTf != "" } {
    1637                 set val $_settings($this-opacity)
    1638                 set sval [expr { 0.01 * double($val) }]
     1590                set opacity [expr { 0.01 * double($_settings($this-opacity)) }]
    16391591                set tf $_activeTf
    1640                 set _settings($this-$tf-opacity) $sval
     1592                set _settings($this-$tf-opacity) $opacity
    16411593                updatetransferfuncs
    16421594            }
    … …  
    16551607        "outline" {
    16561608            if {[isconnected]} {
    1657                 SendCmd "volume outline state $_settings($this-outline)"
     1609                set comp [lindex [$_first components] 0]
     1610                set tag $_first-$comp
     1611                SendCmd "$tag configure -outline $_settings($this-outline)"
    16581612            }
    16591613        }
    … …  
    16851639        "volume" {
    16861640            if { [isconnected] } {
    1687                 set vols [CurrentVolumeIds -cutplanes]
    1688                 SendCmd "volume data state $_settings($this-volume) $vols"
     1641                set comp [lindex [$_first components] 0]
     1642                set tag $_first-$comp
     1643                SendCmd "$tag configure -volume $_settings($this-volume)"
    16891644            }
    16901645        }
    … …  
    17181673# ----------------------------------------------------------------------
    17191674itcl::body Rappture::FlowvisViewer::ResizeLegend {} {
     1675    puts stderr "ResizeLegend"
    17201676    set _resizeLegendPending 0
    17211677    set lineht [font metrics $itk_option(-font) -linespace]
    17221678    set w [expr {$_width-20}]
    17231679    set h [expr {[winfo height $itk_component(legend)]-20-$lineht}]
     1680
     1681    if { $_first == "" } {
     1682        return
     1683    }
     1684    set comp [lindex [$_first components] 0]
     1685    set tag $_first-$comp
     1686    #set _activeTf [lindex $_obj2style($tag) 0]
    17241687    if {$w > 0 && $h > 0 && "" != $_activeTf} {
    1725         SendCmd "legend $_activeTf $w $h"
     1688        #SendCmd "legend $_activeTf $w $h"
     1689        SendCmd "$tag legend $w $h"
    17261690    } else {
    17271691    # Can't do this as this will remove the items associated with the
    … …  
    17551719    array set style [lindex [$dataobj components -style $comp] 0]
    17561720    set tf "$style(-color):$style(-levels):$style(-opacity)"
    1757     lappend _obj2style($dataobj-$comp) $tf
     1721    set _obj2style($dataobj-$comp) $tf
    17581722    lappend _style2objs($tf) $dataobj $comp
    17591723    return $tf
    … …  
    18071771        set style(-color) "white:yellow:green:cyan:blue:magenta"
    18081772    }
    1809     set clist [split $style(-color) :]
    1810     set cmap "0.0 [Color2RGB white] "
    1811     for {set i 0} {$i < [llength $clist]} {incr i} {
    1812         set x [expr {double($i+1)/([llength $clist]+1)}]
    1813         set color [lindex $clist $i]
    1814         append cmap "$x [Color2RGB $color] "
    1815     }
    1816     append cmap "1.0 [Color2RGB $color]"
    1817 
     1773    if { [info exists style(-nonuniformcolors)] } {
     1774        foreach { value color } $style(-nonuniformcolors) {
     1775            append cmap "$value [Color2RGB $color] "
     1776        }
     1777    } else {
     1778        set clist [split $style(-color) :]
     1779        set cmap "0.0 [Color2RGB white] "
     1780        for {set i 0} {$i < [llength $clist]} {incr i} {
     1781            set x [expr {double($i+1)/([llength $clist]+1)}]
     1782            set color [lindex $clist $i]
     1783            append cmap "$x [Color2RGB $color] "
     1784        }
     1785        append cmap "1.0 [Color2RGB $color]"
     1786    }
    18181787    set tag $this-$tf
    18191788    if { ![info exists _settings($tag-opacity)] } {
    … …  
    18741843        lappend wmap 1.0 0.0
    18751844    }
    1876     SendBytes "transfunc define $tf { $cmap } { $wmap }\n"
    1877     return [SendBytes "$dataobj-$comp configure -transferfunction $tf\n"]
     1845    SendCmd "transfunc define $tf { $cmap } { $wmap }\n"
     1846    return [SendCmd "$dataobj-$comp configure -transferfunction $tf\n"]
    18781847}
    18791848
    … …  
    19781947# ----------------------------------------------------------------------
    19791948itcl::body Rappture::FlowvisViewer::updatetransferfuncs {} {
    1980     $_dispatcher event -idle !send_transfunc
     1949    $_dispatcher event -after 100 !send_transfunc
    19811950}
    19821951
    … …  
    20362005
    20372006itcl::body Rappture::FlowvisViewer::limits { tf } {
    2038     set _limits(min) 0.0
    2039     set _limits(max) 1.0
     2007    set _limits(vmin) 0.0
     2008    set _limits(vmax) 1.0
    20402009    if { ![info exists _style2objs($tf)] } {
     2010        puts stderr "no style2objs for $tf tf=($tf)"
    20412011        return [array get _limits]
    20422012    }
    20432013    set min ""; set max ""
    20442014    foreach {dataobj comp} $_style2objs($tf) {
    2045         if { ![info exists _obj2id($dataobj-$comp)] } {
     2015        set tag $dataobj-$comp
     2016        if { ![info exists _serverObjs($tag)] } {
     2017            puts stderr "$tag not in serverObjs?"
    20462018            continue
    20472019        }
    2048         set ivol $_obj2id($dataobj-$comp)
    2049         if { ![info exists _limits($ivol-min)] } {
     2020        if { ![info exists _limits($tag-min)] } {
     2021            puts stderr "$tag no min?"
    20502022            continue
    20512023        }
    2052         if { $min == "" || $min > $_limits($ivol-min) } {
    2053             set min $_limits($ivol-min)
    2054         }
    2055         if { $max == "" || $max < $_limits($ivol-max) } {
    2056             set max $_limits($ivol-max)
     2024        if { $min == "" || $min > $_limits($tag-min) } {
     2025            set min $_limits($tag-min)
     2026        }
     2027        if { $max == "" || $max < $_limits($tag-max) } {
     2028            set max $_limits($tag-max)
    20572029        }
    20582030    }
    20592031    if { $min != "" } {
    2060         set _limits(min) $min
     2032        set _limits(vmin) $min
    20612033    }
    20622034    if { $max != "" } {
    2063         set _limits(max) $max
     2035        set _limits(vmax) $max
    20642036    }
    20652037    return [array get _limits]
    … …  
    25022474itcl::body Rappture::FlowvisViewer::EventuallyResizeLegend {} {
    25032475    if { !$_resizeLegendPending } {
    2504         $_dispatcher event -idle !legend
     2476        puts stderr "in EventuallyResizeLegend"
     2477        $_dispatcher event -after 100 !legend
    25052478        set _resizeLegendPending 1
    25062479    }

  • trunk/gui/scripts/isomarker.tcl

    r1436 r1479  
    102102        if { $x == "-get" } {
    103103            array set limits [$nvobj_ limits $tf_]
    104             if { $limits(max) == $limits(min) } {
    105                 if { $limits(max) == 0.0 } {
    106                     set limits(min) 0.0
    107                     set limits(max) 1.0
     104            if { $limits(vmax) == $limits(vmin) } {
     105                if { $limits(vmax) == 0.0 } {
     106                    set limits(vmin) 0.0
     107                    set limits(vmax) 1.0
    108108                } else {
    109                     set limits(max) [expr $limits(min) + 1.0]
     109                    set limits(vmax) [expr $limits(vmin) + 1.0]
    110110                }
    111111            }
    112             return [expr {($value_-$limits(min))/($limits(max) - $limits(min))}]
     112            return [expr {($value_-$limits(vmin))/
     113                          ($limits(vmax) - $limits(vmin))}]
    113114        }
    114115        array set limits [$nvobj_ limits $tf_]
    115         if { $limits(max) == $limits(min) } {
     116        if { $limits(vmax) == $limits(vmin) } {
    116117            set limits(min) 0.0
    117118            set limits(max) 1.0
    118119        }
    119         set r [expr $limits(max) - $limits(min)]
    120         absval [expr {($x * $r) + $limits(min)}]
     120        set r [expr $limits(vmax) - $limits(vmin)]
     121        absval [expr {($x * $r) + $limits(vmin)}]
    121122    }
    122123    private method HandleEvent { option args } {
Note: See TracChangeset for help on using the changeset viewer.