mingw/lib/tk8.4/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 # RCS: @(#) $Id: scale.tcl,v 1.9.2.5 2006/03/17 10:50:11 patthoyts Exp $
   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
  21 bind 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 }
  28 bind Scale <Motion> {
  29     tk::ScaleActivate %W %x %y
  30 }
  31 bind 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 }
  39 bind Scale <1> {
  40     tk::ScaleButtonDown %W %x %y
  41 }
  42 bind Scale <B1-Motion> {
  43     tk::ScaleDrag %W %x %y
  44 }
  45 bind Scale <B1-Leave> { }
  46 bind Scale <B1-Enter> { }
  47 bind Scale <ButtonRelease-1> {
  48     tk::CancelRepeat
  49     tk::ScaleEndDrag %W
  50     tk::ScaleActivate %W %x %y
  51 }
  52 bind Scale <2> {
  53     tk::ScaleButton2Down %W %x %y
  54 }
  55 bind Scale <B2-Motion> {
  56     tk::ScaleDrag %W %x %y
  57 }
  58 bind Scale <B2-Leave> { }
  59 bind Scale <B2-Enter> { }
  60 bind Scale <ButtonRelease-2> {
  61     tk::CancelRepeat
  62     tk::ScaleEndDrag %W
  63     tk::ScaleActivate %W %x %y
  64 }
  65 if {$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 }
  73 bind Scale <Control-1> {
  74     tk::ScaleControlPress %W %x %y
  75 }
  76 bind Scale <Up> {
  77     tk::ScaleIncrement %W up little noRepeat
  78 }
  79 bind Scale <Down> {
  80     tk::ScaleIncrement %W down little noRepeat
  81 }
  82 bind Scale <Left> {
  83     tk::ScaleIncrement %W up little noRepeat
  84 }
  85 bind Scale <Right> {
  86     tk::ScaleIncrement %W down little noRepeat
  87 }
  88 bind Scale <Control-Up> {
  89     tk::ScaleIncrement %W up big noRepeat
  90 }
  91 bind Scale <Control-Down> {
  92     tk::ScaleIncrement %W down big noRepeat
  93 }
  94 bind Scale <Control-Left> {
  95     tk::ScaleIncrement %W up big noRepeat
  96 }
  97 bind Scale <Control-Right> {
  98     tk::ScaleIncrement %W down big noRepeat
  99 }
 100 bind Scale <Home> {
 101     %W set [%W cget -from]
 102 }
 103 bind 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
 116 proc ::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
 138 proc ::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
 173 proc ::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
 188 proc ::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
 213 proc ::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
 253 proc ::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
 271 proc ::tk::ScaleButton2Down {w x y} {
 272     variable ::tk::Priv
 273
 274     if {[$w cget -state] eq "disabled"} {
 275       return
 276     }
 277     $w configure -state active
 278     $w set [$w get $x $y]
 279     set Priv(dragging) 1
 280     set Priv(initValue) [$w get]
 281     set Priv($w,relief) [$w cget -sliderrelief]
 282     set coords "$x $y"
 283     set Priv(deltaX) 0
 284     set Priv(deltaY) 0
 285 }