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