← Back to branch summary

~ubuntu-branches/ubuntu/dapper/tk8.0/dapper-updates

« back to all changes in this revision

Viewing changes to tests/scale.test

  • Committer: Bazaar Package Importer
  • Author(s): Mike Markley
  • Date: 2001-07-24 21:57:40 UTC
  • Revision ID: james.westby@ubuntu.com-20010724215740-r70t25rtmbqjil2h
Tags: upstream-8.0.5
Import upstream version 8.0.5

Show diffs side-by-side

added added

removed removed

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