OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [library/] [scale.tcl] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# 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
# SCCS: @(#) scale.tcl 1.12 96/04/16 11:42:25
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 tkPriv(activeBg) [%W cget -activebackground]
24
        %W config -activebackground [%W cget -background]
25
    }
26
    tkScaleActivate %W %x %y
27
}
28
bind Scale <Motion> {
29
    tkScaleActivate %W %x %y
30
}
31
bind Scale <Leave> {
32
    if {$tk_strictMotif} {
33
        %W config -activebackground $tkPriv(activeBg)
34
    }
35
    if {[%W cget -state] == "active"} {
36
        %W configure -state normal
37
    }
38
}
39
bind Scale <1> {
40
    tkScaleButtonDown %W %x %y
41
}
42
bind Scale <B1-Motion> {
43
    tkScaleDrag %W %x %y
44
}
45
bind Scale <B1-Leave> { }
46
bind Scale <B1-Enter> { }
47
bind Scale <ButtonRelease-1> {
48
    tkCancelRepeat
49
    tkScaleEndDrag %W
50
    tkScaleActivate %W %x %y
51
}
52
bind Scale <2> {
53
    tkScaleButton2Down %W %x %y
54
}
55
bind Scale <B2-Motion> {
56
    tkScaleDrag %W %x %y
57
}
58
bind Scale <B2-Leave> { }
59
bind Scale <B2-Enter> { }
60
bind Scale <ButtonRelease-2> {
61
    tkCancelRepeat
62
    tkScaleEndDrag %W
63
    tkScaleActivate %W %x %y
64
}
65
bind Scale <Control-1> {
66
    tkScaleControlPress %W %x %y
67
}
68
bind Scale <Up> {
69
    tkScaleIncrement %W up little noRepeat
70
}
71
bind Scale <Down> {
72
    tkScaleIncrement %W down little noRepeat
73
}
74
bind Scale <Left> {
75
    tkScaleIncrement %W up little noRepeat
76
}
77
bind Scale <Right> {
78
    tkScaleIncrement %W down little noRepeat
79
}
80
bind Scale <Control-Up> {
81
    tkScaleIncrement %W up big noRepeat
82
}
83
bind Scale <Control-Down> {
84
    tkScaleIncrement %W down big noRepeat
85
}
86
bind Scale <Control-Left> {
87
    tkScaleIncrement %W up big noRepeat
88
}
89
bind Scale <Control-Right> {
90
    tkScaleIncrement %W down big noRepeat
91
}
92
bind Scale <Home> {
93
    %W set [%W cget -from]
94
}
95
bind Scale <End> {
96
    %W set [%W cget -to]
97
}
98
 
99
# tkScaleActivate --
100
# This procedure is invoked to check a given x-y position in the
101
# scale and activate the slider if the x-y position falls within
102
# the slider.
103
#
104
# Arguments:
105
# w -           The scale widget.
106
# x, y -        Mouse coordinates.
107
 
108
proc tkScaleActivate {w x y} {
109
    global tkPriv
110
    if {[$w cget -state] == "disabled"} {
111
        return;
112
    }
113
    if {[$w identify $x $y] == "slider"} {
114
        $w configure -state active
115
    } else {
116
        $w configure -state normal
117
    }
118
}
119
 
120
# tkScaleButtonDown --
121
# This procedure is invoked when a button is pressed in a scale.  It
122
# takes different actions depending on where the button was pressed.
123
#
124
# Arguments:
125
# w -           The scale widget.
126
# x, y -        Mouse coordinates of button press.
127
 
128
proc tkScaleButtonDown {w x y} {
129
    global tkPriv
130
    set tkPriv(dragging) 0
131
    set el [$w identify $x $y]
132
    if {$el == "trough1"} {
133
        tkScaleIncrement $w up little initial
134
    } elseif {$el == "trough2"} {
135
        tkScaleIncrement $w down little initial
136
    } elseif {$el == "slider"} {
137
        set tkPriv(dragging) 1
138
        set tkPriv(initValue) [$w get]
139
        set coords [$w coords]
140
        set tkPriv(deltaX) [expr {$x - [lindex $coords 0]}]
141
        set tkPriv(deltaY) [expr {$y - [lindex $coords 1]}]
142
        $w configure -sliderrelief sunken
143
    }
144
}
145
 
