diff options
Diffstat (limited to 'Master/tlpkg/tltcl/lib/tk8.6/scale.tcl')
-rw-r--r-- | Master/tlpkg/tltcl/lib/tk8.6/scale.tcl | 290 |
1 files changed, 290 insertions, 0 deletions
diff --git a/Master/tlpkg/tltcl/lib/tk8.6/scale.tcl b/Master/tlpkg/tltcl/lib/tk8.6/scale.tcl new file mode 100644 index 00000000000..fb9b81b26b0 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/scale.tcl @@ -0,0 +1,290 @@ +# scale.tcl -- +# +# This file defines the default bindings for Tk scale widgets and provides +# procedures that help in implementing the bindings. +# +# 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 tk::Priv(activeBg) [%W cget -activebackground] + %W configure -activebackground [%W cget -background] + } + tk::ScaleActivate %W %x %y +} +bind Scale <Motion> { + tk::ScaleActivate %W %x %y +} +bind Scale <Leave> { + if {$tk_strictMotif} { + %W configure -activebackground $tk::Priv(activeBg) + } + if {[%W cget -state] eq "active"} { + %W configure -state normal + } +} +bind Scale <1> { + tk::ScaleButtonDown %W %x %y +} +bind Scale <B1-Motion> { + tk::ScaleDrag %W %x %y +} +bind Scale <B1-Leave> { } +bind Scale <B1-Enter> { } +bind Scale <ButtonRelease-1> { + tk::CancelRepeat + tk::ScaleEndDrag %W + tk::ScaleActivate %W %x %y +} +bind Scale <2> { + tk::ScaleButton2Down %W %x %y +} +bind Scale <B2-Motion> { + tk::ScaleDrag %W %x %y +} +bind Scale <B2-Leave> { } +bind Scale <B2-Enter> { } +bind Scale <ButtonRelease-2> { + tk::CancelRepeat + tk::ScaleEndDrag %W + tk::ScaleActivate %W %x %y +} +if {[tk windowingsystem] eq "win32"} { + # On Windows do the same with button 3, as that is the right mouse button + bind Scale <3> [bind Scale <2>] + bind Scale <B3-Motion> [bind Scale <B2-Motion>] + bind Scale <B3-Leave> [bind Scale <B2-Leave>] + bind Scale <B3-Enter> [bind Scale <B2-Enter>] + bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>] +} +bind Scale <Control-1> { + tk::ScaleControlPress %W %x %y +} +bind Scale <<PrevLine>> { + tk::ScaleIncrement %W up little noRepeat +} +bind Scale <<NextLine>> { + tk::ScaleIncrement %W down little noRepeat +} +bind Scale <<PrevChar>> { + tk::ScaleIncrement %W up little noRepeat +} +bind Scale <<NextChar>> { + tk::ScaleIncrement %W down little noRepeat +} +bind Scale <<PrevPara>> { + tk::ScaleIncrement %W up big noRepeat +} +bind Scale <<NextPara>> { + tk::ScaleIncrement %W down big noRepeat +} +bind Scale <<PrevWord>> { + tk::ScaleIncrement %W up big noRepeat +} +bind Scale <<NextWord>> { + tk::ScaleIncrement %W down big noRepeat +} +bind Scale <<LineStart>> { + %W set [%W cget -from] +} +bind Scale <<LineEnd>> { + %W set [%W cget -to] +} + +# ::tk::ScaleActivate -- +# 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 ::tk::ScaleActivate {w x y} { + if {[$w cget -state] eq "disabled"} { + return + } + if {[$w identify $x $y] eq "slider"} { + set state active + } else { + set state normal + } + if {[$w cget -state] ne $state} { + $w configure -state $state + } +} + +# ::tk::ScaleButtonDown -- +# 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 ::tk::ScaleButtonDown {w x y} { + variable ::tk::Priv + set Priv(dragging) 0 + set el [$w identify $x $y] + + # save the relief + set Priv($w,relief) [$w cget -sliderrelief] + + if {$el eq "trough1"} { + ScaleIncrement $w up little initial + } elseif {$el eq "trough2"} { + ScaleIncrement $w down little initial + } elseif {$el eq "slider"} { + set Priv(dragging) 1 + set Priv(initValue) [$w get] + set coords [$w coords] + set Priv(deltaX) [expr {$x - [lindex $coords 0]}] + set Priv(deltaY) [expr {$y - [lindex $coords 1]}] + switch -exact -- $Priv($w,relief) { + "raised" { $w configure -sliderrelief sunken } + "ridge" { $w configure -sliderrelief groove } + } + } +} + +# ::tk::ScaleDrag -- +# 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 ::tk::ScaleDrag {w x y} { + variable ::tk::Priv + if {!$Priv(dragging)} { + return + } + $w set [$w get [expr {$x-$Priv(deltaX)}] [expr {$y-$Priv(deltaY)}]] +} + +# ::tk::ScaleEndDrag -- +# 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 ::tk::ScaleEndDrag {w} { + variable ::tk::Priv + set Priv(dragging) 0 + if {[info exists Priv($w,relief)]} { + $w configure -sliderrelief $Priv($w,relief) + unset Priv($w,relief) + } +} + +# ::tk::ScaleIncrement -- +# 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 ::tk::ScaleIncrement {w dir big repeat} { + variable ::tk::Priv + if {![winfo exists $w]} return + if {$big eq "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 eq "up")} { + if {$inc > 0} { + set inc [expr {-$inc}] + } + } else { + if {$inc < 0} { + set inc [expr {-$inc}] + } + } + $w set [expr {[$w get] + $inc}] + + if {$repeat eq "again"} { + set Priv(afterId) [after [$w cget -repeatinterval] \ + [list tk::ScaleIncrement $w $dir $big again]] + } elseif {$repeat eq "initial"} { + set delay [$w cget -repeatdelay] + if {$delay > 0} { + set Priv(afterId) [after $delay \ + [list tk::ScaleIncrement $w $dir $big again]] + } + } +} + +# ::tk::ScaleControlPress -- +# 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 ::tk::ScaleControlPress {w x y} { + set el [$w identify $x $y] + if {$el eq "trough1"} { + $w set [$w cget -from] + } elseif {$el eq "trough2"} { + $w set [$w cget -to] + } +} + +# ::tk::ScaleButton2Down +# 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 ::tk::ScaleButton2Down {w x y} { + variable ::tk::Priv + + if {[$w cget -state] eq "disabled"} { + return + } + + $w configure -state active + $w set [$w get $x $y] + set Priv(dragging) 1 + set Priv(initValue) [$w get] + set Priv($w,relief) [$w cget -sliderrelief] + set coords "$x $y" + set Priv(deltaX) 0 + set Priv(deltaY) 0 +} |