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