scrollbar.test

linux系统下的音频通信

# This file is a Tcl script to test out scrollbar widgets and
# the "scrollbar" 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-1997 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: @(#) scrollbar.test 1.33 97/08/13 17:37:19

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
update

proc scroll args {
    global scrollInfo
    set scrollInfo $args
}

proc getTroughSize {w} {
    global tcl_platform
    if {$tcl_platform(platform) == "windows"} {
	if [string match v* [$w cget -orient]] {
	    return [expr [winfo height $w] - 2*[testmetrics cyvscroll]]
	} else {
	    return [expr [winfo width $w] - 2*[testmetrics cxhscroll]]
	}	    
    } else {
	if [string match v* [$w cget -orient]] {
	    return [expr [winfo height $w] \
			- ([winfo width $w] \
			       - [$w cget -highlightthickness] \
			       - [$w cget -bd] + 1)*2]
	} else {
	    return [expr [winfo width $w] \
			- ([winfo height $w] \
			       - [$w cget -highlightthickness] \
			       - [$w cget -bd] + 1)*2]
	}
    }
}

# XXX Note: this test file is woefully incomplete.  Right now there are
# only bits and pieces of tests.  Please make this file more complete
# as you fix bugs and add features.

foreach {width height} [wm minsize .] {
    set height [expr ($height < 200) ? 200 : $height]
    set width [expr ($width < 1) ? 1 : $width]
} 

