Changeset 2388 for trunk/gui


Ignore:
Timestamp:
Aug 16, 2011, 3:41:57 PM (13 years ago)
Author:
gah
Message:
 
Location:
trunk/gui/scripts
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/histogram.tcl

    r1929 r2388  
    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 { {comp ""} }
     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
     337#
     338# ParseData --
     339#
     340#       Parse the components data representations.  The following
     341#       elements may be used <xy>, <xhw>, <namevalue>, <xvector>,
     342#       <yvector>.  Only one element is used for data. 
     343#
     344itcl::body Rappture::Histogram::ParseData { comp } {
     345    # Create new vectors or discard any existing data
     346    set _xvalues($comp) [blt::vector create \#auto]
     347    set _yvalues($comp) [blt::vector create \#auto]
     348    set _widths($comp) [blt::vector create \#auto]
     349    set _xlabels($comp) {}
     350
     351    set xydata [$_hist get ${comp}.xy]
     352    if { $xydata != "" } {
     353        set count 0
     354        foreach line [split $xydata \n] {
     355            foreach {name value} $line break
     356            $_yvalues($comp) append $value
     357            $_xvalues($comp) append $count
     358            lappend _xlabels($comp) $name
     359            incr count
     360        }           
     361        set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)]
     362        return
     363    }
     364    set xhwdata [$_hist get ${comp}.xhw]
     365    if { $xhwdata != "" } {
     366        set count 0
     367        foreach line [split $xhwdata \n] {
     368            set n [scan $line {%s %s %s} name h w]
     369            lappend _xlabels($comp) $name
     370            $_xvalues($comp) append $count
     371            $_yvalues($comp) append $h
     372            if { $n == 3 } {
     373                $_widths($comp) append $w
     374            }
     375            incr count
     376        }           
     377        set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)]
     378        return
     379
     380        # FIXME:  There must be a width specified for each bin location.
     381        #         If this isn't true, we default to uniform widths
     382        #         (zero-length _widths vector == uniform).
     383        if { [$_xvalues($comp) length] != [$_widths($comp) length] } {
     384            $_widths($comp) set {}
     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) seq 0 [$yv length]
     394        set _xlabels($comp)
     395    }
     396    set _comp2hist($comp) [list $_xvalues($comp) $_yvalues($comp)]
     397}
     398
     399itcl::body Rappture::Histogram::Clear { {comp ""} } {
     400    if { $comp == "" } {
     401        foreach name [array names _widths] {
     402            blt::vector destroy $_widths($name)
     403        }
     404        array unset _widths
     405        foreach name [array names _yvalues] {
     406            blt::vector destroy $_yvalues($name)
     407        }
     408        array unset _yvalues
     409        foreach name [array names _xvalues] {
     410            blt::vector destroy $_xvalues($name)
     411        }
     412        array unset _xvalues
     413        array unset _xlabels
     414        array unset _comp2hist
     415        return
     416    }
     417    if { [info exists _widths($comp)] } {
     418        blt::vector destroy $_widths($comp)
     419    }
     420    if { [info exists _yvalues($comp)] } {
     421        blt::vector destroy $_yvalues($comp)
     422    }
     423    if { [info exists _xvalues($comp)] } {
     424        blt::vector destroy $_xvalues($comp)
     425    }
     426    array unset _xvalues $comp
     427    array unset _yvalues $comp
     428    array unset _widths $comp
     429    array unset _xlabels $comp
     430    array unset _comp2hist $comp
     431}
     432

  • trunk/gui/scripts/histogramresult.tcl

    r2255 r2388  
    1818option add *HistogramResult*Element.borderWidth 1 widgetDefault
    1919option add *HistogramResult*Element.relief solid widgetDefault
    20 option add *HistogramResult*x.loose 1 widgetDefault
     20option add *HistogramResult*x.loose 0 widgetDefault
    2121option add *HistogramResult*y.loose 1 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
     26option add *HistogramResult*x.subdivisions 0 widgetDefault
    2627
    2728option add *HistogramResult.width 3i widgetDefault
    2829option add *HistogramResult.height 3i widgetDefault
    2930option add *HistogramResult.gridColor #d9d9d9 widgetDefault
    30 option add *HistogramResult.activeColor blue widgetDefault
     31option add *HistogramResult.activeColor blue2 widgetDefault
    3132option add *HistogramResult.dimColor gray widgetDefault
    3233option add *HistogramResult.controlBackground gray widgetDefault
    3334option add *HistogramResult.font \
    3435    -*-helvetica-medium-r-normal-*-12-* widgetDefault
    35 
    36 option add *HistogramResult.autoColors {
    37     #0000ff #ff0000 #00cc00
    38     #cc00cc #ff9900 #cccc00
    39     #000080 #800000 #006600
    40     #660066 #996600 #666600
    41 }
    42 set autocolors {
    43 #0000cd
    44 #cd0000
    45 #00cd00
    46 #3a5fcd
    47 #cdcd00
    48 #cd1076
    49 #009acd
    50 #00c5cd
    51 #a2b5cd
    52 #7ac5cd
    53 #66cdaa
    54 #a2cd5a
    55 #cd9b9b
    56 #cdba96
    57 #cd3333
    58 #cd6600
    59 #cd8c95
    60 #cd00cd
    61 #9a32cd
    62 #6ca6cd
    63 #9ac0cd
    64 #9bcd9b
    65 #00cd66
    66 #cdc673
    67 #cdad00
    68 #cd5555
    69 #cd853f
    70 #cd7054
    71 #cd5b45
    72 #cd6889
    73 #cd69c9
    74 #551a8b
    75 }
    76 
    77 option add *HistogramResult.autoColors $autocolors widgetDefault
    7836option add *HistogramResult*Balloon*Entry.background white widgetDefault
     37
     38option add *HistogramResult*autoColors {
     39    #3a5fcd
     40    #cdcd00
     41    #cd1076
     42    #0000cd
     43    #cd0000
     44    #00cd00
     45    #009acd
     46    #00c5cd
     47    #a2b5cd
     48    #7ac5cd
     49    #66cdaa
     50    #a2cd5a
     51    #cd9b9b
     52    #cdba96
     53    #cd3333
     54    #cd6600
     55    #cd8c95
     56    #cd00cd
     57    #9a32cd
     58    #6ca6cd
     59    #9ac0cd
     60    #9bcd9b
     61    #00cd66
     62    #cdc673
     63    #cdad00
     64    #cd5555
     65    #cd853f
     66    #cd7054
     67    #cd5b45
     68    #cd6889
     69    #cd69c9
     70    #551a8b
     71} widgetDefault
    7972
    8073itcl::class Rappture::HistogramResult {
    … …  
    10194    public method download {option args}
    10295
    103     protected method _rebuild {}
    104     protected method _resetLimits {}
    105     protected method _zoom {option args}
    106     protected method _hilite {state x y}
    107     protected method _axis {option args}
    108     protected method _getAxes {dataobj}
    109     protected method _getLineMarkerOptions { style }
    110     protected method _getTextMarkerOptions { style }
    111     protected method _enterMarker { g name x y text }
    112     protected method _leaveMarker { g name }
     96    protected method Rebuild {}
     97    protected method ResetLimits {}
     98    protected method Zoom {option args}
     99    protected method Hilite {state x y}
     100    protected method Axis {option args}
     101    protected method GetAxes {dataobj}
     102    protected method GetLineMarkerOptions { style }
     103    protected method GetTextMarkerOptions { style }
     104    protected method EnterMarker { g name x y text }
     105    protected method LeaveMarker { g name }
     106    protected method FormatLabels { g value }
    113107
    114108    private variable _dispatcher "" ;# dispatcher for !events
    … …  
    129123    common _downloadPopup          ;# download options from popup
    130124    private variable _markers
     125    private variable _xlabels
    131126}
    132127                                                                               
    … …  
    141136    Rappture::dispatcher _dispatcher
    142137    $_dispatcher register !rebuild
    143     $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
     138    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
    144139
    145140    array set _downloadPopup {
    … …  
    160155            -highlightthickness 0 \
    161156            -image [Rappture::icon reset-view] \
    162             -command [itcl::code $this _zoom reset]
     157            -command [itcl::code $this Zoom reset]
    163158    } {
    164159        usual
    … …  
    183178    # Add bindings so you can mouse over points to see values:
    184179    #
    185     bind $itk_component(plot) <Motion> \
    186         [itcl::code $this _hilite at %x %y]
    187     bind $itk_component(plot) <Leave> \
    188         [itcl::code $this _hilite off %x %y]
     180    $itk_component(plot) element bind all <Enter> \
     181        [itcl::code $this Hilite at %x %y]
     182    $itk_component(plot) element bind all <Motion> \
     183        [itcl::code $this Hilite at %x %y]
     184    $itk_component(plot) element bind all <Leave> \
     185        [itcl::code $this Hilite off %x %y]
    189186
    190187    # Add support for editing axes:
    … …  
    237234        set _axisPopup(format-$axis) "%.6g"
    238235    }
    239     _axis scale x linear
    240     _axis scale y linear
     236    Axis scale x linear
     237    Axis scale y linear
    241238
    242239    $itk_component(plot) legend configure -hide yes
    … …  
    357354itcl::body Rappture::HistogramResult::get {} {
    358355    # put the dataobj list in order according to -raise options
    359     set clist $_dlist
    360     foreach obj $clist {
     356    set bottom {}
     357    set top {}
     358    foreach obj $_dlist {
    361359        if {[info exists _dataobj2raise($obj)] && $_dataobj2raise($obj)} {
    362             set i [lsearch -exact $clist $obj]
    363             if {$i >= 0} {
    364                 set clist [lreplace $clist $i $i]
    365                 lappend clist $obj
    366             }
    367         }
    368     }
    369     return $clist
     360            lappend top $obj
     361        } else {
     362            lappend bottom $obj
     363        }
     364    }
     365    set _dlist [concat $bottom $top]
     366    return $_dlist
    370367}
    371368
    … …  
    424421    lappend allx x  ;# fix main x-axis too
    425422    foreach axis $allx {
    426         _axis scale $axis linear
     423        Axis scale $axis linear
    427424    }
    428425
    … …  
    430427    lappend ally y  ;# fix main y-axis too
    431428    foreach axis $ally {
    432         _axis scale $axis linear
     429        Axis scale $axis linear
    433430    }
    434431
    … …  
    436433    foreach dataobj $args {
    437434        # find the axes for this dataobj (e.g., {x y2})
    438         foreach {map(x) map(y)} [_getAxes $dataobj] break
     435        foreach {map(x) map(y)} [GetAxes $dataobj] break
    439436
    440437        foreach axis {x y} {
    … …  
    460457
    461458            if {[$dataobj hints ${axis}scale] == "log"} {
    462                 _axis scale $map($axis) log
    463             }
    464         }
    465     }
    466     _resetLimits
     459                Axis scale $map($axis) log
     460            }
     461        }
     462    }
     463    ResetLimits
    467464}
    468465
    … …  
    590587
    591588# ----------------------------------------------------------------------
    592 # USAGE: _rebuild
     589# USAGE: Rebuild
    593590#
    594591# Called automatically whenever something changes that affects the
    … …  
    596593# widget to display new data.
    597594# ----------------------------------------------------------------------
    598 itcl::body Rappture::HistogramResult::_rebuild {} {
     595itcl::body Rappture::HistogramResult::Rebuild {} {
    599596    set g $itk_component(plot)
    600597
    … …  
    664661    foreach axis $all {
    665662        set _axisPopup(format-$axis) "%.6g"
    666        
    667663        $g axis bind $axis <Enter> \
    668             [itcl::code $this _axis hilite $axis on]
     664            [itcl::code $this Axis hilite $axis on]
    669665        $g axis bind $axis <Leave> \
    670             [itcl::code $this _axis hilite $axis off]
     666            [itcl::code $this Axis hilite $axis off]
    671667        $g axis bind $axis <ButtonPress-1> \
    672             [itcl::code $this _axis click $axis %x %y]
     668            [itcl::code $this Axis click $axis %x %y]
    673669        $g axis bind $axis <B1-Motion> \
    674             [itcl::code $this _axis drag $axis %x %y]
     670            [itcl::code $this Axis drag $axis %x %y]
    675671        $g axis bind $axis <ButtonRelease-1> \
    676             [itcl::code $this _axis release $axis %x %y]
     672            [itcl::code $this Axis release $axis %x %y]
    677673        $g axis bind $axis <KeyPress> \
    678674            [list ::Rappture::Tooltip::tooltip cancel]
    679675    }
    680 
     676    set invert 0
     677    array unset _xlabels
    681678    #
    682679    # Plot all of the dataobjs.
    … …  
    685682    foreach dataobj $_dlist {
    686683        set label [$dataobj hints label]
    687         foreach {mapx mapy} [_getAxes $dataobj] break
    688        
    689         set xv [$dataobj locations]
    690         set yv [$dataobj heights]
    691         set zv [$dataobj widths]
    692         if {$xv eq "" || $yv eq "" || $zv eq ""} {
    693             continue
    694         }
    695        
    696         if {[info exists _dataobj2color($dataobj)]} {
    697             set color $_dataobj2color($dataobj)
    698         } else {
    699             set color [$dataobj hints color]
    700             if {"" == $color} {
    701                 set color black
    702             }
    703         }
    704        
    705         if {[info exists _dataobj2width($dataobj)]} {
    706             set lwidth $_dataobj2width($dataobj)
    707         } else {
    708             set lwidth 2
    709         }
    710        
    711         if {[info exists _dataobj2dashes($dataobj)]} {
    712             set dashes $_dataobj2dashes($dataobj)
    713         } else {
    714             set dashes ""
    715         }
    716         if {([$xv length] <= 1) || ($lwidth == 0)} {
    717             set sym square
    718             set pixels 2
    719         } else {
    720             set sym ""
    721             set pixels 6
    722         }
    723         # Compute default bar width for histogram elements.
    724         if { [$zv length] == [$xv length] } {
    725             foreach x [$xv range 0 end] \
    726                     y [$yv range 0 end] \
    727                     z [$zv range 0 end] {
    728                 set elem "elem[incr count]"
    729                 set _elem2dataobj($elem) $dataobj
    730                 $g element create $elem -x $x -y $y -barwidth $z \
     684        foreach {mapx mapy} [GetAxes $dataobj] break
     685        foreach comp [$dataobj components] {
     686            set xv [$dataobj mesh $comp]
     687            set yv [$dataobj values $comp]
     688            set zv [$dataobj widths $comp]
     689            if {$xv eq "" || $yv eq "" || $zv eq ""} {
     690                continue
     691            }
     692            if {[info exists _dataobj2color($dataobj)]} {
     693                set color $_dataobj2color($dataobj)
     694            } else {
     695                set color [$dataobj hints color]
     696                if {"" == $color} {
     697                    set color black
     698                }
     699            }
     700            if {[info exists _dataobj2width($dataobj)]} {
     701                set lwidth $_dataobj2width($dataobj)
     702            } else {
     703                set lwidth 2
     704            }
     705            if {[info exists _dataobj2dashes($dataobj)]} {
     706                set dashes $_dataobj2dashes($dataobj)
     707            } else {
     708                set dashes ""
     709            }
     710            if {([$xv length] <= 1) || ($lwidth == 0)} {
     711                set sym square
     712                set pixels 2
     713            } else {
     714                set sym ""
     715                set pixels 6
     716            }
     717            # Compute default bar width for histogram elements.
     718            if { [$zv length] == [$xv length] } {
     719                foreach x [$xv values] y [$yv values] z [$zv values] {
     720                    set elem "elem[incr count]"
     721                    set _elem2dataobj($elem) $dataobj
     722                    $g element create $elem -x $x -y $y -barwidth $z \
     723                        -label $label -foreground $color \
     724                        -mapx $mapx -mapy $mapy
     725                }
     726            } else {
     727                set r [blt::vector expr {max($xv) - min($xv)}]
     728                set z [expr {$r / ([$xv length]-1) * 0.8}]
     729                set elem "elem[incr count]"
     730                set _elem2dataobj($elem) $dataobj
     731                $g element create $elem -x $xv -y $yv -barwidth $z \
    731732                    -label $label -foreground $color \
    732733                    -mapx $mapx -mapy $mapy
    733             }
    734         } else {
    735             set r [blt::vector expr {max($xv) - min($xv)}]
    736             set z [expr {$r / ([$xv length]-1) * 0.8}]
    737             set elem "elem[incr count]"
    738             set _elem2dataobj($elem) $dataobj
    739             $g element create $elem -x $xv -y $yv -barwidth $z \
    740                     -label $label -foreground $color \
    741                     -mapx $mapx -mapy $mapy
    742         }
     734            }
     735            set index 0
     736            foreach label [$dataobj xlabels $comp] {
     737                if  { [string length $label] > 3 } {
     738                    set invert 1
     739                }
     740                set _xlabels($index) $label
     741                incr index
     742            }
     743        }
    743744    }
    744745    foreach dataobj $_dlist {
    745         set xmin -Inf
    746         set ymin -Inf
    747         set xmax Inf
    748         set ymax Inf
    749         #
    750         # Create text/line markers for each *axis.marker specified.
     746        set xmin -Inf
     747        set ymin -Inf
     748        set xmax Inf
     749        set ymax Inf
     750        #
     751        # Create text/line markers for each *axis.marker specified.
    751752        #
    752753        foreach m [$dataobj xmarkers] {
    … …  
    754755            set id [$g marker create line -coords [list $at $ymin $at $ymax]]
    755756            $g marker bind $id <Enter> \
    756                 [itcl::code $this _enterMarker $g x-$label $at $ymin $at]
     757                [itcl::code $this EnterMarker $g x-$label $at $ymin $at]
    757758            $g marker bind $id <Leave> \
    758                 [itcl::code $this _leaveMarker $g x-$label]
    759             set options [_getLineMarkerOptions $style]
     759                [itcl::code $this LeaveMarker $g x-$label]
     760            set options [GetLineMarkerOptions $style]
    760761            if { $options != "" } {
    761762                eval $g marker configure $id $options
    … …  
    764765                set id [$g marker create text -anchor nw \
    765766                            -text $label -coords [list $at $ymax]]
    766                 set options [_getTextMarkerOptions $style]
     767                set options [GetTextMarkerOptions $style]
    767768                if { $options != "" } {
    768769                    eval $g marker configure $id $options
    … …  
    774775            set id [$g marker create line -coords [list $xmin $at $xmax $at]]
    775776            $g marker bind $id <Enter> \
    776                 [itcl::code $this _enterMarker $g y-$label $at $xmin $at]
     777                [itcl::code $this EnterMarker $g y-$label $at $xmin $at]
    777778            $g marker bind $id <Leave> \
    778                 [itcl::code $this _leaveMarker $g y-$label]
    779             set options [_getLineMarkerOptions $style]
     779                [itcl::code $this LeaveMarker $g y-$label]
     780            set options [GetLineMarkerOptions $style]
    780781            if { $options != "" } {
    781782                eval $g marker configure $id $options
    … …  
    784785                set id [$g marker create text -anchor se \
    785786                        -text $label -coords [list $xmax $at]]
    786                 set options [_getTextMarkerOptions $style]
     787                set options [GetTextMarkerOptions $style]
    787788                if { $options != "" } {
    788789                    eval $g marker configure $id $options
    … …  
    791792        }
    792793    }
     794    if { [array size _xlabels] > 0 } {
     795        set command [itcl::code $this FormatLabels]
     796    } else {
     797        set command ""
     798    }
     799    $g axis configure x -command $command
     800    $g configure -invertxy $invert
    793801    $itk_component(legend) reset
    794802}
    795803
    796804# ----------------------------------------------------------------------
    797 # USAGE: _resetLimits
     805# USAGE: ResetLimits
    798806#
    799807# Used internally to apply automatic limits to the axes for the
    800808# current plot.
    801809# ----------------------------------------------------------------------
    802 itcl::body Rappture::HistogramResult::_resetLimits {} {
     810itcl::body Rappture::HistogramResult::ResetLimits {} {
    803811    set g $itk_component(plot)
    804812
    … …  
    870878
    871879# ----------------------------------------------------------------------
    872 # USAGE: _zoom reset
     880# USAGE: Zoom reset
    873881#
    874882# Called automatically when the user clicks on one of the zoom
    875883# controls for this widget.  Changes the zoom for the current view.
    876884# ----------------------------------------------------------------------
    877 itcl::body Rappture::HistogramResult::_zoom {option args} {
     885itcl::body Rappture::HistogramResult::Zoom {option args} {
    878886    switch -- $option {
    879887        reset {
    880             _resetLimits
    881         }
    882     }
    883 }
    884 
    885 # ----------------------------------------------------------------------
    886 # USAGE: _hilite <state> <x> <y>
     888            ResetLimits
     889        }
     890    }
     891}
     892
     893# ----------------------------------------------------------------------
     894# USAGE: Hilite <state> <x> <y>
    887895#
    888896# Called automatically when the user brushes one of the elements
    … …  
    890898# pop up with element info.
    891899# ----------------------------------------------------------------------
    892 itcl::body Rappture::HistogramResult::_hilite {state x y} {
     900itcl::body Rappture::HistogramResult::Hilite {state x y} {
    893901    set g $itk_component(plot)
    894902    set elem ""
    … …  
    900908    }
    901909    set tip ""
     910    set index ""
    902911    if {$state == "at"} {
    903         set bool [$g element closest $x $y info -interpolate yes]
     912        set bool [$g element closest $x $y info -along y -halo 1]
     913        # Must be in the element.
    904914        if { $bool } {
    905915            # for dealing with xy line plots
    … …  
    911921            set mapy [$g element cget $elem -mapy]
    912922            if {[info exists _elem2dataobj($elem)]} {
    913                 foreach {mapx mapy} [_getAxes $_elem2dataobj($elem)] break
     923                foreach {mapx mapy} [GetAxes $_elem2dataobj($elem)] break
    914924            }
    915925
    916926            # search again for an exact point -- this time don't interpolate
    917927            set tip ""
    918             array unset info
    919             set bool [$g element closest $x $y info -interpolate no]
    920             if { $bool && $info(name) == $elem} {
     928            if { $info(name) == $elem} {
    921929                set x [$g axis transform $mapx $info(x)]
    922930                set y [$g axis transform $mapy $info(y)]
    923 
     931                if { [$g cget -invertxy] } {
     932                    set tmp $x
     933                    set x $y
     934                    set y $tmp
     935                }
    924936                 if {[info exists _elem2dataobj($elem)]} {
    925937                    set dataobj $_elem2dataobj($elem)
    … …  
    931943                }
    932944                set tip [$g element cget $elem -label]
    933                 set yval [_axis format y dummy $info(y)]
     945                set yval [Axis format y dummy $info(y)]
    934946                append tip "\n$yval$yunits"
    935                 set xval [_axis format x dummy $info(x)]
     947                set xval [Axis format x dummy $info(x)]
    936948                append tip " @ $xval$xunits"
    937949                set tip [string trim $tip]
     950                set index $info(index)
    938951            }
    939952            set state 1
    940953        } else {
    941             set bool [$g element closest $x $y info -interpolate no]
     954            set bool [$g element closest $x $y info -interpolate no -along y]
    942955            if { $bool } {
    943956                # for dealing with xy scatter plot
    … …  
    948961                set mapy [$g element cget $elem -mapy]
    949962                if {[info exists _elem2dataobj($elem)]} {
    950                     foreach {mapx mapy} [_getAxes $_elem2dataobj($elem)] break
     963                    foreach {mapx mapy} [GetAxes $_elem2dataobj($elem)] break
    951964                }
    952965                set tip ""
    953966                set x [$g axis transform $mapx $info(x)]
    954967                set y [$g axis transform $mapy $info(y)]
    955                
     968                if { [$g cget -invertxy] } {
     969                    set tmp $x
     970                    set x $y
     971                    set y $tmp
     972                }
    956973               if {[info exists _elem2dataobj($elem)]} {
    957974                    set dataobj $_elem2dataobj($elem)
    … …  
    963980                }
    964981                set tip [$g element cget $elem -label]
    965                 set yval [_axis format y dummy $info(y)]
     982                set yval [Axis format y dummy $info(y)]
    966983                append tip "\n$yval$yunits"
    967                 set xval [_axis format x dummy $info(x)]
     984                set xval [Axis format x dummy $info(x)]
    968985                append tip " @ $xval$xunits"
    969986                set tip [string trim $tip]
     987                set index $info(index)
    970988                set state 1
    971989            } else {
    … …  
    9871005            Rappture::Tooltip::tooltip cancel
    9881006        }
    989         $g element activate $elem
     1007        if { $index != "" } {
     1008            $g element activate $elem $index
     1009            set _hilite(index) $index
     1010        }
    9901011        set _hilite(elem) $elem
    9911012
    … …  
    9931014        set mapy [$g element cget $elem -mapy]
    9941015        if {[info exists _elem2dataobj($elem)]} {
    995             foreach {mapx mapy} [_getAxes $_elem2dataobj($elem)] break
     1016            foreach {mapx mapy} [GetAxes $_elem2dataobj($elem)] break
    9961017        }
    9971018        set allx [$g x2axis use]
    … …  
    10291050                    set tipx "-0"
    10301051                } else {
    1031                     set tipx "-[expr {$x-4}]"  ;# move tooltip to the left
     1052                    set tipx "-[expr {$x-20}]"  ;# move tooltip to the left
    10321053                }
    10331054            } else {
    … …  
    10351056                    set tipx "+0"
    10361057                } else {
    1037                     set tipx "+[expr {$x+4}]"  ;# move tooltip to the right
     1058                    set tipx "+[expr {$x+20}]"  ;# move tooltip to the right
    10381059                }
    10391060            }
    … …  
    10421063                    set tipy "-0"
    10431064                } else {
    1044                     set tipy "-[expr {$y-4}]"  ;# move tooltip to the top
     1065                    set tipy "-[expr {$y-20}]"  ;# move tooltip to the top
    10451066                }
    10461067            } else {
    … …  
    10481069                    set tipy "+0"
    10491070                } else {
    1050                     set tipy "+[expr {$y+4}]"  ;# move tooltip to the bottom
     1071                    set tipy "+[expr {$y+20}]"  ;# move tooltip to the bottom
    10511072                }
    10521073            }
    … …  
    10951116
    10961117# ----------------------------------------------------------------------
    1097 # USAGE: _axis hilite <axis> <state>
     1118# USAGE: Axis hilite <axis> <state>
    10981119#
    1099 # USAGE: _axis click <axis> <x> <y>
    1100 # USAGE: _axis drag <axis> <x> <y>
    1101 # USAGE: _axis release <axis> <x> <y>
     1120# USAGE: Axis click <axis> <x> <y>
     1121# USAGE: Axis drag <axis> <x> <y>
     1122# USAGE: Axis release <axis> <x> <y>
    11021123#
    1103 # USAGE: _axis edit <axis>
    1104 # USAGE: _axis changed <axis> <what>
    1105 # USAGE: _axis format <axis> <widget> <value>
    1106 # USAGE: _axis scale <axis> linear|log
     1124# USAGE: Axis edit <axis>
     1125# USAGE: Axis changed <axis> <what>
     1126# USAGE: Axis format <axis> <widget> <value>
     1127# USAGE: Axis scale <axis> linear|log
    11071128#
    11081129# Used internally to handle editing of the x/y axes.  The hilite
    … …  
    11111132# changes from the panel.
    11121133# ----------------------------------------------------------------------
    1113 itcl::body Rappture::HistogramResult::_axis {option args} {
     1134itcl::body Rappture::HistogramResult::Axis {option args} {
    11141135    set inner [$itk_component(hull).axes component inner]
    11151136
    … …  
    11171138        hilite {
    11181139            if {[llength $args] != 2} {
    1119                 error "wrong # args: should be \"_axis hilite axis state\""
     1140                error "wrong # args: should be \"Axis hilite axis state\""
    11201141            }
    11211142            set g $itk_component(plot)
    … …  
    11271148                    -color $itk_option(-activecolor) \
    11281149                    -titlecolor $itk_option(-activecolor)
    1129 
    11301150                set x [expr {[winfo pointerx $g]+4}]
    11311151                set y [expr {[winfo pointery $g]+4}]
    … …  
    11401160        click {
    11411161            if {[llength $args] != 3} {
    1142                 error "wrong # args: should be \"_axis click axis x y\""
    1143             }
    1144             set axis [lindex $args 0]
    1145             set x [lindex $args 1]
    1146             set y [lindex $args 2]
     1162                error "wrong # args: should be \"Axis click axis x y\""
     1163            }
     1164            foreach { axis x y } $args break
    11471165            set g $itk_component(plot)
     1166            if { [$g cget -invertxy] } {
     1167                set tmp $x
     1168                set x $y
     1169                set y $tmp
     1170            }
    11481171
    11491172            set _axis(moved) 0
    … …  
    11571180        drag {
    11581181            if {[llength $args] != 3} {
    1159                 error "wrong # args: should be \"_axis drag axis x y\""
     1182                error "wrong # args: should be \"Axis drag axis x y\""
    11601183            }
    11611184            if {![info exists _axis(moved)]} {
    11621185                return  ;# must have skipped click event -- ignore
    11631186            }
    1164             set axis [lindex $args 0]
    1165             set x [lindex $args 1]
    1166             set y [lindex $args 2]
     1187            foreach { axis x y } $args break
    11671188            set g $itk_component(plot)
     1189            if { [$g cget -invertxy] } {
     1190                set tmp $x
     1191                set x $y
     1192                set y $tmp
     1193            }
    11681194
    11691195            if {[info exists _axis(click-x)] && [info exists _axis(click-y)]} {
    … …  
    12151241        release {
    12161242            if {[llength $args] != 3} {
    1217                 error "wrong # args: should be \"_axis release axis x y\""
     1243                error "wrong # args: should be \"Axis release axis x y\""
    12181244            }
    12191245            if {![info exists _axis(moved)]} {
    12201246                return  ;# must have skipped click event -- ignore
    12211247            }
    1222             set axis [lindex $args 0]
    1223             set x [lindex $args 1]
    1224             set y [lindex $args 2]
     1248            foreach { axis x y } $args break
     1249            set g $itk_component(plot)
     1250            if { [$g cget -invertxy] } {
     1251                set tmp $x
     1252                set x $y
     1253                set y $tmp
     1254            }
    12251255
    12261256            if {!$_axis(moved)} {
    … …  
    12291259                set dy [expr {abs($y-$_axis(click-y))}]
    12301260                if {$dx < 2 && $dy < 2} {
    1231                     _axis edit $axis
     1261                    Axis edit $axis
    12321262                }
    12331263            } else {
    12341264                # one last movement
    1235                 _axis drag $axis $x $y
     1265                Axis drag $axis $x $y
    12361266            }
    12371267            catch {unset _axis}
    … …  
    12391269        edit {
    12401270            if {[llength $args] != 1} {
    1241                 error "wrong # args: should be \"_axis edit axis\""
     1271                error "wrong # args: should be \"Axis edit axis\""
    12421272            }
    12431273            set axis [lindex $args 0]
    … …  
    12461276            # apply last value when deactivating
    12471277            $itk_component(hull).axes configure -deactivatecommand \
    1248                 [itcl::code $this _axis changed $axis focus]
     1278                [itcl::code $this Axis changed $axis focus]
    12491279
    12501280            # fix axis label controls...
    … …  
    12531283            $inner.label insert end $label
    12541284            bind $inner.label <KeyPress-Return> \
    1255                 [itcl::code $this _axis changed $axis label]
     1285                [itcl::code $this Axis changed $axis label]
    12561286            bind $inner.label <FocusOut> \
    1257                 [itcl::code $this _axis changed $axis label]
     1287                [itcl::code $this Axis changed $axis label]
    12581288
    12591289            # fix min/max controls...
    … …  
    12621292            $inner.min insert end $min
    12631293            bind $inner.min <KeyPress-Return> \
    1264                 [itcl::code $this _axis changed $axis min]
     1294                [itcl::code $this Axis changed $axis min]
    12651295            bind $inner.min <FocusOut> \
    1266                 [itcl::code $this _axis changed $axis min]
     1296                [itcl::code $this Axis changed $axis min]
    12671297
    12681298            $inner.max delete 0 end
    12691299            $inner.max insert end $max
    12701300            bind $inner.max <KeyPress-Return> \
    1271                 [itcl::code $this _axis changed $axis max]
     1301                [itcl::code $this Axis changed $axis max]
    12721302            bind $inner.max <FocusOut> \
    1273                 [itcl::code $this _axis changed $axis max]
     1303                [itcl::code $this Axis changed $axis max]
    12741304
    12751305            # fix format control...
    … …  
    12801310
    12811311            bind $inner.format <<Value>> \
    1282                 [itcl::code $this _axis changed $axis format]
     1312                [itcl::code $this Axis changed $axis format]
    12831313
    12841314            # fix scale control...
    … …  
    12911321            }
    12921322            $inner.scales.linear configure \
    1293                 -command [itcl::code $this _axis changed $axis scale]
     1323                -command [itcl::code $this Axis changed $axis scale]
    12941324            $inner.scales.log configure \
    1295                 -command [itcl::code $this _axis changed $axis scale]
     1325                -command [itcl::code $this Axis changed $axis scale]
    12961326
    12971327            #
    … …  
    13361366        changed {
    13371367            if {[llength $args] != 2} {
    1338                 error "wrong # args: should be \"_axis changed axis what\""
     1368                error "wrong # args: should be \"Axis changed axis what\""
    13391369            }
    13401370            set axis [lindex $args 0]
    … …  
    14051435                }
    14061436                scale {
    1407                     _axis scale $axis $_axisPopup(scale)
     1437                    Axis scale $axis $_axisPopup(scale)
    14081438
    14091439                    if {$_axisPopup(scale) == "log"} {
    … …  
    14261456        format {
    14271457            if {[llength $args] != 3} {
    1428                 error "wrong # args: should be \"_axis format axis widget value\""
     1458                error "wrong # args: should be \"Axis format axis widget value\""
    14291459            }
    14301460            set axis [lindex $args 0]
    14311461            set value [lindex $args 2]
    1432 
     1462            if { $axis == "x" } {
     1463                return [FormatLabels $itk_component(plot) $value]
     1464            }
    14331465            if {[$itk_component(plot) axis cget $axis -logscale]} {
    14341466                set fmt "%.6g"
    … …  
    14401472        scale {
    14411473            if {[llength $args] != 2} {
    1442                 error "wrong # args: should be \"_axis scale axis type\""
     1474                error "wrong # args: should be \"Axis scale axis type\""
    14431475            }
    14441476            set axis [lindex $args 0]
    … …  
    14531485                # use special formatting for linear mode
    14541486                $itk_component(plot) axis configure $axis -command \
    1455                     [itcl::code $this _axis format $axis]
     1487                    [itcl::code $this Axis format $axis]
    14561488            }
    14571489        }
    … …  
    14631495
    14641496# ----------------------------------------------------------------------
    1465 # USAGE: _getLineMarkerOptions <style>
     1497# USAGE: GetLineMarkerOptions <style>
    14661498#
    14671499# Used internally to create a list of configuration options specific to the
    … …  
    14691501# are not recognized are ignored.
    14701502# ----------------------------------------------------------------------
    1471 itcl::body Rappture::HistogramResult::_getLineMarkerOptions {style} {
     1503itcl::body Rappture::HistogramResult::GetLineMarkerOptions {style} {
    14721504    array set lineOptions {
    14731505        "-color"  "-outline"
    … …  
    14861518
    14871519# ----------------------------------------------------------------------
    1488 # USAGE: _getTextMarkerOptions <style>
     1520# USAGE: GetTextMarkerOptions <style>
    14891521#
    14901522# Used internally to create a list of configuration options specific to the
    … …  
    14921524# are not recognized are ignored.
    14931525# ----------------------------------------------------------------------
    1494 itcl::body Rappture::HistogramResult::_getTextMarkerOptions {style} {
     1526itcl::body Rappture::HistogramResult::GetTextMarkerOptions {style} {
    14951527    array set textOptions {
    14961528        "-color"  "-outline"
    … …  
    15121544
    15131545# ----------------------------------------------------------------------
    1514 # USAGE: _getAxes <dataobj>
     1546# USAGE: GetAxes <dataobj>
    15151547#
    15161548# Used internally to figure out the axes used to plot the given
    … …  
    15181550# x-axis name (x, x2, x3, etc.), and y is the y-axis name.
    15191551# ----------------------------------------------------------------------
    1520 itcl::body Rappture::HistogramResult::_getAxes {dataobj} {
     1552itcl::body Rappture::HistogramResult::GetAxes {dataobj} {
    15211553    # rebuild if needed, so we know about the axes
    15221554    if {[$_dispatcher ispending !rebuild]} {
    … …  
    15701602}
    15711603
    1572 itcl::body Rappture::HistogramResult::_enterMarker { g name x y text } {
    1573     _leaveMarker $g $name
     1604itcl::body Rappture::HistogramResult::EnterMarker { g name x y text } {
     1605    LeaveMarker $g $name
    15741606    set id [$g marker create text \
    15751607                -coords [list $x $y] \
    … …  
    15791611}
    15801612
    1581 itcl::body Rappture::HistogramResult::_leaveMarker { g name } {
     1613itcl::body Rappture::HistogramResult::LeaveMarker { g name } {
    15821614    if { [info exists _markers($name)] } {
    15831615        set id $_markers($name)
    … …  
    15861618    }
    15871619}
     1620
     1621
     1622itcl::body Rappture::HistogramResult::FormatLabels { w value } {
     1623    # Determine the element name from the value
     1624    set index [expr round($value)]
     1625    if { [info exists _xlabels($index)] } {
     1626        return $_xlabels($index)
     1627    }
     1628    return " "
     1629}

  • trunk/gui/scripts/xyresult.tcl

    r2243 r2388  
    170170        -outline black -fill red -color black
    171171
     172    #
    172173    # Add bindings so you can mouse over points to see values:
    173     bind $itk_component(plot) <Motion> \
     174    #
     175    $itk_component(plot) element bind all <Enter> \
    174176        [itcl::code $this Hilite at %x %y]
    175     bind $itk_component(plot) <Leave> \
     177    $itk_component(plot) element bind all <Motion> \
     178        [itcl::code $this Hilite at %x %y]
     179    $itk_component(plot) element bind all <Leave> \
    176180        [itcl::code $this Hilite off %x %y]
    177181
Note: See TracChangeset for help on using the changeset viewer.