Changeset 2297 for branches/blt4


Ignore:
Timestamp:
Jul 8, 2011, 2:17:46 PM (13 years ago)
Author:
gah
Message:

fix for vector interface changes

Location:
branches/blt4/gui/scripts
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • branches/blt4/gui/scripts/curve.tcl

    r1786 r2297  
    139139    }
    140140
    141     blt::vector create tmp zero
     141    blt::vector create tmp
     142    blt::vector create zero
    142143    foreach comp [array names _comp2xy] {
    143144        set vname [lindex $_comp2xy($comp) $pos]

  • branches/blt4/gui/scripts/field.tcl

    r2173 r2297  
    267267    set max ""
    268268
    269     blt::vector create tmp zero
     269    blt::vector create tmp
     270    blt::vector create zero
    270271    foreach comp [array names _comp2dims] {
    271272        switch -- $_comp2dims($comp) {

  • branches/blt4/gui/scripts/histogram.tcl

    r2173 r2297  
    2525
    2626    public method components {{pattern *}}
    27     public method locations {}
    28     public method heights {}
    29     public method widths {}
     27    public method mesh { component }
     28    public method values { component }
     29    public method widths { component }
     30    public method xlabels { component }
    3031    public method limits {which}
    3132    public method xmarkers {}
    … …  
    3334    public method hints {{key ""}}
    3435
    35     protected method _build {}
     36    protected method Build {}
     37    private method Clear {}
     38    private method ParseData { comp }
    3639
    3740    private variable _xmlobj ""  ;# ref to lib obj with histogram data
    3841    private variable _hist ""    ;# lib obj representing this histogram
    39     private variable _widths ""  ;# vector of bin widths (may be empty string).
    40     private variable _heights ""  ;# vector of bin heights along y-axis.
    41     private variable _locations "" ;# vector of bin locations along x-axis.
    42 
     42    private variable _widths     ;# array of vectors of bin widths
     43    private variable _yvalues    ;# array of vectors of bin heights along
     44                                 ;# y-axis.
     45    private variable _xvalues    ;# array of vectors of bin locations along
     46                                 ;# x-axis.
     47    private variable _xlabels    ;# array of labels
    4348    private variable _hints      ;# cache of hints stored in XML
    4449    private variable _xmarkers "";# list of {x,label,options} triplets.
    4550    private variable _ymarkers "";# list of {y,label,options} triplets.
    4651    private common _counter 0    ;# counter for unique vector names
     52    private variable _comp2hist  ;# maps component name => x,y,w,l vectors
    4753}
    4854
    … …  
    5864
    5965    # build up vectors for various components of the histogram
    60     _build
     66    Build
    6167}
    6268
    … …  
    6571# ----------------------------------------------------------------------
    6672itcl::body Rappture::Histogram::destructor {} {
     73    # don't destroy the _xmlobj! we don't own it!
    6774    itcl::delete object $_hist
    68     # don't destroy the _xmlobj! we don't own it!
    69     if {"" != $_widths} {
    70         blt::vector destroy $_widths
    71     }
    72     if {"" != $_heights} {
    73         blt::vector destroy $_heights
    74     }
    75     if {"" != $_locations} {
    76         blt::vector destroy $_locations
    77     }
    78 }
    79 
    80 # ----------------------------------------------------------------------
    81 # USAGE: locations
     75    Clear
     76}
     77
     78# ----------------------------------------------------------------------
     79# USAGE: mesh
    8280#
    8381# Returns the vector for the histogram bin locations along the
    8482# x-axis.
    8583# ----------------------------------------------------------------------
    86 itcl::body Rappture::Histogram::locations {} {
    87     return $_locations
     84itcl::body Rappture::Histogram::mesh { comp } {
     85    if { [info exists _xvalues($comp)] } {
     86        return $_xvalues($comp)
     87    }
     88    return ""
    8889}
    8990
    … …  
    9394# Returns the vector for the histogram bin heights along the y-axis.
    9495# ----------------------------------------------------------------------
    95 itcl::body Rappture::Histogram::heights {} {
    96     return $_heights
     96itcl::body Rappture::Histogram::values { comp } {
     97    if { [info exists _yvalues($comp)] } {
     98        return $_yvalues($comp)
     99    }
     100    return ""
    97101}
    98102
    … …  
    104108# overall histogram (sum of all components).
    105109# ----------------------------------------------------------------------
    106 itcl::body Rappture::Histogram::widths {} {
    107     return $_widths
     110itcl::body Rappture::Histogram::widths { comp } {
     111    if { [info exists _widths($comp)] } {
     112        return $_widths($comp)
     113    }
     114    return ""
     115}
     116
     117# ----------------------------------------------------------------------
     118# USAGE: xlabels
     119#
     120# Returns the vector for the specified histogram component <name>.
     121# If the name is not specified, then it returns the vectors for the
     122# overall histogram (sum of all components).
     123# ----------------------------------------------------------------------
     124itcl::body Rappture::Histogram::xlabels { comp } {
     125    if { [info exists _xlabels($comp)] } {
     126        return $_xlabels($comp)
     127    }
     128    return ""
    108129}
    109130
    … …  
    116137itcl::body Rappture::Histogram::xmarkers {} {
    117138    return $_xmarkers;
     139}
     140
     141# ----------------------------------------------------------------------
     142# USAGE: components ?<pattern>?
     143#
     144# Returns a list of names for the various components of this curve.
     145# If the optional glob-style <pattern> is specified, then it returns
     146# only the component names matching the pattern.
     147# ----------------------------------------------------------------------
     148itcl::body Rappture::Histogram::components {{pattern *}} {
     149    set rlist ""
     150    foreach name [array names _comp2hist] {
     151        if {[string match $pattern $name]} {
     152            lappend rlist $name
     153        }
     154    }
     155    return $rlist
    118156}
    119157
    … …  
    140178    set max ""
    141179    switch -- $which {
    142         x - xlin {
    143             set vname $_locations;
    144             set log 0;
    145             set axis xaxis
    146         }
    147         xlog {
    148             set vname $_locations;
    149             set log 1;
    150             set axis xaxis
    151         }
    152         y - ylin {
    153             set vname $_heights;
    154             set log 0;
    155             set axis yaxis
    156         }
    157         ylog {
    158             set vname $_heights;
    159             set log 1;
    160             set axis yaxis
    161         }
     180        x - xlin { set pos 0; set log 0; set axis xaxis }
     181        xlog { set pos 0; set log 1; set axis xaxis }
     182        y - ylin - v - vlin { set pos 1; set log 0; set axis yaxis }
     183        ylog - vlog { set pos 1; set log 1; set axis yaxis }
    162184        default {
    163             error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog"
    164         }
    165     }
    166     if {"" == $vname} {
    167         return {0 1}
    168     }
    169     $vname dup tmp
    170     $vname dup zero
    171     if {$log} {
    172         # on a log scale, use abs value and ignore 0's
    173         zero expr {tmp == 0}            ;# find the 0's
    174         tmp expr {abs(tmp)}             ;# get the abs value
    175         tmp expr {tmp + zero*max(tmp)}  ;# replace 0's with abs max
    176         set vmin [blt::vector expr min(tmp)]
    177         set vmax [blt::vector expr max(tmp)]
    178     } else {
    179         set vmin [blt::vector expr min($vname)]
    180         set vmax [blt::vector expr max($vname)]
    181     }
    182    
    183     if {"" == $min} {
    184         set min $vmin
    185     } elseif {$vmin < $min} {
    186         set min $vmin
    187     }
    188     if {"" == $max} {
    189         set max $vmax
    190     } elseif {$vmax > $max} {
    191         set max $vmax
     185            error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog"
     186        }
     187    }
     188
     189    blt::vector create tmp
     190    blt::vector create zero
     191    foreach comp [array names _comphist] {
     192        set vname [lindex $_comp2hist($comp) $pos]
     193        $vname variable vec
     194
     195        if {$log} {
     196            # on a log scale, use abs value and ignore 0's
     197            $vname dup tmp
     198            $vname dup zero
     199            zero expr {tmp == 0}            ;# find the 0's
     200            tmp expr {abs(tmp)}             ;# get the abs value
     201            tmp expr {tmp + zero*max(tmp)}  ;# replace 0's with abs max
     202            set vmin [blt::vector expr min(tmp)]
     203            set vmax [blt::vector expr max(tmp)]
     204        } else {
     205            set vmin $vec(min)
     206            set vmax $vec(max)
     207        }
     208
     209        if {"" == $min} {
     210            set min $vmin
     211        } elseif {$vmin < $min} {
     212            set min $vmin
     213        }
     214        if {"" == $max} {
     215            set max $vmax
     216        } elseif {$vmax > $max} {
     217            set max $vmax
     218        }
    192219    }
    193220    blt::vector destroy tmp zero
    … …  
    208235        }
    209236    }
    210 
    211237    return [list $min $max]
    212238}
    … …  
    271297
    272298# ----------------------------------------------------------------------
    273 # USAGE: _build
     299# USAGE: Build
    274300#
    275301# Used internally to build up the vector representation for the
    … …  
    278304# from scratch.
    279305# ----------------------------------------------------------------------
    280 itcl::body Rappture::Histogram::_build {} {
     306itcl::body Rappture::Histogram::Build {} {
    281307    # discard any existing data
    282     if { $_locations != "" } {
    283         blt::vector destroy $_locations
    284         set _locations ""
    285     }
    286     if { $_widths != "" } {
    287         blt::vector destroy $_widths
    288         set _widths ""
    289     }
    290     if { $_heights != "" } {
    291         blt::vector destroy $_heights
    292         set _heights ""
    293     }
    294 
     308    Clear
    295309    #
    296310    # Scan through the components of the histogram and create
    … …  
    299313    # enhancements require more than one component.
    300314    #
    301     set xhwdata [$_hist get component.xhw]
    302     if {"" != $xhwdata} {
    303         set _widths [blt::vector create \#auto]
    304         set _heights [blt::vector create \#auto]
    305         set _locations [blt::vector create \#auto]
    306 
    307         foreach line [split $xhwdata \n] {
    308             set n [scan $line {%s %s %s} x h w]
    309             if { $n == 2 } {
    310                 $_locations append $x
    311                 $_heights append $h
    312             } elseif { $n == 3 } {
    313                 $_locations append $x
    314                 $_heights append $h
    315                 $_widths append $w
    316             }
    317         }
    318         # FIXME:  There must be a width specified for each bin location.
    319         #         If this isn't true, we default to uniform widths
    320         #         (zero-length _widths vector == uniform).
    321         if { [$_locations length] != [$_widths length] } {
    322             $_widths set {}
    323         }
     315    foreach cname [$_hist children -type component] {
     316        ParseData $cname
    324317    }
    325318    # Creates lists of x and y marker data.
    … …  
    341334    }
    342335}
     336
     337itcl::body Rappture::Histogram::ParseData { comp } {
     338    # Create new vectors or discard any existing data
     339    set _xvalues($comp) [blt::vector create \#auto]
     340    set _yvalues($comp) [blt::vector create \#auto]
     341    set _widths($comp) [blt::vector create \#auto]
     342    set _xlabels($comp) {}
     343
     344    set xydata [$_hist get ${comp}.xy]
     345    if { $xydata != "" } {
     346        set tmp [blt::vector create \#auto]
     347        $tmp set $xydata
     348        $tmp split $_xvalues($comp) $_yvalues($comp)
     349        blt::vector destroy $tmp
     350        $_widths($comp) set {}
     351        set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)]
     352        return
     353    }
     354    set xhwdata [$_hist get ${comp}.xhw]
     355    if { $xhwdata != "" } {
     356        foreach line [split $xhwdata \n] {
     357            set n [scan $line {%s %s %s} x h w]
     358            if { $n == 2 } {
     359                $_xvalues($comp) append $x
     360                $_yvalues($comp) append $h
     361            } elseif { $n == 3 } {
     362                $_xvalues($comp) append $x
     363                $_yvalues($comp) append $h
     364                $_widths($comp) append $w
     365            }
     366        }
     367        # FIXME:  There must be a width specified for each bin location.
     368        #         If this isn't true, we default to uniform widths
     369        #         (zero-length _widths vector == uniform).
     370        if { [$_xvalues($comp) length] != [$_widths($comp) length] } {
     371            $_widths($comp) set {}
     372        }
     373        set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)]
     374        return
     375    }
     376    set nvdata [$_hist get ${comp}.namevalue]
     377    if { $nvdata != "" } {
     378        set count 0
     379        foreach line [split $nvdata \n] {
     380            foreach {name value} $line break
     381            $_yvalues($comp) append $value
     382            $_xvalues($comp) append $count
     383            lappend _xlabels($comp) $name
     384            incr count
     385        }           
     386        set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)]
     387        return
     388    }
     389    set xv [$_hist get $comp.xvector]
     390    set yv [$_hist get $comp.yvector]
     391    if { $xv != "" && $yv != "" } {
     392        $_yvalues($comp) set $yv
     393        $_xvalues($comp) set $xv
     394    }
     395    set _comp2hist($comp) [list $xv $yv]
     396}
     397
     398itcl::body Rappture::Histogram::Clear {} {
     399    foreach name [array names _widths] {
     400        blt::vector destroy $_widths($name)
     401    }
     402    array unset _widths
     403    foreach name [array names _yvalues] {
     404        blt::vector destroy $_yvalues($name)
     405    }
     406    array unset _yvalues
     407    foreach name [array names _xvalues] {
     408        blt::vector destroy $_xvalues($name)
     409    }
     410    array unset _xvalues
     411    array unset _xlabels
     412    array unset _comp2hist
     413}
     414

  • branches/blt4/gui/scripts/histogramresult.tcl

    r2295 r2297  
    1818option add *HistogramResult*Element.borderWidth 1 widgetDefault
    1919option add *HistogramResult*Element.relief solid widgetDefault
    20 option add *HistogramResult*x.loose 1 widgetDefault
    21 option add *HistogramResult*y.loose 1 widgetDefault
     20option add *HistogramResult*x.loose 0 widgetDefault
     21option add *HistogramResult*y.loose 0 widgetDefault
    2222option add *HistogramResult*Element.relief solid widgetDefault
    2323option add *HistogramResult*Element.borderWidth 1 widgetDefault
    2424# Don't let the step size default to 1.0 (for barcharts)
    25 option add *HistogramResult*x.stepSize 0.0 widgetDefault
     25option add *HistogramResult*x.stepSize 1.0 widgetDefault
    2626
    2727option add *HistogramResult.width 3i widgetDefault
    … …  
    112112    protected method _enterMarker { g name x y text }
    113113    protected method _leaveMarker { g name }
     114    protected method FormatLabels { g value }
    114115
    115116    private variable _dispatcher "" ;# dispatcher for !events
    … …  
    130131    common _downloadPopup          ;# download options from popup
    131132    private variable _markers
     133    private variable _xlabels
    132134}
    133135                                                                               
    … …  
    362364itcl::body Rappture::HistogramResult::get {} {
    363365    # put the dataobj list in order according to -raise options
    364     set clist $_dlist
    365     foreach obj $clist {
     366    set bottom {}
     367    set top {}
     368    foreach obj $_dlist {
    366369        if {[info exists _dataobj2raise($obj)] && $_dataobj2raise($obj)} {
    367             set i [lsearch -exact $clist $obj]
    368             if {$i >= 0} {
    369                 set clist [lreplace $clist $i $i]
    370                 lappend clist $obj
    371             }
    372         }
    373     }
    374     return $clist
     370            lappend top $obj
     371        } else {
     372            lappend bottom $obj
     373        }
     374    }
     375    set _dlist [concat $bottom $top]
     376    return $_dlist
    375377}
    376378
    … …  
    647649        }
    648650    }
    649    
     651    $g axis configure x
    650652    #
    651653    # All of the extra axes get mapped to the x2/y2 (top/right)
    … …  
    683685            [list ::Rappture::Tooltip::tooltip cancel]
    684686    }
    685    
     687    set invert 0
     688    array unset _xlabels
    686689    #
    687690    # Plot all of the dataobjs.
    … …  
    691694        set label [$dataobj hints label]
    692695        foreach {mapx mapy} [_getAxes $dataobj] break
    693        
    694         set xv [$dataobj locations]
    695         set yv [$dataobj heights]
    696         set zv [$dataobj widths]
    697         if {$xv eq "" || $yv eq "" || $zv eq ""} {
    698             continue
    699         }
    700        
    701         if {[info exists _dataobj2color($dataobj)]} {
    702             set color $_dataobj2color($dataobj)
    703         } else {
    704             set color [$dataobj hints color]
    705             if {"" == $color} {
    706                 set color black
    707             }
    708         }
    709        
    710         if {[info exists _dataobj2width($dataobj)]} {
    711             set lwidth $_dataobj2width($dataobj)
    712         } else {
    713             set lwidth 2
    714         }
    715        
    716         if {[info exists _dataobj2dashes($dataobj)]} {
    717             set dashes $_dataobj2dashes($dataobj)
    718         } else {
    719             set dashes ""
    720         }
    721         if {([$xv length] <= 1) || ($lwidth == 0)} {
    722             set sym square
    723             set pixels 2
    724         } else {
    725             set sym ""
    726             set pixels 6
    727         }
    728         # Compute default bar width for histogram elements.
    729         if { [$zv length] == [$xv length] } {
    730             foreach x [$xv values] y [$yv values] z [$zv values] {
    731                 set elem "elem[incr count]"
    732                 set _elem2dataobj($elem) $dataobj
    733                 $g element create $elem -x $x -y $y -barwidth $z \
     696        foreach comp [$dataobj components] {
     697            set xv [$dataobj mesh $comp]
     698            set yv [$dataobj values $comp]
     699            set zv [$dataobj widths $comp]
     700            if {$xv eq "" || $yv eq "" || $zv eq ""} {
     701                continue
     702            }
     703            if {[info exists _dataobj2color($dataobj)]} {
     704                set color $_dataobj2color($dataobj)
     705            } else {
     706                set color [$dataobj hints color]
     707                if {"" == $color} {
     708                    set color black
     709                }
     710            }
     711            if {[info exists _dataobj2width($dataobj)]} {
     712                set lwidth $_dataobj2width($dataobj)
     713            } else {
     714                set lwidth 2
     715            }
     716            if {[info exists _dataobj2dashes($dataobj)]} {
     717                set dashes $_dataobj2dashes($dataobj)
     718            } else {
     719                set dashes ""
     720            }
     721            if {([$xv length] <= 1) || ($lwidth == 0)} {
     722                set sym square
     723                set pixels 2
     724            } else {
     725                set sym ""
     726                set pixels 6
     727            }
     728            # Compute default bar width for histogram elements.
     729            if { [$zv length] == [$xv length] } {
     730                foreach x [$xv values] y [$yv values] z [$zv values] {
     731                    set elem "elem[incr count]"
     732                    set _elem2dataobj($elem) $dataobj
     733                    $g element create $elem -x $x -y $y -barwidth $z \
     734                        -label $label -foreground $color \
     735                        -mapx $mapx -mapy $mapy
     736                }
     737            } else {
     738                set r [blt::vector expr {max($xv) - min($xv)}]
     739                set z [expr {$r / ([$xv length]-1) * 0.8}]
     740                set elem "elem[incr count]"
     741                set _elem2dataobj($elem) $dataobj
     742                $g element create $elem -x $xv -y $yv -barwidth $z \
    734743                    -label $label -foreground $color \
    735744                    -mapx $mapx -mapy $mapy
    736             }
    737         } else {
    738             set r [blt::vector expr {max($xv) - min($xv)}]
    739             set z [expr {$r / ([$xv length]-1) * 0.8}]
    740             set elem "elem[incr count]"
    741             set _elem2dataobj($elem) $dataobj
    742             $g element create $elem -x $xv -y $yv -barwidth $z \
    743                     -label $label -foreground $color \
    744                     -mapx $mapx -mapy $mapy
    745         }
     745            }
     746            set index 0
     747            foreach label [$dataobj xlabels $comp] {
     748                if  { [string length $label] > 3 } {
     749                    set invert 1
     750                }
     751                set _xlabels($index) $label
     752                incr index
     753            }
     754        }
    746755    }
    747756    foreach dataobj $_dlist {
    748         set xmin -Inf
    749         set ymin -Inf
    750         set xmax Inf
    751         set ymax Inf
    752         #
    753         # Create text/line markers for each *axis.marker specified.
     757        set xmin -Inf
     758        set ymin -Inf
     759        set xmax Inf
     760        set ymax Inf
     761        #
     762        # Create text/line markers for each *axis.marker specified.
    754763        #
    755764        foreach m [$dataobj xmarkers] {
    … …  
    794803        }
    795804    }
     805    if { [array size _xlabels] > 0 } {
     806        set command [itcl::code $this FormatLabels]
     807    } else {
     808        set command ""
     809    }
     810    $g axis configure x -command $command
     811    $g configure -invertxy $invert
    796812    $itk_component(legend) reset
    797813}
    … …  
    805821itcl::body Rappture::HistogramResult::_resetLimits {} {
    806822    set g $itk_component(plot)
    807 
    808823    #
    809824    # HACK ALERT!
    … …  
    16081623    return $img
    16091624}
     1625
     1626itcl::body Rappture::HistogramResult::FormatLabels { w value } {
     1627    # Determine the element name from the value
     1628    set index [expr round($value)]
     1629    if { [info exists _xlabels($index)] } {
     1630        return $_xlabels($index)
     1631    }
     1632    puts stderr "value=$value index=$index"
     1633    parray _xlabels
     1634    return $value
     1635}
Note: See TracChangeset for help on using the changeset viewer.