Ignore:
Timestamp:
Jul 13, 2010 9:52:29 AM (14 years ago)
Author:
gah
Message:
 
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r1793 r1804  
    44#  This widget is an X/Y plot, meant to view line graphs produced
    55#  as output from the run of a Rappture tool.  Use the "add" and
    6 #  "delete" methods to control the curves showing on the plot.
     6#  "delete" methods to control the dataobjs showing on the plot.
    77# ======================================================================
    88#  AUTHOR:  Michael McLennan, Purdue University
    … …  
    7676    itk_option define -autocolors autoColors AutoColors ""
    7777
    78     constructor {args} { # defined below }
    79     destructor { # defined below }
    80 
    81     public method add {curve {settings ""}}
     78    constructor {args} {
     79        # defined below
     80    }
     81    destructor {
     82        # defined below
     83    }
     84    public method add {dataobj {settings ""}}
    8285    public method get {}
    8386    public method delete {args}
    8487    public method scale {args}
    8588    public method snap { w h }
    86     public method parameters {title args} { # do nothing }
     89    public method parameters {title args} {
     90        # do nothing
     91    }
    8792    public method download {option args}
    8893
    … …  
    9297    protected method _hilite {state x y}
    9398    protected method _axis {option args}
    94     protected method _getAxes {curve}
     99    protected method _getAxes {dataobj}
    95100    protected method _getLineMarkerOptions { style }
    96101    protected method _getTextMarkerOptions { style }
    … …  
    99104
    100105    private variable _dispatcher "" ;# dispatcher for !events
    101     private variable _clist ""     ;# list of curve objects
    102     private variable _curve2color  ;# maps curve => plotting color
    103     private variable _curve2width  ;# maps curve => line width
    104     private variable _curve2dashes ;# maps curve => BLT -dashes list
    105     private variable _curve2raise  ;# maps curve => raise flag 0/1
    106     private variable _curve2desc   ;# maps curve => description of data
    107     private variable _elem2curve   ;# maps graph element => curve
     106    private variable _dlist ""     ;# list of dataobj objects
     107    private variable _dataobj2color  ;# maps dataobj => plotting color
     108    private variable _dataobj2width  ;# maps dataobj => line width
     109    private variable _dataobj2dashes ;# maps dataobj => BLT -dashes list
     110    private variable _dataobj2raise  ;# maps dataobj => raise flag 0/1
     111    private variable _dataobj2desc   ;# maps dataobj => description of data
     112    private variable _elem2dataobj   ;# maps graph element => dataobj
    108113    private variable _label2axis   ;# maps axis label => axis ID
    109114    private variable _limits       ;# axis limits:  x-min, x-max, etc.
    … …  
    115120    common _downloadPopup          ;# download options from popup
    116121    private variable _markers
    117     private variable cur_ ""
    118     private variable initialized_ 0
    119122}
    120123                                                                               
    … …  
    164167    itk_component add plot {
    165168        blt::graph $f.plot \
    166             -highlightthickness 0 -plotpadx 0 -plotpady 4 \
    167             -rightmargin 10
     169            -highlightthickness 0 -plotpadx 0 -plotpady 4
    168170    } {
    169171        keep -foreground -cursor -font
    … …  
    175177        -outline black -fill red -color black
    176178
    177     #
    178179    # Add bindings so you can mouse over points to see values:
    179     #
    180180    bind $itk_component(plot) <Motion> \
    181181        [itcl::code $this _hilite at %x %y]
    … …  
    183183        [itcl::code $this _hilite off %x %y]
    184184
    185     #
    186185    # Add support for editing axes:
    187     #
    188186    Rappture::Balloon $itk_component(hull).axes -title "Axis Options"
    189187    set inner [$itk_component(hull).axes component inner]
    … …  
    270268
    271269# ----------------------------------------------------------------------
    272 # USAGE: add <curve> ?<settings>?
     270# USAGE: add <dataobj> ?<settings>?
    273271#
    274 # Clients use this to add a curve to the plot.  The optional <settings>
     272# Clients use this to add a dataobj to the plot.  The optional <settings>
    275273# are used to configure the plot.  Allowed settings are -color,
    276274# -brightness, -width, -linestyle and -raise.
    277275# ----------------------------------------------------------------------
    278 itcl::body Rappture::XyResult::add {curve {settings ""}} {
     276itcl::body Rappture::XyResult::add {dataobj {settings ""}} {
    279277    array set params {
    280         -color auto
    281         -brightness 0
    282         -width 1
    283         -type "line"
    284         -raise 0
    285         -linestyle solid
    286         -description ""
    287         -param ""
     278        -color auto
     279        -brightness 0
     280        -width 1
     281        -type "histogram"
     282        -raise 0
     283        -linestyle solid
     284        -description ""
     285        -param ""
    288286    }
    289287    foreach {opt val} $settings {
    … …  
    337335    }
    338336
    339     set pos [lsearch -exact $curve $_clist]
     337    set pos [lsearch -exact $dataobj $_dlist]
    340338    if {$pos < 0} {
    341         lappend _clist $curve
    342         set _curve2color($curve) $params(-color)
    343         set _curve2width($curve) $params(-width)
    344         set _curve2dashes($curve) $params(-linestyle)
    345         set _curve2raise($curve) $params(-raise)
    346         set _curve2desc($curve) $params(-description)
     339        lappend _dlist $dataobj
     340        set _dataobj2color($dataobj) $params(-color)
     341        set _dataobj2width($dataobj) $params(-width)
     342        set _dataobj2dashes($dataobj) $params(-linestyle)
     343        set _dataobj2raise($dataobj) $params(-raise)
     344        set _dataobj2desc($dataobj) $params(-description)
    347345
    348346        $_dispatcher event -idle !rebuild
    … …  
    358356itcl::body Rappture::XyResult::get {} {
    359357    # put the dataobj list in order according to -raise options
    360     set clist $_clist
     358    set clist $_dlist
    361359    foreach obj $clist {
    362         if {[info exists _curve2raise($obj)] && $_curve2raise($obj)} {
     360        if {[info exists _dataobj2raise($obj)] && $_dataobj2raise($obj)} {
    363361            set i [lsearch -exact $clist $obj]
    364362            if {$i >= 0} {
    … …  
    372370
    373371# ----------------------------------------------------------------------
    374 # USAGE: delete ?<curve1> <curve2> ...?
     372# USAGE: delete ?<dataobj1> <dataobj2> ...?
    375373#
    376 # Clients use this to delete a curve from the plot.  If no curves
    377 # are specified, then all curves are deleted.
     374# Clients use this to delete a dataobj from the plot.  If no dataobjs
     375# are specified, then all dataobjs are deleted.
    378376# ----------------------------------------------------------------------
    379377itcl::body Rappture::XyResult::delete {args} {
    380378    if {[llength $args] == 0} {
    381         set args $_clist
    382     }
    383 
    384     # delete all specified curves
     379        set args $_dlist
     380    }
     381
     382    # delete all specified dataobjs
    385383    set changed 0
    386     foreach curve $args {
    387         set pos [lsearch -exact $_clist $curve]
     384    foreach dataobj $args {
     385        set pos [lsearch -exact $_dlist $dataobj]
    388386        if {$pos >= 0} {
    389             set _clist [lreplace $_clist $pos $pos]
    390             catch {unset _curve2color($curve)}
    391             catch {unset _curve2width($curve)}
    392             catch {unset _curve2dashes($curve)}
    393             catch {unset _curve2raise($curve)}
    394             foreach elem [array names _elem2curve] {
    395                 if {$_elem2curve($elem) == $curve} {
    396                     unset _elem2curve($elem)
     387            set _dlist [lreplace $_dlist $pos $pos]
     388            catch {unset _dataobj2color($dataobj)}
     389            catch {unset _dataobj2width($dataobj)}
     390            catch {unset _dataobj2dashes($dataobj)}
     391            catch {unset _dataobj2raise($dataobj)}
     392            foreach elem [array names _elem2dataobj] {
     393                if {$_elem2dataobj($elem) == $dataobj} {
     394                    unset _elem2dataobj($elem)
    397395                }
    398396            }
    … …  
    407405
    408406    # Nothing left? then start over with auto colors
    409     if {[llength $_clist] == 0} {
     407    if {[llength $_dlist] == 0} {
    410408        set _autoColorI 0
    411409    }
    … …  
    413411
    414412# ----------------------------------------------------------------------
    415 # USAGE: scale ?<curve1> <curve2> ...?
     413# USAGE: scale ?<dataobj1> <dataobj2> ...?
    416414#
    417415# Sets the default limits for the overall plot according to the
    418 # limits of the data for all of the given <curve> objects.  This
    419 # accounts for all curves--even those not showing on the screen.
    420 # Because of this, the limits are appropriate for all curves as
     416# limits of the data for all of the given <dataobj> objects.  This
     417# accounts for all dataobjs--even those not showing on the screen.
     418# Because of this, the limits are appropriate for all dataobjs as
    421419# the user scans through data in the ResultSet viewer.
    422420# ----------------------------------------------------------------------
    … …  
    435433
    436434    catch {unset _limits}
    437     foreach curve $args {
    438         # find the axes for this curve (e.g., {x y2})
    439         foreach {map(x) map(y)} [_getAxes $curve] break
     435    foreach dataobj $args {
     436        # find the axes for this dataobj (e.g., {x y2})
     437        foreach {map(x) map(y)} [_getAxes $dataobj] break
    440438
    441439        foreach axis {x y} {
    … …  
    444442                # store results -- ex: _limits(x2log-min)
    445443                set id $map($axis)$type
    446                 foreach {min max} [$curve limits $axis$type] break
     444                foreach {min max} [$dataobj limits $axis$type] break
    447445                if {"" != $min && "" != $max} {
    448446                    if {![info exists _limits($id-min)]} {
    … …  
    460458            }
    461459
    462             if {[$curve hints ${axis}scale] == "log"} {
     460            if {[$dataobj hints ${axis}scale] == "log"} {
    463461                _axis scale $map($axis) log
    464462            }
    … …  
    530528                        append csvdata "[string repeat - 60]\n"
    531529                        append csvdata " [$dataobj hints label]\n"
    532                         if {[info exists _curve2desc($dataobj)]
    533                             && [llength [split $_curve2desc($dataobj) \n]] > 1} {
     530                        if {[info exists _dataobj2desc($dataobj)]
     531                            && [llength [split $_dataobj2desc($dataobj) \n]] > 1} {
    534532                            set indent "for:"
    535                             foreach line [split $_curve2desc($dataobj) \n] {
     533                            foreach line [split $_dataobj2desc($dataobj) \n] {
    536534                                append csvdata " $indent $line\n"
    537535                                set indent "    "
    … …  
    549547                            set xv [$dataobj mesh $comp]
    550548                            set yv [$dataobj values $comp]
    551                             foreach x [$xv range 0 end] y [$yv range 0 end] {
     549                            foreach x [$xv values] y [$yv values] {
    552550                                append csvdata [format "%20.15g, %20.15g\n" $x $y]
    553551                            }
    … …  
    599597    set g $itk_component(plot)
    600598
    601     # first clear out the widget
     599    # First clear out the widget
    602600    eval $g element delete [$g element names]
     601    eval $g marker delete [$g marker names]
    603602    foreach axis [$g axis names] {
    604603        $g axis configure $axis -hide yes -checklimits no \
    … …  
    608607    $g xaxis configure -hide no
    609608    $g yaxis configure -hide no
    610     catch {unset _label2axis}
     609    array unset _label2axis
    611610
    612611    #
    … …  
    618617    set anum(x) 0
    619618    set anum(y) 0
    620     foreach curve [get] {
     619    foreach dataobj [get] {
    621620        foreach ax {x y} {
    622             set label [$curve hints ${ax}label]
     621            set label [$dataobj hints ${ax}label]
    623622            if {"" != $label} {
    624623                if {![info exists _label2axis($ax-$label)]} {
    … …  
    636635
    637636                    # if this axis has a description, add it as a tooltip
    638                     set desc [string trim [$curve hints ${ax}desc]]
     637                    set desc [string trim [$dataobj hints ${ax}desc]]
    639638                    Rappture::Tooltip::text $g-$axis $desc
    640639                }
    … …  
    680679
    681680    #
    682     # Plot all of the curves.
     681    # Plot all of the dataobjs.
    683682    #
    684683    set count 0
    685     foreach curve $_clist {
    686         set label [$curve hints label]
    687         foreach {mapx mapy} [_getAxes $curve] break
    688 
    689         foreach comp [$curve components] {
    690             set xv [$curve mesh $comp]
    691             set yv [$curve values $comp]
    692 
    693             if {[info exists _curve2color($curve)]} {
    694                 set color $_curve2color($curve)
     684    foreach dataobj $_dlist {
     685        set label [$dataobj hints label]
     686        foreach {mapx mapy} [_getAxes $dataobj] break
     687
     688        foreach comp [$dataobj components] {
     689            set xv [$dataobj mesh $comp]
     690            set yv [$dataobj values $comp]
     691
     692            if {[info exists _dataobj2color($dataobj)]} {
     693                set color $_dataobj2color($dataobj)
    695694            } else {
    696                 set color [$curve hints color]
     695                set color [$dataobj hints color]
    697696                if {"" == $color} {
    698697                    set color black
    … …  
    700699            }
    701700
    702             if {[info exists _curve2width($curve)]} {
    703                 set lwidth $_curve2width($curve)
     701            if {[info exists _dataobj2width($dataobj)]} {
     702                set lwidth $_dataobj2width($dataobj)
    704703            } else {
    705704                set lwidth 2
    706705            }
    707706
    708             if {[info exists _curve2dashes($curve)]} {
    709                 set dashes $_curve2dashes($curve)
     707            if {[info exists _dataobj2dashes($dataobj)]} {
     708                set dashes $_dataobj2dashes($dataobj)
    710709            } else {
    711710                set dashes ""
    … …  
    721720
    722721            set elem "elem[incr count]"
    723             set _elem2curve($elem) $curve
     722            set _elem2dataobj($elem) $dataobj
    724723            lappend label2elem($label) $elem
    725724            $g element create $elem -x $xv -y $yv \
    … …  
    737736        }
    738737        foreach elem $label2elem($label) {
    739             set curve $_elem2curve($elem)
    740             scan [$curve hints xmlobj] "::libraryObj%d" suffix
     738            set dataobj $_elem2dataobj($elem)
     739            scan [$dataobj hints xmlobj] "::libraryObj%d" suffix
    741740            incr suffix
    742741            set elabel [format "%s \#%d" $label $suffix]
    … …  
    745744    }       
    746745
    747     foreach curve $_clist {
     746    foreach dataobj $_dlist {
    748747        set xmin -Inf
    749748        set ymin -Inf
    … …  
    753752        # Create text/line markers for each *axis.marker specified.
    754753        #
    755         foreach m [$curve xmarkers] {
     754        foreach m [$dataobj xmarkers] {
    756755            foreach {at label style} $m break
    757756            set id [$g marker create line -coords [list $at $ymin $at $ymax]]
    … …  
    769768                set options [_getTextMarkerOptions $style]
    770769                if { $options != "" } {
    771                     puts stderr "$g marker configure $id $options"
    772 
    773770                    eval $g marker configure $id $options
    774771                }
    775772            }
    776773        }
    777         foreach m [$curve ymarkers] {
     774        foreach m [$dataobj ymarkers] {
    778775            foreach {at label style} $m break
    779776            set id [$g marker create line -coords [list $xmin $at $xmax $at]]
    … …  
    792789                if { $options != "" } {
    793790                    eval $g marker configure $id $options
    794                     puts stderr [$g marker configure $id]
    795791                }
    796792            }
    … …  
    919915
    920916            # Some elements are generated dynamically and therefore will
    921             # not have a curve object associated with them.
     917            # not have a dataobj object associated with them.
    922918            set mapx [$g element cget $elem -mapx]
    923919            set mapy [$g element cget $elem -mapy]
    924             if {[info exists _elem2curve($elem)]} {
    925                 foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
     920            if {[info exists _elem2dataobj($elem)]} {
     921                foreach {mapx mapy} [_getAxes $_elem2dataobj($elem)] break
    926922            }
    927923
    … …  
    936932                set y [$g axis transform $mapy $info(y)]
    937933               
    938                 if {[info exists _elem2curve($elem)]} {
    939                     set curve $_elem2curve($elem)
    940                     set yunits [$curve hints yunits]
    941                     set xunits [$curve hints xunits]
     934                if {[info exists _elem2dataobj($elem)]} {
     935                    set dataobj $_elem2dataobj($elem)
     936                    set yunits [$dataobj hints yunits]
     937                    set xunits [$dataobj hints xunits]
    942938                } else {
    943939                    set xunits ""
    … …  
    961957               
    962958                # Some elements are generated dynamically and therefore will
    963                 # not have a curve object associated with them.
     959                # not have a dataobj object associated with them.
    964960                set mapx [$g element cget $elem -mapx]
    965961                set mapy [$g element cget $elem -mapy]
    966                 if {[info exists _elem2curve($elem)]} {
    967                     foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
     962                if {[info exists _elem2dataobj($elem)]} {
     963                    foreach {mapx mapy} [_getAxes $_elem2dataobj($elem)] break
    968964                }
    969965               
    … …  
    972968                set y [$g axis transform $mapy $info(y)]
    973969               
    974                 if {[info exists _elem2curve($elem)]} {
    975                     set curve $_elem2curve($elem)
    976                     set yunits [$curve hints yunits]
    977                     set xunits [$curve hints xunits]
     970                if {[info exists _elem2dataobj($elem)]} {
     971                    set dataobj $_elem2dataobj($elem)
     972                    set yunits [$dataobj hints yunits]
     973                    set xunits [$dataobj hints xunits]
    978974                } else {
    979975                    set xunits ""
    … …  
    10101006        set mapx [$g element cget $elem -mapx]
    10111007        set mapy [$g element cget $elem -mapy]
    1012         if {[info exists _elem2curve($elem)]} {
    1013             foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
     1008        if {[info exists _elem2dataobj($elem)]} {
     1009            foreach {mapx mapy} [_getAxes $_elem2dataobj($elem)] break
    10141010        }
    10151011        set allx [$g x2axis use]
    … …  
    15271523
    15281524# ----------------------------------------------------------------------
    1529 # USAGE: _getAxes <curveObj>
     1525# USAGE: _getAxes <dataobj>
    15301526#
    15311527# Used internally to figure out the axes used to plot the given
    1532 # <curveObj>.  Returns a list of the form {x y}, where x is the
     1528# <dataobj>.  Returns a list of the form {x y}, where x is the
    15331529# x-axis name (x, x2, x3, etc.), and y is the y-axis name.
    15341530# ----------------------------------------------------------------------
    1535 itcl::body Rappture::XyResult::_getAxes {curve} {
     1531itcl::body Rappture::XyResult::_getAxes {dataobj} {
    15361532    # rebuild if needed, so we know about the axes
    15371533    if {[$_dispatcher ispending !rebuild]} {
    … …  
    15411537
    15421538    # what is the x axis?  x? x2? x3? ...
    1543     set xlabel [$curve hints xlabel]
     1539    set xlabel [$dataobj hints xlabel]
    15441540    if {[info exists _label2axis(x-$xlabel)]} {
    15451541        set mapx $_label2axis(x-$xlabel)
    … …  
    15491545
    15501546    # what is the y axis?  y? y2? y3? ...
    1551     set ylabel [$curve hints ylabel]
     1547    set ylabel [$dataobj hints ylabel]
    15521548    if {[info exists _label2axis(y-$ylabel)]} {
    15531549        set mapy $_label2axis(y-$ylabel)
Note: See TracChangeset for help on using the changeset viewer.