Ignore:
Timestamp:
Nov 29, 2007, 5:17:31 PM (17 years ago)
Author:
gah
Message:
 
File:
1 edited

Legend:

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

    r818 r822  
    11
    22# ----------------------------------------------------------------------
    3 #  COMPONENT: historesult - X/Y plot in a ResultSet
     3#  COMPONENT: HistoResult - X/Y plot in a ResultSet
    44#
    55#  This widget is an X/Y plot, meant to view histograms produced
     
    1717package require BLT
    1818
    19 option add *Historesult.width 3i widgetDefault
    20 option add *Historesult.height 3i widgetDefault
    21 option add *Historesult.gridColor #d9d9d9 widgetDefault
    22 option add *Historesult.activeColor blue widgetDefault
    23 option add *Historesult.dimColor gray widgetDefault
    24 option add *Historesult.controlBackground gray widgetDefault
    25 option add *Historesult.font \
     19option add *HistoResult*Element.borderWidth 1 widgetDefault
     20option add *HistoResult*Element.relief solid widgetDefault
     21option add *HistoResult*x.loose 1 widgetDefault
     22option add *HistoResult*y.loose 1 widgetDefault
     23option add *HistoResult*Element.relief solid widgetDefault
     24
     25option add *HistoResult.width 3i widgetDefault
     26option add *HistoResult.height 3i widgetDefault
     27option add *HistoResult.gridColor #d9d9d9 widgetDefault
     28option add *HistoResult.activeColor blue widgetDefault
     29option add *HistoResult.dimColor gray widgetDefault
     30option add *HistoResult.controlBackground gray widgetDefault
     31option add *HistoResult.font \
    2632    -*-helvetica-medium-r-normal-*-12-* widgetDefault
    2733
    28 option add *Historesult.autoColors {
     34option add *HistoResult.autoColors {
    2935    #0000ff #ff0000 #00cc00
    3036    #cc00cc #ff9900 #cccc00
     
    3339} widgetDefault
    3440
    35 option add *Historesult*Balloon*Entry.background white widgetDefault
    36 
    37 itcl::class Rappture::Historesult {
     41option add *HistoResult*Balloon*Entry.background white widgetDefault
     42
     43itcl::class Rappture::HistoResult {
    3844    inherit itk::Widget
    3945
     
    5965    protected method _axis {option args}
    6066    protected method _getAxes {xydata}
     67    protected method _getLineMarkerOptions { style }
     68    protected method _getTextMarkerOptions { style }
    6169
    6270    private variable _dispatcher "" ;# dispatcher for !events
     
    7785    private variable _axisPopup    ;# info for axis being edited in popup
    7886    common _downloadPopup          ;# download options from popup
     87
    7988}
    8089                                                                               
    81 itk::usual Historesult {
     90itk::usual HistoResult {
    8291    keep -background -foreground -cursor -font
    8392}
     
    8695# CONSTRUCTOR
    8796# ----------------------------------------------------------------------
    88 itcl::body Rappture::Historesult::constructor {args} {
     97itcl::body Rappture::HistoResult::constructor {args} {
    8998    Rappture::dispatcher _dispatcher
    9099    $_dispatcher register !rebuild
     
    122131    itk_component add plot {
    123132        blt::barchart $itk_interior.plot \
    124             -highlightthickness 0 -plotpadx 0 -plotpady 0 \
     133            -highlightthickness 0 -plotpadx 10 -plotpady 10 \
    125134            -rightmargin 10
    126135    } {
     
    129138    pack $itk_component(plot) -expand yes -fill both
    130139    $itk_component(plot) pen configure activeBar \
    131         -linewidth 2 -color black
     140        -foreground red -borderwidth 0
    132141
    133142    #
     
    176185    grid $inner.format -row 4 -column 1 -sticky ew -pady 4
    177186
    178     label $inner.scalel -text "Scale:"
    179     frame $inner.scales
    180     radiobutton $inner.scales.linear -text "Linear" \
    181         -variable [itcl::scope _axisPopup(scale)] -value "linear"
    182     pack $inner.scales.linear -side left
    183     radiobutton $inner.scales.log -text "Logarithmic" \
    184         -variable [itcl::scope _axisPopup(scale)] -value "log"
    185     pack $inner.scales.log -side left
    186     grid $inner.scalel -row 5 -column 0 -sticky e
    187     grid $inner.scales -row 5 -column 1 -sticky ew -pady 4
     187    # I've temporarily removed the scaling controls.  Log scale isn't useful
     188    # for the x-axis, but can be for the y-axis.  I need to figure out how to
     189    # provide different menus for each axis.
    188190
    189191    foreach axis {x y} {
     
    205207# DESTRUCTOR
    206208# ----------------------------------------------------------------------
    207 itcl::body Rappture::Historesult::destructor {} {
     209itcl::body Rappture::HistoResult::destructor {} {
    208210}
    209211
     
    215217# -brightness, -width, -linestyle and -raise.
    216218# ----------------------------------------------------------------------
    217 itcl::body Rappture::Historesult::add {histogram {settings ""}} {
     219itcl::body Rappture::HistoResult::add {histogram {settings ""}} {
    218220    array set params {
    219221        -color auto
     
    291293# order from bottom to top of this result.
    292294# ----------------------------------------------------------------------
    293 itcl::body Rappture::Historesult::get {} {
     295itcl::body Rappture::HistoResult::get {} {
    294296    # put the dataobj list in order according to -raise options
    295297    set clist $_hlist
     
    312314# are specified, then all histograms are deleted.
    313315# ----------------------------------------------------------------------
    314 itcl::body Rappture::Historesult::delete {args} {
     316itcl::body Rappture::HistoResult::delete {args} {
    315317    if {[llength $args] == 0} {
    316318        set args $_hlist
     
    356358# the user scans through data in the ResultSet viewer.
    357359# ----------------------------------------------------------------------
    358 itcl::body Rappture::Historesult::scale {args} {
     360itcl::body Rappture::HistoResult::scale {args} {
    359361    set allx [$itk_component(plot) x2axis use]
    360362    lappend allx x  ;# fix main x-axis too
     
    380382                set id $map($axis)$type
    381383                foreach {min max} [$xydata limits $axis$type] break
     384                puts stderr "axis=$axis min=$min, max=$max"
    382385                if {"" != $min && "" != $max} {
    383386                    if {![info exists _limits($id-min)]} {
     
    413416# "string" is the data itself.
    414417# ----------------------------------------------------------------------
    415 itcl::body Rappture::Historesult::download {option args} {
     418itcl::body Rappture::HistoResult::download {option args} {
    416419    switch $option {
    417420        coming {
     
    419422        }
    420423        controls {
    421             set popup .historesultdownload
     424            set popup .HistoResultdownload
    422425            if {![winfo exists .historesultdownload]} {
    423426                # if we haven't created the popup yet, do it now
     
    427430                pack $inner.summary -side top
    428431                radiobutton $inner.csv -text "Data as Comma-Separated Values" \
    429                     -variable Rappture::Historesult::_downloadPopup(format) \
     432                    -variable Rappture::HistoResult::_downloadPopup(format) \
    430433                    -value csv
    431434                pack $inner.csv -anchor w
    432435                radiobutton $inner.pdf -text "Image as PDF/PostScript" \
    433                     -variable Rappture::Historesult::_downloadPopup(format) \
     436                    -variable Rappture::HistoResult::_downloadPopup(format) \
    434437                    -value pdf
    435438                pack $inner.pdf -anchor w
     
    475478
    476479                    append csvdata "[$dataobj hints xlabel], [$dataobj hints ylabel]\n"
    477                     set first 1
    478                     foreach comp [$dataobj components] {
    479                         if {!$first} {
    480                             # blank line between components
    481                             append csvdata "\n"
    482                         }
    483                         set xv [$dataobj locations]
    484                         set hv [$dataobj heights]
    485                         set wv [$dataobj widths]
    486                         if { $wv == "" } {
    487                             foreach x [$xv range 0 end] h [$hv range 0 end] {
     480                    set xv [$dataobj locations]
     481                    set hv [$dataobj heights]
     482                    set wv [$dataobj widths]
     483                    if { $wv == "" } {
     484                        foreach x [$xv range 0 end] h [$hv range 0 end] {
     485                            append csvdata \
     486                                [format "%20.15g, %20.15g\n" $x $h]
     487                        }
     488                    } else {
     489                        foreach x [$xv range 0 end] \
     490                            h [$hv range 0 end] \
     491                            w [$wv range 0 end] {
    488492                                append csvdata \
    489                                     [format "%20.15g, %20.15g\n" $x $h]
     493                                    [format "%20.15g, %20.15g, %20.15g\n" $x $h $w]
    490494                            }
    491                         } else {
    492                             foreach x [$xv range 0 end] \
    493                                     h [$hv range 0 end] \
    494                                     w [$wv range 0 end] {
    495                                 append csvdata [format \
    496                                     "%20.15g, %20.15g, %20.15g\n" $x $h $w]
    497                             }
    498                         }
    499                         set first 0
    500                         append csvdata "\n"
    501495                    }
     496                    append csvdata "\n"
    502497                }
    503498                return [list .txt $csvdata]
     
    537532# widget to display new data.
    538533# ----------------------------------------------------------------------
    539 itcl::body Rappture::Historesult::_rebuild {} {
     534itcl::body Rappture::HistoResult::_rebuild {} {
    540535    set g $itk_component(plot)
    541536
    542537    # first clear out the widget
    543538    eval $g element delete [$g element names]
     539    eval $g marker delete [$g marker names]
    544540    foreach axis [$g axis names] {
    545         $g axis configure $axis -hide yes
     541        $g axis configure $axis -hide yes 
    546542    }
    547543    catch {unset _label2axis}
    548 
    549544    #
    550545    # Scan through all objects and create a list of all axes.
     
    623618        foreach {mapx mapy} [_getAxes $xydata] break
    624619
    625         foreach comp [$xydata components] {
    626             set xv [$xydata locations]
    627             set yv [$xydata heights]
    628             set zv [$xydata widths]
    629                
    630             if {[info exists _histo2color($xydata)]} {
    631                 set color $_histo2color($xydata)
    632             } else {
    633                 set color [$xydata hints color]
    634                 if {"" == $color} {
    635                     set color black
    636                 }
    637             }
    638 
    639             if {[info exists _histo2width($xydata)]} {
    640                 set lwidth $_histo2width($xydata)
    641             } else {
    642                 set lwidth 2
    643             }
    644 
    645             if {[info exists _histo2dashes($xydata)]} {
    646                 set dashes $_histo2dashes($xydata)
    647             } else {
    648                 set dashes ""
    649             }
    650             set elem "elem[incr count]"
    651             set _elem2histo($elem) $xydata
    652             $g element line $elem -x $xv -y $yv \
    653                 -symbol $sym -pixels $pixels -linewidth $lwidth -label $label \
    654                 -color $color -dashes $dashes -smooth natural \
    655                 -mapx $mapx -mapy $mapy
    656 
    657             # Compute default bar width for histogram elements.
    658             set defwidth { [expr ($zv(max) - $zv(min)) / ([$xv length] - 1)] }
    659             foreach x [$xv range 0 end] y [$yv range 0 end] z [$zv range 0 end] {
    660                 if { $z == "" } {
    661                     set z $defwidth
    662                 }
     620        set xv [$xydata locations]
     621        set yv [$xydata heights]
     622        set zv [$xydata widths]
     623       
     624        if {[info exists _histo2color($xydata)]} {
     625            set color $_histo2color($xydata)
     626        } else {
     627            set color [$xydata hints color]
     628            if {"" == $color} {
     629                set color black
     630            }
     631        }
     632       
     633        if {[info exists _histo2width($xydata)]} {
     634            set lwidth $_histo2width($xydata)
     635        } else {
     636            set lwidth 2
     637        }
     638
     639        if {[info exists _histo2dashes($xydata)]} {
     640            set dashes $_histo2dashes($xydata)
     641        } else {
     642            set dashes ""
     643        }
     644        if {([$xv length] <= 1) || ($lwidth == 0)} {
     645            set sym square
     646            set pixels 2
     647        } else {
     648            set sym ""
     649            set pixels 6
     650        }
     651        if { 0 } {
     652        set elem "elem[incr count]"
     653        set _elem2histo($elem) $xydata
     654        $g line create $elem -x $xv -y $yv \
     655            -symbol $sym -pixels $pixels -linewidth $lwidth -label $label \
     656            -color $color -dashes $dashes -smooth natural \
     657            -mapx $mapx -mapy $mapy
     658        }
     659        # Compute default bar width for histogram elements.
     660        if { [$zv length] == [$xv length] } {
     661            foreach x [$xv range 0 end] \
     662                    y [$yv range 0 end] \
     663                    z [$zv range 0 end] {
    663664                set elem "elem[incr count]"
    664665                set _elem2histo($elem) $xydata
    665666                $g element create $elem -x $x -y $y -barwidth $z \
    666                         -label $label -foreground $color \
    667                         -mapx $mapx -mapy $mapy
     667                    -label $label -foreground $color \
     668                    -mapx $mapx -mapy $mapy
    668669            }
    669         }
     670        } else {
     671            set r [blt::vector expr {max($xv) - min($xv)}]
     672            set z [expr {$r / ([$xv length]-1)}]
     673            foreach x [$xv range 0 end] y [$yv range 0 end] {
     674                set elem "elem[incr count]"
     675                set _elem2histo($elem) $xydata
     676                $g element create $elem -x $x -y $y -barwidth $z \
     677                    -label $label -foreground $color \
     678                    -mapx $mapx -mapy $mapy
     679            }
     680        }
     681
     682        #
     683        # Create text/line markers for each *axis.marker specified.
     684        #
     685        foreach m [$xydata xmarkers] {
     686            foreach {at label style} $m break
     687            set yv [$xydata heights]
     688            set min [blt::vector expr min($yv)]
     689            set max [blt::vector expr max($yv)]
     690            set id [$g marker create line -coords [list $at $min $at $max]]
     691            set options [_getLineMarkerOptions $style]
     692            if { $options != "" } {
     693                eval $g marker configure $id $options
     694            }
     695            if { $label != "" } {
     696                set id [$g marker create text -anchor w -xoffset 5 \
     697                        -text $label -coords [list $at $max]]
     698                set options [_getTextMarkerOptions $style]
     699                if { $options != "" } {
     700                    eval $g marker configure $id $options
     701                }
     702            }
     703        }
     704        foreach m [$xydata ymarkers] {
     705            foreach {at label style} $m break
     706            set xv [$xydata widths]
     707            set min [blt::vector expr min($xv)]
     708            set max [blt::vector expr max($xv)]
     709            set id [$g marker create line -coords [list $min $at $max $at]]
     710            set options [_getLineMarkerOptions $style]
     711            if { $options != "" } {
     712                eval $g marker configure $id $options
     713            }
     714            if { $label != "" } {
     715                set id [$g marker create text -anchor se -yoffset 5 \
     716                        -text $label -coords [list $max $at]]
     717                set options [_getTextMarkerOptions $style]
     718                if { $options != "" } {
     719                    eval $g marker configure $id $options
     720                }
     721            }
     722        }
    670723    }
    671724}
     
    677730# current plot.
    678731# ----------------------------------------------------------------------
    679 itcl::body Rappture::Historesult::_resetLimits {} {
     732itcl::body Rappture::HistoResult::_resetLimits {} {
    680733    set g $itk_component(plot)
    681734
     
    753806# controls for this widget.  Changes the zoom for the current view.
    754807# ----------------------------------------------------------------------
    755 itcl::body Rappture::Historesult::_zoom {option args} {
     808itcl::body Rappture::HistoResult::_zoom {option args} {
    756809    switch -- $option {
    757810        reset {
     
    768821# pop up with element info.
    769822# ----------------------------------------------------------------------
    770 itcl::body Rappture::Historesult::_hilite {state x y} {
     823itcl::body Rappture::HistoResult::_hilite {state x y} {
    771824    set g $itk_component(plot)
    772825    set elem ""
     
    9781031# changes from the panel.
    9791032# ----------------------------------------------------------------------
    980 itcl::body Rappture::Historesult::_axis {option args} {
     1033itcl::body Rappture::HistoResult::_axis {option args} {
    9811034    set inner [$itk_component(hull).axes component inner]
    9821035
     
    11491202                [itcl::code $this _axis changed $axis format]
    11501203
    1151             # fix scale control...
    1152             if {[$itk_component(plot) axis cget $axis -logscale]} {
    1153                 set _axisPopup(scale) "log"
    1154                 $inner.format configure -state disabled
    1155             } else {
    1156                 set _axisPopup(scale) "linear"
    1157                 $inner.format configure -state normal
    1158             }
    1159             $inner.scales.linear configure \
    1160                 -command [itcl::code $this _axis changed $axis scale]
    1161             $inner.scales.log configure \
    1162                 -command [itcl::code $this _axis changed $axis scale]
     1204            # I removed the code for fixing the axis menus scale controls.
     1205            # This needs to be added back when different menus are available
     1206            # for each axis.
    11631207
    11641208            #
     
    13301374
    13311375# ----------------------------------------------------------------------
     1376# USAGE: _getLineMarkerOptions <style>
     1377#
     1378# Used internally to create a list of configuration options specific to the
     1379# axis line marker.  The input is a list of name value pairs.  Options that
     1380# are not recognized are ignored.
     1381# ----------------------------------------------------------------------
     1382itcl::body Rappture::HistoResult::_getLineMarkerOptions {style} {
     1383    array set lineOptions {
     1384        "-color"  "-outline"
     1385        "-dashes" "-dashes"
     1386        "-linecolor" "-outline"
     1387        "-linewidth" "-linewidth"
     1388    }
     1389    set options {}
     1390    foreach {name value} $style {
     1391        if { [info exists lineOptions($name)] } {
     1392            lappend options $lineOptions($name) $value
     1393        }
     1394    }
     1395    return $options
     1396}
     1397
     1398# ----------------------------------------------------------------------
     1399# USAGE: _getTextMarkerOptions <style>
     1400#
     1401# Used internally to create a list of configuration options specific to the
     1402# axis text marker.  The input is a list of name value pairs.  Options that
     1403# are not recognized are ignored.
     1404# ----------------------------------------------------------------------
     1405itcl::body Rappture::HistoResult::_getTextMarkerOptions {style} {
     1406    array set textOptions {
     1407        "-color"  "-outline"
     1408        "-textcolor"  "-outline"
     1409        "-font"   "-font"
     1410        "-xoffset" "-xoffset"
     1411        "-yoffset" "-yoffset"
     1412        "-anchor" "-anchor"
     1413    }
     1414    set options {}
     1415    foreach {name value} $style {
     1416        if { [info exists textOptions($name)] } {
     1417            lappend options $textOptions($name) $value
     1418        }
     1419    }
     1420    return $options
     1421}
     1422
     1423# ----------------------------------------------------------------------
    13321424# USAGE: _getAxes <histoObj>
    13331425#
     
    13361428# x-axis name (x, x2, x3, etc.), and y is the y-axis name.
    13371429# ----------------------------------------------------------------------
    1338 itcl::body Rappture::Historesult::_getAxes {xydata} {
     1430itcl::body Rappture::HistoResult::_getAxes {xydata} {
    13391431    # rebuild if needed, so we know about the axes
    13401432    if {[$_dispatcher ispending !rebuild]} {
     
    13651457# CONFIGURATION OPTION: -gridcolor
    13661458# ----------------------------------------------------------------------
    1367 itcl::configbody Rappture::Historesult::gridcolor {
     1459itcl::configbody Rappture::HistoResult::gridcolor {
    13681460    if {"" == $itk_option(-gridcolor)} {
    13691461        $itk_component(plot) grid off
     
    13771469# CONFIGURATION OPTION: -autocolors
    13781470# ----------------------------------------------------------------------
    1379 itcl::configbody Rappture::Historesult::autocolors {
     1471itcl::configbody Rappture::HistoResult::autocolors {
    13801472    foreach c $itk_option(-autocolors) {
    13811473        if {[catch {winfo rgb $itk_component(hull) $c}]} {
Note: See TracChangeset for help on using the changeset viewer.