Changeset 57 for trunk


Ignore:
Timestamp:
Sep 19, 2005, 8:27:37 PM (19 years ago)
Author:
mmc
Message:
  • Fixed x/y graphs to support multiple axes.
  • Added Rappture::result proc for reporting results.
  • Fixed up app-fermi example to be a little cleaner.
Location:
trunk
Files:
1 added
3 deleted
4 edited
1 moved

Legend:

Unmodified
Added
Removed

  • trunk/examples/app-fermi/fermi.tcl

    r34 r57  
    4343#
    4444# Save the updated XML describing the run...
    45 # Be sure to do this back in the original directory
    4645#
    47 set rfile "run[clock seconds].xml"
    48 set fid [open $rfile w]
    49 puts $fid "<?xml version=\"1.0\"?>"
    50 puts $fid [$driver xml]
    51 close $fid
    52 
    53 puts "=RAPPTURE-RUN=>$rfile"
     46Rappture::result $driver
     47exit 0

  • trunk/examples/app-fermi/tool.xml

    r34 r57  
    33    <tool>
    44        <about>Press Simulate to view results.</about>
    5         <command> @tool/fermi @driver</command>
     5        <command>tclsh @tool/fermi.tcl @driver</command>
    66    </tool>
    77    <input>

  • trunk/gui/scripts/curve.tcl

    r56 r57  
    3232    private variable _curve ""   ;# lib obj representing this curve
    3333    private variable _comp2xy    ;# maps component name => x,y vectors
     34    private variable _hints      ;# cache of hints stored in XML
    3435
    3536    private common _counter 0    ;# counter for unique vector names
    … …  
    108109
    109110# ----------------------------------------------------------------------
    110 # USAGE: limits x|xlog|y|ylog
     111# USAGE: limits x|xlin|xlog|y|ylin|ylog
    111112#
    112113# Returns the {min max} limits for the specified axis.
    … …  
    116117    set max ""
    117118    switch -- $which {
    118         x { set pos 0; set log 0; set axis xaxis }
     119        x - xlin { set pos 0; set log 0; set axis xaxis }
    119120        xlog { set pos 0; set log 1; set axis xaxis }
    120         y - v { set pos 1; set log 0; set axis yaxis }
     121        y - ylin - v - vlin { set pos 1; set log 0; set axis yaxis }
    121122        ylog - vlog { set pos 1; set log 1; set axis yaxis }
    122123        default {
    123             error "bad option \"$which\": should be x, xlog, y, ylog, v, vlog"
     124            error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog, v, vlin, vlog"
    124125        }
    125126    }
    … …  
    184185# ----------------------------------------------------------------------
    185186itcl::body Rappture::Curve::hints {{keyword ""}} {
    186     foreach {key path} {
    187         group   about.group
    188         label   about.label
    189         color   about.color
    190         style   about.style
    191         xlabel  xaxis.label
    192         xunits  xaxis.units
    193         xscale  xaxis.scale
    194         xmin    xaxis.min
    195         xmax    xaxis.max
    196         ylabel  yaxis.label
    197         yunits  yaxis.units
    198         yscale  yaxis.scale
    199         ymin    yaxis.min
    200         ymax    yaxis.max
    201     } {
    202         set str [$_curve get $path]
    203         if {"" != $str} {
    204             set hints($key) $str
    205         }
    206     }
    207 
    208     if {[info exists hints(xlabel)] && "" != $hints(xlabel)
    209           && [info exists hints(xunits)] && "" != $hints(xunits)} {
    210         set hints(xlabel) "$hints(xlabel) ($hints(xunits))"
    211     }
    212     if {[info exists hints(ylabel)] && "" != $hints(ylabel)
    213           && [info exists hints(yunits)] && "" != $hints(yunits)} {
    214         set hints(ylabel) "$hints(ylabel) ($hints(yunits))"
    215     }
    216 
    217     if {[info exists hints(group)] && [info exists hints(label)]} {
    218         # pop-up help for each curve
    219         set hints(tooltip) $hints(label)
     187    if {![info exists _hints]} {
     188        foreach {key path} {
     189            group   about.group
     190            label   about.label
     191            color   about.color
     192            style   about.style
     193            xlabel  xaxis.label
     194            xunits  xaxis.units
     195            xscale  xaxis.scale
     196            xmin    xaxis.min
     197            xmax    xaxis.max
     198            ylabel  yaxis.label
     199            yunits  yaxis.units
     200            yscale  yaxis.scale
     201            ymin    yaxis.min
     202            ymax    yaxis.max
     203        } {
     204            set str [$_curve get $path]
     205            if {"" != $str} {
     206                set _hints($key) $str
     207            }
     208        }
     209
     210        if {[info exists _hints(xlabel)] && "" != $_hints(xlabel)
     211              && [info exists _hints(xunits)] && "" != $_hints(xunits)} {
     212            set _hints(xlabel) "$_hints(xlabel) ($_hints(xunits))"
     213        }
     214        if {[info exists _hints(ylabel)] && "" != $_hints(ylabel)
     215              && [info exists _hints(yunits)] && "" != $_hints(yunits)} {
     216            set _hints(ylabel) "$_hints(ylabel) ($_hints(yunits))"
     217        }
     218
     219        if {[info exists _hints(group)] && [info exists _hints(label)]} {
     220            # pop-up help for each curve
     221            set _hints(tooltip) $_hints(label)
     222        }
    220223    }
    221224
    222225    if {$keyword != ""} {
    223         if {[info exists hints($keyword)]} {
    224             return $hints($keyword)
     226        if {[info exists _hints($keyword)]} {
     227            return $_hints($keyword)
    225228        }
    226229        return ""
    227230    }
    228     return [array get hints]
     231    return [array get _hints]
    229232}
    230233

  • trunk/gui/scripts/valueresult.tcl

    r50 r57  
    9090
    9191        # find the value and assign it with the proper coloring
    92         if {"" != $params(-color) && $params(-brightness) != 0} {
     92        if {"" != $params(-color) && "" != $params(-brightness)
     93              && $params(-brightness) != 0} {
    9394            set params(-color) [Rappture::color::brightness \
    9495                $params(-color) $params(-brightness)]

  • trunk/gui/scripts/xyresult.tcl

    r56 r57  
    1717option add *XyResult.gridColor #d9d9d9 widgetDefault
    1818option add *XyResult.activeColor blue widgetDefault
     19option add *XyResult.dimColor gray widgetDefault
    1920option add *XyResult.controlBackground gray widgetDefault
    2021option add *XyResult.font \
    … …  
    4546    itk_option define -gridcolor gridColor GridColor ""
    4647    itk_option define -activecolor activeColor ActiveColor ""
     48    itk_option define -dimcolor dimColor DimColor ""
    4749
    4850    constructor {args} { # defined below }
    … …  
    6062    protected method _hilite {state x y}
    6163    protected method _axis {option args}
     64    protected method _getAxes {xydata}
     65
     66    private variable _dispatcher "" ;# dispatcher for !events
    6267
    6368    private variable _clist ""     ;# list of curve objects
    … …  
    6772    private variable _curve2raise  ;# maps curve => raise flag 0/1
    6873    private variable _elem2curve   ;# maps graph element => curve
    69     private variable _xmin ""      ;# autoscale min for x-axis
    70     private variable _xlogmin ""   ;# autoscale min for x-axis (log scale)
    71     private variable _xmax ""      ;# autoscale max for x-axis
    72     private variable _xlogmax ""   ;# autoscale max for x-axis (log scale)
    73     private variable _vmin ""      ;# autoscale min for y-axis
    74     private variable _vlogmin ""   ;# autoscale min for y-axis (log scale)
    75     private variable _vmax ""      ;# autoscale max for y-axis
    76     private variable _vlogmax ""   ;# autoscale max for y-axis (log scale)
    77     private variable _hilite       ;# info from last _hilite operation
    78     private variable _axis         ;# info for axis being edited
     74    private variable _label2axis   ;# maps axis label => axis ID
     75    private variable _limits       ;# axis limits:  x-min, x-max, etc.
     76
     77    private variable _hilite       ;# info for element currently highlighted
     78    private variable _axisPopup    ;# info for axis being edited
    7979}
    8080                                                                               
    … …  
    8787# ----------------------------------------------------------------------
    8888itcl::body Rappture::XyResult::constructor {args} {
     89    Rappture::dispatcher _dispatcher
     90    $_dispatcher register !rebuild
     91    $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
     92
    8993    option add hull.width hull.height
    9094    pack propagate $itk_component(hull) no
    … …  
    120124    }
    121125    pack $itk_component(plot) -expand yes -fill both
    122     $itk_component(plot) pen configure activeLine -symbol square -pixels 5
    123     $itk_component(plot) element bind all <Enter> \
    124         {%W element activate [%W element get current]}
    125     $itk_component(plot) element bind all <Leave> \
    126         {%W element deactivate [%W element get current]}
     126    $itk_component(plot) pen configure activeLine \
     127        -symbol square -pixels 3 -linewidth 2 -color black
    127128
    128129    #
    129130    # Add bindings so you can mouse over points to see values:
    130131    #
    131     array set _hilite {
    132         elem ""
    133         color ""
    134     }
    135132    bind $itk_component(plot) <Motion> \
    136133        [itcl::code $this _hilite at %x %y]
    … …  
    186183    frame $inner.scales
    187184    radiobutton $inner.scales.linear -text "Linear" \
    188         -variable [itcl::scope _axis(scale)] -value "linear"
     185        -variable [itcl::scope _axisPopup(scale)] -value "linear"
    189186    pack $inner.scales.linear -side left
    190187    radiobutton $inner.scales.log -text "Logarithmic" \
    191         -variable [itcl::scope _axis(scale)] -value "log"
     188        -variable [itcl::scope _axisPopup(scale)] -value "log"
    192189    pack $inner.scales.log -side left
    193190    grid $inner.scalel -row 5 -column 0 -sticky e
    … …  
    195192
    196193    foreach axis {x y} {
    197         $itk_component(plot) axis bind $axis <Enter> \
    198             [itcl::code $this _axis hilite $axis on]
    199         $itk_component(plot) axis bind $axis <Leave> \
    200             [itcl::code $this _axis hilite $axis off]
    201         $itk_component(plot) axis bind $axis <ButtonPress> \
    202             [itcl::code $this _axis edit $axis]
    203     }
    204 
    205     set _axis(format-x) "%.3g"
    206     set _axis(format-y) "%.3g"
     194        set _axisPopup(format-$axis) "%.3g"
     195    }
    207196    _axis scale x linear
    208197    _axis scale y linear
    … …  
    213202
    214203    eval itk_initialize $args
     204
     205    set _hilite(elem) ""
    215206}
    216207
    … …  
    264255        set _curve2raise($curve) $params(-raise)
    265256
    266         after cancel [itcl::code $this _rebuild]
    267         after idle [itcl::code $this _rebuild]
     257        $_dispatcher event -idle !rebuild
    268258    }
    269259}
    … …  
    322312    # if anything changed, then rebuild the plot
    323313    if {$changed} {
    324         after cancel [itcl::code $this _rebuild]
    325         after idle [itcl::code $this _rebuild]
     314        $_dispatcher event -idle !rebuild
    326315    }
    327316}
    … …  
    337326# ----------------------------------------------------------------------
    338327itcl::body Rappture::XyResult::scale {args} {
    339     set _xmin ""
    340     set _xlogmin ""
    341     set _xmax ""
    342     set _xlogmax ""
    343     set _vmin ""
    344     set _vlogmin ""
    345     set _vmax ""
    346     set _vlogmax ""
    347     foreach obj $args {
    348         foreach axis {x xlog v vlog} {
    349             foreach {min max} [$obj limits $axis] break
    350             if {"" != $min && "" != $max} {
    351                 if {"" == [set _${axis}min]} {
    352                     set _${axis}min $min
    353                     set _${axis}max $max
    354                 } else {
    355                     if {$min < [set _${axis}min]} {
    356                         set _${axis}min $min
    357                     }
    358                     if {$max > [set _${axis}max]} {
    359                         set _${axis}max $max
     328    catch {unset _limits}
     329    foreach xydata $args {
     330        # find the axes for this curve (e.g., {x y2})
     331        foreach {map(x) map(y)} [_getAxes $xydata] break
     332
     333        foreach axis {x y} {
     334            # get defaults for both linear and log scales
     335            foreach type {lin log} {
     336                # store results -- ex: _limits(x2log-min)
     337                set id $map($axis)$type
     338                foreach {min max} [$xydata limits $axis$type] break
     339                if {"" != $min && "" != $max} {
     340                    if {![info exists _limits($id-min)]} {
     341                        set _limits($id-min) $min
     342                        set _limits($id-max) $max
     343                    } else {
     344                        if {$min < $_limits($id-min)} {
     345                            set _limits($id-min) $min
     346                        }
     347                        if {$max > $_limits($id-max)} {
     348                            set _limits($id-max) $max
     349                        }
    360350                    }
    361351                }
    … …  
    406396    # first clear out the widget
    407397    eval $g element delete [$g element names]
    408 
    409     $g axis configure x -min "" -max ""
     398    foreach axis [$g axis names] {
     399        $g axis configure $axis -hide yes
     400    }
     401    catch {unset _label2axis}
     402
     403    $g axis configure x -min "" -max "" -hide no
    410404    _axis scale x linear
    411405
    412     $g axis configure y -min "" -max ""
     406    $g axis configure y -min "" -max "" -hide no
    413407    _axis scale y linear
    414408
    415     # extract axis information from the first curve
    416     set clist [get]
    417     set xydata [lindex $clist 0]
    418     if {$xydata != ""} {
    419         set legend [$xydata hints legend]
    420         if {"" != $legend} {
    421             if {$legend == "off"} {
    422                 $g legend configure -hide yes
    423             } else {
    424                 $g legend configure -hide no \
    425                     -position plotarea -anchor $legend -borderwidth 0
    426             }
    427         }
    428 
    429         set xlabel [$xydata hints xlabel]
    430         if {"" != $xlabel} {
    431             $g xaxis configure -title $xlabel
    432         }
    433 
    434         set ylabel [$xydata hints ylabel]
    435         if {"" != $ylabel} {
    436             $g yaxis configure -title $ylabel
    437         }
    438     }
    439 
    440     foreach lim {xmin xmax ymin ymax} {
    441         set limits($lim) ""
    442     }
    443 
    444     # plot all of the curves
     409    #
     410    # Scan through all objects and create a list of all axes.
     411    # The first x-axis gets mapped to "x".  The second, to "x2".
     412    # Beyond that, we must create new axes "x3", "x4", etc.
     413    # We do the same for y.
     414    #
     415    set anum(x) 0
     416    set anum(y) 0
     417    foreach xydata [get] {
     418        foreach ax {x y} {
     419            set label [$xydata hints ${ax}label]
     420            if {"" != $label} {
     421                if {![info exists _label2axis($ax-$label)]} {
     422                    switch [incr anum($ax)] {
     423                        1 { set axis $ax }
     424                        2 { set axis ${ax}2 }
     425                        default {
     426                            set axis $ax$anum($ax)
     427                            catch {$g axis create $axis}
     428                        }
     429                    }
     430                    $g axis configure $axis -title $label -hide no
     431                    set _label2axis($ax-$label) $axis
     432                }
     433            }
     434        }
     435    }
     436
     437    #
     438    # All of the extra axes get mapped to the x2/y2 (top/right)
     439    # position.
     440    #
     441    set all ""
     442    foreach ax {x y} {
     443        lappend all $ax
     444
     445        set extra ""
     446        for {set i 2} {$i <= $anum($ax)} {incr i} {
     447            lappend extra ${ax}$i
     448        }
     449        eval lappend all $extra
     450        $g ${ax}2axis use $extra
     451        if {$ax == "y"} {
     452            $g configure -rightmargin [expr {($extra == "") ? 10 : 0}]
     453        }
     454    }
     455
     456    foreach axis $all {
     457        set _axisPopup(format-$axis) "%.3g"
     458
     459        $g axis bind $axis <Enter> \
     460            [itcl::code $this _axis hilite $axis on]
     461        $g axis bind $axis <Leave> \
     462            [itcl::code $this _axis hilite $axis off]
     463        $g axis bind $axis <ButtonPress> \
     464            [itcl::code $this _axis edit $axis]
     465    }
     466
     467    #
     468    # Plot all of the curves.
     469    #
    445470    set count 0
    446     foreach xydata $clist {
     471    foreach xydata $_clist {
     472        set label [$xydata hints label]
     473        foreach {mapx mapy} [_getAxes $xydata] break
     474
    447475        foreach comp [$xydata components] {
    448             catch {unset hints}
    449             array set hints [$xydata hints]
    450 
    451476            set xv [$xydata mesh $comp]
    452477            set yv [$xydata values $comp]
    … …  
    455480                set color $_curve2color($xydata)
    456481            } else {
    457                 if {[info exists hints(color)]} {
    458                     set color $hints(color)
    459                 } else {
     482                set color [$xydata hints color]
     483                if {"" == $color} {
    460484                    set color black
    461485                }
    … …  
    483507            set _elem2curve($elem) $xydata
    484508
    485             if {[info exists hints(label)]} {
    486                 set label $hints(label)
    487             } else {
    488                 set label ""
    489             }
    490509            $g element create $elem -x $xv -y $yv \
    491510                -symbol $sym -pixels 6 -linewidth $lwidth -label $label \
    492                 -color $color -dashes $dashes
    493 
    494             if {[info exists hints(xscale)] && $hints(xscale) == "log"} {
     511                -color $color -dashes $dashes \
     512                -mapx $mapx -mapy $mapy
     513
     514            if {[$xydata hints xscale] == "log"} {
    495515                _axis scale x log
    496516            }
    497             if {[info exists hints(yscale)] && $hints(yscale) == "log"} {
     517            if {[$xydata hints yscale] == "log"} {
    498518                _axis scale y log
    499519            }
    500 
    501             # see if there are any hints on limit
    502             foreach lim {xmin xmax ymin ymax} {
    503                 if {[info exists hints($lim)] && "" != $hints($lim)} {
    504                     set limits($lim) $hints($lim)
    505                 }
    506             }
    507         }
    508     }
    509 
    510     # add any limit directives from the curve objects
    511     foreach lim {xmin xmax ymin ymax} var {_xmin _xmax _vmin _vmax} {
    512         if {"" != $limits($lim)} {
    513             set $var $limits($lim)
    514         }
    515     }
     520        }
     521    }
     522
    516523    _fixLimits
    517524}
    … …  
    533540    # limits.
    534541    #
    535     if {$_xmin != $_xmax} {
    536         set log [$g axis cget x -logscale]
    537         if {$log} {
    538             set min $_xlogmin
    539             set max $_xlogmax
    540             if {$min == $max} {
    541                 set min [expr {0.9*$min}]
    542                 set max [expr {1.1*$max}]
    543             }
    544             set v [expr {floor(log10($min))}]
    545             if {$v > 0} {
    546                 set min [expr {pow(10.0,$v)}]
    547             }
    548             set v [expr {floor(log10($max))}]
    549             if {$v > 0} {
    550                 set max [expr {pow(10.0,$v)}]
     542    foreach axis [$g axis names] {
     543        if {[info exists _limits(${axis}lin-min)]} {
     544            set log [$g axis cget $axis -logscale]
     545            if {$log} {
     546                set min $_limits(${axis}log-min)
     547                set max $_limits(${axis}log-max)
     548                if {$min == $max} {
     549                    set logmin [expr {floor(log10(abs(0.9*$min)))}]
     550                    set logmax [expr {ceil(log10(abs(1.1*$max)))}]
     551                } else {
     552                    set logmin [expr {floor(log10(abs($min)))}]
     553                    set logmax [expr {ceil(log10(abs($max)))}]
     554                    if {[string match y* $axis]} {
     555                        # add a little padding
     556                        set delta [expr {$logmax-$logmin}]
     557                        set logmin [expr {$logmin-0.05*$delta}]
     558                        set logmax [expr {$logmax+0.05*$delta}]
     559                    }
     560                }
     561                if {$logmin < -300} {
     562                    set min 1e-300
     563                } elseif {$logmin > 300} {
     564                    set min 1e+300
     565                } else {
     566                    set min [expr {pow(10.0,$logmin)}]
     567                }
     568
     569                if {$logmax < -300} {
     570                    set max 1e-300
     571                } elseif {$logmax > 300} {
     572                    set max 1e+300
     573                } else {
     574                    set max [expr {pow(10.0,$logmax)}]
     575                }
     576            } else {
     577                set min $_limits(${axis}lin-min)
     578                set max $_limits(${axis}lin-max)
     579
     580                if {[string match y* $axis]} {
     581                    # add a little padding
     582                    set delta [expr {$max-$min}]
     583                    set min [expr {$min-0.05*$delta}]
     584                    set max [expr {$max+0.05*$delta}]
     585                }
     586            }
     587            if {$min != $max} {
     588                $g axis configure $axis -min $min -max $max
     589            } else {
     590                $g axis configure $axis -min "" -max ""
    551591            }
    552592        } else {
    553             set min $_xmin
    554             set max $_xmax
    555         }
    556         if {$min != $max} {
    557             $g axis configure x -min $min -max $max
    558         } else {
    559             $g axis configure x -min "" -max ""
    560         }
    561     } else {
    562         $g axis configure x -min "" -max ""
    563     }
    564 
    565     if {"" != $_vmin && "" != $_vmax} {
    566         set log [$g axis cget y -logscale]
    567         if {$log} {
    568             set min $_vlogmin
    569             set max $_vlogmax
    570             if {$min == $max} {
    571                 set logmin [expr {floor(log10(abs(0.9*$min)))}]
    572                 set logmax [expr {ceil(log10(abs(1.1*$max)))}]
    573             } else {
    574                 # add a little padding
    575                 set logmin [expr {floor(log10(abs($min)))}]
    576                 set logmax [expr {ceil(log10(abs($max)))}]
    577                 set delta [expr {$logmax-$logmin}]
    578                 set logmin [expr {$logmin-0.05*$delta}]
    579                 set logmax [expr {$logmax+0.05*$delta}]
    580             }
    581             if {$logmin < -300} {
    582                 set min 1e-300
    583             } elseif {$logmin > 300} {
    584                 set min 1e+300
    585             } else {
    586                 set min [expr {pow(10.0,$logmin)}]
    587             }
    588 
    589             if {$logmax < -300} {
    590                 set max 1e-300
    591             } elseif {$logmax > 300} {
    592                 set max 1e+300
    593             } else {
    594                 set max [expr {pow(10.0,$logmax)}]
    595             }
    596         } else {
    597             set min $_vmin
    598             set max $_vmax
    599             set delta [expr {$max-$min}]
    600             set min [expr {$min-0.05*$delta}]
    601             set max [expr {$max+0.05*$delta}]
    602         }
    603         if {$min != $max} {
    604             $g axis configure y -min $min -max $max
    605         } else {
    606             $g axis configure y -min "" -max ""
    607         }
    608     } else {
    609         $g axis configure y -min "" -max ""
     593            $g axis configure $axis -min "" -max ""
     594        }
    610595    }
    611596}
    … …  
    634619itcl::body Rappture::XyResult::_hilite {state x y} {
    635620    set g $itk_component(plot)
     621    set elem ""
    636622    if {$state == "at"} {
    637         if {[$g element closest $x $y info]} {
     623        if {[$g element closest $x $y info -interpolate yes]} {
    638624            set elem $info(name)
    639             set x [$g axis transform x $info(x)]
    640             set y [$g axis transform y $info(y)]
     625            foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
     626
     627            # search again for an exact point -- this time don't interpolate
     628            set tip ""
     629            if {[$g element closest $x $y info -interpolate no]
     630                  && $info(name) == $elem} {
     631                set x [$g axis transform $mapx $info(x)]
     632                set y [$g axis transform $mapy $info(y)]
     633
     634                if {[info exists _elem2curve($elem)]} {
     635                    set curve $_elem2curve($elem)
     636                    set tip [$curve hints tooltip]
     637                    if {[info exists info(y)]} {
     638                        set val [_axis format y dummy $info(y)]
     639                        set units [$curve hints yunits]
     640                        append tip "\n$val$units"
     641
     642                        if {[info exists info(x)]} {
     643                            set val [_axis format x dummy $info(x)]
     644                            set units [$curve hints xunits]
     645                            append tip " @ $val$units"
     646                        }
     647                    }
     648                    set tip [string trim $tip]
     649                }
     650            }
    641651            set state 1
    642652        } else {
    … …  
    646656
    647657    if {$state} {
    648         $g crosshairs configure -hide no -position @$x,$y
    649658        #
    650659        # Highlight ON:
    651         # - fatten line
    652         # - change color
     660        # - activate trace
     661        # - multiple axes? dim other axes
    653662        # - pop up tooltip about data
    654663        #
    655         if {"" == $_hilite(elem)} {
    656             set t [$g element cget $elem -linewidth]
    657             $g element configure $elem -linewidth [expr {$t+2}]
    658             set _hilite(elem) $elem
    659         }
    660 
    661         set tip ""
    662         if {[info exists _elem2curve($elem)]} {
    663             set curve $_elem2curve($elem)
    664             set tip [$curve hints tooltip]
    665             if {[info exists info(y)]} {
    666                 set val [_axis format y dummy $info(y)]
    667                 set units [$curve hints yunits]
    668                 append tip "\n$val$units"
    669 
    670                 if {[info exists info(x)]} {
    671                     set val [_axis format x dummy $info(x)]
    672                     set units [$curve hints xunits]
    673                     append tip " @ $val$units"
    674                 }
    675             }
    676             set tip [string trim $tip]
    677         }
     664        if {$_hilite(elem) != "" && $_hilite(elem) != $elem} {
     665            $g element deactivate $_hilite(elem)
     666            $g crosshairs configure -hide yes
     667            Rappture::Tooltip::tooltip cancel
     668        }
     669        $g element activate $elem
     670        set _hilite(elem) $elem
     671
     672        foreach {mapx mapy} [_getAxes $_elem2curve($elem)] break
     673
     674        set allx [$g x2axis use]
     675        if {[llength $allx] > 0} {
     676            lappend allx x  ;# fix main x-axis too
     677            foreach axis $allx {
     678                if {$axis == $mapx} {
     679                    $g axis configure $axis -color $itk_option(-foreground) \
     680                        -titlecolor $itk_option(-foreground)
     681                } else {
     682                    $g axis configure $axis -color $itk_option(-dimcolor) \
     683                        -titlecolor $itk_option(-dimcolor)
     684                }
     685            }
     686        }
     687        set ally [$g y2axis use]
     688        if {[llength $ally] > 0} {
     689            lappend ally y  ;# fix main y-axis too
     690            foreach axis $ally {
     691                if {$axis == $mapy} {
     692                    $g axis configure $axis -color $itk_option(-foreground) \
     693                        -titlecolor $itk_option(-foreground)
     694                } else {
     695                    $g axis configure $axis -color $itk_option(-dimcolor) \
     696                        -titlecolor $itk_option(-dimcolor)
     697                }
     698            }
     699        }
     700
    678701        if {"" != $tip} {
     702            $g crosshairs configure -hide no -position @$x,$y
     703
    679704            if {$x > 0.5*[winfo width $g]} {
    680                 set x "-[expr {$x-4}]"  ;# move tooltip to the left
    681             } else {
    682                 set x "+[expr {$x+4}]"  ;# move tooltip to the right
     705                if {$x < 4} {
     706                    set x "-0"
     707                } else {
     708                    set x "-[expr {$x-4}]"  ;# move tooltip to the left
     709                }
     710            } else {
     711                if {$x < -4} {
     712                    set x "+0"
     713                } else {
     714                    set x "+[expr {$x+4}]"  ;# move tooltip to the right
     715                }
    683716            }
    684717            if {$y > 0.5*[winfo height $g]} {
    685                 set y "-[expr {$y-4}]"  ;# move tooltip to the top
    686             } else {
    687                 set y "+[expr {$y+4}]"  ;# move tooltip to the bottom
     718                if {$y < 4} {
     719                    set y "-0"
     720                } else {
     721                    set y "-[expr {$y-4}]"  ;# move tooltip to the top
     722                }
     723            } else {
     724                if {$y < -4} {
     725                    set y "+0"
     726                } else {
     727                    set y "+[expr {$y+4}]"  ;# move tooltip to the bottom
     728                }
    688729            }
    689730            Rappture::Tooltip::text $g $tip
    … …  
    693734        #
    694735        # Highlight OFF:
    695         # - put line width back to normal
    696         # - put color back to normal
     736        # - deactivate (color back to normal)
     737        # - put all axes back to normal color
    697738        # - take down tooltip
    698739        #
     740        if {"" != $_hilite(elem)} {
     741            $g element deactivate $_hilite(elem)
     742
     743            set allx [$g x2axis use]
     744            if {[llength $allx] > 0} {
     745                lappend allx x  ;# fix main x-axis too
     746                foreach axis $allx {
     747                    $g axis configure $axis -color $itk_option(-foreground) \
     748                        -titlecolor $itk_option(-foreground)
     749                }
     750            }
     751
     752            set ally [$g y2axis use]
     753            if {[llength $ally] > 0} {
     754                lappend ally y  ;# fix main y-axis too
     755                foreach axis $ally {
     756                    $g axis configure $axis -color $itk_option(-foreground) \
     757                        -titlecolor $itk_option(-foreground)
     758                }
     759            }
     760        }
     761
    699762        $g crosshairs configure -hide yes
    700 
    701         if {"" != $_hilite(elem)} {
    702             set t [$g element cget $_hilite(elem) -linewidth]
    703             $g element configure $_hilite(elem) -linewidth [expr {$t-2}]
    704             set _hilite(elem) ""
    705         }
    706763        Rappture::Tooltip::tooltip cancel
     764
     765        # there is no currently highlighted element
     766        set _hilite(elem) ""
    707767    }
    708768}
    … …  
    746806            }
    747807            set axis [lindex $args 0]
    748             set _axis(current) $axis
     808            set _axisPopup(current) $axis
    749809
    750810            # apply last value when deactivating
    … …  
    779839            # fix format control...
    780840            set fmts [$inner.format choices get -value]
    781             set i [lsearch -exact $fmts $_axis(format-$axis)]
     841            set i [lsearch -exact $fmts $_axisPopup(format-$axis)]
    782842            if {$i < 0} { set i 0 }  ;# use Auto choice
    783843            $inner.format value [$inner.format choices get -label $i]
    … …  
    788848            # fix scale control...
    789849            if {[$itk_component(plot) axis cget $axis -logscale]} {
    790                 set _axis(scale) "log"
     850                set _axisPopup(scale) "log"
    791851                $inner.format configure -state disabled
    792852            } else {
    793                 set _axis(scale) "linear"
     853                set _axisPopup(scale) "linear"
    794854                $inner.format configure -state normal
    795855            }
    … …  
    807867            set h [winfo height $itk_component(plot)]
    808868            foreach {x0 y0 pw ph} [$itk_component(plot) extents plotarea] break
    809             switch -- $axis {
     869            switch -glob -- $axis {
    810870                x {
    811871                    set x [expr {round($x + $x0+0.5*$pw)}]
    … …  
    813873                    set dir "above"
    814874                }
     875                x* {
     876                    set x [expr {round($x + $x0+0.5*$pw)}]
     877                    set dir "below"
     878                    set allx [$itk_component(plot) x2axis use]
     879                    set max [llength $allx]
     880                    set i [lsearch -exact $allx $axis]
     881                    set y [expr {round($y + ($i+0.5)*$y0/double($max))}]
     882                }
    815883                y {
    816884                    set x [expr {round($x + 0.5*$x0)}]
    817885                    set y [expr {round($y + $y0+0.5*$ph)}]
    818886                    set dir "right"
     887                }
     888                y* {
     889                    set y [expr {round($y + $y0+0.5*$ph)}]
     890                    set dir "left"
     891                    set ally [$itk_component(plot) y2axis use]
     892                    set max [llength $ally]
     893                    set i [lsearch -exact $ally $axis]
     894                    set y [expr {round($y + ($i+0.5)*$y0/double($max))}]
     895                    set x [expr {round($x+$x0+$pw + ($i+0.5)*($w-$x0-$pw)/double($max))}]
    819896                }
    820897            }
    … …  
    885962                format {
    886963                    set fmt [$inner.format translate [$inner.format value]]
    887                     set _axis(format-$axis) $fmt
     964                    set _axisPopup(format-$axis) $fmt
    888965
    889966                    # force a refresh
    … …  
    892969                }
    893970                scale {
    894                     _axis scale $axis $_axis(scale)
    895 
    896                     if {$_axis(scale) == "log"} {
     971                    _axis scale $axis $_axisPopup(scale)
     972
     973                    if {$_axisPopup(scale) == "log"} {
    897974                        $inner.format configure -state disabled
    898975                    } else {
    … …  
    921998                set fmt "%.3g"
    922999            } else {
    923                 set fmt $_axis(format-$axis)
     1000                set fmt $_axisPopup(format-$axis)
    9241001            }
    9251002            return [format $fmt $value]
    … …  
    9471024        }
    9481025    }
     1026}
     1027
     1028# ----------------------------------------------------------------------
     1029# USAGE: _getAxes <curveObj>
     1030#
     1031# Used internally to figure out the axes used to plot the given
     1032# <curveObj>.  Returns a list of the form {x y}, where x is the
     1033# x-axis name (x, x2, x3, etc.), and y is the y-axis name.
     1034# ----------------------------------------------------------------------
     1035itcl::body Rappture::XyResult::_getAxes {xydata} {
     1036    # rebuild if needed, so we know about the axes
     1037    if {[$_dispatcher ispending !rebuild]} {
     1038        $_dispatcher cancel !rebuild
     1039        $_dispatcher event -now !rebuild
     1040    }
     1041
     1042    # what is the x axis?  x? x2? x3? ...
     1043    set xlabel [$xydata hints xlabel]
     1044    if {[info exists _label2axis(x-$xlabel)]} {
     1045        set mapx $_label2axis(x-$xlabel)
     1046    } else {
     1047        set mapx "x"
     1048    }
     1049
     1050    # what is the y axis?  y? y2? y3? ...
     1051    set ylabel [$xydata hints ylabel]
     1052    if {[info exists _label2axis(y-$ylabel)]} {
     1053        set mapy $_label2axis(y-$ylabel)
     1054    } else {
     1055        set mapy "y"
     1056    }
     1057
     1058    return [list $mapx $mapy]
    9491059}
    9501060
Note: See TracChangeset for help on using the changeset viewer.