author | Jan Vrany <jan.vrany@fit.cvut.cz> |
Fri, 14 Jun 2019 12:45:30 +0100 | |
branch | jv |
changeset 6068 | 5e8b7ee23889 |
parent 5331 | 05820770f2af |
child 5474 | a28015d6ede0 |
permissions | -rw-r--r-- |
0 | 1 |
" |
4 | 2 |
COPYRIGHT (c) 1992 by Claus Gittinger |
24 | 3 |
All Rights Reserved |
0 | 4 |
|
5 |
This software is furnished under a license and may be used |
|
6 |
only in accordance with the terms of that license and with the |
|
7 |
inclusion of the above copyright notice. This software may not |
|
8 |
be provided or otherwise made available to, or used by, any |
|
9 |
other person. No title to or ownership of the software is |
|
10 |
hereby transferred. |
|
11 |
" |
|
4695 | 12 |
"{ Package: 'stx:libwidg2' }" |
0 | 13 |
|
4695 | 14 |
"{ NameSpace: Smalltalk }" |
1973 | 15 |
|
0 | 16 |
Scroller subclass:#Slider |
137 | 17 |
instanceVariableNames:'sliderHeight' |
18 |
classVariableNames:'' |
|
19 |
poolDictionaries:'' |
|
20 |
category:'Views-Interactors' |
|
0 | 21 |
! |
22 |
||
11 | 23 |
!Slider class methodsFor:'documentation'! |
24 |
||
25 |
copyright |
|
26 |
" |
|
27 |
COPYRIGHT (c) 1992 by Claus Gittinger |
|
24 | 28 |
All Rights Reserved |
0 | 29 |
|
11 | 30 |
This software is furnished under a license and may be used |
31 |
only in accordance with the terms of that license and with the |
|
32 |
inclusion of the above copyright notice. This software may not |
|
33 |
be provided or otherwise made available to, or used by, any |
|
34 |
other person. No title to or ownership of the software is |
|
35 |
hereby transferred. |
|
36 |
" |
|
37 |
! |
|
0 | 38 |
|
11 | 39 |
documentation |
40 |
" |
|
41 |
this class implements sliders - which are simply scrollers |
|
49 | 42 |
with a constant thumbHeight. For details on actionBlocks and |
43 |
MVC operation, see the documentation in Scroller. |
|
155 | 44 |
|
45 |
[author:] |
|
46 |
Claus Gittinger |
|
11 | 47 |
" |
48 | 48 |
! |
49 |
||
50 |
examples |
|
51 |
" |
|
52 |
a slider with action block (ST/X style): |
|
159 | 53 |
[exBegin] |
54 |
|top s| |
|
48 | 55 |
|
159 | 56 |
top := StandardSystemView new extent:200@200. |
57 |
s := Slider in:top. |
|
1973 | 58 |
s origin:(0.0@0.0) corner:(15@1.0). |
184 | 59 |
s scrollAction:[:percent | Transcript show:'moved to: '; showCR:percent asFloat]. |
159 | 60 |
top open |
61 |
[exEnd] |
|
48 | 62 |
|
49 | 63 |
same, horizontal: |
159 | 64 |
[exBegin] |
65 |
|top s| |
|
49 | 66 |
|
159 | 67 |
top := StandardSystemView new extent:200@200. |
68 |
s := HorizontalSlider in:top. |
|
1973 | 69 |
s origin:(0.0@0.0) corner:(1.0@15). |
184 | 70 |
s scrollAction:[:percent | Transcript show:'moved to: '; showCR:percent asFloat]. |
159 | 71 |
top open |
72 |
[exEnd] |
|
49 | 73 |
|
74 |
with a range other than the default: |
|
159 | 75 |
[exBegin] |
76 |
|top s| |
|
49 | 77 |
|
159 | 78 |
top := StandardSystemView new extent:200@200. |
79 |
s := Slider in:top. |
|
80 |
s origin:(0.0@0.0) corner:(20@1.0). |
|
184 | 81 |
s scrollAction:[:percent | Transcript show:'moved to: '; showCR:percent asFloat]. |
159 | 82 |
s start:-50 stop:50. |
83 |
top open |
|
84 |
[exEnd] |
|
49 | 85 |
|
48 | 86 |
using a model (ST-80 style): |
49 | 87 |
(see the changing value in the inspector) |
159 | 88 |
[exBegin] |
89 |
|top s m| |
|
48 | 90 |
|
159 | 91 |
m := 0 asValue. |
92 |
m inspect. |
|
93 |
top := StandardSystemView new extent:200@200. |
|
94 |
s := Slider in:top. |
|
95 |
s origin:(0.0@0.0) corner:(20@1.0). |
|
96 |
s model:m. |
|
97 |
top open |
|
98 |
[exEnd] |
|
48 | 99 |
|
100 |
reacting to changes from the model: |
|
49 | 101 |
(look at and/or change value using 'self value:' in the inspector). |
159 | 102 |
[exBegin] |
103 |
|top s m| |
|
48 | 104 |
|
159 | 105 |
m := 0 asValue. |
106 |
m inspect. |
|
107 |
top := StandardSystemView new extent:200@200. |
|
108 |
s := Slider in:top. |
|
109 |
s origin:(0.0@0.0) corner:(20@1.0). |
|
110 |
s model:m. |
|
111 |
top open |
|
112 |
[exEnd] |
|
48 | 113 |
|
114 |
using a different changeSelector: |
|
159 | 115 |
[exBegin] |
116 |
|top s1 s2 m| |
|
48 | 117 |
|
159 | 118 |
m := Plug new. |
184 | 119 |
m respondTo:#value1: with:[:v | Transcript show:'scroller 1 moved to: '; showCR:v]. |
120 |
m respondTo:#value2: with:[:v | Transcript show:'scroller 2 moved to: '; showCR:v]. |
|
48 | 121 |
|
159 | 122 |
top := StandardSystemView new extent:200@200. |
123 |
s1 := Slider in:top. |
|
124 |
s1 origin:(0.0@0.0) corner:(20@1.0). |
|
125 |
s1 thumbHeight:10. 'percent'. |
|
126 |
s1 model:m; change:#value1:. |
|
48 | 127 |
|
159 | 128 |
s2 := Slider in:top. |
129 |
s2 origin:(30@0.0) corner:(50@1.0). |
|
130 |
s2 thumbHeight:10. 'percent'. |
|
131 |
s2 model:m; change:#value2:. |
|
132 |
top open |
|
133 |
[exEnd] |
|
62 | 134 |
|
135 |
another example: |
|
159 | 136 |
[exBegin] |
137 |
|top redVal greenVal blueVal |
|
138 |
colorVal upd s1 s2 s3 l| |
|
62 | 139 |
|
159 | 140 |
redVal := 0 asValue. |
141 |
greenVal := 0 asValue. |
|
142 |
blueVal := 0 asValue. |
|
62 | 143 |
|
159 | 144 |
upd := [colorVal value:(Color red:redVal value |
145 |
green:greenVal value |
|
146 |
blue:blueVal value)]. |
|
62 | 147 |
|
159 | 148 |
colorVal := (Color red:0 green:0 blue:0) asValue. |
149 |
colorVal onChangeSend:#value to:[l backgroundColor:colorVal value]. |
|
62 | 150 |
|
159 | 151 |
redVal onChangeSend:#value to:upd. |
152 |
greenVal onChangeSend:#value to:upd. |
|
153 |
blueVal onChangeSend:#value to:upd. |
|
62 | 154 |
|
159 | 155 |
top := StandardSystemView new extent:200@200. |
156 |
top label:'Color mixer'. |
|
62 | 157 |
|
159 | 158 |
s1 := Slider in:top. |
159 |
s1 origin:(0.0@0.0) corner:(20@1.0). |
|
160 |
s1 thumbHeight:10. 'percent'. |
|
161 |
s1 model:redVal. |
|
62 | 162 |
|
159 | 163 |
s2 := Slider in:top. |
164 |
s2 origin:(30@0.0) corner:(50@1.0). |
|
165 |
s2 thumbHeight:10. 'percent'. |
|
166 |
s2 model:greenVal. |
|
62 | 167 |
|
159 | 168 |
s3 := Slider in:top. |
169 |
s3 origin:(60@0.0) corner:(80@1.0). |
|
170 |
s3 thumbHeight:10. 'percent'. |
|
171 |
s3 model:blueVal. |
|
62 | 172 |
|
159 | 173 |
l := Label in:top. |
174 |
l origin:90@0.0 corner:1.0@1.0. |
|
175 |
l backgroundColor:Color black. |
|
62 | 176 |
|
159 | 177 |
top open |
178 |
[exEnd] |
|
62 | 179 |
|
180 |
the same setup, using action blocks: |
|
159 | 181 |
[exBegin] |
182 |
|top red green blue |
|
183 |
colorVal upd s1 s2 s3 labelModel l| |
|
62 | 184 |
|
159 | 185 |
red := green := blue := 0. |
62 | 186 |
|
159 | 187 |
top := StandardSystemView new extent:200@200. |
188 |
top label:'Color mixer'. |
|
62 | 189 |
|
159 | 190 |
s1 := Slider in:top. |
191 |
s1 origin:(0.0@0.0) corner:(20@1.0). |
|
192 |
s1 thumbHeight:10. 'percent'. |
|
193 |
s1 action:[:percent | red := percent. |
|
194 |
l backgroundColor:(Color red:red green:green blue:blue)]. |
|
62 | 195 |
|
159 | 196 |
s2 := Slider in:top. |
197 |
s2 origin:(30@0.0) corner:(50@1.0). |
|
198 |
s2 thumbHeight:10. 'percent'. |
|
199 |
s2 action:[:percent | green := percent. |
|
200 |
l backgroundColor:(Color red:red green:green blue:blue)]. |
|
62 | 201 |
|
159 | 202 |
s3 := Slider in:top. |
203 |
s3 origin:(60@0.0) corner:(80@1.0). |
|
204 |
s3 thumbHeight:10. 'percent'. |
|
205 |
s3 action:[:percent | blue := percent. |
|
206 |
l backgroundColor:(Color red:red green:green blue:blue)]. |
|
62 | 207 |
|
159 | 208 |
l := Label in:top. |
209 |
l origin:90@0.0 corner:1.0@1.0. |
|
210 |
l backgroundColor:Color black. |
|
62 | 211 |
|
159 | 212 |
top open |
213 |
[exEnd] |
|
48 | 214 |
" |
11 | 215 |
! ! |
0 | 216 |
|
2495 | 217 |
!Slider methodsFor:'Compatibility-VW'! |
288 | 218 |
|
219 |
beHorizontal |
|
220 |
"ST-80 compatibility: make the slider a horizontalSlider" |
|
221 |
||
222 |
sliderHeight := (self horizontalPixelPerMillimeter:10) rounded. |
|
223 |
orientation := #horizontal |
|
224 |
||
225 |
"Created: 27.1.1997 / 13:46:42 / cg" |
|
226 |
! |
|
227 |
||
228 |
beVertical |
|
229 |
"ST-80 compatibility: make the slider a verticalSlider" |
|
230 |
||
231 |
sliderHeight := (self verticalPixelPerMillimeter:10) rounded. |
|
232 |
orientation := #vertical |
|
233 |
||
234 |
"Created: 27.1.1997 / 13:47:07 / cg" |
|
235 |
! ! |
|
236 |
||
100 | 237 |
!Slider methodsFor:'accessing'! |
238 |
||
4695 | 239 |
sliderHeight: numPixels |
2700 | 240 |
|
4695 | 241 |
sliderHeight := numPixels. |
2700 | 242 |
! |
243 |
||
100 | 244 |
thumbHeight |
245 |
"redefined since a slider has no height - just origin" |
|
246 |
||
247 |
^ nil |
|
248 |
! ! |
|
0 | 249 |
|
870 | 250 |
!Slider methodsFor:'event handling'! |
251 |
||
1583
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
252 |
buttonPress:butt x:x y:y |
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
253 |
self requestFocus. |
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
254 |
super buttonPress:butt x:x y:y |
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
255 |
! |
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
256 |
|
870 | 257 |
keyPress:key x:x y:y |
1985
1e21a6928dfb
stc does not understand + and - in resources.
Stefan Vogel <sv@exept.de>
parents:
1983
diff
changeset
|
258 |
<resource: #keyboard (#CursorRight #CursorUp #CursorLeft #CursorDown)> |
1973 | 259 |
|
1197
bfccea7d6d80
use keyboardStep value if non-nil.
Claus Gittinger <cg@exept.de>
parents:
1098
diff
changeset
|
260 |
|step| |
1098 | 261 |
|
262 |
enabled ifFalse:[^ self]. |
|
263 |
||
5331 | 264 |
step := keyboardStep ? ((rangeEnd - rangeStart) / 10). |
1198 | 265 |
|
1983
ee3be6ecc37a
Move left with cursor left and right with cursor right
Stefan Vogel <sv@exept.de>
parents:
1973
diff
changeset
|
266 |
(key == #CursorLeft |
870 | 267 |
or:[key == #CursorUp |
1983
ee3be6ecc37a
Move left with cursor left and right with cursor right
Stefan Vogel <sv@exept.de>
parents:
1973
diff
changeset
|
268 |
or:[key == $-]]) ifTrue:[ |
ee3be6ecc37a
Move left with cursor left and right with cursor right
Stefan Vogel <sv@exept.de>
parents:
1973
diff
changeset
|
269 |
self scrollStep:step negated. |
870 | 270 |
^ self |
271 |
]. |
|
272 |
||
1983
ee3be6ecc37a
Move left with cursor left and right with cursor right
Stefan Vogel <sv@exept.de>
parents:
1973
diff
changeset
|
273 |
(key == #CursorRight |
870 | 274 |
or:[key == #CursorDown |
1983
ee3be6ecc37a
Move left with cursor left and right with cursor right
Stefan Vogel <sv@exept.de>
parents:
1973
diff
changeset
|
275 |
or:[key == $+]]) ifTrue:[ |
ee3be6ecc37a
Move left with cursor left and right with cursor right
Stefan Vogel <sv@exept.de>
parents:
1973
diff
changeset
|
276 |
self scrollStep:step. |
870 | 277 |
^ self |
278 |
]. |
|
279 |
||
280 |
super keyPress:key x:x y:y |
|
5331 | 281 |
|
282 |
"Modified (format): / 16-11-2016 / 23:13:56 / cg" |
|
870 | 283 |
! ! |
284 |
||
100 | 285 |
!Slider methodsFor:'forced scroll'! |
286 |
||
287 |
pageDown |
|
288 |
"ignored - a slider has no concept of page-wise scrolling" |
|
8 | 289 |
|
100 | 290 |
^ self |
291 |
! |
|
292 |
||
293 |
pageUp |
|
294 |
"ignored - a slider has no concept of page-wise scrolling" |
|
24 | 295 |
|
100 | 296 |
^ self |
297 |
! ! |
|
298 |
||
299 |
!Slider methodsFor:'initialization'! |
|
300 |
||
301 |
initStyle |
|
281 | 302 |
"initialize style specifics" |
303 |
||
559 | 304 |
<resource: #style (#'slider.NTallyMarks' #'slider.tallyLevel')> |
165 | 305 |
|
100 | 306 |
super initStyle. |
0 | 307 |
|
559 | 308 |
tallyMarks := StyleSheet at:'slider.NTallyMarks' default:1. |
309 |
tallyLevel := StyleSheet at:'slider.tallyLevel' default:-1. |
|
137 | 310 |
thumbActiveLevel := thumbLevel. |
311 |
||
888 | 312 |
"Modified: / 12.5.1998 / 21:01:43 / cg" |
49 | 313 |
! |
0 | 314 |
|
100 | 315 |
initialize |
316 |
sliderHeight := (self verticalPixelPerMillimeter:10) rounded. |
|
317 |
super initialize. |
|
318 |
thumbHeight := 0. |
|
319 |
! ! |
|
320 |
||
321 |
!Slider methodsFor:'private'! |
|
322 |
||
0 | 323 |
absFromPercent:percent |
324 |
"given a percentage, compute number of pixels" |
|
325 |
||
49 | 326 |
|fullSize| |
0 | 327 |
|
49 | 328 |
(orientation == #vertical) ifTrue:[ |
329 |
fullSize := height |
|
330 |
] ifFalse:[ |
|
331 |
fullSize := width |
|
332 |
]. |
|
333 |
^ ((percent * (fullSize - sliderHeight - (margin * 2))) / 100) rounded |
|
0 | 334 |
! |
335 |
||
336 |
computeThumbFrame |
|
337 |
"redefined, since the thumb-height stays constant" |
|
338 |
||
49 | 339 |
|nh nw ny nx sz m| |
0 | 340 |
|
341 |
thumbHeight := 0. |
|
49 | 342 |
sz := (self absFromPercent:thumbOrigin) + margin. |
343 |
m := margin + inset. |
|
344 |
(orientation == #vertical) ifTrue:[ |
|
345 |
ny := sz. |
|
346 |
nh := sliderHeight. |
|
347 |
nx := m. |
|
348 |
nw := width - (2 * nx). |
|
349 |
] ifFalse:[ |
|
350 |
nx := sz. |
|
351 |
nw := sliderHeight. |
|
352 |
ny := m. |
|
353 |
nh := height - (2 * ny). |
|
354 |
]. |
|
355 |
||
0 | 356 |
" |
357 |
do not create new Rectangle if its the same anyway |
|
358 |
" |
|
359 |
thumbFrame notNil ifTrue:[ |
|
24 | 360 |
(ny == thumbFrame top) ifTrue:[ |
361 |
(nx == thumbFrame left) ifTrue:[ |
|
362 |
(nh == thumbFrame height) ifTrue:[ |
|
363 |
(nw == thumbFrame width) ifTrue:[ ^ self] |
|
364 |
] |
|
365 |
] |
|
366 |
] |
|
0 | 367 |
]. |
368 |
thumbFrame := Rectangle left:nx top:ny width:nw height:nh |
|
49 | 369 |
! |
370 |
||
100 | 371 |
percentFromAbs:absValue |
372 |
"given a number of pixels, compute percentage" |
|
373 |
||
374 |
|fullSize val| |
|
375 |
||
376 |
(orientation == #vertical) ifTrue:[ |
|
672
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
377 |
fullSize := height |
100 | 378 |
] ifFalse:[ |
672
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
379 |
fullSize := width |
100 | 380 |
]. |
381 |
||
672
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
382 |
absValue < 0 ifTrue:[^ rangeStart]. |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
383 |
absValue > fullSize ifTrue:[^ rangeEnd]. |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
384 |
|
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
385 |
val := absValue / (fullSize - sliderHeight - (margin * 2)) |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
386 |
* (rangeEnd - rangeStart). |
100 | 387 |
val := val + rangeStart. |
672
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
388 |
rangeStart < rangeEnd ifTrue:[ |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
389 |
val < rangeStart ifTrue:[^ rangeStart]. |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
390 |
val > rangeEnd ifTrue:[^ rangeEnd]. |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
391 |
] ifFalse:[ |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
392 |
val > rangeStart ifTrue:[^ rangeStart]. |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
393 |
val < rangeEnd ifTrue:[^ rangeEnd]. |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
394 |
]. |
100 | 395 |
^ val |
672
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
396 |
|
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
397 |
"Modified: / 21.1.1998 / 19:31:08 / cg" |
49 | 398 |
! ! |
399 |
||
100 | 400 |
!Slider class methodsFor:'documentation'! |
49 | 401 |
|
100 | 402 |
version |
5331 | 403 |
^ '$Header$' |
49 | 404 |
! ! |
4695 | 405 |