canvtext.test

linux系统下的音频通信

# This file is a Tcl script to test out the procedures in tkCanvText.c,
# which implement canvas "text" items.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1996-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: @(#) canvText.test 1.8 97/06/24 13:34:16

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

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

canvas .c -width 400 -height 300 -bd 2 -relief sunken
pack .c
update

set i 1
.c create text 20 20 -tag test

set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
set ay [font metrics $font -linespace]
set ax [font measure $font 0]


foreach test {
    {-anchor nw nw xyz {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center}}
    {-fill #ff0000 #ff0000 xyz {unknown color name "xyz"}}
    {-font {Times 40} {Times 40} {} {font "" doesn't exist}}
    {-justify left left xyz {bad justification "xyz": must be left, right, or center}}
    {-stipple gray50 gray50 xyz {bitmap "xyz" not defined}}
    {-tags {test a b c} {test a b c} {} {}}
    {-text xyz xyz {} {}}
    {-width 6 6 xyz {bad screen distance "xyz"}}
} {
    set name [lindex $test 0]
    test canvText-1.$i {configuration options} {
	.c itemconfigure test $name [lindex $test 1]
	list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name]
    } [list [lindex $test 2] [lindex $test 2]]
    incr i
    if {[lindex $test 3] != ""} {
	test canvText-1.$i {configuration options} {
	    list [catch {.c itemconfigure test $name [lindex $test 3]} msg] $msg
	} [list 1 [lindex $test 4]]
    }
    incr i
}
test canvText-1.$i {configuration options} {
    .c itemconfigure test -tags {test xyz}
    .c itemcget xyz -tags
} {test xyz}

.c delete test
.c create text 20 20 -tag test

test canvText-2.1 {CreateText procedure: args} {
    list [catch {.c create text} msg] $msg
} {1 {wrong # args: should be ".c create text x y ?options?"}}
test canvText-2.2 {CreateText procedure: args} {
    list [catch {.c create text xyz 0} msg] $msg
} {1 {bad screen distance "xyz"}}
test canvText-2.3 {CreateText procedure: args} {
    list [catch {.c create text 0 xyz} msg] $msg
} {1 {bad screen distance "xyz"}}
test canvText-2.4 {CreateText procedure: args} {
    list [catch {.c create text 0 0 -xyz xyz} msg] $msg
} {1 {unknown option "-xyz"}}
test canvText-2.5 {CreateText procedure} {
    .c create text 0 0 -tags x
    set x [.c coords x]
    .c delete x
    set x
} {0.0 0.0}

focus -force .c
.c focus test
.c coords test 0 0
update

test canvText-3.1 {TextCoords procedure} {
    .c coords test
} {0.0 0.0}
test canvText-3.2 {TextCoords procedure} {
    list [catch {.c coords test xyz 0} msg] $msg
} {1 {bad screen distance "xyz"}}
test canvText-3.3 {TextCoords procedure} {
    list [catch {.c coords test 0 xyz} msg] $msg
} {1 {bad screen distance "xyz"}}
test canvText-3.4 {TextCoords procedure} {
    .c coords test 10 10
    set result {}
    foreach element [.c coords test] {
	lappend result [format %.1f $element]
    }
    set result
} {10.0 10.0}
test canvText-3.5 {TextCoords procedure} {
    list [catch {.c coords test 10} msg] $msg
} {1 {wrong # coordinates: expected 0 or 2, got 1}}
test canvText-3.6 {TextCoords procedure} {
    list [catch {.c coords test 10 10 10} msg] $msg
} {1 {wrong # coordinates: expected 0 or 2, got 3}}

test canvText-4.1 {ConfigureText procedure} {
    list [catch {.c itemconfig test -fill xyz} msg] $msg
} {1 {unknown color name "xyz"}}
test canvText-4.2 {ConfigureText procedure} {
    .c itemconfig test -fill blue
    .c itemcget test -fill
} {blue}
test canvText-4.3 {ConfigureText procedure: construct font gcs} {
    .c itemconfig test -font "times 20" -fill black -stipple gray50
    list [.c itemcget test -font] [.c itemcget test -fill] [.c itemcget test -stipple]
} {{times 20} black gray50}
test canvText-4.4 {ConfigureText procedure: construct cursor gc} {
    .c itemconfig test -text "abcdefg"
    .c select from test 2
    .c select to test 4
    .c icursor test 3

    # Both black -> cursor becomes white.
    .c config -insertbackground black
    .c config -selectbackground black
    .c itemconfig test -just left
    update

    # Both same color (and not black) -> cursor becomes black.
    .c config -insertbackground red
    .c config -selectbackground red
    .c itemconfig test -just left
    update
} {}
test canvText-4.5 {ConfigureText procedure: adjust selection} {
    set x {}
    .c itemconfig test -text "abcdefghi"
    .c select from test 2
    .c select to test 6
    lappend x [selection get]
    .c dchars test 1 end
    lappend x [catch {selection get}]
    .c insert test end "bcdefghi"
    .c select from test 2
    .c select to test 6
    lappend x [selection get]
    .c dchars test 4 end
    lappend x [selection get]
    .c insert test end "efghi"
    .c select from test 6
    .c select to test 2
    lappend x [selection get]
    .c dchars test 4 end
    lappend x [selection get]
} {cdefg 1 cdefg cd cdef cd}
test canvText-4.6 {ConfigureText procedure: adjust cursor} {
    .c itemconfig test -text "abcdefghi"
    set x {}
    .c icursor test 6
    .c dchars test 4 end
    .c index test insert
} {4}

test canvText-5.1 {ConfigureText procedure: adjust cursor} {
    .c create text 10 10 -tag x -fill blue -font "times 40" -stipple gray50 -text "xyz"
    .c delete x
} {}

test canvText-6.1 {ComputeTextBbox procedure} {fonts} {
    .c itemconfig test -font $font -text 0
    .c coords test 0 0
    set x {}
    lappend x [.c itemconfig test -anchor n; .c bbox test]
    lappend x [.c itemconfig test -anchor nw; .c bbox test]
    lappend x [.c itemconfig test -anchor w; .c bbox test]
    lappend x [.c itemconfig test -anchor sw; .c bbox test]
    lappend x [.c itemconfig test -anchor s; .c bbox test]
    lappend x [.c itemconfig test -anchor se; .c bbox test]
    lappend x [.c itemconfig test -anchor e; .c bbox test]
    lappend x [.c itemconfig test -anchor ne; .c bbox test]
    lappend x [.c itemconfig test -anchor center; .c bbox test]
} "{[expr -$ax/2-1] 0 [expr $ax/2+1] $ay}\
{-1 0 [expr $ax+1] $ay}\
{-1 [expr -$ay/2] [expr $ax+1] [expr $ay/2]}\
{-1 -$ay [expr $ax+1] 0}\
{[expr -$ax/2-1] -$ay [expr $ax/2+1] 0}\
{[expr -$ax-1] -$ay 1 0}\
{[expr -$ax-1] [expr -$ay/2] 1 [expr $ay/2]}\
{[expr -$ax-1] 0 1 $ay}\
{[expr -$ax/2-1] [expr -$ay/2] [expr $ax/2+1] [expr $ay/2]}"

focus .c
.c focus test
.c itemconfig test -text "abcd\nefghi\njklmnopq"
test canvText-7.1 {DisplayText procedure: stippling} {
    .c itemconfig test -stipple gray50
    update
    .c itemconfig test -stipple {}
    update
} {}
test canvText-7.2 {DisplayText procedure: draw selection} {
    .c select from test 0
    .c select to test end
    update
    selection get
} "abcd\nefghi\njklmnopq"
test canvText-7.3 {DisplayText procedure: selection} {
    .c select from test 0
    .c select to test end
    update
    selection get
} "abcd\nefghi\njklmnopq"
test canvText-7.4 {DisplayText procedure: one line selection} {
    .c select from test 2
    .c select to test 3
    update
} {}
test canvText-7.5 {DisplayText procedure: multi-line selection} {
    .c select from test 2
    .c select to test 12
    update
} {}
test canvText-7.6 {DisplayText procedure: draw cursor} {
    .c icursor test 3
    update
} {}
test canvText-7.7 {DisplayText procedure: selected text different color} {
    .c config -selectforeground blue
    .c itemconfig test -anchor n
    update
} {}
test canvText-7.8 {DisplayText procedure: not selected} {
    .c select clear
    update
} {}

test canvText-8.1 {TextInsert procedure: 0 length insert} {
    .c insert test end {}
} {}
test canvText-8.2 {TextInsert procedure: before beginning/after end} {