1# This file is a Tcl script to test out the procedures in tkCanvImg.c, 2# which implement canvas "image" items. It is organized in the standard 3# fashion for Tcl tests. 4# 5# Copyright (c) 1994 The Regents of the University of California. 6# Copyright (c) 1994-1996 Sun Microsystems, Inc. 7# Copyright (c) 1998-1999 by Scriptics Corporation. 8# All rights reserved. 9 10package require tcltest 2.1 11eval tcltest::configure $argv 12tcltest::loadTestedCommands 13 14eval image delete [image names] 15canvas .c 16pack .c 17update 18if {[testConstraint testImageType]} { 19 image create test foo -variable x 20 image create test foo2 -variable y 21 foo2 changed 0 0 0 0 80 60 22} 23test canvImg-1.1 {options for image items} { 24 .c delete all 25 .c create image 50 50 -anchor nw -tags i1 26 .c itemconfigure i1 -anchor 27} {-anchor {} {} center nw} 28test canvImg-1.2 {options for image items} { 29 .c delete all 30 list [catch {.c create image 50 50 -anchor gorp -tags i1} msg] $msg 31} {1 {bad anchor position "gorp": must be n, ne, e, se, s, sw, w, nw, or center}} 32test canvImg-1.3 {options for image items} testImageType { 33 .c delete all 34 .c create image 50 50 -image foo -tags i1 35 .c itemconfigure i1 -image 36} {-image {} {} {} foo} 37test canvImg-1.4 {options for image items} { 38 .c delete all 39 list [catch {.c create image 50 50 -image unknown -tags i1} msg] $msg 40} {1 {image "unknown" doesn't exist}} 41test canvImg-1.5 {options for image items} testImageType { 42 .c delete all 43 .c create image 50 50 -image foo -tags {i1 foo} 44 .c itemconfigure i1 -tags 45} {-tags {} {} {} {i1 foo}} 46 47test canvImg-2.1 {CreateImage procedure} { 48 list [catch {.c create image 40} msg] $msg 49} {1 {wrong # coordinates: expected 2, got 1}} 50test canvImg-2.2 {CreateImage procedure} { 51 list [catch {.c create image 40 50 60} msg] $msg 52} {1 {unknown option "60"}} 53test canvImg-2.3 {CreateImage procedure} { 54 .c delete all 55 set i [.c create image 50 50] 56 list [lindex [.c itemconf $i -anchor] 4] \ 57 [lindex [.c itemconf $i -image] 4] \ 58 [lindex [.c itemconf $i -tags] 4] 59} {center {} {}} 60test canvImg-2.4 {CreateImage procedure} { 61 list [catch {.c create image xyz 40} msg] $msg 62} {1 {bad screen distance "xyz"}} 63test canvImg-2.5 {CreateImage procedure} { 64 list [catch {.c create image 50 qrs} msg] $msg 65} {1 {bad screen distance "qrs"}} 66test canvImg-2.6 {CreateImage procedure} testImageType { 67 list [catch {.c create image 50 50 -gorp foo} msg] $msg 68} {1 {unknown option "-gorp"}} 69 70test canvImg-3.1 {ImageCoords procedure} testImageType { 71 .c delete all 72 .c create image 50 100 -image foo -tags i1 73 .c coords i1 74} {50.0 100.0} 75test canvImg-3.2 {ImageCoords procedure} testImageType { 76 .c delete all 77 .c create image 50 100 -image foo -tags i1 78 list [catch {.c coords i1 dumb 100} msg] $msg 79} {1 {bad screen distance "dumb"}} 80test canvImg-3.3 {ImageCoords procedure} testImageType { 81 .c delete all 82 .c create image 50 100 -image foo -tags i1 83 list [catch {.c coords i1 250 dumb0} msg] $msg 84} {1 {bad screen distance "dumb0"}} 85test canvImg-3.4 {ImageCoords procedure} testImageType { 86 .c delete all 87 .c create image 50 100 -image foo -tags i1 88 list [catch {.c coords i1 250} msg] $msg 89} {1 {wrong # coordinates: expected 2, got 1}} 90test canvImg-3.5 {ImageCoords procedure} testImageType { 91 .c delete all 92 .c create image 50 100 -image foo -tags i1 93 list [catch {.c coords i1 250 300 400} msg] $msg 94} {1 {wrong # coordinates: expected 0 or 2, got 3}} 95 96test canvImg-4.1 {ConfiugreImage procedure} testImageType { 97 .c delete all 98 .c create image 50 100 -image foo -tags i1 99 update 100 set x {} 101 .c itemconfigure i1 -image {} 102 update 103 list $x [.c bbox i1] 104} {{{foo free}} {}} 105test canvImg-4.2 {ConfiugreImage procedure} testImageType { 106 .c delete all 107 .c create image 50 100 -image foo -tags i1 -anchor nw 108 update 109 set x {} 110 set y {} 111 .c itemconfigure i1 -image foo2 112 update 113 list $x $y [.c bbox i1] 114} {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60 30 30}} {50 100 130 160}} 115test canvImg-4.3 {ConfiugreImage procedure} testImageType { 116 .c delete all 117 .c create image 50 100 -image foo -tags i1 -anchor nw 118 update 119 set x {} 120 set y {} 121 list [catch {.c itemconfigure i1 -image lousy} msg] $msg 122} {1 {image "lousy" doesn't exist}} 123 124test canvImg-5.1 {DeleteImage procedure} testImageType { 125 image create test xyzzy -variable z 126 .c delete all 127 .c create image 50 100 -image xyzzy -tags i1 128 update 129 set names [lsort [image names]] 130 image delete xyzzy 131 set z {} 132 set names2 [lsort [image names]] 133 .c delete i1 134 update 135 list $names $names2 $z [lsort [image names]] 136} {{foo foo2 xyzzy} {foo foo2} {} {foo foo2}} 137test canvImg-5.2 {DeleteImage procedure (don't delete non-existent image)} { 138 .c delete all 139 .c create image 50 100 -tags i1 140 update 141 .c delete i1 142 update 143} {} 144 145test canvImg-6.1 {ComputeImageBbox procedure} testImageType { 146 .c delete all 147 .c create image 15.51 17.51 -image foo -tags i1 -anchor nw 148 .c bbox i1 149} {16 18 46 33} 150test canvImg-6.2 {ComputeImageBbox procedure} testImageType { 151 .c delete all 152 .c create image 15.49 17.49 -image foo -tags i1 -anchor nw 153 .c bbox i1 154} {15 17 45 32} 155test canvImg-6.3 {ComputeImageBbox procedure} { 156 .c delete all 157 .c create image 20 30 -tags i1 -anchor nw 158 .c bbox i1 159} {} 160test canvImg-6.4 {ComputeImageBbox procedure} testImageType { 161 .c delete all 162 .c create image 20 30 -image foo -tags i1 -anchor nw 163 .c bbox i1 164} {20 30 50 45} 165test canvImg-6.5 {ComputeImageBbox procedure} testImageType { 166 .c delete all 167 .c create image 20 30 -image foo -tags i1 -anchor n 168 .c bbox i1 169} {5 30 35 45} 170test canvImg-6.6 {ComputeImageBbox procedure} testImageType { 171 .c delete all 172 .c create image 20 30 -image foo -tags i1 -anchor ne 173 .c bbox i1 174} {-10 30 20 45} 175test canvImg-6.7 {ComputeImageBbox procedure} testImageType { 176 .c delete all 177 .c create image 20 30 -image foo -tags i1 -anchor e 178 .c bbox i1 179} {-10 23 20 38} 180test canvImg-6.8 {ComputeImageBbox procedure} testImageType { 181 .c delete all 182 .c create image 20 30 -image foo -tags i1 -anchor se 183 .c bbox i1 184} {-10 15 20 30} 185test canvImg-6.9 {ComputeImageBbox procedure} testImageType { 186 .c delete all 187 .c create image 20 30 -image foo -tags i1 -anchor s 188 .c bbox i1 189} {5 15 35 30} 190test canvImg-6.10 {ComputeImageBbox procedure} testImageType { 191 .c delete all 192 .c create image 20 30 -image foo -tags i1 -anchor sw 193 .c bbox i1 194} {20 15 50 30} 195test canvImg-6.11 {ComputeImageBbox procedure} testImageType { 196 .c delete all 197 .c create image 20 30 -image foo -tags i1 -anchor w 198 .c bbox i1 199} {20 23 50 38} 200test canvImg-6.12 {ComputeImageBbox procedure} testImageType { 201 .c delete all 202 .c create image 20 30 -image foo -tags i1 -anchor center 203 .c bbox i1 204} {5 23 35 38} 205 206# The following test is non-portable because of differences in 207# coordinate rounding on some machines (does 0.5 round up?). 208 209test canvImg-7.1 {DisplayImage procedure} {nonPortable testImageType} { 210 .c delete all 211 .c create image 50 100 -image foo -tags i1 -anchor nw 212 update 213 set x {} 214 .c create rect 55 110 65 115 -width 1 -outline black -fill white 215 update 216 set x 217} {{foo display 4 9 12 6 30 30}} 218test canvImg-7.2 {DisplayImage procedure, no image} { 219 .c delete all 220 .c create image 50 100 -tags i1 221 update 222 .c create rect 55 110 65 115 -width 1 -outline black -fill white 223 update 224} {} 225 226.c delete all 227if {[testConstraint testImageType]} { 228 .c create image 50 100 -image foo -tags image -anchor nw 229} 230.c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 231foreach check { 232 {canvImg-8.1 {50 70 80 81} {70 90} rect} 233 {canvImg-8.2 {50 70 80 79} {70 90} image} 234 {canvImg-8.3 {99 70 110 81} {90 90} rect} 235 {canvImg-8.4 {101 70 110 79} {90 90} image} 236 {canvImg-8.5 {99 100 110 115} {90 110} rect} 237 {canvImg-8.6 {101 100 110 115} {90 110} image} 238 {canvImg-8.7 {99 134 110 145} {90 125} rect} 239 {canvImg-8.8 {101 136 110 145} {90 125} image} 240 {canvImg-8.9 {50 134 80 145} {70 125} rect} 241 {canvImg-8.10 {50 136 80 145} {70 125} image} 242 {canvImg-8.11 {20 134 31 145} {40 125} rect} 243 {canvImg-8.12 {20 136 29 145} {40 125} image} 244 {canvImg-8.13 {20 100 31 115} {40 110} rect} 245 {canvImg-8.14 {20 100 29 115} {40 110} image} 246 {canvImg-8.15 {20 70 31 80} {40 90} rect} 247 {canvImg-8.16 {20 70 29 79} {40 90} image} 248 {canvImg-8.17 {60 70 69 109} {70 110} image} 249 {canvImg-8.18 {60 70 71 111} {70 110} rect} 250} { 251 lassign $check name rectCoords testPoint result 252 test $name {ImageToPoint procedure} testImageType { 253 .c coords rect {*}$rectCoords 254 .c gettags [.c find closest {*}$testPoint] 255 } $result 256} 257 258.c delete all 259if {[testConstraint testImageType]} { 260 .c create image 50 100 -image foo -tags image -anchor nw 261} 262test canvImg-8.19 {ImageToArea procedure} testImageType { 263 .c gettags [.c find overlapping 60 0 70 99] 264} {} 265test canvImg-8.20 {ImageToArea procedure} testImageType { 266 .c gettags [.c find overlapping 60 0 70 99.999] 267} {} 268test canvImg-8.21 {ImageToArea procedure} testImageType { 269 .c gettags [.c find overlapping 60 0 70 101] 270} {image} 271test canvImg-8.22 {ImageToArea procedure} testImageType { 272 .c gettags [.c find overlapping 81 105 120 115] 273} {} 274test canvImg-8.23 {ImageToArea procedure} testImageType { 275 .c gettags [.c find overlapping 80.001 105 120 115] 276} {} 277test canvImg-8.24 {ImageToArea procedure} testImageType { 278 .c gettags [.c find overlapping 79 105 120 115] 279} {image} 280test canvImg-8.25 {ImageToArea procedure} testImageType { 281 .c gettags [.c find overlapping 60 116 70 150] 282} {} 283test canvImg-8.26 {ImageToArea procedure} testImageType { 284 .c gettags [.c find overlapping 60 115.001 70 150] 285} {} 286test canvImg-8.27 {ImageToArea procedure} testImageType { 287 .c gettags [.c find overlapping 60 114 70 150] 288} {image} 289test canvImg-8.28 {ImageToArea procedure} testImageType { 290 .c gettags [.c find overlapping 0 105 49 115] 291} {} 292test canvImg-8.29 {ImageToArea procedure} testImageType { 293 .c gettags [.c find overlapping 0 105 50 114.999] 294} {} 295test canvImg-8.30 {ImageToArea procedure} testImageType { 296 .c gettags [.c find overlapping 0 105 51 115] 297} {image} 298test canvImg-8.31 {ImageToArea procedure} testImageType { 299 .c gettags [.c find overlapping 0 0 49.999 99.999] 300} {} 301test canvImg-8.32 {ImageToArea procedure} testImageType { 302 .c gettags [.c find overlapping 0 0 51 101] 303} {image} 304test canvImg-8.33 {ImageToArea procedure} testImageType { 305 .c gettags [.c find overlapping 80 0 150 100] 306} {} 307test canvImg-8.34 {ImageToArea procedure} testImageType { 308 .c gettags [.c find overlapping 79 0 150 101] 309} {image} 310test canvImg-8.35 {ImageToArea procedure} testImageType { 311 .c gettags [.c find overlapping 80.001 115.001 150 180] 312} {} 313test canvImg-8.36 {ImageToArea procedure} testImageType { 314 .c gettags [.c find overlapping 79 114 150 180] 315} {image} 316test canvImg-8.37 {ImageToArea procedure} testImageType { 317 .c gettags [.c find overlapping 0 115 50 180] 318} {} 319test canvImg-8.38 {ImageToArea procedure} testImageType { 320 .c gettags [.c find overlapping 0 114 51 180] 321} {image} 322test canvImg-8.39 {ImageToArea procedure} testImageType { 323 .c gettags [.c find enclosed 0 0 200 200] 324} {image} 325test canvImg-8.40 {ImageToArea procedure} testImageType { 326 .c gettags [.c find enclosed 49.999 99.999 80.001 115.001] 327} {image} 328test canvImg-8.41 {ImageToArea procedure} testImageType { 329 .c gettags [.c find enclosed 51 100 80 115] 330} {} 331test canvImg-8.42 {ImageToArea procedure} testImageType { 332 .c gettags [.c find enclosed 50 101 80 115] 333} {} 334test canvImg-8.43 {ImageToArea procedure} testImageType { 335 .c gettags [.c find enclosed 50 100 79 115] 336} {} 337test canvImg-8.44 {ImageToArea procedure} testImageType { 338 .c gettags [.c find enclosed 50 100 80 114] 339} {} 340 341test canvImg-9.1 {DisplayImage procedure} testImageType { 342 .c delete all 343 .c create image 50 100 -image foo -tags image -anchor nw 344 .c scale image 25 0 2.0 1.5 345 .c bbox image 346} {75 150 105 165} 347 348test canvImg-10.1 {TranslateImage procedure} testImageType { 349 .c delete all 350 .c create image 50 100 -image foo -tags image -anchor nw 351 update 352 set x {} 353 foo changed 2 4 6 8 30 15 354 update 355 set x 356} {{foo display 2 4 6 8 30 30}} 357 358test canvImg-11.1 {TranslateImage procedure} testImageType { 359 .c delete all 360 .c create image 50 100 -image foo -tags image -anchor nw 361 update 362 set x {} 363 foo changed 2 4 6 8 40 50 364 update 365 set x 366} {{foo display 0 0 40 50 30 30}} 367test canvImg-11.2 {ImageChangedProc procedure} testImageType { 368 .c delete all 369 image create test foo -variable x 370 .c create image 50 100 -image foo -tags image -anchor center 371 update 372 set x {} 373 foo changed 0 0 0 0 40 50 374 .c bbox image 375} {30 75 70 125} 376test canvImg-11.3 {ImageChangedProc procedure} testImageType { 377 .c delete all 378 image create test foo -variable x 379 foo changed 0 0 0 0 40 50 380 .c create image 50 100 -image foo -tags image -anchor nw 381 .c create image 70 110 -image foo2 -anchor nw 382 update 383 set y {} 384 image create test foo -variable x 385 update 386 set y 387} {{foo2 display 0 0 20 40 50 40}} 388 389# cleanup 390cleanupTests 391return 392