diff options
Diffstat (limited to 'library/scale.tcl')
| -rw-r--r-- | library/scale.tcl | 265 |
1 files changed, 265 insertions, 0 deletions
diff --git a/library/scale.tcl b/library/scale.tcl new file mode 100644 index 0000000..8e96176 --- /dev/null +++ b/library/scale.tcl @@ -0,0 +1,265 @@ +# scale.tcl -- +# +# This file defines the default bindings for Tk scale widgets and provides +# procedures that help in implementing the bindings. +# +# SCCS: @(#) scale.tcl 1.12 96/04/16 11:42:25 +# +# Copyright (c) 1994 The Regents of the University of California. +# Copyright (c) 1994-1995 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# + +#------------------------------------------------------------------------- +# The code below creates the default class bindings for entries. +#------------------------------------------------------------------------- + +# Standard Motif bindings: + +bind Scale <Enter> { + if $tk_strictMotif { + set tkPriv(activeBg) [%W cget -activebackground] + %W config -activebackground [%W cget -background] + } + tkScaleActivate %W %x %y +} +bind Scale <Motion> { + tkScaleActivate %W %x %y +} +bind Scale <Leave> { + if $tk_strictMotif { + %W config -activebackground $tkPriv(activeBg) + } + if {[%W cget -state] == "active"} { + %W configure -state normal + } +} +bind Scale <1> { + tkScaleButtonDown %W %x %y +} +bind Scale <B1-Motion> { + tkScaleDrag %W %x %y +} +bind Scale <B1-Leave> { } +bind Scale <B1-Enter> { } +bind Scale <ButtonRelease-1> { + tkCancelRepeat + tkScaleEndDrag %W + tkScaleActivate %W %x %y +} +bind Scale <2> { + tkScaleButton2Down %W %x %y +} +bind Scale <B2-Motion> { + tkScaleDrag %W %x %y +} +bind Scale <B2-Leave> { } +bind Scale <B2-Enter> { } +bind Scale <ButtonRelease-2> { + tkCancelRepeat + tkScaleEndDrag %W + tkScaleActivate %W %x %y +} +bind Scale <Control-1> { + tkScaleControlPress %W %x %y +} +bind Scale <Up> { + tkScaleIncrement %W up little noRepeat +} +bind Scale <Down> { + tkScaleIncrement %W down little noRepeat +} +bind Scale <Left> { + tkScaleIncrement %W up little noRepeat +} +bind Scale <Right> { + tkScaleIncrement %W down little noRepeat +} +bind Scale <Control-Up> { + tkScaleIncrement %W up big noRepeat +} +bind Scale <Control-Down> { + tkScaleIncrement %W down big noRepeat +} +bind Scale <Control-Left> { + tkScaleIncrement %W up big noRepeat +} +bind Scale <Control-Right> { + tkScaleIncrement %W down big noRepeat +} +bind Scale <Home> { + %W set [%W cget -from] +} +bind Scale <End> { + %W set [%W cget -to] +} + +# tkScaleActivate -- +# This procedure is invoked to check a given x-y position in the +# scale and activate the slider if the x-y position falls within +# the slider. +# +# Arguments: +# w - The scale widget. +# x, y - Mouse coordinates. + +proc tkScaleActivate {w x y} { + global tkPriv + if {[$w cget -state] == "disabled"} { + return; + } + if {[$w identify $x $y] == "slider"} { + $w configure -state active + } else { + $w configure -state normal + } +} + +# tkScaleButtonDown -- +# This procedure is invoked when a button is pressed in a scale. It +# takes different actions depending on where the button was pressed. +# +# Arguments: +# w - The scale widget. +# x, y - Mouse coordinates of button press. + +proc tkScaleButtonDown {w x y} { + global tkPriv + set tkPriv(dragging) 0 + set el [$w identify $x $y] + if {$el == "trough1"} { + tkScaleIncrement $w up little initial + } elseif {$el == "trough2"} { + tkScaleIncrement $w down little initial + } elseif {$el == "slider"} { + set tkPriv(dragging) 1 + set tkPriv(initValue) [$w get] + set coords [$w coords] + set tkPriv(deltaX) [expr $x - [lindex $coords 0]] + set tkPriv(deltaY) [expr $y - [lindex $coords 1]] + $w configure -sliderrelief sunken + } +} + +# tkScaleDrag -- +# This procedure is called when the mouse is dragged with +# mouse button 1 down. If the drag started inside the slider +# (i.e. the scale is active) then the scale's value is adjusted +# to reflect the mouse's position. +# +# Arguments: +# w - The scale widget. +# x, y - Mouse coordinates. + +proc tkScaleDrag {w x y} { + global tkPriv + if !$tkPriv(dragging) { + return + } + $w set [$w get [expr $x - $tkPriv(deltaX)] \ + [expr $y - $tkPriv(deltaY)]] +} + +# tkScaleEndDrag -- +# This procedure is called to end an interactive drag of the +# slider. It just marks the drag as over. +# +# Arguments: +# w - The scale widget. + +proc tkScaleEndDrag {w} { + global tkPriv + set tkPriv(dragging) 0 + $w configure -sliderrelief raised +} + +# tkScaleIncrement -- +# This procedure is invoked to increment the value of a scale and +# to set up auto-repeating of the action if that is desired. The +# way the value is incremented depends on the "dir" and "big" +# arguments. +# +# Arguments: +# w - The scale widget. +# dir - "up" means move value towards -from, "down" means +# move towards -to. +# big - Size of increments: "big" or "little". +# repeat - Whether and how to auto-repeat the action: "noRepeat" +# means don't auto-repeat, "initial" means this is the +# first action in an auto-repeat sequence, and "again" +# means this is the second repetition or later. + +proc tkScaleIncrement {w dir big repeat} { + global tkPriv + if {![winfo exists $w]} return + if {$big == "big"} { + set inc [$w cget -bigincrement] + if {$inc == 0} { + set inc [expr abs([$w cget -to] - [$w cget -from])/10.0] + } + if {$inc < [$w cget -resolution]} { + set inc [$w cget -resolution] + } + } else { + set inc [$w cget -resolution] + } + if {([$w cget -from] > [$w cget -to]) ^ ($dir == "up")} { + set inc [expr -$inc] + } + $w set [expr [$w get] + $inc] + + if {$repeat == "again"} { + set tkPriv(afterId) [after [$w cget -repeatinterval] \ + tkScaleIncrement $w $dir $big again] + } elseif {$repeat == "initial"} { + set delay [$w cget -repeatdelay] + if {$delay > 0} { + set tkPriv(afterId) [after $delay \ + tkScaleIncrement $w $dir $big again] + } + } +} + +# tkScaleControlPress -- +# This procedure handles button presses that are made with the Control +# key down. Depending on the mouse position, it adjusts the scale +# value to one end of the range or the other. +# +# Arguments: +# w - The scale widget. +# x, y - Mouse coordinates where the button was pressed. + +proc tkScaleControlPress {w x y} { + set el [$w identify $x $y] + if {$el == "trough1"} { + $w set [$w cget -from] + } elseif {$el == "trough2"} { + $w set [$w cget -to] + } +} + +# tkScaleButton2Down +# This procedure is invoked when button 2 is pressed over a scale. +# It sets the value to correspond to the mouse position and starts +# a slider drag. +# +# Arguments: +# w - The scrollbar widget. +# x, y - Mouse coordinates within the widget. + +proc tkScaleButton2Down {w x y} { + global tkPriv + + if {[$w cget -state] == "disabled"} { + return; + } + $w configure -state active + $w set [$w get $x $y] + set tkPriv(dragging) 1 + set tkPriv(initValue) [$w get] + set coords "$x $y" + set tkPriv(deltaX) 0 + set tkPriv(deltaY) 0 +} |