1# textImage.test -- test images embedded in text widgets
2#
3# This file contains a collection of tests for one or more of the Tcl
4# built-in commands.  Sourcing this file into Tcl runs the tests and
5# generates output for errors.  No output means no errors were found.
6#
7# Copyright (c) 1998-1999 by Scriptics Corporation.
8# All rights reserved.
9#
10# RCS: @(#) $Id: textImage.test,v 1.5 2002/07/13 20:28:35 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
19# One time setup.  Create a font to insure the tests are font metric invariant.
20
21catch {destroy .t}
22font create test_font -family courier -size 14
23text .t -font test_font
24destroy .t
25
26test textImage-1.1 {basic argument checking} {
27	catch {destroy .t}
28	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
29	pack .t
30	list [catch {.t image} msg] $msg
31} {1 {wrong # args: should be ".t image option ?arg arg ...?"}}
32
33test textImage-1.2 {basic argument checking} {
34	catch {destroy .t}
35	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
36	pack .t
37	list [catch {.t image c} msg] $msg
38} {1 {bad image option "c": must be cget, configure, create, or names}}
39
40test textImage-1.3 {cget argument checking} {
41	catch {destroy .t}
42	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
43	pack .t
44	list [catch {.t image cget} msg] $msg
45} {1 {wrong # args: should be ".t image cget index option"}}
46
47test textImage-1.4 {cget argument checking} {
48	catch {destroy .t}
49	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
50	pack .t
51	list [catch {.t image cget blurf -flurp} msg] $msg
52} {1 {bad text index "blurf"}}
53
54test textImage-1.5 {cget argument checking} {
55	catch {destroy .t}
56	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
57	pack .t
58	list [catch {.t image cget 1.1 -flurp} msg] $msg
59} {1 {no embedded image at index "1.1"}}
60
61test textImage-1.6 {configure argument checking} {
62	catch {destroy .t}
63	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
64	pack .t
65	list [catch {.t image configure } msg] $msg
66} {1 {wrong # args: should be ".t image configure index ?option value ...?"}}
67
68test textImage-1.7 {configure argument checking} {
69	catch {destroy .t}
70	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
71	pack .t
72	list [catch {.t image configure blurf } msg] $msg
73} {1 {bad text index "blurf"}}
74
75test textImage-1.8 {configure argument checking} {
76	catch {destroy .t}
77	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
78	pack .t
79	list [catch {.t image configure 1.1 } msg] $msg
80} {1 {no embedded image at index "1.1"}}
81
82test textImage-1.9 {create argument checking} {
83	catch {destroy .t}
84	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
85	pack .t
86	list [catch {.t image create} msg] $msg
87} {1 {wrong # args: should be ".t image create index ?option value ...?"}}
88
89test textImage-1.10 {create argument checking} {
90	catch {destroy .t}
91	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
92	pack .t
93	list [catch {.t image create blurf } msg] $msg
94} {1 {bad text index "blurf"}}
95
96test textImage-1.11 {basic argument checking} {
97	catch {
98	    image create photo small -width 5 -height 5
99	    small put red -to 0 0 4 4
100	}
101	catch {destroy .t}
102	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
103	pack .t
104	list [catch {.t image create 1000.1000 -image small} msg] $msg
105} {0 small}
106
107test textImage-1.12 {names argument checking} {
108	catch {destroy .t}
109	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
110	pack .t
111	list [catch {.t image names dates places} msg] $msg
112} {1 {wrong # args: should be ".t image names"}}
113
114
115test textImage-1.13 {names argument checking} {
116	catch {
117	    image create photo small -width 5 -height 5
118	    small put red -to 0 0 4 4
119	}
120	catch {destroy .t}
121	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
122	pack .t
123	set result ""
124	lappend result [.t image names]
125	.t image create insert -image small
126	lappend result [.t image names]
127	.t image create insert -image small
128	lappend result [.t image names]
129	.t image create insert -image small -name little
130	lappend result [.t image names]
131} {{} small {small#1 small} {small#1 small little}}
132
133test textImage-1.14 {basic argument checking} {
134	catch {destroy .t}
135	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
136	pack .t
137	list [catch {.t image huh} msg] $msg
138} {1 {bad image option "huh": must be cget, configure, create, or names}}
139
140test textImage-1.15 {align argument checking} {
141	catch {
142	    image create photo small -width 5 -height 5
143	    small put red -to 0 0 4 4
144	}
145	catch {destroy .t}
146	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
147	pack .t
148	list [catch {.t image create end -image small -align wrong} msg] $msg
149} {1 {bad alignment "wrong": must be baseline, bottom, center, or top}}
150
151test textImage-1.16 {configure} {
152	catch {
153	    image create photo small -width 5 -height 5
154	    small put red -to 0 0 4 4
155	}
156	catch {destroy .t}
157	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
158	pack .t
159	.t image create end -image small
160	.t image configure small
161} {{-align {} {} center center} {-padx {} {} 0 0} {-pady {} {} 0 0} {-image {} {} {} small} {-name {} {} {} {}}}
162
163test textImage-1.17 {basic cget options} {
164	catch {
165	    image create photo small -width 5 -height 5
166	    small put red -to 0 0 4 4
167	}
168	catch {destroy .t}
169	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
170	pack .t
171	.t image create end -image small
172	set result ""
173	foreach i {align padx pady image name} {
174	    lappend result $i:[.t image cget small -$i]
175	} 
176	set result
177} {align:center padx:0 pady:0 image:small name:}
178
179test textImage-1.18 {basic configure options} {
180	catch {
181	    image create photo small -width 5 -height 5
182	    small put red -to 0 0 4 4
183	    image create photo large -width 50 -height 50
184	    large put green -to 0 0 50 50
185	}
186	catch {destroy .t}
187	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
188	pack .t
189	.t image create end -image small
190	set result ""
191	foreach {option value}  {align top padx 5 pady 7 image large name none} {
192	    .t image configure small -$option $value
193	} 
194	update
195	.t image configure small
196} {{-align {} {} center top} {-padx {} {} 0 5} {-pady {} {} 0 7} {-image {} {} {} large} {-name {} {} {} none}}
197
198test textImage-1.19 {basic image naming} {
199	catch {
200	    image create photo small -width 5 -height 5
201	    small put red -to 0 0 4 4
202	}
203	catch {destroy .t}
204	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
205	pack .t
206	.t image create end -image small
207	.t image create end -image small -name small
208	.t image create end -image small -name small#6342
209	.t image create end -image small -name small
210	lsort [.t image names]
211} {small small#1 small#6342 small#6343}
212
213test textImage-2.1 {debug} {
214	catch {
215	    image create photo small -width 5 -height 5
216	    small put red -to 0 0 4 4
217	}
218	catch {destroy .t}
219	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
220	pack .t
221	.t debug 1
222	.t insert end front
223	.t image create end -image small
224	.t insert end back
225	.t delete small
226	.t image names
227	.t debug 0
228} {}
229
230test textImage-3.1 {image change propagation} {
231	catch {
232	    image create photo vary -width 5 -height 5
233	    small put red -to 0 0 4 4
234	}
235	catch {destroy .t}
236	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
237	pack .t
238	.t image create end -image vary -align top
239	update
240	set result ""
241	lappend result base:[.t bbox vary]
242	foreach i {10 20 40} {
243	    vary configure -width $i -height $i
244	    update
245	    lappend result $i:[.t bbox vary]
246	} 
247	set result
248} {{base:0 0 5 5} {10:0 0 10 10} {20:0 0 20 20} {40:0 0 40 40}}
249
250test textImage-3.2 {delayed image management} {
251	catch {
252	    image create photo small -width 5 -height 5
253	    small put red -to 0 0 4 4
254	}
255	catch {destroy .t}
256	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
257	pack .t
258	.t image create end -name test
259	update
260	set result ""
261	lappend result [.t bbox test]
262	.t image configure test -image small -align top
263	update
264	lappend result [.t bbox test]
265} {{} {0 0 5 5}}
266
267# some temporary random tests
268
269test textImage-4.1 {alignment checking - except baseline} {
270    catch {
271	image create photo small -width 5 -height 5
272	small put red -to 0 0 4 4
273	image create photo large -width 50 -height 50
274	large put green -to 0 0 50 50
275    }
276    catch {destroy .t}
277    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
278    pack .t
279    .t image create end -image large
280    .t image create end -image small
281    .t insert end test
282    update
283    set result ""
284    lappend result default:[.t bbox small]
285    foreach i {top bottom center} {
286	.t image configure small -align $i
287	update
288	lappend result [.t image cget small -align]:[.t bbox small]
289    }
290    set result
291} {{default:50 22 5 5} {top:50 0 5 5} {bottom:50 45 5 5} {center:50 22 5 5}}
292
293test textImage-4.2 {alignment checking - baseline} {
294    catch {
295	image create photo small -width 5 -height 5
296	small put red -to 0 0 4 4
297	image create photo large -width 50 -height 50
298	large put green -to 0 0 50 50
299    }
300    catch {destroy .t}
301    font create test_font2 -size 5
302    text .t -font test_font2 -bd 0 -highlightthickness 0 -padx 0 -pady 0
303    pack .t
304    .t image create end -image large
305    .t image create end -image small -align baseline
306    .t insert end test
307    set result ""
308    foreach size {10 15 20 30} {
309	font configure test_font2 -size $size
310	array set Metrics [font metrics test_font2]
311	update
312	foreach {x y w h} [.t bbox small] {}
313	set norm [expr {
314	    (([image height large] - $Metrics(-linespace))/2
315	    + $Metrics(-ascent) - [image height small] - $y)
316	 }]
317        lappend result "$size $norm"
318    }
319    font delete test_font2
320    unset Metrics
321    set result
322} {{10 0} {15 0} {20 0} {30 0}}
323
324test textImage-4.3 {alignment and padding checking} {fonts} {
325    catch {
326	image create photo small -width 5 -height 5
327	small put red -to 0 0 4 4
328	image create photo large -width 50 -height 50
329	large put green -to 0 0 50 50
330    }
331    catch {destroy .t}
332    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
333    pack .t
334    .t image create end -image large
335    .t image create end -image small -padx 5 -pady 10
336    .t insert end test
337    update
338    set result ""
339    lappend result default:[.t bbox small]
340    foreach i {top bottom center baseline} {
341	.t image configure small -align $i
342	update
343	lappend result $i:[.t bbox small]
344    }
345    set result
346} {{default:55 22 5 5} {top:55 10 5 5} {bottom:55 35 5 5} {center:55 22 5 5} {baseline:55 22 5 5}}
347# cleanup
348
349catch {destroy .t}
350foreach image [image names] {image delete $image}
351font delete test_font
352
353# cleanup
354::tcltest::cleanupTests
355return
356
357
358
359
360
361
362
363
364
365
366
367
368
369