frame .f -height $height -width $width
pack .f -side left
scrollbar .s
pack .s -side right -fill y
update
set i 1
foreach test {
    {-activebackground #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-activerelief sunken sunken non-existent
	    {bad relief type "non-existent": must be flat, groove, raised, ridge, solid, or sunken}}
    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-bd 4 4 badValue {bad screen distance "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} {} {}}
    {-elementborderwidth 4 4 badValue {bad screen distance "badValue"}}
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
    {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
    {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
    {-highlightthickness -2 0 {} {}}
    {-jump true 1 silly {expected boolean value but got "silly"}}
    {-orient horizontal horizontal badValue
	    {bad orientation "badValue": must be vertical or horizontal}}
    {-orient horizontal horizontal bogus {bad orientation "bogus": must be vertical or horizontal}}
    {-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
    {-repeatdelay 140 140 129.3 {expected integer but got "129.3"}}
    {-repeatinterval 140 140 129.3 {expected integer but got "129.3"}}
    {-takefocus "any string" "any string" {} {}}
    {-trough #432 #432 lousy {unknown color name "lousy"}}
    {-width 32 32 badValue {bad screen distance "badValue"}}
} {
    set name [lindex $test 0]
    test scrollbar-1.1 {configuration options} {
	.s configure $name [lindex $test 1]
	lindex [.s configure $name] 4
    } [lindex $test 2]
    incr i
    if {[lindex $test 3] != ""} {
	test scrollbar-1.2 {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 scrollbar-2.1 {Tk_ScrollbarCmd procedure} {
    list [catch {scrollbar} msg] $msg
} {1 {wrong # args: should be "scrollbar pathName ?options?"}}
test scrollbar-2.2 {Tk_ScrollbarCmd procedure} {
    list [catch {scrollbar gorp} msg] $msg
} {1 {bad window path name "gorp"}}
test scrollbar-2.3 {Tk_ScrollbarCmd procedure} {
    scrollbar .s
    set x "[winfo class .s] [info command .s]"
    destroy .s
    set x
} {Scrollbar .s}
test scrollbar-2.4 {Tk_ScrollbarCmd procedure} {
    list [catch {scrollbar .s -gorp blah} msg] $msg [winfo exists .s] \
	    [info command .s]
} {1 {unknown option "-gorp"} 0 {}}
test scrollbar-2.5 {Tk_ScrollbarCmd procedure} {
    set x [scrollbar .s]
    destroy .s
    set x
} {.s}

scrollbar .s -orient vertical -command scroll -highlightthickness 2 -bd 2
pack .s -side right -fill y
update
test scrollbar-3.1 {ScrollbarWidgetCmd procedure} {
    list [catch {.s} msg] $msg
} {1 {wrong # args: should be ".s option ?arg arg ...?"}}
test scrollbar-3.2 {ScrollbarWidgetCmd procedure, "cget" option} {
    list [catch {.s cget} msg] $msg
} {1 {wrong # args: should be ".s cget option"}}
test scrollbar-3.3 {ScrollbarWidgetCmd procedure, "cget" option} {
    list [catch {.s cget -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test scrollbar-3.4 {ScrollbarWidgetCmd procedure, "activate" option} {
    list [catch {.s activate a b} msg] $msg
} {1 {wrong # args: should be ".s activate element"}}
test scrollbar-3.5 {ScrollbarWidgetCmd procedure, "activate" option} {
    .s activate arrow1
    .s activate
} {arrow1}
test scrollbar-3.6 {ScrollbarWidgetCmd procedure, "activate" option} {
    .s activate slider
    .s activate
} {slider}
test scrollbar-3.7 {ScrollbarWidgetCmd procedure, "activate" option} {
    .s activate arrow2
    .s activate
} {arrow2}
test scrollbar-3.8 {ScrollbarWidgetCmd procedure, "activate" option} {
    .s activate s
    .s activate {}
    .s activate
} {}
test scrollbar-3.9 {ScrollbarWidgetCmd procedure, "activate" option} {
    list [catch {.s activate trough1} msg] $msg
} {0 {}}
test scrollbar-3.10 {ScrollbarWidgetCmd procedure, "cget" option} {
    list [catch {.s cget -orient} msg] $msg
} {0 vertical}
scrollbar .s2
test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pc} {
    list [catch {.s2 cget -bd} msg] $msg
} {0 0}
test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {!pc} {
    list [catch {.s2 cget -bd} msg] $msg
} {0 2}
test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pc} {
    list [catch {.s2 cget -highlightthickness} msg] $msg
} {0 0}
test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {!pc} {
    list [catch {.s2 cget -highlightthickness} msg] $msg
} {0 1}
destroy .s2
test scrollbar-3.15 {ScrollbarWidgetCmd procedure, "configure" option} {
    llength [.s configure]
} {20}
test scrollbar-3.16 {ScrollbarWidgetCmd procedure, "configure" option} {
    list [catch {.s configure -bad} msg] $msg
} {1 {unknown option "-bad"}}
test scrollbar-3.17 {ScrollbarWidgetCmd procedure, "configure" option} {
    .s configure -orient
} {-orient orient Orient vertical vertical}
test scrollbar-3.18 {ScrollbarWidgetCmd procedure, "configure" option} {
    .s configure -orient horizontal
    set x [.s cget -orient]
    .s configure -orient vertical
    set x
} {horizontal}
test scrollbar-3.19 {ScrollbarWidgetCmd procedure, "configure" option} {
    list [catch {.s configure -bad worse} msg] $msg
} {1 {unknown option "-bad"}}
test scrollbar-3.20 {ScrollbarWidgetCmd procedure, "delta" option} {
    list [catch {.s delta 24} msg] $msg
} {1 {wrong # args: should be ".s delta xDelta yDelta"}}
test scrollbar-3.21 {ScrollbarWidgetCmd procedure, "delta" option} {
    list [catch {.s delta 24 35 42} msg] $msg
} {1 {wrong # args: should be ".s delta xDelta yDelta"}}
test scrollbar-3.22 {ScrollbarWidgetCmd procedure, "delta" option} {
    list [catch {.s delta silly 24} msg] $msg
} {1 {expected integer but got "silly"}}
test scrollbar-3.23 {ScrollbarWidgetCmd procedure, "delta" option} {
    list [catch {.s delta 18 xxyz} msg] $msg
} {1 {expected integer but got "xxyz"}}
test scrollbar-3.24 {ScrollbarWidgetCmd procedure, "delta" option} {
    list [catch {.s delta 18 xxyz} msg] $msg
} {1 {expected integer but got "xxyz"}}
test scrollbar-3.25 {ScrollbarWidgetCmd procedure, "delta" option} {
    .s delta 20 0
} {0}
test scrollbar-3.26 {ScrollbarWidgetCmd procedure, "delta" option} {
    .s delta 0 20
} [format %.6g [expr 20.0/([getTroughSize .s]-1)]]
test scrollbar-3.27 {ScrollbarWidgetCmd procedure, "delta" option} {
    .s delta 0 -20
} [format %.6g [expr -20.0/([getTroughSize .s]-1)]]
test scrollbar-3.28 {ScrollbarWidgetCmd procedure, "delta" option} {
    toplevel .t -width 250 -height 100
    wm geom .t +0+0
    scrollbar .t.s -orient horizontal -borderwidth 2
    place .t.s -width 201
    update
    set result [list [.t.s delta 0 20] \
		    [.t.s delta [expr [getTroughSize .t.s] - 1] 0]]
    destroy .t
    set result
} {0 1}
test scrollbar-3.29 {ScrollbarWidgetCmd procedure, "fraction" option} {
    list [catch {.s fraction 24} msg] $msg
} {1 {wrong # args: should be ".s fraction x y"}}
test scrollbar-3.30 {ScrollbarWidgetCmd procedure, "fraction" option} {
    list [catch {.s fraction 24 30 32} msg] $msg
} {1 {wrong # args: should be ".s fraction x y"}}
test scrollbar-3.31 {ScrollbarWidgetCmd procedure, "fraction" option} {
    list [catch {.s fraction silly 24} msg] $msg
} {1 {expected integer but got "silly"}}
test scrollbar-3.32 {ScrollbarWidgetCmd procedure, "fraction" option} {
    list [catch {.s fraction 24 bogus} msg] $msg
} {1 {expected integer but got "bogus"}}
test scrollbar-3.33 {ScrollbarWidgetCmd procedure, "fraction" option} {
    .s fraction 0 0
} {0}
test scrollbar-3.34 {ScrollbarWidgetCmd procedure, "fraction" option} {
    .s fraction 0 1000
} {1}
test scrollbar-3.35 {ScrollbarWidgetCmd procedure, "fraction" option} {
    .s fraction 4 21
} [format %.6g [expr (21.0 - ([winfo height .s] - [getTroughSize .s])/2.0) \
       /([getTroughSize .s] - 1)]]
test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} {unixOnly} {
    .s fraction 4 179
} {1}
test scrollbar-3.37 {ScrollbarWidgetCmd procedure, "fraction" option} {macOrPc} {
    .s fraction 4 [expr 200 - [testmetrics cyvscroll .s]]
} {1}
test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} {unixOnly} {
    .s fraction 4 178
} {0.993711}
test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {pcOnly} {
    expr [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s] - 2]] \
	== [format %g [expr (200.0 - [testmetrics cyvscroll .s]*2 - 2) \
			   / ($height - 1 - [testmetrics cyvscroll .s]*2)]]
} 1
test scrollbar-3.40 {ScrollbarWidgetCmd procedure, "fraction" option} {macOnly} {
    .s fraction 4 178
} {0.97006}

toplevel .t -width 250 -height 100
wm geom .t +0+0
scrollbar .t.s -orient horizontal -borderwidth 2
place .t.s -width 201
update

test scrollbar-3.41 {ScrollbarWidgetCmd procedure, "fraction" option} {
    .t.s fraction 100 0
} {0.5}
if {$tcl_platform(platform) == "windows"} {
    place configure .t.s -width [expr 2*[testmetrics cxhscroll]+1]
} else {
    place configure .t.s -width [expr [winfo reqwidth .t.s] - 4]
}
update
test scrollbar-3.42 {ScrollbarWidgetCmd procedure, "fraction" option} {
    .t.s fraction 100 0
} {0}
destroy .t
test scrollbar-3.43 {ScrollbarWidgetCmd procedure, "get" option} {
    list [catch {.s get a} msg] $msg
} {1 {wrong # args: should be ".s get"}}
test scrollbar-3.44 {ScrollbarWidgetCmd procedure, "get" option} {
    .s set 100 10 13 14
    .s get
} {100 10 13 14}
test scrollbar-3.45 {ScrollbarWidgetCmd procedure, "get" option} {
    .s set 0.6 0.8
    set result {}
    foreach element [.s get] {
	lappend result [format %.1f $element]
    }
    set result
} {0.6 0.8}
test scrollbar-3.46 {ScrollbarWidgetCmd procedure, "identify" option} {
    list [catch {.s identify 0} msg] $msg
} {1 {wrong # args: should be ".s identify x y"}}
test scrollbar-3.47 {ScrollbarWidgetCmd procedure, "identify" option} {
    list [catch {.s identify 0 0 1} msg] $msg
} {1 {wrong # args: should be ".s identify x y"}}
test scrollbar-3.48 {ScrollbarWidgetCmd procedure, "identify" option} {
    list [catch {.s identify bogus 2} msg] $msg
} {1 {expected integer but got "bogus"}}
test scrollbar-3.49 {ScrollbarWidgetCmd procedure, "identify" option} {
    list [catch {.s identify -1 bogus} msg] $msg
} {1 {expected integer but got "bogus"}}
test scrollbar-3.50 {ScrollbarWidgetCmd procedure, "identify" option} {
    .s identify 5 5
} {arrow1}
test scrollbar-3.51 {ScrollbarWidgetCmd procedure, "identify" option} {
    .s identify 5 35
} {trough1}
test scrollbar-3.52 {ScrollbarWidgetCmd procedure, "identify" option} {
    .s set .3 .6
    .s identify 5 80