# path.test --
#
package require tcltest
namespace import tcltest::*

namespace eval ::TEST {

proc ::TEST::_setup {} {
    catch {destroy {*}[winfo children .]}
    pack [::tko::path .c -width 60 -height 40 -bd 0 -highlightthickness 0]
    update
}

test path.canvWind-1.1 {
    DisplayWinItem, windows off-screen vertically
} {
    catch {destroy .t}
    toplevel .t
    ::tko::path .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \
	    -relief sunken -xscrollincrement 1 -yscrollincrement 1 \
	    -highlightthickness 1
    pack .t.c -fill both -expand 1 -padx 20 -pady 20
    wm geometry .t +0+0
    set f .t.c.f
    frame $f -width 80 -height 50 -bg red
    .t.c create window 300 400 -window $f -anchor nw
    .t.c xview moveto .3
    .t.c yview moveto .50
    update
    set x [list [list [winfo ismapped $f] [winfo y $f]]]
    .t.c yview scroll 52 units
    update
    lappend x [list [winfo ismapped $f] [winfo y $f]]
    .t.c yview scroll 1 units
    update
    lappend x [list [winfo ismapped $f] [winfo y $f]]
    .t.c yview scroll -255 units
    update
    lappend x [list [winfo ismapped $f] [winfo y $f]]
    .t.c yview scroll -1 units
    update
    lappend x [list [winfo ismapped $f] [winfo y $f]]
} {{1 3} {1 -49} {0 -49} {1 205} {0 205}}

test path.canvWind-1.2 {
    DisplayWinItem, windows off-screen vertically
} {
    catch {destroy .t}
    toplevel .t
    ::tko::path .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \
	    -relief sunken -xscrollincrement 1 -yscrollincrement 1 \
	    -highlightthickness 1
    pack .t.c -fill both -expand 1 -padx 20 -pady 20
    wm geometry .t +0+0
    set f .t.c.f
    frame $f -width 80 -height 50 -bg red
    .t.c create window 300 400 -window $f -anchor nw
    .t.c xview moveto .3
    .t.c yview moveto .50
    update
    set x [list [list [winfo ismapped $f] [winfo y $f]]]
    .t.c yview scroll 52 units
    update
    lappend x [list [winfo ismapped $f] [winfo y $f]]
    .t.c yview scroll 1 units
    update
    lappend x [list [winfo ismapped $f] [winfo y $f]]
    .t.c yview scroll -255 units
    update
    lappend x [list [winfo ismapped $f] [winfo y $f]]
    .t.c yview scroll -1 units
    update
    lappend x [list [winfo ismapped $f] [winfo y $f]]
} {{1 3} {1 -49} {0 -49} {1 205} {0 205}}

test path.canvWind-1.3 {
    DisplayWinItem, windows off-screen horizontally
} {
    catch {destroy .t}
    toplevel .t
    ::tko::path .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \
	    -relief sunken -xscrollincrement 1 -yscrollincrement 1 \
	    -highlightthickness 1
    pack .t.c -fill both -expand 1 -padx 20 -pady 20
    wm geometry .t +0+0
    set f .t.f
    frame $f -width 80 -height 50 -bg red
    .t.c create window 300 400 -window $f -anchor nw
    .t.c xview moveto .3
    .t.c yview moveto .50
    update
    set x [list [list [winfo ismapped $f] [winfo x $f]]]
    .t.c xview scroll 82 units
    update
    lappend x [list [winfo ismapped $f] [winfo x $f]]
    .t.c xview scroll 1 units
    update
    lappend x [list [winfo ismapped $f] [winfo x $f]]
    .t.c xview scroll -335 units
    update
    lappend x [list [winfo ismapped $f] [winfo x $f]]
    .t.c xview scroll -1 units
    update
    lappend x [list [winfo ismapped $f] [winfo x $f]]
} {{1 23} {1 -59} {0 -59} {1 275} {0 275}}

test path.canvWind-1.4 {
    DisplayWinItem, windows off-screen horizontally
} {
    catch {destroy .t}
    toplevel .t
    ::tko::path .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \
	    -relief sunken -xscrollincrement 1 -yscrollincrement 1 \
	    -highlightthickness 1
    pack .t.c -fill both -expand 1 -padx 20 -pady 20
    wm geometry .t +0+0
    set f .t.c.f
    frame $f -width 80 -height 50 -bg red
    .t.c create window 300 400 -window $f -anchor nw
    .t.c xview moveto .3
    .t.c yview moveto .50
    update
    set x [list [list [winfo ismapped $f] [winfo x $f]]]
    .t.c xview scroll 82 units
    update
    lappend x [list [winfo ismapped $f] [winfo x $f]]
    .t.c xview scroll 1 units
    update
    lappend x [list [winfo ismapped $f] [winfo x $f]]
    .t.c xview scroll -335 units
    update
    lappend x [list [winfo ismapped $f] [winfo x $f]]
    .t.c xview scroll -1 units
    update
    lappend x [list [winfo ismapped $f] [winfo x $f]]
} {{1 3} {1 -79} {0 -79} {1 255} {0 255}}
catch {destroy .t}

test path.canvas-1.1 {
    configuration options: good value for -background
} -setup {
    ::TEST::_setup
} -body {
	.c configure -background #ff0000
	lindex [.c configure -background] 4
} -result #ff0000

test path.canvas-1.2 {
    configuration options: bad value for -background
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -background non-existent
} -result {*: unknown color name "non-existent"}

test path.canvas-1.3 {
    configuration options: good value for -bg
} -setup {
    ::TEST::_setup
} -body {
	.c configure -bg #ff0000
	lindex [.c configure -bg] 4
} -result #ff0000

test path.canvas-1.4 {
    configuration options: bad value for -bg
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -bg non-existent
} -result {*: unknown color name "non-existent"}

test path.canvas-1.5 {
    configuration options: good value for -borderwidth
} -setup {
    ::TEST::_setup
} -body {
	.c configure -borderwidth 5
	lindex [.c configure -borderwidth] 4
} -result 5

test path.canvas-1.6 {
    configuration options: bad value for -borderwidth
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -borderwidth badValue
} -result {*: bad screen distance "badValue"}

test path.canvas-1.7 {
    configuration options: good value for -bd
} -setup {
    ::TEST::_setup
} -body {
	.c configure -bd 5
	lindex [.c configure -bd] 4
} -result 5

test path.canvas-1.8 {
    configuration options: bad value for -bd
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -bd badValue
} -result {*: bad screen distance "badValue"}

test path.canvas-1.9 {
    configuration options: good value for -closeenough
} -setup {
    ::TEST::_setup
} -body {
	.c configure -closeenough 24
	lindex [.c configure -closeenough] 4
} -result 24.0

test path.canvas-1.10 {
    configuration options: bad value for -closeenough
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -closeenough bogus
} -result {*: expected floating-point number but got "bogus"}

test path.canvas-1.11 {
    configuration options: good value for -confine
} -setup {
    ::TEST::_setup
} -body {
	.c configure -confine true
	lindex [.c configure -confine] 4
} -result 1

test path.canvas-1.12 {
    configuration options: bad value for -confine
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -confine silly
} -result {*: expected boolean value but got "silly"}

test path.canvas-1.13 {
    configuration options: good value for -cursor
} -setup {
    ::TEST::_setup
} -body {
	.c configure -cursor arrow
	lindex [.c configure -cursor] 4
} -result arrow

test path.canvas-1.14 {
    configuration options: bad value for -cursor
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -cursor badValue
} -result {*: bad cursor spec "badValue"}

test path.canvas-1.15 {
    configuration options: good value for -height
} -setup {
    ::TEST::_setup
} -body {
	.c configure -height 2.1
	lindex [.c configure -height] 4
} -result 2

test path.canvas-1.16 {
    configuration options: bad value for -height
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -height x42
} -result {*: bad screen distance "x42"}

test path.canvas-1.17 {
    configuration options: good value for -highlightbackground
} -setup {
    ::TEST::_setup
} -body {
	.c configure -highlightbackground #112233
	lindex [.c configure -highlightbackground] 4
} -result #112233

test path.canvas-1.18 {
    configuration options: bad value for -highlightbackground
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -highlightbackground ugly
} -result {*: unknown color name "ugly"}

test path.canvas-1.19 {
    configuration options: good value for -highlightcolor
} -setup {
    ::TEST::_setup
} -body {
	.c configure -highlightcolor #110022
	lindex [.c configure -highlightcolor] 4
} -result #110022

test path.canvas-1.20 {
    configuration options: bad value for -highlightcolor
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -highlightcolor bogus
} -result {*: unknown color name "bogus"}

test path.canvas-1.21 {
    configuration options: good value for -highlightthickness
} -setup {
    ::TEST::_setup
} -body {
	.c configure -highlightthickness 18
	lindex [.c configure -highlightthickness] 4
} -result 18

test path.canvas-1.22 {
configuration options: bad value for -highlightthickness
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -highlightthickness badValue
} -result {*: bad screen distance "badValue"}

test path.canvas-1.23 {
    configuration options: good value for -insertbackground
} -setup {
    ::TEST::_setup
} -body {
	.c configure -insertbackground #110022
	lindex [.c configure -insertbackground] 4
} -result #110022

test path.canvas-1.24 {
    configuration options: bad value for -insertbackground
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -insertbackground bogus
} -result {*: unknown color name "bogus"}

test path.canvas-1.25 {
    configuration options: good value for -insertborderwidth
} -setup {
    ::TEST::_setup
} -body {
	.c configure -insertborderwidth 1.3
	lindex [.c configure -insertborderwidth] 4
} -result 1

test path.canvas-1.26 {
    configuration options: bad value for -insertborderwidth
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -insertborderwidth 2.6x
} -result {*: bad screen distance "2.6x"}

test path.canvas-1.27 {
    configuration options: good value for -insertofftime
} -setup {
    ::TEST::_setup
} -body {
	.c configure -insertofftime 100
	lindex [.c configure -insertofftime] 4
} -result 100

test path.canvas-1.28 {
    configuration options: bad value for -insertofftime
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -insertofftime 3.2
} -result {*: expected integer but got "3.2"}

test path.canvas-1.29 {
    configuration options: good value for -insertontime
} -setup {
    ::TEST::_setup
} -body {
	.c configure -insertofftime 10
	lindex [.c configure -insertofftime] 4
} -result 10

test path.canvas-1.30 {
    configuration options: bad value for -insertontime
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -insertofftime 3.5
} -result {*: expected integer but got "3.5"}

test path.canvas-1.31 {
    configuration options: good value for -insertwidth
} -setup {
    ::TEST::_setup
} -body {
	.c configure -insertwidth 1.3
	lindex [.c configure -insertwidth] 4
} -result 1

test path.canvas-1.32 {
    configuration options: bad value for -insertwidth
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -insertwidth 6x
} -result {*: bad screen distance "6x"}

test path.canvas-1.33 {
    configuration options: good value for -relief
} -setup {
    ::TEST::_setup
} -body {
	.c configure -relief groove
	lindex [.c configure -relief] 4
} -result groove

test path.canvas-1.34 {
    configuration options: bad value for -relief
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -relief 1.5
} -result {*: bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}

test path.canvas-1.35 {
    configuration options: good value for -selectbackground
} -setup {
    ::TEST::_setup
} -body {
	.c configure -selectbackground #110022
	lindex [.c configure -selectbackground] 4
} -result #110022

test path.canvas-1.36 {
    configuration options: bad value for -selectbackground
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -selectbackground bogus
} -result {*: unknown color name "bogus"}

test path.canvas-1.37 {
    configuration options: good value for -selectborderwidth
} -setup {
    ::TEST::_setup
} -body {
	.c configure -selectborderwidth 1.3
	lindex [.c configure -selectborderwidth] 4
} -result 1

test path.canvas-1.38 {
    configuration options: bad value for -selectborderwidth
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -selectborderwidth badValue
} -result {*: bad screen distance "badValue"}

test path.canvas-1.39 {
    configuration options: good value for -selectforeground
} -setup {
    ::TEST::_setup
} -body {
	.c configure -selectforeground #654321
	lindex [.c configure -selectforeground] 4
} -result #654321

test path.canvas-1.40 {
    configuration options: bad value for -selectforeground
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -selectforeground bogus
} -result {*: unknown color name "bogus"}

test path.canvas-1.41 {
    configuration options: good value for -takefocus
} -setup {
    ::TEST::_setup
} -body {
	.c configure -takefocus "any string"
	lindex [.c configure -takefocus] 4
} -result "any string"

test path.canvas-1.42 {
    configuration options: good value for -width
} -setup {
    ::TEST::_setup
} -body {
	.c configure -width 402
	lindex [.c configure -width] 4
} -result 402

test path.canvas-1.43 {
    configuration options: bad value for -width
} -returnCodes error -match glob -setup {
    ::TEST::_setup
} -body {
    .c configure -width xyz
} -result {*: bad screen distance "xyz"}

test path.canvas-1.44 {
    configuration options: good value for -xscrollcommand
} -setup {
    ::TEST::_setup
} -body {
	.c configure -xscrollcommand "some command"
	lindex [.c configure -xscrollcommand] 4
} -result "some command"

test path.canvas-1.45 {
    configuration options: good value for -yscrollcommand
} -setup {
    ::TEST::_setup
} -body {
	.c configure -yscrollcommand "other command"
	lindex [.c configure -yscrollcommand] 4
} -result "other command"

test path.canvas-1.46 {
    configure throws error on bad option
} -setup {
    ::TEST::_setup
} -body {
    set res [list [catch {.c configure -gorp foo}]]
    .c create rect 10 10 100 100
    lappend res [catch {.c configure -gorp foo}]
    set res
} -result [list 1 1]

#
# Path widget commands
#

test path.canvas-2.1 {
    CanvasWidgetCmd, bind option
} -setup {
    ::TEST::_setup
} -body {
    set i [.c create rect 10 10 100 100]
    list [catch {.c bind $i <a>} msg] $msg
} -result {0 {}}

test path.canvas-2.2 {
    CanvasWidgetCmd, bind option
} -setup {
    ::TEST::_setup
} -body {
    set i [.c create rect 10 10 100 100]
    list [catch {.c bind $i <} msg] $msg
} -result {1 {no event type or button # or keysym}}

test path.canvas-2.3 {
    CanvasWidgetCmd, xview option
} -setup {
    ::TEST::_setup
} -body {
    .c configure -width 60 -height 40 -scrollregion {0 0 200 150} -bd 0 \
	-highlightthickness 0
    .c configure -xscrollincrement 40 -yscrollincrement 5
    .c xview moveto 0
    update
    set x [list [.c xview]]
    .c xview scroll 2 units
    update
    lappend x [.c xview]
} -result {{0.0 0.3} {0.4 0.7}}

test path.canvas-2.4 {
    CanvasWidgetCmd, xview option
} -setup {
    ::TEST::_setup
} -body {
    .c configure -width 60 -height 40 -scrollregion {0 0 200 150} -bd 0 \
	-highlightthickness 0
    # This test gives slightly different results on platforms such
    # as NetBSD.  I don't know why...
    .c configure -xscrollincrement 0 -yscrollincrement 5
    .c xview moveto 0.6
    update
    set x [list [.c xview]]
    .c xview scroll 2 units
    update
    lappend x [.c xview]
} -result {{0.6 0.9} {0.66 0.96}}

test path.canvas-3.1 {
    CanvasWidgetCmd, yview option
} -setup {
    ::TEST::_setup
} -body {
    .c configure -width 60 -height 40 -scrollregion {0 0 200 80} \
	-borderwidth 0 -highlightthickness 0
    .c configure -xscrollincrement 40 -yscrollincrement 5
    .c yview moveto 0
    update
    set x [list [.c yview]]
    .c yview scroll 3 units
    update
    lappend x [.c yview]
} -result {{0.0 0.5} {0.1875 0.6875}}

test path.canvas-3.2 {
    CanvasWidgetCmd, yview option
} -setup {
    ::TEST::_setup
} -body {
    .c configure -width 60 -height 40 -scrollregion {0 0 200 80} \
	-borderwidth 0 -highlightthickness 0
    .c configure -xscrollincrement 40 -yscrollincrement 0
    .c yview moveto 0
    update
    set x [list [.c yview]]
    .c yview scroll 2 units
    update
    lappend x [.c yview]
} -result {{0.0 0.5} {0.1 0.6}}

test path.canvas-4.1 {
    ButtonEventProc procedure
} -setup {
    ::TEST::_setup
} -body {
    .c configure -bg #543210
    rename .c .c2
    set x {}
    lappend x [winfo children .]
    lappend x [.c2 cget -bg]
    destroy .c
    lappend x [info command .c*] [winfo children .]
} -result {.c #543210 {} {}}

test path.canvas-5.1 {
    ButtonCmdDeletedProc procedure
} -setup {
    ::TEST::_setup
} -body {
    rename .c {}
    list [info command .c*] [winfo children .]
} -result {{} {}}

test path.canvas-6.1 {
    CanvasSetOrigin procedure
} -setup {
    ::TEST::_setup
} -body {
    .c configure -width 100 -height 50 -scrollregion {-200 -100 305 102} \
	-borderwidth 2 -highlightthickness 3
    .c configure -xscrollincrement 0 -yscrollincrement 0 \
	-width 100 -height 50 -scrollregion {-200 -100 305 102} \
	-borderwidth 2 -highlightthickness 3
    update
    .c xview moveto 0
    .c yview moveto 0
    update
    list [.c canvasx 0] [.c canvasy 0]
} -result {-205.0 -105.0}

test path.canvas-6.2 {
    CanvasSetOrigin procedure
} -setup {
    ::TEST::_setup
} -body {
    .c configure -width 100 -height 50 -scrollregion {-200 -100 305 102} \
	-borderwidth 2 -highlightthickness 3
    .c configure -xscrollincrement 20 -yscrollincrement 10
    set x ""
    foreach i {.08 .10 .48 .50} {
	.c xview moveto $i
	update
	lappend x [.c canvasx 0]
    }
    set x
} -result {-165.0 -145.0 35.0 55.0}

test path.canvas-6.3 {
    CanvasSetOrigin procedure
} -setup {
    ::TEST::_setup
} -body {
    .c configure -width 100 -height 50 -scrollregion {-200 -100 305 102} \
	-borderwidth 2 -highlightthickness 3
    .c configure -xscrollincrement 20 -yscrollincrement 10
    set x ""
    foreach i {.06 .08 .70 .72} {
	.c yview moveto $i
	update
	lappend x [.c canvasy 0]
    }
    set x
} -result {-95.0 -85.0 35.0 45.0}

test path.canvas-6.4 {
    CanvasSetOrigin procedure
} -setup {
    ::TEST::_setup
} -body {
    .c configure -width 100 -height 50 -scrollregion {-200 -100 305 102} \
	-borderwidth 2 -highlightthickness 3
    .c configure -xscrollincrement 20 -yscrollincrement 10
    update
    .c xview moveto 1.0
    .c canvasx 0
} -result {215.0}

test path.canvas-6.5 {
    CanvasSetOrigin procedure
} -setup {
    ::TEST::_setup
} -body {
    .c configure -width 100 -height 50 -scrollregion {-200 -100 305 102} \
	-borderwidth 2 -highlightthickness 3
    .c configure -xscrollincrement 20 -yscrollincrement 10
    update
    .c yview moveto 1.0
    .c canvasy 0
} -result {55.0}

test path.canvas-7.1 {
    canvas widget vs hidden commands
} -setup {
    ::TEST::_setup
} -body {
    set l [lsort [interp hidden]]
    interp hide {} .c
    destroy .c
    list [winfo children .] [string compare [lsort [interp hidden]] $l]
} -result [list {} 0]

test path.canvas-9.1 {
    canvas id creation and deletion
} -setup {
    ::TEST::_setup
} -body {
    # With Tk 8.0.4 the ids are now stored in a hash table.  You
    # can use this test as a performance test with older versions
    # by changing the value of size.
    set size 15
    for {set i 0} {$i < $size} {incr i} {
	set x [expr {-10 + 3*$i}]
	for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} {
	    .c create rect ${x}c ${y}c [expr $x+2]c [expr $y+2]c \
		    -stroke black -fill blue -tags rect
	    .c create text [expr $x+1]c [expr $y+1]c -text "$i,$j" \
		    -textanchor middle -tags text
	}
    }
    # The actual bench mark - this code also exercises all the hash
    # table changes.
    set time [lindex [time {
	foreach id [.c find withtag all] {
	    .c lower $id
	    .c raise $id
	    .c find withtag $id
	    .c bind <Return> $id {}
	    .c delete $id
	}
    }] 0]
    set x ""
} -result {}

test path.canvas-10.1 {
    find items using tag expressions
} -setup {
    ::TEST::_setup
} -body {
    .c create circle 20 20 -r 10 -fill red -tag [list a b c d]
    .c create circle 20 60 -r 10 -fill yellow -tag [list b a]
    .c create circle 20 100 -r 10 -fill green -tag [list c b]
    .c create circle 20 140 -r 10 -fill blue -tag [list b]
    .c create circle 20 180 -r 10 -fill bisque -tag [list a d e]
    .c create circle 20 220 -r 10 -fill bisque -tag b
    .c create circle 20 260 -r 10 -fill bisque -tag [list d "tag with spaces"]
    set res {}
    lappend res [.c find withtag {!a}]
    lappend res [.c find withtag {b&&c}]
    lappend res [.c find withtag {b||c}]
    lappend res [.c find withtag {a&&!b}]
    lappend res [.c find withtag {!b&&!c}]
    lappend res [.c find withtag {d&&a&&c&&b}]
    lappend res [.c find withtag {b^a}]
    lappend res [.c find withtag {(a&&!b)||(!a&&b)}]
    lappend res [.c find withtag { ( a && ! b ) || ( ! a && b ) }]
    lappend res [.c find withtag {a&&!(c||d)}]
    lappend res [.c find withtag {d&&"tag with spaces"}]
    lappend res [.c find withtag "tag with spaces"]
} -result {{0 3 4 6 7} {1 3} {1 2 3 4 6} 5 {0 5 7} 1 {3 4 5 6} {3 4 5 6} {3 4 5 6} 2 7 7}

test path.canvas-10.2 {
    check errors from tag expressions
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c create circle 20 20 -r 10 -fill red -tag [list a b c d]
    .c create circle 20 260 -r 10 -fill bisque -tag [list d "tag with spaces"]
    .c find withtag {&&c}
} -result {Unexpected operator in tag search expression}

test path.canvas-10.3 {
    check errors from tag expressions
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c create circle 20 20 -r 10 -fill red -tag [list a b c d]
    .c create circle 20 260 -r 10 -fill bisque -tag [list d "tag with spaces"]
    .c find withtag {!!c}
} -result {Too many '!' in tag search expression} \

test path.canvas-10.4 {
    check errors from tag expressions
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c create circle 20 20 -r 10 -fill red -tag [list a b c d]
    .c create circle 20 260 -r 10 -fill bisque -tag [list d "tag with spaces"]
    .c find withtag {b||}
} -result {Missing tag in tag search expression}

test path.canvas-10.5 {
    check errors from tag expressions
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c create circle 20 20 -r 10 -fill red -tag [list a b c d]
    .c create circle 20 260 -r 10 -fill bisque -tag [list d "tag with spaces"]
    .c find withtag {b&&(c||)}
} -result {Unexpected operator in tag search expression}

test path.canvas-10.6 {
    check errors from tag expressions
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c create circle 20 20 -r 10 -fill red -tag [list a b c d]
    .c create circle 20 260 -r 10 -fill bisque -tag [list d "tag with spaces"]
    .c find withtag {d&&""}
} -result {Null quoted tag string in tag search expression}

test path.canvas-10.7 {
    check errors from tag expressions
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c create circle 20 20 -r 10 -fill red -tag [list a b c d]
    .c create circle 20 260 -r 10 -fill bisque -tag [list d "tag with spaces"]
    .c find withtag "d&&\"tag with spaces"
} -result {Missing endquote in tag search expression} \

test path.canvas-10.8 {
    check errors from tag expressions
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c create circle 20 20 -r 10 -fill red -tag [list a b c d]
    .c create circle 20 260 -r 10 -fill bisque -tag [list d "tag with spaces"]
    .c find withtag {a&&"tag with spaces"z}
} -result {Invalid boolean operator in tag search expression}

test path.canvas-10.9 {
    check errors from tag expressions
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c create circle 20 20 -r 10 -fill red -tag [list a b c d]
    .c create circle 20 260 -r 10 -fill bisque -tag [list d "tag with spaces"]
    .c find withtag {a&&b&c}
} -result {Singleton '&' in tag search expression}

test path.canvas-10.10 {
    check errors from tag expressions
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c create circle 20 20 -r 10 -fill red -tag [list a b c d]
    .c create circle 20 260 -r 10 -fill bisque -tag [list d "tag with spaces"]
    .c find withtag {a||b|c}
} -result {Singleton '|' in tag search expression}

test path.canvas-10.11 {
    backward compatility, strange tags that are not expressions
} -setup {
    ::TEST::_setup
} -body {
    .c create circle 20 20 -r 10 -fill red -tag [list { strange tag(xxx&yyy|zzz) " && \" || ! ^ " }]
    .c find withtag { strange tag(xxx&yyy|zzz) " && \" || ! ^ " }
} -result 1

test path.canvas-10.12 {
    multple events bound to same tag expr
} -setup {
    ::TEST::_setup
} -body {
    .c bind {a && b} <Enter> {puts Enter}
    .c bind {a && b} <Leave> {puts Leave}
} -result {}

test path.canvas-11.2 {
    canvas polygon overlap fill check, bug 226357
} -setup {
    ::TEST::_setup
} -body {
    set result {}
    set id [.c create polygon 30 30 90 90 30 90 90 30 -fill black]
    lappend result [.c find over 40 40 45 45]; # rect region inc. edge
    lappend result [.c find over 60 40 60 40]; # top-center point
    lappend result [.c find over 0 0 0 0]; # not on poly
    lappend result [.c find over 60 60 60 60]; # center-point
    lappend result [.c find over 45 50 45 50]; # outside poly
    .c itemconfigure $id -fill "" -stroke black
    lappend result [.c find over 40 40 45 45]; # rect region inc. edge
    lappend result [.c find over 60 40 60 40]; # top-center point
    lappend result [.c find over 0 0 0 0]; # not on poly
    lappend result [.c find over 60 60 60 60]; # center-point
    lappend result [.c find over 45 50 45 50]; # outside poly
    .c itemconfigure $id -strokewidth 8
    lappend result [.c find over 45 50 45 50]; # outside poly
} -result {1 1 {} 1 {} 1 {} {} 1 {} 1}

test path.canvas-12.1 {
    canvas mm obj, patch SF-403327, 102471
} -setup {
    ::TEST::_setup
} -body {
    set qx [expr {1.+1.}] 
    # qx has type double and no string representation 
    .c scale all $qx 0 1. 1.
    # qx has now type MMRep and no string representation 
    list $qx [string length $qx]
} -result {2.0 3}

test path.canvas-12.2 {
    canvas mm obj, patch SF-403327, 102471
} -setup {
    ::TEST::_setup
} -body {
    set val 10
    incr val
    # qx has type double and no string representation 
    .c scale all $val 0 1 1
    # qx has now type MMRep and no string representation 
    incr val
} -result 12 

test path.canvas-13.1 {
    canvas delete during event, SF bug-228024
} -setup {
    ::TEST::_setup
} -body {
    proc ::TEST::_kill_canvas {w} {
        destroy $w
        pack [::tko::path $w -height 200 -width 200] -fill both -expand yes
        update idle
        $w create rect 80 80 120 120 -fill blue -tags blue
        # bind a button press to re-build the canvas
        $w bind blue <ButtonRelease-1> [subst {
	        [lindex [info level 0] 0] $w
	        append ::x ok
        }]
    }
    ::TEST::_kill_canvas .c
    set ::x {}
    # do this many times to improve chances of triggering the crash
    for {set i 0} {$i < 30} {incr i} {
	    event generate .c <1> -x 100 -y 100
	    event generate .c <ButtonRelease-1> -x 100 -y 100
    }
    rename ::TEST::_kill_canvas {}
    set ::x
} -result okokokokokokokokokokokokokokokokokokokokokokokokokokokokokok

test path.canvas-14.1 {
    canvas scan SF bug 581560
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c scan
} -result {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"}

test path.canvas-14.2 {
    canvas scan
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c scan bogus
} -result {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"}

test path.canvas-14.3 {
    canvas scan
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c scan mark
} -result {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"}

test path.canvas-14.4 {
    canvas scan
} -setup {
    ::TEST::_setup
} -body {
    .c scan mark 10 10
} -result {}

test path.canvas-14.5 {
    canvas scan
} -returnCodes error -setup {
    ::TEST::_setup
} -body {
    .c scan mark 10 10 5
} -result {wrong # args: should be ".c scan mark x y"}

test path.canvas-14.6 {
    canvas scan
} -setup {
    ::TEST::_setup
} -body {
    .c scan dragto 10 10 5
} -result {}

set i 0
foreach type {image line circle ellipse polygon rect text window} {
    incr i
    test path.canvas-15.$i "basic types check: $type requires coords" \
-setup ::TEST::_setup \
-returnCodes error \
-result "wrong # args: should be \".c create $type coords ?arg arg ...?\"" \
-body {
    .c create $type
}
    incr i
    test path.canvas-15.$i "basic coords check: $type coords are paired" \
-setup ::TEST::_setup \
-match glob \
-returnCodes error \
-result "wrong # coordinates: expected*" \
-body {
    .c create $type 0
}
}

test path.gradientslave-1.1 {
    Destroy slave
} -body {
    interp create slavei
    slavei eval {
        package require Tk
    }
    interp delete slavei
} -result {}

test path.gradientslave-1.2 {
    Shared gradients inside slave
} -body {
    foreach g [::tko::path::gradient names] {::tko::path::gradient delete $g}
    set masterg [::tko::path::gradient create radial \
                -stops [list \
                           {0 white 0.9}  [list 1 red4 0.4]] \
                -radialtransition {
                    0.477551020408 0.540983606557
                    1.00918367347 0.898979591837
                    0.139344262295}]
    interp create slavei
    slavei eval {
        package require Tk
    }
    set myRet [string compare [::tko::path::gradient names] $masterg]
    foreach g [::tko::path::gradient names] {::tko::path::gradient delete $g}
    interp delete slavei
    set myRet
} -result 0

# Testcase for image "move".
# ----------------------------------------------------------------
# Author : Arndt Roger Schneider
# Date   : 09/22/2007
# License: Tcl-License (aka BSD)
#
# Copyright © 2007 Arndt Roger Schneider
# ----------------------------------------------------------------
image create photo _oval -data {
R0lGODlhIQAZAPcAMf//////////////9///9//39//39//39/f///f///f/
9/f/9/f3//f3//f39/f39/f37/f37/fv9/fv9/fv7/fv7/fv7/fv3vfv3vfv
3u/39+/39+/v9+/v9+/v7+/v7+/v5+/v5+/v3u/v3u/v3u/v1u/v1u/vzu/v
zu/n7+/n7+/n7+/n5+/n5+/nve/nve/eve/eve/Wre/Wrefv7+fv7+fv5+fv
5+fn7+fn7+fn5+fn5+fn5+fWxufWxufWxufWvefWvefWvefOpefOpefGlOfG
lOfGlOe9jOe9jOe9jN7v997v997v797v79bW1tbW1tala9ala9ala87n787n
787n587n587Ozs7Ozs7Ozs7Oxs7Oxs7Gxs7Gxs6tjM6tjM6lY86lY8bn98bn
98bOzsbOzsbOxsbOxsbGzsbGzsbGzsbGxsbGxsbGvcbGvcbGvcale8ale73n
973n973n773n773Gxr3Gxr29vb29vb29vb2le72le72le72MUr2MUr2MUrW1
tbW1tbW1rbW1rbWcjLWcjLWMY7WMY7WMY63e763e763e7621ta21ta1zKa1z
Ka1zKaW9zqW9zqW9zqWttaWttaWlpaWlpaWlpZzO55zO55ycnJycnJyUe5yU
e5yEa5yEa5yEa5TO55TO55S1xpS1xpSUlJSUlJRKAJRKAJQ5AJQ5AIS954S9
54S93oS93oRjSoRjSoRjSoQpAIQpAHO11nO11nOt1nOt1nOt1nMAAHMAAGuE
nGuEnGuEnGOUxmOUxmOUxmMAAGMAAGMAAFpzjFpzjFpzjFo5AFo5AFo5AFKM
vVKMvVKMvUp7pUp7pUpje0pje0oAAEoAADlrlDlrlDlrlDkpADkpADkAKTkA
KTkAKTkAADkAACl7vSl7vSlrrSlrrSlrrSljjCljjCljjCkAACkAACkAAABj
pQBjpQBKlABKlABKlAA5cwA5cwA5WgA5WgAAawAAawAAawAAUgAAUgAAKQAA
KQAAKQAAAAAAAAAAAAAAACwAAAAAIQAZAAAI/wABAPCApaDBgwgTJvQgEACm
TnmwuLkzsSLFixYzUsyTp1MnAFg+AuDQUELDkygBmEzpoVPBPAAolJxpsqbK
mzhJCoyIBaaGmAJNMgTwc+BNCDiHMpQgkaIGmQyjCmRIwYOHJlaJImUIQSpP
mBygDuzK0I2sf2j/ybOkQUNUoQPv9MSS1aoHCQw1/PmXz5cjS1+U/YNXZ6AE
CmQBfPXQlUNXCBw8QPoHzTHJJhC+/LtXx7EHyx6+Rmbswa0HJP+aCrRrV4a3
dXbJhn7J2q6IWu0gYK1tNcq/TbwX83bhChZv1heI5QpOmzcMdIuO22YFjjVW
jhytPvEgAquLbXWwdtTnLr6JCOra7Qonz90KNeNPIo/vLqIHsVt2t892k8fD
dvEeUKAKPLvNt1sYv/mX31dPUKDfdiIUQRkH5ZH3hTfgGGgVR3f0lx97iPxj
Cl0QNhHHP/RgUR59DCp4lYt8oHWMJZh8Qo2IVJA33nYc8acghA960MMn2aQl
zSRYPWFeE+b5J9x2QUKZnoI7cidlHnJh8mN6UroIpXlRXsVTJ1KGWSZ3VCq5
5TFuSOARJhxhASd2HBFCpyV5uIFnndh18kVDIrwkKE9yzeUGFoVGdOhcTZgU
EAA7LA==} -gamma 1.0

# The TestCase itself:
test path.image-1.1 {
    move 10 10
} -setup {
    ::TEST::_setup
} -body {
    set id [.c create image 100 100 -image _oval]
    .c move $id 10 10
    .c coords $id
} -result {110.0 110.0}

test path.image-1.2 {
    coords 10 10
} -setup {
    ::TEST::_setup
} -body {
    set id [.c create image 100 100 -image _oval]
    .c coords $id 110.0 110.0
    .c coords $id
} -result {110.0 110.0}

test path.line-1.1 {
    line coords
} -setup {
    ::TEST::_setup
} -body {
    lassign [.c coords [.c create line 200 201 250 202]] l t r b
    return [list \
               [expr { round($l) }] \
               [expr { round($t) }] \
               [expr { round($r) }] \
               [expr { round($b) }]]

} -result {200 201 250 202}

test path.line-1.2 {
    line {coords after move}
} -setup {
    ::TEST::_setup
} -body {
    set line [.c create line 200 201 250 202]
    .c move $line 20 20
    lassign [.c coords $line] l t r b
    return [list \
               [expr { round($l) }] \
               [expr { round($t) }] \
               [expr { round($r) }] \
               [expr { round($b) }]]

} -result {220 221 270 222}

test path.line-1.3 {
    line {Strokedash as .}
} -setup {
    ::TEST::_setup
} -body {
    set line [.c create line 200 201 250 202 -strokedash {0.1 0.2}]
    return {}
} -result {}

test path.polyline-1.1 {
    polyline coords
} -setup {
    ::TEST::_setup
} -body { 
    .c coords [.c create polyline 12 20 34 5 90 56] 
} -result {12.0 20.0 34.0 5.0 90.0 56.0}

test path.polygon-1.1 {
    polygon coords
} -setup {
    ::TEST::_setup
} -body { 
    .c coords [.c create polygon 12 20 34 5 90 56 -fill red] 
} -result {12.0 20.0 34.0 5.0 90.0 56.0}

# cleanup
::tcltest::cleanupTests
catch {destroy {*}[winfo children .]}
}
catch {namespace delete ::TEST}
# vim: set ts=4 sw=4 sts=4 ff=unix et :
