# This file is a Tcl script to test out the procedures in tkRectOval.c,
# which implement canvas "rectangle" and "oval" items.  It is organized
# in the standard fashion for Tcl tests.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#

source [file join [file dirname [info script]] errorMessages.tcl]

set i 1
foreach test {
    {-fill #ff0000 #ff0000
	    non-existent {unknown color name "non-existent"}}
    {-outline #123456 #123456
	    bad_color {unknown color name "bad_color"}}
    {-stipple gray50 gray50
	    bogus {bitmap "bogus" not defined}}
    {-tags {test a b c} {test a b c}
	    {} {}}
    {-width 6.0 6.0
	    abc {bad screen distance "abc"}}
} {
    lassign $test ::name ::goodValue ::goodResult ::badValue ::badResult
    test canvRect-1.$i "configuration options: good value for $::name" \
-setup ::tkp_setup \
-result [list $goodResult $goodResult] \
-body {
    .c create rectangle 20 20 80 80 -tag test
    .c itemconfigure test $::name $::goodValue
    list [lindex [.c itemconfigure test $::name] 4] [.c itemcget test $::name]
}
    incr i
    if {$::badValue ne ""} {
	test canvRect-1.$i "configuration options: bad value for $::name" \
-setup ::tkp_setup \
-returnCodes error \
-result $::badResult \
-body {
    .c create rectangle 20 20 80 80 -tag test
    .c itemconfigure test $::name $::badValue
}
    }
    incr i
    unset name goodValue goodResult badValue badResult
}

test canvRect-1.$i {configuration options} \
-setup ::tkp_setup \
-result {test xyz} \
-body {
    .c create rectangle 20 20 80 80 -tag test
    .c itemconfigure test -tags {test xyz}
    .c itemcget xyz -tags
}

