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 © 1994 The Regents of the University of California. 6# Copyright © 1994-1996 Sun Microsystems, Inc. 7# Copyright © 1998-1999 Scriptics Corporation. 8# All rights reserved. 9 10package require tcltest 2.2 11namespace import ::tcltest::* 12eval tcltest::configure $argv 13tcltest::loadTestedCommands 14imageInit 15 16# Canvas used in every test case of the whole file 17canvas .c 18pack .c 19update 20 21 22test canvImg-1.1 {options for image items} -body { 23 .c create image 50 50 -anchor nw -tags i1 24 .c itemconfigure i1 -anchor 25} -cleanup { 26 .c delete all 27} -result {-anchor {} {} center nw} 28test canvImg-1.2 {options for image items} -body { 29 .c create image 50 50 -anchor gorp -tags i1 30} -cleanup { 31 .c delete all 32} -returnCodes {error} -result {bad anchor position "gorp": must be n, ne, e, se, s, sw, w, nw, or center} 33test canvImg-1.3 {options for image items} -constraints testImageType -setup { 34 image create test foo 35 .c delete all 36} -body { 37 .c create image 50 50 -image foo -tags i1 38 .c itemconfigure i1 -image 39} -cleanup { 40 .c delete all 41 image delete foo 42} -result {-image {} {} {} foo} 43test canvImg-1.4 {options for image items} -body { 44 .c create image 50 50 -image unknown -tags i1 45} -cleanup { 46 .c delete all 47} -returnCodes {error} -result {image "unknown" doesn't exist} 48test canvImg-1.5 {options for image items} -constraints testImageType -setup { 49 image create test foo 50 .c delete all 51} -body { 52 .c create image 50 50 -image foo -tags {i1 foo} 53 .c itemconfigure i1 -tags 54} -cleanup { 55 .c delete all 56 image delete foo 57} -result {-tags {} {} {} {i1 foo}} 58 59test canvImg-2.1 {CreateImage procedure} -body { 60 .c create image 40 61} -cleanup { 62 .c delete all 63} -returnCodes {error} -result {wrong # coordinates: expected 2, got 1} 64test canvImg-2.2 {CreateImage procedure} -body { 65 .c create image 40 50 60 66} -cleanup { 67 .c delete all 68} -returnCodes {error} -result {unknown option "60"} 69test canvImg-2.3 {CreateImage procedure} -body { 70 .c delete all 71 set i [.c create image 50 50] 72 list [lindex [.c itemconf $i -anchor] 4] \ 73 [lindex [.c itemconf $i -image] 4] \ 74 [lindex [.c itemconf $i -tags] 4] 75} -cleanup { 76 .c delete all 77} -result {center {} {}} 78test canvImg-2.4 {CreateImage procedure} -body { 79 .c create image xyz 40 80} -cleanup { 81 .c delete all 82} -returnCodes {error} -result {bad screen distance "xyz"} 83test canvImg-2.5 {CreateImage procedure} -body { 84 .c create image 50 qrs 85} -cleanup { 86 .c delete all 87} -returnCodes {error} -result {bad screen distance "qrs"} 88test canvImg-2.6 {CreateImage procedure} -constraints testImageType -body { 89 .c create image 50 50 -gorp foo 90} -cleanup { 91 .c delete all 92} -returnCodes {error} -result {unknown option "-gorp"} 93 94 95test canvImg-3.1 {ImageCoords procedure} -constraints testImageType -setup { 96 image create test foo 97} -body { 98 .c create image 50 100 -image foo -tags i1 99 format {%.6g %.6g} {*}[.c coords i1] 100} -cleanup { 101 .c delete all 102 image delete foo 103} -result {50 100} 104test canvImg-3.2 {ImageCoords procedure} -constraints testImageType -setup { 105 image create test foo 106} -body { 107 .c create image 50 100 -image foo -tags i1 108 .c coords i1 dumb 100 109} -cleanup { 110 .c delete all 111 image delete foo 112} -returnCodes {error} -result {bad screen distance "dumb"} 113test canvImg-3.3 {ImageCoords procedure} -constraints testImageType -setup { 114 image create test foo 115} -body { 116 .c delete all 117 .c create image 50 100 -image foo -tags i1 118 .c coords i1 250 dumb0 119} -cleanup { 120 .c delete all 121 image delete foo 122} -returnCodes {error} -result {bad screen distance "dumb0"} 123test canvImg-3.4 {ImageCoords procedure} -constraints testImageType -setup { 124 image create test foo 125} -body { 126 .c delete all 127 .c create image 50 100 -image foo -tags i1 128 .c coords i1 250 129} -cleanup { 130 .c delete all 131 image delete foo 132} -returnCodes {error} -result {wrong # coordinates: expected 2, got 1} 133test canvImg-3.5 {ImageCoords procedure} -constraints testImageType -setup { 134 image create test foo 135} -body { 136 .c delete all 137 .c create image 50 100 -image foo -tags i1 138 .c coords i1 250 300 400 139} -cleanup { 140 .c delete all 141 image delete foo 142} -returnCodes {error} -result {wrong # coordinates: expected 0 or 2, got 3} 143 144 145test canvImg-4.1 {ConfiugreImage procedure} -constraints testImageType -setup { 146 .c delete all 147} -body { 148 image create test foo -variable x 149 .c create image 50 100 -image foo -tags i1 150 update 151 set x {} 152 .c itemconfigure i1 -image {} 153 update 154 list $x [.c bbox i1] 155} -cleanup { 156 .c delete all 157 image delete foo 158} -result {{{foo free}} {}} 159test canvImg-4.2 {ConfigureImage procedure} -constraints testImageType -setup { 160 .c delete all 161} -body { 162 image create test foo -variable x 163 image create test foo2 -variable y 164 foo2 changed 0 0 0 0 80 60 165 .c create image 50 100 -image foo -tags i1 -anchor nw 166 update 167 set x {} 168 set y {} 169 set timer [after 300 {lappend y "timed out"}] 170 .c itemconfigure i1 -image foo2 171 update idletasks 172 update 173 # On MacOS we need to wait for the test image display procedure to run. 174 while {"timed out" ni $y && [lindex $y end 1] ne "display"} { 175 vwait y 176 } 177 after cancel $timer 178 list $x $y [.c bbox i1] 179} -cleanup { 180 .c delete all 181 image delete foo 182 image delete foo2 183} -result {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60}} {50 100 130 160}} 184test canvImg-4.3 {ConfiugreImage procedure} -constraints testImageType -setup { 185 .c delete all 186} -body { 187 image create test foo -variable x 188 image create test foo2 -variable y 189 foo2 changed 0 0 0 0 80 60 190 .c create image 50 100 -image foo -tags i1 -anchor nw 191 update 192 set x {} 193 set y {} 194 .c itemconfigure i1 -image lousy 195} -cleanup { 196 .c delete all 197 image delete foo foo2 198} -returnCodes {error} -result {image "lousy" doesn't exist} 199 200 201test canvImg-5.1 {DeleteImage procedure} -constraints testImageType -setup { 202 .c delete all 203 imageCleanup 204} -body { 205 image create test foo -variable x 206 image create test foo2 -variable y 207 image create test xyzzy -variable z 208 .c create image 50 100 -image xyzzy -tags i1 209 update 210 set names [lsort [imageNames]] 211 image delete xyzzy 212 set z {} 213 set names2 [lsort [imageNames]] 214 .c delete i1 215 update 216 list $names $names2 $z [lsort [imageNames]] 217} -cleanup { 218 imageCleanup 219 .c delete all 220} -result {{foo foo2 xyzzy} {foo foo2} {} {foo foo2}} 221test canvImg-5.2 {DeleteImage procedure (don't delete non-existent image)} -body { 222 .c delete all 223 .c create image 50 100 -tags i1 224 update 225 .c delete i1 226 update 227} -result {} 228 229 230test canvImg-6.1 {ComputeImageBbox procedure} -constraints testImageType -setup { 231 image create test foo 232 .c delete all 233} -body { 234 .c create image 15.51 17.51 -image foo -tags i1 -anchor nw 235 .c bbox i1 236} -cleanup { 237 .c delete all 238 imageCleanup 239} -result {16 18 46 33} 240test canvImg-6.2 {ComputeImageBbox procedure} -constraints testImageType -setup { 241 image create test foo 242 .c delete all 243} -body { 244 .c create image 15.49 17.49 -image foo -tags i1 -anchor nw 245 .c bbox i1 246} -cleanup { 247 .c delete all 248 imageCleanup 249} -result {15 17 45 32} 250test canvImg-6.3 {ComputeImageBbox procedure} -setup { 251 .c delete all 252} -body { 253 .c create image 20 30 -tags i1 -anchor nw 254 .c bbox i1 255} -cleanup { 256 .c delete all 257} -result {} 258test canvImg-6.4 {ComputeImageBbox procedure} -constraints testImageType -setup { 259 image create test foo 260 .c delete all 261} -body { 262 .c delete all 263 .c create image 20 30 -image foo -tags i1 -anchor nw 264 .c bbox i1 265} -cleanup { 266 .c delete all 267 imageCleanup 268} -result {20 30 50 45} 269test canvImg-6.5 {ComputeImageBbox procedure} -constraints testImageType -setup { 270 image create test foo 271 .c delete all 272} -body { 273 .c delete all 274 .c create image 20 30 -image foo -tags i1 -anchor n 275 .c bbox i1 276} -cleanup { 277 .c delete all 278 imageCleanup 279} -result {5 30 35 45} 280test canvImg-6.6 {ComputeImageBbox procedure} -constraints testImageType -setup { 281 image create test foo 282 .c delete all 283} -body { 284 .c delete all 285 .c create image 20 30 -image foo -tags i1 -anchor ne 286 .c bbox i1 287} -cleanup { 288 .c delete all 289 imageCleanup 290} -result {-10 30 20 45} 291test canvImg-6.7 {ComputeImageBbox procedure} -constraints testImageType -setup { 292 image create test foo 293 .c delete all 294} -body { 295 .c delete all 296 .c create image 20 30 -image foo -tags i1 -anchor e 297 .c bbox i1 298} -cleanup { 299 .c delete all 300 imageCleanup 301} -result {-10 23 20 38} 302test canvImg-6.8 {ComputeImageBbox procedure} -constraints testImageType -setup { 303 image create test foo 304 .c delete all 305} -body { 306 .c delete all 307 .c create image 20 30 -image foo -tags i1 -anchor se 308 .c bbox i1 309} -cleanup { 310 .c delete all 311 imageCleanup 312} -result {-10 15 20 30} 313test canvImg-6.9 {ComputeImageBbox procedure} -constraints testImageType -setup { 314 image create test foo 315 .c delete all 316} -body { 317 .c delete all 318 .c create image 20 30 -image foo -tags i1 -anchor s 319 .c bbox i1 320} -cleanup { 321 .c delete all 322 imageCleanup 323} -result {5 15 35 30} 324test canvImg-6.10 {ComputeImageBbox procedure} -constraints { 325 testImageType 326} -setup { 327 image create test foo 328 .c delete all 329} -body { 330 .c delete all 331 .c create image 20 30 -image foo -tags i1 -anchor sw 332 .c bbox i1 333} -cleanup { 334 .c delete all 335 image delete foo 336} -result {20 15 50 30} 337test canvImg-6.11 {ComputeImageBbox procedure} -constraints { 338 testImageType 339} -setup { 340 image create test foo 341 .c delete all 342} -body { 343 .c delete all 344 .c create image 20 30 -image foo -tags i1 -anchor w 345 .c bbox i1 346} -cleanup { 347 .c delete all 348 image delete foo 349} -result {20 23 50 38} 350test canvImg-6.12 {ComputeImageBbox procedure} -constraints { 351 testImageType 352} -setup { 353 image create test foo 354 .c delete all 355} -body { 356 .c delete all 357 .c create image 20 30 -image foo -tags i1 -anchor center 358 .c bbox i1 359} -cleanup { 360 .c delete all 361 image delete foo 362} -result {5 23 35 38} 363 364# The following test is non-portable because of differences in 365# coordinate rounding on some machines (does 0.5 round up?). 366 367test canvImg-7.1 {DisplayImage procedure} -constraints { 368 nonPortable testImageType 369} -setup { 370 .c delete all 371} -body { 372 image create test foo -variable x 373 .c create image 50 100 -image foo -tags i1 -anchor nw 374 update 375 set x {} 376 .c create rect 55 110 65 115 -width 1 -outline black -fill white 377 update 378 set x 379} -result {{foo display 4 9 12 6 30 30}} 380test canvImg-7.2 {DisplayImage procedure, no image} -body { 381 .c delete all 382 .c create image 50 100 -tags i1 383 update 384 .c create rect 55 110 65 115 -width 1 -outline black -fill white 385 update 386} -result {} 387 388 389# image used in 8.* test cases 390if {[testConstraint testImageType]} { 391 image create test foo 392} 393test canvImg-8.1 {ImageToArea procedure} -constraints testImageType -setup { 394 .c create image 50 100 -image foo -tags image -anchor nw 395 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 396} -body { 397 .c coords rect 50 70 80 81 398 .c gettags [.c find closest 70 90] 399} -cleanup { 400 .c delete all 401} -result {rect} 402test canvImg-8.2 {ImageToArea procedure} -constraints testImageType -setup { 403 .c create image 50 100 -image foo -tags image -anchor nw 404 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 405} -body { 406 .c coords rect {*}{50 70 80 79} 407 .c gettags [.c find closest {*}{70 90}] 408} -cleanup { 409 .c delete all 410} -result {image} 411test canvImg-8.3 {ImageToArea procedure} -constraints testImageType -setup { 412 .c create image 50 100 -image foo -tags image -anchor nw 413 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 414} -body { 415 .c coords rect {*}{99 70 110 81} 416 .c gettags [.c find closest {*}{90 90}] 417} -cleanup { 418 .c delete all 419} -result {rect} 420test canvImg-8.4 {ImageToArea procedure} -constraints testImageType -setup { 421 .c create image 50 100 -image foo -tags image -anchor nw 422 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 423} -body { 424 .c coords rect {*}{101 70 110 79} 425 .c gettags [.c find closest {*}{90 90}] 426} -cleanup { 427 .c delete all 428} -result {image} 429test canvImg-8.5 {ImageToArea procedure} -constraints testImageType -setup { 430 .c create image 50 100 -image foo -tags image -anchor nw 431 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 432} -body { 433 .c coords rect {*}{99 100 110 115} 434 .c gettags [.c find closest {*}{90 110}] 435} -cleanup { 436 .c delete all 437} -result {rect} 438test canvImg-8.6 {ImageToArea procedure} -constraints testImageType -setup { 439 .c create image 50 100 -image foo -tags image -anchor nw 440 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 441} -body { 442 .c coords rect {*}{101 100 110 115} 443 .c gettags [.c find closest {*}{90 110}] 444} -cleanup { 445 .c delete all 446} -result {image} 447test canvImg-8.7 {ImageToArea procedure} -constraints testImageType -setup { 448 .c create image 50 100 -image foo -tags image -anchor nw 449 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 450} -body { 451 .c coords rect {*}{99 134 110 145} 452 .c gettags [.c find closest {*}{90 125}] 453} -cleanup { 454 .c delete all 455} -result {rect} 456test canvImg-8.8 {ImageToArea procedure} -constraints testImageType -setup { 457 .c create image 50 100 -image foo -tags image -anchor nw 458 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 459} -body { 460 .c coords rect {*}{101 136 110 145} 461 .c gettags [.c find closest {*}{90 125}] 462} -cleanup { 463 .c delete all 464} -result {image} 465test canvImg-8.9 {ImageToArea procedure} -constraints testImageType -setup { 466 .c create image 50 100 -image foo -tags image -anchor nw 467 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 468} -body { 469 .c coords rect {*}{50 134 80 145} 470 .c gettags [.c find closest {*}{70 125}] 471} -cleanup { 472 .c delete all 473} -result {rect} 474test canvImg-8.10 {ImageToArea procedure} -constraints testImageType -setup { 475 .c create image 50 100 -image foo -tags image -anchor nw 476 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 477} -body { 478 .c coords rect {*}{50 136 80 145} 479 .c gettags [.c find closest {*}{70 125}] 480} -cleanup { 481 .c delete all 482} -result {image} 483test canvImg-8.11 {ImageToArea procedure} -constraints testImageType -setup { 484 .c create image 50 100 -image foo -tags image -anchor nw 485 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 486} -body { 487 .c coords rect {*}{20 134 31 145} 488 .c gettags [.c find closest {*}{40 125}] 489} -cleanup { 490 .c delete all 491} -result {rect} 492test canvImg-8.12 {ImageToArea procedure} -constraints testImageType -setup { 493 .c create image 50 100 -image foo -tags image -anchor nw 494 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 495} -body { 496 .c coords rect {*}{20 136 29 145} 497 .c gettags [.c find closest {*}{40 125}] 498} -cleanup { 499 .c delete all 500} -result {image} 501test canvImg-8.13 {ImageToArea procedure} -constraints testImageType -setup { 502 .c create image 50 100 -image foo -tags image -anchor nw 503 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 504} -body { 505 .c coords rect {*}{20 100 31 115} 506 .c gettags [.c find closest {*}{40 110}] 507} -cleanup { 508 .c delete all 509} -result {rect} 510test canvImg-8.14 {ImageToArea procedure} -constraints testImageType -setup { 511 .c create image 50 100 -image foo -tags image -anchor nw 512 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 513} -body { 514 .c coords rect {*}{20 100 29 115} 515 .c gettags [.c find closest {*}{40 110}] 516} -cleanup { 517 .c delete all 518} -result {image} 519test canvImg-8.15 {ImageToArea procedure} -constraints testImageType -setup { 520 .c create image 50 100 -image foo -tags image -anchor nw 521 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 522} -body { 523 .c coords rect {*}{20 70 31 80} 524 .c gettags [.c find closest {*}{40 90}] 525} -cleanup { 526 .c delete all 527} -result {rect} 528test canvImg-8.16 {ImageToArea procedure} -constraints testImageType -setup { 529 .c create image 50 100 -image foo -tags image -anchor nw 530 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 531} -body { 532 .c coords rect {*}{20 70 29 79} 533 .c gettags [.c find closest {*}{40 90}] 534} -cleanup { 535 .c delete all 536} -result {image} 537test canvImg-8.17 {ImageToArea procedure} -constraints testImageType -setup { 538 .c create image 50 100 -image foo -tags image -anchor nw 539 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 540} -body { 541 .c coords rect {*}{60 70 69 109} 542 .c gettags [.c find closest {*}{70 110}] 543} -cleanup { 544 .c delete all 545} -result {image} 546test canvImg-8.18 {ImageToArea procedure} -constraints testImageType -setup { 547 .c create image 50 100 -image foo -tags image -anchor nw 548 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} 549} -body { 550 .c coords rect {*}{60 70 71 111} 551 .c gettags [.c find closest {*}{70 110}] 552} -cleanup { 553 .c delete all 554} -result {rect} 555.c delete all 556 557test canvImg-8.19 {ImageToArea procedure} -constraints testImageType -body { 558 .c create image 50 100 -image foo -tags image -anchor nw 559 .c gettags [.c find overlapping 60 0 70 99] 560} -cleanup { 561 .c delete all 562} -result {} 563test canvImg-8.20 {ImageToArea procedure} -constraints testImageType -body { 564 .c create image 50 100 -image foo -tags image -anchor nw 565 .c gettags [.c find overlapping 60 0 70 99.999] 566} -cleanup { 567 .c delete all 568} -result {} 569test canvImg-8.21 {ImageToArea procedure} -constraints testImageType -body { 570 .c create image 50 100 -image foo -tags image -anchor nw 571 .c gettags [.c find overlapping 60 0 70 101] 572} -cleanup { 573 .c delete all 574} -result {image} 575test canvImg-8.22 {ImageToArea procedure} -constraints testImageType -body { 576 .c create image 50 100 -image foo -tags image -anchor nw 577 .c gettags [.c find overlapping 81 105 120 115] 578} -cleanup { 579 .c delete all 580} -result {} 581test canvImg-8.23 {ImageToArea procedure} -constraints testImageType -body { 582 .c create image 50 100 -image foo -tags image -anchor nw 583 .c gettags [.c find overlapping 80.001 105 120 115] 584} -cleanup { 585 .c delete all 586} -result {} 587test canvImg-8.24 {ImageToArea procedure} -constraints testImageType -body { 588 .c create image 50 100 -image foo -tags image -anchor nw 589 .c gettags [.c find overlapping 79 105 120 115] 590} -cleanup { 591 .c delete all 592} -result {image} 593test canvImg-8.25 {ImageToArea procedure} -constraints testImageType -body { 594 .c create image 50 100 -image foo -tags image -anchor nw 595 .c gettags [.c find overlapping 60 116 70 150] 596} -cleanup { 597 .c delete all 598} -result {} 599test canvImg-8.26 {ImageToArea procedure} -constraints testImageType -body { 600 .c create image 50 100 -image foo -tags image -anchor nw 601 .c gettags [.c find overlapping 60 115.001 70 150] 602} -cleanup { 603 .c delete all 604} -result {} 605test canvImg-8.27 {ImageToArea procedure} -constraints testImageType -body { 606 .c create image 50 100 -image foo -tags image -anchor nw 607 .c gettags [.c find overlapping 60 114 70 150] 608} -cleanup { 609 .c delete all 610} -result {image} 611test canvImg-8.28 {ImageToArea procedure} -constraints testImageType -body { 612 .c create image 50 100 -image foo -tags image -anchor nw 613 .c gettags [.c find overlapping 0 105 49 115] 614} -cleanup { 615 .c delete all 616} -result {} 617test canvImg-8.29 {ImageToArea procedure} -constraints testImageType -body { 618 .c create image 50 100 -image foo -tags image -anchor nw 619 .c gettags [.c find overlapping 0 105 50 114.999] 620} -cleanup { 621 .c delete all 622} -result {} 623test canvImg-8.30 {ImageToArea procedure} -constraints testImageType -body { 624 .c create image 50 100 -image foo -tags image -anchor nw 625 .c gettags [.c find overlapping 0 105 51 115] 626} -cleanup { 627 .c delete all 628} -result {image} 629test canvImg-8.31 {ImageToArea procedure} -constraints testImageType -body { 630 .c create image 50 100 -image foo -tags image -anchor nw 631 .c gettags [.c find overlapping 0 0 49.999 99.999] 632} -cleanup { 633 .c delete all 634} -result {} 635test canvImg-8.32 {ImageToArea procedure} -constraints testImageType -body { 636 .c create image 50 100 -image foo -tags image -anchor nw 637 .c gettags [.c find overlapping 0 0 51 101] 638} -cleanup { 639 .c delete all 640} -result {image} 641test canvImg-8.33 {ImageToArea procedure} -constraints testImageType -body { 642 .c create image 50 100 -image foo -tags image -anchor nw 643 .c gettags [.c find overlapping 80 0 150 100] 644} -cleanup { 645 .c delete all 646} -result {} 647test canvImg-8.34 {ImageToArea procedure} -constraints testImageType -body { 648 .c create image 50 100 -image foo -tags image -anchor nw 649 .c gettags [.c find overlapping 79 0 150 101] 650} -cleanup { 651 .c delete all 652} -result {image} 653test canvImg-8.35 {ImageToArea procedure} -constraints testImageType -body { 654 .c create image 50 100 -image foo -tags image -anchor nw 655 .c gettags [.c find overlapping 80.001 115.001 150 180] 656} -cleanup { 657 .c delete all 658} -result {} 659test canvImg-8.36 {ImageToArea procedure} -constraints testImageType -body { 660 .c create image 50 100 -image foo -tags image -anchor nw 661 .c gettags [.c find overlapping 79 114 150 180] 662} -cleanup { 663 .c delete all 664} -result {image} 665test canvImg-8.37 {ImageToArea procedure} -constraints testImageType -body { 666 .c create image 50 100 -image foo -tags image -anchor nw 667 .c gettags [.c find overlapping 0 115 50 180] 668} -cleanup { 669 .c delete all 670} -result {} 671test canvImg-8.38 {ImageToArea procedure} -constraints testImageType -body { 672 .c create image 50 100 -image foo -tags image -anchor nw 673 .c gettags [.c find overlapping 0 114 51 180] 674} -cleanup { 675 .c delete all 676} -result {image} 677test canvImg-8.39 {ImageToArea procedure} -constraints testImageType -body { 678 .c create image 50 100 -image foo -tags image -anchor nw 679 .c gettags [.c find enclosed 0 0 200 200] 680} -cleanup { 681 .c delete all 682} -result {image} 683test canvImg-8.40 {ImageToArea procedure} -constraints testImageType -body { 684 .c create image 50 100 -image foo -tags image -anchor nw 685 .c gettags [.c find enclosed 49.999 99.999 80.001 115.001] 686} -cleanup { 687 .c delete all 688} -result {image} 689test canvImg-8.41 {ImageToArea procedure} -constraints testImageType -body { 690 .c create image 50 100 -image foo -tags image -anchor nw 691 .c gettags [.c find enclosed 51 100 80 115] 692} -cleanup { 693 .c delete all 694} -result {} 695test canvImg-8.42 {ImageToArea procedure} -constraints testImageType -body { 696 .c create image 50 100 -image foo -tags image -anchor nw 697 .c gettags [.c find enclosed 50 101 80 115] 698} -cleanup { 699 .c delete all 700} -result {} 701test canvImg-8.43 {ImageToArea procedure} -constraints testImageType -body { 702 .c create image 50 100 -image foo -tags image -anchor nw 703 .c gettags [.c find enclosed 50 100 79 115] 704} -cleanup { 705 .c delete all 706} -result {} 707test canvImg-8.44 {ImageToArea procedure} -constraints testImageType -body { 708 .c create image 50 100 -image foo -tags image -anchor nw 709 .c gettags [.c find enclosed 50 100 80 114] 710} -cleanup { 711 .c delete all 712} -result {} 713if {[testConstraint testImageType]} { 714 image delete foo 715} 716 717 718test canvImg-9.1 {DisplayImage procedure} -constraints testImageType -setup { 719 .c delete all 720 image create test foo 721} -body { 722 .c create image 50 100 -image foo -tags image -anchor nw 723 .c scale image 25 0 2.0 1.5 724 .c bbox image 725} -cleanup { 726 .c delete all 727 image delete foo 728} -result {75 150 105 165} 729 730test canvImg-10.1 {TranslateImage procedure} -constraints testImageType -setup { 731 .c delete all 732 update 733} -body { 734 image create test foo -variable x 735 .c create image 50 100 -image foo -tags image -anchor nw 736 update 737 set x {} 738 set timer [after 500 {lappend x "timed out"}] 739 foo changed 2 4 6 8 30 15 740 vwait x 741 after cancel $timer 742 return $x 743} -cleanup { 744 .c delete all 745 image delete foo 746} -result {{foo display 2 4 6 8}} 747 748test canvImg-11.1 {TranslateImage procedure} -constraints testImageType -setup { 749 .c delete all 750 update 751} -body { 752 image create test foo -variable x 753 .c create image 50 100 -image foo -tags image -anchor nw 754 update 755 set x {} 756 set timer [after 500 {lappend x "timed out"}] 757 foo changed 2 4 6 8 40 50 758 vwait x 759 after cancel $timer 760 update 761 return $x 762} -cleanup { 763 .c delete all 764 image delete foo 765} -result {{foo display 0 0 40 50}} 766test canvImg-11.2 {ImageChangedProc procedure} -constraints { 767 testImageType 768} -setup { 769 .c delete all 770} -body { 771 image create test foo -variable x 772 .c create image 50 100 -image foo -tags image -anchor center 773 update 774 set x {} 775 foo changed 0 0 0 0 40 50 776 .c bbox image 777} -cleanup { 778 .c delete all 779 image delete foo 780} -result {30 75 70 125} 781 782test canvImg-11.3 {ImageChangedProc procedure} -constraints { 783 testImageType 784} -setup { 785 .c delete all 786 update idletasks 787} -body { 788 image create test foo -variable x 789 image create test foo2 -variable z 790 foo changed 0 0 0 0 40 50 791 foo2 changed 0 0 0 0 80 60 792 .c create image 50 100 -image foo -tags image -anchor nw 793 .c create image 70 110 -image foo2 -anchor nw 794 set z {} 795 set timer [after 500 {lappend z "timed out"}] 796 image delete foo 797 vwait z 798 after cancel $timer 799 return $z 800} -cleanup { 801 .c delete all 802 image delete foo2 803} -result {{foo2 display 0 0 80 60}} 804 805# cleanup 806imageFinish 807cleanupTests 808return 809 810# Local variables: 811# mode: tcl 812# End: 813