783 lines
24 KiB
Plaintext
783 lines
24 KiB
Plaintext
# This file is a Tcl script to test out the "scale" command
|
|
# of Tk. It is organized in the standard fashion for Tcl tests.
|
|
#
|
|
# Copyright (c) 1994 The Regents of the University of California.
|
|
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
|
|
#
|
|
# See the file "license.terms" for information on usage and redistribution
|
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
#
|
|
# SCCS: @(#) scale.test 1.19 96/08/21 09:56:14
|
|
|
|
if {[info procs test] != "test"} {
|
|
source defs
|
|
}
|
|
|
|
foreach i [winfo children .] {
|
|
destroy $i
|
|
}
|
|
wm geometry . {}
|
|
raise .
|
|
|
|
scale .s -from 100 -to 300
|
|
pack .s
|
|
update
|
|
set i 1
|
|
foreach test {
|
|
{-activebackground #ff0000 #ff0000 non-existent
|
|
{unknown color name "non-existent"}}
|
|
{-background #ff0000 #ff0000 non-existent
|
|
{unknown color name "non-existent"}}
|
|
{-bd 4 4 badValue {bad screen distance "badValue"}}
|
|
{-bigincrement 12.2 12.2 badValue
|
|
{expected floating-point number but got "badValue"}}
|
|
{-bg #ff0000 #ff0000 non-existent
|
|
{unknown color name "non-existent"}}
|
|
{-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
|
|
{-command "set x" {set x} {} {}}
|
|
{-cursor arrow arrow badValue {bad cursor spec "badValue"}}
|
|
{-digits 5 5 badValue {expected integer but got "badValue"}}
|
|
{-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}}
|
|
{-font fixed fixed badValue {font "badValue" doesn't exist}}
|
|
{-foreground green green badValue {unknown color name "badValue"}}
|
|
{-from -15.0 -15.0 badValue
|
|
{expected floating-point number but got "badValue"}}
|
|
{-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
|
|
{-highlightcolor #123456 #123456 non-existent
|
|
{unknown color name "non-existent"}}
|
|
{-highlightthickness 2 2 badValue {bad screen distance "badValue"}}
|
|
{-label "Some text" {Some text} {} {}}
|
|
{-length 130 130 badValue {bad screen distance "badValue"}}
|
|
{-orient horizontal horizontal badValue
|
|
{bad orientation "badValue": must be vertical or horizontal}}
|
|
{-orient horizontal horizontal {} {}}
|
|
{-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, or sunken}}
|
|
{-repeatdelay 14 14 bogus {expected integer but got "bogus"}}
|
|
{-repeatinterval 14 14 bogus {expected integer but got "bogus"}}
|
|
{-resolution 2.0 2.0 badValue
|
|
{expected floating-point number but got "badValue"}}
|
|
{-showvalue 0 0 badValue {expected boolean value but got "badValue"}}
|
|
{-sliderlength 86 86 badValue {bad screen distance "badValue"}}
|
|
{-sliderrelief raised raised badValue {bad relief type "badValue": must be flat, groove, raised, ridge, or sunken}}
|
|
{-state disabled disabled badValue
|
|
{bad state value "badValue": must be normal, active, or disabled}}
|
|
{-state normal normal {} {}}
|
|
{-takefocus "any string" "any string" {} {}}
|
|
{-tickinterval 4.3 4.0 badValue
|
|
{expected floating-point number but got "badValue"}}
|
|
{-to 14.9 15.0 badValue
|
|
{expected floating-point number but got "badValue"}}
|
|
{-troughcolor #ff0000 #ff0000 non-existent
|
|
{unknown color name "non-existent"}}
|
|
{-variable x x {} {}}
|
|
{-width 32 32 badValue {bad screen distance "badValue"}}
|
|
} {
|
|
set name [lindex $test 0]
|
|
test scale-1.$i {configuration options} {
|
|
.s configure $name [lindex $test 1]
|
|
lindex [.s configure $name] 4
|
|
} [lindex $test 2]
|
|
incr i
|
|
if {[lindex $test 3] != ""} {
|
|
test scale-1.$i {configuration options} {
|
|
list [catch {.s configure $name [lindex $test 3]} msg] $msg
|
|
} [list 1 [lindex $test 4]]
|
|
}
|
|
.s configure $name [lindex [.s configure $name] 3]
|
|
incr i
|
|
}
|
|
|
|
destroy .s
|
|
test scale-2.1 {Tk_ScaleCmd procedure} {
|
|
list [catch {scale} msg] $msg
|
|
} {1 {wrong # args: should be "scale pathName ?options?"}}
|
|
test scale-2.2 {Tk_ScaleCmd procedure} {
|
|
list [catch {scale foo} msg] $msg [winfo child .]
|
|
} {1 {bad window path name "foo"} {}}
|
|
test scale-2.3 {Tk_ScaleCmd procedure} {
|
|
list [catch {scale .s -gorp dumb} msg] $msg [winfo child .]
|
|
} {1 {unknown option "-gorp"} {}}
|
|
|
|
scale .s -from 100 -to 200
|
|
pack .s
|
|
update idletasks
|
|
test scale-3.1 {ScaleWidgetCmd procedure} {
|
|
list [catch {.s} msg] $msg
|
|
} {1 {wrong # args: should be ".s option ?arg arg ...?"}}
|
|
test scale-3.2 {ScaleWidgetCmd procedure, cget option} {
|
|
list [catch {.s cget} msg] $msg
|
|
} {1 {wrong # args: should be ".s cget option"}}
|
|
test scale-3.3 {ScaleWidgetCmd procedure, cget option} {
|
|
list [catch {.s cget a b} msg] $msg
|
|
} {1 {wrong # args: should be ".s cget option"}}
|
|
test scale-3.4 {ScaleWidgetCmd procedure, cget option} {
|
|
list [catch {.s cget -gorp} msg] $msg
|
|
} {1 {unknown option "-gorp"}}
|
|
test scale-3.5 {ScaleWidgetCmd procedure, cget option} {
|
|
.s cget -highlightthickness
|
|
} {2}
|
|
test scale-3.6 {ScaleWidgetCmd procedure, configure option} {
|
|
list [llength [.s configure]] [lindex [.s configure] 5]
|
|
} {33 {-borderwidth borderWidth BorderWidth 2 2}}
|
|
test scale-3.7 {ScaleWidgetCmd procedure, configure option} {
|
|
list [catch {.s configure -foo} msg] $msg
|
|
} {1 {unknown option "-foo"}}
|
|
test scale-3.8 {ScaleWidgetCmd procedure, configure option} {
|
|
list [catch {.s configure -borderwidth 2 -bg} msg] $msg
|
|
} {1 {value for "-bg" missing}}
|
|
test scale-3.9 {ScaleWidgetCmd procedure, coords option} {
|
|
list [catch {.s coords a b} msg] $msg
|
|
} {1 {wrong # args: should be ".s coords ?value?"}}
|
|
test scale-3.10 {ScaleWidgetCmd procedure, coords option} {
|
|
list [catch {.s coords bad} msg] $msg
|
|
} {1 {expected floating-point number but got "bad"}}
|
|
test scale-3.11 {ScaleWidgetCmd procedure} {fonts} {
|
|
.s set 120
|
|
.s coords
|
|
} {37 34}
|
|
test scale-3.12 {ScaleWidgetCmd procedure, coords option} {fonts} {
|
|
.s configure -orient horizontal
|
|
update
|
|
.s set 120
|
|
.s coords
|
|
} {34 31}
|
|
.s configure -orient vertical
|
|
update
|
|
test scale-3.13 {ScaleWidgetCmd procedure, get option} {
|
|
list [catch {.s get a} msg] $msg
|
|
} {1 {wrong # args: should be ".s get ?x y?"}}
|
|
test scale-3.14 {ScaleWidgetCmd procedure, get option} {
|
|
list [catch {.s get a b c} msg] $msg
|
|
} {1 {wrong # args: should be ".s get ?x y?"}}
|
|
test scale-3.15 {ScaleWidgetCmd procedure, get option} {
|
|
list [catch {.s get a 11} msg] $msg
|
|
} {1 {expected integer but got "a"}}
|
|
test scale-3.16 {ScaleWidgetCmd procedure, get option} {
|
|
list [catch {.s get 12 b} msg] $msg
|
|
} {1 {expected integer but got "b"}}
|
|
test scale-3.17 {ScaleWidgetCmd procedure, get option} {
|
|
.s set 133
|
|
.s get
|
|
} 133
|
|
test scale-3.18 {ScaleWidgetCmd procedure, get option} {
|
|
.s configure -resolution 0.5
|
|
.s set 150
|
|
.s get 37 34
|
|
} 119.5
|
|
.s configure -resolution 1
|
|
test scale-3.19 {ScaleWidgetCmd procedure, identify option} {
|
|
list [catch {.s identify} msg] $msg
|
|
} {1 {wrong # args: should be ".s identify x y"}}
|
|
test scale-3.20 {ScaleWidgetCmd procedure, identify option} {
|
|
list [catch {.s identify 1 2 3} msg] $msg
|
|
} {1 {wrong # args: should be ".s identify x y"}}
|
|
test scale-3.21 {ScaleWidgetCmd procedure, identify option} {
|
|
list [catch {.s identify boo 16} msg] $msg
|
|
} {1 {expected integer but got "boo"}}
|
|
test scale-3.22 {ScaleWidgetCmd procedure, identify option} {
|
|
list [catch {.s identify 17 bad} msg] $msg
|
|
} {1 {expected integer but got "bad"}}
|
|
test scale-3.23 {ScaleWidgetCmd procedure, identify option} {fonts} {
|
|
.s set 120
|
|
list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80]
|
|
} {trough1 slider trough2 {}}
|
|
test scale-3.24 {ScaleWidgetCmd procedure, set option} {
|
|
list [catch {.s set} msg] $msg
|
|
} {1 {wrong # args: should be ".s set value"}}
|
|
test scale-3.25 {ScaleWidgetCmd procedure, set option} {
|
|
list [catch {.s set a b} msg] $msg
|
|
} {1 {wrong # args: should be ".s set value"}}
|
|
test scale-3.26 {ScaleWidgetCmd procedure, set option} {
|
|
list [catch {.s set bad} msg] $msg
|
|
} {1 {expected floating-point number but got "bad"}}
|
|
test scale-3.27 {ScaleWidgetCmd procedure, set option} {
|
|
.s set 142
|
|
} {}
|
|
test scale-3.28 {ScaleWidgetCmd procedure, set option} {
|
|
.s set 118
|
|
.s configure -state disabled
|
|
.s set 181
|
|
.s configure -state normal
|
|
.s get
|
|
} {118}
|
|
test scale-3.29 {ScaleWidgetCmd procedure} {
|
|
list [catch {.s dumb} msg] $msg
|
|
} {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}}
|
|
test scale-3.30 {ScaleWidgetCmd procedure} {
|
|
list [catch {.s c} msg] $msg
|
|
} {1 {bad option "c": must be cget, configure, coords, get, identify, or set}}
|
|
test scale-3.31 {ScaleWidgetCmd procedure} {
|
|
list [catch {.s co} msg] $msg
|
|
} {1 {bad option "co": must be cget, configure, coords, get, identify, or set}}
|
|
test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} {
|
|
proc kill args {
|
|
destroy .s
|
|
}
|
|
catch {destroy .s}
|
|
scale .s -variable x -from 0 -to 100 -orient horizontal
|
|
pack .s
|
|
update
|
|
.s configure -command kill
|
|
.s set 55
|
|
} {}
|
|
|
|
test scale-4.1 {DestroyScale procedure} {
|
|
catch {destroy .s}
|
|
set x 50
|
|
scale .s -variable x -from 0 -to 100 -orient horizontal
|
|
pack .s
|
|
update
|
|
destroy .s
|
|
list [catch {set x foo} msg] $msg $x
|
|
} {0 foo foo}
|
|
|
|
test scale-5.1 {ConfigureScale procedure} {
|
|
catch {destroy .s}
|
|
set x 66
|
|
set y 77
|
|
scale .s -variable x -from 0 -to 100
|
|
pack .s
|
|
update
|
|
.s configure -variable y
|
|
list [catch {set x foo} msg] $msg $x [.s get]
|
|
} {0 foo foo 77}
|
|
test scale-5.2 {ConfigureScale procedure} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100
|
|
list [catch {.s configure -foo bar} msg] $msg
|
|
} {1 {unknown option "-foo"}}
|
|
test scale-5.3 {ConfigureScale procedure} {
|
|
catch {destroy .s}
|
|
catch {unset x}
|
|
scale .s -from 0 -to 100 -variable x
|
|
set result $x
|
|
lappend result [.s get]
|
|
set x 92
|
|
lappend result [.s get]
|
|
.s set 3
|
|
lappend result $x
|
|
unset x
|
|
lappend result [catch {set x} msg] $msg
|
|
} {0 0 92 3 0 3}
|
|
test scale-5.4 {ConfigureScale procedure} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100
|
|
list [catch {.s configure -orient dumb} msg] $msg
|
|
} {1 {bad orientation "dumb": must be vertical or horizontal}}
|
|
test scale-5.5 {ConfigureScale procedure} {
|
|
catch {destroy .s}
|
|
scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76
|
|
list [.s cget -from] [.s cget -to] [.s cget -tickinterval]
|
|
} {1.1 1.9 0.8}
|
|
test scale-5.6 {ConfigureScale procedure} {
|
|
catch {destroy .s}
|
|
scale .s -from 1 -to 10 -tickinterval -2
|
|
pack .s
|
|
set result [lindex [.s configure -tickinterval] 4]
|
|
.s configure -from 10 -to 1 -tickinterval 2
|
|
lappend result [lindex [.s configure -tickinterval] 4]
|
|
} {2.0 -2.0}
|
|
test scale-5.7 {ConfigureScale procedure} {
|
|
catch {destroy .s}
|
|
list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg
|
|
} {1 {bad state value "bogus": must be normal, active, or disabled}}
|
|
|
|
catch {destroy .s}
|
|
scale .s -orient horizontal -length 200
|
|
pack .s
|
|
test scale-6.1 {ComputeFormat procedure} {
|
|
.s configure -from 10 -to 100 -resolution 10
|
|
.s set 49.3
|
|
.s get
|
|
} {50}
|
|
test scale-6.2 {ComputeFormat procedure} {
|
|
.s configure -from 100 -to 1000 -resolution 100
|
|
.s set 493
|
|
.s get
|
|
} {500}
|
|
test scale-6.3 {ComputeFormat procedure} {
|
|
.s configure -from 1000 -to 10000 -resolution 1000
|
|
.s set 4930
|
|
.s get
|
|
} {5000}
|
|
test scale-6.4 {ComputeFormat procedure} {
|
|
.s configure -from 10000 -to 100000 -resolution 10000
|
|
.s set 49000
|
|
.s get
|
|
} {50000}
|
|
test scale-6.5 {ComputeFormat procedure} {
|
|
.s configure -from 100000 -to 1000000 -resolution 100000
|
|
.s set 493000
|
|
.s get
|
|
} {500000}
|
|
test scale-6.6 {ComputeFormat procedure} {nonPortable} {
|
|
# This test is non-portable because some platforms format the
|
|
# result as 5e+06.
|
|
|
|
.s configure -from 1000000 -to 10000000 -resolution 1000000
|
|
.s set 4930000
|
|
.s get
|
|
} {5000000}
|
|
test scale-6.7 {ComputeFormat procedure} {
|
|
.s configure -from 1000000000 -to 10000000000 -resolution 1000000000
|
|
.s set 4930000000
|
|
.s get
|
|
} {5.0e+09}
|
|
test scale-6.8 {ComputeFormat procedure} {
|
|
.s configure -from .1 -to 1 -resolution .1
|
|
.s set .6
|
|
.s get
|
|
} {0.6}
|
|
test scale-6.9 {ComputeFormat procedure} {
|
|
.s configure -from .01 -to .1 -resolution .01
|
|
.s set .06
|
|
.s get
|
|
} {0.06}
|
|
test scale-6.10 {ComputeFormat procedure} {
|
|
.s configure -from .001 -to .01 -resolution .001
|
|
.s set .006
|
|
.s get
|
|
} {0.006}
|
|
test scale-6.11 {ComputeFormat procedure} {
|
|
.s configure -from .0001 -to .001 -resolution .0001
|
|
.s set .0006
|
|
.s get
|
|
} {0.0006}
|
|
test scale-6.12 {ComputeFormat procedure} {
|
|
.s configure -from .00001 -to .0001 -resolution .00001
|
|
.s set .00006
|
|
.s get
|
|
} {0.00006}
|
|
test scale-6.13 {ComputeFormat procedure} {
|
|
.s configure -from .000001 -to .00001 -resolution .000001
|
|
.s set .000006
|
|
.s get
|
|
} {6.0e-06}
|
|
test scale-6.14 {ComputeFormat procedure} {
|
|
.s configure -to .00001 -from .0001 -resolution .00001
|
|
.s set .00006
|
|
.s get
|
|
} {0.00006}
|
|
test scale-6.15 {ComputeFormat procedure} {
|
|
.s configure -to .000001 -from .00001 -resolution .000001
|
|
.s set .000006
|
|
.s get
|
|
} {6.0e-06}
|
|
test scale-6.16 {ComputeFormat procedure} {
|
|
.s configure -from .00001 -to .0001 -resolution .00001 -digits 1
|
|
.s set .00006
|
|
.s get
|
|
} {6e-05}
|
|
test scale-6.17 {ComputeFormat procedure} {
|
|
.s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3
|
|
.s set 49300000
|
|
.s get
|
|
} {50000000}
|
|
test scale-6.18 {ComputeFormat procedure} {
|
|
.s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0
|
|
.s set .111111111
|
|
.s get
|
|
} {0.11}
|
|
test scale-6.19 {ComputeFormat procedure} {
|
|
.s configure -length 200 -from 1000 -to 1002 -resolution 0 -digits 0
|
|
.s set 1001.23456789
|
|
.s get
|
|
} {1001.23}
|
|
test scale-6.20 {ComputeFormat procedure} {
|
|
.s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 0
|
|
.s set 1001.23456789
|
|
.s get
|
|
} {1001.235}
|
|
|
|
test scale-7.1 {ComputeScaleGeometry procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} {86 458}
|
|
test scale-7.2 {ComputeScaleGeometry procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} {164 108}
|
|
test scale-7.3 {ComputeScaleGeometry procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 \
|
|
-sliderlength 10
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} {22 108}
|
|
test scale-7.4 {ComputeScaleGeometry procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \
|
|
-relief sunken
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} {39 114}
|
|
test scale-7.5 {ComputeScaleGeometry procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} {458 61}
|
|
test scale-7.6 {ComputeScaleGeometry procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 1000 -label "Long string" -orient horizontal \
|
|
-tick 500
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} {108 79}
|
|
test scale-7.7 {ComputeScaleGeometry procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 1000 -orient horizontal -showvalue 0
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} {108 27}
|
|
test scale-7.8 {ComputeScaleGeometry procedure} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 \
|
|
-relief raised
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} {114 39}
|
|
|
|
test scale-8.1 {ScaleElement procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
|
|
pack .s
|
|
.s set 30
|
|
update
|
|
list [.s identify 51 52] [.s identify 52 52] [.s identify 68 52] \
|
|
[.s identify 69 52]
|
|
} {{} trough1 trough1 {}}
|
|
test scale-8.2 {ScaleElement procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
|
|
pack .s
|
|
.s set 30
|
|
update
|
|
list [.s identify 60 2] [.s identify 60 3] [.s identify 60 302] \
|
|
[.s identify 60 303]
|
|
} {{} trough1 trough2 {}}
|
|
test scale-8.3 {ScaleElement procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
|
|
pack .s
|
|
.s set 30
|
|
update
|
|
list [.s identify 60 83] [.s identify 60 84] [.s identify 60 113] \
|
|
[.s identify 60 114] \
|
|
} {trough1 slider slider trough2}
|
|
test scale-8.4 {ScaleElement procedure} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -orient vertical -bd 4 -width 10 \
|
|
-highlightthickness 1 -length 300 -showvalue 0
|
|
pack .s
|
|
.s set 30
|
|
update
|
|
list [.s identify 4 40] [.s identify 5 40] [.s identify 22 40] \
|
|
[.s identify 23 40] \
|
|
} {{} trough1 trough1 {}}
|
|
test scale-8.5 {ScaleElement procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -orient horizontal -bd 1 \
|
|
-highlightthickness 2 -tick 20 -sliderlength 20 \
|
|
-length 200 -label Test
|
|
pack .s
|
|
.s set 30
|
|
update
|
|
list [.s identify 150 36] [.s identify 150 37] [.s identify 150 53] \
|
|
[.s identify 150 54]
|
|
} {{} trough2 trough2 {}}
|
|
test scale-8.6 {ScaleElement procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -orient horizontal -bd 2 \
|
|
-highlightthickness 1 -tick 20 -length 200
|
|
pack .s
|
|
.s set 30
|
|
update
|
|
list [.s identify 150 20] [.s identify 150 21] [.s identify 150 39] \
|
|
[.s identify 150 40]
|
|
} {{} trough2 trough2 {}}
|
|
test scale-8.7 {ScaleElement procedure} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -orient horizontal -bd 4 -highlightthickness 2 \
|
|
-length 200 -width 10 -showvalue 0
|
|
pack .s
|
|
.s set 30
|
|
update
|
|
list [.s identify 30 5] [.s identify 30 6] [.s identify 30 23] \
|
|
[.s identify 30 24]
|
|
} {{} trough1 trough1 {}}
|
|
test scale-8.8 {ScaleElement procedure} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
|
|
-tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
|
|
pack .s
|
|
.s set 30
|
|
update
|
|
list [.s identify 2 28] [.s identify 3 28] [.s identify 202 28] \
|
|
[.s identify 203 28]
|
|
} {{} trough1 trough2 {}}
|
|
test scale-8.9 {ScaleElement procedure} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
|
|
-tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
|
|
pack .s
|
|
.s set 80
|
|
update
|
|
list [.s identify 145 28] [.s identify 146 28] [.s identify 165 28] \
|
|
[.s identify 166 28]
|
|
} {trough1 slider slider trough2}
|
|
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
|
|
pack .s
|
|
update
|
|
test scale-9.1 {PixelToValue procedure} {
|
|
.s get 47 0
|
|
} 0
|
|
test scale-9.2 {PixelToValue procedure} {
|
|
.s get -10 9
|
|
} 0
|
|
test scale-9.3 {PixelToValue procedure} {
|
|
.s get -10 12
|
|
} 1
|
|
test scale-9.4 {PixelToValue procedure} {
|
|
.s get -10 46
|
|
} 35
|
|
test scale-9.5 {PixelToValue procedure} {
|
|
.s get -10 110
|
|
} 99
|
|
test scale-9.6 {PixelToValue procedure} {
|
|
.s get -10 111
|
|
} 100
|
|
test scale-9.7 {PixelToValue procedure} {
|
|
.s get -10 112
|
|
} 100
|
|
test scale-9.8 {PixelToValue procedure} {
|
|
.s get -10 154
|
|
} 100
|
|
.s configure -orient horizontal
|
|
update
|
|
test scale-9.9 {PixelToValue procedure} {
|
|
.s get 76 152
|
|
} 65
|
|
|
|
test scale-10.1 {ValueToPixel procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -sliderlength 20 -length 124 -bd 2 \
|
|
-orient horizontal -label Test -tick 20
|
|
pack .s
|
|
update
|
|
list [.s coords -10] [.s coords 40] [.s coords 1000]
|
|
} {{16 47} {56 47} {116 47}}
|
|
test scale-10.2 {ValueToPixel procedure} {fonts} {
|
|
catch {destroy .s}
|
|
scale .s -from 100 -to 0 -sliderlength 20 -length 122 -bd 1 \
|
|
-orient vertical -label Test -tick 20
|
|
pack .s
|
|
update
|
|
list [.s coords -10] [.s coords 40] [.s coords 1000]
|
|
} {{60 114} {60 74} {60 14}}
|
|
|
|
test scale-11.1 {ScaleEventProc procedure} {
|
|
proc killScale value {
|
|
global x
|
|
if {$value > 30} {
|
|
destroy .s1
|
|
lappend x [winfo exists .s1] [info commands .s1]
|
|
}
|
|
}
|
|
catch {destroy .s1}
|
|
set x initial
|
|
scale .s1 -from 0 -to 100 -command killScale
|
|
.s1 set 20
|
|
pack .s1
|
|
update idletasks
|
|
lappend x [winfo exists .s1]
|
|
.s1 set 40
|
|
update idletasks
|
|
rename killScale {}
|
|
set x
|
|
} {initial 1 0 {}}
|
|
test scale-11.2 {ScaleEventProc procedure} {
|
|
eval destroy [winfo children .]
|
|
scale .s1 -bg #543210
|
|
rename .s1 .s2
|
|
set x {}
|
|
lappend x [winfo children .]
|
|
lappend x [.s2 cget -bg]
|
|
destroy .s1
|
|
lappend x [info command .s*] [winfo children .]
|
|
} {.s1 #543210 {} {}}
|
|
|
|
test scale-12.1 {ScaleCmdDeletedProc procedure} {
|
|
eval destroy [winfo children .]
|
|
scale .s1
|
|
rename .s1 {}
|
|
list [info command .s*] [winfo children .]
|
|
} {{} {}}
|
|
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -command {set x} -variable y
|
|
pack .s
|
|
update
|
|
proc varTrace args {
|
|
global traceInfo
|
|
set traceInfo $args
|
|
}
|
|
test scale-13.1 {SetScaleValue procedure} {
|
|
set x xyzzy
|
|
.s set 44
|
|
set result [list $x $y]
|
|
update
|
|
lappend result $x $y
|
|
} {xyzzy 44 44 44}
|
|
test scale-13.2 {SetScaleValue procedure} {
|
|
.s set -3
|
|
.s get
|
|
} 0
|
|
test scale-13.3 {SetScaleValue procedure} {
|
|
.s set 105
|
|
.s get
|
|
} 100
|
|
.s configure -from 100 -to 0
|
|
test scale-13.4 {SetScaleValue procedure} {
|
|
.s set -3
|
|
.s get
|
|
} 0
|
|
test scale-13.5 {SetScaleValue procedure} {
|
|
.s set 105
|
|
.s get
|
|
} 100
|
|
test scale-13.6 {SetScaleValue procedure} {
|
|
.s set 50
|
|
update
|
|
trace variable y w varTrace
|
|
set traceInfo empty
|
|
set x untouched
|
|
.s set 50
|
|
update
|
|
list $x $traceInfo
|
|
} {untouched empty}
|
|
|
|
catch {destroy .s}
|
|
scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -orient horizontal
|
|
pack .s
|
|
update
|
|
.s configure -resolution 4.0
|
|
update
|
|
test scale-14.1 {RoundToResolution procedure} {
|
|
.s get 84 152
|
|
} 72
|
|
test scale-14.2 {RoundToResolution procedure} {
|
|
.s get 86 152
|
|
} 76
|
|
.s configure -from 100 -to 0
|
|
update
|
|
test scale-14.3 {RoundToResolution procedure} {
|
|
.s get 84 152
|
|
} 28
|
|
test scale-14.4 {RoundToResolution procedure} {
|
|
.s get 86 152
|
|
} 24
|
|
.s configure -from -100 -to 0
|
|
update
|
|
test scale-14.5 {RoundToResolution procedure} {
|
|
.s get 84 152
|
|
} -28
|
|
test scale-14.6 {RoundToResolution procedure} {
|
|
.s get 86 152
|
|
} -24
|
|
.s configure -from 0 -to -100
|
|
update
|
|
test scale-14.7 {RoundToResolution procedure} {
|
|
.s get 84 152
|
|
} -72
|
|
test scale-14.8 {RoundToResolution procedure} {
|
|
.s get 86 152
|
|
} -76
|
|
.s configure -from 0 -to 2.25 -resolution 0
|
|
update
|
|
test scale-14.9 {RoundToResolution procedure} {
|
|
.s get 84 152
|
|
} 1.64
|
|
test scale-14.10 {RoundToResolution procedure} {
|
|
.s get 86 152
|
|
} 1.69
|
|
.s configure -from 0 -to 225 -resolution 0 -digits 5
|
|
update
|
|
test scale-14.11 {RoundToResolution procedure} {
|
|
.s get 84 152
|
|
} 164.25
|
|
test scale-14.12 {RoundToResolution procedure} {
|
|
.s get 86 152
|
|
} 168.75
|
|
|
|
test scale-15.1 {ScaleVarProc procedure} {
|
|
catch {destroy .s}
|
|
set y -130
|
|
scale .s -from 0 -to -200 -variable y -orient horizontal -length 150
|
|
pack .s
|
|
set y
|
|
} -130
|
|
test scale-15.2 {ScaleVarProc procedure} {
|
|
catch {destroy .s}
|
|
set y -130
|
|
scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
|
|
pack .s
|
|
set y -87
|
|
.s get
|
|
} -87
|
|
test scale-15.3 {ScaleVarProc procedure} {
|
|
catch {destroy .s}
|
|
set y -130
|
|
scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
|
|
pack .s
|
|
list [catch {set y 40q} msg] $msg [.s get]
|
|
} {1 {can't set "y": can't assign non-numeric value to scale variable} -130}
|
|
test scale-15.4 {ScaleVarProc procedure} {
|
|
catch {destroy .s}
|
|
set y 1
|
|
scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
|
|
pack .s
|
|
list [catch {set y x} msg] $msg [.s get]
|
|
} {1 {can't set "y": can't assign non-numeric value to scale variable} 1}
|
|
test scale-15.5 {ScaleVarProc procedure, variable deleted} {
|
|
catch {destroy .s}
|
|
set y 6
|
|
scale .s -from 10 -to 0 -variable y -orient horizontal -length 150 \
|
|
-command "set x"
|
|
pack .s
|
|
update
|
|
set x untouched
|
|
unset y
|
|
update
|
|
list [catch {set y} msg] $msg [.s get] $x
|
|
} {0 6 6 untouched}
|
|
test scale-15.6 {ScaleVarProc procedure, don't call -command} {
|
|
catch {destroy .s}
|
|
set y 6
|
|
scale .s -from 0 -to 100 -variable y -orient horizontal -length 150 \
|
|
-command "set x"
|
|
pack .s
|
|
update
|
|
set x untouched
|
|
set y 60
|
|
update
|
|
list $x [.s get]
|
|
} {untouched 60}
|
|
|
|
catch {destroy .s}
|
|
concat {}
|