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