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