146
# tkScaleDrag --
147
# This procedure is called when the mouse is dragged with
148
# mouse button 1 down.  If the drag started inside the slider
149
# (i.e. the scale is active) then the scale's value is adjusted
150
# to reflect the mouse's position.
151
#
152
# Arguments:
153
# w -           The scale widget.
154
# x, y -        Mouse coordinates.
155
 
156
proc tkScaleDrag {w x y} {
157
    global tkPriv
158
    if {!$tkPriv(dragging)} {
159
        return
160
    }
161
    $w set [$w get [expr {$x - $tkPriv(deltaX)}] \
162
            [expr {$y - $tkPriv(deltaY)}]]
163
}
164
 
165
# tkScaleEndDrag --
166
# This procedure is called to end an interactive drag of the
167
# slider.  It just marks the drag as over.
168
#
169
# Arguments:
170
# w -           The scale widget.
171
 
172
proc tkScaleEndDrag {w} {
173
    global tkPriv
174
    set tkPriv(dragging) 0
175
    $w configure -sliderrelief raised
176
}
177
 
178
# tkScaleIncrement --
179
# This procedure is invoked to increment the value of a scale and
180
# to set up auto-repeating of the action if that is desired.  The
181
# way the value is incremented depends on the "dir" and "big"
182
# arguments.
183
#
184
# Arguments:
185
# w -           The scale widget.
186
# dir -         "up" means move value towards -from, "down" means
187
#               move towards -to.
188
# big -         Size of increments: "big" or "little".
189
# repeat -      Whether and how to auto-repeat the action:  "noRepeat"
190
#               means don't auto-repeat, "initial" means this is the
191
#               first action in an auto-repeat sequence, and "again"
192
#               means this is the second repetition or later.
193
 
194
proc tkScaleIncrement {w dir big repeat} {
195
    global tkPriv
196
    if {![winfo exists $w]} return
197
    if {$big == "big"} {
198
        set inc [$w cget -bigincrement]
199
        if {$inc == 0} {
200
            set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]
201
        }
202
        if {$inc < [$w cget -resolution]} {
203
            set inc [$w cget -resolution]
204
        }
205
    } else {
206
        set inc [$w cget -resolution]
207
    }
208
    if {([$w cget -from] > [$w cget -to]) ^ ($dir == "up")} {
209
        set inc [expr {-$inc}]
210
    }
211
    $w set [expr {[$w get] + $inc}]
212
 
213
    if {$repeat == "again"} {
214
        set tkPriv(afterId) [after [$w cget -repeatinterval] \
215
                tkScaleIncrement $w $dir $big again]
216
    } elseif {$repeat == "initial"} {
217
        set delay [$w cget -repeatdelay]
218
        if {$delay > 0} {
219
            set tkPriv(afterId) [after $delay \
220
                    tkScaleIncrement $w $dir $big again]
221
        }
222
    }
223
}
224
 
225
# tkScaleControlPress --
226
# This procedure handles button presses that are made with the Control
227
# key down.  Depending on the mouse position, it adjusts the scale
228
# value to one end of the range or the other.
229
#
230
# Arguments:
231
# w -           The scale widget.
232
# x, y -        Mouse coordinates where the button was pressed.
233
 
234
proc tkScaleControlPress {w x y} {
235
    set el [$w identify $x $y]
236
    if {$el == "trough1"} {
237
        $w set [$w cget -from]
238
    } elseif {$el == "trough2"} {
239
        $w set [$w cget -to]
240
    }
241
}
242
 
243
# tkScaleButton2Down
244
# This procedure is invoked when button 2 is pressed over a scale.
245
# It sets the value to correspond to the mouse position and starts
246
# a slider drag.
247
#
248
# Arguments:
249
# w -           The scrollbar widget.
250
# x, y -        Mouse coordinates within the widget.
251
 
252
proc tkScaleButton2Down {w x y} {
253
    global tkPriv
254
 
255
    if {[$w cget -state] == "disabled"} {
256
        return;
257
    }
258
    $w configure -state active
259
    $w set [$w get $x $y]
260
    set tkPriv(dragging) 1
261
    set tkPriv(initValue) [$w get]
262
    set coords "$x $y"
263
    set tkPriv(deltaX) 0
264
    set tkPriv(deltaY) 0
265
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.