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

Subversion Repositories or1k_old

[/] [or1k_old/] [trunk/] [insight/] [tk/] [tests/] [scale.test] - Blame information for rev 1782

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# 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.1.1.1 2002-01-16 10:25:59 markom 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

powered by: WebSVN 2.1.0

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