1# This file is a Tcl script to test out the "scale" command
2# of Tk.  It is organized in the standard fashion for Tcl tests.
3#
4# Copyright (c) 1994 The Regents of the University of California.
5# Copyright (c) 1994-1996 Sun Microsystems, Inc.
6# Copyright (c) 1998-1999 by Scriptics Corporation.
7# All rights reserved.
8#
9# RCS: @(#) $Id: scale.test,v 1.12.2.1 2003/08/13 10:59:33 patthoyts Exp $
10
11package require tcltest 2.1
12namespace import -force tcltest::configure
13namespace import -force tcltest::testsDirectory
14configure -testdir [file join [pwd] [file dirname [info script]]]
15configure -loadfile [file join [testsDirectory] constraints.tcl]
16tcltest::loadTestedCommands
17
18# Create entries in the option database to be sure that geometry options
19# like border width have predictable values.
20
21option add *Scale.borderWidth 2
22option add *Scale.highlightThickness 2
23option add *Scale.font {Helvetica -12 bold}
24
25scale .s -from 100 -to 300
26pack .s
27update
28set i 1
29foreach test {
30    {-activebackground #ff0000 #ff0000 non-existent
31	    {unknown color name "non-existent"}}
32    {-background #ff0000 #ff0000 non-existent
33	    {unknown color name "non-existent"}}
34    {-bd 4 4 badValue {bad screen distance "badValue"}}
35    {-bigincrement 12.5 12.5 badValue
36	    {expected floating-point number but got "badValue"}}
37    {-bg #ff0000 #ff0000 non-existent
38	    {unknown color name "non-existent"}}
39    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
40    {-command "set x" {set x} {} {}}
41    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
42    {-digits 5 5 badValue {expected integer but got "badValue"}}
43    {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}}
44    {-font fixed fixed {} {font "" doesn't exist}}
45    {-foreground green green badValue {unknown color name "badValue"}}
46    {-from -15.0 -15.0 badValue
47	    {expected floating-point number but got "badValue"}}
48    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
49    {-highlightcolor #123456 #123456 non-existent
50	    {unknown color name "non-existent"}}
51    {-highlightthickness 2 2 badValue {bad screen distance "badValue"}}
52    {-label "Some text" {Some text} {} {}}
53    {-length 130 130 badValue {bad screen distance "badValue"}}
54    {-orient horizontal horizontal badValue
55	    {bad orient "badValue": must be horizontal or vertical}}
56    {-orient horizontal horizontal {} {}}
57    {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
58    {-repeatdelay 14 14 bogus {expected integer but got "bogus"}}
59    {-repeatinterval 14 14 bogus {expected integer but got "bogus"}}
60    {-resolution 2.0 2.0 badValue
61	    {expected floating-point number but got "badValue"}}
62    {-showvalue 0 0 badValue {expected boolean value but got "badValue"}}
63    {-sliderlength 86 86 badValue {bad screen distance "badValue"}}
64    {-sliderrelief raised raised badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
65    {-state d disabled badValue
66	    {bad state "badValue": must be active, disabled, or normal}}
67    {-state n normal {} {}}
68    {-takefocus "any string" "any string" {} {}}
69    {-tickinterval 4.3 4.0 badValue
70	    {expected floating-point number but got "badValue"}}
71    {-to 14.9 15.0 badValue
72	    {expected floating-point number but got "badValue"}}
73    {-troughcolor #ff0000 #ff0000 non-existent
74	    {unknown color name "non-existent"}}
75    {-variable x x {} {}}
76    {-width 32 32 badValue {bad screen distance "badValue"}}
77} {
78    set name [lindex $test 0]
79    test scale-1.$i {configuration options} {
80	.s configure $name [lindex $test 1]
81	lindex [.s configure $name] 4
82    } [lindex $test 2]
83    incr i
84    if {[lindex $test 3] != ""} {
85	test scale-1.$i {configuration options} {
86	    list [catch {.s configure $name [lindex $test 3]} msg] $msg
87	} [list 1 [lindex $test 4]]
88    }
89    .s configure $name [lindex [.s configure $name] 3]
90    incr i
91}
92destroy .s
93
94test scale-2.1 {Tk_ScaleCmd procedure} {
95    list [catch {scale} msg] $msg
96} {1 {wrong # args: should be "scale pathName ?options?"}}
97test scale-2.2 {Tk_ScaleCmd procedure} {
98    list [catch {scale foo} msg] $msg [winfo child .]
99} {1 {bad window path name "foo"} {}}
100test scale-2.3 {Tk_ScaleCmd procedure} {
101    list [catch {scale .s -gorp dumb} msg] $msg [winfo child .]
102} {1 {unknown option "-gorp"} {}}
103
104scale .s -from 100 -to 200
105pack .s
106update idletasks
107test scale-3.1 {ScaleWidgetCmd procedure} {
108    list [catch {.s} msg] $msg
109} {1 {wrong # args: should be ".s option ?arg arg ...?"}}
110test scale-3.2 {ScaleWidgetCmd procedure, cget option} {
111    list [catch {.s cget} msg] $msg
112} {1 {wrong # args: should be ".s cget option"}}
113test scale-3.3 {ScaleWidgetCmd procedure, cget option} {
114    list [catch {.s cget a b} msg] $msg
115} {1 {wrong # args: should be ".s cget option"}}
116test scale-3.4 {ScaleWidgetCmd procedure, cget option} {
117    list [catch {.s cget -gorp} msg] $msg
118} {1 {unknown option "-gorp"}}
119test scale-3.5 {ScaleWidgetCmd procedure, cget option} {
120    .s cget -highlightthickness
121} {2}
122test scale-3.6 {ScaleWidgetCmd procedure, configure option} {
123    list [llength [.s configure]] [lindex [.s configure] 6]
124} {33 {-command command Command {} {}}}
125test scale-3.7 {ScaleWidgetCmd procedure, configure option} {
126    list [catch {.s configure -foo} msg] $msg
127} {1 {unknown option "-foo"}}
128test scale-3.8 {ScaleWidgetCmd procedure, configure option} {
129    list [catch {.s configure -borderwidth 2 -bg} msg] $msg
130} {1 {value for "-bg" missing}}
131test scale-3.9 {ScaleWidgetCmd procedure, coords option} {
132    list [catch {.s coords a b} msg] $msg
133} {1 {wrong # args: should be ".s coords ?value?"}}
134test scale-3.10 {ScaleWidgetCmd procedure, coords option} {
135    list [catch {.s coords bad} msg] $msg
136} {1 {expected floating-point number but got "bad"}}
137test scale-3.11 {ScaleWidgetCmd procedure} {fonts} {
138    .s set 120
139    .s coords
140} {38 34}
141test scale-3.12 {ScaleWidgetCmd procedure, coords option} {fonts} {
142    .s configure -orient horizontal
143    update
144    .s set 120
145    .s coords
146} {34 31}
147.s configure -orient vertical
148update
149test scale-3.13 {ScaleWidgetCmd procedure, get option} {
150    list [catch {.s get a} msg] $msg
151} {1 {wrong # args: should be ".s get ?x y?"}}
152test scale-3.14 {ScaleWidgetCmd procedure, get option} {
153    list [catch {.s get a b c} msg] $msg
154} {1 {wrong # args: should be ".s get ?x y?"}}
155test scale-3.15 {ScaleWidgetCmd procedure, get option} {
156    list [catch {.s get a 11} msg] $msg
157} {1 {expected integer but got "a"}}
158test scale-3.16 {ScaleWidgetCmd procedure, get option} {
159    list [catch {.s get 12 b} msg] $msg
160} {1 {expected integer but got "b"}}
161test scale-3.17 {ScaleWidgetCmd procedure, get option} {
162    .s set 133
163    .s get
164} 133
165test scale-3.18 {ScaleWidgetCmd procedure, get option} {
166    .s configure -resolution 0.5
167    .s set 150
168    .s get 37 34
169} 119.5
170.s configure -resolution 1
171test scale-3.19 {ScaleWidgetCmd procedure, identify option} {
172    list [catch {.s identify} msg] $msg
173} {1 {wrong # args: should be ".s identify x y"}}
174test scale-3.20 {ScaleWidgetCmd procedure, identify option} {
175    list [catch {.s identify 1 2 3} msg] $msg
176} {1 {wrong # args: should be ".s identify x y"}}
177test scale-3.21 {ScaleWidgetCmd procedure, identify option} {
178    list [catch {.s identify boo 16} msg] $msg
179} {1 {expected integer but got "boo"}}
180test scale-3.22 {ScaleWidgetCmd procedure, identify option} {
181    list [catch {.s identify 17 bad} msg] $msg
182} {1 {expected integer but got "bad"}}
183test scale-3.23 {ScaleWidgetCmd procedure, identify option} {fonts} {
184    .s set 120
185    list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80]
186} {trough1 slider trough2 {}}
187test scale-3.24 {ScaleWidgetCmd procedure, set option} {
188    list [catch {.s set} msg] $msg
189} {1 {wrong # args: should be ".s set value"}}
190test scale-3.25 {ScaleWidgetCmd procedure, set option} {
191    list [catch {.s set a b} msg] $msg
192} {1 {wrong # args: should be ".s set value"}}
193test scale-3.26 {ScaleWidgetCmd procedure, set option} {
194    list [catch {.s set bad} msg] $msg
195} {1 {expected floating-point number but got "bad"}}
196test scale-3.27 {ScaleWidgetCmd procedure, set option} {
197    .s set 142
198} {}
199test scale-3.28 {ScaleWidgetCmd procedure, set option} {
200    .s set 118
201    .s configure -state disabled
202    .s set 181
203    .s configure -state normal
204    .s get
205} {118}
206test scale-3.29 {ScaleWidgetCmd procedure} {
207    list [catch {.s dumb} msg] $msg
208} {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}}
209test scale-3.30 {ScaleWidgetCmd procedure} {
210    list [catch {.s c} msg] $msg
211} {1 {ambiguous option "c": must be cget, configure, coords, get, identify, or set}}
212test scale-3.31 {ScaleWidgetCmd procedure} {
213    list [catch {.s co} msg] $msg
214} {1 {ambiguous option "co": must be cget, configure, coords, get, identify, or set}}
215test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} {
216    proc kill args {
217	destroy .s
218    }
219    catch {destroy .s}
220    scale .s -variable x -from 0 -to 100 -orient horizontal
221    pack .s
222    update
223    .s configure -command kill
224    .s set 55
225} {}
226
227test scale-4.1 {DestroyScale procedure} {
228    catch {destroy .s}
229    set x 50
230    scale .s -variable x -from 0 -to 100 -orient horizontal
231    pack .s
232    update
233    destroy .s
234    list [catch {set x foo} msg] $msg $x
235} {0 foo foo}
236
237test scale-5.1 {ConfigureScale procedure} {
238    catch {destroy .s}
239    set x 66
240    set y 77
241    scale .s -variable x -from 0 -to 100
242    pack .s
243    update
244    .s configure -variable y
245    list [catch {set x foo} msg] $msg $x [.s get]
246} {0 foo foo 77}
247test scale-5.2 {ConfigureScale procedure} {
248    catch {destroy .s}
249    scale .s -from 0 -to 100
250    list [catch {.s configure -foo bar} msg] $msg
251} {1 {unknown option "-foo"}}
252test scale-5.3 {ConfigureScale procedure} {
253    catch {destroy .s}
254    catch {unset x}
255    scale .s -from 0 -to 100 -variable x
256    set result $x
257    lappend result [.s get]
258    set x 92
259    lappend result [.s get]
260    .s set 3
261    lappend result $x
262    unset x
263    lappend result [catch {set x} msg] $msg
264} {0 0 92 3 0 3}
265test scale-5.4 {ConfigureScale procedure} {
266    catch {destroy .s}
267    scale .s -from 0 -to 100
268    list [catch {.s configure -orient dumb} msg] $msg
269} {1 {bad orient "dumb": must be horizontal or vertical}}
270test scale-5.5 {ConfigureScale procedure} {
271    catch {destroy .s}
272    scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76
273    list [format %.1f [.s cget -from]] [format %.1f [.s cget -to]] \
274	    [format %.1f [.s cget -tickinterval]]
275} {1.1 1.9 0.8}
276test scale-5.6 {ConfigureScale procedure} {
277    catch {destroy .s}
278    scale .s -from 1 -to 10 -tickinterval -2
279    pack .s
280    set result [lindex [.s configure -tickinterval] 4]
281    .s configure -from 10 -to 1 -tickinterval 2
282    lappend result [lindex [.s configure -tickinterval] 4]
283} {2.0 -2.0}
284test scale-5.7 {ConfigureScale procedure} {
285    catch {destroy .s}
286    list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg
287} {1 {bad state "bogus": must be active, disabled, or normal}}
288
289catch {destroy .s}
290scale .s -orient horizontal -length 200
291pack .s
292test scale-6.1 {ComputeFormat procedure} {
293    .s configure -from 10 -to 100 -resolution 10
294    .s set 49.3
295    .s get
296} {50}
297test scale-6.2 {ComputeFormat procedure} {
298    .s configure -from 100 -to 1000 -resolution 100
299    .s set 493
300    .s get
301} {500}
302test scale-6.3 {ComputeFormat procedure} {
303    .s configure -from 1000 -to 10000 -resolution 1000
304    .s set 4930
305    .s get
306} {5000}
307test scale-6.4 {ComputeFormat procedure} {
308    .s configure -from 10000 -to 100000 -resolution 10000
309    .s set 49000
310    .s get
311} {50000}
312test scale-6.5 {ComputeFormat procedure} {
313    .s configure -from 100000 -to 1000000 -resolution 100000
314    .s set 493000
315    .s get
316} {500000}
317test scale-6.6 {ComputeFormat procedure} {nonPortable} {
318    # This test is non-portable because some platforms format the
319    # result as 5e+06.
320
321    .s configure -from 1000000 -to 10000000 -resolution 1000000
322    .s set 4930000
323    .s get
324} {5000000}
325test scale-6.7 {ComputeFormat procedure} {
326    .s configure -from 1000000000 -to 10000000000 -resolution 1000000000
327    .s set 4930000000
328    expr {[.s get] == 5.0e+09}
329} 1
330test scale-6.8 {ComputeFormat procedure} {
331    .s configure -from .1 -to 1 -resolution .1
332    .s set .6
333    .s get
334} {0.6}
335test scale-6.9 {ComputeFormat procedure} {
336    .s configure -from .01 -to .1 -resolution .01
337    .s set .06
338    .s get
339} {0.06}
340test scale-6.10 {ComputeFormat procedure} {
341    .s configure -from .001 -to .01 -resolution .001
342    .s set .006
343    .s get
344} {0.006}
345test scale-6.11 {ComputeFormat procedure} {
346    .s configure -from .0001 -to .001 -resolution .0001
347    .s set .0006
348    .s get
349} {0.0006}
350test scale-6.12 {ComputeFormat procedure} {
351    .s configure -from .00001 -to .0001 -resolution .00001
352    .s set .00006
353    .s get
354} {0.00006}
355test scale-6.13 {ComputeFormat procedure} {
356    .s configure -from .000001 -to .00001 -resolution .000001
357    .s set .000006
358    expr {[.s get] == 6.0e-06}
359} {1}
360test scale-6.14 {ComputeFormat procedure} {
361    .s configure -to .00001 -from .0001 -resolution .00001
362    .s set .00006
363    .s get
364} {0.00006}
365test scale-6.15 {ComputeFormat procedure} {
366    .s configure -to .000001 -from .00001 -resolution .000001
367    .s set .000006
368    expr {[.s get] == 6.0e-06}
369} {1}
370test scale-6.16 {ComputeFormat procedure} {
371    .s configure -from .00001 -to .0001 -resolution .00001 -digits 1
372    .s set .00006
373    expr {[.s get] == 6e-05}
374} {1}
375test scale-6.17 {ComputeFormat procedure} {
376    .s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3
377    .s set 49300000
378    .s get
379} {50000000}
380test scale-6.18 {ComputeFormat procedure} {
381    .s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0
382    .s set .111111111
383    .s get
384} {0.11}
385test scale-6.19 {ComputeFormat procedure} {
386    .s configure -length 200 -from 1000 -to 1002 -resolution 0 -digits 0
387    .s set 1001.23456789
388    .s get
389} {1001.23}
390test scale-6.20 {ComputeFormat procedure} {
391    .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 0
392    .s set 1001.23456789
393    .s get
394} {1001.235}
395
396test scale-7.1 {ComputeScaleGeometry procedure} {nonPortable fonts} {
397    catch {destroy .s}
398    scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i
399    pack .s
400    update
401    list [winfo reqwidth .s] [winfo reqheight .s]
402} {88 458}
403test scale-7.2 {ComputeScaleGeometry procedure} {fonts} {
404    catch {destroy .s}
405    scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200
406    pack .s
407    update
408    list [winfo reqwidth .s] [winfo reqheight .s]
409} {168 108}
410test scale-7.3 {ComputeScaleGeometry procedure} {fonts} {
411    catch {destroy .s}
412    scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 \
413	    -sliderlength 10
414    pack .s
415    update
416    list [winfo reqwidth .s] [winfo reqheight .s]
417} {22 108}
418test scale-7.4 {ComputeScaleGeometry procedure} {fonts} {
419    catch {destroy .s}
420    scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \
421	    -relief sunken
422    pack .s
423    update
424    list [winfo reqwidth .s] [winfo reqheight .s]
425} {39 114}
426test scale-7.5 {ComputeScaleGeometry procedure} {nonPortable fonts} {
427    catch {destroy .s}
428    scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i
429    pack .s
430    update
431    list [winfo reqwidth .s] [winfo reqheight .s]
432} {458 61}
433test scale-7.6 {ComputeScaleGeometry procedure} {fonts} {
434    catch {destroy .s}
435    scale .s -from 0 -to 1000 -label "Long string" -orient horizontal \
436	    -tick 500
437    pack .s
438    update
439    list [winfo reqwidth .s] [winfo reqheight .s]
440} {108 79}
441test scale-7.7 {ComputeScaleGeometry procedure} {fonts} {
442    catch {destroy .s}
443    scale .s -from 0 -to 1000 -orient horizontal -showvalue 0
444    pack .s
445    update
446    list [winfo reqwidth .s] [winfo reqheight .s]
447} {108 27}
448test scale-7.8 {ComputeScaleGeometry procedure} {
449    catch {destroy .s}
450    scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 \
451	    -relief raised -highlightthickness 2
452    pack .s
453    update
454    list [winfo reqwidth .s] [winfo reqheight .s]
455} {114 39}
456
457test scale-8.1 {ScaleElement procedure} {fonts} {
458    catch {destroy .s}
459    scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
460    pack .s
461    .s set 30
462    update
463    list [.s identify 53 52] [.s identify 54 52] [.s identify 70 52] \
464	    [.s identify 71 52]
465} {{} trough1 trough1 {}}
466test scale-8.2 {ScaleElement procedure} {fonts} {
467    catch {destroy .s}
468    scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
469    pack .s
470    .s set 30
471    update
472    list [.s identify 60 2] [.s identify 60 3] [.s identify 60 302] \
473	    [.s identify 60 303]
474} {{} trough1 trough2 {}}
475test scale-8.3 {ScaleElement procedure} {fonts} {
476    catch {destroy .s}
477    scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
478    pack .s
479    .s set 30
480    update
481    list [.s identify 60 83] [.s identify 60 84] [.s identify 60 113] \
482	    [.s identify 60 114] \
483} {trough1 slider slider trough2}
484test scale-8.4 {ScaleElement procedure} {
485    catch {destroy .s}
486    scale .s -from 0 -to 100 -orient vertical -bd 4 -width 10 \
487	    -highlightthickness 1 -length 300 -showvalue 0
488    pack .s
489    .s set 30
490    update
491    list [.s identify 4 40] [.s identify 5 40] [.s identify 22 40] \
492	    [.s identify 23 40] \
493} {{} trough1 trough1 {}}
494test scale-8.5 {ScaleElement procedure} {fonts} {
495    catch {destroy .s}
496    scale .s -from 0 -to 100 -orient horizontal -bd 1 \
497	    -highlightthickness 2 -tick 20 -sliderlength 20 \
498	    -length 200 -label Test
499    pack .s
500    .s set 30
501    update
502    list [.s identify 150 36] [.s identify 150 37] [.s identify 150 53] \
503	    [.s identify 150 54]
504} {{} trough2 trough2 {}}
505test scale-8.6 {ScaleElement procedure} {fonts} {
506    catch {destroy .s}
507    scale .s -from 0 -to 100 -orient horizontal -bd 2 \
508	    -highlightthickness 1 -tick 20 -length 200
509    pack .s
510    .s set 30
511    update
512    list [.s identify 150 20] [.s identify 150 21] [.s identify 150 39] \
513	    [.s identify 150 40]
514} {{} trough2 trough2 {}}
515test scale-8.7 {ScaleElement procedure} {
516    catch {destroy .s}
517    scale .s -from 0 -to 100 -orient horizontal -bd 4 -highlightthickness 2 \
518	    -length 200 -width 10 -showvalue 0
519    pack .s
520    .s set 30
521    update
522    list [.s identify 30 5] [.s identify 30 6] [.s identify 30 23] \
523	    [.s identify 30 24]
524} {{} trough1 trough1 {}}
525test scale-8.8 {ScaleElement procedure} {
526    catch {destroy .s}
527    scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
528	    -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
529    pack .s
530    .s set 30
531    update
532    list [.s identify 2 28] [.s identify 3 28] [.s identify 202 28] \
533	    [.s identify 203 28]
534} {{} trough1 trough2 {}}
535test scale-8.9 {ScaleElement procedure} {
536    catch {destroy .s}
537    scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
538	    -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
539    pack .s
540    .s set 80
541    update
542    list [.s identify 145 28] [.s identify 146 28] [.s identify 165 28] \
543	    [.s identify 166 28]
544} {trough1 slider slider trough2}
545
546catch {destroy .s}
547scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
548pack .s
549update
550test scale-9.1 {PixelToValue procedure} {
551    .s get 46 0
552} 0
553test scale-9.2 {PixelToValue procedure} {
554    .s get -10 9
555} 0
556test scale-9.3 {PixelToValue procedure} {
557    .s get -10 12
558} 1
559test scale-9.4 {PixelToValue procedure} {
560    .s get -10 46
561} 35
562test scale-9.5 {PixelToValue procedure} {
563    .s get -10 110
564} 99
565test scale-9.6 {PixelToValue procedure} {
566    .s get -10 111
567} 100
568test scale-9.7 {PixelToValue procedure} {
569    .s get -10 112
570} 100
571test scale-9.8 {PixelToValue procedure} {
572    .s get -10 154
573} 100
574.s configure -orient horizontal
575update
576test scale-9.9 {PixelToValue procedure} {
577    .s get 76 152
578} 65
579
580test scale-10.1 {ValueToPixel procedure} {fonts} {
581    catch {destroy .s}
582    scale .s -from 0 -to 100 -sliderlength 20 -length 124 -bd 2 \
583	    -orient horizontal -label Test -tick 20
584    pack .s
585    update
586    list [.s coords -10] [.s coords 40] [.s coords 1000]
587} {{16 47} {56 47} {116 47}}
588test scale-10.2 {ValueToPixel procedure} {fonts} {
589    catch {destroy .s}
590    scale .s -from 100 -to 0 -sliderlength 20 -length 122 -bd 1 \
591	    -orient vertical -label Test -tick 20
592    pack .s
593    update
594    list [.s coords -10] [.s coords 40] [.s coords 1000]
595} {{62 114} {62 74} {62 14}}
596
597test scale-11.1 {ScaleEventProc procedure} {
598    proc killScale value {
599	global x
600	if {$value > 30} {
601	    destroy .s1
602	    lappend x [winfo exists .s1] [info commands .s1]
603	}
604    }
605    catch {destroy .s1}
606    set x initial
607    scale .s1 -from 0 -to 100 -command killScale
608    .s1 set 20
609    pack .s1
610    update idletasks
611    lappend x [winfo exists .s1]
612    .s1 set 40
613    update idletasks
614    rename killScale {}
615    set x
616} {initial 1 0 {}}
617test scale-11.2 {ScaleEventProc procedure} {
618    deleteWindows
619    scale .s1 -bg #543210
620    rename .s1 .s2
621    set x {}
622    lappend x [winfo children .]
623    lappend x [.s2 cget -bg]
624    destroy .s1
625    lappend x [info command .s*] [winfo children .]
626} {.s1 #543210 {} {}}
627
628test scale-12.1 {ScaleCmdDeletedProc procedure} {
629    deleteWindows
630    scale .s1
631    rename .s1 {}
632    list [info command .s*] [winfo children .]
633} {{} {}}
634
635catch {destroy .s}
636scale .s -from 0 -to 100 -command {set x} -variable y
637pack .s
638update
639proc varTrace args {
640    global traceInfo
641    set traceInfo $args
642}
643test scale-13.1 {SetScaleValue procedure} {
644    set x xyzzy
645    .s set 44
646    set result [list $x $y]
647    update
648    lappend result $x $y
649} {xyzzy 44 44 44}
650test scale-13.2 {SetScaleValue procedure} {
651    .s set -3
652    .s get
653} 0
654test scale-13.3 {SetScaleValue procedure} {
655    .s set 105
656    .s get
657} 100
658.s configure -from 100 -to 0
659test scale-13.4 {SetScaleValue procedure} {
660    .s set -3
661    .s get
662} 0
663test scale-13.5 {SetScaleValue procedure} {
664    .s set 105
665    .s get
666} 100
667test scale-13.6 {SetScaleValue procedure} {
668    .s set 50
669    update
670    trace variable y w varTrace
671    set traceInfo empty
672    set x untouched
673    .s set 50
674    update
675    list $x $traceInfo
676} {untouched empty}
677
678catch {destroy .s}
679scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -orient horizontal
680pack .s
681update
682.s configure -resolution 4.0
683update
684test scale-14.1 {RoundToResolution procedure} {
685    .s get 84 152
686} 72
687test scale-14.2 {RoundToResolution procedure} {
688    .s get 86 152
689} 76
690.s configure -from 100 -to 0
691update
692test scale-14.3 {RoundToResolution procedure} {
693    .s get 84 152
694} 28
695test scale-14.4 {RoundToResolution procedure} {
696    .s get 86 152
697} 24
698.s configure -from -100 -to 0
699update
700test scale-14.5 {RoundToResolution procedure} {
701    .s get 84 152
702} -28
703test scale-14.6 {RoundToResolution procedure} {
704    .s get 86 152
705} -24
706.s configure -from 0 -to -100
707update
708test scale-14.7 {RoundToResolution procedure} {
709    .s get 84 152
710} -72
711test scale-14.8 {RoundToResolution procedure} {
712    .s get 86 152
713} -76
714.s configure -from 0 -to 2.25 -resolution 0
715update
716test scale-14.9 {RoundToResolution procedure} {
717    .s get 84 152
718} 1.64
719test scale-14.10 {RoundToResolution procedure} {
720    .s get 86 152
721} 1.69
722.s configure -from 0 -to 225 -resolution 0  -digits 5
723update
724test scale-14.11 {RoundToResolution procedure} {
725    .s get 84 152
726} 164.25
727test scale-14.12 {RoundToResolution procedure} {
728    .s get 86 152
729} 168.75
730
731test scale-15.1 {ScaleVarProc procedure} {
732    catch {destroy .s}
733    set y -130
734    scale .s -from 0 -to -200 -variable y -orient horizontal -length 150
735    pack .s
736    set y
737} -130
738test scale-15.2 {ScaleVarProc procedure} {
739    catch {destroy .s}
740    set y -130
741    scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
742    pack .s
743    set y -87
744    .s get
745} -87
746test scale-15.3 {ScaleVarProc procedure} {
747    catch {destroy .s}
748    set y -130
749    scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
750    pack .s
751    list [catch {set y 40q} msg] $msg [.s get]
752} {1 {can't set "y": can't assign non-numeric value to scale variable} -130}
753test scale-15.4 {ScaleVarProc procedure} {
754    catch {destroy .s}
755    set y 1
756    scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
757    pack .s
758    list [catch {set y x} msg] $msg [.s get]
759} {1 {can't set "y": can't assign non-numeric value to scale variable} 1}
760test scale-15.5 {ScaleVarProc procedure, variable deleted} {
761    catch {destroy .s}
762    set y 6
763    scale .s -from 10 -to 0 -variable y -orient horizontal -length 150 \
764	    -command "set x"
765    pack .s
766    update
767    set x untouched
768    unset y
769    update
770    list [catch {set y} msg] $msg [.s get] $x
771} {0 6 6 untouched}
772test scale-15.6 {ScaleVarProc procedure, don't call -command} {
773    catch {destroy .s}
774    set y 6
775    scale .s -from 0 -to 100 -variable y -orient horizontal -length 150 \
776	    -command "set x"
777    pack .s
778    update
779    set x untouched
780    set y 60
781    update
782    list $x [.s get]
783} {untouched 60}
784
785set l [interp hidden]
786deleteWindows
787
788test scale-16.1 {scale widget vs hidden commands} {
789    catch {destroy .s}
790    scale .s
791    interp hide {} .s
792    destroy .s
793    list [winfo children .] [interp hidden]
794} [list {} $l]
795
796test scale-17.1 {bug fix 1786} {
797    # Perhaps x is set to {}, depending on what other tests have run.
798    # If x is unset, or set to something not convertable to a double,
799    # then the scale try to initialize its value with the contents
800    # of uninitialized memory.  Sometimes that causes an FPE.
801
802    set x {}
803    scale .s -from 100 -to 300
804    pack .s
805    update
806    .s configure -variable x   ;# CRASH! -> Floating point exception
807
808    # Bug 4833 changed the result to realize that x should pick up
809    # a value from the scale.  In an FPE occurs, it is due to the
810    # lack of errno being set to 0 by some libc's. (see bug 4942)
811    set x
812} {100}
813
814test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} {
815    catch {destroy .s}
816    scale .s -cursor trek
817    destroy .s
818} {}
819
820test scale-18.2 {Scale button 1 events [Bug 787065]} \
821    -setup {
822        catch {destroy .s}
823        set y 5
824        scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
825        pack .s
826        tkwait visibility .s
827        set ::error {}
828        proc bgerror {args} {set ::error $args}
829    } \
830    -body {
831        list [catch {
832            event generate .s <1> -x 0 -y 0
833            event generate .s <ButtonRelease-1> -x 0 -y 0
834            update
835            set ::error
836        } msg] $msg
837    } \
838    -cleanup {
839        unset ::error
840        rename bgerror {}
841        catch {destroy .s}
842    } \
843    -result {0 {}}
844
845test scale-18.3 {Scale button 2 events [Bug 787065]} \
846    -setup {
847        catch {destroy .s}
848        set y 5
849        scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
850        pack .s
851        tkwait visibility .s
852        set ::error {}
853        proc bgerror {args} {set ::error $args}
854    } \
855    -body {
856        list [catch {
857            event generate .s <2> -x 0 -y 0
858            event generate .s <ButtonRelease-2> -x 0 -y 0
859            update
860            set ::error
861        } msg] $msg
862    } \
863    -cleanup {
864        unset ::error
865        rename bgerror {}
866        catch {destroy .s}
867    } \
868    -result {0 {}}
869
870catch {destroy .s}
871option clear
872
873# cleanup
874::tcltest::cleanupTests
875return
876