1# scale.tcl -- 2# 3# This file defines the default bindings for Tk scale widgets and provides 4# procedures that help in implementing the bindings. 5# 6# RCS: @(#) $Id$ 7# 8# Copyright (c) 1994 The Regents of the University of California. 9# Copyright (c) 1994-1995 Sun Microsystems, Inc. 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13# 14 15#------------------------------------------------------------------------- 16# The code below creates the default class bindings for entries. 17#------------------------------------------------------------------------- 18 19# Standard Motif bindings: 20 21bind Scale <Enter> { 22 if {$tk_strictMotif} { 23 set tk::Priv(activeBg) [%W cget -activebackground] 24 %W configure -activebackground [%W cget -background] 25 } 26 tk::ScaleActivate %W %x %y 27} 28bind Scale <Motion> { 29 tk::ScaleActivate %W %x %y 30} 31bind Scale <Leave> { 32 if {$tk_strictMotif} { 33 %W configure -activebackground $tk::Priv(activeBg) 34 } 35 if {[%W cget -state] eq "active"} { 36 %W configure -state normal 37 } 38} 39bind Scale <1> { 40 tk::ScaleButtonDown %W %x %y 41} 42bind Scale <B1-Motion> { 43 tk::ScaleDrag %W %x %y 44} 45bind Scale <B1-Leave> { } 46bind Scale <B1-Enter> { } 47bind Scale <ButtonRelease-1> { 48 tk::CancelRepeat 49 tk::ScaleEndDrag %W 50 tk::ScaleActivate %W %x %y 51} 52bind Scale <2> { 53 tk::ScaleButton2Down %W %x %y 54} 55bind Scale <B2-Motion> { 56 tk::ScaleDrag %W %x %y 57} 58bind Scale <B2-Leave> { } 59bind Scale <B2-Enter> { } 60bind Scale <ButtonRelease-2> { 61 tk::CancelRepeat 62 tk::ScaleEndDrag %W 63 tk::ScaleActivate %W %x %y 64} 65if {$tcl_platform(platform) eq "windows"} { 66 # On Windows do the same with button 3, as that is the right mouse button 67 bind Scale <3> [bind Scale <2>] 68 bind Scale <B3-Motion> [bind Scale <B2-Motion>] 69 bind Scale <B3-Leave> [bind Scale <B2-Leave>] 70 bind Scale <B3-Enter> [bind Scale <B2-Enter>] 71 bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>] 72} 73bind Scale <Control-1> { 74 tk::ScaleControlPress %W %x %y 75} 76bind Scale <Up> { 77 tk::ScaleIncrement %W up little noRepeat 78} 79bind Scale <Down> { 80 tk::ScaleIncrement %W down little noRepeat 81} 82bind Scale <Left> { 83 tk::ScaleIncrement %W up little noRepeat 84} 85bind Scale <Right> { 86 tk::ScaleIncrement %W down little noRepeat 87} 88bind Scale <Control-Up> { 89 tk::ScaleIncrement %W up big noRepeat 90} 91bind Scale <Control-Down> { 92 tk::ScaleIncrement %W down big noRepeat 93} 94bind Scale <Control-Left> { 95 tk::ScaleIncrement %W up big noRepeat 96} 97bind Scale <Control-Right> { 98 tk::ScaleIncrement %W down big noRepeat 99} 100bind Scale <Home> { 101 %W set [%W cget -from] 102} 103bind Scale <End> { 104 %W set [%W cget -to] 105} 106 107# ::tk::ScaleActivate -- 108# This procedure is invoked to check a given x-y position in the 109# scale and activate the slider if the x-y position falls within 110# the slider. 111# 112# Arguments: 113# w - The scale widget. 114# x, y - Mouse coordinates. 115 116proc ::tk::ScaleActivate {w x y} { 117 if {[$w cget -state] eq "disabled"} { 118 return 119 } 120 if {[$w identify $x $y] eq "slider"} { 121 set state active 122 } else { 123 set state normal 124 } 125 if {[$w cget -state] ne $state} { 126 $w configure -state $state 127 } 128} 129 130# ::tk::ScaleButtonDown -- 131# This procedure is invoked when a button is pressed in a scale. It 132# takes different actions depending on where the button was pressed. 133# 134# Arguments: 135# w - The scale widget. 136# x, y - Mouse coordinates of button press. 137 138proc ::tk::ScaleButtonDown {w x y} { 139 variable ::tk::Priv 140 set Priv(dragging) 0 141 set el [$w identify $x $y] 142 143 # save the relief 144 set Priv($w,relief) [$w cget -sliderrelief] 145 146 if {$el eq "trough1"} { 147 ScaleIncrement $w up little initial 148 } elseif {$el eq "trough2"} { 149 ScaleIncrement $w down little initial 150 } elseif {$el eq "slider"} { 151 set Priv(dragging) 1 152 set Priv(initValue) [$w get] 153 set coords [$w coords] 154 set Priv(deltaX) [expr {$x - [lindex $coords 0]}] 155 set Priv(deltaY) [expr {$y - [lindex $coords 1]}] 156 switch -exact -- $Priv($w,relief) { 157 "raised" { $w configure -sliderrelief sunken } 158 "ridge" { $w configure -sliderrelief groove } 159 } 160 } 161} 162 163# ::tk::ScaleDrag -- 164# This procedure is called when the mouse is dragged with 165# mouse button 1 down. If the drag started inside the slider 166# (i.e. the scale is active) then the scale's value is adjusted 167# to reflect the mouse's position. 168# 169# Arguments: 170# w - The scale widget. 171# x, y - Mouse coordinates. 172 173proc ::tk::ScaleDrag {w x y} { 174 variable ::tk::Priv 175 if {!$Priv(dragging)} { 176 return 177 } 178 $w set [$w get [expr {$x-$Priv(deltaX)}] [expr {$y-$Priv(deltaY)}]] 179} 180 181# ::tk::ScaleEndDrag -- 182# This procedure is called to end an interactive drag of the 183# slider. It just marks the drag as over. 184# 185# Arguments: 186# w - The scale widget. 187 188proc ::tk::ScaleEndDrag {w} { 189 variable ::tk::Priv 190 set Priv(dragging) 0 191 if {[info exists Priv($w,relief)]} { 192 $w configure -sliderrelief $Priv($w,relief) 193 unset Priv($w,relief) 194 } 195} 196 197# ::tk::ScaleIncrement -- 198# This procedure is invoked to increment the value of a scale and 199# to set up auto-repeating of the action if that is desired. The 200# way the value is incremented depends on the "dir" and "big" 201# arguments. 202# 203# Arguments: 204# w - The scale widget. 205# dir - "up" means move value towards -from, "down" means 206# move towards -to. 207# big - Size of increments: "big" or "little". 208# repeat - Whether and how to auto-repeat the action: "noRepeat" 209# means don't auto-repeat, "initial" means this is the 210# first action in an auto-repeat sequence, and "again" 211# means this is the second repetition or later. 212 213proc ::tk::ScaleIncrement {w dir big repeat} { 214 variable ::tk::Priv 215 if {![winfo exists $w]} return 216 if {$big eq "big"} { 217 set inc [$w cget -bigincrement] 218 if {$inc == 0} { 219 set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}] 220 } 221 if {$inc < [$w cget -resolution]} { 222 set inc [$w cget -resolution] 223 } 224 } else { 225 set inc [$w cget -resolution] 226 } 227 if {([$w cget -from] > [$w cget -to]) ^ ($dir eq "up")} { 228 set inc [expr {-$inc}] 229 } 230 $w set [expr {[$w get] + $inc}] 231 232 if {$repeat eq "again"} { 233 set Priv(afterId) [after [$w cget -repeatinterval] \ 234 [list tk::ScaleIncrement $w $dir $big again]] 235 } elseif {$repeat eq "initial"} { 236 set delay [$w cget -repeatdelay] 237 if {$delay > 0} { 238 set Priv(afterId) [after $delay \ 239 [list tk::ScaleIncrement $w $dir $big again]] 240 } 241 } 242} 243 244# ::tk::ScaleControlPress -- 245# This procedure handles button presses that are made with the Control 246# key down. Depending on the mouse position, it adjusts the scale 247# value to one end of the range or the other. 248# 249# Arguments: 250# w - The scale widget. 251# x, y - Mouse coordinates where the button was pressed. 252 253proc ::tk::ScaleControlPress {w x y} { 254 set el [$w identify $x $y] 255 if {$el eq "trough1"} { 256 $w set [$w cget -from] 257 } elseif {$el eq "trough2"} { 258 $w set [$w cget -to] 259 } 260} 261 262# ::tk::ScaleButton2Down 263# This procedure is invoked when button 2 is pressed over a scale. 264# It sets the value to correspond to the mouse position and starts 265# a slider drag. 266# 267# Arguments: 268# w - The scrollbar widget. 269# x, y - Mouse coordinates within the widget. 270 271proc ::tk::ScaleButton2Down {w x y} { 272 variable ::tk::Priv 273 274 if {[$w cget -state] eq "disabled"} { 275 return 276 } 277 278 $w configure -state active 279 $w set [$w get $x $y] 280 set Priv(dragging) 1 281 set Priv(initValue) [$w get] 282 set Priv($w,relief) [$w cget -sliderrelief] 283 set coords "$x $y" 284 set Priv(deltaX) 0 285 set Priv(deltaY) 0 286} 287