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