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