Ignore:
Timestamp:
Jun 8, 2005 5:37:19 PM (19 years ago)
Author:
mmc
Message:

Many improvements, including a new energy level viewer
for Huckel-IV. Added support for a new <boolean> type.
Fixed the cloud/field stuff so that when a cloud is 1D,
it reverts to BLT vectors so it will plot correctly.
Fixed the install script to work better on Windows.

File:
1 edited

Legend:

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

    r12 r13  
    1616option add *XyResult.height 4i widgetDefault
    1717option add *XyResult.gridColor #d9d9d9 widgetDefault
     18option add *XyResult.hiliteColor black widgetDefault
     19option add *XyResult.controlBackground gray widgetDefault
    1820option add *XyResult.font \
    1921    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
    2022
     23blt::bitmap define ContourResult-reset {
     24#define reset_width 12
     25#define reset_height 12
     26static unsigned char reset_bits[] = {
     27   0x00, 0x00, 0x00, 0x00, 0xfc, 0x03, 0x04, 0x02, 0x04, 0x02, 0x04, 0x02,
     28   0x04, 0x02, 0x04, 0x02, 0x04, 0x02, 0xfc, 0x03, 0x00, 0x00, 0x00, 0x00};
     29}
     30
    2131itcl::class Rappture::XyResult {
    2232    inherit itk::Widget
    2333
    2434    itk_option define -gridcolor gridColor GridColor ""
     35    itk_option define -hilitecolor hiliteColor HiliteColor ""
    2536
    2637    constructor {args} { # defined below }
     
    2839
    2940    public method add {curve {settings ""}}
     41    public method get {}
    3042    public method delete {args}
    3143    public method scale {args}
     
    3345    protected method _rebuild {}
    3446    protected method _fixLimits {}
     47    protected method _zoom {option args}
     48    protected method _hilite {state x y}
    3549
    3650    private variable _clist ""     ;# list of curve objects
    3751    private variable _curve2color  ;# maps curve => plotting color
    3852    private variable _curve2width  ;# maps curve => line width
     53    private variable _curve2dashes ;# maps curve => BLT -dashes list
    3954    private variable _curve2raise  ;# maps curve => raise flag 0/1
    40     private variable _curve2elems  ;# maps curve => elements on graph
     55    private variable _elem2curve   ;# maps graph element => curve
    4156    private variable _xmin ""      ;# autoscale min for x-axis
    4257    private variable _xmax ""      ;# autoscale max for x-axis
    4358    private variable _ymin ""      ;# autoscale min for y-axis
    4459    private variable _ymax ""      ;# autoscale max for y-axis
     60    private variable _hilite ""    ;# info from last _hilite operation
    4561}
    4662                                                                               
     
    5571    option add hull.width hull.height
    5672    pack propagate $itk_component(hull) no
     73
     74    itk_component add controls {
     75        frame $itk_interior.cntls
     76    } {
     77        usual
     78        rename -background -controlbackground controlBackground Background
     79    }
     80    pack $itk_component(controls) -side right -fill y
     81
     82    itk_component add reset {
     83        button $itk_component(controls).reset \
     84            -borderwidth 1 -padx 1 -pady 1 \
     85            -bitmap ContourResult-reset \
     86            -command [itcl::code $this _zoom reset]
     87    } {
     88        usual
     89        ignore -borderwidth
     90        rename -highlightbackground -controlbackground controlBackground Background
     91    }
     92    pack $itk_component(reset) -padx 4 -pady 4
     93    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
     94
    5795
    5896    itk_component add plot {
     
    65103    pack $itk_component(plot) -expand yes -fill both
    66104
     105    # special pen for highlighting active traces
     106    $itk_component(plot) element bind all <Enter> \
     107        [itcl::code $this _hilite on %x %y]
     108    $itk_component(plot) element bind all <Leave> \
     109        [itcl::code $this _hilite off %x %y]
     110
    67111    Blt_ZoomStack $itk_component(plot)
    68112    $itk_component(plot) legend configure -hide yes
     
    81125#
    82126# Clients use this to add a curve to the plot.  The optional <settings>
    83 # are used to configure the plot.  Allowed settings are -color, -width,
    84 # and -raise.
     127# are used to configure the plot.  Allowed settings are -color,
     128# -brightness, -width, -linestyle and -raise.
    85129# ----------------------------------------------------------------------
    86130itcl::body Rappture::XyResult::add {curve {settings ""}} {
    87131    array set params {
    88132        -color black
     133        -brightness 0
    89134        -width 1
    90135        -raise 0
     136        -linestyle solid
    91137    }
    92138    foreach {opt val} $settings {
     
    95141        }
    96142        set params($opt) $val
     143    }
     144
     145    # convert -linestyle to BLT -dashes
     146    switch -- $params(-linestyle) {
     147        dashed { set params(-linestyle) {4 4} }
     148        dotted { set params(-linestyle) {2 4} }
     149        default { set params(-linestyle) {} }
     150    }
     151
     152    # if -brightness is set, then update the color
     153    if {$params(-brightness) != 0} {
     154        set params(-color) [Rappture::color::brightness \
     155            $params(-color) $params(-brightness)]
    97156    }
    98157
     
    102161        set _curve2color($curve) $params(-color)
    103162        set _curve2width($curve) $params(-width)
     163        set _curve2dashes($curve) $params(-linestyle)
    104164        set _curve2raise($curve) $params(-raise)
    105165
     
    107167        after idle [itcl::code $this _rebuild]
    108168    }
     169}
     170
     171# ----------------------------------------------------------------------
     172# USAGE: get
     173#
     174# Clients use this to query the list of objects being plotted, in
     175# order from bottom to top of this result.
     176# ----------------------------------------------------------------------
     177itcl::body Rappture::XyResult::get {} {
     178    # put the dataobj list in order according to -raise options
     179    set clist $_clist
     180    foreach obj $clist {
     181        if {[info exists _curve2raise($obj)] && $_curve2raise($obj)} {
     182            set i [lsearch -exact $clist $obj]
     183            if {$i >= 0} {
     184                set clist [lreplace $clist $i $i]
     185                lappend clist $obj
     186            }
     187        }
     188    }
     189    return $clist
    109190}
    110191
     
    128209            catch {unset _curve2color($curve)}
    129210            catch {unset _curve2width($curve)}
     211            catch {unset _curve2dashes($curve)}
    130212            catch {unset _curve2raise($curve)}
    131             catch {unset _curve2elems($curve)}
     213            foreach elem [array names _elem2curve] {
     214                if {$_elem2curve($elem) == $curve} {
     215                    unset _elem2curve($elem)
     216                }
     217            }
    132218            set changed 1
    133219        }
     
    191277
    192278    # extract axis information from the first curve
    193     set xydata [lindex $_clist 0]
     279    set clist [get]
     280    set xydata [lindex $clist 0]
    194281    if {$xydata != ""} {
    195282        set legend [$xydata hints legend]
     
    216303    # plot all of the curves
    217304    set count 0
    218     foreach xydata $_clist {
    219         set _curve2elems($xydata) ""
    220 
     305    foreach xydata $clist {
    221306        foreach comp [$xydata components] {
    222307            set xv [$xydata mesh $comp]
     
    238323            }
    239324
     325            if {[info exists _curve2dashes($xydata)]} {
     326                set dashes $_curve2dashes($xydata)
     327            } else {
     328                set dashes ""
     329            }
     330
     331            if {[$xv length] <= 1} {
     332                set sym square
     333            } else {
     334                set sym ""
     335            }
     336
    240337            set elem "elem[incr count]"
    241             lappend _curve2elems($xydata) $elem
     338            set _elem2curve($elem) $xydata
    242339
    243340            set label [$xydata hints label]
    244341            $g element create $elem -x $xv -y $yv \
    245                 -symbol "" -linewidth $lwidth -label $label -color $color
    246 
    247             set style [$xydata hints style]
    248             if {$style != ""} {
    249                 eval $g element configure $elem $style
    250             }
    251         }
    252     }
    253 
    254     # raise those tagged to be on top
    255     set dlist [$g element show]
    256     foreach xydata $_clist {
    257         if {[info exists _curve2raise($xydata)] && $_curve2raise($xydata)} {
    258             foreach elem $_curve2elems($xydata) {
    259                 set i [lsearch -exact $dlist $elem]
    260                 if {$i >= 0} {
    261                     # move element to end of display list
    262                     set dlist [lreplace $dlist $i $i]
    263                     lappend dlist $elem
    264                 }
    265             }
    266         }
    267     }
    268     $g element show $dlist
     342                -symbol $sym -pixels 6 -linewidth $lwidth -label $label \
     343                -color $color -dashes $dashes
     344        }
     345    }
    269346
    270347    _fixLimits
     
    287364    # limits.
    288365    #
    289     $g axis configure x -min $_xmin -max $_xmax
     366    if {$_xmin != $_xmax} {
     367        $g axis configure x -min $_xmin -max $_xmax
     368    } else {
     369        $g axis configure x -min "" -max ""
     370    }
    290371
    291372    if {"" != $_ymin && "" != $_ymax} {
     
    312393            }
    313394        }
    314         $g axis configure y -min $min -max $max
     395        if {$min != $max} {
     396            $g axis configure y -min $min -max $max
     397        } else {
     398            $g axis configure y -min "" -max ""
     399        }
    315400    } else {
    316401        $g axis configure y -min "" -max ""
     402    }
     403}
     404
     405# ----------------------------------------------------------------------
     406# USAGE: _zoom reset
     407#
     408# Called automatically when the user clicks on one of the zoom
     409# controls for this widget.  Changes the zoom for the current view.
     410# ----------------------------------------------------------------------
     411itcl::body Rappture::XyResult::_zoom {option args} {
     412    switch -- $option {
     413        reset {
     414            _fixLimits
     415        }
     416    }
     417}
     418
     419# ----------------------------------------------------------------------
     420# USAGE: _hilite <state> <x> <y>
     421#
     422# Called automatically when the user brushes one of the elements
     423# on the plot.  Causes the element to highlight and a tooltip to
     424# pop up with element info.
     425# ----------------------------------------------------------------------
     426itcl::body Rappture::XyResult::_hilite {state x y} {
     427    set elem [$itk_component(plot) element get current]
     428    if {$state} {
     429        #
     430        # Highlight ON:
     431        # - fatten line
     432        # - change color
     433        # - pop up tooltip about data
     434        #
     435        set t [$itk_component(plot) element cget $elem -linewidth]
     436        $itk_component(plot) element configure $elem -linewidth [expr {$t+2}]
     437
     438        set _hilite [$itk_component(plot) element cget $elem -color]
     439        $itk_component(plot) element configure $elem \
     440            -color $itk_option(-hilitecolor)
     441
     442        set tip ""
     443        if {[info exists _elem2curve($elem)]} {
     444            set curve $_elem2curve($elem)
     445            set tip [$curve hints tooltip]
     446        }
     447        if {"" != $tip} {
     448            set x [expr {$x+4}]  ;# move the tooltip over a bit
     449            set y [expr {$y+4}]
     450            Rappture::Tooltip::text $itk_component(plot) $tip
     451            Rappture::Tooltip::tooltip show $itk_component(plot) +$x,$y
     452        }
     453    } else {
     454        #
     455        # Highlight OFF:
     456        # - put line width back to normal
     457        # - put color back to normal
     458        # - take down tooltip
     459        #
     460        set t [$itk_component(plot) element cget $elem -linewidth]
     461        $itk_component(plot) element configure $elem -linewidth [expr {$t-2}]
     462
     463        if {"" != $_hilite} {
     464            $itk_component(plot) element configure $elem -color $_hilite
     465        }
     466        Rappture::Tooltip::tooltip cancel
    317467    }
    318468}
Note: See TracChangeset for help on using the changeset viewer.