# This file is a Tcl script to test out the "scale" command

# of Tk.

#

# Copyright © 1994 The Regents of the University of California.

# Copyright © 1994-1996 Sun Microsystems, Inc.

# Copyright © 1998-1999 Scriptics Corporation.

# All rights reserved.

#

# TESTFILE INITIALIZATION

#

package require tcltest 2.2; # needed in mode -singleproc 0

# Load the main script main.tcl, which takes care of:

# - setup for the application and the root window

# - importing commands from the tcltest namespace

# - loading of the testutils mechanism along with its utility procs

# - loading of Tk specific test constraints (additionally to constraints

# provided by the package tcltest)

source [file join [tcltest::configure -testdir] main.tcl]

# Ensure a pristine initial window state

resetWindows

# Create entries in the option database to be sure that geometry options

# like border width have predictable values.

option add *Scale.borderWidth 2

option add *Scale.highlightThickness 2

option add *Scale.font {Helvetica -12 bold}

#

# COMMON TEST SETUP

#

# For tests 1.*

#

scale .s -from 100 -to 300

pack .s

update

#

# TESTS

#

test scale-1.1 {configuration options} -body {

.s configure -activebackground #ff0000

.s cget -activebackground

} -cleanup {

.s configure -activebackground [lindex [.s configure -activebackground] 3]

} -result {#ff0000}

test scale-1.2 {configuration options} -body {

.s configure -activebackground non-existent

} -returnCodes error -result {unknown color name "non-existent"}

test scale-1.3 {configuration options} -body {

.s configure -background #ff0000

.s cget -background

} -cleanup {

.s configure -background [lindex [.s configure -background] 3]

} -result {#ff0000}

test scale-1.4 {configuration options} -body {

.s configure -background non-existent

} -returnCodes error -result {unknown color name "non-existent"}

test scale-1.5 {configuration options} -body {

.s configure -bd 4

.s cget -bd

} -cleanup {

.s configure -bd [lindex [.s configure -bd] 3]

} -result 4

test scale-1.6 {configuration options} -body {

.s configure -bd badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test scale-1.7 {configuration options} -body {

.s configure -bigincrement 12.5

.s cget -bigincrement

} -cleanup {

.s configure -bigincrement [lindex [.s configure -bigincrement] 3]

} -result {12.5}

test scale-1.8 {configuration options} -body {

.s configure -bigincrement badValue

} -returnCodes error -result {expected floating-point number but got "badValue"}

test scale-1.9 {configuration options} -body {

.s configure -bg #ff0000

.s cget -bg

} -cleanup {

.s configure -bg [lindex [.s configure -bg] 3]

} -result {#ff0000}

test scale-1.10 {configuration options} -body {

.s configure -bg non-existent

} -returnCodes error -result {unknown color name "non-existent"}

test scale-1.11 {configuration options} -body {

.s configure -borderwidth 1.3

.s cget -borderwidth

} -cleanup {

.s configure -borderwidth [lindex [.s configure -borderwidth] 3]

} -result 1.3

test scale-1.12 {configuration options} -body {

.s configure -borderwidth badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test scale-1.13 {configuration options} -body {

.s configure -command {set x}

.s cget -command

} -cleanup {

.s configure -command [lindex [.s configure -command] 3]

} -result {set x}

test scale-1.15 {configuration options} -body {

.s configure -cursor arrow

.s cget -cursor

} -cleanup {

.s configure -cursor [lindex [.s configure -cursor] 3]

} -result {arrow}

test scale-1.16 {configuration options} -body {

.s configure -cursor badValue

} -returnCodes error -result {bad cursor spec "badValue"}

test scale-1.17 {configuration options} -body {

.s configure -digits 5

.s cget -digits

} -cleanup {

.s configure -digits [lindex [.s configure -digits] 3]

} -result 5

test scale-1.18 {configuration options} -body {

.s configure -digits badValue

} -returnCodes error -result {expected integer but got "badValue"}

test scale-1.19 {configuration options} -body {

.s configure -fg #00ff00

.s cget -fg

} -cleanup {

.s configure -fg [lindex [.s configure -fg] 3]

} -result {#00ff00}

test scale-1.20 {configuration options} -body {

.s configure -fg badValue

} -returnCodes error -result {unknown color name "badValue"}

test scale-1.21 {configuration options} -body {

.s configure -font fixed

.s cget -font

} -cleanup {

.s configure -font [lindex [.s configure -font] 3]

} -result {fixed}

test scale-1.23 {configuration options} -body {

.s configure -foreground green

.s cget -foreground

} -cleanup {

.s configure -foreground [lindex [.s configure -foreground] 3]

} -result {green}

test scale-1.24 {configuration options} -body {

.s configure -foreground badValue

} -returnCodes error -result {unknown color name "badValue"}

test scale-1.25 {configuration options} -body {

.s configure -from -15.0

.s cget -from

} -cleanup {

.s configure -from [lindex [.s configure -from] 3]

} -result {-15.0}

test scale-1.26 {configuration options} -body {

.s configure -from badValue

} -returnCodes error -result {expected floating-point number but got "badValue"}

test scale-1.27 {configuration options} -body {

.s configure -highlightbackground #112233

.s cget -highlightbackground

} -cleanup {

.s configure -highlightbackground [lindex [.s configure -highlightbackground] 3]

} -result {#112233}

test scale-1.28 {configuration options} -body {

.s configure -highlightbackground ugly

} -returnCodes error -result {unknown color name "ugly"}

test scale-1.29 {configuration options} -body {

.s configure -highlightcolor #123456

.s cget -highlightcolor

} -cleanup {

.s configure -highlightcolor [lindex [.s configure -highlightcolor] 3]

} -result {#123456}

test scale-1.30 {configuration options} -body {

.s configure -highlightcolor non-existent

} -returnCodes error -result {unknown color name "non-existent"}

test scale-1.31 {configuration options} -body {

.s configure -highlightthickness 2

.s cget -highlightthickness

} -cleanup {

.s configure -highlightthickness [lindex [.s configure -highlightthickness] 3]

} -result 2

test scale-1.32 {configuration options} -body {

.s configure -highlightthickness badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test scale-1.33 {configuration options} -body {

.s configure -label {Some text}

.s cget -label

} -cleanup {

.s configure -label [lindex [.s configure -label] 3]

} -result {Some text}

test scale-1.35 {configuration options} -body {

.s configure -length 130

.s cget -length

} -cleanup {

.s configure -length [lindex [.s configure -length] 3]

} -result 130

test scale-1.36 {configuration options} -body {

.s configure -length badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test scale-1.37 {configuration options} -body {

.s configure -orient horizontal

.s cget -orient

} -cleanup {

.s configure -orient [lindex [.s configure -orient] 3]

} -result {horizontal}

test scale-1.38 {configuration options} -body {

.s configure -orient badValue

} -returnCodes error -result {bad orient "badValue": must be horizontal or vertical}

test scale-1.39 {configuration options} -body {

.s configure -orient horizontal

.s cget -orient

} -cleanup {

.s configure -orient [lindex [.s configure -orient] 3]

} -result {horizontal}

test scale-1.41 {configuration options} -body {

.s configure -relief ridge

.s cget -relief

} -cleanup {

.s configure -relief [lindex [.s configure -relief] 3]

} -result {ridge}

test scale-1.42 {configuration options} -body {

.s configure -relief badValue

} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}

test scale-1.43 {configuration options} -body {

.s configure -repeatdelay 14

.s cget -repeatdelay

} -cleanup {

.s configure -repeatdelay [lindex [.s configure -repeatdelay] 3]

} -result 14

test scale-1.44 {configuration options} -body {

.s configure -repeatdelay bogus

} -returnCodes error -result {expected integer but got "bogus"}

test scale-1.45 {configuration options} -body {

.s configure -repeatinterval 14

.s cget -repeatinterval

} -cleanup {

.s configure -repeatinterval [lindex [.s configure -repeatinterval] 3]

} -result 14

test scale-1.46 {configuration options} -body {

.s configure -repeatinterval bogus

} -returnCodes error -result {expected integer but got "bogus"}

test scale-1.47 {configuration options} -body {

.s configure -resolution 2.0

.s cget -resolution

} -cleanup {

.s configure -resolution [lindex [.s configure -resolution] 3]

} -result {2.0}

test scale-1.48 {configuration options} -body {

.s configure -resolution badValue

} -returnCodes error -result {expected floating-point number but got "badValue"}

test scale-1.49 {configuration options} -body {

.s configure -showvalue 0

.s cget -showvalue

} -cleanup {

.s configure -showvalue [lindex [.s configure -showvalue] 3]

} -result 0

test scale-1.50 {configuration options} -body {

.s configure -showvalue badValue

} -returnCodes error -result {expected boolean value but got "badValue"}

test scale-1.51 {configuration options} -body {

.s configure -sliderlength 86

.s cget -sliderlength

} -cleanup {

.s configure -sliderlength [lindex [.s configure -sliderlength] 3]

} -result 86

test scale-1.52 {configuration options} -body {

.s configure -sliderlength badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test scale-1.53 {configuration options} -body {

.s configure -sliderrelief raised

.s cget -sliderrelief

} -cleanup {

.s configure -sliderrelief [lindex [.s configure -sliderrelief] 3]

} -result {raised}

test scale-1.54 {configuration options} -body {

.s configure -sliderrelief badValue

} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}

test scale-1.55 {configuration options} -body {

.s configure -state d

.s cget -state

} -cleanup {

.s configure -state [lindex [.s configure -state] 3]

} -result {disabled}

test scale-1.56 {configuration options} -body {

.s configure -state badValue

} -returnCodes error -result {bad state "badValue": must be active, disabled, or normal}

test scale-1.57 {configuration options} -body {

.s configure -state n

.s cget -state

} -cleanup {

.s configure -state [lindex [.s configure -state] 3]

} -result {normal}

test scale-1.59 {configuration options} -body {

.s configure -takefocus {any string}

.s cget -takefocus

} -cleanup {

.s configure -takefocus [lindex [.s configure -takefocus] 3]

} -result {any string}

test scale-1.61 {configuration options} -body {

.s configure -tickinterval 4.3

.s cget -tickinterval

} -cleanup {

.s configure -tickinterval [lindex [.s configure -tickinterval] 3]

} -result {4.0}

test scale-1.62 {configuration options} -body {

.s configure -tickinterval badValue

} -returnCodes error -result {expected floating-point number but got "badValue"}

test scale-1.63 {configuration options} -body {

.s configure -to 14.9

.s cget -to

} -cleanup {

.s configure -to [lindex [.s configure -to] 3]

} -result {15.0}

test scale-1.64 {configuration options} -body {

.s configure -to badValue

} -returnCodes error -result {expected floating-point number but got "badValue"}

test scale-1.65 {configuration options} -body {

.s configure -troughcolor #ff0000

.s cget -troughcolor

} -cleanup {

.s configure -troughcolor [lindex [.s configure -troughcolor] 3]

} -result {#ff0000}

test scale-1.66 {configuration options} -body {

.s configure -troughcolor non-existent

} -returnCodes error -result {unknown color name "non-existent"}

test scale-1.67 {configuration options} -body {

.s configure -variable x

.s cget -variable

} -cleanup {

.s configure -variable [lindex [.s configure -variable] 3]

} -result {x}

test scale-1.69 {configuration options} -body {

.s configure -width 32

.s cget -width

} -cleanup {

.s configure -width [lindex [.s configure -width] 3]

} -result 32

test scale-1.70 {configuration options} -body {

.s configure -width badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

#

# COMMON TEST CLEANUP

#

destroy .s

test scale-2.1 {Tk_ScaleCmd procedure} -body {

scale

} -returnCodes error -result {wrong # args: should be "scale pathName ?-option value ...?"}

test scale-2.2 {Tk_ScaleCmd procedure} -body {

scale foo

} -returnCodes error -result {bad window path name "foo"}

test scale-2.3 {Tk_ScaleCmd procedure} -body {

catch {scale foo}

winfo children .

} -result {}

test scale-2.4 {Tk_ScaleCmd procedure} -body {

scale .s -gorp dumb

} -returnCodes error -result {unknown option "-gorp"}

test scale-2.5 {Tk_ScaleCmd procedure} -body {

catch {scale .s -gorp dumb}

winfo children .

} -result {}

#

# COMMON TEST SETUP

#

# For tests 3.*

#

destroy .s

scale .s -from 100 -to 200

pack .s

update idletasks

test scale-3.1 {ScaleWidgetCmd procedure} -body {

.s

} -returnCodes error -result {wrong # args: should be ".s option ?arg ...?"}

test scale-3.2 {ScaleWidgetCmd procedure, cget option} -body {

.s cget

} -returnCodes error -result {wrong # args: should be ".s cget option"}

test scale-3.3 {ScaleWidgetCmd procedure, cget option} -body {

.s cget a b

} -returnCodes error -result {wrong # args: should be ".s cget option"}

test scale-3.4 {ScaleWidgetCmd procedure, cget option} -body {

.s cget -gorp

} -returnCodes error -result {unknown option "-gorp"}

test scale-3.5 {ScaleWidgetCmd procedure, cget option} -body {

.s configure -highlightthickness 2

.s cget -highlightthickness

} -result 2

test scale-3.6 {ScaleWidgetCmd procedure, configure option} -body {

list [llength [.s configure]] [lindex [.s configure] 6]

} -result {33 {-command command Command {} {}}}

test scale-3.7 {ScaleWidgetCmd procedure, configure option} -body {

.s configure -foo

} -returnCodes error -result {unknown option "-foo"}

test scale-3.8 {ScaleWidgetCmd procedure, configure option} -body {

.s configure -borderwidth 2 -bg

} -returnCodes error -result {value for "-bg" missing}

test scale-3.9 {ScaleWidgetCmd procedure, coords option} -body {

.s coords a b

} -returnCodes error -result {wrong # args: should be ".s coords ?value?"}

test scale-3.10 {ScaleWidgetCmd procedure, coords option} -body {

.s coords bad

} -returnCodes error -result {expected floating-point number but got "bad"}

test scale-3.11 {ScaleWidgetCmd procedure} -constraints {

fonts

} -body {

.s configure -from 100 -to 200

update idletasks

.s set 120

.s coords

} -result {38 34}

test scale-3.12 {ScaleWidgetCmd procedure, coords option} -constraints {

fonts

} -body {

.s configure -from 100 -to 200 -orient horizontal

update idletasks

.s set 120

.s coords

} -result {34 31}

test scale-3.13 {ScaleWidgetCmd procedure, get option} -body {

.s configure -orient vertical

update

.s get a

} -returnCodes error -result {wrong # args: should be ".s get ?x y?"}

test scale-3.14 {ScaleWidgetCmd procedure, get option} -body {

.s configure -orient vertical

update

.s get a b c

} -returnCodes error -result {wrong # args: should be ".s get ?x y?"}

test scale-3.15 {ScaleWidgetCmd procedure, get option} -body {

.s configure -orient vertical

update

.s get a 11

} -returnCodes error -result {expected integer but got "a"}

test scale-3.16 {ScaleWidgetCmd procedure, get option} -body {

.s configure -orient vertical

update

.s get 12 b

} -returnCodes error -result {expected integer but got "b"}

test scale-3.17 {ScaleWidgetCmd procedure, get option} -body {

.s configure -orient vertical

update

.s set 133

.s get

} -result 133

test scale-3.18 {ScaleWidgetCmd procedure, get option} -body {

.s configure -orient vertical -resolution 0.5

update

.s set 150

.s get 37 34

} -result {119.5}

#

# COMMON TEST SETUP

#

# For tests from scale-3.19

#

.s configure -resolution 1

test scale-3.19 {ScaleWidgetCmd procedure, identify option} -body {

.s identify

} -returnCodes error -result {wrong # args: should be ".s identify x y"}

test scale-3.20 {ScaleWidgetCmd procedure, identify option} -body {

.s identify 1 2 3

} -returnCodes error -result {wrong # args: should be ".s identify x y"}

test scale-3.21 {ScaleWidgetCmd procedure, identify option} -body {

.s identify boo 16

} -returnCodes error -result {expected integer but got "boo"}

test scale-3.22 {ScaleWidgetCmd procedure, identify option} -body {

.s identify 17 bad

} -returnCodes error -result {expected integer but got "bad"}

test scale-3.23 {ScaleWidgetCmd procedure, identify option} -constraints {

fonts

} -body {

.s configure -from 100 -to 200 -orient vertical -resolution 1

update

.s set 120

list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80]

} -result {trough1 slider trough2 {}}

test scale-3.24 {ScaleWidgetCmd procedure, set option} -body {

.s set

} -returnCodes error -result {wrong # args: should be ".s set value"}

test scale-3.25 {ScaleWidgetCmd procedure, set option} -body {

.s set a b

} -returnCodes error -result {wrong # args: should be ".s set value"}

test scale-3.26 {ScaleWidgetCmd procedure, set option} -body {

.s set bad

} -returnCodes error -result {expected floating-point number but got "bad"}

test scale-3.27 {ScaleWidgetCmd procedure, set option} -body {

.s configure -from 100 -to 200 -orient vertical -resolution 0.5

update

.s set 142

} -result {}

test scale-3.28 {ScaleWidgetCmd procedure, set option} -body {

.s configure -from 100 -to 200 -orient vertical -resolution 1

update

.s set 118

.s configure -state disabled

.s set 181

.s configure -state normal

.s get

} -result 118

test scale-3.29 {ScaleWidgetCmd procedure} -body {

.s dumb

} -returnCodes error -result {bad option "dumb": must be cget, configure, coords, get, identify, or set}

test scale-3.30 {ScaleWidgetCmd procedure} -body {

.s c

} -returnCodes error -result {ambiguous option "c": must be cget, configure, coords, get, identify, or set}

test scale-3.31 {ScaleWidgetCmd procedure} -body {

.s co

} -returnCodes error -result {ambiguous option "co": must be cget, configure, coords, get, identify, or set}

#

# COMMON TEST CLEANUP

#

destroy .s

test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} -setup {

destroy .s

} -body {

proc kill args {

destroy .s

}

scale .s -variable x -from 0 -to 100 -orient horizontal

pack .s

update

.s configure -command kill

.s set 55

} -cleanup {

destroy .s

} -result {}

test scale-4.1 {DestroyScale procedure} -setup {

deleteWindows

} -body {

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

} -result {0 foo foo}

test scale-5.1 {ConfigureScale procedure} -setup {

deleteWindows

} -body {

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]

} -cleanup {

deleteWindows

} -result {0 foo foo 77}

test scale-5.2 {ConfigureScale procedure} -setup {

deleteWindows

} -body {

scale .s -from 0 -to 100

.s configure -foo bar

} -cleanup {

deleteWindows

} -returnCodes error -result {unknown option "-foo"}

test scale-5.3 {ConfigureScale procedure} -setup {

deleteWindows

} -body {

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 [set x]

} -cleanup {

deleteWindows

} -result {0 0 92 3 3}

test scale-5.4 {ConfigureScale procedure} -setup {

deleteWindows

} -body {

scale .s -from 0 -to 100

.s configure -orient dumb

} -cleanup {

deleteWindows

} -returnCodes error -result {bad orient "dumb": must be horizontal or vertical}

test scale-5.5 {ConfigureScale procedure} -setup {

deleteWindows

} -body {

scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76

list [format %.1f [.s cget -from]] [format %.1f [.s cget -to]] \

[format %.1f [.s cget -tickinterval]]

} -cleanup {

deleteWindows

} -result {1.1 1.9 0.8}

test scale-5.6 {ConfigureScale procedure} -setup {

deleteWindows

} -body {

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]

} -cleanup {

deleteWindows

} -result {2.0 -2.0}

test scale-5.7 {ConfigureScale procedure} -setup {

deleteWindows

} -body {

scale .s -from 0 -to 100 -state bogus

} -cleanup {

deleteWindows

} -returnCodes error -result {bad state "bogus": must be active, disabled, or normal}

#

# COMMON TEST SETUP

#

# For tests scale-6.*

#

destroy .s

scale .s -orient horizontal -length 200

pack .s

test scale-6.1 {ComputeFormat procedure} -body {

.s configure -from 10 -to 100 -resolution 10

.s set 49.3

.s get

} -result 50

test scale-6.2 {ComputeFormat procedure} -body {

.s configure -from 100 -to 1000 -resolution 100

.s set 493

.s get

} -result 500

test scale-6.3 {ComputeFormat procedure} -body {

.s configure -from 1000 -to 10000 -resolution 1000

.s set 4930

.s get

} -result 5000

test scale-6.4 {ComputeFormat procedure} -body {

.s configure -from 10000 -to 100000 -resolution 10000

.s set 49000

.s get

} -result 50000

test scale-6.5 {ComputeFormat procedure} -body {

.s configure -from 100000 -to 1000000 -resolution 100000

.s set 493000

.s get

} -result 500000

test scale-6.6 {ComputeFormat procedure} -constraints {

nonPortable

} -body {

# 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

} -result 5000000

test scale-6.7 {ComputeFormat procedure} -body {

.s configure -from 1000000000 -to 10000000000 -resolution 1000000000

.s set 4930000000

expr {[.s get] == 5.0e+09}

} -result 1

test scale-6.8 {ComputeFormat procedure} -body {

.s configure -from .1 -to 1 -resolution .1

.s set .6

.s get

} -result {0.6}

test scale-6.9 {ComputeFormat procedure} -body {

.s configure -from .01 -to .1 -resolution .01

.s set .06

.s get

} -result {0.06}

test scale-6.10 {ComputeFormat procedure} -body {

.s configure -from .001 -to .01 -resolution .001

.s set .006

.s get

} -result {0.006}

test scale-6.11 {ComputeFormat procedure} -body {

.s configure -from .0001 -to .001 -resolution .0001

.s set .0006

.s get

} -result {0.0006}

test scale-6.12 {ComputeFormat procedure} -body {

.s configure -from .00001 -to .0001 -resolution .00001

.s set .00006

.s get

} -result {0.00006}

test scale-6.13 {ComputeFormat procedure} -body {

.s configure -from .000001 -to .00001 -resolution .000001

.s set .000006

expr {[.s get] == 6.0e-06}

} -result 1

test scale-6.14 {ComputeFormat procedure} -body {

.s configure -to .00001 -from .0001 -resolution .00001

.s set .00006

.s get

} -result {0.00006}

test scale-6.15 {ComputeFormat procedure} -body {

.s configure -to .000001 -from .00001 -resolution .000001

.s set .000006

expr {[.s get] == 6.0e-06}

} -result 1

test scale-6.16 {ComputeFormat procedure} -body {

.s configure -from .00001 -to .0001 -resolution .00001 -digits 1

.s set .00006

expr {[.s get] == 6e-05}

} -result 1

test scale-6.17 {ComputeFormat procedure} -body {

.s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3

.s set 49300000

.s get

} -result 50000000

test scale-6.18 {ComputeFormat procedure} -body {

.s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0

.s set .111111111

.s get

} -result {0.11}

test scale-6.19 {ComputeFormat procedure} -body {

.s configure -length 200 -from 1000 -to 1002 -resolution 0 -digits 0

.s set 1001.23456789

.s get

} -result {1001.23}

test scale-6.20 {ComputeFormat procedure} -body {

.s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 0

.s set 1001.23456789

.s get

} -result {1001.235}

test scale-6.21 {ComputeFormat procedure} -body {

.s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 200

.s set 1001.23456789

.s get

} -result {1001.235}

#

# COMMON TEST CLEANUP

#

destroy .s

test scale-7.1 {ComputeScaleGeometry procedure} -constraints {

nonPortable fonts

} -setup {

deleteWindows

} -body {

scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i

pack .s

update

list [winfo reqwidth .s] [winfo reqheight .s]

} -cleanup {

deleteWindows

} -result {88 458}

test scale-7.2 {ComputeScaleGeometry procedure} -constraints {

fonts

} -setup {

deleteWindows

} -body {

scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200

pack .s

update

list [winfo reqwidth .s] [winfo reqheight .s]

} -cleanup {

deleteWindows

} -result {168 108}

test scale-7.3 {ComputeScaleGeometry procedure} -constraints {

fonts

} -setup {

deleteWindows

} -body {

scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 \

-sliderlength 10

pack .s

update

list [winfo reqwidth .s] [winfo reqheight .s]

} -cleanup {

deleteWindows

} -result {22 108}

test scale-7.4 {ComputeScaleGeometry procedure} -constraints {

fonts

} -setup {

deleteWindows

} -body {

scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \

-relief sunken

pack .s

update

list [winfo reqwidth .s] [winfo reqheight .s]

} -cleanup {

deleteWindows

} -result {39 114}

test scale-7.5 {ComputeScaleGeometry procedure} -constraints {

nonPortable fonts

} -setup {

deleteWindows

} -body {

scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i

pack .s

update

list [winfo reqwidth .s] [winfo reqheight .s]

} -cleanup {

deleteWindows

} -result {458 61}

test scale-7.6 {ComputeScaleGeometry procedure} -constraints {

fonts

} -setup {

deleteWindows

} -body {

scale .s -from 0 -to 1000 -label "Long string" -orient horizontal \

-tick 500

pack .s

update

list [winfo reqwidth .s] [winfo reqheight .s]

} -cleanup {

deleteWindows

} -result {108 79}

test scale-7.7 {ComputeScaleGeometry procedure} -constraints {

fonts

} -setup {

deleteWindows

} -body {

scale .s -from 0 -to 1000 -orient horizontal -showvalue 0

pack .s

update

list [winfo reqwidth .s] [winfo reqheight .s]

} -cleanup {

deleteWindows

} -result {108 27}

test scale-7.8 {ComputeScaleGeometry procedure} -setup {

deleteWindows

} -body {

scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 \

-relief raised -highlightthickness 2

pack .s

update

list [winfo reqwidth .s] [winfo reqheight .s]

} -cleanup {

deleteWindows

} -result {114 39}

test scale-8.1 {ScaleElement procedure} -constraints {

fonts

} -setup {

deleteWindows

} -body {

scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300

pack .s

.s set 30

update

list [.s identify 53 52] [.s identify 54 52] [.s identify 70 52] \

[.s identify 71 52]

} -cleanup {

deleteWindows

} -result {{} trough1 trough1 {}}

test scale-8.2 {ScaleElement procedure} -constraints {

fonts

} -setup {

deleteWindows

} -body {

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]

} -cleanup {

deleteWindows

} -result {{} trough1 trough2 {}}

test scale-8.3 {ScaleElement procedure} -constraints {

fonts

} -setup {

deleteWindows

} -body {

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] \

} -cleanup {

deleteWindows

} -result {trough1 slider slider trough2}

test scale-8.4 {ScaleElement procedure} -setup {

deleteWindows

} -body {

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] \

} -cleanup {

deleteWindows

} -result {{} trough1 trough1 {}}

test scale-8.5 {ScaleElement procedure} -constraints {

fonts

} -setup {

deleteWindows

} -body {

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]

} -cleanup {

deleteWindows

} -result {{} trough2 trough2 {}}

test scale-8.6 {ScaleElement procedure} -constraints {

fonts

} -setup {

deleteWindows

} -body {

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]

} -cleanup {

deleteWindows

} -result {{} trough2 trough2 {}}

test scale-8.7 {ScaleElement procedure} -setup {

deleteWindows

} -body {

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]

} -cleanup {

deleteWindows

} -result {{} trough1 trough1 {}}

test scale-8.8 {ScaleElement procedure} -setup {

deleteWindows

} -body {

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]

} -cleanup {

deleteWindows

} -result {{} trough1 trough2 {}}

test scale-8.9 {ScaleElement procedure} -setup {

deleteWindows

} -body {

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]

} -cleanup {

deleteWindows

} -result {trough1 slider slider trough2}

#

# COMMON TEST SETUP

#

# For tests scale-9.*

#

destroy .s

pack [scale .s]

test scale-9.1 {PixelToValue procedure} -body {

.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2

update

.s get 46 0

} -result 0

test scale-9.2 {PixelToValue procedure} -body {

.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2

update

.s get -10 9

} -result 0

test scale-9.3 {PixelToValue procedure} -body {

.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2

update

.s get -10 12

} -result 1

test scale-9.4 {PixelToValue procedure} -body {

.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2

update

.s get -10 46

} -result 35

test scale-9.5 {PixelToValue procedure} -body {