test canvRect-2.1 {CreateRectOval procedure} \
-setup ::tkp_setup \
-result {1 {wrong # args: should be ".c create rect coords ?arg arg ...?"}} \
-body {
    list [catch {.c create rect} msg] $msg
}

test canvRect-2.2 {CreateRectOval procedure} \
-setup ::tkp_setup \
-result {1 {wrong # coordinates: expected 0 or 4, got 3}} \
-body {
    list [catch {.c create oval x y z} msg] $msg
}

test canvRect-2.3 {CreateRectOval procedure} \
-setup ::tkp_setup \
-result [list 1 [errMsgBadDistance "x"]] \
-body {
    list [catch {.c create rectangle x 2 3 4} msg] $msg
}

test canvRect-2.4 {CreateRectOval procedure} \
-setup ::tkp_setup \
-result [list 1 [errMsgBadDistance "y"]] \
-body {
    list [catch {.c create rectangle 1 y 3 4} msg] $msg
}

test canvRect-2.5 {CreateRectOval procedure} \
-setup ::tkp_setup \
-result [list 1 [errMsgBadDistance "z"]] \
-body {
    list [catch {.c create rectangle 1 2 z 4} msg] $msg
}

test canvRect-2.6 {CreateRectOval procedure} \
-setup ::tkp_setup \
-result [list 1 [errMsgBadDistance "q"]] \
-body {
    list [catch {.c create rectangle 1 2 3 q} msg] $msg
}

test canvRect-2.7 {CreateRectOval procedure} \
-setup ::tkp_setup \
-result {1.0 2.0 3.0 4.0} \
-body {
    .c create rectangle 1 2 3 4 -tags x
    set result {}
    foreach element [.c coords x] {
	lappend result [format %.1f $element]
    }
    set result
}

test canvRect-2.8 {CreateRectOval procedure} \
-setup ::tkp_setup \
-result {1 {unknown option "-gorp"}} \
-body {
    list [catch {.c create rectangle 1 2 3 4 -gorp foo} msg] $msg
}

test canvRect-3.1 {RectOvalCoords procedure} \
-setup ::tkp_setup \
-result {10.0 20.0 30.0 40.0} \
-body {
    .c create rectangle 10 20 30 40 -tags x
    set result {}
    foreach element [.c coords x] {
	lappend result [format %.1f $element]
    }
    set result
}

test canvRect-3.2 {RectOvalCoords procedure} \
-setup ::tkp_setup \
-result [list 1 [errMsgBadDistance "a"]] \
-body {
    .c create rectangle 10 20 30 40 -tags x
    list [catch {.c coords x a 2 3 4} msg] $msg
}

test canvRect-3.3 {RectOvalCoords procedure} \
-setup ::tkp_setup \
-result [list 1 [errMsgBadDistance "b"]] \
-body {
    .c create rectangle 10 20 30 40 -tags x
    list [catch {.c coords x 1 b 3 4} msg] $msg
}

test canvRect-3.4 {RectOvalCoords procedure} \
-setup ::tkp_setup \
-result [list 1 [errMsgBadDistance "c"]] \
-body {
    .c create rectangle 10 20 30 40 -tags x
    list [catch {.c coords x 1 2 c 4} msg] $msg
}

test canvRect-3.5 {RectOvalCoords procedure} \
-setup ::tkp_setup \
-result [list 1 [errMsgBadDistance "d"]] \
-body {
    .c create rectangle 10 20 30 40 -tags x
    list [catch {.c coords x 1 2 3 d} msg] $msg
}

test canvRect-3.6 {RectOvalCoords procedure} \
-constraints nonPortable \
-setup ::tkp_setup \
-result {9 24 16 41} \
-body {
    .c create rectangle 10 20 30 40 -tags x
    # Non-portable due to rounding differences.
    .c coords x 10 25 15 40
    .c bbox x
}

test canvRect-3.7 {RectOvalCoords procedure} \
-setup ::tkp_setup \
-result {1 {wrong # coordinates: expected 0 or 4, got 5}} \
-body {
    .c create rectangle 10 20 30 40 -tags x
    list [catch {.c coords x 1 2 3 4 5} msg] $msg
}

test canvRect-4.1 {ConfigureRectOval procedure} \
-setup ::tkp_setup \
-result {1 {bad screen distance "abc"} 1.0} \
-body {
    .c create rectangle 10 20 30 40 -tags x -width 1
    list [catch {.c itemconfigure x -width abc} msg] $msg \
	    [.c itemcget x -width]
}

test canvRect-4.2 {ConfigureRectOval procedure} \
-setup ::tkp_setup \
-result {1 {bad screen distance "-5"}} \
-body {
    .c create rectangle 10 20 30 40 -tags x -width 1
    list [catch {.c itemconfigure x -width -5} msg] $msg
}

test canvRect-4.3 {ConfigureRectOval procedure} \
-constraints {nonPortable} \
-setup ::tkp_setup \
-result {5 15 35 45} \
-body {
    .c create rectangle 10 20 30 40 -tags x -width 1
    # Non-portable due to rounding differences.
    .c itemconfigure x -width 10
    .c bbox x
}

# I can't come up with any good tests for DeleteRectOval.

test canvRect-5.1 {ComputeRectOvalBbox procedure} \
-constraints {nonPortable} \
-setup ::tkp_setup \
-result {10 5 20 15} \
-body {
    .c create rectangle 10 20 30 40 -tags x -width 1 -outline {}
    # Non-portable due to rounding differences:
    .c coords x 20 15 10 5
    .c bbox x
}

test canvRect-5.2 {ComputeRectOvalBbox procedure} \
-constraints {nonPortable} \
-setup ::tkp_setup \
-result {9 9 31 21} \
-body {
    .c create rectangle 10 20 30 40 -tags x -width 1 -outline {}
    # Non-portable due to rounding differences:
    .c coords x 10 20 30 10
    .c itemconfigure x -width 1 -outline red
    .c bbox x
}

test canvRect-5.3 {ComputeRectOvalBbox procedure} \
-constraints {nonPortable} \
-setup ::tkp_setup \
-result {9 9 31 21} \
-body {
    .c create rectangle 10 20 30 40 -tags x -width 1 -outline {}
    # Non-portable due to rounding differences:
    .c coords x 10 20 30 10
    .c itemconfigure x -width 2 -outline red
    .c bbox x
}

test canvRect-5.4 {ComputeRectOvalBbox procedure} \
-constraints {nonPortable} \
-setup ::tkp_setup \
-result {8 8 32 22} \
-body {
    .c create rectangle 10 20 30 40 -tags x -width 1 -outline {}
    # Non-portable due to rounding differences:
    .c coords x 10 20 30 10
    .c itemconfigure x -width 3 -outline red
    .c bbox x
}

# I can't come up with any good tests for DisplayRectOval.

test canvRect-6.1 {RectToPoint procedure} \
-setup ::tkp_setup \
-result "1 2 2 1" \
-body {
    set x [.c create rectangle 10 20 30 35 -tags x -fill green];#=1
    set y [.c create rectangle 15 25 25 30  -tags y -fill red];#=2
    .c itemconfigure 0 -state hidden ;# hide the root item
    .c itemconfigure y -outline {}
    list [.c find closest 14.9 28] [.c find closest 15.1 28] \
	    [.c find closest 24.9 28] [.c find closest 25.1 28]
}

test canvRect-6.2 {RectToPoint procedure} \
-setup ::tkp_setup \
-result "1 2 2 1" \
-body {
    set x  [.c create rectangle 10 20 30 35 -tags x -fill green]
    set y [.c create rectangle 15 25 25 30  -tags y -fill red]
    .c itemconfigure 0 -state hidden ;# hide the root item
    .c itemconfigure y -outline {}
    list [.c find closest 20 24.9] [.c find closest 20 25.1] \
	    [.c find closest 20 29.9]  [.c find closest 20 30.1]
}

test canvRect-6.3 {RectToPoint procedure} \
-setup ::tkp_setup \
-result "1 2 2 1" \
-body {
    set x  [.c create rectangle 10 20 30 35 -tags x -fill green]
    set y [.c create rectangle 15 25 25 30  -tags y -fill red]
    .c itemconfigure 0 -state hidden ;# hide the root item
    .c itemconfigure y -width 1 -outline black
    list [.c find closest 14.4 28] [.c find closest 14.6 28] \
	    [.c find closest 25.4 28] [.c find closest 25.6 28]
}

test canvRect-6.4 {RectToPoint procedure} \
-setup ::tkp_setup \
-result "1 2 2 1" \
-body {
    set x  [.c create rectangle 10 20 30 35 -tags x -fill green]
    set y [.c create rectangle 15 25 25 30  -tags y -fill red]
    .c itemconfigure 0 -state hidden ;# hide the root item
    .c itemconfigure  y -width 1 -outline black
    list [.c find closest 20 24.4] [.c find closest 20 24.6] \
	    [.c find closest 20 30.4] [.c find closest 20 30.6]
}

test canvRect-6.5 {RectToPoint procedure} \
-setup ::tkp_setup \
-result "1 2 2 1" \
-body {
    set x  [.c create rectangle 10 20 30 35 -tags x -fill green]
    set y [.c create rectangle 15 25 25 30  -tags y -fill red]
    .c itemconfigure 0 -state hidden ;# hide the root item
    .c itemconfigure x -fill {} -outline black -width 3
    .c itemconfigure y -outline {}
    list [.c find closest 13.2 28] [.c find closest 13.3 28] \
	    [.c find closest 26.7 28] [.c find closest 26.8 28]
}

test canvRect-6.6 {RectToPoint procedure} \
-setup ::tkp_setup \
-result "1 2 2 1" \
-body {
    set x [.c create rectangle 10 20 30 35 -tags x -fill green]
    set y [.c create rectangle 15 25 25 30  -tags y -fill red]
    .c itemconfigure 0 -state hidden ;# hide the root item
    .c itemconfigure x -fill {} -outline black -width 3
    .c itemconfigure y -outline {}
    list [.c find closest 20 23.2] [.c find closest 20 23.3] \
	    [.c find closest 20 31.7] [.c find closest 20 31.8]
}

test canvRect-6.7 {RectToPoint procedure} \
-setup ::tkp_setup \
-result "1 2 2 2" \
-body {
    set x [.c create rectangle 10 20 30 40 -outline {} -fill black]
    set y [.c create rectangle 40 40 50 50 -outline {} -fill black]
    .c itemconfigure 0 -state hidden ;# hide the root item
    .c itemconfigure x -fill {} -outline black -width 3
    .c itemconfigure y -outline {}
    list [.c find closest 35 35] [.c find closest 36 36] \
	    [.c find closest 37 37] [.c find closest 38 38]
}

test canvRect-7.1 {RectToArea procedure} \
-setup ::tkp_setup \
-result {{} 2 2 2 {}} \
-body {
    set x  [.c create rectangle 10 20 30 35 -fill green -outline {}]
    set y [.c create rectangle 40 45 60 70 -fill red -outline black -width 3]
    set z [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3]
    list [.c find overlapping 20 50 38 60] \
	    [.c find overlapping 20 50 39 60] \
	    [.c find overlapping 20 50 70 60] \
	    [.c find overlapping 61 50 70 60] \
	    [.c find overlapping 62 50 70 60]
}

test canvRect-7.2 {RectToArea procedure} \
-setup ::tkp_setup \
-result {{} 2 2 2 {}} \
-body {
    set x  [.c create rectangle 10 20 30 35 -fill green -outline {}]
    set y [.c create rectangle 40 45 60 70 -fill red -outline black -width 3]
    set z [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3]
    list [.c find overlapping 45 20 55 43] \
	    [.c find overlapping 45 20 55 44] \
	    [.c find overlapping 45 20 55 80] \
	    [.c find overlapping 45 71 55 80] \
	    [.c find overlapping 45 72 55 80]
}

test canvRect-7.3 {RectToArea procedure} \
-setup ::tkp_setup \
-result {{} 1} \
-body {
    set x  [.c create rectangle 10 20 30 35 -fill green -outline {}]
    set y [.c create rectangle 40 45 60 70 -fill red -outline black -width 3]
    set z [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3]
    list [.c find overlapping 5 25 9.9 30] [.c find overlapping 5 25 10.1 30]
}

test canvRect-7.4 {RectToArea procedure} \
-setup ::tkp_setup \
-result {{} 3 3 3 3} \
-body {
    set x  [.c create rectangle 10 20 30 35 -fill green -outline {}]
    set y [.c create rectangle 40 45 60 70 -fill red -outline black -width 3]
    set z [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3]
    list [.c find overlapping 102 152 118 168] \
	    [.c find overlapping 101 152 118 168] \
	    [.c find overlapping 102 151 118 168] \
	    [.c find overlapping 102 152 119 168] \
	    [.c find overlapping 102 152 118 169]
}

test canvRect-7.5 {RectToArea procedure} \
-setup ::tkp_setup \
-result {{} {} 2 {} {}} \
-body {
    set x  [.c create rectangle 10 20 30 35 -fill green -outline {}]
    set y [.c create rectangle 40 45 60 70 -fill red -outline black -width 3]
    set z [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3]
    list [.c find enclosed 20 40 38 80] \
	    [.c find enclosed 20 40 39 80] \
	    [.c find enclosed 20 40 70 80] \
	    [.c find enclosed 61 40 70 80] \
	    [.c find enclosed 62 40 70 80]
}

test canvRect-7.6 {RectToArea procedure} \
-setup ::tkp_setup \
-result {{} {} 2 {} {}} \
-body {
    set x  [.c create rectangle 10 20 30 35 -fill green -outline {}]
    set y [.c create rectangle 40 45 60 70 -fill red -outline black -width 3]
    set z [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3]
    list [.c find enclosed 20 20 65 43] \
	    [.c find enclosed 20 20 65 44] \
	    [.c find enclosed 20 20 65 80] \
	    [.c find enclosed 20 71 65 80] \
	    [.c find enclosed 20 72 65 80]
}

test canvRect-8.1 {OvalToArea procedure} \
-setup ::tkp_setup \
-result {{} {2 3} {1 2 3} {1 2 3} {1 2} {1 2 3} {2 3} {}} \
-body {
    set x  [.c create oval 50 100 200 150 -fill green -outline {}]
    set y [.c create oval 50 100 200 150 -fill red -outline black -width 3]
    set z [.c create oval 50 100 200 150 -fill {} -outline black -width 3]
    list [.c find overlapping 20 120 48 130] \
	    [.c find overlapping 20 120 49 130] \
	    [.c find overlapping 20 120 50.2 130] \
	    [.c find overlapping 20 120 300 130] \
	    [.c find overlapping 60 120 190 130] \
	    [.c find overlapping 199.9 120 300 130] \
	    [.c find overlapping 201 120 300 130] \
	    [.c find overlapping 202 120 300 130]
}

test canvRect-8.2 {OvalToArea procedure} \
-setup ::tkp_setup \
-result {{} {2 3} {1 2 3} {1 2 3} {1 2} {1 2 3} {2 3} {}} \
-body {
    set x  [.c create oval 50 100 200 150 -fill green -outline {}]
    set y [.c create oval 50 100 200 150 -fill red -outline black -width 3]
    set z [.c create oval 50 100 200 150 -fill {} -outline black -width 3]
    list [.c find overlapping 100 50 150 98] \
	    [.c find overlapping 100 50 150 99] \
	    [.c find overlapping 100 50 150 100.1] \
	    [.c find overlapping 100 50 150 200] \
	    [.c find overlapping 100 110 150 140] \
	    [.c find overlapping 100 149.9 150 200] \
	    [.c find overlapping 100 151 150 200] \
	    [.c find overlapping 100 152 150 200]
}

test canvRect-8.3 {OvalToArea procedure} \
-setup ::tkp_setup \
-result {{} {1 2} {} {1 2} {} {1 2} {} {1 2}} \
-body {
    set x  [.c create oval 50 100 200 150 -fill green -outline {}]
    set y [.c create oval 50 100 200 150 -fill red -outline black -width 3]
    set z [.c create oval 50 100 200 150 -fill {} -outline black -width 3]
    list [.c find overlapping 176 104 177 105] \
	    [.c find overlapping 187 116 188 117] \
	    [.c find overlapping 192 142 193 143] \
	    [.c find overlapping 180 138 181 139] \
	    [.c find overlapping 61 142 62 143] \
	    [.c find overlapping 65 137 66 136] \
	    [.c find overlapping 62 108 63 109] \
	    [.c find overlapping 68 115 69 116]
}

test canvRect-9.1 {ScaleRectOval procedure} \
-setup ::tkp_setup \
-result {150.0 900.0 350.0 1100.0} \
-body {
    .c create rect 100 300 200 350 -tags x
    .c scale x 50 100 2 4
    .c coords x
}

test canvRect-10.1 {TranslateRectOval procedure} \
-setup ::tkp_setup \
-result {200.0 290.0 300.0 340.0} \
-body {
    .c create rect 100 300 200 350 -tags x
    .c move x 100 -10
    .c coords x
}

# This test is non-portable because different color information
# will get generated on different displays (e.g. mono displays
# vs. color).
test canvRect-11.1 {RectOvalToPostscript procedure} \
-constraints {nonPortable macCrash} \
-setup ::tkp_setup \
-result {-200 -150 translate
0 300 moveto 400 300 lineto 400 0 lineto 0 0 lineto closepath clip newpath
gsave
50 240 moveto 40 0 rlineto 0 -20 rlineto -40 0 rlineto closepath
0.000 0.000 0.000 setrgbcolor AdjustColor
clip 16 16 <5555aaaa5555aaaa5555aaaa5555aaaa5555aaaa5555aaaa5555aaaa5555
aaaa> StippleFill
grestore
gsave
matrix currentmatrix
150 125 translate 50 25 scale 1 0 moveto 0 0 1 0 360 arc
setmatrix
5 setlinewidth 0 setlinejoin 2 setlinecap
1.000 0.000 0.000 setrgbcolor AdjustColor
stroke
grestore
restore showpage

%%Trailer
end
%%EOF
} \
-body {
    # Crashes on Mac because the XGetImage() call isn't implemented, causing a
    # dereference of NULL.
    .c configure -bd 0 -highlightthickness 0
    .c delete withtag all
    .c create rect 50 60 90 80 -fill black -stipple gray50 -outline {}
    .c create oval 100 150 200 200 -fill {} -outline #ff0000 -width 5
    update
    set x [.c postscript]
    string range $x [string first "-200 -150 translate" $x] end
}

# cleanup
::tkp_cleanup
return
