Commit 23e7e763575f281964c1076eeb3f2ccad47c4d19 - libimager-perl

+215

-1321

Changes less more

0		------------------------------------------------------------------------
1		r1098 \| tony \| 2006-09-14 17:43:24 +1000 (Thu, 14 Sep 2006) \| 29 lines
2		Changed paths:
3		M /trunk/Imager/Imager.pm
4		M /trunk/Imager/META.yml
5		A /trunk/Imager/announce/0.54.txt
	0	Imager release history. Older releases can be found in Changes.old
	1
	2	Imager 0.56 -
	3	===========
	4
	5	- added support for reading 16-bit/sample PGM/PPM images
	6
	7	- added support for writing 16-bit/sample PGM/PPM images
	8
	9	- improved performance of reading PBM/PGM/PPM images
	10
	11	- added support for writing PBM images if the image is paletted and
	12	contains only black and white
	13
	14	- added a new make_colors value - "mono"
	15
	16	- switched from the svn log Changes to a manual Changes to reduce
	17	noise
	18
	19	- new sample code - samples/flasher.pl
	20
	21	Bug fixes:
	22
	23	- CRITICAL: the "Imager" typemap entry (not used by Imager itself)
	24	was returning an image object with an extra reference, this
	25	resulted in a memory leak.
	26	http://rt.cpan.org/Ticket/Display.html?id=24992
	27
	28	- fix rendering on alpha channel images for the FreeType 2.x driver
	29	http://rt.cpan.org/Ticket/Display.html?id=11972
	30
	31	- reading bmp files now consitently handles short reads. You can now
	32	supply a parameter to treat a short read as successful and set
	33	i_incomplete
	34	http://rt.cpan.org/Ticket/Display.html?id=8426
	35
	36	- previously, reading ASCII PBM files required spaces between samples,
	37	even though the format doesn't require that
	38
	39	- improved documentation of the unsharpmask filter (I hope)
	40	http://rt.cpan.org/Ticket/Display.html?id=25531
	41
	42	- force flushing of the output from i_tt_dump_names() and test output
	43	in t/t35ttfont.t to prevent output from being mixed up.
	44	https://rt.cpan.org/Ticket/Display.html?id=24859
	45
	46	- rewrite a conditional expression as an if() to hopefully work around
	47	a bug in the pre-4.0 GCC Apple shipped with OS X 10.4.
	48	https://rt.cpan.org/Ticket/Display.html?id=25561
	49
	50	- avoid Data::Dumper in regops.perl to support older releases of perl
	51	https://rt.cpan.org/Ticket/Display.html?id=24391
	52
	53	Imager 0.55 - 16 Dec 2006
	54	===========
	55
	56	This is primarily a bug fix release.
	57
	58	Note: Test::More is now a pre-requisite for Imager and is no longer bundled.
	59
	60	There is one new feature:
	61
	62	- the Win32 font driver now supports UTF8 (RT 22166)
	63	http://www.cpanforum.com/threads/3276
	64	http://rt.cpan.org/Ticket/Display.html?id=22166
	65
	66	Several bugs were fixed:
	67
	68	- the string() method would not output the string "0"
	69	http://rt.cpan.org/Public/Bug/Display.html?id=21770
	70
	71	- fills.c was failing to compile on Solaris 10 (compiler unknown)
	72	http://rt.cpan.org/Public/Bug/Display.html?id=21944
	73
	74	- the gif_disposal and gif_user_input tags weren't being read from
	75	the file correctly
	76	http://rt.cpan.org/Public/Bug/Display.html?id=22192
	77
	78	- gif.c was failing to build under MSVC
	79	http://rt.cpan.org/Ticket/Display.html?id=23922
	80
	81	- in some cases strings passed to the string() method were treated as
	82	terminated by NUL (chr 0)
	83	http://rt.cpan.org/Public/Bug/Display.html?id=21770
	84
	85	- on "MSWin32" perl builds we now link to -lzlib instead of -lz since
	86	that's the default build name for zlib on Win32.
	87	http://rt.cpan.org/Ticket/Display.html?id=23064
	88
	89	- search $Config{incpath} for headers too, which we should have been
	90	doing all along.
	91
	92	Win32 font driver fixes:
	93
	94	- the global descent value from bounding box was the wrong sign
	95	http://www.cpanforum.com/threads/3276
	96
	97	- if the first or last glyph overflowed the left or right side of the
	98	advance width they would be clipped
	99
	100
	101	Imager 0.54 - 14 Sep 2006
	102	===========
6	103
7	104	This is primarily a feature release:
8	105
9		- a new qtype value 'mixing' has been added to the scale() method.
10		This is faster than 'normal', slower than 'preview'. This is based on
11		the method used by pnmscale, and seems to produce less blurry results
12		than normal.
13
14		- the rubthrough() method can now render onto images with an alpha
15		channel.
16
17		- the read_multi() method now falls back to calling doing a single
18		image read via the read() method and write_multi() will now fall
19		back to calling write() if a single image is supplied. This means
20		you can simply call the read_multi() or write_multi() functions
21		without having to check if the type is formatted by that method.
22
23		- the GIF loop extension can now be written. If you don't have
24		libungif/giflib 4.1.4 (or some distribution's bugfixed equivalent)
25		you should upgrade.
26
27		- getscanline() and setscanline() can now read/write palette index
28		based data from/to the image for paletted images, by setting type to
29		'index'.
30
31		- we no longer hassle you to disable GIF support
32
33		- minor documentation fixes
34
35
36		------------------------------------------------------------------------
37		r1092 \| tony \| 2006-09-12 14:19:09 +1000 (Tue, 12 Sep 2006) \| 2 lines
38		Changed paths:
39		M /trunk/Imager/Makefile.PL
40
41		add generated .c files to make clean
42
43		------------------------------------------------------------------------
44		r1091 \| tony \| 2006-09-06 23:50:43 +1000 (Wed, 06 Sep 2006) \| 3 lines
45		Changed paths:
46		M /trunk/Imager/doco.perl
47		M /trunk/Imager/errep.perl
48		M /trunk/Imager/filterlist.perl
49		M /trunk/Imager/t/t94kwalitee.t
50
51		add .perl files to the t94kwalitee struct tests and fix the non strict
52		.perl code
53
54		------------------------------------------------------------------------
55		r1090 \| tony \| 2006-09-06 21:35:38 +1000 (Wed, 06 Sep 2006) \| 3 lines
56		Changed paths:
57		M /trunk/Imager/Imager.pm
58		M /trunk/Imager/t/t102png.t
59
60		read_multi() now falls back to calling read() and write_multi() now
61		falls back to calling write() for a single image.
62
63		------------------------------------------------------------------------
64		r1089 \| tony \| 2006-09-01 17:17:36 +1000 (Fri, 01 Sep 2006) \| 1 line
65		Changed paths:
66		M /trunk/Imager/t/t105gif.t
67
68		skip the right number of tests when gif not available
69		------------------------------------------------------------------------
70		r1088 \| tony \| 2006-08-31 23:35:33 +1000 (Thu, 31 Aug 2006) \| 2 lines
71		Changed paths:
72		M /trunk/Imager/TODO
73
74		rubthrough done
75
76		------------------------------------------------------------------------
77		r1087 \| tony \| 2006-08-31 23:27:19 +1000 (Thu, 31 Aug 2006) \| 2 lines
78		Changed paths:
79		M /trunk/Imager/t/t105gif.t
80
81		skip the loop tests with older (un)giflibs
82
83		------------------------------------------------------------------------
84		r1086 \| tony \| 2006-08-31 23:16:45 +1000 (Thu, 31 Aug 2006) \| 18 lines
85		Changed paths:
86		M /trunk/Imager/Makefile.PL
87		M /trunk/Imager/gif.c
88		M /trunk/Imager/t/t105gif.t
89
90		Changes to GIF support:
91
92		- the Nescape loop extension block is written if gif_loop is set.
93		This requires libungif/libgif 4.1.3 or later.
94
95		Resolves: http://rt.cpan.org/Ticket/Display.html?id=21185
96
97		- we now set the GIF header depending on the features enabled in the
98		GIF. Since we don't do configure type probes for bugs we have to
99		enable this based on the gif_lib.h version number, it's enabled for
100		4.1.0 and later, but requires 4.1.3 and later (maybe 4.1.3) to run
101		without crashing.
102
103		You can avoid this crash by passing --nogifsetversion to Makefile.PL,
104		or by installing a non-buggy libungif/libgif, if there is such a
105		thing.
106
107
108		------------------------------------------------------------------------
109		r1085 \| tony \| 2006-08-30 17:25:55 +1000 (Wed, 30 Aug 2006) \| 2 lines
110		Changed paths:
111		M /trunk/Imager/lib/Imager/Transformations.pod
112
113		note on relative speeds of the scaling mechanisms
114
115		------------------------------------------------------------------------
116		r1084 \| tony \| 2006-08-30 16:47:48 +1000 (Wed, 30 Aug 2006) \| 12 lines
117		Changed paths:
118		M /trunk/Imager/MANIFEST
119		M /trunk/Imager/bench/scale.perl
120		M /trunk/Imager/imtoc.perl
121		M /trunk/Imager/lib/Imager/Transformations.pod
122		D /trunk/Imager/scale.c
123		A /trunk/Imager/scale.im (from /trunk/Imager/scale.c:1083)
124		M /trunk/Imager/t/t40scale.t
125
126		convert scale.c to scale.im so we have 8 bit/sample and double/sample
127		implementations of mixing scaling.
128
129		modified imtoc.perl to allow non-conditional #code sections to allow
130		creation ofr 8 and double/sample versions of support functions.
131
132		fixed a bug in an optimization that avoids vertically scaling when the
133		vertical size stays the same.
134
135		The change from double/sample only to both saved about 20% on
136		scalebench time (which also loads/saves the images)
137
138		------------------------------------------------------------------------
139		r1083 \| tony \| 2006-08-29 17:20:42 +1000 (Tue, 29 Aug 2006) \| 3 lines
140		Changed paths:
141		M /trunk/Imager/CountColor/Makefile.PL
142		M /trunk/Imager/DynTest/Makefile.PL
143		M /trunk/Imager/Flines/Makefile.PL
144		M /trunk/Imager/ICO/Makefile.PL
145		M /trunk/Imager/Makefile.PL
146		M /trunk/Imager/Mandelbrot/Makefile.PL
147
148		comparisons against $ExtUtils::MakeMaker::VERSION were warning when
149		that had an _ in it. We now eval it to prevent the warning.
150
151		------------------------------------------------------------------------
152		r1082 \| tony \| 2006-08-29 10:42:46 +1000 (Tue, 29 Aug 2006) \| 10 lines
153		Changed paths:
154		M /trunk/Imager
155		M /trunk/Imager/MANIFEST
156		M /trunk/Imager/MANIFEST.SKIP
157		M /trunk/Imager/Makefile.PL
158		M /trunk/Imager/apidocs.perl
159		M /trunk/Imager/image.c
160		A /trunk/Imager/imtoc.perl
161		M /trunk/Imager/lib/Imager/APIRef.pod
162		M /trunk/Imager/lib/Imager/ImageTypes.pod
163		A /trunk/Imager/rubthru.im
164		M /trunk/Imager/t/t69rubthru.t
165
166		the rubthrough() method now supports destination images with an alpha
167		channel.
168
169		Also added a statement on the relationship between the alpha channel
170		and color data in Imager.
171
172		The new rubthrough() code uses a new pre-processor that reduces source
173		code duplication between 8-bit/sample and double/sample processing.
174
175
176		------------------------------------------------------------------------
177		r1081 \| tony \| 2006-08-29 10:23:01 +1000 (Tue, 29 Aug 2006) \| 2 lines
178		Changed paths:
179		M /trunk/Imager/MANIFEST
180
181		remove t/t60dyntest.t from the MANIFEST, since we moved it
182
183		------------------------------------------------------------------------
184		r1080 \| tony \| 2006-08-19 17:24:35 +1000 (Sat, 19 Aug 2006) \| 2 lines
185		Changed paths:
186		M /trunk/Imager/Imager.pm
187
188		to_rgb8 doesn't crop but the void content warning said it did
189
190		------------------------------------------------------------------------
191		r1079 \| tony \| 2006-08-18 17:08:37 +1000 (Fri, 18 Aug 2006) \| 3 lines
192		Changed paths:
193		M /trunk/Imager/MANIFEST
194		M /trunk/Imager/TODO
195		D /trunk/Imager/dynfilt/t/t00dummy.t
196		A /trunk/Imager/dynfilt/t/t60dyntest.t (from /trunk/Imager/t/t60dyntest.t:1077)
197		D /trunk/Imager/t/t60dyntest.t
198
199		move the existing dynfilt test into dynfilt/t, update it to use
200		Test::More and remove the dummy test script
201
202		------------------------------------------------------------------------
203		r1078 \| tony \| 2006-08-18 14:35:27 +1000 (Fri, 18 Aug 2006) \| 10 lines
204		Changed paths:
205		M /trunk/Imager/Imager.pm
206		M /trunk/Imager/Imager.xs
207		M /trunk/Imager/MANIFEST
208		M /trunk/Imager/Makefile.PL
209		M /trunk/Imager/TODO
210		M /trunk/Imager/imager.h
211		M /trunk/Imager/lib/Imager/Transformations.pod
212		A /trunk/Imager/scale.c (from /branches/Imager/scale/scale.c:1077)
213		M /trunk/Imager/t/t40scale.t
214
215		Merged in the scale branch:
216
217		- adds a new scaling mechanism 'mixing' based on the method
218		implemented by pnmscale. Produces better detail when scaling down and
219		is faster than the 'normal' method.
220
221		- the scale() method can now scale non-proportionally if the caller
222		specifically asks for it with xscalefactor/yscalefactor or by setting
223		type to 'nonprop'.
224
225		------------------------------------------------------------------------
226		r1074 \| tony \| 2006-08-15 18:12:30 +1000 (Tue, 15 Aug 2006) \| 5 lines
227		Changed paths:
228		M /trunk/Imager/Imager.pm
229		M /trunk/Imager/Imager.xs
230		M /trunk/Imager/TODO
231		M /trunk/Imager/lib/Imager/Draw.pod
232		M /trunk/Imager/t/t023palette.t
233		M /trunk/Imager/t/t67convert.t
234
235		added pixel type 'index' to getscanline() and setscanline() for
236		getting/setting palette indexes from paletted images.
237
238		https://rt.cpan.org/Ticket/Display.html?id=20338
239
240		------------------------------------------------------------------------
241		r1073 \| tony \| 2006-08-10 11:53:19 +1000 (Thu, 10 Aug 2006) \| 5 lines
242		Changed paths:
243		M /trunk/Imager/samples/slant_text.pl
244		M /trunk/Imager/t/t91pod.t
245
246		finally found which file contained the POD errors that
247		http://cpants.perl.org/kwalitee/Imager was complaining about
248
249		modified t/t91pod.t to check every pl/pod/pm/PL file
250
251		------------------------------------------------------------------------
252		r1071 \| tony \| 2006-08-08 00:20:21 +1000 (Tue, 08 Aug 2006) \| 5 lines
253		Changed paths:
254		M /trunk/Imager/lib/Imager/API.pod
255
256		you need to load Imager to use the API, Imager::API now tells the user
257		that
258
259		http://rt.cpan.org/Ticket/Display.html?id=20823
260
261		------------------------------------------------------------------------
262		r1070 \| tony \| 2006-08-07 17:02:43 +1000 (Mon, 07 Aug 2006) \| 7 lines
263		Changed paths:
264		M /trunk/Imager/Makefile.PL
265		M /trunk/Imager/README
266
267		Removed the query asking if GIF support should be disabled, since
268		recent lib(un)gif are sane.
269
270		https://rt.cpan.org/Ticket/Display.html?id=20687
271
272		Some README cleanup.
273
274		------------------------------------------------------------------------
275		r1069 \| tony \| 2006-07-29 15:21:49 +1000 (Sat, 29 Jul 2006) \| 2 lines
276		Changed paths:
277		M /trunk/Imager/TODO
278
279		basic todo for 0.54
280
281		------------------------------------------------------------------------
282		r1067 \| tony \| 2006-07-27 10:38:49 +1000 (Thu, 27 Jul 2006) \| 6 lines
283		Changed paths:
284		M /trunk/Imager/Imager.pm
285		M /trunk/Imager/META.yml
286
287		bump to 0.53
288
289		This is to fix a crash bug introduced in 0.52.
290
291		http://rt.cpan.org/Ticket/Display.html?id=20705
292
293		------------------------------------------------------------------------
294		r1066 \| tony \| 2006-07-27 10:31:44 +1000 (Thu, 27 Jul 2006) \| 8 lines
295		Changed paths:
296		M /trunk/Imager/Imager.xs
297		M /trunk/Imager/t/t07iolayer.t
298
299		there was a C< (char )0 = 0 > left in a code path uncovered by the
300		test suite.
301
302		- added a test to cover that code path
303		- removed the debug code
304
305		Fixes: http://rt.cpan.org/Ticket/Display.html?id=20705
306
307		------------------------------------------------------------------------
308		r1064 \| tony \| 2006-07-25 14:43:38 +1000 (Tue, 25 Jul 2006) \| 42 lines
309		Changed paths:
310		M /trunk/Imager/Imager.pm
311		M /trunk/Imager/META.yml
312		A /trunk/Imager/announce/0.52.txt
313
314		bump to 0.52
	106	- a new qtype value 'mixing' has been added to the scale()
	107	method. This is faster than 'normal', slower than 'preview'. This
	108	is based on the method used by pnmscale, and seems to produce less
	109	blurry results than normal.
	110	http://rt.cpan.org/Public/Bug/Display.html?id=20677
	111
	112	- the rubthrough() method can now render onto images with an alpha
	113	channel.
	114	http://rt.cpan.org/Ticket/Display.html?id=20678
	115
	116	- the read_multi() method now falls back to calling doing a single
	117	image read via the read() method and write_multi() will now fall
	118	back to calling write() if a single image is supplied. This means
	119	you can simply call the read_multi() or write_multi() functions
	120	without having to check if the type is formatted by that method.
	121	http://rt.cpan.org/Ticket/Display.html?id=19457
	122	http://rt.cpan.org/Ticket/Display.html?id=19458
	123
	124	- the GIF loop extension can now be written. If you don't have
	125	libungif/giflib 4.1.4 (or some distribution's bugfixed equivalent) you
	126	should upgrade.
	127	http://rt.cpan.org/Ticket/Display.html?id=21185
	128
	129	- getscanline() and setscanline() can now read/write palette index
	130	based data from/to the image for paletted images, by setting type to
	131	'index'.
	132	http://rt.cpan.org/Ticket/Display.html?id=20338
	133
	134	- we no longer hassle you to disable GIF support
	135	http://rt.cpan.org/Ticket/Display.html?id=20687
	136
	137	- minor documentation fixes
	138
	139
	140	Imager 0.53 - 26 Jul 2006
	141	===========
	142
	143	This is a bugfix release.
	144
	145	Some test code was left in a code path not covered by the test
	146	suite. A test was added to cover this code path and the test code was
	147	removed.
	148	http://rt.cpan.org/Public/Bug/Display.html?id=20705
	149
	150
	151	Imager 0.52 - 25 Jul 2006
	152	===========
315	153
316	154	This is primarily a feature release, but contains a fair few bug
317	155	fixes, new features:
318	156
319		- ability to read and write MS Windows ICO and CUR files
320
321		- you can now add file format plugins to support new file formats
322
323		- add POD coverage tests
324
325		- setcolors() and addcolors() now accept color names and so on instead
326		of requiring Imager::Color objects.
327
328		- flood_fill() can now fill to a specified border color instead of
329		just to the area the same color as the seed.
	157	- ability to read and write MS Windows ICO and CUR files
	158
	159	- you can now add file format plugins to support new file formats
	160
	161	- add POD coverage tests
	162
	163	- setcolors() and addcolors() now accept color names and so on
	164	instead of requiring Imager::Color objects.
	165	http://rt.cpan.org/Ticket/Display.html?id=20056
	166
	167	- flood_fill() can now fill to a specified border color instead of
	168	just to the area the same color as the seed.
	169	http://rt.cpan.org/Ticket/Display.html?id=19618
	170
330	171
331	172	Bug fixes:
332	173
333		- bounding_box for the T1 driver wasn't converting UTF8 to ascii when
334		calculating the advance width.
335
336		- bounding_box for the T1 driver wasn't including leading and trailing
337		spaces in the bounding box as the other drivers did, it also produced
338		strange results for empty strings or strings containing only spaces
339
340		- when reading CMYK jpeg images they were being transferred to the
341		image object as is, producing a four channel image. It only looked
342		ok due to an old still unfixed Photoshop bug. We now convert from
343		the inverted CMYK that photoshop (and Corel for example) produce
344		into RGB.
345
346		- reading a CYMK TIFF would result in a 4 channel image, reading any
347		image with more than 4 channels (eg. RGB with 2 alpha channels)
348		would result in an error.
349
350		- added /usr/local/include to the default include search path, since
351		we were already searching /usr/local/lib for libraries.
	174	- bounding_box for the T1 driver wasn't converting UTF8 to ascii when
	175	calculating the advance width.
	176	http://rt.cpan.org/Public/Bug/Display.html?id=20554
	177
	178	- bounding_box for the T1 driver wasn't including leading and
	179	trailing spaces in the bounding box as the other drivers did, it also
	180	produced strange results for empty strings or strings containing only
	181	spaces
	182
	183	- when reading CMYK jpeg images they were being transferred to the
	184	image object as is, producing a four channel image. It only looked ok
	185	due to an old still unfixed Photoshop bug. We now convert from the
	186	inverted CMYK that photoshop (and Corel for example) produce into RGB.
	187	http://rt.cpan.org/Ticket/Display.html?id=20416
	188
	189	- reading a CYMK TIFF would result in a 4 channel image, reading any
	190	image with more than 4 channels (eg. RGB with 2 alpha channels) would
	191	result in an error.
	192	http://rt.cpan.org/Ticket/Display.html?id=20415
	193
	194	- added /usr/local/include to the default include search path, since
	195	we were already searching /usr/local/lib for libraries.
352	196
353	197	And various minor fixes and documentation updates.
354	198
355	199
356		------------------------------------------------------------------------
357		r1063 \| tony \| 2006-07-24 22:28:31 +1000 (Mon, 24 Jul 2006) \| 4 lines
358		Changed paths:
359		M /trunk/Imager/lib/Imager/Cookbook.pod
360
361		added a cookbook entry for converting files from one format to another
362
363		part of http://rt.cpan.org/Ticket/Display.html?id=5608
364
365		------------------------------------------------------------------------
366		r1062 \| tony \| 2006-07-24 22:09:22 +1000 (Mon, 24 Jul 2006) \| 4 lines
367		Changed paths:
368		M /trunk/Imager/lib/Imager/Draw.pod
369
370		document the direction of Imager's co-ordinate system
371
372		http://rt.cpan.org/Ticket/Display.html?id=11429
373
374		------------------------------------------------------------------------
375		r1061 \| tony \| 2006-07-24 21:27:24 +1000 (Mon, 24 Jul 2006) \| 2 lines
376		Changed paths:
377		M /trunk/Imager/lib/Imager/Files.pod
378
379		add an example of reading exif tags
380
381		------------------------------------------------------------------------
382		r1060 \| tony \| 2006-07-24 21:16:06 +1000 (Mon, 24 Jul 2006) \| 2 lines
383		Changed paths:
384		M /trunk/Imager/lib/Imager/Files.pod
385
386		add some basic examples of using data, fd, fh, callback parameters
387
388		------------------------------------------------------------------------
389		r1059 \| tony \| 2006-07-24 20:17:00 +1000 (Mon, 24 Jul 2006) \| 3 lines
390		Changed paths:
391		M /trunk/Imager/lib/Imager/Files.pod
392
393		added examples for fh, fd, file, data and callback mechanisms for
394		reading/writing files.
395
396		------------------------------------------------------------------------
397		r1058 \| tony \| 2006-07-24 17:15:49 +1000 (Mon, 24 Jul 2006) \| 2 lines
398		Changed paths:
399		M /trunk/Imager/image.c
400		M /trunk/Imager/t/t1000files.t
401
402		add detection of BZIP2 and gzip data
403
404		------------------------------------------------------------------------
405		r1057 \| tony \| 2006-07-24 14:46:00 +1000 (Mon, 24 Jul 2006) \| 2 lines
406		Changed paths:
407		M /trunk/Imager/MANIFEST
408		A /trunk/Imager/dynfilt/t
409		A /trunk/Imager/dynfilt/t/t00dummy.t
410
411		add dummy test to dynfilt to since it was confusing smoke testers
412
413		------------------------------------------------------------------------
414		r1056 \| tony \| 2006-07-24 14:44:28 +1000 (Mon, 24 Jul 2006) \| 2 lines
415		Changed paths:
416		M /trunk/Imager/fontfiles/SpaceTest.sfd
417
418		commit changes to SpaceTest font source caused by exports
419
420		------------------------------------------------------------------------
421		r1055 \| tony \| 2006-07-21 10:01:57 +1000 (Fri, 21 Jul 2006) \| 2 lines
422		Changed paths:
423		M /trunk/Imager/image.c
424		M /trunk/Imager/t/t1000files.t
425
426		add a magic entry to detect XWD files
427
428		------------------------------------------------------------------------
429		r1054 \| tony \| 2006-07-21 00:35:22 +1000 (Fri, 21 Jul 2006) \| 5 lines
430		Changed paths:
431		M /trunk/Imager/font.c
432		M /trunk/Imager/t/t30t1font.t
433
434		bounding_box() for the t1 driver wasn't converting from UTF8 to ascii
435		when calculating the advance width.
436
437		fixes http://rt.cpan.org/Ticket/Display.html?id=20554
438
439		------------------------------------------------------------------------
440		r1053 \| tony \| 2006-07-20 23:42:04 +1000 (Thu, 20 Jul 2006) \| 11 lines
441		Changed paths:
442		M /trunk/Imager/MANIFEST
443		M /trunk/Imager/font.c
444		M /trunk/Imager/fontfiles/ExistenceTest.afm
445		M /trunk/Imager/fontfiles/ExistenceTest.pfb
446		M /trunk/Imager/fontfiles/ExistenceTest.sfd
447		A /trunk/Imager/fontfiles/SpaceTest.afm
448		A /trunk/Imager/fontfiles/SpaceTest.pfb
449		A /trunk/Imager/fontfiles/SpaceTest.sfd
450		M /trunk/Imager/t/t30t1font.t
451
452		bounding_box() for t1 driver fonts was treating spaces as empty space
453		when calculating the bounds, which they are, but this is inconsistent
454		with other drivers. This was especially a problem for strings
455		containing only spaces where the left bound would end up far to the
456		right of the right bound, and similarly for the ascent and descent.
457
458		calculating the bounding box for an empty string invoked special
459		behaviour in t1lib, making it unreliable.
460
461		Fixes: http://rt.cpan.org/Ticket/Display.html?id=20555
462
463		------------------------------------------------------------------------
464		r1052 \| tony \| 2006-07-19 10:39:58 +1000 (Wed, 19 Jul 2006) \| 2 lines
465		Changed paths:
466		M /trunk/Imager/Imager.pm
467		M /trunk/Imager/META.yml
468
469		bump to 0.51_03
470
471		------------------------------------------------------------------------
472		r1051 \| tony \| 2006-07-19 00:34:52 +1000 (Wed, 19 Jul 2006) \| 3 lines
473		Changed paths:
474		M /trunk/Imager/jpeg.c
475
476		make the selection of a transfer function check that it's getting the
477		right number of channels
478
479		------------------------------------------------------------------------
480		r1050 \| tony \| 2006-07-18 23:34:56 +1000 (Tue, 18 Jul 2006) \| 2 lines
481		Changed paths:
482		M /trunk/Imager/lib/Imager/APIRef.pod
483
484		set eol-style so that generation doesn't make svn burp
485
486		------------------------------------------------------------------------
487		r1049 \| tony \| 2006-07-18 23:21:21 +1000 (Tue, 18 Jul 2006) \| 3 lines
488		Changed paths:
489		M /trunk/Imager/image.c
490		M /trunk/Imager/jpeg.c
491
492		cast 2 signed/unsigned char pointer conversions to prevent warnings
493		(errors on some compilers)
494
495		------------------------------------------------------------------------
496		r1048 \| tony \| 2006-07-18 22:49:31 +1000 (Tue, 18 Jul 2006) \| 2 lines
497		Changed paths:
498		M /trunk/Imager/t/t106tiff.t
499
500		report the error if we can't read the alpha test images
501
502		------------------------------------------------------------------------
503		r1047 \| tony \| 2006-07-18 22:43:02 +1000 (Tue, 18 Jul 2006) \| 3 lines
504		Changed paths:
505		M /trunk/Imager/testimg/scmyka.tif
506		M /trunk/Imager/testimg/scmykaa.tif
507		M /trunk/Imager/testimg/srgba.tif
508		M /trunk/Imager/testimg/srgbaa.tif
509
510		newer versions of libtiff were choking on the bad values corel was
511		putting into EXTRASAMPLES, corrected via hex editing
512
513		------------------------------------------------------------------------
514		r1046 \| tony \| 2006-07-15 00:57:44 +1000 (Sat, 15 Jul 2006) \| 21 lines
515		Changed paths:
516		M /trunk/Imager/MANIFEST
517		M /trunk/Imager/jpeg.c
518		M /trunk/Imager/t/t101jpeg.t
519		A /trunk/Imager/testimg/scmyk.jpg
520
521		CMYK jpeg images were being read as 4 channel images, even though they
522		have no alpha channel.
523
524		The colors were being transferred directly from the JPEG image data,
525		this only looked correct because of an old bug in photoshop, kept for
526		compatibility in later versions. Photoshop inverts the ink values in
527		the file, so max cyan coverage is stored at 0, and min as 255, and so
528		on.
529
530		CMYK jpegs are now read as 3 channel images. The colors are now
531		converted adjusting for the photoshop bug, cmyk images from the only
532		other source I have, corel draw 9, are inverted in the same way,
533		presumably for compatibility with photoshop.
534
535		If anyone has an application that produces technically correct CMYK
536		jpegs, please provide a sample in jpeg and tiff form so I can attempt
537		to deal with it.
538
539		Fixes: http://rt.cpan.org/Ticket/Display.html?id=20416
540
541
542		------------------------------------------------------------------------
543		r1045 \| tony \| 2006-07-13 21:04:53 +1000 (Thu, 13 Jul 2006) \| 10 lines
544		Changed paths:
545		M /trunk/Imager/MANIFEST
546		M /trunk/Imager/lib/Imager/Files.pod
547		M /trunk/Imager/t/t106tiff.t
548		A /trunk/Imager/testimg/scmyk.tif
549		A /trunk/Imager/testimg/scmyka.tif
550		A /trunk/Imager/testimg/scmykaa.tif
551		A /trunk/Imager/testimg/slab.tif
552		A /trunk/Imager/testimg/srgb.tif
553		A /trunk/Imager/testimg/srgba.tif
554		A /trunk/Imager/testimg/srgbaa.tif
555		M /trunk/Imager/tiff.c
556
557		http://rt.cpan.org/Ticket/Display.html?id=20415
558
559		Reading a CMYK TIFF with no alpha would result in a 4-channel image.
560
561		Also, reading a CMYK TIFF with an alpha channel would fail to read.
562
563		Reading a CMYK TIFF with 2 alpha channels would fail to read.
564
565		Reading a RGB TIFF with 2 alpha channels would also fail to read.
566
567		------------------------------------------------------------------------
568		r1044 \| tony \| 2006-07-13 15:20:09 +1000 (Thu, 13 Jul 2006) \| 8 lines
569		Changed paths:
570		M /trunk/Imager/freetyp2.c
571		M /trunk/Imager/t/t38ft2font.t
572
573		attempting to render a space non-antialiased from freetype 2 could
574		crash or fail, depending on the version of freetype.
575
576		Fixed by checking if the glyph has anything to render before calling
577		FT_Render_Glyph().
578
579		https://rt.cpan.org/Ticket/Display.html?id=20403
580
581		------------------------------------------------------------------------
582		r1043 \| tony \| 2006-07-11 23:21:31 +1000 (Tue, 11 Jul 2006) \| 2 lines
583		Changed paths:
584		M /trunk/Imager/Imager.pm
585		M /trunk/Imager/lib/Imager/Cookbook.pod
586		M /trunk/Imager/lib/Imager/ImageTypes.pod
587
588		add some examples using the i_xres and i_yres tags
589
590		------------------------------------------------------------------------
591		r1042 \| tony \| 2006-07-10 18:07:18 +1000 (Mon, 10 Jul 2006) \| 3 lines
592		Changed paths:
593		M /trunk/Imager/lib/Imager/Cookbook.pod
594
595		the cookbook said we couldn't limit image sizes, but we can now. Fix
596		that and add some simple examples.
597
598		------------------------------------------------------------------------
599		r1035 \| tony \| 2006-07-07 20:59:07 +1000 (Fri, 07 Jul 2006) \| 2 lines
600		Changed paths:
601		M /trunk/Imager/Makefile.PL
602
603		it's libgif not libguf
604
605		------------------------------------------------------------------------
606		r1034 \| tony \| 2006-07-07 20:57:26 +1000 (Fri, 07 Jul 2006) \| 3 lines
607		Changed paths:
608		M /trunk/Imager/Makefile.PL
609
610		move linker flags from freetype-config/pkg-config up to the front to
611		match the placement of C flags.
612
613		------------------------------------------------------------------------
614		r1033 \| tony \| 2006-07-06 00:21:07 +1000 (Thu, 06 Jul 2006) \| 6 lines
615		Changed paths:
616		M /trunk/Imager/Makefile.PL
617
618		we search /usr/local/include by default but we weren't searching
619		/usr/local/lib, fixed that
620
621		don't rebuild META.yml if we're not setting AUTHOR, this was producing
622		a bad META.yml on older EU::MMs
623
624		------------------------------------------------------------------------
625		r1032 \| tony \| 2006-07-05 21:54:33 +1000 (Wed, 05 Jul 2006) \| 3 lines
626		Changed paths:
627		M /trunk/Imager/ICO/t/t60writefail.t
628
629		implement limited writes as a closure instead of as an overloaded
630		class to support 5.005_03
631
632		------------------------------------------------------------------------
633		r1031 \| tony \| 2006-07-05 21:41:04 +1000 (Wed, 05 Jul 2006) \| 2 lines
634		Changed paths:
635		M /trunk/Imager/ICO/ICO.xs
636		M /trunk/Imager/ICO/t/t10icon.t
637		M /trunk/Imager/ICO/t/t20readone.t
638		M /trunk/Imager/ICO/t/t21readmult.t
639		M /trunk/Imager/ICO/t/t30cursor.t
640		M /trunk/Imager/ICO/t/t40readcurone.t
641		M /trunk/Imager/ICO/t/t41curmultread.t
642		M /trunk/Imager/ICO/t/t50readfail.t
643		M /trunk/Imager/ICO/t/t60writefail.t
644		M /trunk/Imager/ICO/t/t70icosing.t
645		M /trunk/Imager/ICO/t/t71icomult.t
646		M /trunk/Imager/ICO/t/t72cursing.t
647		M /trunk/Imager/ICO/t/t73curmult.t
648		M /trunk/Imager/t/t07iolayer.t
649		M /trunk/Imager/t/t69rubthru.t
650		M /trunk/Imager/t/tr18561.t
651		M /trunk/Imager/t/tr18561b.t
652
653		minor changes for compatibility with 5.005_03
654
655		------------------------------------------------------------------------
656		r1028 \| tony \| 2006-07-04 23:54:13 +1000 (Tue, 04 Jul 2006) \| 2 lines
657		Changed paths:
658		M /trunk/Imager/Imager.pm
659		M /trunk/Imager/META.yml
660
661		bump to 0.51_02
662
663		------------------------------------------------------------------------
664		r1027 \| tony \| 2006-07-04 22:52:08 +1000 (Tue, 04 Jul 2006) \| 3 lines
665		Changed paths:
666		M /trunk/Imager/Imager.pm
667		M /trunk/Imager/t/t93podcover.t
668
669		make sure the method index includes all documented Imager methods and
670		is properly sorted.
671
672		------------------------------------------------------------------------
673		r1026 \| tony \| 2006-07-04 22:06:22 +1000 (Tue, 04 Jul 2006) \| 3 lines
674		Changed paths:
675		M /trunk/Imager/Imager.xs
676		M /trunk/Imager/ppport.h
677
678		update to a newer ppport.h and modify Imager.xs a bit based on its
679		recommendations
680
681		------------------------------------------------------------------------
682		r1025 \| tony \| 2006-07-04 21:39:37 +1000 (Tue, 04 Jul 2006) \| 2 lines
683		Changed paths:
684		M /trunk/Imager/filters.c
685
686		addition memory allocation checks
687
688		------------------------------------------------------------------------
689		r1024 \| tony \| 2006-07-04 21:28:34 +1000 (Tue, 04 Jul 2006) \| 2 lines
690		Changed paths:
691		M /trunk/Imager/lib/Imager/Matrix2d.pm
692		M /trunk/Imager/lib/Imager/Transform.pm
693		M /trunk/Imager/t/t93podcover.t
694
695		add more pod coverage tests (and the coverage needed)
696
697		------------------------------------------------------------------------
698		r1023 \| tony \| 2006-07-04 21:17:12 +1000 (Tue, 04 Jul 2006) \| 6 lines
699		Changed paths:
700		M /trunk/Imager
701		M /trunk/Imager/CountColor
702		M /trunk/Imager/DynTest
703		M /trunk/Imager/Flines
704		M /trunk/Imager/ICO
705		M /trunk/Imager/Imager.pm
706		M /trunk/Imager/MANIFEST
707		M /trunk/Imager/Mandelbrot
708		M /trunk/Imager/lib/Imager/Color/Float.pm
709		M /trunk/Imager/lib/Imager/Color/Table.pm
710		M /trunk/Imager/lib/Imager/Color.pm
711		M /trunk/Imager/lib/Imager/Expr.pm
712		M /trunk/Imager/lib/Imager/Files.pod
713		M /trunk/Imager/lib/Imager/Fill.pm
714		M /trunk/Imager/lib/Imager/Font/BBox.pm
715		M /trunk/Imager/lib/Imager/Font/Wrap.pm
716		M /trunk/Imager/lib/Imager/Font.pm
717		A /trunk/Imager/lib/Imager/Handy.pod
718		M /trunk/Imager/lib/Imager/ImageTypes.pod
719		M /trunk/Imager/t/t93podcover.t
720
721		svn:ignore some more profiler files and other junk
722
723		we now pass the pod coverage test on the Imager class, remove the TODO
724
725		add pod coverage tests for several other classes, and pass them
726
727		------------------------------------------------------------------------
728		r1021 \| tony \| 2006-07-01 15:38:11 +1000 (Sat, 01 Jul 2006) \| 4 lines
729		Changed paths:
730		M /trunk/Imager/apidocs.perl
731		M /trunk/Imager/lib/Imager/APIRef.pod
732
733		don't include the line number in the From comment so since unrelated edits
734		were causing changes to APIRef.pm. This is still possible but they should
735		be a lot less frequence.
736
737		------------------------------------------------------------------------
738		r1020 \| tony \| 2006-07-01 15:31:35 +1000 (Sat, 01 Jul 2006) \| 3 lines
739		Changed paths:
740		M /trunk/Imager/t/t023palette.t
741
742		added error handling tests for bad colors supplied to addcolors()
743		and setcolors()
744
745		------------------------------------------------------------------------
746		r1019 \| tony \| 2006-06-30 23:51:45 +1000 (Fri, 30 Jun 2006) \| 6 lines
747		Changed paths:
748		M /trunk/Imager/Imager.xs
749		M /trunk/Imager/iolayer.c
750		A /trunk/Imager/lib/Imager/IO.pod
751		M /trunk/Imager/t/t07iolayer.t
752
753		add more iolayer tests
754		callback handler fixes to return errors correctly
755		Imager::IO XS changes to make errors return empty lists
756		iolayer error handling fixes
757		documented Imager::IO methods
758
759		------------------------------------------------------------------------
760		r1018 \| tony \| 2006-06-29 21:39:10 +1000 (Thu, 29 Jun 2006) \| 3 lines
761		Changed paths:
762		M /trunk/Imager/Imager.pm
763		M /trunk/Imager/t/t023palette.t
764
765		setcolors() and addcolors() can now accept non-object colors like most
766		other methods
767
768		------------------------------------------------------------------------
769		r1017 \| tony \| 2006-06-29 21:06:16 +1000 (Thu, 29 Jun 2006) \| 2 lines
770		Changed paths:
771		M /trunk/Imager/t/t101jpeg.t
772
773		extra jpeg tests to improve code coverage of jpeg.c
774
775		------------------------------------------------------------------------
776		r1016 \| tony \| 2006-06-29 20:56:09 +1000 (Thu, 29 Jun 2006) \| 3 lines
777		Changed paths:
778		M /trunk/Imager/bmp.c
779		M /trunk/Imager/datatypes.c
780		M /trunk/Imager/error.c
781		M /trunk/Imager/filters.c
782		M /trunk/Imager/font.c
783		M /trunk/Imager/gif.c
784		M /trunk/Imager/hlines.c
785		M /trunk/Imager/image.c
786		M /trunk/Imager/imexif.c
787		M /trunk/Imager/iolayer.c
788		M /trunk/Imager/log.c
789
790		long delayed renaming of m_fatal() to i_fatal() to match Imager's
791		functions in general
792
793		------------------------------------------------------------------------
794		r1015 \| tony \| 2006-06-29 20:53:07 +1000 (Thu, 29 Jun 2006) \| 2 lines
795		Changed paths:
796		M /trunk/Imager/META.yml
797
798		META.yml changed due to release
799
800		------------------------------------------------------------------------
801		r1014 \| tony \| 2006-06-29 20:51:12 +1000 (Thu, 29 Jun 2006) \| 2 lines
802		Changed paths:
803		M /trunk/Imager/jpeg.c
804
805		add missing parameter required by format in wiol_empty_output_buffer
806
807		------------------------------------------------------------------------
808		r1012 \| tony \| 2006-06-28 23:22:25 +1000 (Wed, 28 Jun 2006) \| 2 lines
809		Changed paths:
810		M /trunk/Imager/Imager.pm
811
812		bump to 0.51_01 for release
813
814		------------------------------------------------------------------------
815		r1011 \| tony \| 2006-06-28 00:38:10 +1000 (Wed, 28 Jun 2006) \| 1 line
816		Changed paths:
817		M /trunk/Imager/Makefile.PL
818
819		handle a missing Changes file when checking if we need to generate one.
820		------------------------------------------------------------------------
821		r1010 \| tony \| 2006-06-28 00:25:03 +1000 (Wed, 28 Jun 2006) \| 2 lines
822		Changed paths:
823		M /trunk/Imager/lib/Imager/APIRef.pod
824		M /trunk/Imager/limits.c
825
826		document the image file limit functions for the API
827
828		------------------------------------------------------------------------
829		r1009 \| tony \| 2006-06-27 22:50:28 +1000 (Tue, 27 Jun 2006) \| 1 line
830		Changed paths:
831		M /trunk/Imager/iolayert.h
832
833		include stddef.h for size_t
834		------------------------------------------------------------------------
835		r1008 \| tony \| 2006-06-27 22:20:47 +1000 (Tue, 27 Jun 2006) \| 10 lines
836		Changed paths:
837		M /trunk/Imager/Imager.pm
838		M /trunk/Imager/Imager.xs
839		M /trunk/Imager/draw.c
840		M /trunk/Imager/fills.c
841		M /trunk/Imager/imager.h
842		M /trunk/Imager/imext.c
843		M /trunk/Imager/imext.h
844		M /trunk/Imager/imexttypes.h
845		M /trunk/Imager/lib/Imager/APIRef.pod
846		M /trunk/Imager/lib/Imager/Draw.pod
847		M /trunk/Imager/t/t20fill.t
848		M /trunk/Imager/t/t82inline.t
849
850		implement a flood_fill that stops at a given color rather than filling
851		a region of the color at the start poiint.
852
853		from perl you can call flood_fill() with a border parameter to specify
854		a fill to border.
855
856		from the API call the i_flood_fill_border() or i_flood_cfill_border()
857		function.
858
859
860		------------------------------------------------------------------------
861		r1007 \| tony \| 2006-06-27 22:12:12 +1000 (Tue, 27 Jun 2006) \| 3 lines
862		Changed paths:
863		M /trunk/Imager/Makefile.PL
864
865		Makefile was generating lib/Imager/APIRef.pod, not
866		lib/Imager/APIRef.pm
867
868		------------------------------------------------------------------------
869		r1006 \| tony \| 2006-06-26 23:14:54 +1000 (Mon, 26 Jun 2006) \| 3 lines
870		Changed paths:
871		M /trunk/Imager/Makefile.PL
872
873		use the ExtUtils::MakeMaker prompt() function to ask about including
874		gif support instead of <STDIN>
875
876		------------------------------------------------------------------------
877		r1005 \| tony \| 2006-06-26 22:57:00 +1000 (Mon, 26 Jun 2006) \| 3 lines
878		Changed paths:
879		M /trunk/Imager/Imager.pm
880		M /trunk/Imager/lib/Imager/Files.pod
881
882		document parseiptc()
883		https://rt.cpan.org/Ticket/Display.html?id=17894
884
885		------------------------------------------------------------------------
886		r1004 \| tony \| 2006-06-26 22:34:40 +1000 (Mon, 26 Jun 2006) \| 3 lines
887		Changed paths:
888		M /trunk/Imager/lib/Imager/Files.pod
889
890		clarify that FORMATGUESS is only used when writing to a file.
891		http://rt.cpan.org/Ticket/Display.html?id=18773
892
893		------------------------------------------------------------------------
894		r1003 \| tony \| 2006-06-26 22:20:27 +1000 (Mon, 26 Jun 2006) \| 10 lines
895		Changed paths:
896		M /trunk/Imager
897		M /trunk/Imager/CountColor
898		M /trunk/Imager/DynTest
899		M /trunk/Imager/Flines
900		M /trunk/Imager/ICO
901		M /trunk/Imager/ICO/ICO.pm
902		M /trunk/Imager/ICO/ICO.xs
903		M /trunk/Imager/ICO/Makefile.PL
904		M /trunk/Imager/ICO/imicon.c
905		M /trunk/Imager/ICO/imicon.h
906		A /trunk/Imager/ICO/lib (from /branches/Imager/ico/ICO/lib:1002)
907		M /trunk/Imager/ICO/msicon.c
908		M /trunk/Imager/ICO/msicon.h
909		M /trunk/Imager/ICO/t/t10icon.t
910		A /trunk/Imager/ICO/t/t30cursor.t (from /branches/Imager/ico/ICO/t/t30cursor.t:1002)
911		A /trunk/Imager/ICO/t/t40readcurone.t (from /branches/Imager/ico/ICO/t/t40readcurone.t:1002)
912		A /trunk/Imager/ICO/t/t41curmultread.t (from /branches/Imager/ico/ICO/t/t41curmultread.t:1002)
913		A /trunk/Imager/ICO/t/t50readfail.t (from /branches/Imager/ico/ICO/t/t50readfail.t:1002)
914		A /trunk/Imager/ICO/t/t60writefail.t (from /branches/Imager/ico/ICO/t/t60writefail.t:1002)
915		A /trunk/Imager/ICO/t/t70icosing.t (from /branches/Imager/ico/ICO/t/t70icosing.t:1002)
916		A /trunk/Imager/ICO/t/t71icomult.t (from /branches/Imager/ico/ICO/t/t71icomult.t:1002)
917		A /trunk/Imager/ICO/t/t72cursing.t (from /branches/Imager/ico/ICO/t/t72cursing.t:1002)
918		A /trunk/Imager/ICO/t/t73curmult.t (from /branches/Imager/ico/ICO/t/t73curmult.t:1002)
919		A /trunk/Imager/ICO/testimg/pal43232.cur (from /branches/Imager/ico/ICO/testimg/pal43232.cur:1002)
920		M /trunk/Imager/Imager.pm
921		M /trunk/Imager/Imager.xs
922		M /trunk/Imager/MANIFEST
923		M /trunk/Imager/MANIFEST.SKIP
924		M /trunk/Imager/Makefile.PL
925		M /trunk/Imager/Mandelbrot
926		M /trunk/Imager/dynfilt
927		M /trunk/Imager/image.c
928		M /trunk/Imager/imager.h
929		M /trunk/Imager/imageri.h
930		M /trunk/Imager/imext.c
931		M /trunk/Imager/imext.h
932		M /trunk/Imager/imexttypes.h
933		M /trunk/Imager/iolayer.c
934		M /trunk/Imager/iolayert.h
935		M /trunk/Imager/lib/Imager/Files.pod
936		M /trunk/Imager/t/t106tiff.t
937
938		add support for file write plugins
939
940		fix write_multi() writing to scalars
941		https://rt.cpan.org/Ticket/Display.html?id=19982
942
943		add support for writing to ICO/CUR image files
944
945		added file limit check functions to the API
946
947
948		------------------------------------------------------------------------
949		r996 \| tony \| 2006-05-22 13:46:15 +1000 (Mon, 22 May 2006) \| 2 lines
950		Changed paths:
951		M /trunk/Imager/MANIFEST
952		M /trunk/Imager/samples/README
953		A /trunk/Imager/samples/inline_capture2image.pl
954
955		add inline_capture2image.pl sample
956
957		------------------------------------------------------------------------
958		r995 \| tony \| 2006-05-22 13:29:51 +1000 (Mon, 22 May 2006) \| 2 lines
959		Changed paths:
960		M /trunk/Imager/MANIFEST
961		M /trunk/Imager/Makefile.PL
962		D /trunk/Imager/lib/Imager/API.pm
963		A /trunk/Imager/lib/Imager/API.pod (from /trunk/Imager/lib/Imager/API.pm:959)
964		D /trunk/Imager/lib/Imager/APIRef.pm
965		A /trunk/Imager/lib/Imager/APIRef.pod (from /trunk/Imager/lib/Imager/APIRef.pm:959)
966
967		rename APIRef.pm, API.pm to *.pod since they contain no code
968
969		------------------------------------------------------------------------
970		r994 \| tony \| 2006-05-22 13:24:49 +1000 (Mon, 22 May 2006) \| 2 lines
971		Changed paths:
972		M /trunk/Imager/tags.c
973
974		fix documentation nit
975
976		------------------------------------------------------------------------
977		r993 \| tony \| 2006-05-22 13:24:20 +1000 (Mon, 22 May 2006) \| 2 lines
978		Changed paths:
979		M /trunk/Imager/MANIFEST
980
981		added kwalitee test script to the MANIFEST
982
983		------------------------------------------------------------------------
984		r992 \| tony \| 2006-05-22 13:23:50 +1000 (Mon, 22 May 2006) \| 2 lines
985		Changed paths:
986		M /trunk/Imager/lib/Imager/ExtUtils.pm
987
988		give lib/Imager/ExtUtils.pm a version number
989
990		------------------------------------------------------------------------
991		r991 \| tony \| 2006-05-22 13:23:11 +1000 (Mon, 22 May 2006) \| 4 lines
992		Changed paths:
993		M /trunk/Imager/CountColor/Makefile.PL
994		M /trunk/Imager/DynTest/Makefile.PL
995		M /trunk/Imager/Flines/Makefile.PL
996		M /trunk/Imager/Mandelbrot/Makefile.PL
997		M /trunk/Imager/dynfilt/Makefile.PL
998		M /trunk/Imager/t/Pod/Coverage/Imager.pm
999		A /trunk/Imager/t/t94kwalitee.t
1000		M /trunk/Imager/t/testtools.pl
1001
1002		added "kwalitee" test script:
1003		- currently tests all pl/pm/PL files have use strict
1004		- added use strict to all pl/pm/PL files with code in them
1005
1006		------------------------------------------------------------------------
1007		r990 \| tony \| 2006-05-22 13:18:27 +1000 (Mon, 22 May 2006) \| 5 lines
1008		Changed paths:
1009		M /trunk/Imager/image.c
1010		M /trunk/Imager/t/t1000files.t
1011
1012		i_test_format_probe:
1013		- added Utah RLE,
1014		- separated ICO and CUR file formats,
1015		- fix duplicate PCX entry
1016
1017		------------------------------------------------------------------------
1018		r989 \| tony \| 2006-04-30 00:53:11 +1000 (Sun, 30 Apr 2006) \| 4 lines
1019		Changed paths:
1020		M /trunk/Imager/lib/Imager/interface.pod
1021
1022		minor updates, make it clear in the title this documents the C level.
1023		tags is now used.
1024		there's been a double image type for a while now.
1025
1026		------------------------------------------------------------------------
1027		r988 \| tony \| 2006-04-30 00:44:27 +1000 (Sun, 30 Apr 2006) \| 4 lines
1028		Changed paths:
1029		M /trunk/Imager/lib/Imager/ImageTypes.pod
1030
1031		changed the title to better reflect what it documents - model, not
1032		internals.
1033		Split out the initial paragraphs into more concise statements.
1034
1035		------------------------------------------------------------------------
1036		r983 \| tony \| 2006-04-19 22:19:56 +1000 (Wed, 19 Apr 2006) \| 9 lines
1037		Changed paths:
1038		M /trunk/Imager/Imager.pm
1039		M /trunk/Imager/MANIFEST
1040		A /trunk/Imager/t/tr18561.t
1041		A /trunk/Imager/t/tr18561b.t
1042
1043		- Calling setpixel() with color set to [ 0, 0, 0 ] would crash with
1044		Can't locate object method "new" via package "Imager::Color::Float" ...
1045
1046		- having the color parameter code create floating point colors could
1047		cause other problems too, since most of the underlying functions can't
1048		handle them, so removed the attempt to create float colors.
1049
1050		Fixes #18561
1051
1052		------------------------------------------------------------------------
1053		r980 \| tony \| 2006-04-19 14:05:45 +1000 (Wed, 19 Apr 2006) \| 4 lines
1054		Changed paths:
1055		M /trunk/Imager/Imager.pm
1056		M /trunk/Imager/t/t66paste.t
1057
1058		Specifying the bottom edge of the source image to paste was broken in
1059		a couple of different ways.
1060		Fixes #18712
1061
1062		------------------------------------------------------------------------
1063		r978 \| tony \| 2006-04-04 09:53:26 +1000 (Tue, 04 Apr 2006) \| 2 lines
1064		Changed paths:
1065		M /trunk/Imager/lib/Imager/Filters.pod
1066
1067		add AUTHOR, SEE ALSO, REVISION sections
1068
1069		------------------------------------------------------------------------
1070		r977 \| tony \| 2006-04-02 16:57:56 +1000 (Sun, 02 Apr 2006) \| 4 lines
1071		Changed paths:
1072		M /trunk/Imager/MANIFEST
1073		M /trunk/Imager/imexif.c
1074		M /trunk/Imager/t/t101jpeg.t
1075		A /trunk/Imager/testimg/zerotype.jpg
1076
1077		fix range checking on IFD entry data types. This could cause various
1078		crashes.
1079		Fixes #18496
1080
1081		------------------------------------------------------------------------
1082		r976 \| tony \| 2006-03-30 18:14:17 +1100 (Thu, 30 Mar 2006) \| 2 lines
1083		Changed paths:
1084		M /trunk/Imager/jpeg.c
1085		M /trunk/Imager/t/t101jpeg.t
1086		M /trunk/Imager/t/t108tga.t
1087		M /trunk/Imager/tga.c
1088
1089		backport fix for RT issue 18397
1090
1091		------------------------------------------------------------------------
1092		r975 \| tony \| 2006-03-30 15:41:41 +1100 (Thu, 30 Mar 2006) \| 5 lines
1093		Changed paths:
1094		M /trunk/Imager/image.c
1095		M /trunk/Imager/t/t1000files.t
1096
1097		add format probes for SGI RGB, ILBM, XPM, PCX, FITS, Photoshop, EPS
1098
1099		if you have an entry for some other format you want to implement let
1100		me know.
1101
1102		------------------------------------------------------------------------
1103		r964 \| tony \| 2006-03-24 20:49:57 +1100 (Fri, 24 Mar 2006) \| 6 lines
1104		Changed paths:
1105		A /trunk/Imager/ICO
1106		A /trunk/Imager/ICO/ICO.pm
1107		A /trunk/Imager/ICO/ICO.xs
1108		A /trunk/Imager/ICO/Makefile.PL
1109		A /trunk/Imager/ICO/imicon.c
1110		A /trunk/Imager/ICO/imicon.h
1111		A /trunk/Imager/ICO/msicon.c
1112		A /trunk/Imager/ICO/msicon.h
1113		A /trunk/Imager/ICO/t
1114		A /trunk/Imager/ICO/t/t10icon.t
1115		A /trunk/Imager/ICO/t/t20readone.t
1116		A /trunk/Imager/ICO/t/t21readmult.t
1117		A /trunk/Imager/ICO/testimg
1118		A /trunk/Imager/ICO/testimg/combo.ico
1119		A /trunk/Imager/ICO/testimg/pal13232.ico
1120		A /trunk/Imager/ICO/testimg/pal43232.ico
1121		A /trunk/Imager/ICO/testimg/pal43232.ppm
1122		A /trunk/Imager/ICO/testimg/pal83232.ico
1123		A /trunk/Imager/ICO/testimg/pal83232.ppm
1124		A /trunk/Imager/ICO/testimg/rgba3232.ico
1125		A /trunk/Imager/ICO/testimg/rgba3232.ppm
1126		M /trunk/Imager/MANIFEST
1127		M /trunk/Imager/MANIFEST.SKIP
1128
1129		- implement reading MS Windows icon files
1130
1131		- add t/Pod/Coverage/Imager.pm to MANIFEST
1132
1133		- skip some more trash in MANIFEST.SKIP
1134
1135		------------------------------------------------------------------------
1136		r963 \| tony \| 2006-03-24 15:26:24 +1100 (Fri, 24 Mar 2006) \| 2 lines
1137		Changed paths:
1138		M /trunk/Imager/tga.c
1139
1140		make the targa probe even stricter
1141
1142		------------------------------------------------------------------------
1143		r962 \| tony \| 2006-03-24 01:09:57 +1100 (Fri, 24 Mar 2006) \| 10 lines
1144		Changed paths:
1145		M /trunk/Imager/Imager.pm
1146		M /trunk/Imager/Imager.xs
1147		M /trunk/Imager/lib/Imager/Files.pod
1148		M /trunk/Imager/t/t70newgif.t
1149
1150		- added support for registering file readers
1151
1152		- if you supply and unknown type value (or Imager probes and finds
1153		one) then Imager will attempt to load "Imager::File::\Utypecode" (this
1154		can register a file reader.)
1155
1156		- note: these changes may mean slightly different errors if you call
1157		read_multi() with no file or type parameters, since read_multi() now
1158		attempts to do the same file format probe that read() does.
1159
1160		------------------------------------------------------------------------
1161		r961 \| tony \| 2006-03-24 00:41:56 +1100 (Fri, 24 Mar 2006) \| 5 lines
1162		Changed paths:
1163		M /trunk/Imager/image.c
1164		M /trunk/Imager/imager.h
1165		M /trunk/Imager/t/t1000files.t
1166		M /trunk/Imager/tga.c
1167
1168		- i_test_format_probe() now attempts to detect MS Windows Icon/cursor files
1169
1170		- made the TGA probe a bit more specific since it was giving false
1171		positives on icon files.
1172
1173		------------------------------------------------------------------------
1174		r960 \| tony \| 2006-03-22 12:01:15 +1100 (Wed, 22 Mar 2006) \| 8 lines
1175		Changed paths:
1176		M /trunk/Imager/Imager.xs
1177		M /trunk/Imager/MANIFEST
1178		M /trunk/Imager/imdatatypes.h
1179		M /trunk/Imager/imperl.h
1180		M /trunk/Imager/iolayer.c
1181		M /trunk/Imager/iolayer.h
1182		A /trunk/Imager/iolayert.h
1183
1184		More iolayers work:
1185
1186		- rename the callback types
1187		- move types and the call macros into iolayer.t
1188		- move typedef for Imager__IO to imperl.h
1189
1190		so now io glue objects can be used from XS/Inline
1191
1192		------------------------------------------------------------------------
1193		r957 \| tony \| 2006-03-16 16:41:10 +1100 (Thu, 16 Mar 2006) \| 6 lines
1194		Changed paths:
1195		M /trunk/Imager/Imager.xs
1196		M /trunk/Imager/iolayer.c
1197		M /trunk/Imager/iolayer.h
1198		M /trunk/Imager/t/t07iolayer.t
1199
1200		more iolayer goodness:
1201
1202		- make write/read/seek/close on an IO object visible as methods from perl
1203
1204		- allow SEEK_CUR on bufchains
1205
1206		------------------------------------------------------------------------
1207		r956 \| tony \| 2006-03-15 23:49:49 +1100 (Wed, 15 Mar 2006) \| 3 lines
1208		Changed paths:
1209		M /trunk/Imager/Imager.xs
1210		M /trunk/Imager/iolayer.c
1211		M /trunk/Imager/iolayer.h
1212
1213		io_glue_destroy() now uses an extra callback to handle type specific
1214		destruction, instead of switching on "class"
1215
1216		------------------------------------------------------------------------
1217		r955 \| tony \| 2006-03-15 23:08:47 +1100 (Wed, 15 Mar 2006) \| 7 lines
1218		Changed paths:
1219		M /trunk/Imager/iolayer.c
1220		M /trunk/Imager/iolayer.h
1221
1222		iolayer modifications:
1223
1224		- move private types and functions into iolayers.c
1225
1226		- make each layer "new" function do the initialization that
1227		io_commit_types() was doing.
1228
1229		------------------------------------------------------------------------
1230		r954 \| tony \| 2006-03-15 22:32:59 +1100 (Wed, 15 Mar 2006) \| 2 lines
1231		Changed paths:
1232		M /trunk/Imager/MANIFEST
1233
1234		fixed incorrect filename for t/t93podcover.t in MANIFEST
1235
1236		------------------------------------------------------------------------
1237		r953 \| tony \| 2006-03-14 11:50:09 +1100 (Tue, 14 Mar 2006) \| 6 lines
1238		Changed paths:
1239		M /trunk/Imager/Imager.pm
1240
1241		remove the reference to IRC from SUPPORT, I'm not paying enough
1242		attention there for it to be useful. Yes, there is a channel, but the
1243		mailing list/perlmonks/direct email/cpanratings are more likely to get
1244		you some help.
1245
1246
1247		------------------------------------------------------------------------
1248		r952 \| tony \| 2006-03-13 13:46:48 +1100 (Mon, 13 Mar 2006) \| 3 lines
1249		Changed paths:
1250		M /trunk/Imager/Imager.pm
1251		M /trunk/Imager/t/t101jpeg.t
1252
1253		prevent the parseiptc method from warning when there's no IPTC data to
1254		process
1255
1256		------------------------------------------------------------------------
1257		r951 \| tony \| 2006-03-13 12:58:44 +1100 (Mon, 13 Mar 2006) \| 2 lines
1258		Changed paths:
1259		M /trunk/Imager
1260		M /trunk/Imager/MANIFEST
1261		A /trunk/Imager/t/Pod
1262		A /trunk/Imager/t/Pod/Coverage
1263		A /trunk/Imager/t/Pod/Coverage/Imager.pm
1264		M /trunk/Imager/t/t101jpeg.t
1265		A /trunk/Imager/t/t93podcover.t
1266
1267		POD coverage tests, as a TODO for now
1268
1269		------------------------------------------------------------------------
1270		r950 \| tony \| 2006-03-12 00:16:47 +1100 (Sun, 12 Mar 2006) \| 2 lines
1271		Changed paths:
1272		M /trunk/Imager/Imager.pm
1273		M /trunk/Imager/Imager.xs
1274		M /trunk/Imager/log.c
1275		M /trunk/Imager/log.h
1276		M /trunk/Imager/t/t50basicoo.t
1277
1278		rename some private functions to private names
1279
1280		------------------------------------------------------------------------
1281		r949 \| tony \| 2006-03-09 11:56:19 +1100 (Thu, 09 Mar 2006) \| 3 lines
1282		Changed paths:
1283		M /trunk/Imager/io.c
1284
1285		malloc_state() no longer writes to stdout when Imager is built without
1286		memory debugging
1287
1288		------------------------------------------------------------------------
1289		r948 \| tony \| 2006-03-08 23:11:41 +1100 (Wed, 08 Mar 2006) \| 2 lines
1290		Changed paths:
1291		M /trunk/Imager/TODO
1292
1293		initial targets for 0.50
1294
1295		------------------------------------------------------------------------
1296		r947 \| tony \| 2006-03-08 22:56:41 +1100 (Wed, 08 Mar 2006) \| 7 lines
1297		Changed paths:
1298		M /trunk/Imager/t/t82inline.t
1299
1300		Skip Inline tests when we're in a directory containing spaces in the
1301		path, since Inline itself errors out when used in such a directory.
1302		See #4150.
1303
1304		Fixes: 18049.
1305
1306
1307		------------------------------------------------------------------------
1308		r946 \| tony \| 2006-03-07 23:06:50 +1100 (Tue, 07 Mar 2006) \| 2 lines
1309		Changed paths:
1310		M /trunk/Imager/png.c
1311
1312		removed unreachable code (mymalloc() succeeds or exit()s)
1313
1314		------------------------------------------------------------------------
1315		r945 \| tony \| 2006-03-07 23:01:38 +1100 (Tue, 07 Mar 2006) \| 2 lines
1316		Changed paths:
1317		M /trunk/Imager/Makefile.PL
1318
1319		Actually get the changes in the right order.
1320
1321		------------------------------------------------------------------------
1322		r944 \| tony \| 2006-03-07 22:54:01 +1100 (Tue, 07 Mar 2006) \| 5 lines
1323		Changed paths:
1324		D /trunk/Imager/Changes
1325		A /trunk/Imager/Changes.old (from /trunk/Imager/Changes:943)
1326		M /trunk/Imager/MANIFEST
1327		M /trunk/Imager/Makefile.PL
1328
1329		New changes will be listed most recent first, and is generated from
1330		svn log.
1331
1332		Changes for older revisions of Imager can be found in Changes.old.
1333
1334		------------------------------------------------------------------------
	200	Imager 0.51 - 23 Apr 2006
	201	===========
	202
	203	- fix a validation bug when processing JPEG EXIF data that can cause
	204	a crash
	205	http://rt.cpan.org/Public/Bug/Display.html?id=18496
	206
	207	- fix mis-processing of the src_maxx and src_maxy parameters of the
	208	paste() method
	209	http://rt.cpan.org/Public/Bug/Display.html?id=18712
	210
	211	- fix a problem in Imager's "smart" handling of the color parameter
	212	to various methods.
	213	http://rt.cpan.org/Public/Bug/Display.html?id=18561
	214
	215
	216	Imager 0.50 - 29 Mar 2006
	217	===========
	218
	219	- CRITICAL: fixes a segmentation fault from attempting to write a 2
	220	or 4 channel image to jpeg or a 2 channel image to tga where the
	221	output is an in-memeory buffer.
	222	http://rt.cpan.org/Public/Bug/Display.html?id=18397
	223
	224	- fixes an incorrect pointer parameter in the PNG code
	225	http://rt.cpan.org/Public/Bug/Display.html?id=18051
	226
	227	- skip Inline::C tests when building in a directory with spaces
	228	http://rt.cpan.org/Public/Bug/Display.html?id=18049⏎

+0

-1

CountColor/t/t00countcolor.t less more

0	0	#!perl -w
1	1	use strict;
2	2	use blib;
3		use lib '../t';
4	3	use Imager;
5	4	use Test::More tests => 9;
6	5

+0

-1

DynTest/t/t00dyntest.t less more

0	0	#!perl -w
1	1	use strict;
2	2	use blib;
3		use lib '../t';
4	3	use Imager;
5	4	use Test::More tests => 4;
6	5

+0

-1

Flines/t/t00flines.t less more

0	0	#!perl -w
1	1	use strict;
2	2	use blib;
3		use lib '../t';
4	3	use Imager;
5	4	use Test::More tests => 3;
6	5

+0

-1

ICO/t/t10icon.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib '../t';
3	2	use Test::More tests => 94;
4	3
5	4	BEGIN { use_ok('Imager::File::ICO'); }

+0

-1

ICO/t/t20readone.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib '../t';
3	2	use Test::More tests => 1;
4	3	use Imager;
5	4

+0

-1

ICO/t/t21readmult.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib '../t';
3	2	use Test::More tests => 1;
4	3	use Imager;
5	4

+0

-1

ICO/t/t30cursor.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib '../t';
3	2	use Test::More tests => 25;
4	3
5	4	BEGIN { use_ok('Imager::File::CUR'); }

+0

-1

ICO/t/t40readcurone.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib '../t';
3	2	use Test::More tests => 1;
4	3	use Imager;
5	4

+0

-1

ICO/t/t41curmultread.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib '../t';
3	2	use Test::More tests => 1;
4	3	use Imager;
5	4

+0

-1

ICO/t/t50readfail.t less more

0	0	#!perl -w
1	1	use strict;
2	2	use Imager;
3		use lib '../t';
4	3	use Test::More tests => 40;
5	4
6	5	sub get_data;

+0

-1

ICO/t/t60writefail.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib '../t';
3	2	use Test::More tests => 69;
4	3	use Imager ':handy';
5	4

+0

-1

ICO/t/t70icosing.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib '../t';
3	2	use Test::More tests => 1;
4	3	use Imager;
5	4	require '../t/testtools.pl';

+0

-1

ICO/t/t71icomult.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib '../t';
3	2	use Test::More tests => 1;
4	3	use Imager;
5	4	require '../t/testtools.pl';

+0

-1

ICO/t/t72cursing.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib '../t';
3	2	use Test::More tests => 1;
4	3	use Imager;
5	4	require '../t/testtools.pl';

+0

-1

ICO/t/t73curmult.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib '../t';
3	2	use Test::More tests => 1;
4	3	use Imager;
5	4	require '../t/testtools.pl';

+9

-7

Imager.pm less more

154	154	BEGIN {
155	155	require Exporter;
156	156	@ISA = qw(Exporter);
157		$VERSION = '0.54';
	157	$VERSION = '0.56';
158	158	eval {
159	159	require XSLoader;
160	160	XSLoader::load(Imager => $VERSION);

1268	1268	return $self;
1269	1269	}
1270	1270
	1271	my $allow_incomplete = $input{allow_incomplete};
	1272	defined $allow_incomplete or $allow_incomplete = 0;
	1273
1271	1274	if ( $input{'type'} eq 'tiff' ) {
1272	1275	my $page = $input{'page'};
1273	1276	defined $page or $page = 0;
1274		# Fixme, check if that length parameter is ever needed
1275		$self->{IMG}=i_readtiff_wiol( $IO, -1, $page );
	1277	$self->{IMG}=i_readtiff_wiol( $IO, $allow_incomplete, $page );
1276	1278	if ( !defined($self->{IMG}) ) {
1277	1279	$self->{ERRSTR}=$self->_error_as_msg(); return undef;
1278	1280	}

1281	1283	}
1282	1284
1283	1285	if ( $input{'type'} eq 'pnm' ) {
1284		$self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
	1286	$self->{IMG}=i_readpnm_wiol( $IO, $allow_incomplete );
1285	1287	if ( !defined($self->{IMG}) ) {
1286	1288	$self->{ERRSTR}='unable to read pnm image: '._error_as_msg();
1287	1289	return undef;

1300	1302	}
1301	1303
1302	1304	if ( $input{'type'} eq 'bmp' ) {
1303		$self->{IMG}=i_readbmp_wiol( $IO );
	1305	$self->{IMG}=i_readbmp_wiol( $IO, $allow_incomplete );
1304	1306	if ( !defined($self->{IMG}) ) {
1305	1307	$self->{ERRSTR}=$self->_error_as_msg();
1306	1308	return undef;

1674	1676	$self->_set_opts(\%input, "bmp_", $self)
1675	1677	or return undef;
1676	1678	if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
1677		$self->{ERRSTR}='unable to write bmp image';
	1679	$self->{ERRSTR} = $self->_error_as_msg;
1678	1680	return undef;
1679	1681	}
1680	1682	$self->{DEBUG} && print "writing a bmp file\n";

3253	3255	unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
3254	3256
3255	3257	my %input=('x'=>0, 'y'=>0, @_);
3256		$input{string}\|\|=$input{text};
	3258	defined($input{string}) or $input{string} = $input{text};
3257	3259
3258	3260	unless(defined $input{string}) {
3259	3261	$self->{ERRSTR}="missing required parameter 'string'";

+53

-24

Imager.xs less more

436	436	size -= cbd->used - cbd->where;
437	437	out += cbd->used - cbd->where;
438	438	if (size < sizeof(cbd->buffer)) {
439		int did_read;
	439	int did_read = 0;
440	440	int copy_size;
441	441	while (size
442	442	&& (did_read = call_reader(cbd, cbd->buffer, size,

534	534	{ "webmap", mc_web_map, },
535	535	{ "addi", mc_addi, },
536	536	{ "mediancut", mc_median_cut, },
	537	{ "mono", mc_mono, },
	538	{ "monochrome", mc_mono, },
537	539	};
538	540
539	541	static struct value_name translate_names[] =

2249	2251	#ifdef HAVE_LIBTIFF
2250	2252
2251	2253	Imager::ImgRaw
2252		i_readtiff_wiol(ig, length, page=0)
	2254	i_readtiff_wiol(ig, allow_incomplete, page=0)
2253	2255	Imager::IO ig
2254		int length
	2256	int allow_incomplete
2255	2257	int page
2256	2258
2257	2259	void

2880	2882
2881	2883
2882	2884	Imager::ImgRaw
2883		i_readpnm_wiol(ig, length)
	2885	i_readpnm_wiol(ig, allow_incomplete)
2884	2886	Imager::IO ig
2885		int length
	2887	int allow_incomplete
2886	2888
2887	2889
2888	2890	undef_int

2911	2913	Imager::IO ig
2912	2914
2913	2915	Imager::ImgRaw
2914		i_readbmp_wiol(ig)
	2916	i_readbmp_wiol(ig, allow_incomplete=0)
2915	2917	Imager::IO ig
	2918	int allow_incomplete
2916	2919
2917	2920
2918	2921	undef_int

3564	3567	PREINIT:
3565	3568	i_palidx *work;
3566	3569	int i;
3567		STRLEN len;
3568		int count;
3569	3570	CODE:
3570	3571	if (items > 3) {
3571	3572	work = mymalloc(sizeof(i_palidx) * (items-3));

3590	3591	SV *data
3591	3592	PREINIT:
3592	3593	i_palidx const *work;
3593		int i;
3594	3594	STRLEN len;
3595		int count;
3596	3595	CODE:
3597	3596	work = (i_palidx const *)SvPV(data, len);
3598	3597	len /= sizeof(i_palidx);

4191	4190	#ifdef HAVE_WIN32
4192	4191
4193	4192	void
4194		i_wf_bbox(face, size, text)
	4193	i_wf_bbox(face, size, text_sv, utf8=0)
4195	4194	char *face
4196	4195	int size
4197		char *text
	4196	SV *text_sv
	4197	int utf8
4198	4198	PREINIT:
4199	4199	int cords[BOUNDING_BOX_COUNT];
4200	4200	int rc, i;
	4201	char const *text;
	4202	STRLEN text_len;
4201	4203	PPCODE:
4202		if (rc = i_wf_bbox(face, size, text, strlen(text), cords)) {
	4204	text = SvPV(text_sv, text_len);
	4205	#ifdef SvUTF8
	4206	if (SvUTF8(text_sv))
	4207	utf8 = 1;
	4208	#endif
	4209	if (rc = i_wf_bbox(face, size, text, text_len, cords, utf8)) {
4203	4210	EXTEND(SP, rc);
4204	4211	for (i = 0; i < rc; ++i)
4205	4212	PUSHs(sv_2mortal(newSViv(cords[i])));
4206	4213	}
4207	4214
4208	4215	undef_int
4209		i_wf_text(face, im, tx, ty, cl, size, text, align, aa)
	4216	i_wf_text(face, im, tx, ty, cl, size, text_sv, align, aa, utf8 = 0)
4210	4217	char *face
4211	4218	Imager::ImgRaw im
4212	4219	int tx
4213	4220	int ty
4214	4221	Imager::Color cl
4215	4222	int size
4216		char *text
	4223	SV *text_sv
4217	4224	int align
4218	4225	int aa
	4226	int utf8
	4227	PREINIT:
	4228	char const *text;
	4229	STRLEN text_len;
4219	4230	CODE:
4220		RETVAL = i_wf_text(face, im, tx, ty, cl, size, text, strlen(text),
4221		align, aa);
	4231	text = SvPV(text_sv, text_len);
	4232	#ifdef SvUTF8
	4233	if (SvUTF8(text_sv))
	4234	utf8 = 1;
	4235	#endif
	4236	RETVAL = i_wf_text(face, im, tx, ty, cl, size, text, text_len,
	4237	align, aa, utf8);
4222	4238	OUTPUT:
4223	4239	RETVAL
4224	4240
4225	4241	undef_int
4226		i_wf_cp(face, im, tx, ty, channel, size, text, align, aa)
	4242	i_wf_cp(face, im, tx, ty, channel, size, text_sv, align, aa, utf8 = 0)
4227	4243	char *face
4228	4244	Imager::ImgRaw im
4229	4245	int tx
4230	4246	int ty
4231	4247	int channel
4232	4248	int size
4233		char *text
	4249	SV *text_sv
4234	4250	int align
4235	4251	int aa
	4252	int utf8
	4253	PREINIT:
	4254	char const *text;
	4255	STRLEN text_len;
4236	4256	CODE:
4237		RETVAL = i_wf_cp(face, im, tx, ty, channel, size, text, strlen(text),
4238		align, aa);
	4257	text = SvPV(text_sv, text_len);
	4258	#ifdef SvUTF8
	4259	if (SvUTF8(text_sv))
	4260	utf8 = 1;
	4261	#endif
	4262	RETVAL = i_wf_cp(face, im, tx, ty, channel, size, text, text_len,
	4263	align, aa, utf8);
4239	4264	OUTPUT:
4240	4265	RETVAL
4241	4266

4389	4414	RETVAL
4390	4415
4391	4416	undef_int
4392		i_ft2_cp(font, im, tx, ty, channel, cheight, cwidth, text, align, aa, vlayout, utf8)
	4417	i_ft2_cp(font, im, tx, ty, channel, cheight, cwidth, text_sv, align, aa, vlayout, utf8)
4393	4418	Imager::Font::FT2 font
4394	4419	Imager::ImgRaw im
4395	4420	int tx

4397	4422	int channel
4398	4423	double cheight
4399	4424	double cwidth
4400		char *text
	4425	SV *text_sv
4401	4426	int align
4402	4427	int aa
4403	4428	int vlayout
4404	4429	int utf8
	4430	PREINIT:
	4431	char const *text;
	4432	STRLEN len;
4405	4433	CODE:
4406	4434	#ifdef SvUTF8
4407	4435	if (SvUTF8(ST(7)))
4408	4436	utf8 = 1;
4409	4437	#endif
	4438	text = SvPV(text_sv, len);
4410	4439	RETVAL = i_ft2_cp(font, im, tx, ty, channel, cheight, cwidth, text,
4411		strlen(text), align, aa, vlayout, 1);
	4440	len, align, aa, vlayout, 1);
4412	4441	OUTPUT:
4413	4442	RETVAL
4414	4443

+17

-2

MANIFEST less more

116	116	imgdouble.c Implements double/sample images
117	117	imio.h
118	118	imperl.h
	119	imrender.h Buffer rending engine function declarations
119	120	imtoc.perl Sample size adapter pre-processor
120	121	io.c
121	122	iolayer.c

150	151	lib/Imager/Inline.pod Using Imager with Inline::C
151	152	lib/Imager/Matrix2d.pm
152	153	lib/Imager/Regops.pm
	154	lib/Imager/Test.pm
153	155	lib/Imager/Transform.pm
154	156	lib/Imager/Transformations.pod
155	157	lib/Imager/Tutorial.pod

171	173	regmach.c
172	174	regmach.h
173	175	regops.perl
	176	render.im
	177	rendert.h Buffer rendering engine types
174	178	rgb.c Reading and writing SGI rgb files
175	179	rotate.c
176	180	rubthru.im

178	182	samples/align-string.pl Demonstrate align_string method.
179	183	samples/anaglyph.pl
180	184	samples/border.pl Demonstrate adding a border
	185	samples/flasher.pl Animate an source image fading to a color and back
181	186	samples/inline_capture2image.pl convert captured BGR data to an image
182	187	samples/inline_replace_color.pl replace colors using Inline::C
183	188	samples/interleave.pl

195	200	stackmach.c
196	201	stackmach.h
197	202	t/Pod/Coverage/Imager.pm
198		t/Test/Builder.pm
199		t/Test/More.pm
200	203	t/t00basic.t
201	204	t/t01introvert.t
202	205	t/t020masked.t

271	274	testimg/badused1.bmp 1-bit/pixel, out of range colors used value
272	275	testimg/badused4a.bmp 4-bit/pixel, badly out of range used value (SEGV test)
273	276	testimg/badused4b.bmp 4-bit/pixel, just out of range used value (SEGV test)
	277	testimg/bad_asc.pbm ASCII PBM with invalid image data
	278	testimg/bad_asc.pgm ASCII PGM with invalid image data
	279	testimg/bad_asc.ppm ASCII PPM with invalid image data
274	280	testimg/bandw.gif
275	281	testimg/base.jpg Base JPEG test image
276	282	testimg/comp4.bmp Compressed 4-bit/pixel BMP

295	301	testimg/palette.png
296	302	testimg/palette_out.png
297	303	testimg/penguin-base.ppm
	304	testimg/pgm.pgm Simple pgm for testing the right sample is in the right place
298	305	testimg/scale.gif
299	306	testimg/scale.ppm
300	307	testimg/scalei.gif

310	317	testimg/short4rle.bmp truncated 4bit/pixel compressed BMP
311	318	testimg/short8.bmp 8-bit/pixel, data missing from EOF
312	319	testimg/short8rle.bmp 8-bit/pixel compressed, data missing from EOF
	320	testimg/short_asc.pbm ASCII PBM with short image section
	321	testimg/short_asc.pgm ASCII PGM with short image section
	322	testimg/short_asc.ppm ASCII PPM with short image section
	323	testimg/short_bin.pbm Bin PBM with short image section
	324	testimg/short_bin.pgm Bin PGM with short image section
	325	testimg/short_bin.ppm Bin PPM with short image section
	326	testimg/short_bin16.pgm 16-bit Bin PGM with short image section
	327	testimg/short_bin16.ppm 16-bit Bin PPM with short image section
313	328	testimg/simple.pbm
314	329	testimg/slab.tif Lab color image
315	330	testimg/srgb.tif Simple RGB image

+7

-2

META.yml less more

0	0	--- #YAML:1.0
1	1	name: Imager
2		version: 0.54
	2	version: 0.56
3	3	version_from: Imager.pm
4	4	author: Tony Cook <tony@imager.perl.org>, Arnar M. Hrafnkelsson
5	5	abstract: Perl extension for Generating 24 bit Images
6	6	installdirs: site
7	7	recommends:
8	8	Parse::RecDescent: 0
	9	requires:
	10	Test::More: 0.47
9	11	license: perl
10	12	dynamic_config: 1
11	13	distribution_type: module
12		generated_by: Imager version 0.54
	14	meta-spec:
	15	version: 1.3
	16	url: http://module-build.sourceforge.net/META-spec-v1.3.html
	17	generated_by: Imager version 0.56

+28

-32

Makefile.PL less more

38	38	my $noprobe; # non-zero to disable newer probes
39	39	my $noexif; # non-zero to disable EXIF parsing of JPEGs
40	40	my $no_gif_set_version; # disable calling EGifSetGifVersion
	41	my $coverage; # build for coverage testing
41	42	GetOptions("help" => \$help,
42	43	"enable=s" => \@enable,
43	44	"disable=s" => \@disable,

47	48	"verbose\|v" => \$VERBOSE,
48	49	"nolog" => \$NOLOG,
49	50	"noexif" => \$noexif,
50		"nogifsetversion" => \$no_gif_set_version);
	51	"nogifsetversion" => \$no_gif_set_version,
	52	'coverage' => \$coverage);
51	53
52	54	if ($VERBOSE) {
53	55	print "Verbose mode\n";

83	85
84	86	init(); # initialize global data
85	87	pathcheck(); # Check if directories exist
86		distcheck(); # for building dists
87	88
88	89	if (exists $ENV{IM_ENABLE}) {
89	90	my %en = map { $_, 1 } split ' ', $ENV{IM_ENABLE};

156	157	regmach.o trans2.o quant.o error.o convert.o
157	158	map.o tags.o palimg.o maskimg.o img16.o rotate.o
158	159	bmp.o tga.o rgb.o color.o fills.o imgdouble.o limits.o hlines.o
159		imext.o scale.o rubthru.o);
	160	imext.o scale.o rubthru.o render.o);
160	161
161	162	$Recommends{Imager} =
162	163	{ 'Parse::RecDescent' => 0 };

170	171	'OBJECT' => join(' ', @objs, $F_OBJECT),
171	172	clean => { FILES=>'testout meta.tmp rubthru.c scale.c' },
172	173	PM => gen_PM(),
	174	PREREQ_PM => { 'Test::More' => 0.47 },
173	175	);
	176
	177	if ($coverage) {
	178	if ($Config{gccversion}) {
	179	push @ARGV, 'OPTIMIZE=-ftest-coverage -fprofile-arcs';
	180	#$opts{dynamic_lib} = { OTHERLDFLAGS => '-ftest-coverage -fprofile-arcs' };
	181	}
	182	else {
	183	die "Don't know the coverage C flags for your compiler\n";
	184	}
	185	}
174	186
175	187	# eval to prevent warnings about versions with _ in them
176	188	my $MM_ver = eval $ExtUtils::MakeMaker::VERSION;

397	409	if ($^O =~ /win32/i && $Config{cc} =~ /\bcl\b/i) {
398	410	push(@incs, split /;/, $ENV{INCLUDE}) if exists $ENV{INCLUDE};
399	411	}
	412	if ($Config{incpath}) {
	413	push @incs, grep -d, split /\Q$Config{path_sep}/, $Config{incpath};
	414	}
400	415	push @incs, grep -d,
401	416	qw(/sw/include
402	417	/usr/include/freetype2

466	481	def=>'HAVE_LIBPNG',
467	482	inccheck=>sub { -e catfile($_[0], 'png.h') },
468	483	libcheck=>sub { $_[0] eq "libpng$aext" or $_[0] eq "libpng.$lext" },
469		libfiles=>'-lpng -lz',
	484	libfiles=>$^O eq 'MSWin32' ? '-lpng -lzlib' : '-lpng -lz',
470	485	objfiles=>'png.o',
471	486	docs=>q{
472	487	Png stands for Portable Network Graphics and is intended as

851	866	$meta .= " $module: $version\n";
852	867	}
853	868	}
	869	if ($opts->{PREREQ_PM}) {
	870	$meta .= "requires:\n";
	871	while (my ($module, $version) = each %{$opts->{PREREQ_PM}}) {
	872	$meta .= " $module: $version\n";
	873	}
	874	}
854	875	$meta .= <<YAML;
855	876	license: perl
856	877	dynamic_config: 1
857	878	distribution_type: module
	879	meta-spec:
	880	version: 1.3
	881	url: http://module-build.sourceforge.net/META-spec-v1.3.html
858	882	generated_by: $opts->{NAME} version $version
859	883	YAML
860	884	my $save_meta;

875	899	}
876	900	}
877	901
878		# this is intended to only be running on the development
879		# machines
880		sub distcheck {
881		if (-e '.svn') {
882		# update Changes if needed
883		my $write_changes;
884		# get the last revision from Changes
885		if (open CHANGES, "< Changes") {
886		<CHANGES>;
887		my ($changes_rev) = <CHANGES> =~ /^r(\d+)/
888		or ++$write_changes;
889
890		my ($revision) = grep s/^Revision: //, `svn info`
891		or die "Could not get Revision from svn";
892		chomp $revision;
893
894		$write_changes \|\|= $changes_rev != $revision;
895		close CHANGES;
896		}
897		else {
898		++$write_changes;
899		}
900		if ($write_changes) {
901		print "Updating Changes file\n";
902		system 'svn log -v -r HEAD:943 >Changes';
903		}
904		}
905		}

+142

-58

bmp.c less more

44	44	static int write_24bit_data(io_glue ig, i_img im);
45	45	static int read_bmp_pal(io_glue ig, i_img im, int count);
46	46	static i_img read_1bit_bmp(io_glue ig, int xsize, int ysize, int clr_used,
47		int compression, long offbits);
	47	int compression, long offbits, int allow_incomplete);
48	48	static i_img read_4bit_bmp(io_glue ig, int xsize, int ysize, int clr_used,
49		int compression, long offbits);
	49	int compression, long offbits, int allow_incomplete);
50	50	static i_img read_8bit_bmp(io_glue ig, int xsize, int ysize, int clr_used,
51		int compression, long offbits);
	51	int compression, long offbits, int allow_incomplete);
52	52	static i_img read_direct_bmp(io_glue ig, int xsize, int ysize,
53	53	int bit_count, int clr_used, int compression,
54		long offbits);
	54	long offbits, int allow_incomplete);
55	55
56	56	/*
57	57	=item i_writebmp_wiol(im, io_glue)

101	101	*/
102	102
103	103	i_img *
104		i_readbmp_wiol(io_glue *ig) {
	104	i_readbmp_wiol(io_glue *ig, int allow_incomplete) {
105	105	int b_magic, m_magic, filesize, res1, res2, infohead_size;
106	106	int xsize, ysize, planes, bit_count, compression, size_image, xres, yres;
107	107	int clr_used, clr_important, offbits;

117	117	&xsize, &ysize, &planes,
118	118	&bit_count, &compression, &size_image, &xres, &yres,
119	119	&clr_used, &clr_important)) {
120		i_push_error(0, "file too short");
	120	i_push_error(0, "file too short to be a BMP file");
121	121	return 0;
122	122	}
123	123	if (b_magic != 'B' \|\| m_magic != 'M' \|\| infohead_size != INFOHEAD_SIZE

132	132	bit_count, compression, size_image, xres, yres, clr_used,
133	133	clr_important));
134	134
135		if (!i_int_check_image_file_limits(xsize, ysize, 3, sizeof(i_sample_t))) {
	135	if (!i_int_check_image_file_limits(xsize, abs(ysize), 3, sizeof(i_sample_t))) {
136	136	mm_log((1, "i_readbmp_wiol: image size exceeds limits\n"));
137	137	return NULL;
138	138	}
139	139
140	140	switch (bit_count) {
141	141	case 1:
142		im = read_1bit_bmp(ig, xsize, ysize, clr_used, compression, offbits);
	142	im = read_1bit_bmp(ig, xsize, ysize, clr_used, compression, offbits,
	143	allow_incomplete);
143	144	break;
144	145
145	146	case 4:
146		im = read_4bit_bmp(ig, xsize, ysize, clr_used, compression, offbits);
	147	im = read_4bit_bmp(ig, xsize, ysize, clr_used, compression, offbits,
	148	allow_incomplete);
147	149	break;
148	150
149	151	case 8:
150		im = read_8bit_bmp(ig, xsize, ysize, clr_used, compression, offbits);
	152	im = read_8bit_bmp(ig, xsize, ysize, clr_used, compression, offbits,
	153	allow_incomplete);
151	154	break;
152	155
153	156	case 32:
154	157	case 24:
155	158	case 16:
156	159	im = read_direct_bmp(ig, xsize, ysize, bit_count, clr_used, compression,
157		offbits);
	160	offbits, allow_incomplete);
158	161	break;
159	162
160	163	default:

662	665	*/
663	666	static i_img *
664	667	read_1bit_bmp(io_glue *ig, int xsize, int ysize, int clr_used,
665		int compression, long offbits) {
	668	int compression, long offbits, int allow_incomplete) {
666	669	i_img *im;
667		int x, y, lasty, yinc;
	670	int x, y, lasty, yinc, start_y;
668	671	i_palidx line, p;
669	672	unsigned char *packed;
670	673	int line_size = (xsize + 7)/8;

689	692	line_size = (line_size+3) / 4 * 4;
690	693
691	694	if (ysize > 0) {
692		y = ysize-1;
	695	start_y = ysize-1;
693	696	lasty = -1;
694	697	yinc = -1;
695	698	}
696	699	else {
697	700	/* when ysize is -ve it's a top-down image */
698	701	ysize = -ysize;
699		y = 0;
	702	start_y = 0;
700	703	lasty = ysize;
701	704	yinc = 1;
702	705	}
	706	y = start_y;
703	707	if (!clr_used)
704	708	clr_used = 2;
705	709	if (clr_used < 0 \|\| clr_used > 2) {

743	747	if (ig->readcb(ig, packed, line_size) != line_size) {
744	748	myfree(packed);
745	749	myfree(line);
746		i_push_error(0, "failed reading 1-bit bmp data");
747		i_img_destroy(im);
748		return NULL;
	750	if (allow_incomplete) {
	751	i_tags_setn(&im->tags, "i_incomplete", 1);
	752	i_tags_setn(&im->tags, "i_lines_read", abs(start_y - y));
	753	return im;
	754	}
	755	else {
	756	i_push_error(0, "failed reading 1-bit bmp data");
	757	i_img_destroy(im);
	758	return NULL;
	759	}
749	760	}
750	761	in = packed;
751	762	bit = 0x80;

781	792	*/
782	793	static i_img *
783	794	read_4bit_bmp(io_glue *ig, int xsize, int ysize, int clr_used,
784		int compression, long offbits) {
	795	int compression, long offbits, int allow_incomplete) {
785	796	i_img *im;
786	797	int x, y, lasty, yinc;
787	798	i_palidx line, p;

790	801	unsigned char *in;
791	802	int size, i;
792	803	long base_offset;
	804	int starty;
793	805
794	806	/* line_size is going to be smaller than xsize in most cases (and
795	807	when it's not, xsize is itself small), and hence not overflow */
796	808	line_size = (line_size+3) / 4 * 4;
797	809
798	810	if (ysize > 0) {
799		y = ysize-1;
	811	starty = ysize-1;
800	812	lasty = -1;
801	813	yinc = -1;
802	814	}
803	815	else {
804	816	/* when ysize is -ve it's a top-down image */
805	817	ysize = -ysize;
806		y = 0;
	818	starty = 0;
807	819	lasty = ysize;
808	820	yinc = 1;
809	821	}
	822	y = starty;
810	823	if (!clr_used)
811	824	clr_used = 16;
812	825

855	868	if (ig->readcb(ig, packed, line_size) != line_size) {
856	869	myfree(packed);
857	870	myfree(line);
858		i_push_error(0, "failed reading 4-bit bmp data");
859		i_img_destroy(im);
860		return NULL;
	871	if (allow_incomplete) {
	872	i_tags_setn(&im->tags, "i_incomplete", 1);
	873	i_tags_setn(&im->tags, "i_lines_read", abs(y - starty));
	874	return im;
	875	}
	876	else {
	877	i_push_error(0, "failed reading 4-bit bmp data");
	878	i_img_destroy(im);
	879	return NULL;
	880	}
861	881	}
862	882	in = packed;
863	883	p = line;

883	903	if (ig->readcb(ig, packed, 2) != 2) {
884	904	myfree(packed);
885	905	myfree(line);
886		i_push_error(0, "missing data during decompression");
887		i_img_destroy(im);
888		return NULL;
	906	if (allow_incomplete) {
	907	i_tags_setn(&im->tags, "i_incomplete", 1);
	908	i_tags_setn(&im->tags, "i_lines_read", abs(y - starty));
	909	return im;
	910	}
	911	else {
	912	i_push_error(0, "missing data during decompression");
	913	i_img_destroy(im);
	914	return NULL;
	915	}
889	916	}
890	917	else if (packed[0]) {
891	918	line[0] = packed[1] >> 4;

913	940	if (ig->readcb(ig, packed, 2) != 2) {
914	941	myfree(packed);
915	942	myfree(line);
916		i_push_error(0, "missing data during decompression");
917		i_img_destroy(im);
918		return NULL;
	943	if (allow_incomplete) {
	944	i_tags_setn(&im->tags, "i_incomplete", 1);
	945	i_tags_setn(&im->tags, "i_lines_read", abs(y - starty));
	946	return im;
	947	}
	948	else {
	949	i_push_error(0, "missing data during decompression");
	950	i_img_destroy(im);
	951	return NULL;
	952	}
919	953	}
920	954	x += packed[0];
921	955	y += yinc * packed[1];

928	962	if (ig->readcb(ig, packed, read_size) != read_size) {
929	963	myfree(packed);
930	964	myfree(line);
931		i_push_error(0, "missing data during decompression");
932		/i_img_destroy(im);/
933		return im;
	965	if (allow_incomplete) {
	966	i_tags_setn(&im->tags, "i_incomplete", 1);
	967	i_tags_setn(&im->tags, "i_lines_read", abs(y - starty));
	968	return im;
	969	}
	970	else {
	971	i_push_error(0, "missing data during decompression");
	972	i_img_destroy(im);
	973	return NULL;
	974	}
934	975	}
935	976	for (i = 0; i < size; ++i) {
936	977	line[0] = packed[i] >> 4;

955	996	}
956	997
957	998	/*
958		=item read_8bit_bmp(ig, xsize, ysize, clr_used, compression)
	999	=item read_8bit_bmp(ig, xsize, ysize, clr_used, compression, allow_incomplete)
959	1000
960	1001	Reads in the palette and image data for a 8-bit/pixel image.
961	1002

965	1006	*/
966	1007	static i_img *
967	1008	read_8bit_bmp(io_glue *ig, int xsize, int ysize, int clr_used,
968		int compression, long offbits) {
	1009	int compression, long offbits, int allow_incomplete) {
969	1010	i_img *im;
970		int x, y, lasty, yinc;
	1011	int x, y, lasty, yinc, start_y;
971	1012	i_palidx *line;
972	1013	int line_size = xsize;
973	1014	long base_offset;

979	1020	}
980	1021
981	1022	if (ysize > 0) {
982		y = ysize-1;
	1023	start_y = ysize-1;
983	1024	lasty = -1;
984	1025	yinc = -1;
985	1026	}
986	1027	else {
987	1028	/* when ysize is -ve it's a top-down image */
988	1029	ysize = -ysize;
989		y = 0;
	1030	start_y = 0;
990	1031	lasty = ysize;
991	1032	yinc = 1;
992	1033	}
	1034	y = start_y;
993	1035	if (!clr_used)
994	1036	clr_used = 256;
995	1037	if (clr_used > 256 \|\| clr_used < 0) {

1031	1073	while (y != lasty) {
1032	1074	if (ig->readcb(ig, line, line_size) != line_size) {
1033	1075	myfree(line);
1034		i_push_error(0, "failed reading 8-bit bmp data");
1035		i_img_destroy(im);
1036		return NULL;
	1076	if (allow_incomplete) {
	1077	i_tags_setn(&im->tags, "i_incomplete", 1);
	1078	i_tags_setn(&im->tags, "i_lines_read", abs(start_y - y));
	1079	return im;
	1080	}
	1081	else {
	1082	i_push_error(0, "failed reading 8-bit bmp data");
	1083	i_img_destroy(im);
	1084	return NULL;
	1085	}
1037	1086	}
1038	1087	i_ppal(im, 0, xsize, y, line);
1039	1088	y += yinc;

1051	1100	/* there's always at least 2 bytes in a sequence */
1052	1101	if (ig->readcb(ig, packed, 2) != 2) {
1053	1102	myfree(line);
1054		i_push_error(0, "missing data during decompression");
1055		i_img_destroy(im);
1056		return NULL;
	1103	if (allow_incomplete) {
	1104	i_tags_setn(&im->tags, "i_incomplete", 1);
	1105	i_tags_setn(&im->tags, "i_lines_read", abs(start_y-y));
	1106	return im;
	1107	}
	1108	else {
	1109	i_push_error(0, "missing data during decompression");
	1110	i_img_destroy(im);
	1111	return NULL;
	1112	}
1057	1113	}
1058	1114	if (packed[0]) {
1059	1115	memset(line, packed[1], packed[0]);

1073	1129	case BMPRLE_DELTA:
1074	1130	if (ig->readcb(ig, packed, 2) != 2) {
1075	1131	myfree(line);
1076		i_push_error(0, "missing data during decompression");
1077		i_img_destroy(im);
1078		return NULL;
	1132	if (allow_incomplete) {
	1133	i_tags_setn(&im->tags, "i_incomplete", 1);
	1134	i_tags_setn(&im->tags, "i_lines_read", abs(start_y-y));
	1135	return im;
	1136	}
	1137	else {
	1138	i_push_error(0, "missing data during decompression");
	1139	i_img_destroy(im);
	1140	return NULL;
	1141	}
1079	1142	}
1080	1143	x += packed[0];
1081	1144	y += yinc * packed[1];

1086	1149	read_size = (count+1) / 2 * 2;
1087	1150	if (ig->readcb(ig, line, read_size) != read_size) {
1088	1151	myfree(line);
1089		i_push_error(0, "missing data during decompression");
1090		i_img_destroy(im);
1091		return NULL;
	1152	if (allow_incomplete) {
	1153	i_tags_setn(&im->tags, "i_incomplete", 1);
	1154	i_tags_setn(&im->tags, "i_lines_read", abs(start_y-y));
	1155	return im;
	1156	}
	1157	else {
	1158	i_push_error(0, "missing data during decompression");
	1159	i_img_destroy(im);
	1160	return NULL;
	1161	}
1092	1162	}
1093	1163	i_ppal(im, x, x+count, y, line);
1094	1164	x += count;

1128	1198	};
1129	1199
1130	1200	/*
1131		=item read_direct_bmp(ig, xsize, ysize, bit_count, clr_used, compression)
	1201	=item read_direct_bmp(ig, xsize, ysize, bit_count, clr_used, compression, allow_incomplete)
1132	1202
1133	1203	Skips the palette and reads in the image data for a direct colour image.
1134	1204

1138	1208	*/
1139	1209	static i_img *
1140	1210	read_direct_bmp(io_glue *ig, int xsize, int ysize, int bit_count,
1141		int clr_used, int compression, long offbits) {
	1211	int clr_used, int compression, long offbits,
	1212	int allow_incomplete) {
1142	1213	i_img *im;
1143		int x, y, lasty, yinc;
	1214	int x, y, starty, lasty, yinc;
1144	1215	i_color line, p;
1145	1216	int pix_size = bit_count / 8;
1146	1217	int line_size = xsize * pix_size;

1160	1231	extras = line_size - xsize * pix_size;
1161	1232
1162	1233	if (ysize > 0) {
1163		y = ysize-1;
	1234	starty = ysize-1;
1164	1235	lasty = -1;
1165	1236	yinc = -1;
1166	1237	}
1167	1238	else {
1168	1239	/* when ysize is -ve it's a top-down image */
1169	1240	ysize = -ysize;
1170		y = 0;
	1241	starty = 0;
1171	1242	lasty = ysize;
1172	1243	yinc = 1;
1173	1244	}
	1245	y = starty;
1174	1246	if (compression == BI_RGB) {
1175	1247	compression_name = "BI_RGB";
1176	1248	masks = std_masks[pix_size-2];

1210	1282	return NULL;
1211	1283	}
1212	1284
	1285	if (offbits < base_offset) {
	1286	i_push_errorf(0, "image data offset too small (%ld)", offbits);
	1287	return NULL;
	1288	}
	1289
1213	1290	if (offbits > base_offset) {
1214	1291	/* this will be slow if the offset is large, but that should be
1215	1292	rare */

1243	1320	for (x = 0; x < xsize; ++x) {
1244	1321	unsigned pixel;
1245	1322	if (!read_packed(ig, unpack_code, &pixel)) {
1246		i_push_error(0, "failed reading image data");
1247	1323	myfree(line);
1248		i_img_destroy(im);
1249		return NULL;
	1324	if (allow_incomplete) {
	1325	i_tags_setn(&im->tags, "i_incomplete", 1);
	1326	i_tags_setn(&im->tags, "i_lines_read", abs(starty - y));
	1327	return im;
	1328	}
	1329	else {
	1330	i_push_error(0, "failed reading image data");
	1331	i_img_destroy(im);
	1332	return NULL;
	1333	}
1250	1334	}
1251	1335	for (i = 0; i < 3; ++i) {
1252	1336	if (masks.shifts[i] > 0)

+2

-2

color.c less more

32	32	=cut
33	33	*/
34	34	void i_rgb_to_hsvf(i_fcolor *color) {
35		double h, s, v;
	35	double h = 0, s, v;
36	36	double temp;
37	37	double Cr, Cg, Cb;
38	38

73	73	=cut
74	74	*/
75	75	void i_rgb_to_hsv(i_color *color) {
76		double h, s, v;
	76	double h = 0, s, v;
77	77	double temp;
78	78	double Cr, Cg, Cb;
79	79

+27

-6

fills.c less more

620	620	fill->base.fill_with_color = fill_hatch;
621	621	fill->base.fill_with_fcolor = fill_hatchf;
622	622	fill->base.destroy = NULL;
623		fill->fg = fg ? *fg : fcolor_to_color(ffg);
624		fill->bg = bg ? *bg : fcolor_to_color(fbg);
625		fill->ffg = ffg ? *ffg : color_to_fcolor(fg);
626		fill->fbg = fbg ? *fbg : color_to_fcolor(bg);
	623	/* Some Sun C didn't like the condition expressions that were here.
	624	See https://rt.cpan.org/Ticket/Display.html?id=21944
	625	*/
	626	if (fg)
	627	fill->fg = *fg;
	628	else
	629	fill->fg = fcolor_to_color(ffg);
	630	if (bg)
	631	fill->bg = *bg;
	632	else
	633	fill->bg = fcolor_to_color(fbg);
	634	if (ffg)
	635	fill->ffg = *ffg;
	636	else
	637	fill->ffg = color_to_fcolor(fg);
	638	if (fbg)
	639	fill->fbg = *fbg;
	640	else
	641	fill->fbg = color_to_fcolor(bg);
627	642	if (combine) {
628	643	i_get_combine(combine, &fill->base.combine, &fill->base.combinef);
629	644	}

660	675	int mask = 128 >> xpos;
661	676
662	677	while (width-- > 0) {
663		*data++ = (byte & mask) ? f->fg : f->bg;
	678	if (byte & mask)
	679	*data++ = f->fg;
	680	else
	681	*data++ = f->bg;
664	682
665	683	if ((mask >>= 1) == 0)
666	684	mask = 128;

682	700	int mask = 128 >> xpos;
683	701
684	702	while (width-- > 0) {
685		*data++ = (byte & mask) ? f->ffg : f->fbg;
	703	if (byte & mask)
	704	*data++ = f->ffg;
	705	else
	706	*data++ = f->fbg;
686	707
687	708	if ((mask >>= 1) == 0)
688	709	mask = 128;

+2

-1

font.c less more

1945	1945	printf("'%s'\n", name);
1946	1946	}
1947	1947	}
	1948	fflush(stdout);
1948	1949	}
1949	1950
1950	1951	int

1965	1966	}
1966	1967
1967	1968	if (handle->load_cond) {
1968		i_push_errorf(rc, "error loading names (%d)", handle->load_cond);
	1969	i_push_errorf(handle->load_cond, "error loading names (%d)", handle->load_cond);
1969	1970	return 0;
1970	1971	}
1971	1972

+20

-13

freetyp2.c less more

326	326	FT_Glyph_Metrics *gm;
327	327	int start = 0;
328	328	int loadFlags = FT_LOAD_DEFAULT;
329		int rightb;
	329	int rightb = 0;
330	330
331	331	mm_log((1, "i_ft2_bbox(handle %p, cheight %f, cwidth %f, text %p, len %d, bbox %p)\n",
332	332	handle, cheight, cwidth, text, len, bbox));

644	644	int ch;
645	645	i_color pel;
646	646	int loadFlags = FT_LOAD_DEFAULT;
	647	i_render render;
647	648
648	649	mm_log((1, "i_ft2_text(handle %p, im %p, tx %d, ty %d, cl %p, cheight %f, cwidth %f, text %p, len %d, align %d, aa %d)\n",
649	650	handle, im, tx, ty, cl, cheight, cwidth, text, align, aa));

661	662	/* set the base-line based on the string ascent */
662	663	if (!i_ft2_bbox(handle, cheight, cwidth, text, len, bbox, utf8))
663	664	return 0;
	665
	666	if (aa)
	667	i_render_init(&render, im, bbox[BBOX_POS_WIDTH] - bbox[BBOX_NEG_WIDTH]);
664	668
665	669	if (!align) {
666	670	/* this may need adjustment */

687	691	ft2_push_message(error);
688	692	i_push_errorf(0, "loading glyph for character \\x%02x (glyph 0x%04X)",
689	693	c, index);
	694	if (aa)
	695	i_render_done(&render);
690	696	return 0;
691	697	}
692	698	slot = handle->face->glyph;

697	703	if (error) {
698	704	ft2_push_message(error);
699	705	i_push_errorf(0, "rendering glyph 0x%04X (character \\x%02X)");
	706	if (aa)
	707	i_render_done(&render);
700	708	return 0;
701	709	}
702	710	if (slot->bitmap.pixel_mode == ft_pixel_mode_mono) {

727	735	last_mode = slot->bitmap.pixel_mode;
728	736	last_grays = slot->bitmap.num_grays;
729	737	}
730
	738
731	739	bmp = slot->bitmap.buffer;
732	740	for (y = 0; y < slot->bitmap.rows; ++y) {
733		for (x = 0; x < slot->bitmap.width; ++x) {
734		int value = map[bmp[x]];
735		if (value) {
736		i_gpix(im, tx+x+slot->bitmap_left, ty+y-slot->bitmap_top, &pel);
737		for (ch = 0; ch < im->channels; ++ch) {
738		pel.channel[ch] =
739		((255-value)pel.channel[ch] + value cl->channel[ch]) / 255;
740		}
741		i_ppix(im, tx+x+slot->bitmap_left, ty+y-slot->bitmap_top, &pel);
742		}
743		}
	741	if (last_mode == ft_pixel_mode_grays &&
	742	last_grays != 255) {
	743	for (x = 0; x < slot->bitmap.width; ++x)
	744	bmp[x] = map[bmp[x]];
	745	}
	746	i_render_color(&render, tx + slot->bitmap_left, ty-slot->bitmap_top+y,
	747	slot->bitmap.width, bmp, cl);
744	748	bmp += slot->bitmap.pitch;
745	749	}
746	750	}

749	753	tx += slot->advance.x / 64;
750	754	ty -= slot->advance.y / 64;
751	755	}
	756
	757	if (aa)
	758	i_render_done(&render);
752	759
753	760	return 1;
754	761	}

+14

-14

gif.c less more

0	0	#include "imageri.h"
1	1	#include <gif_lib.h>
2		#ifdef _MSCVER
	2	#ifdef _MSC_VER
3	3	#include <io.h>
4	4	#else
5	5	#include <unistd.h>

518	518
519	519	GifRowType GifRow;
520	520	int got_gce = 0;
521		int trans_index; /* transparent index if we see a GCE */
522		int gif_delay; /* delay from a GCE */
523		int user_input; /* user input flag from a GCE */
524		int disposal; /* disposal method from a GCE */
	521	int trans_index = 0; /* transparent index if we see a GCE */
	522	int gif_delay = 0; /* delay from a GCE */
	523	int user_input = 0; /* user input flag from a GCE */
	524	int disposal = 0; /* disposal method from a GCE */
525	525	int got_ns_loop = 0;
526		int ns_loop;
	526	int ns_loop = 0;
527	527	char comment = NULL; / a comment */
528	528	i_img **results = NULL;
529	529	int result_alloc = 0;

747	747	else
748	748	trans_index = -1;
749	749	gif_delay = Extension[2] + 256 * Extension[3];
750		user_input = (Extension[0] & 2) != 0;
751		disposal = (Extension[0] >> 2) & 3;
	750	user_input = (Extension[1] & 2) != 0;
	751	disposal = (Extension[1] >> 2) & 7;
752	752	}
753	753	if (ExtCode == 0xFF && *Extension == 11) {
754	754	if (memcmp(Extension+1, "NETSCAPE2.0", 11) == 0) {

1659	1659
1660	1660	static undef_int
1661	1661	i_writegif_low(i_quantize quant, GifFileType gf, i_img **imgs, int count) {
1662		unsigned char *result;
	1662	unsigned char *result = NULL;
1663	1663	int color_bits;
1664	1664	ColorMapObject *map;
1665	1665	int scrw = 0, scrh = 0;
1666	1666	int imgn, orig_count, orig_size;
1667	1667	int posx, posy;
1668		int trans_index;
	1668	int trans_index = -1;
1669	1669	i_mempool mp;
1670	1670	int *localmaps;
1671	1671	int anylocal;

1673	1673	int glob_img_count;
1674	1674	i_color *orig_colors = quant->mc_colors;
1675	1675	i_color *glob_colors = NULL;
1676		int glob_color_count;
	1676	int glob_color_count = 0;
1677	1677	int glob_want_trans;
1678		int glob_paletted; /* the global map was made from the image palettes */
1679		int colors_paletted;
1680		int want_trans;
	1678	int glob_paletted = 0; /* the global map was made from the image palettes */
	1679	int colors_paletted = 0;
	1680	int want_trans = 0;
1681	1681	int interlace;
1682	1682	int gif_background;
1683	1683

+73

-4

image.c less more

2152	2152	return NULL;
2153	2153	}
2154	2154
2155
2156
2157
2158		/*
	2155	/*
	2156	=item i_img_is_monochrome(img, &zero_is_white)
	2157
	2158	Tests an image to check it meets our monochrome tests.
	2159
	2160	The idea is that a file writer can use this to test where it should
	2161	write the image in whatever bi-level format it uses, eg. pbm for pnm.
	2162
	2163	For performance of encoders we require monochrome images:
	2164
	2165	=over
	2166
	2167	=item *
	2168
	2169	be paletted
	2170
	2171	=item *
	2172
	2173	have a palette of two colors, containing only (0,0,0) and
	2174	(255,255,255) in either order.
	2175
2159	2176	=back
2160	2177
	2178	zero_is_white is set to non-zero iff the first palette entry is white.
	2179
	2180	=cut
	2181	*/
	2182
	2183	int
	2184	i_img_is_monochrome(i_img im, int zero_is_white) {
	2185	if (im->type == i_palette_type
	2186	&& i_colorcount(im) == 2) {
	2187	i_color colors[2];
	2188	i_getcolors(im, 0, colors, 2);
	2189	if (im->channels == 3) {
	2190	if (colors[0].rgb.r == 255 &&
	2191	colors[0].rgb.g == 255 &&
	2192	colors[0].rgb.b == 255 &&
	2193	colors[1].rgb.r == 0 &&
	2194	colors[1].rgb.g == 0 &&
	2195	colors[1].rgb.b == 0) {
	2196	*zero_is_white = 0;
	2197	return 1;
	2198	}
	2199	else if (colors[0].rgb.r == 0 &&
	2200	colors[0].rgb.g == 0 &&
	2201	colors[0].rgb.b == 0 &&
	2202	colors[1].rgb.r == 255 &&
	2203	colors[1].rgb.g == 255 &&
	2204	colors[1].rgb.b == 255) {
	2205	*zero_is_white = 1;
	2206	return 1;
	2207	}
	2208	}
	2209	else if (im->channels == 1) {
	2210	if (colors[0].channel[0] == 255 &&
	2211	colors[1].channel[1] == 0) {
	2212	*zero_is_white = 0;
	2213	return 1;
	2214	}
	2215	else if (colors[0].channel[0] == 0 &&
	2216	colors[0].channel[0] == 255) {
	2217	*zero_is_white = 1;
	2218	return 1;
	2219	}
	2220	}
	2221	}
	2222
	2223	*zero_is_white = 0;
	2224	return 0;
	2225	}
	2226
	2227	/*
	2228	=back
	2229
2161	2230	=head1 AUTHOR
2162	2231
2163	2232	Arnar M. Hrafnkelsson <addi@umich.edu>

+10

-7

imager.h less more

275	275
276	276	#ifdef WIN32
277	277
278		extern int i_wf_bbox(const char face, int size, const char text, int length, int *bbox);
	278	extern int i_wf_bbox(const char face, int size, const char text, int length, int *bbox, int utf8);
279	279	extern int i_wf_text(const char face, i_img im, int tx, int ty, const i_color *cl,
280		int size, const char *text, int len, int align, int aa);
	280	int size, const char *text, int len, int align, int aa, int utf8);
281	281	extern int i_wf_cp(const char face, i_img im, int tx, int ty, int channel,
282		int size, const char *text, int len, int align, int aa);
	282	int size, const char *text, int len, int align, int aa, int utf8);
283	283	extern int i_wf_addfont(char const *file);
284	284
285	285	#endif

351	351	extern i_img *i_img_double_new(int x, int y, int ch);
352	352	extern i_img i_img_double_new_low(i_img im, int x, int y, int ch);
353	353
	354	extern int i_img_is_monochrome(i_img im, int zero_is_white);
354	355
355	356	const char * i_test_format_probe(io_glue *data, int length);
356	357

362	363	#endif /* HAVE_LIBJPEG */
363	364
364	365	#ifdef HAVE_LIBTIFF
365		i_img * i_readtiff_wiol(io_glue *ig, int length, int page);
	366	i_img * i_readtiff_wiol(io_glue *ig, int allow_incomplete, int page);
366	367	i_img ** i_readtiff_multi_wiol(io_glue ig, int length, int count);
367	368	undef_int i_writetiff_wiol(i_img im, io_glue ig);
368	369	undef_int i_writetiff_multi_wiol(io_glue ig, i_img *imgs, int count);

400	401	i_img * i_readraw_wiol(io_glue *ig, int x, int y, int datachannels, int storechannels, int intrl);
401	402	undef_int i_writeraw_wiol(i_img* im, io_glue *ig);
402	403
403		i_img * i_readpnm_wiol(io_glue *ig, int length);
	404	i_img * i_readpnm_wiol(io_glue *ig, int allow_incomplete);
404	405	undef_int i_writeppm_wiol(i_img im, io_glue ig);
405	406
406	407	extern int i_writebmp_wiol(i_img im, io_glue ig);
407		extern i_img i_readbmp_wiol(io_glue ig);
	408	extern i_img i_readbmp_wiol(io_glue ig, int allow_incomplete);
408	409
409	410	int tga_header_verify(unsigned char headbuf[18]);
410	411

559	560
560	561	#endif /* IMAGER_MALLOC_DEBUG */
561	562
562		#endif
	563	#include "imrender.h"
	564
	565	#endif

+3

-0

imdatatypes.h less more

386	386	mc_web_map, /* Use the 216 colour web colour map */
387	387	mc_addi, /* Addi's algorithm */
388	388	mc_median_cut, /* median cut - similar to giflib, hopefully */
	389	mc_mono, /* fixed mono color map */
389	390	mc_mask = 0xFF /* (mask for generator) */
390	391	} i_make_colors;
391	392

517	518
518	519	#include "iolayert.h"
519	520
	521	#include "rendert.h"
	522
520	523	#endif
521	524

+10

-4

imexif.c less more

228	228	static int tiff_load_ifd(imtiff *tiff, unsigned long offset);
229	229	static void tiff_final(imtiff *tiff);
230	230	static void tiff_clear_ifd(imtiff *tiff);
	231	#if 0 /* currently unused, but that may change */
231	232	static int tiff_get_bytes(imtiff tiff, unsigned char to, size_t offset,
232	233	size_t count);
	234	#endif
233	235	static int tiff_get_tag_double(imtiff , int index, double result);
234	236	static int tiff_get_tag_int(imtiff , int index, int result);
235	237	static unsigned tiff_get16(imtiff *, unsigned long offset);

1411	1413	+ 0x10000 * tiff->base[offset+1] + 0x1000000 * tiff->base[offset];
1412	1414	}
1413	1415
	1416	#if 0 /* currently unused, but that may change */
	1417
1414	1418	/*
1415	1419	=item tiff_get_bytes
1416	1420

1432	1436
1433	1437	return 1;
1434	1438	}
	1439
	1440	#endif
1435	1441
1436	1442	/*
1437	1443	=item tiff_get16s

1551	1557
1552	1558	=head1 REVISION
1553	1559
1554		$Revision: 1016 $
1555
1556		=cut
1557		*/
	1560	$Revision: 1117 $
	1561
	1562	=cut
	1563	*/

+14

-0

imrender.h less more

	0	#ifndef IMAGER_IMRENDER_H
	1	#define IMAGER_IMRENDER_H
	2
	3	#include "rendert.h"
	4
	5	extern void
	6	i_render_init(i_render r, i_img im, int width);
	7	extern void
	8	i_render_done(i_render *r);
	9	extern void
	10	i_render_color(i_render r, int x, int y, int width, unsigned char const src,
	11	i_color const *color);
	12
	13	#endif

+6

-1

io.c less more

350	350	This doesn't support the extended UTF8 encoding used by later versions
351	351	of Perl.
352	352
	353	This doesn't check that the UTF8 charecter is using the shortest
	354	possible representation.
	355
353	356	=cut
354	357	*/
355	358
356		unsigned long i_utf8_advance(char const *p, int len) {
	359	unsigned long
	360	i_utf8_advance(char const *p, int len) {
357	361	unsigned char c;
358	362	int i, ci, clen = 0;
359	363	unsigned char codes[3];

364	368	for (i = 0; i < sizeof(utf8_sizes)/sizeof(*utf8_sizes); ++i) {
365	369	if ((c & utf8_sizes[i].mask) == utf8_sizes[i].expect) {
366	370	clen = utf8_sizes[i].size;
	371	break;
367	372	}
368	373	}
369	374	if (clen == 0 \|\| *len < clen-1) {

+76

-29

lib/Imager/Files.pod less more

45	45	$img->read(file=>$filename, type=>$type)
46	46	or die "Cannot read $filename: ", $img->errstr;
47	47
	48	In most cases Imager can auto-detect the file type, so you can just
	49	supply the filename:
	50
	51	$img->read(file => $filename)
	52	or die "Cannot read $filename: ", $img->errstr;
	53
	54	The read() method accepts the C<allow_partial> parameter. If this is
	55	non-zero then read() can return true on an incomplete image and set
	56	the C<i_incomplete> tag.
	57
48	58	=item write
49	59
50	60	and the C<write()> method to write an image:

60	70	my @imgs = Imager->read_multi(file=>$filename, type=>$type)
61	71	or die "Cannot read $filename: ", Imager->errstr;
62	72
	73	As with the read() method, Imager will normally detect the C<type>
	74	automatically.
	75
63	76	=item write_multi
64	77
65	78	and if you want to write multiple images to a single file use the

70	83
71	84	=back
72	85
73		If the I<filename> includes an extension that Imager recognizes, then
74		you don't need the I<type>, but you may want to provide one anyway.
75		See L</Guessing types> for information on controlling this
76		recognition.
	86	When writing, if the I<filename> includes an extension that Imager
	87	recognizes, then you don't need the I<type>, but you may want to
	88	provide one anyway. See L</Guessing types> for information on
	89	controlling this recognition.
77	90
78	91	The C<type> parameter is a lowercase representation of the file type,
79	92	and can be any of the following:

101	114
102	115	=over
103	116
104		=item file
105
106		The C<file> parameter is the name of the image file to be written to
107		or read from. If Imager recognizes the extension of the file you do
108		not need to supply a C<type>.
	117	=item *
	118
	119	file - The C<file> parameter is the name of the image file to be
	120	written to or read from. If Imager recognizes the extension of the
	121	file you do not need to supply a C<type>.
109	122
110	123	# write in tiff format
111	124	$image->write(file => "example.tif")

118	131	$image->read(file => 'example.tif')
119	132	or die $image->errstr;
120	133
121		=item fh
122
123		C<fh> is a file handle, typically either returned from
	134	=item
	135
	136	fh - C<fh> is a file handle, typically either returned from
124	137	C<<IO::File->new()>>, or a glob from an C<open> call. You should call
125	138	C<binmode> on the handle before passing it to Imager.
126	139

135	148	$image->read(fd => $cgi->param('file'))
136	149	or die $image->errstr;
137	150
138		=item fd
139
140		C<fd> is a file descriptor. You can get this by calling the
	151	=item
	152
	153	fd - C<fd> is a file descriptor. You can get this by calling the
141	154	C<fileno()> function on a file handle, or by using one of the standard
142	155	file descriptor numbers.
143	156

148	161	$image->write(fd => file(STDOUT), type => 'gif')
149	162	or die $image->errstr;
150	163
151		=item data
152
153		When reading data, C<data> is a scalar containing the image file data,
154		when writing, C<data> is a reference to the scalar to save the image
155		file data too. For GIF images you will need giflib 4 or higher, and
156		you may need to patch giflib to use this option for writing.
	164	=item
	165
	166	data - When reading data, C<data> is a scalar containing the image
	167	file data, when writing, C<data> is a reference to the scalar to save
	168	the image file data too. For GIF images you will need giflib 4 or
	169	higher, and you may need to patch giflib to use this option for
	170	writing.
157	171
158	172	my $data;
159	173	$image->write(data => \$data, type => 'tiff')

163	177	my @images = Imager->read_multi(data => $data)
164	178	or die Imager->errstr;
165	179
166		=item callback
167
168		Imager will make calls back to your supplied coderefs to read, write
169		and seek from/to/through the image file.
	180	=item *
	181
	182	callback - Imager will make calls back to your supplied coderefs to
	183	read, write and seek from/to/through the image file.
170	184
171	185	When reading from a file you can use either C<callback> or C<readcb>
172	186	to supply the read callback, and when writing C<callback> or

351	365
352	366	PNM does not support the spatial resolution tags.
353	367
	368	The following tags are set when reading a PNM file:
	369
	370	=over
	371
	372	=item *
	373
	374	X<pnm_maxval>pnm_maxval - the maxvals number from the PGM/PPM header.
	375	Always set to 2 for a PBM file.
	376
	377	=item *
	378
	379	X<pnm_type>pnm_type - the type number from the PNM header, 1 for ASCII
	380	PBM files, 2 for ASCII PGM files, 3 for ASCII PPM files, 4 for binary
	381	PBM files, 5 for binary PGM files, 6 for binary PPM files.
	382
	383	=back
	384
	385	The following tag is checked when writing an image with more than
	386	8-bits/sample:
	387
	388	=over
	389
	390	=item *
	391
	392	X<pnm_write_wide_data>pnm_write_wide_data - if this is non-zero then
	393	write() can write PGM/PPM files with 16-bits/sample. Some
	394	applications, for example GIMP 2.2, and tools can only read
	395	8-bit/sample binary PNM files, so Imager will only write a 16-bit
	396	image when this tag is non-zero.
	397
	398	=back
	399
354	400	=head2 JPEG
355	401
356	402	You can supply a C<jpegquality> parameter (0-100) when writing a JPEG

372	418	=item jpeg_density_unit
373	419
374	420	The value of the density unit field in the JFIF header. This is
375		ignored on writing if the i_aspect_only tag is non-zero.
	421	ignored on writing if the C<i_aspect_only> tag is non-zero.
376	422
377	423	The C<i_xres> and C<i_yres> tags are expressed in pixels per inch no
378	424	matter the value of this tag, they will be converted to/from the value

563	609
564	610	=item gif_loop
565	611
566		the number of loops from the Netscape Loop extension. This may be zero.
	612	the number of loops from the Netscape Loop extension. This may be
	613	zero to loop forever.
567	614
568	615	=item gif_comment
569	616

739	786	names in the TIFF specification. These are set in images read from a
740	787	TIFF and saved when writing a TIFF image.
741	788
	789	=back
	790
742	791	You can supply a C<page> parameter to the C<read()> method to read
743	792	some page other than the first. The page is 0 based:
744	793
745	794	# read the second image in the file
746	795	$image->read(file=>"example.tif", page=>1)
747	796	or die "Cannot read second page: ",$image->errstr,"\n";
748
749		=back
750	797
751	798	Note: Imager uses the TIFFRGBA family of libtiff functions,
752	799	unfortunately these don't support alpha channels on CMYK images. This

+28

-6

lib/Imager/Filters.pod less more

135	135	truncate the range by the specified fraction at the top and bottom of
136	136	the range respectivly.
137	137
138		# increase contrast, losing little detail
	138	# increase contrast per channel, losing little detail
139	139	$img->filter(type=>"autolevels")
140	140	or die $img->errstr;
141	141

477	477
478	478	=item unsharpmask
479	479
480		performs an unsharp mask on the image. This is the result of
481		subtracting a gaussian blurred version of the image from the original.
482		I<stddev> controls the stddev parameter of the gaussian blur. Each
483		output pixel is: in + I<scale> * (in - blurred).
	480	performs an unsharp mask on the image. This increases the contrast of
	481	edges in the image.
	482
	483	This is the result of subtracting a gaussian blurred version of the
	484	image from the original. I<stddev> controls the stddev parameter of
	485	the gaussian blur. Each output pixel is: in + I<scale> * (in -
	486	blurred).
484	487
485	488	$img->filter(type=>"unsharpmask", stddev=>1, scale=>0.5)
486	489	or die $img->errstr;
	490
	491	unsharpmark has the following parameters:
	492
	493	=over
	494
	495	=item *
	496
	497	stddev - this is equivalent to the C<Radius> value in the GIMP's
	498	unsharpmask filter. This controls the size of the contrast increase
	499	around edges, larger values will remove fine detail. You should
	500	probably experiement on the types of images you plan to work with.
	501	Default: 2.0.
	502
	503	=item *
	504
	505	scale - controls the strength of the edge enhancement, equivalent to
	506	I<Amount> in the GIMP's unsharp mask filter. Default: 1.0.
	507
	508	=back
487	509
488	510	=item watermark
489	511

645	667
646	668	=head1 REVISION
647	669
648		$Revision: 978 $
	670	$Revision: 1192 $
649	671
650	672	=cut

+8

-4

lib/Imager/Font/Win32.pm less more

2	2	use vars qw(@ISA $VERSION);
3	3	@ISA = qw(Imager::Font);
4	4
5		$VERSION = "1.004";
	5	$VERSION = "1.005";
6	6
7	7	# called by Imager::Font::new()
8	8	# since Win32's HFONTs include the size information this

16	16	sub _bounding_box {
17	17	my ($self, %opts) = @_;
18	18
19		my @bbox = Imager::i_wf_bbox($self->{face}, $opts{size}, $opts{string});
	19	my @bbox = Imager::i_wf_bbox($self->{face}, $opts{size}, $opts{string}, $opts{utf8});
20	20	}
21	21
22	22	sub _draw {

26	26	if (exists $input{channel}) {
27	27	Imager::i_wf_cp($self->{face}, $input{image}{IMG}, $input{x}, $input{'y'},
28	28	$input{channel}, $input{size},
29		$input{string}, $input{align}, $input{aa});
	29	$input{string}, $input{align}, $input{aa}, $input{utf8});
30	30	}
31	31	else {
32	32	Imager::i_wf_text($self->{face}, $input{image}{IMG}, $input{x},
33	33	$input{'y'}, $input{color}, $input{size},
34		$input{string}, $input{align}, $input{aa});
	34	$input{string}, $input{align}, $input{aa}, $input{utf8});
35	35	}
36	36	}
37	37
	38
	39	sub utf8 {
	40	return 1;
	41	}
38	42
39	43	1;
40	44

+56

-40

lib/Imager/ImageTypes.pod less more

678	678
679	679	=over
680	680
681		=item i_xres
682
683		=item i_yres
684
685		The spatial resolution of the image in pixels per inch. If the image
686		format uses a different scale, eg. pixels per meter, then this value
687		is converted. A floating point number stored as a string.
	681	=item *
	682
	683	X<i_xres tag>X<i_yres tag>X<tags, i_xres>X<tags, i_yres>i_xres, i_yres
	684	- The spatial resolution of the image in pixels per inch. If the
	685	image format uses a different scale, eg. pixels per meter, then this
	686	value is converted. A floating point number stored as a string.
688	687
689	688	# our image was generated as a 300 dpi image
690	689	$img->settag(name => 'i_xres', value => 300);

696	695	$img->settag(name => 'i_xres', value => 100 * 2.54);
697	696	$img->settag(name => 'i_yres', value => 100 * 2.54);
698	697
699		=item i_aspect_only
700
701		If this is non-zero then the values in i_xres and i_yres are treated
702		as a ratio only. If the image format does not support aspect ratios
703		then this is scaled so the smaller value is 72dpi.
704
705		=item i_incomplete
706
707		If this tag is present then the whole image could not be read. This
708		isn't implemented for all images yet, and may not be.
709
710		=item i_format
711
712		The file format this file was read from.
	698	=item *
	699
	700	X<i_aspect_only tag>X<tags, i_aspect_only>i_aspect_only - If this is
	701	non-zero then the values in i_xres and i_yres are treated as a ratio
	702	only. If the image format does not support aspect ratios then this is
	703	scaled so the smaller value is 72dpi.
	704
	705	=item *
	706
	707	X<i_incomplete tag>X<tags, i_incomplete>i_incomplete - If this tag is
	708	present then the whole image could not be read. This isn't
	709	implemented for all images yet, and may not be.
	710
	711	=item *
	712
	713	X<i_lines_read tag>X<tags, i_lines_read>i_lines_read - If
	714	C<i_incomplete> is set then this tag may be set to the number of
	715	scanlines successfully read from the file. This can be used to decide
	716	whether an image is worth processing.
	717
	718	=item *
	719
	720	X<i_format tag>X<tags, i_format>i_format - The file format this file
	721	was read from.
713	722
714	723	=back
715	724
716	725	=head2 Quantization options
717	726
718		These options can be specified when calling write_multi() for gif
719		files, when writing a single image with the gifquant option set to
720		'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
	727	These options can be specified when calling
	728	L<Imager::ImageTypes/to_paletted>, write_multi() for gif files, when
	729	writing a single image with the gifquant option set to 'gen', or for
	730	direct calls to i_writegif_gen and i_writegif_callback.
721	731
722	732	=over
723	733

835	845
836	846	=over
837	847
838		=item none
839
840		Only colors supplied in 'colors' are used.
841
842		=item webmap
843
844		The web color map is used (need url here.)
845
846		=item addi
847
848		The original code for generating the color map (Addi's code) is used.
849
850		=item mediancut
851
852		Uses a mediancut algorithm, faster than 'addi', but not as good a
	848	=item *
	849
	850	none - only colors supplied in 'colors' are used.
	851
	852	=item *
	853
	854	webmap - the web color map is used (need url here.)
	855
	856	=item *
	857
	858	addi - The original code for generating the color map (Addi's code) is
	859	used.
	860
	861	=item *
	862
	863	mediancut - Uses a mediancut algorithm, faster than 'addi', but not as good a
853	864	result.
	865
	866	=item *
	867
	868	mono, monochrome - a fixed black and white palette, suitable for
	869	producing bi-level images (eg. facsimile)
854	870
855	871	=back
856	872

991	1007
992	1008	=head1 REVISION
993	1009
994		$Revision: 1082 $
	1010	$Revision: 1137 $
995	1011
996	1012	=head1 AUTHORS
997	1013

+419

-366

lib/Imager/Regops.pm less more

60	60
61	61	@EXPORT = qw(RBC_ADD RBC_SUBTRACT RBC_MULT RBC_DIV RBC_MOD RBC_POW RBC_UMINUS RBC_MULTP RBC_ADDP RBC_SUBTRACTP RBC_SIN RBC_COS RBC_ATAN2 RBC_SQRT RBC_DISTANCE RBC_GETP1 RBC_GETP2 RBC_GETP3 RBC_VALUE RBC_HUE RBC_SAT RBC_HSV RBC_RED RBC_GREEN RBC_BLUE RBC_RGB RBC_INT RBC_IF RBC_IFP RBC_LE RBC_LT RBC_GE RBC_GT RBC_EQ RBC_NE RBC_AND RBC_OR RBC_NOT RBC_ABS RBC_RET RBC_JUMP RBC_JUMPZ RBC_JUMPNZ RBC_SET RBC_SETP RBC_PRINT RBC_RGBA RBC_HSVA RBC_ALPHA RBC_LOG RBC_EXP RBC_OP_COUNT);
62	62
63		%Attr = (
64		'abs' => {
65		'func' => 1,
66		'opcode' => 38,
67		'parms' => 1,
68		'result' => 'r',
69		'types' => 'r'
70		},
71		'add' => {
72		'func' => 0,
73		'opcode' => 0,
74		'parms' => 2,
75		'result' => 'r',
76		'types' => 'rr'
77		},
78		'addp' => {
79		'func' => 0,
80		'opcode' => 8,
81		'parms' => 2,
82		'result' => 'p',
83		'types' => 'pp'
84		},
85		'alpha' => {
86		'func' => 1,
87		'opcode' => 48,
88		'parms' => 1,
89		'result' => 'r',
90		'types' => 'p'
91		},
92		'and' => {
93		'func' => 0,
94		'opcode' => 35,
95		'parms' => 2,
96		'result' => 'r',
97		'types' => 'rr'
98		},
99		'atan2' => {
100		'func' => 1,
101		'opcode' => 12,
102		'parms' => 2,
103		'result' => 'r',
104		'types' => 'rr'
105		},
106		'blue' => {
107		'func' => 1,
108		'opcode' => 24,
109		'parms' => 1,
110		'result' => 'r',
111		'types' => 'p'
112		},
113		'cos' => {
114		'func' => 1,
115		'opcode' => 11,
116		'parms' => 1,
117		'result' => 'r',
118		'types' => 'r'
119		},
120		'distance' => {
121		'func' => 1,
122		'opcode' => 14,
123		'parms' => 4,
124		'result' => 'r',
125		'types' => 'rrrr'
126		},
127		'div' => {
128		'func' => 0,
129		'opcode' => 3,
130		'parms' => 2,
131		'result' => 'r',
132		'types' => 'rr'
133		},
134		'eq' => {
135		'func' => 0,
136		'opcode' => 33,
137		'parms' => 2,
138		'result' => 'r',
139		'types' => 'rr'
140		},
141		'exp' => {
142		'func' => 1,
143		'opcode' => 50,
144		'parms' => 1,
145		'result' => 'r',
146		'types' => 'r'
147		},
148		'ge' => {
149		'func' => 0,
150		'opcode' => 31,
151		'parms' => 2,
152		'result' => 'r',
153		'types' => 'rr'
154		},
155		'getp1' => {
156		'func' => 1,
157		'opcode' => 15,
158		'parms' => 2,
159		'result' => 'p',
160		'types' => 'rr'
161		},
162		'getp2' => {
163		'func' => 1,
164		'opcode' => 16,
165		'parms' => 2,
166		'result' => 'p',
167		'types' => 'rr'
168		},
169		'getp3' => {
170		'func' => 1,
171		'opcode' => 17,
172		'parms' => 2,
173		'result' => 'p',
174		'types' => 'rr'
175		},
176		'green' => {
177		'func' => 1,
178		'opcode' => 23,
179		'parms' => 1,
180		'result' => 'r',
181		'types' => 'p'
182		},
183		'gt' => {
184		'func' => 0,
185		'opcode' => 32,
186		'parms' => 2,
187		'result' => 'r',
188		'types' => 'rr'
189		},
190		'hsv' => {
191		'func' => 1,
192		'opcode' => 21,
193		'parms' => 3,
194		'result' => 'p',
195		'types' => 'rrr'
196		},
197		'hsva' => {
198		'func' => 1,
199		'opcode' => 47,
200		'parms' => 4,
201		'result' => 'p',
202		'types' => 'rrrr'
203		},
204		'hue' => {
205		'func' => 1,
206		'opcode' => 19,
207		'parms' => 1,
208		'result' => 'r',
209		'types' => 'p'
210		},
211		'if' => {
212		'func' => 1,
213		'opcode' => 27,
214		'parms' => 3,
215		'result' => 'r',
216		'types' => 'rrr'
217		},
218		'ifp' => {
219		'func' => 1,
220		'opcode' => 28,
221		'parms' => 3,
222		'result' => 'p',
223		'types' => 'rpp'
224		},
225		'int' => {
226		'func' => 1,
227		'opcode' => 26,
228		'parms' => 1,
229		'result' => 'r',
230		'types' => 'r'
231		},
232		'jump' => {
233		'func' => 0,
234		'opcode' => 40,
235		'parms' => 0,
236		'result' => undef,
237		'types' => ''
238		},
239		'jumpnz' => {
240		'func' => 0,
241		'opcode' => 42,
242		'parms' => 1,
243		'result' => undef,
244		'types' => 'r'
245		},
246		'jumpz' => {
247		'func' => 0,
248		'opcode' => 41,
249		'parms' => 1,
250		'result' => undef,
251		'types' => 'r'
252		},
253		'le' => {
254		'func' => 0,
255		'opcode' => 29,
256		'parms' => 2,
257		'result' => 'r',
258		'types' => 'rr'
259		},
260		'log' => {
261		'func' => 1,
262		'opcode' => 49,
263		'parms' => 1,
264		'result' => 'r',
265		'types' => 'r'
266		},
267		'lt' => {
268		'func' => 0,
269		'opcode' => 30,
270		'parms' => 2,
271		'result' => 'r',
272		'types' => 'rr'
273		},
274		'mod' => {
275		'func' => 0,
276		'opcode' => 4,
277		'parms' => 2,
278		'result' => 'r',
279		'types' => 'rr'
280		},
281		'mult' => {
282		'func' => 0,
283		'opcode' => 2,
284		'parms' => 2,
285		'result' => 'r',
286		'types' => 'rr'
287		},
288		'multp' => {
289		'func' => 0,
290		'opcode' => 7,
291		'parms' => 2,
292		'result' => 'p',
293		'types' => 'pr'
294		},
295		'ne' => {
296		'func' => 0,
297		'opcode' => 34,
298		'parms' => 2,
299		'result' => 'r',
300		'types' => 'rr'
301		},
302		'not' => {
303		'func' => 0,
304		'opcode' => 37,
305		'parms' => 1,
306		'result' => 'r',
307		'types' => 'r'
308		},
309		'op_count' => {
310		'func' => 0,
311		'opcode' => 51,
312		'parms' => 0,
313		'result' => undef,
314		'types' => ''
315		},
316		'or' => {
317		'func' => 0,
318		'opcode' => 36,
319		'parms' => 2,
320		'result' => 'r',
321		'types' => 'rr'
322		},
323		'pow' => {
324		'func' => 0,
325		'opcode' => 5,
326		'parms' => 2,
327		'result' => 'r',
328		'types' => 'rr'
329		},
330		'print' => {
331		'func' => 0,
332		'opcode' => 45,
333		'parms' => 1,
334		'result' => undef,
335		'types' => 'r'
336		},
337		'red' => {
338		'func' => 1,
339		'opcode' => 22,
340		'parms' => 1,
341		'result' => 'r',
342		'types' => 'p'
343		},
344		'ret' => {
345		'func' => 0,
346		'opcode' => 39,
347		'parms' => 1,
348		'result' => undef,
349		'types' => 'p'
350		},
351		'rgb' => {
352		'func' => 1,
353		'opcode' => 25,
354		'parms' => 3,
355		'result' => 'p',
356		'types' => 'rrr'
357		},
358		'rgba' => {
359		'func' => 1,
360		'opcode' => 46,
361		'parms' => 4,
362		'result' => 'p',
363		'types' => 'rrrr'
364		},
365		'sat' => {
366		'func' => 1,
367		'opcode' => 20,
368		'parms' => 1,
369		'result' => 'r',
370		'types' => 'p'
371		},
372		'set' => {
373		'func' => 0,
374		'opcode' => 43,
375		'parms' => 1,
376		'result' => 'r',
377		'types' => 'r'
378		},
379		'setp' => {
380		'func' => 0,
381		'opcode' => 44,
382		'parms' => 1,
383		'result' => 'p',
384		'types' => 'p'
385		},
386		'sin' => {
387		'func' => 1,
388		'opcode' => 10,
389		'parms' => 1,
390		'result' => 'r',
391		'types' => 'r'
392		},
393		'sqrt' => {
394		'func' => 1,
395		'opcode' => 13,
396		'parms' => 1,
397		'result' => 'r',
398		'types' => 'r'
399		},
400		'subtract' => {
401		'func' => 0,
402		'opcode' => 1,
403		'parms' => 2,
404		'result' => 'r',
405		'types' => 'rr'
406		},
407		'subtractp' => {
408		'func' => 0,
409		'opcode' => 9,
410		'parms' => 2,
411		'result' => 'p',
412		'types' => 'pp'
413		},
414		'uminus' => {
415		'func' => 0,
416		'opcode' => 6,
417		'parms' => 1,
418		'result' => 'r',
419		'types' => 'r'
420		},
421		'value' => {
422		'func' => 1,
423		'opcode' => 18,
424		'parms' => 1,
425		'result' => 'r',
426		'types' => 'p'
427		}
428		);
	63	%Attr =
	64	(
	65	'abs' =>
	66	{
	67	'func' => 1,
	68	'opcode' => 38,
	69	'parms' => 1,
	70	'result' => 'r',
	71	'types' => 'r',
	72	},
	73	'add' =>
	74	{
	75	'func' => 0,
	76	'opcode' => 0,
	77	'parms' => 2,
	78	'result' => 'r',
	79	'types' => 'rr',
	80	},
	81	'addp' =>
	82	{
	83	'func' => 0,
	84	'opcode' => 8,
	85	'parms' => 2,
	86	'result' => 'p',
	87	'types' => 'pp',
	88	},
	89	'alpha' =>
	90	{
	91	'func' => 1,
	92	'opcode' => 48,
	93	'parms' => 1,
	94	'result' => 'r',
	95	'types' => 'p',
	96	},
	97	'and' =>
	98	{
	99	'func' => 0,
	100	'opcode' => 35,
	101	'parms' => 2,
	102	'result' => 'r',
	103	'types' => 'rr',
	104	},
	105	'atan2' =>
	106	{
	107	'func' => 1,
	108	'opcode' => 12,
	109	'parms' => 2,
	110	'result' => 'r',
	111	'types' => 'rr',
	112	},
	113	'blue' =>
	114	{
	115	'func' => 1,
	116	'opcode' => 24,
	117	'parms' => 1,
	118	'result' => 'r',
	119	'types' => 'p',
	120	},
	121	'cos' =>
	122	{
	123	'func' => 1,
	124	'opcode' => 11,
	125	'parms' => 1,
	126	'result' => 'r',
	127	'types' => 'r',
	128	},
	129	'distance' =>
	130	{
	131	'func' => 1,
	132	'opcode' => 14,
	133	'parms' => 4,
	134	'result' => 'r',
	135	'types' => 'rrrr',
	136	},
	137	'div' =>
	138	{
	139	'func' => 0,
	140	'opcode' => 3,
	141	'parms' => 2,
	142	'result' => 'r',
	143	'types' => 'rr',
	144	},
	145	'eq' =>
	146	{
	147	'func' => 0,
	148	'opcode' => 33,
	149	'parms' => 2,
	150	'result' => 'r',
	151	'types' => 'rr',
	152	},
	153	'exp' =>
	154	{
	155	'func' => 1,
	156	'opcode' => 50,
	157	'parms' => 1,
	158	'result' => 'r',
	159	'types' => 'r',
	160	},
	161	'ge' =>
	162	{
	163	'func' => 0,
	164	'opcode' => 31,
	165	'parms' => 2,
	166	'result' => 'r',
	167	'types' => 'rr',
	168	},
	169	'getp1' =>
	170	{
	171	'func' => 1,
	172	'opcode' => 15,
	173	'parms' => 2,
	174	'result' => 'p',
	175	'types' => 'rr',
	176	},
	177	'getp2' =>
	178	{
	179	'func' => 1,
	180	'opcode' => 16,
	181	'parms' => 2,
	182	'result' => 'p',
	183	'types' => 'rr',
	184	},
	185	'getp3' =>
	186	{
	187	'func' => 1,
	188	'opcode' => 17,
	189	'parms' => 2,
	190	'result' => 'p',
	191	'types' => 'rr',
	192	},
	193	'green' =>
	194	{
	195	'func' => 1,
	196	'opcode' => 23,
	197	'parms' => 1,
	198	'result' => 'r',
	199	'types' => 'p',
	200	},
	201	'gt' =>
	202	{
	203	'func' => 0,
	204	'opcode' => 32,
	205	'parms' => 2,
	206	'result' => 'r',
	207	'types' => 'rr',
	208	},
	209	'hsv' =>
	210	{
	211	'func' => 1,
	212	'opcode' => 21,
	213	'parms' => 3,
	214	'result' => 'p',
	215	'types' => 'rrr',
	216	},
	217	'hsva' =>
	218	{
	219	'func' => 1,
	220	'opcode' => 47,
	221	'parms' => 4,
	222	'result' => 'p',
	223	'types' => 'rrrr',
	224	},
	225	'hue' =>
	226	{
	227	'func' => 1,
	228	'opcode' => 19,
	229	'parms' => 1,
	230	'result' => 'r',
	231	'types' => 'p',
	232	},
	233	'if' =>
	234	{
	235	'func' => 1,
	236	'opcode' => 27,
	237	'parms' => 3,
	238	'result' => 'r',
	239	'types' => 'rrr',
	240	},
	241	'ifp' =>
	242	{
	243	'func' => 1,
	244	'opcode' => 28,
	245	'parms' => 3,
	246	'result' => 'p',
	247	'types' => 'rpp',
	248	},
	249	'int' =>
	250	{
	251	'func' => 1,
	252	'opcode' => 26,
	253	'parms' => 1,
	254	'result' => 'r',
	255	'types' => 'r',
	256	},
	257	'jump' =>
	258	{
	259	'func' => 0,
	260	'opcode' => 40,
	261	'parms' => 0,
	262	'result' => undef,
	263	'types' => '',
	264	},
	265	'jumpnz' =>
	266	{
	267	'func' => 0,
	268	'opcode' => 42,
	269	'parms' => 1,
	270	'result' => undef,
	271	'types' => 'r',
	272	},
	273	'jumpz' =>
	274	{
	275	'func' => 0,
	276	'opcode' => 41,
	277	'parms' => 1,
	278	'result' => undef,
	279	'types' => 'r',
	280	},
	281	'le' =>
	282	{
	283	'func' => 0,
	284	'opcode' => 29,
	285	'parms' => 2,
	286	'result' => 'r',
	287	'types' => 'rr',
	288	},
	289	'log' =>
	290	{
	291	'func' => 1,
	292	'opcode' => 49,
	293	'parms' => 1,
	294	'result' => 'r',
	295	'types' => 'r',
	296	},
	297	'lt' =>
	298	{
	299	'func' => 0,
	300	'opcode' => 30,
	301	'parms' => 2,
	302	'result' => 'r',
	303	'types' => 'rr',
	304	},
	305	'mod' =>
	306	{
	307	'func' => 0,
	308	'opcode' => 4,
	309	'parms' => 2,
	310	'result' => 'r',
	311	'types' => 'rr',
	312	},
	313	'mult' =>
	314	{
	315	'func' => 0,
	316	'opcode' => 2,
	317	'parms' => 2,
	318	'result' => 'r',
	319	'types' => 'rr',
	320	},
	321	'multp' =>
	322	{
	323	'func' => 0,
	324	'opcode' => 7,
	325	'parms' => 2,
	326	'result' => 'p',
	327	'types' => 'pr',
	328	},
	329	'ne' =>
	330	{
	331	'func' => 0,
	332	'opcode' => 34,
	333	'parms' => 2,
	334	'result' => 'r',
	335	'types' => 'rr',
	336	},
	337	'not' =>
	338	{
	339	'func' => 0,
	340	'opcode' => 37,
	341	'parms' => 1,
	342	'result' => 'r',
	343	'types' => 'r',
	344	},
	345	'op_count' =>
	346	{
	347	'func' => 0,
	348	'opcode' => 51,
	349	'parms' => 0,
	350	'result' => undef,
	351	'types' => '',
	352	},
	353	'or' =>
	354	{
	355	'func' => 0,
	356	'opcode' => 36,
	357	'parms' => 2,
	358	'result' => 'r',
	359	'types' => 'rr',
	360	},
	361	'pow' =>
	362	{
	363	'func' => 0,
	364	'opcode' => 5,
	365	'parms' => 2,
	366	'result' => 'r',
	367	'types' => 'rr',
	368	},
	369	'print' =>
	370	{
	371	'func' => 0,
	372	'opcode' => 45,
	373	'parms' => 1,
	374	'result' => undef,
	375	'types' => 'r',
	376	},
	377	'red' =>
	378	{
	379	'func' => 1,
	380	'opcode' => 22,
	381	'parms' => 1,
	382	'result' => 'r',
	383	'types' => 'p',
	384	},
	385	'ret' =>
	386	{
	387	'func' => 0,
	388	'opcode' => 39,
	389	'parms' => 1,
	390	'result' => undef,
	391	'types' => 'p',
	392	},
	393	'rgb' =>
	394	{
	395	'func' => 1,
	396	'opcode' => 25,
	397	'parms' => 3,
	398	'result' => 'p',
	399	'types' => 'rrr',
	400	},
	401	'rgba' =>
	402	{
	403	'func' => 1,
	404	'opcode' => 46,
	405	'parms' => 4,
	406	'result' => 'p',
	407	'types' => 'rrrr',
	408	},
	409	'sat' =>
	410	{
	411	'func' => 1,
	412	'opcode' => 20,
	413	'parms' => 1,
	414	'result' => 'r',
	415	'types' => 'p',
	416	},
	417	'set' =>
	418	{
	419	'func' => 0,
	420	'opcode' => 43,
	421	'parms' => 1,
	422	'result' => 'r',
	423	'types' => 'r',
	424	},
	425	'setp' =>
	426	{
	427	'func' => 0,
	428	'opcode' => 44,
	429	'parms' => 1,
	430	'result' => 'p',
	431	'types' => 'p',
	432	},
	433	'sin' =>
	434	{
	435	'func' => 1,
	436	'opcode' => 10,
	437	'parms' => 1,
	438	'result' => 'r',
	439	'types' => 'r',
	440	},
	441	'sqrt' =>
	442	{
	443	'func' => 1,
	444	'opcode' => 13,
	445	'parms' => 1,
	446	'result' => 'r',
	447	'types' => 'r',
	448	},
	449	'subtract' =>
	450	{
	451	'func' => 0,
	452	'opcode' => 1,
	453	'parms' => 2,
	454	'result' => 'r',
	455	'types' => 'rr',
	456	},
	457	'subtractp' =>
	458	{
	459	'func' => 0,
	460	'opcode' => 9,
	461	'parms' => 2,
	462	'result' => 'p',
	463	'types' => 'pp',
	464	},
	465	'uminus' =>
	466	{
	467	'func' => 0,
	468	'opcode' => 6,
	469	'parms' => 1,
	470	'result' => 'r',
	471	'types' => 'r',
	472	},
	473	'value' =>
	474	{
	475	'func' => 1,
	476	'opcode' => 18,
	477	'parms' => 1,
	478	'result' => 'r',
	479	'types' => 'p',
	480	},
	481	);
429	482	$MaxOperands = 4;
430	483	$PackCode = "i";
431	484	1;

+230

-0

lib/Imager/Test.pm less more

	0	package Imager::Test;
	1	use strict;
	2	use Test::Builder;
	3	require Exporter;
	4	use vars qw(@ISA @EXPORT_OK);
	5	@ISA = qw(Exporter);
	6	@EXPORT_OK = qw(diff_text_with_nul test_image_raw test_image_16 is_color3 is_color1 is_image);
	7
	8	sub diff_text_with_nul {
	9	my ($desc, $text1, $text2, @params) = @_;
	10
	11	my $builder = Test::Builder->new;
	12
	13	print "# $desc\n";
	14	my $imbase = Imager->new(xsize => 100, ysize => 100);
	15	my $imcopy = Imager->new(xsize => 100, ysize => 100);
	16
	17	$builder->ok($imbase->string(x => 5, 'y' => 50, size => 20,
	18	string => $text1,
	19	@params), "$desc - draw text1");
	20	$builder->ok($imcopy->string(x => 5, 'y' => 50, size => 20,
	21	string => $text2,
	22	@params), "$desc - draw text2");
	23	$builder->isnt_num(Imager::i_img_diff($imbase->{IMG}, $imcopy->{IMG}), 0,
	24	"$desc - check result different");
	25	}
	26
	27	sub is_color3($$$$$) {
	28	my ($color, $red, $green, $blue, $comment) = @_;
	29
	30	my $builder = Test::Builder->new;
	31
	32	unless (defined $color) {
	33	$builder->ok(0, $comment);
	34	$builder->diag("color is undef");
	35	return;
	36	}
	37	unless ($color->can('rgba')) {
	38	$builder->ok(0, $comment);
	39	$builder->diag("color is not a color object");
	40	return;
	41	}
	42
	43	my ($cr, $cg, $cb) = $color->rgba;
	44	unless ($builder->ok($cr == $red && $cg == $green && $cb == $blue, $comment)) {
	45	$builder->diag(<<END_DIAG);
	46	Color mismatch:
	47	Red: $red vs $cr
	48	Green: $green vs $cg
	49	Blue: $blue vs $cb
	50	END_DIAG
	51	return;
	52	}
	53
	54	return 1;
	55	}
	56
	57	sub is_color1($$$) {
	58	my ($color, $grey, $comment) = @_;
	59
	60	my $builder = Test::Builder->new;
	61
	62	unless (defined $color) {
	63	$builder->ok(0, $comment);
	64	$builder->diag("color is undef");
	65	return;
	66	}
	67	unless ($color->can('rgba')) {
	68	$builder->ok(0, $comment);
	69	$builder->diag("color is not a color object");
	70	return;
	71	}
	72
	73	my ($cgrey) = $color->rgba;
	74	unless ($builder->ok($cgrey == $grey, $comment)) {
	75	$builder->diag(<<END_DIAG);
	76	Color mismatch:
	77	Grey: $grey vs $cgrey
	78	END_DIAG
	79	return;
	80	}
	81
	82	return 1;
	83	}
	84
	85	sub test_image_raw {
	86	my $green=Imager::i_color_new(0,255,0,255);
	87	my $blue=Imager::i_color_new(0,0,255,255);
	88	my $red=Imager::i_color_new(255,0,0,255);
	89
	90	my $img=Imager::ImgRaw::new(150,150,3);
	91
	92	Imager::i_box_filled($img,70,25,130,125,$green);
	93	Imager::i_box_filled($img,20,25,80,125,$blue);
	94	Imager::i_arc($img,75,75,30,0,361,$red);
	95	Imager::i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
	96
	97	$img;
	98	}
	99
	100	sub test_image_16 {
	101	my $green = Imager::Color->new(0, 255, 0, 255);
	102	my $blue = Imager::Color->new(0, 0, 255, 255);
	103	my $red = Imager::Color->new(255, 0, 0, 255);
	104	my $img = Imager->new(xsize => 150, ysize => 150, bits => 16);
	105	$img->box(filled => 1, color => $green, box => [ 70, 25, 130, 125 ]);
	106	$img->box(filled => 1, color => $blue, box => [ 20, 25, 80, 125 ]);
	107	$img->arc(x => 75, y => 75, r => 30, color => $red);
	108	$img->filter(type => 'conv', coef => [ 0.1, 0.2, 0.4, 0.2, 0.1 ]);
	109
	110	$img;
	111	}
	112
	113	sub is_image($$$) {
	114	my ($left, $right, $comment) = @_;
	115
	116	my $builder = Test::Builder->new;
	117
	118	unless (defined $left) {
	119	$builder->ok(0, $comment);
	120	$builder->diag("left is undef");
	121	return;
	122	}
	123	unless (defined $right) {
	124	$builder->ok(0, $comment);
	125	$builder->diag("right is undef");
	126	return;
	127	}
	128	unless ($left->{IMG}) {
	129	$builder->ok(0, $comment);
	130	$builder->diag("left image has no low level object");
	131	return;
	132	}
	133	unless ($right->{IMG}) {
	134	$builder->ok(0, $comment);
	135	$builder->diag("right image has no low level object");
	136	return;
	137	}
	138	unless ($left->getwidth == $right->getwidth) {
	139	$builder->ok(0, $comment);
	140	$builder->diag("left width " . $left->getwidth . " vs right width "
	141	. $right->getwidth);
	142	return;
	143	}
	144	unless ($left->getheight == $right->getheight) {
	145	$builder->ok(0, $comment);
	146	$builder->diag("left height " . $left->getheight . " vs right height "
	147	. $right->getheight);
	148	return;
	149	}
	150	unless ($left->getchannels == $right->getchannels) {
	151	$builder->ok(0, $comment);
	152	$builder->diag("left channels " . $left->getchannels . " vs right channels "
	153	. $right->getchannels);
	154	return;
	155	}
	156	my $diff = Imager::i_img_diff($left->{IMG}, $right->{IMG});
	157	unless ($diff == 0) {
	158	$builder->ok(0, $comment);
	159	$builder->diag("image data different - $diff");
	160	return;
	161	}
	162
	163	return $builder->ok(1, $comment);
	164	}
	165
	166	1;
	167
	168	__END__
	169
	170	=head1 NAME
	171
	172	Imager::Test - common functions used in testing Imager
	173
	174	=head1 SYNOPSIS
	175
	176	use Imager::Test 'diff_text_with_nul';
	177	diff_text_with_nul($test_name, $text1, $text2, @string_options);
	178
	179	=head1 DESCRIPTION
	180
	181	This is a repository of functions used in testing Imager.
	182
	183	Some functions will only be useful in testing Imager itself, while
	184	others should be useful in testing modules that use Imager.
	185
	186	No functions are exported by default.
	187
	188	=head1 FUNCTIONS
	189
	190	=over
	191
	192	=item is_color3($color, $red, $blue, $green, $comment)
	193
	194	Tests is $color matches the given ($red, $blue, $green)
	195
	196	=item is_image($im1, $im2, $comment)
	197
	198	Tests if the 2 images have the same content. Both images must be
	199	defined, have the same width, height, channels and the same color in
	200	each pixel. The color comparison is done at 8-bits per pixel. The
	201	color representation such as direct vs paletted, bits per sample are
	202	not checked.
	203
	204	=item test_image_raw()
	205
	206	Returns a 150x150x3 Imager::ImgRaw test image.
	207
	208	=item test_image_16()
	209
	210	Returns a 150x150x3 16-bit/sample OO test image.
	211
	212	=item diff_text_with_nul($test_name, $text1, $text2, @options)
	213
	214	Creates 2 test images and writes $text1 to the first image and $text2
	215	to the second image with the string() method. Each call adds 3 ok/not
	216	ok to the output of the test script.
	217
	218	Extra options that should be supplied include the font and either a
	219	color or channel parameter.
	220
	221	This was explicitly created for regression tests on #21770.
	222
	223	=back
	224
	225	=head1 AUTHOR
	226
	227	Tony Cook <tony@develop-help.com>
	228
	229	=cut

+1

-1

map.c less more

38	38	i_color *vals;
39	39	int x, y;
40	40	int i, ch;
41		int minset = -1, maxset;
	41	int minset = -1, maxset = 0;
42	42
43	43	mm_log((1,"i_map(im %p, maps %p, chmask %u)\n", im, maps, mask));
44	44

+499

-130

pnm.c less more

14	14	=head1 SYNOPSIS
15	15
16	16	io_glue *ig = io_new_fd( fd );
17		i_img *im = i_readpnm_wiol(ig, -1); // no limit on how much is read
	17	i_img *im = i_readpnm_wiol(ig, 0); // no limit on how much is read
18	18	// or
19	19	io_glue *ig = io_new_fd( fd );
20	20	return_code = i_writepnm_wiol(im, ig);

74	74	=cut
75	75	*/
76	76
	77	#define gnext(mb) (((mb)->cp == (mb)->len) ? gnextf(mb) : (mb)->buf + (mb)->cp++)
	78
77	79	static
78	80	char *
79		gnext(mbuf *mb) {
	81	gnextf(mbuf *mb) {
80	82	io_glue *ig = mb->ig;
81	83	if (mb->cp == mb->len) {
82	84	mb->cp = 0;

87	89	return NULL;
88	90	}
89	91	if (mb->len == 0) {
90		i_push_error(errno, "unexpected end of file");
91	92	mm_log((1, "i_readpnm: end of file\n"));
92	93	return NULL;
93	94	}

107	108	=cut
108	109	*/
109	110
	111	#define gpeek(mb) ((mb)->cp == (mb)->len ? gpeekf(mb) : (mb)->buf + (mb)->cp)
	112
110	113	static
111	114	char *
112		gpeek(mbuf *mb) {
	115	gpeekf(mbuf *mb) {
113	116	io_glue *ig = mb->ig;
114	117	if (mb->cp == mb->len) {
115	118	mb->cp = 0;

120	123	return NULL;
121	124	}
122	125	if (mb->len == 0) {
123		i_push_error(0, "unexpected end of file");
124	126	mm_log((1, "i_readpnm: end of file\n"));
125	127	return NULL;
126	128	}

128	130	return &mb->buf[mb->cp];
129	131	}
130	132
131
	133	int
	134	gread(mbuf mb, unsigned char buf, size_t read_size) {
	135	int total_read = 0;
	136	if (mb->cp != mb->len) {
	137	int avail_size = mb->len - mb->cp;
	138	int use_size = read_size > avail_size ? avail_size : read_size;
	139	memcpy(buf, mb->buf+mb->cp, use_size);
	140	mb->cp += use_size;
	141	total_read += use_size;
	142	read_size -= use_size;
	143	buf += use_size;
	144	}
	145	if (read_size) {
	146	io_glue *ig = mb->ig;
	147	int read_res = i_io_read(ig, buf, read_size);
	148	if (read_res >= 0) {
	149	total_read += read_res;
	150	}
	151	}
	152	return total_read;
	153	}
132	154
133	155
134	156	/*

201	223
202	224	if (!skip_spaces(mb)) return 0;
203	225
	226	if (!(cp = gpeek(mb)))
	227	return 0;
	228	if (!misnumber(*cp))
	229	return 0;
204	230	while( (cp = gpeek(mb)) && misnumber(*cp) ) {
205	231	i = i10+(cp-'0');
206	232	cp = gnext(mb);

208	234	return 1;
209	235	}
210	236
	237	static
	238	i_img *
	239	read_pgm_ppm_bin8(mbuf mb, i_img im, int width, int height,
	240	int channels, int maxval, int allow_incomplete) {
	241	i_color line, linep;
	242	int read_size;
	243	unsigned char read_buf, readp;
	244	int x, y, ch;
	245	int rounder = maxval / 2;
	246
	247	line = mymalloc(width * sizeof(i_color));
	248	read_size = channels * width;
	249	read_buf = mymalloc(read_size);
	250	for(y=0;y<height;y++) {
	251	linep = line;
	252	readp = read_buf;
	253	if (gread(mb, read_buf, read_size) != read_size) {
	254	myfree(line);
	255	myfree(read_buf);
	256	if (allow_incomplete) {
	257	i_tags_setn(&im->tags, "i_incomplete", 1);
	258	i_tags_setn(&im->tags, "i_lines_read", y);
	259	return im;
	260	}
	261	else {
	262	i_push_error(0, "short read - file truncated?");
	263	i_img_destroy(im);
	264	return NULL;
	265	}
	266	}
	267	if (maxval == 255) {
	268	for(x=0; x<width; x++) {
	269	for(ch=0; ch<channels; ch++) {
	270	linep->channel[ch] = *readp++;
	271	}
	272	++linep;
	273	}
	274	}
	275	else {
	276	for(x=0; x<width; x++) {
	277	for(ch=0; ch<channels; ch++) {
	278	/* we just clamp samples to the correct range */
	279	unsigned sample = *readp++;
	280	if (sample > maxval)
	281	sample = maxval;
	282	linep->channel[ch] = (sample * 255 + rounder) / maxval;
	283	}
	284	++linep;
	285	}
	286	}
	287	i_plin(im, 0, width, y, line);
	288	}
	289	myfree(read_buf);
	290	myfree(line);
	291
	292	return im;
	293	}
	294
	295	static
	296	i_img *
	297	read_pgm_ppm_bin16(mbuf mb, i_img im, int width, int height,
	298	int channels, int maxval, int allow_incomplete) {
	299	i_fcolor line, linep;
	300	int read_size;
	301	unsigned char read_buf, readp;
	302	int x, y, ch;
	303	double maxvalf = maxval;
	304
	305	line = mymalloc(width * sizeof(i_fcolor));
	306	read_size = channels * width * 2;
	307	read_buf = mymalloc(read_size);
	308	for(y=0;y<height;y++) {
	309	linep = line;
	310	readp = read_buf;
	311	if (gread(mb, read_buf, read_size) != read_size) {
	312	myfree(line);
	313	myfree(read_buf);
	314	if (allow_incomplete) {
	315	i_tags_setn(&im->tags, "i_incomplete", 1);
	316	i_tags_setn(&im->tags, "i_lines_read", y);
	317	return im;
	318	}
	319	else {
	320	i_push_error(0, "short read - file truncated?");
	321	i_img_destroy(im);
	322	return NULL;
	323	}
	324	}
	325	for(x=0; x<width; x++) {
	326	for(ch=0; ch<channels; ch++) {
	327	unsigned sample = (readp[0] << 8) + readp[1];
	328	if (sample > maxval)
	329	sample = maxval;
	330	readp += 2;
	331	linep->channel[ch] = sample / maxvalf;
	332	}
	333	++linep;
	334	}
	335	i_plinf(im, 0, width, y, line);
	336	}
	337	myfree(read_buf);
	338	myfree(line);
	339
	340	return im;
	341	}
	342
	343	static
	344	i_img *
	345	read_pbm_bin(mbuf mb, i_img im, int width, int height, int allow_incomplete) {
	346	i_palidx line, linep;
	347	int read_size;
	348	unsigned char read_buf, readp;
	349	int x, y;
	350	unsigned mask;
	351
	352	line = mymalloc(width * sizeof(i_palidx));
	353	read_size = (width + 7) / 8;
	354	read_buf = mymalloc(read_size);
	355	for(y = 0; y < height; y++) {
	356	if (gread(mb, read_buf, read_size) != read_size) {
	357	myfree(line);
	358	myfree(read_buf);
	359	if (allow_incomplete) {
	360	i_tags_setn(&im->tags, "i_incomplete", 1);
	361	i_tags_setn(&im->tags, "i_lines_read", y);
	362	return im;
	363	}
	364	else {
	365	i_push_error(0, "short read - file truncated?");
	366	i_img_destroy(im);
	367	return NULL;
	368	}
	369	}
	370	linep = line;
	371	readp = read_buf;
	372	mask = 0x80;
	373	for(x = 0; x < width; ++x) {
	374	linep++ = readp & mask ? 1 : 0;
	375	mask >>= 1;
	376	if (mask == 0) {
	377	++readp;
	378	mask = 0x80;
	379	}
	380	}
	381	i_ppal(im, 0, width, y, line);
	382	}
	383	myfree(read_buf);
	384	myfree(line);
	385
	386	return im;
	387	}
	388
	389	/* unlike pgm/ppm pbm:
	390	- doesn't require spaces between samples (bits)
	391	- 1 (maxval) is black instead of white
	392	*/
	393	static
	394	i_img *
	395	read_pbm_ascii(mbuf mb, i_img im, int width, int height, int allow_incomplete) {
	396	i_palidx line, linep;
	397	int x, y;
	398
	399	line = mymalloc(width * sizeof(i_palidx));
	400	for(y = 0; y < height; y++) {
	401	linep = line;
	402	for(x = 0; x < width; ++x) {
	403	char *cp;
	404	skip_spaces(mb);
	405	if (!(cp = gnext(mb)) \|\| (cp != '0' && cp != '1')) {
	406	myfree(line);
	407	if (allow_incomplete) {
	408	i_tags_setn(&im->tags, "i_incomplete", 1);
	409	i_tags_setn(&im->tags, "i_lines_read", y);
	410	return im;
	411	}
	412	else {
	413	if (cp)
	414	i_push_error(0, "invalid data for ascii pnm");
	415	else
	416	i_push_error(0, "short read - file truncated?");
	417	i_img_destroy(im);
	418	return NULL;
	419	}
	420	}
	421	linep++ = cp == '0' ? 0 : 1;
	422	}
	423	i_ppal(im, 0, width, y, line);
	424	}
	425	myfree(line);
	426
	427	return im;
	428	}
	429
	430	static
	431	i_img *
	432	read_pgm_ppm_ascii(mbuf mb, i_img im, int width, int height, int channels,
	433	int maxval, int allow_incomplete) {
	434	i_color line, linep;
	435	int x, y, ch;
	436	int rounder = maxval / 2;
	437
	438	line = mymalloc(width * sizeof(i_color));
	439	for(y=0;y<height;y++) {
	440	linep = line;
	441	for(x=0; x<width; x++) {
	442	for(ch=0; ch<channels; ch++) {
	443	int sample;
	444
	445	if (!gnum(mb, &sample)) {
	446	myfree(line);
	447	if (allow_incomplete) {
	448	i_tags_setn(&im->tags, "i_incomplete", 1);
	449	i_tags_setn(&im->tags, "i_lines_read", 1);
	450	return im;
	451	}
	452	else {
	453	if (gpeek(mb))
	454	i_push_error(0, "invalid data for ascii pnm");
	455	else
	456	i_push_error(0, "short read - file truncated?");
	457	i_img_destroy(im);
	458	return NULL;
	459	}
	460	}
	461	if (sample > maxval)
	462	sample = maxval;
	463	linep->channel[ch] = (sample * 255 + rounder) / maxval;
	464	}
	465	++linep;
	466	}
	467	i_plin(im, 0, width, y, line);
	468	}
	469	myfree(line);
	470
	471	return im;
	472	}
	473
	474	static
	475	i_img *
	476	read_pgm_ppm_ascii_16(mbuf mb, i_img im, int width, int height,
	477	int channels, int maxval, int allow_incomplete) {
	478	i_fcolor line, linep;
	479	int x, y, ch;
	480	double maxvalf = maxval;
	481
	482	line = mymalloc(width * sizeof(i_fcolor));
	483	for(y=0;y<height;y++) {
	484	linep = line;
	485	for(x=0; x<width; x++) {
	486	for(ch=0; ch<channels; ch++) {
	487	int sample;
	488
	489	if (!gnum(mb, &sample)) {
	490	myfree(line);
	491	if (allow_incomplete) {
	492	i_tags_setn(&im->tags, "i_incomplete", 1);
	493	i_tags_setn(&im->tags, "i_lines_read", y);
	494	return im;
	495	}
	496	else {
	497	if (gpeek(mb))
	498	i_push_error(0, "invalid data for ascii pnm");
	499	else
	500	i_push_error(0, "short read - file truncated?");
	501	i_img_destroy(im);
	502	return NULL;
	503	}
	504	}
	505	if (sample > maxval)
	506	sample = maxval;
	507	linep->channel[ch] = sample / maxvalf;
	508	}
	509	++linep;
	510	}
	511	i_plinf(im, 0, width, y, line);
	512	}
	513	myfree(line);
	514
	515	return im;
	516	}
211	517
212	518	/*
213		=item i_readpnm_wiol(ig, length)
	519	=item i_readpnm_wiol(ig, allow_incomplete)
214	520
215	521	Retrieve an image and stores in the iolayer object. Returns NULL on fatal error.
216	522
217	523	ig - io_glue object
218		length - maximum length to read from data source, before closing it -1
219		signifies no limit.
	524	allow_incomplete - allows a partial file to be read successfully
220	525
221	526	=cut
222	527	*/
223	528
224	529
225	530	i_img *
226		i_readpnm_wiol(io_glue *ig, int length) {
	531	i_readpnm_wiol(io_glue *ig, int allow_incomplete) {
227	532	i_img* im;
228	533	int type;
229		int x, y, ch;
230	534	int width, height, maxval, channels, pcount;
231	535	int rounder;
232	536	char *cp;
233		unsigned char *uc;
234	537	mbuf buf;
235		i_color val;
236	538
237	539	i_clear_error();
238
239		mm_log((1,"i_readpnm(ig %p, length %d)\n", ig, length));
	540	mm_log((1,"i_readpnm(ig %p, allow_incomplete %d)\n", ig, allow_incomplete));
240	541
241	542	io_glue_commit_types(ig);
242	543	init_buf(&buf, ig);

326	627	mm_log((1, "i_readpnm: maxval of %d is over 65535 - invalid pnm file\n"));
327	628	return NULL;
328	629	}
329		else if (type >= 4 && maxval > 255) {
330		i_push_errorf(0, "maxval of %d is over 255 - not currently supported by Imager for binary pnm", maxval);
331		mm_log((1, "i_readpnm: maxval of %d is over 255 - not currently supported by Imager for binary pnm\n", maxval));
332		return NULL;
333		}
334	630	} else maxval=1;
335	631	rounder = maxval / 2;
336	632

349	645	}
350	646
351	647	mm_log((1, "i_readpnm: (%d x %d), channels = %d, maxval = %d\n", width, height, channels, maxval));
352
353		im = i_img_empty_ch(NULL, width, height, channels);
354
355		i_tags_add(&im->tags, "i_format", 0, "pnm", -1, 0);
	648
	649	if (type == 1 \|\| type == 4) {
	650	i_color pbm_pal[2];
	651	pbm_pal[0].channel[0] = 255;
	652	pbm_pal[1].channel[0] = 0;
	653
	654	im = i_img_pal_new(width, height, 1, 256);
	655	i_addcolors(im, pbm_pal, 2);
	656	}
	657	else {
	658	if (maxval > 255)
	659	im = i_img_16_new(width, height, channels);
	660	else
	661	im = i_img_8_new(width, height, channels);
	662	}
356	663
357	664	switch (type) {
358	665	case 1: /* Ascii types */
	666	im = read_pbm_ascii(&buf, im, width, height, allow_incomplete);
	667	break;
	668
359	669	case 2:
360	670	case 3:
361		for(y=0;y<height;y++) for(x=0; x<width; x++) {
362		for(ch=0; ch<channels; ch++) {
363		int t;
364		if (gnum(&buf, &t)) val.channel[ch] = (t * 255 + rounder) / maxval;
365		else {
366		mm_log((1,"i_readpnm: gnum() returned false in data\n"));
367		return im;
368		}
369		}
370		i_ppix(im, x, y, &val);
371		}
	671	if (maxval > 255)
	672	im = read_pgm_ppm_ascii_16(&buf, im, width, height, channels, maxval, allow_incomplete);
	673	else
	674	im = read_pgm_ppm_ascii(&buf, im, width, height, channels, maxval, allow_incomplete);
372	675	break;
373	676
374	677	case 4: /* binary pbm */
375		for(y=0;y<height;y++) for(x=0; x<width; x+=8) {
376		if ( (uc = (unsigned char*)gnext(&buf)) ) {
377		int xt;
378		int pc = width-x < 8 ? width-x : 8;
379		/* mm_log((1,"i_readpnm: y=%d x=%d pc=%d\n", y, x, pc)); */
380		for(xt = 0; xt<pc; xt++) {
381		val.channel[0] = (*uc & (128>>xt)) ? 0 : 255;
382		i_ppix(im, x+xt, y, &val);
383		}
384		} else {
385		mm_log((1,"i_readpnm: gnext() returned false in data\n"));
386		return im;
387		}
388		}
	678	im = read_pbm_bin(&buf, im, width, height, allow_incomplete);
389	679	break;
390	680
391	681	case 5: /* binary pgm */
392	682	case 6: /* binary ppm */
393		for(y=0;y<height;y++) for(x=0; x<width; x++) {
394		for(ch=0; ch<channels; ch++) {
395		if ( (uc = (unsigned char*)gnext(&buf)) )
396		val.channel[ch] = (uc 255 + rounder) / maxval;
397		else {
398		mm_log((1,"i_readpnm: gnext() returned false in data\n"));
399		return im;
400		}
401		}
402		i_ppix(im, x, y, &val);
403		}
	683	if (maxval > 255)
	684	im = read_pgm_ppm_bin16(&buf, im, width, height, channels, maxval, allow_incomplete);
	685	else
	686	im = read_pgm_ppm_bin8(&buf, im, width, height, channels, maxval, allow_incomplete);
404	687	break;
	688
405	689	default:
406	690	mm_log((1, "type %s [P%d] unsupported\n", typenames[type-1], type));
407	691	return NULL;
408	692	}
	693
	694	if (!im)
	695	return NULL;
	696
	697	i_tags_add(&im->tags, "i_format", 0, "pnm", -1, 0);
	698	i_tags_setn(&im->tags, "pnm_maxval", maxval);
	699	i_tags_setn(&im->tags, "pnm_type", type);
	700
409	701	return im;
410	702	}
411	703
	704	static
	705	int
	706	write_pbm(i_img im, io_glue ig, int zero_is_white) {
	707	int x, y;
	708	i_palidx *line;
	709	int write_size;
	710	unsigned char *write_buf;
	711	unsigned char *writep;
	712	char header[255];
	713	unsigned mask;
	714
	715	sprintf(header, "P4\012# CREATOR: Imager\012%d %d\012",
	716	im->xsize, im->ysize);
	717	if (i_io_write(ig, header, strlen(header)) < 0) {
	718	i_push_error(0, "could not write pbm header");
	719	return 0;
	720	}
	721	write_size = (im->xsize + 7) / 8;
	722	line = mymalloc(sizeof(i_palidx) * im->xsize);
	723	write_buf = mymalloc(write_size);
	724	for (y = 0; y < im->ysize; ++y) {
	725	i_gpal(im, 0, im->xsize, y, line);
	726	mask = 0x80;
	727	writep = write_buf;
	728	memset(write_buf, 0, write_size);
	729	for (x = 0; x < im->xsize; ++x) {
	730	if (zero_is_white ? line[x] : !line[x])
	731	*writep \|= mask;
	732	mask >>= 1;
	733	if (!mask) {
	734	++writep;
	735	mask = 0x80;
	736	}
	737	}
	738	if (i_io_write(ig, write_buf, write_size) != write_size) {
	739	i_push_error(0, "write failure");
	740	myfree(write_buf);
	741	myfree(line);
	742	return 0;
	743	}
	744	}
	745	myfree(write_buf);
	746	myfree(line);
	747
	748	return 1;
	749	}
	750
	751	static
	752	int
	753	write_ppm_data_8(i_img im, io_glue ig) {
	754	int write_size = im->xsize * im->channels;
	755	unsigned char *data = mymalloc(write_size);
	756	int y = 0;
	757	int rc = 1;
	758
	759	while (y < im->ysize && rc >= 0) {
	760	i_gsamp(im, 0, im->xsize, y, data, NULL, im->channels);
	761	if (i_io_write(ig, data, write_size) != write_size) {
	762	i_push_error(errno, "could not write ppm data");
	763	rc = 0;
	764	break;
	765	}
	766	++y;
	767	}
	768	myfree(data);
	769
	770	return rc;
	771	}
	772
	773	static
	774	int
	775	write_ppm_data_16(i_img im, io_glue ig) {
	776	int sample_count = im->channels * im->xsize;
	777	int write_size = sample_count * 2;
	778	int line_size = sample_count * sizeof(i_fsample_t);
	779	i_fsample_t *line_buf = mymalloc(line_size);
	780	i_fsample_t *samplep;
	781	unsigned char *write_buf = mymalloc(write_size);
	782	unsigned char *writep;
	783	int sample_num;
	784	int y = 0;
	785	int rc = 1;
	786
	787	while (y < im->ysize) {
	788	i_gsampf(im, 0, im->xsize, y, line_buf, NULL, im->channels);
	789	samplep = line_buf;
	790	writep = write_buf;
	791	for (sample_num = 0; sample_num < sample_count; ++sample_num) {
	792	unsigned sample16 = SampleFTo16(*samplep++);
	793	*writep++ = sample16 >> 8;
	794	*writep++ = sample16 & 0xFF;
	795	}
	796	if (i_io_write(ig, write_buf, write_size) != write_size) {
	797	i_push_error(errno, "could not write ppm data");
	798	rc = 0;
	799	break;
	800	}
	801	++y;
	802	}
	803	myfree(line_buf);
	804	myfree(write_buf);
	805
	806	return rc;
	807	}
412	808
413	809	undef_int
414	810	i_writeppm_wiol(i_img im, io_glue ig) {
415	811	char header[255];
416		int rc;
	812	int zero_is_white;
	813	int wide_data;
417	814
418	815	mm_log((1,"i_writeppm(im %p, ig %p)\n", im, ig));
419	816	i_clear_error();

423	820
424	821	io_glue_commit_types(ig);
425	822
426		if (im->channels == 3) {
427		sprintf(header,"P6\n#CREATOR: Imager\n%d %d\n255\n",im->xsize,im->ysize);
428		if (ig->writecb(ig,header,strlen(header))<0) {
	823	if (i_img_is_monochrome(im, &zero_is_white)) {
	824	return write_pbm(im, ig, zero_is_white);
	825	}
	826	else {
	827	int type;
	828	int maxval;
	829
	830	if (!i_tags_get_int(&im->tags, "pnm_write_wide_data", 0, &wide_data))
	831	wide_data = 0;
	832
	833	if (im->channels == 3) {
	834	type = 6;
	835	}
	836	else if (im->channels == 1) {
	837	type = 5;
	838	}
	839	else {
	840	i_push_error(0, "can only save 1 or 3 channel images to pnm");
	841	mm_log((1,"i_writeppm: ppm/pgm is 1 or 3 channel only (current image is %d)\n",im->channels));
	842	return(0);
	843	}
	844	if (im->bits <= 8 \|\| !wide_data)
	845	maxval = 255;
	846	else
	847	maxval = 65535;
	848
	849	sprintf(header,"P%d\n#CREATOR: Imager\n%d %d\n%d\n",
	850	type, im->xsize, im->ysize, maxval);
	851
	852	if (ig->writecb(ig,header,strlen(header)) != strlen(header)) {
429	853	i_push_error(errno, "could not write ppm header");
430	854	mm_log((1,"i_writeppm: unable to write ppm header.\n"));
431	855	return(0);
432	856	}
433	857
434	858	if (!im->virtual && im->bits == i_8_bits && im->type == i_direct_type) {
435		rc = ig->writecb(ig,im->idata,im->bytes);
	859	if (ig->writecb(ig,im->idata,im->bytes) != im->bytes) {
	860	i_push_error(errno, "could not write ppm data");
	861	return 0;
	862	}
	863	}
	864	else if (maxval == 255) {
	865	if (!write_ppm_data_8(im, ig))
	866	return 0;
436	867	}
437	868	else {
438		unsigned char data = mymalloc(3 im->xsize);
439		if (data != NULL) {
440		int y = 0;
441		static int rgb_chan[3] = { 0, 1, 2 };
442
443		rc = 0;
444		while (y < im->ysize && rc >= 0) {
445		i_gsamp(im, 0, im->xsize, y, data, rgb_chan, 3);
446		rc = ig->writecb(ig, data, im->xsize * 3);
447		++y;
448		}
449		myfree(data);
450		}
451		else {
452		i_push_error(0, "Out of memory");
	869	if (!write_ppm_data_16(im, ig))
453	870	return 0;
454		}
455		}
456		if (rc<0) {
457		i_push_error(errno, "could not write ppm data");
458		mm_log((1,"i_writeppm: unable to write ppm data.\n"));
459		return(0);
460		}
461		}
462		else if (im->channels == 1) {
463		sprintf(header, "P5\n#CREATOR: Imager\n%d %d\n255\n",
464		im->xsize, im->ysize);
465		if (ig->writecb(ig,header, strlen(header)) < 0) {
466		i_push_error(errno, "could not write pgm header");
467		mm_log((1,"i_writeppm: unable to write pgm header.\n"));
468		return(0);
469		}
470
471		if (!im->virtual && im->bits == i_8_bits && im->type == i_direct_type) {
472		rc=ig->writecb(ig,im->idata,im->bytes);
473		}
474		else {
475		unsigned char *data = mymalloc(im->xsize);
476		if (data != NULL) {
477		int y = 0;
478		int chan = 0;
479
480		rc = 0;
481		while (y < im->ysize && rc >= 0) {
482		i_gsamp(im, 0, im->xsize, y, data, &chan, 1);
483		rc = ig->writecb(ig, data, im->xsize);
484		++y;
485		}
486		myfree(data);
487		}
488		else {
489		i_push_error(0, "Out of memory");
490		return 0;
491		}
492		}
493		if (rc<0) {
494		i_push_error(errno, "could not write pgm data");
495		mm_log((1,"i_writeppm: unable to write pgm data.\n"));
496		return(0);
497		}
498		}
499		else {
500		i_push_error(0, "can only save 1 or 3 channel images to pnm");
501		mm_log((1,"i_writeppm: ppm/pgm is 1 or 3 channel only (current image is %d)\n",im->channels));
502		return(0);
	871	}
503	872	}
504	873	ig->closecb(ig);
505	874

511	880
512	881	=head1 AUTHOR
513	882
514		Arnar M. Hrafnkelsson <addi@umich.edu>
	883	Arnar M. Hrafnkelsson <addi@umich.edu>, Tony Cook<tony@imager.perl.org>
515	884
516	885	=head1 SEE ALSO
517	886

+5

-2

polygon.c less more

338	338	(maxx-p_eval_aty(line, miny))*(p_eval_atx(line, maxx)-miny)/2.0;
339	339	return r;
340	340	}
	341
	342	return 0; /* silence compiler warning */
341	343	}
342	344
343	345

531	533	i_poly_aa_low(i_img im, int l, const double x, const double y, void const ctx, scanline_flusher flusher) {
532	534	int i ,k; /* Index variables */
533	535	int clc; /* Lines inside current interval */
534		pcord tempy;
535		int cscl; /* Current scanline */
	536	/* initialize to avoid compiler warnings */
	537	pcord tempy = 0;
	538	int cscl = 0; /* Current scanline */
536	539
537	540	ss_scanline templine; /* scanline accumulator */
538	541	p_point pset; / List of points in polygon */

+22

-3

quant.c less more

5	5
6	6	static void makemap_addi(i_quantize , i_img *imgs, int count);
7	7	static void makemap_mediancut(i_quantize , i_img *imgs, int count);
	8	static void makemap_mono(i_quantize *);
8	9
9	10	static
10	11	void

68	69
69	70	case mc_median_cut:
70	71	makemap_mediancut(quant, imgs, count);
	72	break;
	73
	74	case mc_mono:
	75	makemap_mono(quant);
71	76	break;
72	77
73	78	case mc_addi:

615	620	color_count = 1;
616	621
617	622	while (color_count < quant->mc_size) {
618		int max_index, max_ch; /* index/channel with biggest spread */
	623	/* initialized to avoid compiler warnings */
	624	int max_index = 0, max_ch = 0; /* index/channel with biggest spread */
619	625	int max_size;
620	626	medcut_partition *workpart;
621	627	int cum_total;

693	699	}
694	700	/printf("out %d colors\n", quant->mc_count);/
695	701	i_mempool_destroy(&mp);
	702	}
	703
	704	static void
	705	makemap_mono(i_quantize *quant) {
	706	quant->mc_colors[0].rgba.r = 0;
	707	quant->mc_colors[0].rgba.g = 0;
	708	quant->mc_colors[0].rgba.b = 0;
	709	quant->mc_colors[0].rgba.a = 255;
	710	quant->mc_colors[1].rgba.r = 255;
	711	quant->mc_colors[1].rgba.g = 255;
	712	quant->mc_colors[1].rgba.b = 255;
	713	quant->mc_colors[1].rgba.a = 255;
	714	quant->mc_count = 2;
696	715	}
697	716
698	717	#define pboxjump 32

1086	1105	#endif
1087	1106
1088	1107	static void translate_addi(i_quantize quant, i_img img, i_palidx *out) {
1089		int x, y, i, k, bst_idx;
	1108	int x, y, i, k, bst_idx = 0;
1090	1109	i_color val;
1091	1110	int pixdev = quant->perturb;
1092	1111	CF_VARS;

1183	1202	int errw;
1184	1203	int difftotal;
1185	1204	int x, y, dx, dy;
1186		int bst_idx;
	1205	int bst_idx = 0;
1187	1206	CF_VARS;
1188	1207
1189	1208	if ((quant->errdiff & ed_mask) == ed_custom) {

+28

-3

regops.perl less more

43	43	}
44	44	}
45	45	print OUT "\n\@EXPORT = qw(@ops);\n\n";
46		my $dumper = Data::Dumper->new([\%attr],["*Attr"]);
47		$dumper->Sortkeys(1);
48		print OUT $dumper->Dump;
	46	# previously we used Data::Dumper, with Sortkeys()
	47	# to make sure the generated code only changed when the data
	48	# changed. Unfortunately Sortkeys isn't supported in some versions of
	49	# perl we try to support, so we now generate this manually
	50	print OUT "%Attr =\n (\n";
	51	for my $opname (sort keys %attr) {
	52	my $op = $attr{$opname};
	53	print OUT " '$opname' =>\n {\n";
	54	for my $attrname (sort keys %$op) {
	55	my $attr = $op->{$attrname};
	56	print OUT " '$attrname' => ";
	57	if (defined $attr) {
	58	if ($attr =~ /^\d+$/) {
	59	print OUT $attr;
	60	}
	61	else {
	62	print OUT "'$attr'";
	63	}
	64	}
	65	else {
	66	print OUT "undef";
	67	}
	68
	69	print OUT ",\n";
	70	}
	71	print OUT " },\n";
	72	}
	73	print OUT " );\n";
49	74	print OUT "\$MaxOperands = $max_opr;\n";
50	75	print OUT qq/\$PackCode = "$reg_pack";\n/;
51	76	print OUT <<'EOS';

+204

-0

render.im less more

	0	/*
	1	Render utilities
	2	*/
	3	#include "imager.h"
	4
	5	#define RENDER_MAGIC 0x765AE
	6
	7	typedef void (render_color_f)(i_render , int, int, int, unsigned char const src, i_color const color);
	8
	9	#code
	10
	11	static void IM_SUFFIX(render_color_alpha)(i_render r, int x, int y, int width, unsigned char const src, i_color const *color);
	12	static void IM_SUFFIX(render_color_13)(i_render r, int x, int y, int width, unsigned char const src, i_color const *color);
	13
	14	static render_color_f IM_SUFFIX(render_color_tab)[] =
	15	{
	16	NULL,
	17	IM_SUFFIX(render_color_13),
	18	IM_SUFFIX(render_color_alpha),
	19	IM_SUFFIX(render_color_13),
	20	IM_SUFFIX(render_color_alpha),
	21	};
	22
	23	#/code
	24
	25	void
	26	i_render_init(i_render r, i_img im, int width) {
	27	r->magic = RENDER_MAGIC;
	28	r->im = im;
	29	r->width = width;
	30	r->line_8 = NULL;
	31	r->line_double = NULL;
	32	#code im->bits <= 8
	33	r->IM_SUFFIX(line) = mymalloc(sizeof(i_fcolor) * width);
	34	#/code
	35	}
	36
	37	void
	38	i_render_done(i_render *r) {
	39	if (r->line_8)
	40	myfree(r->line_8);
	41	else
	42	myfree(r->line_double);
	43	r->magic = 0;
	44	}
	45
	46	void
	47	i_render_color(i_render r, int x, int y, int width, unsigned char const src,
	48	i_color const *color) {
	49	i_img *im = r->im;
	50	if (y < 0 \|\| y >= im->ysize)
	51	return;
	52	if (x < 0) {
	53	width += x;
	54	src -= x;
	55	x = 0;
	56	}
	57	if (x + width > im->xsize) {
	58	width = im->xsize - x;
	59	}
	60	if (x >= im->xsize \|\| x + width <= 0 \|\| width <= 0)
	61	return;
	62
	63	/* avoid as much work as we can */
	64	while (width > 0 && *src == 0) {
	65	--width;
	66	++src;
	67	++x;
	68	}
	69	while (width > 0 && src[width-1] == 0) {
	70	--width;
	71	}
	72	if (!width)
	73	return;
	74
	75	/* make sure our line buffer is big enough */
	76	if (width > r->width) {
	77	int new_width = r->width * 2;
	78	if (new_width < width)
	79	new_width = width;
	80
	81	if (r->line_8)
	82	r->line_8 = myrealloc(r->line_8, sizeof(i_color) * new_width);
	83	else
	84	r->line_double = myrealloc(r->line_double, sizeof(i_fcolor) * new_width);
	85	}
	86
	87	#code r->im->bits <= 8
	88	(IM_SUFFIX(render_color_tab)[im->channels])(r, x, y, width, src, color);
	89	#/code
	90	}
	91
	92	static void
	93	dump_src(const char note, unsigned char const src, int width) {
	94	int i;
	95	printf("%s - %p/%d\n", note, src, width);
	96	for (i = 0; i < width; ++i) {
	97	printf("%02x ", src[i]);
	98	}
	99	putchar('\n');
	100	}
	101
	102	#code
	103
	104	static
	105	void
	106	IM_SUFFIX(render_color_13)(i_render *r, int x, int y, int width,
	107	unsigned char const src, i_color const color) {
	108	i_img *im = r->im;
	109	IM_COLOR *linep = r->IM_SUFFIX(line);
	110	int ch, channels = im->channels;
	111	int fetch_offset;
	112	#undef STORE_COLOR
	113	#ifdef IM_EIGHT_BIT
	114	#define STORE_COLOR (*color)
	115	#else
	116	i_fcolor fcolor;
	117
	118	for (ch = 0; ch < channels; ++ch) {
	119	fcolor.channel[ch] = color->channel[ch] / 255.0;
	120	}
	121	#define STORE_COLOR fcolor
	122	#endif
	123
	124	fetch_offset = 0;
	125	while (fetch_offset < width && *src == 0xFF) {
	126	*linep++ = STORE_COLOR;
	127	++src;
	128	++fetch_offset;
	129	}
	130	IM_GLIN(im, x+fetch_offset, x+width, y, linep);
	131	while (fetch_offset < width) {
	132	#ifdef IM_EIGHT_BIT
	133	IM_WORK_T alpha = *src++;
	134	#else
	135	IM_WORK_T alpha = *src++ / 255.0;
	136	#endif
	137	if (alpha == IM_SAMPLE_MAX)
	138	*linep = STORE_COLOR;
	139	else if (alpha) {
	140	for (ch = 0; ch < channels; ++ch) {
	141	linep->channel[ch] = (linep->channel[ch] * (IM_SAMPLE_MAX - alpha)
	142	+ STORE_COLOR.channel[ch] * alpha) / IM_SAMPLE_MAX;
	143	}
	144	}
	145	++linep;
	146	++fetch_offset;
	147	}
	148	IM_PLIN(im, x, x+width, y, r->IM_SUFFIX(line));
	149	}
	150
	151	static
	152	void
	153	IM_SUFFIX(render_color_alpha)(i_render *r, int x, int y, int width,
	154	unsigned char const src, i_color const color) {
	155	IM_COLOR *linep = r->IM_SUFFIX(line);
	156	int ch;
	157	int alpha_channel = r->im->channels - 1;
	158	int fetch_offset;
	159	#undef STORE_COLOR
	160	#ifdef IM_EIGHT_BIT
	161	#define STORE_COLOR (*color)
	162	#else
	163	i_fcolor fcolor;
	164
	165	for (ch = 0; ch < r->im->channels; ++ch) {
	166	fcolor.channel[ch] = color->channel[ch] / 255.0;
	167	}
	168	#define STORE_COLOR fcolor
	169	#endif
	170
	171	fetch_offset = 0;
	172	while (fetch_offset < width && *src == 0xFF) {
	173	*linep++ = STORE_COLOR;
	174	++src;
	175	++fetch_offset;
	176	}
	177	IM_GLIN(r->im, x+fetch_offset, x+width, y, linep);
	178	while (fetch_offset < width) {
	179	#ifdef IM_EIGHT_BIT
	180	IM_WORK_T src_alpha = *src++;
	181	#else
	182	IM_WORK_T src_alpha = *src++ / 255.0;
	183	#endif
	184	if (src_alpha == IM_SAMPLE_MAX)
	185	*linep = STORE_COLOR;
	186	else if (src_alpha) {
	187	IM_WORK_T remains = - src_alpha;
	188	IM_WORK_T orig_alpha = linep->channel[alpha_channel];
	189	IM_WORK_T dest_alpha = src_alpha + (remains * orig_alpha) / IM_SAMPLE_MAX;
	190	for (ch = 0; ch < alpha_channel; ++ch) {
	191	linep->channel[ch] = ( src_alpha * STORE_COLOR.channel[ch]
	192	+ remains * linep->channel[ch] * orig_alpha / IM_SAMPLE_MAX
	193	) / dest_alpha;
	194	}
	195	linep->channel[alpha_channel] = dest_alpha;
	196	}
	197	++linep;
	198	++fetch_offset;
	199	}
	200	IM_PLIN(r->im, x, x+width, y, r->IM_SUFFIX(line));
	201	}
	202
	203	#/code

+12

-0

rendert.h less more

	0	#ifndef IMAGER_RENDERT_H
	1	#define IMAGER_RENDERT_H
	2
	3	typedef struct {
	4	int magic;
	5	i_img *im;
	6	i_color *line_8;
	7	i_fcolor *line_double;
	8	int width;
	9	} i_render;
	10
	11	#endif

+3

-2

rgb.c less more

92	92	header->colormap = (headbuf[100]<<24) + (headbuf[101]<<16)+(headbuf[102]<<8)+headbuf[103];
93	93	}
94	94
	95	#if 0 /* this is currently unused */
95	96
96	97	/*
97	98	=item rgb_header_pack(header, headbuf)

145	146	return -1;
146	147	}
147	148
148
	149	#endif
149	150
150	151
151	152

294	295	for(y=0; y<height; y++) {
295	296	for(c=0; c<channels; c++) {
296	297	unsigned long iidx = 0, oidx = 0, span = 0;
297		unsigned char cval;
	298	unsigned char cval = 0;
298	299	int rle = 0;
299	300	int ci = height*c+y;
300	301	int datalen = lengthtab[ci];

+9

-0

rotate.c less more

214	214	sx = (x * matrix[0] + y * matrix[1] + matrix[2]) / sz;
215	215	sy = (x * matrix[3] + y * matrix[4] + matrix[5]) / sz;
216	216	}
	217	else {
	218	sx = sy = 0;
	219	}
217	220
218	221	/* anything outside these ranges is either a broken co-ordinate
219	222	or outside the source */

289	292	sx = (x * matrix[0] + y * matrix[1] + matrix[2]) / sz;
290	293	sy = (x * matrix[3] + y * matrix[4] + matrix[5]) / sz;
291	294	}
	295	else {
	296	sx = sy = 0;
	297	}
292	298
293	299	/* anything outside these ranges is either a broken co-ordinate
294	300	or outside the source */

388	394	if (abs(sz) > 0.0000001) {
389	395	sx = (x * matrix[0] + y * matrix[1] + matrix[2]) / sz;
390	396	sy = (x * matrix[3] + y * matrix[4] + matrix[5]) / sz;
	397	}
	398	else {
	399	sx = sy = 0;
391	400	}
392	401
393	402	/* anything outside these ranges is either a broken co-ordinate

+7

-0

samples/README less more

96	96
97	97	Demonstrates using Inline and Imager's API to convert captured BGR
98	98	image data into an Imager image.
	99
	100	flasher.pl
	101
	102	Animate an image fading down to a background color and back again.
	103
	104	Demonstrates setting an alpha channel with convert(), rubthrough(),
	105	and writing animated GIFs.

+165

-0

samples/flasher.pl less more

	0	#!perl
	1	use strict;
	2	use Imager;
	3	use Getopt::Long;
	4
	5	my $delay = 10;
	6	my $frames = 20;
	7	my $low_pct = 30;
	8	my $back = '#FFFFFF';
	9	my $verbose = 0;
	10	GetOptions('delay\|d=i', \$delay,
	11	'frames\|f=i', \$frames,
	12	'lowpct\|p=i', \$low_pct,
	13	'back\|b=s', \$back,
	14	'verbose\|v' => \$verbose);
	15
	16	my $back_color = Imager::Color->new($back)
	17	or die "Cannot convert $back to a color: ", Imager->errstr, "\n";
	18
	19	$low_pct >= 0 && $low_pct < 100
	20	or die "lowpct must be >=0 and < 100\n";
	21
	22	$delay > 0 and $delay < 255
	23	or die "delay must be between 1 and 255\n";
	24
	25	$frames > 1
	26	or die "frames must be > 1\n";
	27
	28	my $in_name = shift
	29	or usage();
	30
	31	my $out_name = shift
	32	or usage();
	33
	34	my $base = Imager->new;
	35	$base->read(file => $in_name)
	36	or die "Cannot read image file $in_name: ", $base->errstr, "\n";
	37
	38	# convert to RGBA to simplify the convert() matrix
	39	$base = $base->convert(preset => 'rgb') unless $base->getchannels >=3;
	40	$base = $base->convert(preset => 'addalpha') unless $base->getchannels == 4;
	41
	42	my $width = $base->getwidth;
	43	my $height = $base->getheight;
	44
	45	my @down;
	46	my $down_frames = $frames / 2;
	47	my $step = (100 - $low_pct) / $down_frames;
	48	my $percent = 100 - $step;
	49	++$\|;
	50	print "Generating frames\n" if $verbose;
	51	for my $frame_no (1 .. $down_frames) {
	52	print "\rFrame $frame_no/$down_frames";
	53
	54	# canvas with our background color
	55	my $canvas = Imager->new(xsize => $width, ysize => $height);
	56	$canvas->box(filled => 1, color => $back_color);
	57
	58	# make a version of our original with the alpha scaled
	59	my $scale = $percent / 100.0;
	60	my $draw = $base->convert(matrix => [ [ 1, 0, 0, 0 ],
	61	[ 0, 1, 0, 0 ],
	62	[ 0, 0, 1, 0 ],
	63	[ 0, 0, 0, $scale ] ]);
	64
	65	# draw it on the canvas
	66	$canvas->rubthrough(src => $draw);
	67
	68	push @down, $canvas;
	69	$percent -= $step;
	70	}
	71	print "\n" if $verbose;
	72
	73	# generate a sequence going from the original down to the most faded
	74	my @frames = $base;
	75	push @frames, @down;
	76	# remove the most faded frame so it isn't repeated
	77	pop @down;
	78	# and back up again
	79	push @frames, reverse @down;
	80
	81	print "Writing frames\n" if $verbose;
	82	Imager->write_multi({ file => $out_name,
	83	type => 'gif',
	84	gif_loop => 0, # loop forever
	85	gif_delay => $delay,
	86	translate => 'errdiff',
	87	make_colors => 'mediancut',
	88	},
	89	@frames)
	90	or die "Cannot write $out_name: ", Imager->errstr, "\n";
	91
	92	sub usage {
	93	die <<EOS;
	94	Produce an animated gif that cycles an image fading into a background and
	95	unfading back to the original image.
	96	Usage: $0 [options] input output
	97	Input can be any image supported by Imager.
	98	Output should be a .gif file.
	99	Options include:
	100	-v \| --verbose
	101	Progress reports
	102	-d <delay> \| --delay <delay>
	103	Delay between frames in 1/100 sec. Default 10.
	104	-p <percent> \| --percent <percent>
	105	Low percentage coverage. Default: 30
	106	-b <color> \| --back <color>
	107	Color to fade towards, in some format Imager understands.
	108	Default: #FFFFFF
	109	-f <frames> \| --frames <frames>
	110	Rough total number of frames to produce. Default: 20.
	111	EOS
	112	}
	113
	114	=head1 NAME
	115
	116	flasher.pl - produces a slowly flashing GIF based on an input image
	117
	118	=head1 SYNOPSIS
	119
	120	perl flasher.pl [options] input output.gif
	121
	122	=head1 DESCRIPTION
	123
	124	flasher.pl generates an animation from the given image to I<lowpct>%
	125	coverage on a blank image of color I<back>.
	126
	127	=head1 OPTIONS
	128
	129	=over
	130
	131	=item *
	132
	133	-f I<frames>, --frames I<frames> - the total number of frames. This is
	134	always rounded up to the next even number. Default: 20
	135
	136	=item *
	137
	138	-d I<delay>, --delay I<delay> - the delay in 1/100 second between
	139	frames. Default: 10.
	140
	141	=item *
	142
	143	-p I<percent>, --lowpct I<percent> - the lowest coverage of the image.
	144	Default: 30
	145
	146	=item *
	147
	148	-b I<color>, --back I<color> - the background color to fade to.
	149	Default: #FFFFFF.
	150
	151	=item *
	152
	153	-v, --verbose - produce progress information.
	154
	155	=item
	156
	157	=back
	158
	159	=head1 AUTHOR
	160
	161	Tony Cook <tonyc@cpan.org>
	162
	163	=cut
	164

+2

-2

scale.im less more

112	112	for (y = 0; y < y_out; ++y) {
113	113	if (y_out == src->ysize) {
114	114	/* no vertical scaling, just load it */
	115	#ifdef IM_EIGHT_BIT
115	116	int x, ch;
116		#ifdef IM_EIGHT_BIT
117	117	/* load and convert to doubles */
118	118	IM_GLIN(src, 0, src->xsize, y, in_row);
119	119	for (x = 0; x < src->xsize; ++x) {

154	154	}
155	155	/* we've accumulated a vertically scaled row */
156	156	if (x_out == src->xsize) {
	157	#if IM_EIGHT_BIT
157	158	int x, ch;
158		#if IM_EIGHT_BIT
159	159	/* no need to scale, but we need to convert it */
160	160	for (x = 0; x < x_out; ++x) {
161	161	for (ch = 0; ch < result->channels; ++ch)

+0

-1408

~~t/Test/Builder.pm~~ less more

0		package Test::Builder;
1
2		use 5.004;
3
4		# $^C was only introduced in 5.005-ish. We do this to prevent
5		# use of uninitialized value warnings in older perls.
6		$^C \|\|= 0;
7
8		use strict;
9		use vars qw($VERSION $CLASS);
10		$VERSION = '0.17';
11		$CLASS = __PACKAGE__;
12
13		my $IsVMS = $^O eq 'VMS';
14
15		# Make Test::Builder thread-safe for ithreads.
16		BEGIN {
17		use Config;
18		if( $] >= 5.008 && $Config{useithreads} ) {
19		require threads;
20		require threads::shared;
21		threads::shared->import;
22		}
23		else {
24		*share = sub { 0 };
25		*lock = sub { 0 };
26		}
27		}
28
29		use vars qw($Level);
30		my($Test_Died) = 0;
31		my($Have_Plan) = 0;
32		my $Original_Pid = $$;
33		my $Curr_Test = 0; share($Curr_Test);
34		my @Test_Results = (); share(@Test_Results);
35		my @Test_Details = (); share(@Test_Details);
36
37
38		=head1 NAME
39
40		Test::Builder - Backend for building test libraries
41
42		=head1 SYNOPSIS
43
44		package My::Test::Module;
45		use Test::Builder;
46		require Exporter;
47		@ISA = qw(Exporter);
48		@EXPORT = qw(ok);
49
50		my $Test = Test::Builder->new;
51		$Test->output('my_logfile');
52
53		sub import {
54		my($self) = shift;
55		my $pack = caller;
56
57		$Test->exported_to($pack);
58		$Test->plan(@_);
59
60		$self->export_to_level(1, $self, 'ok');
61		}
62
63		sub ok {
64		my($test, $name) = @_;
65
66		$Test->ok($test, $name);
67		}
68
69
70		=head1 DESCRIPTION
71
72		Test::Simple and Test::More have proven to be popular testing modules,
73		but they're not always flexible enough. Test::Builder provides the a
74		building block upon which to write your own test libraries I<which can
75		work together>.
76
77		=head2 Construction
78
79		=over 4
80
81		=item B<new>
82
83		my $Test = Test::Builder->new;
84
85		Returns a Test::Builder object representing the current state of the
86		test.
87
88		Since you only run one test per program, there is B<one and only one>
89		Test::Builder object. No matter how many times you call new(), you're
90		getting the same object. (This is called a singleton).
91
92		=cut
93
94		my $Test;
95		sub new {
96		my($class) = shift;
97		$Test \|\|= bless ['Move along, nothing to see here'], $class;
98		return $Test;
99		}
100
101		=back
102
103		=head2 Setting up tests
104
105		These methods are for setting up tests and declaring how many there
106		are. You usually only want to call one of these methods.
107
108		=over 4
109
110		=item B<exported_to>
111
112		my $pack = $Test->exported_to;
113		$Test->exported_to($pack);
114
115		Tells Test::Builder what package you exported your functions to.
116		This is important for getting TODO tests right.
117
118		=cut
119
120		my $Exported_To;
121		sub exported_to {
122		my($self, $pack) = @_;
123
124		if( defined $pack ) {
125		$Exported_To = $pack;
126		}
127		return $Exported_To;
128		}
129
130		=item B<plan>
131
132		$Test->plan('no_plan');
133		$Test->plan( skip_all => $reason );
134		$Test->plan( tests => $num_tests );
135
136		A convenient way to set up your tests. Call this and Test::Builder
137		will print the appropriate headers and take the appropriate actions.
138
139		If you call plan(), don't call any of the other methods below.
140
141		=cut
142
143		sub plan {
144		my($self, $cmd, $arg) = @_;
145
146		return unless $cmd;
147
148		if( $Have_Plan ) {
149		die sprintf "You tried to plan twice! Second plan at %s line %d\n",
150		($self->caller)[1,2];
151		}
152
153		if( $cmd eq 'no_plan' ) {
154		$self->no_plan;
155		}
156		elsif( $cmd eq 'skip_all' ) {
157		return $self->skip_all($arg);
158		}
159		elsif( $cmd eq 'tests' ) {
160		if( $arg ) {
161		return $self->expected_tests($arg);
162		}
163		elsif( !defined $arg ) {
164		die "Got an undefined number of tests. Looks like you tried to ".
165		"say how many tests you plan to run but made a mistake.\n";
166		}
167		elsif( !$arg ) {
168		die "You said to run 0 tests! You've got to run something.\n";
169		}
170		}
171		else {
172		require Carp;
173		my @args = grep { defined } ($cmd, $arg);
174		Carp::croak("plan() doesn't understand @args");
175		}
176
177		return 1;
178		}
179
180		=item B<expected_tests>
181
182		my $max = $Test->expected_tests;
183		$Test->expected_tests($max);
184
185		Gets/sets the # of tests we expect this test to run and prints out
186		the appropriate headers.
187
188		=cut
189
190		my $Expected_Tests = 0;
191		sub expected_tests {
192		my($self, $max) = @_;
193
194		if( defined $max ) {
195		$Expected_Tests = $max;
196		$Have_Plan = 1;
197
198		$self->_print("1..$max\n") unless $self->no_header;
199		}
200		return $Expected_Tests;
201		}
202
203
204		=item B<no_plan>
205
206		$Test->no_plan;
207
208		Declares that this test will run an indeterminate # of tests.
209
210		=cut
211
212		my($No_Plan) = 0;
213		sub no_plan {
214		$No_Plan = 1;
215		$Have_Plan = 1;
216		}
217
218		=item B<has_plan>
219
220		$plan = $Test->has_plan
221
222		Find out whether a plan has been defined. $plan is either C<undef> (no plan has been set), C<no_plan> (indeterminate # of tests) or an integer (the number of expected tests).
223
224		=cut
225
226		sub has_plan {
227		return($Expected_Tests) if $Expected_Tests;
228		return('no_plan') if $No_Plan;
229		return(undef);
230		};
231
232
233		=item B<skip_all>
234
235		$Test->skip_all;
236		$Test->skip_all($reason);
237
238		Skips all the tests, using the given $reason. Exits immediately with 0.
239
240		=cut
241
242		my $Skip_All = 0;
243		sub skip_all {
244		my($self, $reason) = @_;
245
246		my $out = "1..0";
247		$out .= " # Skip $reason" if $reason;
248		$out .= "\n";
249
250		$Skip_All = 1;
251
252		$self->_print($out) unless $self->no_header;
253		exit(0);
254		}
255
256		=back
257
258		=head2 Running tests
259
260		These actually run the tests, analogous to the functions in
261		Test::More.
262
263		$name is always optional.
264
265		=over 4
266
267		=item B<ok>
268
269		$Test->ok($test, $name);
270
271		Your basic test. Pass if $test is true, fail if $test is false. Just
272		like Test::Simple's ok().
273
274		=cut
275
276		sub ok {
277		my($self, $test, $name) = @_;
278
279		# $test might contain an object which we don't want to accidentally
280		# store, so we turn it into a boolean.
281		$test = $test ? 1 : 0;
282
283		unless( $Have_Plan ) {
284		require Carp;
285		Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
286		}
287
288		lock $Curr_Test;
289		$Curr_Test++;
290
291		$self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
292		You named your test '$name'. You shouldn't use numbers for your test names.
293		Very confusing.
294		ERR
295
296		my($pack, $file, $line) = $self->caller;
297
298		my $todo = $self->todo($pack);
299
300		my $out;
301		my $result = {};
302		share($result);
303
304		unless( $test ) {
305		$out .= "not ";
306		@$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
307		}
308		else {
309		@$result{ 'ok', 'actual_ok' } = ( 1, $test );
310		}
311
312		$out .= "ok";
313		$out .= " $Curr_Test" if $self->use_numbers;
314
315		if( defined $name ) {
316		$name =~ s\|#\|\\#\|g; # # in a name can confuse Test::Harness.
317		$out .= " - $name";
318		$result->{name} = $name;
319		}
320		else {
321		$result->{name} = '';
322		}
323
324		if( $todo ) {
325		my $what_todo = $todo;
326		$out .= " # TODO $what_todo";
327		$result->{reason} = $what_todo;
328		$result->{type} = 'todo';
329		}
330		else {
331		$result->{reason} = '';
332		$result->{type} = '';
333		}
334
335		$Test_Results[$Curr_Test-1] = $result;
336		$out .= "\n";
337
338		$self->_print($out);
339
340		unless( $test ) {
341		my $msg = $todo ? "Failed (TODO)" : "Failed";
342		$self->diag(" $msg test ($file at line $line)\n");
343		}
344
345		return $test ? 1 : 0;
346		}
347
348		=item B<is_eq>
349
350		$Test->is_eq($got, $expected, $name);
351
352		Like Test::More's is(). Checks if $got eq $expected. This is the
353		string version.
354
355		=item B<is_num>
356
357		$Test->is_num($got, $expected, $name);
358
359		Like Test::More's is(). Checks if $got == $expected. This is the
360		numeric version.
361
362		=cut
363
364		sub is_eq {
365		my($self, $got, $expect, $name) = @_;
366		local $Level = $Level + 1;
367
368		if( !defined $got \|\| !defined $expect ) {
369		# undef only matches undef and nothing else
370		my $test = !defined $got && !defined $expect;
371
372		$self->ok($test, $name);
373		$self->_is_diag($got, 'eq', $expect) unless $test;
374		return $test;
375		}
376
377		return $self->cmp_ok($got, 'eq', $expect, $name);
378		}
379
380		sub is_num {
381		my($self, $got, $expect, $name) = @_;
382		local $Level = $Level + 1;
383
384		if( !defined $got \|\| !defined $expect ) {
385		# undef only matches undef and nothing else
386		my $test = !defined $got && !defined $expect;
387
388		$self->ok($test, $name);
389		$self->_is_diag($got, '==', $expect) unless $test;
390		return $test;
391		}
392
393		return $self->cmp_ok($got, '==', $expect, $name);
394		}
395
396		sub _is_diag {
397		my($self, $got, $type, $expect) = @_;
398
399		foreach my $val (\$got, \$expect) {
400		if( defined $$val ) {
401		if( $type eq 'eq' ) {
402		# quote and force string context
403		$$val = "'$$val'"
404		}
405		else {
406		# force numeric context
407		$$val = $$val+0;
408		}
409		}
410		else {
411		$$val = 'undef';
412		}
413		}
414
415		return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
416		got: %s
417		expected: %s
418		DIAGNOSTIC
419
420		}
421
422		=item B<isnt_eq>
423
424		$Test->isnt_eq($got, $dont_expect, $name);
425
426		Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
427		the string version.
428
429		=item B<isnt_num>
430
431		$Test->is_num($got, $dont_expect, $name);
432
433		Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
434		the numeric version.
435
436		=cut
437
438		sub isnt_eq {
439		my($self, $got, $dont_expect, $name) = @_;
440		local $Level = $Level + 1;
441
442		if( !defined $got \|\| !defined $dont_expect ) {
443		# undef only matches undef and nothing else
444		my $test = defined $got \|\| defined $dont_expect;
445
446		$self->ok($test, $name);
447		$self->_cmp_diag('ne', $got, $dont_expect) unless $test;
448		return $test;
449		}
450
451		return $self->cmp_ok($got, 'ne', $dont_expect, $name);
452		}
453
454		sub isnt_num {
455		my($self, $got, $dont_expect, $name) = @_;
456		local $Level = $Level + 1;
457
458		if( !defined $got \|\| !defined $dont_expect ) {
459		# undef only matches undef and nothing else
460		my $test = defined $got \|\| defined $dont_expect;
461
462		$self->ok($test, $name);
463		$self->_cmp_diag('!=', $got, $dont_expect) unless $test;
464		return $test;
465		}
466
467		return $self->cmp_ok($got, '!=', $dont_expect, $name);
468		}
469
470
471		=item B<like>
472
473		$Test->like($this, qr/$regex/, $name);
474		$Test->like($this, '/$regex/', $name);
475
476		Like Test::More's like(). Checks if $this matches the given $regex.
477
478		You'll want to avoid qr// if you want your tests to work before 5.005.
479
480		=item B<unlike>
481
482		$Test->unlike($this, qr/$regex/, $name);
483		$Test->unlike($this, '/$regex/', $name);
484
485		Like Test::More's unlike(). Checks if $this B<does not match> the
486		given $regex.
487
488		=cut
489
490		sub like {
491		my($self, $this, $regex, $name) = @_;
492
493		local $Level = $Level + 1;
494		$self->_regex_ok($this, $regex, '=~', $name);
495		}
496
497		sub unlike {
498		my($self, $this, $regex, $name) = @_;
499
500		local $Level = $Level + 1;
501		$self->_regex_ok($this, $regex, '!~', $name);
502		}
503
504		=item B<maybe_regex>
505
506		$Test->maybe_regex(qr/$regex/);
507		$Test->maybe_regex('/$regex/');
508
509		Convenience method for building testing functions that take regular
510		expressions as arguments, but need to work before perl 5.005.
511
512		Takes a quoted regular expression produced by qr//, or a string
513		representing a regular expression.
514
515		Returns a Perl value which may be used instead of the corresponding
516		regular expression, or undef if it's argument is not recognised.
517
518		For example, a version of like(), sans the useful diagnostic messages,
519		could be written as:
520
521		sub laconic_like {
522		my ($self, $this, $regex, $name) = @_;
523		my $usable_regex = $self->maybe_regex($regex);
524		die "expecting regex, found '$regex'\n"
525		unless $usable_regex;
526		$self->ok($this =~ m/$usable_regex/, $name);
527		}
528
529		=cut
530
531
532		sub maybe_regex {
533		my ($self, $regex) = @_;
534		my $usable_regex = undef;
535		if( ref $regex eq 'Regexp' ) {
536		$usable_regex = $regex;
537		}
538		# Check if it looks like '/foo/'
539		elsif( my($re, $opts) = $regex =~ m{^ /(.)/ (\w) $ }sx ) {
540		$usable_regex = length $opts ? "(?$opts)$re" : $re;
541		};
542		return($usable_regex)
543		};
544
545		sub _regex_ok {
546		my($self, $this, $regex, $cmp, $name) = @_;
547
548		local $Level = $Level + 1;
549
550		my $ok = 0;
551		my $usable_regex = $self->maybe_regex($regex);
552		unless (defined $usable_regex) {
553		$ok = $self->ok( 0, $name );
554		$self->diag(" '$regex' doesn't look much like a regex to me.");
555		return $ok;
556		}
557
558		{
559		local $^W = 0;
560		my $test = $this =~ /$usable_regex/ ? 1 : 0;
561		$test = !$test if $cmp eq '!~';
562		$ok = $self->ok( $test, $name );
563		}
564
565		unless( $ok ) {
566		$this = defined $this ? "'$this'" : 'undef';
567		my $match = $cmp eq '=~' ? "doesn't match" : "matches";
568		$self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
569		%s
570		%13s '%s'
571		DIAGNOSTIC
572
573		}
574
575		return $ok;
576		}
577
578		=item B<cmp_ok>
579
580		$Test->cmp_ok($this, $type, $that, $name);
581
582		Works just like Test::More's cmp_ok().
583
584		$Test->cmp_ok($big_num, '!=', $other_big_num);
585
586		=cut
587
588		sub cmp_ok {
589		my($self, $got, $type, $expect, $name) = @_;
590
591		my $test;
592		{
593		local $^W = 0;
594		local($@,$!); # don't interfere with $@
595		# eval() sometimes resets $!
596		$test = eval "\$got $type \$expect";
597		}
598		local $Level = $Level + 1;
599		my $ok = $self->ok($test, $name);
600
601		unless( $ok ) {
602		if( $type =~ /^(eq\|==)$/ ) {
603		$self->_is_diag($got, $type, $expect);
604		}
605		else {
606		$self->_cmp_diag($got, $type, $expect);
607		}
608		}
609		return $ok;
610		}
611
612		sub _cmp_diag {
613		my($self, $got, $type, $expect) = @_;
614
615		$got = defined $got ? "'$got'" : 'undef';
616		$expect = defined $expect ? "'$expect'" : 'undef';
617		return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
618		%s
619		%s
620		%s
621		DIAGNOSTIC
622		}
623
624		=item B<BAILOUT>
625
626		$Test->BAILOUT($reason);
627
628		Indicates to the Test::Harness that things are going so badly all
629		testing should terminate. This includes running any additional test
630		scripts.
631
632		It will exit with 255.
633
634		=cut
635
636		sub BAILOUT {
637		my($self, $reason) = @_;
638
639		$self->_print("Bail out! $reason");
640		exit 255;
641		}
642
643		=item B<skip>
644
645		$Test->skip;
646		$Test->skip($why);
647
648		Skips the current test, reporting $why.
649
650		=cut
651
652		sub skip {
653		my($self, $why) = @_;
654		$why \|\|= '';
655
656		unless( $Have_Plan ) {
657		require Carp;
658		Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
659		}
660
661		lock($Curr_Test);
662		$Curr_Test++;
663
664		my %result;
665		share(%result);
666		%result = (
667		'ok' => 1,
668		actual_ok => 1,
669		name => '',
670		type => 'skip',
671		reason => $why,
672		);
673		$Test_Results[$Curr_Test-1] = \%result;
674
675		my $out = "ok";
676		$out .= " $Curr_Test" if $self->use_numbers;
677		$out .= " # skip $why\n";
678
679		$Test->_print($out);
680
681		return 1;
682		}
683
684
685		=item B<todo_skip>
686
687		$Test->todo_skip;
688		$Test->todo_skip($why);
689
690		Like skip(), only it will declare the test as failing and TODO. Similar
691		to
692
693		print "not ok $tnum # TODO $why\n";
694
695		=cut
696
697		sub todo_skip {
698		my($self, $why) = @_;
699		$why \|\|= '';
700
701		unless( $Have_Plan ) {
702		require Carp;
703		Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
704		}
705
706		lock($Curr_Test);
707		$Curr_Test++;
708
709		my %result;
710		share(%result);
711		%result = (
712		'ok' => 1,
713		actual_ok => 0,
714		name => '',
715		type => 'todo_skip',
716		reason => $why,
717		);
718
719		$Test_Results[$Curr_Test-1] = \%result;
720
721		my $out = "not ok";
722		$out .= " $Curr_Test" if $self->use_numbers;
723		$out .= " # TODO & SKIP $why\n";
724
725		$Test->_print($out);
726
727		return 1;
728		}
729
730
731		=begin _unimplemented
732
733		=item B<skip_rest>
734
735		$Test->skip_rest;
736		$Test->skip_rest($reason);
737
738		Like skip(), only it skips all the rest of the tests you plan to run
739		and terminates the test.
740
741		If you're running under no_plan, it skips once and terminates the
742		test.
743
744		=end _unimplemented
745
746		=back
747
748
749		=head2 Test style
750
751		=over 4
752
753		=item B<level>
754
755		$Test->level($how_high);
756
757		How far up the call stack should $Test look when reporting where the
758		test failed.
759
760		Defaults to 1.
761
762		Setting $Test::Builder::Level overrides. This is typically useful
763		localized:
764
765		{
766		local $Test::Builder::Level = 2;
767		$Test->ok($test);
768		}
769
770		=cut
771
772		sub level {
773		my($self, $level) = @_;
774
775		if( defined $level ) {
776		$Level = $level;
777		}
778		return $Level;
779		}
780
781		$CLASS->level(1);
782
783
784		=item B<use_numbers>
785
786		$Test->use_numbers($on_or_off);
787
788		Whether or not the test should output numbers. That is, this if true:
789
790		ok 1
791		ok 2
792		ok 3
793
794		or this if false
795
796		ok
797		ok
798		ok
799
800		Most useful when you can't depend on the test output order, such as
801		when threads or forking is involved.
802
803		Test::Harness will accept either, but avoid mixing the two styles.
804
805		Defaults to on.
806
807		=cut
808
809		my $Use_Nums = 1;
810		sub use_numbers {
811		my($self, $use_nums) = @_;
812
813		if( defined $use_nums ) {
814		$Use_Nums = $use_nums;
815		}
816		return $Use_Nums;
817		}
818
819		=item B<no_header>
820
821		$Test->no_header($no_header);
822
823		If set to true, no "1..N" header will be printed.
824
825		=item B<no_ending>
826
827		$Test->no_ending($no_ending);
828
829		Normally, Test::Builder does some extra diagnostics when the test
830		ends. It also changes the exit code as described in Test::Simple.
831
832		If this is true, none of that will be done.
833
834		=cut
835
836		my($No_Header, $No_Ending) = (0,0);
837		sub no_header {
838		my($self, $no_header) = @_;
839
840		if( defined $no_header ) {
841		$No_Header = $no_header;
842		}
843		return $No_Header;
844		}
845
846		sub no_ending {
847		my($self, $no_ending) = @_;
848
849		if( defined $no_ending ) {
850		$No_Ending = $no_ending;
851		}
852		return $No_Ending;
853		}
854
855
856		=back
857
858		=head2 Output
859
860		Controlling where the test output goes.
861
862		It's ok for your test to change where STDOUT and STDERR point to,
863		Test::Builder's default output settings will not be affected.
864
865		=over 4
866
867		=item B<diag>
868
869		$Test->diag(@msgs);
870
871		Prints out the given $message. Normally, it uses the failure_output()
872		handle, but if this is for a TODO test, the todo_output() handle is
873		used.
874
875		Output will be indented and marked with a # so as not to interfere
876		with test output. A newline will be put on the end if there isn't one
877		already.
878
879		We encourage using this rather than calling print directly.
880
881		Returns false. Why? Because diag() is often used in conjunction with
882		a failing test (C<ok() \|\| diag()>) it "passes through" the failure.
883
884		return ok(...) \|\| diag(...);
885
886		=for blame transfer
887		Mark Fowler <mark@twoshortplanks.com>
888
889		=cut
890
891		sub diag {
892		my($self, @msgs) = @_;
893		return unless @msgs;
894
895		# Prevent printing headers when compiling (i.e. -c)
896		return if $^C;
897
898		# Escape each line with a #.
899		foreach (@msgs) {
900		$_ = 'undef' unless defined;
901		s/^/# /gms;
902		}
903
904		push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
905
906		local $Level = $Level + 1;
907		my $fh = $self->todo ? $self->todo_output : $self->failure_output;
908		local($\, $", $,) = (undef, ' ', '');
909		print $fh @msgs;
910
911		return 0;
912		}
913
914		=begin _private
915
916		=item B<_print>
917
918		$Test->_print(@msgs);
919
920		Prints to the output() filehandle.
921
922		=end _private
923
924		=cut
925
926		sub _print {
927		my($self, @msgs) = @_;
928
929		# Prevent printing headers when only compiling. Mostly for when
930		# tests are deparsed with B::Deparse
931		return if $^C;
932
933		local($\, $", $,) = (undef, ' ', '');
934		my $fh = $self->output;
935
936		# Escape each line after the first with a # so we don't
937		# confuse Test::Harness.
938		foreach (@msgs) {
939		s/\n(.)/\n# $1/sg;
940		}
941
942		push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
943
944		print $fh @msgs;
945		}
946
947
948		=item B<output>
949
950		$Test->output($fh);
951		$Test->output($file);
952
953		Where normal "ok/not ok" test output should go.
954
955		Defaults to STDOUT.
956
957		=item B<failure_output>
958
959		$Test->failure_output($fh);
960		$Test->failure_output($file);
961
962		Where diagnostic output on test failures and diag() should go.
963
964		Defaults to STDERR.
965
966		=item B<todo_output>
967
968		$Test->todo_output($fh);
969		$Test->todo_output($file);
970
971		Where diagnostics about todo test failures and diag() should go.
972
973		Defaults to STDOUT.
974
975		=cut
976
977		my($Out_FH, $Fail_FH, $Todo_FH);
978		sub output {
979		my($self, $fh) = @_;
980
981		if( defined $fh ) {
982		$Out_FH = _new_fh($fh);
983		}
984		return $Out_FH;
985		}
986
987		sub failure_output {
988		my($self, $fh) = @_;
989
990		if( defined $fh ) {
991		$Fail_FH = _new_fh($fh);
992		}
993		return $Fail_FH;
994		}
995
996		sub todo_output {
997		my($self, $fh) = @_;
998
999		if( defined $fh ) {
1000		$Todo_FH = _new_fh($fh);
1001		}
1002		return $Todo_FH;
1003		}
1004
1005		sub _new_fh {
1006		my($file_or_fh) = shift;
1007
1008		my $fh;
1009		unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
1010		$fh = do { local *FH };
1011		open $fh, ">$file_or_fh" or
1012		die "Can't open test output log $file_or_fh: $!";
1013		}
1014		else {
1015		$fh = $file_or_fh;
1016		}
1017
1018		return $fh;
1019		}
1020
1021		unless( $^C ) {
1022		# We dup STDOUT and STDERR so people can change them in their
1023		# test suites while still getting normal test output.
1024		open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
1025		open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
1026
1027		# Set everything to unbuffered else plain prints to STDOUT will
1028		# come out in the wrong order from our own prints.
1029		_autoflush(\*TESTOUT);
1030		_autoflush(\*STDOUT);
1031		_autoflush(\*TESTERR);
1032		_autoflush(\*STDERR);
1033
1034		$CLASS->output(\*TESTOUT);
1035		$CLASS->failure_output(\*TESTERR);
1036		$CLASS->todo_output(\*TESTOUT);
1037		}
1038
1039		sub _autoflush {
1040		my($fh) = shift;
1041		my $old_fh = select $fh;
1042		$\| = 1;
1043		select $old_fh;
1044		}
1045
1046
1047		=back
1048
1049
1050		=head2 Test Status and Info
1051
1052		=over 4
1053
1054		=item B<current_test>
1055
1056		my $curr_test = $Test->current_test;
1057		$Test->current_test($num);
1058
1059		Gets/sets the current test # we're on.
1060
1061		You usually shouldn't have to set this.
1062
1063		=cut
1064
1065		sub current_test {
1066		my($self, $num) = @_;
1067
1068		lock($Curr_Test);
1069		if( defined $num ) {
1070		unless( $Have_Plan ) {
1071		require Carp;
1072		Carp::croak("Can't change the current test number without a plan!");
1073		}
1074
1075		$Curr_Test = $num;
1076		if( $num > @Test_Results ) {
1077		my $start = @Test_Results ? $#Test_Results + 1 : 0;
1078		for ($start..$num-1) {
1079		my %result;
1080		share(%result);
1081		%result = ( ok => 1,
1082		actual_ok => undef,
1083		reason => 'incrementing test number',
1084		type => 'unknown',
1085		name => undef
1086		);
1087		$Test_Results[$_] = \%result;
1088		}
1089		}
1090		}
1091		return $Curr_Test;
1092		}
1093
1094
1095		=item B<summary>
1096
1097		my @tests = $Test->summary;
1098
1099		A simple summary of the tests so far. True for pass, false for fail.
1100		This is a logical pass/fail, so todos are passes.
1101
1102		Of course, test #1 is $tests[0], etc...
1103
1104		=cut
1105
1106		sub summary {
1107		my($self) = shift;
1108
1109		return map { $_->{'ok'} } @Test_Results;
1110		}
1111
1112		=item B<details>
1113
1114		my @tests = $Test->details;
1115
1116		Like summary(), but with a lot more detail.
1117
1118		$tests[$test_num - 1] =
1119		{ 'ok' => is the test considered a pass?
1120		actual_ok => did it literally say 'ok'?
1121		name => name of the test (if any)
1122		type => type of test (if any, see below).
1123		reason => reason for the above (if any)
1124		};
1125
1126		'ok' is true if Test::Harness will consider the test to be a pass.
1127
1128		'actual_ok' is a reflection of whether or not the test literally
1129		printed 'ok' or 'not ok'. This is for examining the result of 'todo'
1130		tests.
1131
1132		'name' is the name of the test.
1133
1134		'type' indicates if it was a special test. Normal tests have a type
1135		of ''. Type can be one of the following:
1136
1137		skip see skip()
1138		todo see todo()
1139		todo_skip see todo_skip()
1140		unknown see below
1141
1142		Sometimes the Test::Builder test counter is incremented without it
1143		printing any test output, for example, when current_test() is changed.
1144		In these cases, Test::Builder doesn't know the result of the test, so
1145		it's type is 'unkown'. These details for these tests are filled in.
1146		They are considered ok, but the name and actual_ok is left undef.
1147
1148		For example "not ok 23 - hole count # TODO insufficient donuts" would
1149		result in this structure:
1150
1151		$tests[22] = # 23 - 1, since arrays start from 0.
1152		{ ok => 1, # logically, the test passed since it's todo
1153		actual_ok => 0, # in absolute terms, it failed
1154		name => 'hole count',
1155		type => 'todo',
1156		reason => 'insufficient donuts'
1157		};
1158
1159		=cut
1160
1161		sub details {
1162		return @Test_Results;
1163		}
1164
1165		=item B<todo>
1166
1167		my $todo_reason = $Test->todo;
1168		my $todo_reason = $Test->todo($pack);
1169
1170		todo() looks for a $TODO variable in your tests. If set, all tests
1171		will be considered 'todo' (see Test::More and Test::Harness for
1172		details). Returns the reason (ie. the value of $TODO) if running as
1173		todo tests, false otherwise.
1174
1175		todo() is pretty part about finding the right package to look for
1176		$TODO in. It uses the exported_to() package to find it. If that's
1177		not set, it's pretty good at guessing the right package to look at.
1178
1179		Sometimes there is some confusion about where todo() should be looking
1180		for the $TODO variable. If you want to be sure, tell it explicitly
1181		what $pack to use.
1182
1183		=cut
1184
1185		sub todo {
1186		my($self, $pack) = @_;
1187
1188		$pack = $pack \|\| $self->exported_to \|\| $self->caller(1);
1189
1190		no strict 'refs';
1191		return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
1192		: 0;
1193		}
1194
1195		=item B<caller>
1196
1197		my $package = $Test->caller;
1198		my($pack, $file, $line) = $Test->caller;
1199		my($pack, $file, $line) = $Test->caller($height);
1200
1201		Like the normal caller(), except it reports according to your level().
1202
1203		=cut
1204
1205		sub caller {
1206		my($self, $height) = @_;
1207		$height \|\|= 0;
1208
1209		my @caller = CORE::caller($self->level + $height + 1);
1210		return wantarray ? @caller : $caller[0];
1211		}
1212
1213		=back
1214
1215		=cut
1216
1217		=begin _private
1218
1219		=over 4
1220
1221		=item B<_sanity_check>
1222
1223		_sanity_check();
1224
1225		Runs a bunch of end of test sanity checks to make sure reality came
1226		through ok. If anything is wrong it will die with a fairly friendly
1227		error message.
1228
1229		=cut
1230
1231		#'#
1232		sub _sanity_check {
1233		_whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
1234		_whoa(!$Have_Plan and $Curr_Test,
1235		'Somehow your tests ran without a plan!');
1236		_whoa($Curr_Test != @Test_Results,
1237		'Somehow you got a different number of results than tests ran!');
1238		}
1239
1240		=item B<_whoa>
1241
1242		_whoa($check, $description);
1243
1244		A sanity check, similar to assert(). If the $check is true, something
1245		has gone horribly wrong. It will die with the given $description and
1246		a note to contact the author.
1247
1248		=cut
1249
1250		sub _whoa {
1251		my($check, $desc) = @_;
1252		if( $check ) {
1253		die <<WHOA;
1254		WHOA! $desc
1255		This should never happen! Please contact the author immediately!
1256		WHOA
1257		}
1258		}
1259
1260		=item B<_my_exit>
1261
1262		_my_exit($exit_num);
1263
1264		Perl seems to have some trouble with exiting inside an END block. 5.005_03
1265		and 5.6.1 both seem to do odd things. Instead, this function edits $?
1266		directly. It should ONLY be called from inside an END block. It
1267		doesn't actually exit, that's your job.
1268
1269		=cut
1270
1271		sub _my_exit {
1272		$? = $_[0];
1273
1274		return 1;
1275		}
1276
1277
1278		=back
1279
1280		=end _private
1281
1282		=cut
1283
1284		$SIG{__DIE__} = sub {
1285		# We don't want to muck with death in an eval, but $^S isn't
1286		# totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
1287		# with it. Instead, we use caller. This also means it runs under
1288		# 5.004!
1289		my $in_eval = 0;
1290		for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
1291		$in_eval = 1 if $sub =~ /^$eval$/;
1292		}
1293		$Test_Died = 1 unless $in_eval;
1294		};
1295
1296		sub _ending {
1297		my $self = shift;
1298
1299		_sanity_check();
1300
1301		# Don't bother with an ending if this is a forked copy. Only the parent
1302		# should do the ending.
1303		do{ _my_exit($?) && return } if $Original_Pid != $$;
1304
1305		# Bailout if plan() was never called. This is so
1306		# "require Test::Simple" doesn't puke.
1307		do{ _my_exit(0) && return } if !$Have_Plan && !$Test_Died;
1308
1309		# Figure out if we passed or failed and print helpful messages.
1310		if( @Test_Results ) {
1311		# The plan? We have no plan.
1312		if( $No_Plan ) {
1313		$self->_print("1..$Curr_Test\n") unless $self->no_header;
1314		$Expected_Tests = $Curr_Test;
1315		}
1316
1317		# 5.8.0 threads bug. Shared arrays will not be auto-extended
1318		# by a slice. Worse, we have to fill in every entry else
1319		# we'll get an "Invalid value for shared scalar" error
1320		for my $idx ($#Test_Results..$Expected_Tests-1) {
1321		my %empty_result = ();
1322		share(%empty_result);
1323		$Test_Results[$idx] = \%empty_result
1324		unless defined $Test_Results[$idx];
1325		}
1326
1327		my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
1328		$num_failed += abs($Expected_Tests - @Test_Results);
1329
1330		if( $Curr_Test < $Expected_Tests ) {
1331		$self->diag(<<"FAIL");
1332		Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
1333		FAIL
1334		}
1335		elsif( $Curr_Test > $Expected_Tests ) {
1336		my $num_extra = $Curr_Test - $Expected_Tests;
1337		$self->diag(<<"FAIL");
1338		Looks like you planned $Expected_Tests tests but ran $num_extra extra.
1339		FAIL
1340		}
1341		elsif ( $num_failed ) {
1342		$self->diag(<<"FAIL");
1343		Looks like you failed $num_failed tests of $Expected_Tests.
1344		FAIL
1345		}
1346
1347		if( $Test_Died ) {
1348		$self->diag(<<"FAIL");
1349		Looks like your test died just after $Curr_Test.
1350		FAIL
1351
1352		_my_exit( 255 ) && return;
1353		}
1354
1355		_my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
1356		}
1357		elsif ( $Skip_All ) {
1358		_my_exit( 0 ) && return;
1359		}
1360		elsif ( $Test_Died ) {
1361		$self->diag(<<'FAIL');
1362		Looks like your test died before it could output anything.
1363		FAIL
1364		}
1365		else {
1366		$self->diag("No tests run!\n");
1367		_my_exit( 255 ) && return;
1368		}
1369		}
1370
1371		END {
1372		$Test->_ending if defined $Test and !$Test->no_ending;
1373		}
1374
1375		=head1 THREADS
1376
1377		In perl 5.8.0 and later, Test::Builder is thread-safe. The test
1378		number is shared amongst all threads. This means if one thread sets
1379		the test number using current_test() they will all be effected.
1380
1381		=head1 EXAMPLES
1382
1383		CPAN can provide the best examples. Test::Simple, Test::More,
1384		Test::Exception and Test::Differences all use Test::Builder.
1385
1386		=head1 SEE ALSO
1387
1388		Test::Simple, Test::More, Test::Harness
1389
1390		=head1 AUTHORS
1391
1392		Original code by chromatic, maintained by Michael G Schwern
1393		E<lt>schwern@pobox.comE<gt>
1394
1395		=head1 COPYRIGHT
1396
1397		Copyright 2002 by chromatic E<lt>chromatic@wgz.orgE<gt>,
1398		Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1399
1400		This program is free software; you can redistribute it and/or
1401		modify it under the same terms as Perl itself.
1402
1403		See F<http://www.perl.com/perl/misc/Artistic.html>
1404
1405		=cut
1406
1407		1;

+0

-1248

~~t/Test/More.pm~~ less more

0		package Test::More;
1
2		use 5.004;
3
4		use strict;
5		use Test::Builder;
6
7
8		# Can't use Carp because it might cause use_ok() to accidentally succeed
9		# even though the module being used forgot to use Carp. Yes, this
10		# actually happened.
11		sub _carp {
12		my($file, $line) = (caller(1))[1,2];
13		warn @_, " at $file line $line\n";
14		}
15
16
17
18		require Exporter;
19		use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
20		$VERSION = '0.47';
21		@ISA = qw(Exporter);
22		@EXPORT = qw(ok use_ok require_ok
23		is isnt like unlike is_deeply
24		cmp_ok
25		skip todo todo_skip
26		pass fail
27		eq_array eq_hash eq_set
28		$TODO
29		plan
30		can_ok isa_ok
31		diag
32		);
33
34		my $Test = Test::Builder->new;
35
36
37		# 5.004's Exporter doesn't have export_to_level.
38		sub _export_to_level
39		{
40		my $pkg = shift;
41		my $level = shift;
42		(undef) = shift; # redundant arg
43		my $callpkg = caller($level);
44		$pkg->export($callpkg, @_);
45		}
46
47
48		=head1 NAME
49
50		Test::More - yet another framework for writing test scripts
51
52		=head1 SYNOPSIS
53
54		use Test::More tests => $Num_Tests;
55		# or
56		use Test::More qw(no_plan);
57		# or
58		use Test::More skip_all => $reason;
59
60		BEGIN { use_ok( 'Some::Module' ); }
61		require_ok( 'Some::Module' );
62
63		# Various ways to say "ok"
64		ok($this eq $that, $test_name);
65
66		is ($this, $that, $test_name);
67		isnt($this, $that, $test_name);
68
69		# Rather than print STDERR "# here's what went wrong\n"
70		diag("here's what went wrong");
71
72		like ($this, qr/that/, $test_name);
73		unlike($this, qr/that/, $test_name);
74
75		cmp_ok($this, '==', $that, $test_name);
76
77		is_deeply($complex_structure1, $complex_structure2, $test_name);
78
79		SKIP: {
80		skip $why, $how_many unless $have_some_feature;
81
82		ok( foo(), $test_name );
83		is( foo(42), 23, $test_name );
84		};
85
86		TODO: {
87		local $TODO = $why;
88
89		ok( foo(), $test_name );
90		is( foo(42), 23, $test_name );
91		};
92
93		can_ok($module, @methods);
94		isa_ok($object, $class);
95
96		pass($test_name);
97		fail($test_name);
98
99		# Utility comparison functions.
100		eq_array(\@this, \@that);
101		eq_hash(\%this, \%that);
102		eq_set(\@this, \@that);
103
104		# UNIMPLEMENTED!!!
105		my @status = Test::More::status;
106
107		# UNIMPLEMENTED!!!
108		BAIL_OUT($why);
109
110
111		=head1 DESCRIPTION
112
113		B<STOP!> If you're just getting started writing tests, have a look at
114		Test::Simple first. This is a drop in replacement for Test::Simple
115		which you can switch to once you get the hang of basic testing.
116
117		The purpose of this module is to provide a wide range of testing
118		utilities. Various ways to say "ok" with better diagnostics,
119		facilities to skip tests, test future features and compare complicated
120		data structures. While you can do almost anything with a simple
121		C<ok()> function, it doesn't provide good diagnostic output.
122
123
124		=head2 I love it when a plan comes together
125
126		Before anything else, you need a testing plan. This basically declares
127		how many tests your script is going to run to protect against premature
128		failure.
129
130		The preferred way to do this is to declare a plan when you C<use Test::More>.
131
132		use Test::More tests => $Num_Tests;
133
134		There are rare cases when you will not know beforehand how many tests
135		your script is going to run. In this case, you can declare that you
136		have no plan. (Try to avoid using this as it weakens your test.)
137
138		use Test::More qw(no_plan);
139
140		In some cases, you'll want to completely skip an entire testing script.
141
142		use Test::More skip_all => $skip_reason;
143
144		Your script will declare a skip with the reason why you skipped and
145		exit immediately with a zero (success). See L<Test::Harness> for
146		details.
147
148		If you want to control what functions Test::More will export, you
149		have to use the 'import' option. For example, to import everything
150		but 'fail', you'd do:
151
152		use Test::More tests => 23, import => ['!fail'];
153
154		Alternatively, you can use the plan() function. Useful for when you
155		have to calculate the number of tests.
156
157		use Test::More;
158		plan tests => keys %Stuff * 3;
159
160		or for deciding between running the tests at all:
161
162		use Test::More;
163		if( $^O eq 'MacOS' ) {
164		plan skip_all => 'Test irrelevant on MacOS';
165		}
166		else {
167		plan tests => 42;
168		}
169
170		=cut
171
172		sub plan {
173		my(@plan) = @_;
174
175		my $caller = caller;
176
177		$Test->exported_to($caller);
178
179		my @imports = ();
180		foreach my $idx (0..$#plan) {
181		if( $plan[$idx] eq 'import' ) {
182		my($tag, $imports) = splice @plan, $idx, 2;
183		@imports = @$imports;
184		last;
185		}
186		}
187
188		$Test->plan(@plan);
189
190		__PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
191		}
192
193		sub import {
194		my($class) = shift;
195		goto &plan;
196		}
197
198
199		=head2 Test names
200
201		By convention, each test is assigned a number in order. This is
202		largely done automatically for you. However, it's often very useful to
203		assign a name to each test. Which would you rather see:
204
205		ok 4
206		not ok 5
207		ok 6
208
209		or
210
211		ok 4 - basic multi-variable
212		not ok 5 - simple exponential
213		ok 6 - force == mass * acceleration
214
215		The later gives you some idea of what failed. It also makes it easier
216		to find the test in your script, simply search for "simple
217		exponential".
218
219		All test functions take a name argument. It's optional, but highly
220		suggested that you use it.
221
222
223		=head2 I'm ok, you're not ok.
224
225		The basic purpose of this module is to print out either "ok #" or "not
226		ok #" depending on if a given test succeeded or failed. Everything
227		else is just gravy.
228
229		All of the following print "ok" or "not ok" depending on if the test
230		succeeded or failed. They all also return true or false,
231		respectively.
232
233		=over 4
234
235		=item B<ok>
236
237		ok($this eq $that, $test_name);
238
239		This simply evaluates any expression (C<$this eq $that> is just a
240		simple example) and uses that to determine if the test succeeded or
241		failed. A true expression passes, a false one fails. Very simple.
242
243		For example:
244
245		ok( $exp{9} == 81, 'simple exponential' );
246		ok( Film->can('db_Main'), 'set_db()' );
247		ok( $p->tests == 4, 'saw tests' );
248		ok( !grep !defined $_, @items, 'items populated' );
249
250		(Mnemonic: "This is ok.")
251
252		$test_name is a very short description of the test that will be printed
253		out. It makes it very easy to find a test in your script when it fails
254		and gives others an idea of your intentions. $test_name is optional,
255		but we B<very> strongly encourage its use.
256
257		Should an ok() fail, it will produce some diagnostics:
258
259		not ok 18 - sufficient mucus
260		# Failed test 18 (foo.t at line 42)
261
262		This is actually Test::Simple's ok() routine.
263
264		=cut
265
266		sub ok ($;$) {
267		my($test, $name) = @_;
268		$Test->ok($test, $name);
269		}
270
271		=item B<is>
272
273		=item B<isnt>
274
275		is ( $this, $that, $test_name );
276		isnt( $this, $that, $test_name );
277
278		Similar to ok(), is() and isnt() compare their two arguments
279		with C<eq> and C<ne> respectively and use the result of that to
280		determine if the test succeeded or failed. So these:
281
282		# Is the ultimate answer 42?
283		is( ultimate_answer(), 42, "Meaning of Life" );
284
285		# $foo isn't empty
286		isnt( $foo, '', "Got some foo" );
287
288		are similar to these:
289
290		ok( ultimate_answer() eq 42, "Meaning of Life" );
291		ok( $foo ne '', "Got some foo" );
292
293		(Mnemonic: "This is that." "This isn't that.")
294
295		So why use these? They produce better diagnostics on failure. ok()
296		cannot know what you are testing for (beyond the name), but is() and
297		isnt() know what the test was and why it failed. For example this
298		test:
299
300		my $foo = 'waffle'; my $bar = 'yarblokos';
301		is( $foo, $bar, 'Is foo the same as bar?' );
302
303		Will produce something like this:
304
305		not ok 17 - Is foo the same as bar?
306		# Failed test (foo.t at line 139)
307		# got: 'waffle'
308		# expected: 'yarblokos'
309
310		So you can figure out what went wrong without rerunning the test.
311
312		You are encouraged to use is() and isnt() over ok() where possible,
313		however do not be tempted to use them to find out if something is
314		true or false!
315
316		# XXX BAD! $pope->isa('Catholic') eq 1
317		is( $pope->isa('Catholic'), 1, 'Is the Pope Catholic?' );
318
319		This does not check if C<$pope->isa('Catholic')> is true, it checks if
320		it returns 1. Very different. Similar caveats exist for false and 0.
321		In these cases, use ok().
322
323		ok( $pope->isa('Catholic') ), 'Is the Pope Catholic?' );
324
325		For those grammatical pedants out there, there's an C<isn't()>
326		function which is an alias of isnt().
327
328		=cut
329
330		sub is ($$;$) {
331		$Test->is_eq(@_);
332		}
333
334		sub isnt ($$;$) {
335		$Test->isnt_eq(@_);
336		}
337
338		*isn't = \&isnt;
339
340
341		=item B<like>
342
343		like( $this, qr/that/, $test_name );
344
345		Similar to ok(), like() matches $this against the regex C<qr/that/>.
346
347		So this:
348
349		like($this, qr/that/, 'this is like that');
350
351		is similar to:
352
353		ok( $this =~ /that/, 'this is like that');
354
355		(Mnemonic "This is like that".)
356
357		The second argument is a regular expression. It may be given as a
358		regex reference (i.e. C<qr//>) or (for better compatibility with older
359		perls) as a string that looks like a regex (alternative delimiters are
360		currently not supported):
361
362		like( $this, '/that/', 'this is like that' );
363
364		Regex options may be placed on the end (C<'/that/i'>).
365
366		Its advantages over ok() are similar to that of is() and isnt(). Better
367		diagnostics on failure.
368
369		=cut
370
371		sub like ($$;$) {
372		$Test->like(@_);
373		}
374
375
376		=item B<unlike>
377
378		unlike( $this, qr/that/, $test_name );
379
380		Works exactly as like(), only it checks if $this B<does not> match the
381		given pattern.
382
383		=cut
384
385		sub unlike {
386		$Test->unlike(@_);
387		}
388
389
390		=item B<cmp_ok>
391
392		cmp_ok( $this, $op, $that, $test_name );
393
394		Halfway between ok() and is() lies cmp_ok(). This allows you to
395		compare two arguments using any binary perl operator.
396
397		# ok( $this eq $that );
398		cmp_ok( $this, 'eq', $that, 'this eq that' );
399
400		# ok( $this == $that );
401		cmp_ok( $this, '==', $that, 'this == that' );
402
403		# ok( $this && $that );
404		cmp_ok( $this, '&&', $that, 'this \|\| that' );
405		...etc...
406
407		Its advantage over ok() is when the test fails you'll know what $this
408		and $that were:
409
410		not ok 1
411		# Failed test (foo.t at line 12)
412		# '23'
413		# &&
414		# undef
415
416		It's also useful in those cases where you are comparing numbers and
417		is()'s use of C<eq> will interfere:
418
419		cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
420
421		=cut
422
423		sub cmp_ok($$$;$) {
424		$Test->cmp_ok(@_);
425		}
426
427
428		=item B<can_ok>
429
430		can_ok($module, @methods);
431		can_ok($object, @methods);
432
433		Checks to make sure the $module or $object can do these @methods
434		(works with functions, too).
435
436		can_ok('Foo', qw(this that whatever));
437
438		is almost exactly like saying:
439
440		ok( Foo->can('this') &&
441		Foo->can('that') &&
442		Foo->can('whatever')
443		);
444
445		only without all the typing and with a better interface. Handy for
446		quickly testing an interface.
447
448		No matter how many @methods you check, a single can_ok() call counts
449		as one test. If you desire otherwise, use:
450
451		foreach my $meth (@methods) {
452		can_ok('Foo', $meth);
453		}
454
455		=cut
456
457		sub can_ok ($@) {
458		my($proto, @methods) = @_;
459		my $class = ref $proto \|\| $proto;
460
461		unless( @methods ) {
462		my $ok = $Test->ok( 0, "$class->can(...)" );
463		$Test->diag(' can_ok() called with no methods');
464		return $ok;
465		}
466
467		my @nok = ();
468		foreach my $method (@methods) {
469		local($!, $@); # don't interfere with caller's $@
470		# eval sometimes resets $!
471		eval { $proto->can($method) } \|\| push @nok, $method;
472		}
473
474		my $name;
475		$name = @methods == 1 ? "$class->can('$methods[0]')"
476		: "$class->can(...)";
477
478		my $ok = $Test->ok( !@nok, $name );
479
480		$Test->diag(map " $class->can('$_') failed\n", @nok);
481
482		return $ok;
483		}
484
485		=item B<isa_ok>
486
487		isa_ok($object, $class, $object_name);
488		isa_ok($ref, $type, $ref_name);
489
490		Checks to see if the given $object->isa($class). Also checks to make
491		sure the object was defined in the first place. Handy for this sort
492		of thing:
493
494		my $obj = Some::Module->new;
495		isa_ok( $obj, 'Some::Module' );
496
497		where you'd otherwise have to write
498
499		my $obj = Some::Module->new;
500		ok( defined $obj && $obj->isa('Some::Module') );
501
502		to safeguard against your test script blowing up.
503
504		It works on references, too:
505
506		isa_ok( $array_ref, 'ARRAY' );
507
508		The diagnostics of this test normally just refer to 'the object'. If
509		you'd like them to be more specific, you can supply an $object_name
510		(for example 'Test customer').
511
512		=cut
513
514		sub isa_ok ($$;$) {
515		my($object, $class, $obj_name) = @_;
516
517		my $diag;
518		$obj_name = 'The object' unless defined $obj_name;
519		my $name = "$obj_name isa $class";
520		if( !defined $object ) {
521		$diag = "$obj_name isn't defined";
522		}
523		elsif( !ref $object ) {
524		$diag = "$obj_name isn't a reference";
525		}
526		else {
527		# We can't use UNIVERSAL::isa because we want to honor isa() overrides
528		local($@, $!); # eval sometimes resets $!
529		my $rslt = eval { $object->isa($class) };
530		if( $@ ) {
531		if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
532		if( !UNIVERSAL::isa($object, $class) ) {
533		my $ref = ref $object;
534		$diag = "$obj_name isn't a '$class' it's a '$ref'";
535		}
536		} else {
537		die <<WHOA;
538		WHOA! I tried to call ->isa on your object and got some weird error.
539		This should never happen. Please contact the author immediately.
540		Here's the error.
541		$@
542		WHOA
543		}
544		}
545		elsif( !$rslt ) {
546		my $ref = ref $object;
547		$diag = "$obj_name isn't a '$class' it's a '$ref'";
548		}
549		}
550
551
552
553		my $ok;
554		if( $diag ) {
555		$ok = $Test->ok( 0, $name );
556		$Test->diag(" $diag\n");
557		}
558		else {
559		$ok = $Test->ok( 1, $name );
560		}
561
562		return $ok;
563		}
564
565
566		=item B<pass>
567
568		=item B<fail>
569
570		pass($test_name);
571		fail($test_name);
572
573		Sometimes you just want to say that the tests have passed. Usually
574		the case is you've got some complicated condition that is difficult to
575		wedge into an ok(). In this case, you can simply use pass() (to
576		declare the test ok) or fail (for not ok). They are synonyms for
577		ok(1) and ok(0).
578
579		Use these very, very, very sparingly.
580
581		=cut
582
583		sub pass (;$) {
584		$Test->ok(1, @_);
585		}
586
587		sub fail (;$) {
588		$Test->ok(0, @_);
589		}
590
591		=back
592
593		=head2 Diagnostics
594
595		If you pick the right test function, you'll usually get a good idea of
596		what went wrong when it failed. But sometimes it doesn't work out
597		that way. So here we have ways for you to write your own diagnostic
598		messages which are safer than just C<print STDERR>.
599
600		=over 4
601
602		=item B<diag>
603
604		diag(@diagnostic_message);
605
606		Prints a diagnostic message which is guaranteed not to interfere with
607		test output. Handy for this sort of thing:
608
609		ok( grep(/foo/, @users), "There's a foo user" ) or
610		diag("Since there's no foo, check that /etc/bar is set up right");
611
612		which would produce:
613
614		not ok 42 - There's a foo user
615		# Failed test (foo.t at line 52)
616		# Since there's no foo, check that /etc/bar is set up right.
617
618		You might remember C<ok() or diag()> with the mnemonic C<open() or
619		die()>.
620
621		B<NOTE> The exact formatting of the diagnostic output is still
622		changing, but it is guaranteed that whatever you throw at it it won't
623		interfere with the test.
624
625		=cut
626
627		sub diag {
628		$Test->diag(@_);
629		}
630
631
632		=back
633
634		=head2 Module tests
635
636		You usually want to test if the module you're testing loads ok, rather
637		than just vomiting if its load fails. For such purposes we have
638		C<use_ok> and C<require_ok>.
639
640		=over 4
641
642		=item B<use_ok>
643
644		BEGIN { use_ok($module); }
645		BEGIN { use_ok($module, @imports); }
646
647		These simply use the given $module and test to make sure the load
648		happened ok. It's recommended that you run use_ok() inside a BEGIN
649		block so its functions are exported at compile-time and prototypes are
650		properly honored.
651
652		If @imports are given, they are passed through to the use. So this:
653
654		BEGIN { use_ok('Some::Module', qw(foo bar)) }
655
656		is like doing this:
657
658		use Some::Module qw(foo bar);
659
660		don't try to do this:
661
662		BEGIN {
663		use_ok('Some::Module');
664
665		...some code that depends on the use...
666		...happening at compile time...
667		}
668
669		instead, you want:
670
671		BEGIN { use_ok('Some::Module') }
672		BEGIN { ...some code that depends on the use... }
673
674
675		=cut
676
677		sub use_ok ($;@) {
678		my($module, @imports) = @_;
679		@imports = () unless @imports;
680
681		my $pack = caller;
682
683		local($@,$!); # eval sometimes interferes with $!
684		eval <<USE;
685		package $pack;
686		require $module;
687		'$module'->import(\@imports);
688		USE
689
690		my $ok = $Test->ok( !$@, "use $module;" );
691
692		unless( $ok ) {
693		chomp $@;
694		$Test->diag(<<DIAGNOSTIC);
695		Tried to use '$module'.
696		Error: $@
697		DIAGNOSTIC
698
699		}
700
701		return $ok;
702		}
703
704		=item B<require_ok>
705
706		require_ok($module);
707
708		Like use_ok(), except it requires the $module.
709
710		=cut
711
712		sub require_ok ($) {
713		my($module) = shift;
714
715		my $pack = caller;
716
717		local($!, $@); # eval sometimes interferes with $!
718		eval <<REQUIRE;
719		package $pack;
720		require $module;
721		REQUIRE
722
723		my $ok = $Test->ok( !$@, "require $module;" );
724
725		unless( $ok ) {
726		chomp $@;
727		$Test->diag(<<DIAGNOSTIC);
728		Tried to require '$module'.
729		Error: $@
730		DIAGNOSTIC
731
732		}
733
734		return $ok;
735		}
736
737		=back
738
739		=head2 Conditional tests
740
741		Sometimes running a test under certain conditions will cause the
742		test script to die. A certain function or method isn't implemented
743		(such as fork() on MacOS), some resource isn't available (like a
744		net connection) or a module isn't available. In these cases it's
745		necessary to skip tests, or declare that they are supposed to fail
746		but will work in the future (a todo test).
747
748		For more details on the mechanics of skip and todo tests see
749		L<Test::Harness>.
750
751		The way Test::More handles this is with a named block. Basically, a
752		block of tests which can be skipped over or made todo. It's best if I
753		just show you...
754
755		=over 4
756
757		=item B<SKIP: BLOCK>
758
759		SKIP: {
760		skip $why, $how_many if $condition;
761
762		...normal testing code goes here...
763		}
764
765		This declares a block of tests that might be skipped, $how_many tests
766		there are, $why and under what $condition to skip them. An example is
767		the easiest way to illustrate:
768
769		SKIP: {
770		eval { require HTML::Lint };
771
772		skip "HTML::Lint not installed", 2 if $@;
773
774		my $lint = new HTML::Lint;
775		isa_ok( $lint, "HTML::Lint" );
776
777		$lint->parse( $html );
778		is( $lint->errors, 0, "No errors found in HTML" );
779		}
780
781		If the user does not have HTML::Lint installed, the whole block of
782		code I<won't be run at all>. Test::More will output special ok's
783		which Test::Harness interprets as skipped, but passing, tests.
784		It's important that $how_many accurately reflects the number of tests
785		in the SKIP block so the # of tests run will match up with your plan.
786
787		It's perfectly safe to nest SKIP blocks. Each SKIP block must have
788		the label C<SKIP>, or Test::More can't work its magic.
789
790		You don't skip tests which are failing because there's a bug in your
791		program, or for which you don't yet have code written. For that you
792		use TODO. Read on.
793
794		=cut
795
796		#'#
797		sub skip {
798		my($why, $how_many) = @_;
799
800		unless( defined $how_many ) {
801		# $how_many can only be avoided when no_plan is in use.
802		_carp "skip() needs to know \$how_many tests are in the block"
803		unless $Test::Builder::No_Plan;
804		$how_many = 1;
805		}
806
807		for( 1..$how_many ) {
808		$Test->skip($why);
809		}
810
811		local $^W = 0;
812		last SKIP;
813		}
814
815
816		=item B<TODO: BLOCK>
817
818		TODO: {
819		local $TODO = $why if $condition;
820
821		...normal testing code goes here...
822		}
823
824		Declares a block of tests you expect to fail and $why. Perhaps it's
825		because you haven't fixed a bug or haven't finished a new feature:
826
827		TODO: {
828		local $TODO = "URI::Geller not finished";
829
830		my $card = "Eight of clubs";
831		is( URI::Geller->your_card, $card, 'Is THIS your card?' );
832
833		my $spoon;
834		URI::Geller->bend_spoon;
835		is( $spoon, 'bent', "Spoon bending, that's original" );
836		}
837
838		With a todo block, the tests inside are expected to fail. Test::More
839		will run the tests normally, but print out special flags indicating
840		they are "todo". Test::Harness will interpret failures as being ok.
841		Should anything succeed, it will report it as an unexpected success.
842		You then know the thing you had todo is done and can remove the
843		TODO flag.
844
845		The nice part about todo tests, as opposed to simply commenting out a
846		block of tests, is it's like having a programmatic todo list. You know
847		how much work is left to be done, you're aware of what bugs there are,
848		and you'll know immediately when they're fixed.
849
850		Once a todo test starts succeeding, simply move it outside the block.
851		When the block is empty, delete it.
852
853
854		=item B<todo_skip>
855
856		TODO: {
857		todo_skip $why, $how_many if $condition;
858
859		...normal testing code...
860		}
861
862		With todo tests, it's best to have the tests actually run. That way
863		you'll know when they start passing. Sometimes this isn't possible.
864		Often a failing test will cause the whole program to die or hang, even
865		inside an C<eval BLOCK> with and using C<alarm>. In these extreme
866		cases you have no choice but to skip over the broken tests entirely.
867
868		The syntax and behavior is similar to a C<SKIP: BLOCK> except the
869		tests will be marked as failing but todo. Test::Harness will
870		interpret them as passing.
871
872		=cut
873
874		sub todo_skip {
875		my($why, $how_many) = @_;
876
877		unless( defined $how_many ) {
878		# $how_many can only be avoided when no_plan is in use.
879		_carp "todo_skip() needs to know \$how_many tests are in the block"
880		unless $Test::Builder::No_Plan;
881		$how_many = 1;
882		}
883
884		for( 1..$how_many ) {
885		$Test->todo_skip($why);
886		}
887
888		local $^W = 0;
889		last TODO;
890		}
891
892		=item When do I use SKIP vs. TODO?
893
894		B<If it's something the user might not be able to do>, use SKIP.
895		This includes optional modules that aren't installed, running under
896		an OS that doesn't have some feature (like fork() or symlinks), or maybe
897		you need an Internet connection and one isn't available.
898
899		B<If it's something the programmer hasn't done yet>, use TODO. This
900		is for any code you haven't written yet, or bugs you have yet to fix,
901		but want to put tests in your testing script (always a good idea).
902
903
904		=back
905
906		=head2 Comparison functions
907
908		Not everything is a simple eq check or regex. There are times you
909		need to see if two arrays are equivalent, for instance. For these
910		instances, Test::More provides a handful of useful functions.
911
912		B<NOTE> These are NOT well-tested on circular references. Nor am I
913		quite sure what will happen with filehandles.
914
915		=over 4
916
917		=item B<is_deeply>
918
919		is_deeply( $this, $that, $test_name );
920
921		Similar to is(), except that if $this and $that are hash or array
922		references, it does a deep comparison walking each data structure to
923		see if they are equivalent. If the two structures are different, it
924		will display the place where they start differing.
925
926		Barrie Slaymaker's Test::Differences module provides more in-depth
927		functionality along these lines, and it plays well with Test::More.
928
929		B<NOTE> Display of scalar refs is not quite 100%
930
931		=cut
932
933		use vars qw(@Data_Stack);
934		my $DNE = bless [], 'Does::Not::Exist';
935		sub is_deeply {
936		my($this, $that, $name) = @_;
937
938		my $ok;
939		if( !ref $this \|\| !ref $that ) {
940		$ok = $Test->is_eq($this, $that, $name);
941		}
942		else {
943		local @Data_Stack = ();
944		if( _deep_check($this, $that) ) {
945		$ok = $Test->ok(1, $name);
946		}
947		else {
948		$ok = $Test->ok(0, $name);
949		$ok = $Test->diag(_format_stack(@Data_Stack));
950		}
951		}
952
953		return $ok;
954		}
955
956		sub _format_stack {
957		my(@Stack) = @_;
958
959		my $var = '$FOO';
960		my $did_arrow = 0;
961		foreach my $entry (@Stack) {
962		my $type = $entry->{type} \|\| '';
963		my $idx = $entry->{'idx'};
964		if( $type eq 'HASH' ) {
965		$var .= "->" unless $did_arrow++;
966		$var .= "{$idx}";
967		}
968		elsif( $type eq 'ARRAY' ) {
969		$var .= "->" unless $did_arrow++;
970		$var .= "[$idx]";
971		}
972		elsif( $type eq 'REF' ) {
973		$var = "\${$var}";
974		}
975		}
976
977		my @vals = @{$Stack[-1]{vals}}[0,1];
978		my @vars = ();
979		($vars[0] = $var) =~ s/\$FOO/ \$got/;
980		($vars[1] = $var) =~ s/\$FOO/\$expected/;
981
982		my $out = "Structures begin differing at:\n";
983		foreach my $idx (0..$#vals) {
984		my $val = $vals[$idx];
985		$vals[$idx] = !defined $val ? 'undef' :
986		$val eq $DNE ? "Does not exist"
987		: "'$val'";
988		}
989
990		$out .= "$vars[0] = $vals[0]\n";
991		$out .= "$vars[1] = $vals[1]\n";
992
993		$out =~ s/^/ /msg;
994		return $out;
995		}
996
997
998		=item B<eq_array>
999
1000		eq_array(\@this, \@that);
1001
1002		Checks if two arrays are equivalent. This is a deep check, so
1003		multi-level structures are handled correctly.
1004
1005		=cut
1006
1007		#'#
1008		sub eq_array {
1009		my($a1, $a2) = @_;
1010		return 1 if $a1 eq $a2;
1011
1012		my $ok = 1;
1013		my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
1014		for (0..$max) {
1015		my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
1016		my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
1017
1018		push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
1019		$ok = _deep_check($e1,$e2);
1020		pop @Data_Stack if $ok;
1021
1022		last unless $ok;
1023		}
1024		return $ok;
1025		}
1026
1027		sub _deep_check {
1028		my($e1, $e2) = @_;
1029		my $ok = 0;
1030
1031		my $eq;
1032		{
1033		# Quiet uninitialized value warnings when comparing undefs.
1034		local $^W = 0;
1035
1036		if( $e1 eq $e2 ) {
1037		$ok = 1;
1038		}
1039		else {
1040		if( UNIVERSAL::isa($e1, 'ARRAY') and
1041		UNIVERSAL::isa($e2, 'ARRAY') )
1042		{
1043		$ok = eq_array($e1, $e2);
1044		}
1045		elsif( UNIVERSAL::isa($e1, 'HASH') and
1046		UNIVERSAL::isa($e2, 'HASH') )
1047		{
1048		$ok = eq_hash($e1, $e2);
1049		}
1050		elsif( UNIVERSAL::isa($e1, 'REF') and
1051		UNIVERSAL::isa($e2, 'REF') )
1052		{
1053		push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
1054		$ok = _deep_check($$e1, $$e2);
1055		pop @Data_Stack if $ok;
1056		}
1057		elsif( UNIVERSAL::isa($e1, 'SCALAR') and
1058		UNIVERSAL::isa($e2, 'SCALAR') )
1059		{
1060		push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
1061		$ok = _deep_check($$e1, $$e2);
1062		}
1063		else {
1064		push @Data_Stack, { vals => [$e1, $e2] };
1065		$ok = 0;
1066		}
1067		}
1068		}
1069
1070		return $ok;
1071		}
1072
1073
1074		=item B<eq_hash>
1075
1076		eq_hash(\%this, \%that);
1077
1078		Determines if the two hashes contain the same keys and values. This
1079		is a deep check.
1080
1081		=cut
1082
1083		sub eq_hash {
1084		my($a1, $a2) = @_;
1085		return 1 if $a1 eq $a2;
1086
1087		my $ok = 1;
1088		my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
1089		foreach my $k (keys %$bigger) {
1090		my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
1091		my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
1092
1093		push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
1094		$ok = _deep_check($e1, $e2);
1095		pop @Data_Stack if $ok;
1096
1097		last unless $ok;
1098		}
1099
1100		return $ok;
1101		}
1102
1103		=item B<eq_set>
1104
1105		eq_set(\@this, \@that);
1106
1107		Similar to eq_array(), except the order of the elements is B<not>
1108		important. This is a deep check, but the irrelevancy of order only
1109		applies to the top level.
1110
1111		B<NOTE> By historical accident, this is not a true set comparision.
1112		While the order of elements does not matter, duplicate elements do.
1113
1114		=cut
1115
1116		# We must make sure that references are treated neutrally. It really
1117		# doesn't matter how we sort them, as long as both arrays are sorted
1118		# with the same algorithm.
1119		sub _bogus_sort { local $^W = 0; ref $a ? 0 : $a cmp $b }
1120
1121		sub eq_set {
1122		my($a1, $a2) = @_;
1123		return 0 unless @$a1 == @$a2;
1124
1125		# There's faster ways to do this, but this is easiest.
1126		return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] );
1127		}
1128
1129		=back
1130
1131
1132		=head2 Extending and Embedding Test::More
1133
1134		Sometimes the Test::More interface isn't quite enough. Fortunately,
1135		Test::More is built on top of Test::Builder which provides a single,
1136		unified backend for any test library to use. This means two test
1137		libraries which both use Test::Builder B<can be used together in the
1138		same program>.
1139
1140		If you simply want to do a little tweaking of how the tests behave,
1141		you can access the underlying Test::Builder object like so:
1142
1143		=over 4
1144
1145		=item B<builder>
1146
1147		my $test_builder = Test::More->builder;
1148
1149		Returns the Test::Builder object underlying Test::More for you to play
1150		with.
1151
1152		=cut
1153
1154		sub builder {
1155		return Test::Builder->new;
1156		}
1157
1158		=back
1159
1160
1161		=head1 NOTES
1162
1163		Test::More is B<explicitly> tested all the way back to perl 5.004.
1164
1165		Test::More is thread-safe for perl 5.8.0 and up.
1166
1167		=head1 BUGS and CAVEATS
1168
1169		=over 4
1170
1171		=item Making your own ok()
1172
1173		If you are trying to extend Test::More, don't. Use Test::Builder
1174		instead.
1175
1176		=item The eq_* family has some caveats.
1177
1178		=item Test::Harness upgrades
1179
1180		no_plan and todo depend on new Test::Harness features and fixes. If
1181		you're going to distribute tests that use no_plan or todo your
1182		end-users will have to upgrade Test::Harness to the latest one on
1183		CPAN. If you avoid no_plan and TODO tests, the stock Test::Harness
1184		will work fine.
1185
1186		If you simply depend on Test::More, it's own dependencies will cause a
1187		Test::Harness upgrade.
1188
1189		=back
1190
1191
1192		=head1 HISTORY
1193
1194		This is a case of convergent evolution with Joshua Pritikin's Test
1195		module. I was largely unaware of its existence when I'd first
1196		written my own ok() routines. This module exists because I can't
1197		figure out how to easily wedge test names into Test's interface (along
1198		with a few other problems).
1199
1200		The goal here is to have a testing utility that's simple to learn,
1201		quick to use and difficult to trip yourself up with while still
1202		providing more flexibility than the existing Test.pm. As such, the
1203		names of the most common routines are kept tiny, special cases and
1204		magic side-effects are kept to a minimum. WYSIWYG.
1205
1206
1207		=head1 SEE ALSO
1208
1209		L<Test::Simple> if all this confuses you and you just want to write
1210		some tests. You can upgrade to Test::More later (it's forward
1211		compatible).
1212
1213		L<Test::Differences> for more ways to test complex data structures.
1214		And it plays well with Test::More.
1215
1216		L<Test> is the old testing module. Its main benefit is that it has
1217		been distributed with Perl since 5.004_05.
1218
1219		L<Test::Harness> for details on how your test results are interpreted
1220		by Perl.
1221
1222		L<Test::Unit> describes a very featureful unit testing interface.
1223
1224		L<Test::Inline> shows the idea of embedded testing.
1225
1226		L<SelfTest> is another approach to embedded testing.
1227
1228
1229		=head1 AUTHORS
1230
1231		Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
1232		from Joshua Pritikin's Test module and lots of help from Barrie
1233		Slaymaker, Tony Bowden, chromatic and the perl-qa gang.
1234
1235
1236		=head1 COPYRIGHT
1237
1238		Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1239
1240		This program is free software; you can redistribute it and/or
1241		modify it under the same terms as Perl itself.
1242
1243		See F<http://www.perl.com/perl/misc/Artistic.html>
1244
1245		=cut
1246
1247		1;

+18

-27

t/t00basic.t less more

0		# Before `make install' is performed this script should be runnable with
1		# `make test'. After `make install' it should work as `perl test.pl'
	0	#!perl -w
	1	use strict;
	2	use Test::More tests => 15;
2	3
3		######################### We start with some black magic to print on failure.
4
5		# Change 1..1 below to 1..last_test_to_print .
6		# (It may become useful if the test is moved to ./t subdirectory.)
7
8		BEGIN { $\| = 1; print "1..2\n"; }
9		END {print "not ok 1\n" unless $loaded;}
10		use Imager;
11		#use Data::Dumper;
12		$loaded = 1;
13		print "ok 1\n";
14
15		init_log("testout/t00basic.log",1);
16
17		#list_formats();
18
19		#%hsh=%Imager::formats;
20		#print Dumper(\%hsh);
21
22		i_has_format("jpeg") && print "# has jpeg\n";
23		i_has_format("png") && print "# has png\n";
24
25		print "ok 2\n";
26
27		malloc_state();
	4	use_ok('Imager');
	5	use_ok('Imager::Font');
	6	use_ok('Imager::Color');
	7	use_ok('Imager::Color::Float');
	8	use_ok('Imager::Color::Table');
	9	use_ok('Imager::Matrix2d');
	10	use_ok('Imager::ExtUtils');
	11	use_ok('Imager::Expr');
	12	use_ok('Imager::Expr::Assem');
	13	use_ok('Imager::Font::BBox');
	14	use_ok('Imager::Font::Wrap');
	15	use_ok('Imager::Fountain');
	16	use_ok('Imager::Regops');
	17	use_ok('Imager::Test');
	18	use_ok('Imager::Transform');

+5

-3

t/t01introvert.t less more

2	2	# to make sure we get expected values
3	3
4	4	use strict;
5		use lib 't';
6	5	use Test::More tests=>196;
7	6
8	7	BEGIN { use_ok(Imager => qw(:handy :all)) }

424	423	my @plin_colors2 = ( $green, $red, $blue, $red );
425	424	is($im->setscanline('y'=>2, 'x'=>3, pixels=>\@plin_colors2), 4,
426	425	"setscanline - arrayref");
427		is_deeply([ ([ 0,0,0,0 ]) x 3, (map [ $_->rgba ], @plin_colors2),
428		([ 0,0,0,0 ]) x 3 ],
	426
	427	# using map instead of x here due to a bug in some versions of Test::More
	428	# fixed in the latest Test::More
	429	is_deeply([ ( map [ 0,0,0,0 ], 1..3), (map [ $_->rgba ], @plin_colors2),
	430	( map [ 0,0,0,0 ], 1..3) ],
429	431	[ map [ $_->rgba ], $im->getscanline('y'=>2) ],
430	432	"check write to middle of line");
431	433

+0

-1

t/t021sixteen.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 85;
4	3
5	4	BEGIN { use_ok(Imager=>qw(:all :handy)) }

+1

-2

t/t022double.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 81;
4	3
5	4	BEGIN { use_ok(Imager => qw(:all :handy)) }

61	60	# basic OO tests
62	61	my $ooimg = Imager->new(xsize=>200, ysize=>201, bits=>'double');
63	62	ok($ooimg, "couldn't make double image");
64		ok($ooimg->bits eq 'double', "oo didn't give double image");
	63	is($ooimg->bits, 'double', "oo didn't give double image");
65	64
66	65	# check that the image is copied correctly
67	66	my $oocopy = $ooimg->copy;

+26

-7

t/t023palette.t less more

0	0	#!perl -w
1	1	# some of this is tested in t01introvert.t too
2	2	use strict;
3		use lib 't';
4		use Test::More tests => 83;
	3	use Test::More tests => 90;
5	4	BEGIN { use_ok("Imager"); }
6	5
7	6	sub isbin($$$);

10	9
11	10	ok($img, "paletted image created");
12	11
13		ok($img->type eq 'paletted', "got a paletted image");
	12	is($img->type, 'paletted', "got a paletted image");
14	13
15	14	my $black = Imager::Color->new(0,0,0);
16	15	my $red = Imager::Color->new(255,0,0);

79	78
80	79	# draw on the image, make sure it stays paletted when it should
81	80	ok($img->box(color=>$red, filled=>1), "fill with red");
82		ok($img->type eq 'paletted', "paletted after fill");
	81	is($img->type, 'paletted', "paletted after fill");
83	82	ok($img->box(color=>$green, filled=>1, xmin=>10, ymin=>10,
84	83	xmax=>40, ymax=>40), "green box");
85		ok($img->type eq 'paletted', 'still paletted after box');
	84	is($img->type, 'paletted', 'still paletted after box');
86	85	# an AA line will almost certainly convert the image to RGB, don't use
87	86	# an AA line here
88	87	ok($img->line(color=>$blue, x1=>10, y1=>10, x2=>40, y2=>40),
89	88	"draw a line");
90		ok($img->type eq 'paletted', 'still paletted after line');
	89	is($img->type, 'paletted', 'still paletted after line');
91	90
92	91	# draw with white - should convert to direct
93	92	ok($img->box(color=>$white, filled=>1, xmin=>20, ymin=>20,
94	93	xmax=>30, ymax=>30), "white box");
95		ok($img->type eq 'direct', "now it should be direct");
	94	is($img->type, 'direct', "now it should be direct");
96	95
97	96	# various attempted to make a paletted image from our now direct image
98	97	my $palimg = $img->to_paletted;

267	266	ok($@, "croak on setscanline() with pv to invalid index");
268	267	}
269	268
	269	{
	270	print "# make_colors => mono\n";
	271	# test mono make_colors
	272	my $imrgb = Imager->new(xsize => 10, ysize => 10);
	273	$imrgb->setpixel(x => 0, 'y' => 0, color => '#FFF');
	274	$imrgb->setpixel(x => 1, 'y' => 0, color => '#FF0');
	275	$imrgb->setpixel(x => 2, 'y' => 0, color => '#000');
	276	my $mono = $imrgb->to_paletted(make_colors => 'mono',
	277	translate => 'closest');
	278	is($mono->type, 'paletted', "check we get right image type");
	279	is($mono->colorcount, 2, "only 2 colors");
	280	my @colors = $mono->getcolors;
	281	iscolor($colors[0], $black, "check first entry");
	282	iscolor($colors[1], $white, "check second entry");
	283	my @pixels = $mono->getscanline(x => 0, 'y' => 0, width => 3, type=>'index');
	284	is($pixels[0], 1, "check white pixel");
	285	is($pixels[1], 1, "check yellow pixel");
	286	is($pixels[2], 0, "check black pixel");
	287	}
	288
270	289	sub iscolor {
271	290	my ($c1, $c2, $msg) = @_;
272	291

+2

-3

t/t07iolayer.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 68;
4	3	# for SEEK_SET etc, Fcntl doesn't provide these in 5.005_03
5	4	use IO::Seekable;

108	107	ok(Imager::i_writeppm_wiol($im, $IO8), "write to cb");
109	108	# I originally compared this to $data, but that doesn't include the
110	109	# Imager header
111		ok($work eq $data2, "write image match");
	110	is($work, $data2, "write image match");
112	111	ok($did_close, "did close");
113	112
114	113	# with a short buffer, no closer

117	116	$pos = 0;
118	117	$work = '';
119	118	ok(Imager::i_writeppm_wiol($im, $IO9), "write to short cb");
120		ok($work eq $data2, "short write image match");
	119	is($work, $data2, "short write image match");
121	120
122	121	{
123	122	my $buf_data = "Test data";

+0

-1

t/t1000files.t less more

3	3	# the file format
4	4
5	5	use strict;
6		use lib 't';
7	6	use Test::More tests => 32;
8	7	use Imager;
9	8

+0

-1

t/t101jpeg.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Imager qw(:all);
4	3	use Test::More tests => 86;
5	4

+0

-1

t/t102png.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 32;
4	3	# Before `make install' is performed this script should be runnable with
5	4	# `make test'. After `make install' it should work as `perl test.pl'

+0

-1

t/t103raw.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 23;
4	3	use Imager qw(:all);
5	4	init_log("testout/t103raw.log",1);

+276

-34

t/t104ppm.t less more

0	0	#!perl -w
1	1	use Imager ':all';
2		use lib 't';
3		use Test::More tests => 64;
	2	use Test::More tests => 143;
4	3	use strict;
	4	use Imager::Test qw(test_image_raw test_image_16 is_color3 is_color1 is_image);
5	5
6	6	init_log("testout/t104ppm.log",1);
7	7

9	9	my $blue = i_color_new(0,0,255,255);
10	10	my $red = i_color_new(255,0,0,255);
11	11
12		my $img = Imager::ImgRaw::new(150,150,3);
13
14		i_box_filled($img,70,25,130,125,$green);
15		i_box_filled($img,20,25,80,125,$blue);
16		i_arc($img,75,75,30,0,361,$red);
17		i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
	12	my $img = test_image_raw();
18	13
19	14	my $fh = openimage(">testout/t104.ppm");
20	15	my $IO = Imager::io_new_fd(fileno($fh));

65	60	my $ooim = Imager->new;
66	61	ok($ooim->read(file=>"testimg/simple.pbm"), "read simple pbm, via OO");
67	62
68		check_gray(Imager::i_get_pixel($ooim->{IMG}, 0, 0), 255);
69		check_gray(Imager::i_get_pixel($ooim->{IMG}, 0, 1), 0);
70		check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 0), 0);
71		check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 1), 255);
	63	check_gray(Imager::i_get_pixel($ooim->{IMG}, 0, 0), 0);
	64	check_gray(Imager::i_get_pixel($ooim->{IMG}, 0, 1), 255);
	65	check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 0), 255);
	66	check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 1), 0);
	67	is($ooim->type, 'paletted', "check pbm read as paletted");
	68	is($ooim->tags(name=>'pnm_type'), 1, "check pnm_type tag");
72	69
73	70	{
74	71	# https://rt.cpan.org/Ticket/Display.html?id=7465

87	84
88	85	# check the pixels
89	86	ok(my ($white, $grey, $green) = $maxval->getpixel('x'=>[0,1,2], 'y'=>[0,0,0]), "fetch pixels");
90		check_color($white, 255, 255, 255, "white pixel");
91		check_color($grey, 130, 130, 130, "grey pixel");
92		check_color($green, 125, 125, 0, "green pixel");
	87	is_color3($white, 255, 255, 255, "white pixel");
	88	is_color3($grey, 130, 130, 130, "grey pixel");
	89	is_color3($green, 125, 125, 0, "green pixel");
	90	is($maxval->tags(name=>'pnm_type'), 6, "check pnm_type tag on maxval");
93	91
94	92	# and do the same for ASCII images
95	93	my $maxval_asc = Imager->new;

103	101	is($maxval_asc->getchannels, 3, "channel count");
104	102	is($maxval_asc->getwidth, 3, "width");
105	103	is($maxval_asc->getheight, 1, "height");
	104
	105	is($maxval->tags(name=>'pnm_type'), 6, "check pnm_type tag on maxval");
106	106
107	107	# check the pixels
108	108	ok(my ($white_asc, $grey_asc, $green_asc) = $maxval_asc->getpixel('x'=>[0,1,2], 'y'=>[0,0,0]), "fetch pixels");
109		check_color($white_asc, 255, 255, 255, "white asc pixel");
110		check_color($grey_asc, 130, 130, 130, "grey asc pixel");
111		check_color($green_asc, 125, 125, 0, "green asc pixel");
	109	is_color3($white_asc, 255, 255, 255, "white asc pixel");
	110	is_color3($grey_asc, 130, 130, 130, "grey asc pixel");
	111	is_color3($green_asc, 125, 125, 0, "green asc pixel");
112	112	}
113	113
114	114	{ # previously we didn't validate maxval at all, make sure it's

127	127	like($maxval65536->errstr, qr/maxval of 65536 is over 65535 - invalid pnm file/,
128	128	"error expected from reading maxval_65536.ppm");
129	129
130		# maxval of 256 is valid, but Imager can't handle it yet in binary files
	130	# maxval of 256 is valid, and handled as of 0.56
131	131	my $maxval256 = Imager->new;
132		ok(!$maxval256->read(file=>'testimg/maxval_256.ppm'),
133		"should fail reading maxval 256 image");
134		print "# ",$maxval256->errstr,"\n";
135		like($maxval256->errstr, qr/maxval of 256 is over 255 - not currently supported by Imager/,
136		"error expected from reading maxval_256.ppm");
	132	ok($maxval256->read(file=>'testimg/maxval_256.ppm'),
	133	"should succeed reading maxval 256 image");
	134	is_color3($maxval256->getpixel(x => 0, 'y' => 0),
	135	0, 0, 0, "check black in maxval_256");
	136	is_color3($maxval256->getpixel(x => 0, 'y' => 1),
	137	255, 255, 255, "check white in maxval_256");
	138	is($maxval256->bits, 16, "check bits/sample on maxval 256");
137	139
138	140	# make sure we handle maxval > 255 for ascii
139	141	my $maxval4095asc = Imager->new;

142	144	is($maxval4095asc->getchannels, 3, "channels");
143	145	is($maxval4095asc->getwidth, 3, "width");
144	146	is($maxval4095asc->getheight, 1, "height");
	147	is($maxval4095asc->bits, 16, "check bits/sample on maxval 4095");
145	148
146	149	ok(my ($white, $grey, $green) = $maxval4095asc->getpixel('x'=>[0,1,2], 'y'=>[0,0,0]), "fetch pixels");
147		check_color($white, 255, 255, 255, "white 4095 pixel");
148		check_color($grey, 128, 128, 128, "grey 4095 pixel");
149		check_color($green, 127, 127, 0, "green 4095 pixel");
	150	is_color3($white, 255, 255, 255, "white 4095 pixel");
	151	is_color3($grey, 128, 128, 128, "grey 4095 pixel");
	152	is_color3($green, 127, 127, 0, "green 4095 pixel");
150	153	}
151	154
152	155	{ # check i_format is set when reading a pnm file

194	197	Imager->set_file_limits(reset=>1);
195	198	}
196	199
	200	{
	201	# check we correctly sync with the data stream
	202	my $im = Imager->new;
	203	ok($im->read(file => 'testimg/pgm.pgm', type => 'pnm'),
	204	"read pgm.pgm")
	205	or print "# cannot read pgm.pgm: ", $im->errstr, "\n";
	206	print "# ", $im->getsamples('y' => 0), "\n";
	207	is_color1($im->getpixel(x=>0, 'y' => 0), 254, "check top left");
	208	}
	209
197	210	{ # check error messages set correctly
198	211	my $im = Imager->new(xsize=>100, ysize=>100, channels=>4);
199	212	ok(!$im->write(file=>"testout/t104_fail.ppm", type=>'pnm'),

206	219	"check error message");
207	220	}
208	221
	222	# various bad input files
	223	print "# check error handling\n";
	224	{
	225	my $im = Imager->new;
	226	ok(!$im->read(file => 'testimg/short_bin.ppm', type=>'pnm'),
	227	"fail to read short bin ppm");
	228	cmp_ok($im->errstr, '=~', 'short read - file truncated',
	229	"check error message");
	230	}
	231
	232	{
	233	my $im = Imager->new;
	234	ok(!$im->read(file => 'testimg/short_bin16.ppm', type=>'pnm'),
	235	"fail to read short bin ppm (maxval 65535)");
	236	cmp_ok($im->errstr, '=~', 'short read - file truncated',
	237	"check error message");
	238	}
	239
	240	{
	241	my $im = Imager->new;
	242	ok(!$im->read(file => 'testimg/short_bin.pgm', type=>'pnm'),
	243	"fail to read short bin pgm");
	244	cmp_ok($im->errstr, '=~', 'short read - file truncated',
	245	"check error message");
	246	}
	247
	248	{
	249	my $im = Imager->new;
	250	ok(!$im->read(file => 'testimg/short_bin16.pgm', type=>'pnm'),
	251	"fail to read short bin pgm (maxval 65535)");
	252	cmp_ok($im->errstr, '=~', 'short read - file truncated',
	253	"check error message");
	254	}
	255
	256	{
	257	my $im = Imager->new;
	258	ok(!$im->read(file => 'testimg/short_bin.pbm', type => 'pnm'),
	259	"fail to read a short bin pbm");
	260	cmp_ok($im->errstr, '=~', 'short read - file truncated',
	261	"check error message");
	262	}
	263
	264	{
	265	my $im = Imager->new;
	266	ok(!$im->read(file => 'testimg/short_asc.ppm', type => 'pnm'),
	267	"fail to read a short asc ppm");
	268	cmp_ok($im->errstr, '=~', 'short read - file truncated',
	269	"check error message");
	270	}
	271
	272	{
	273	my $im = Imager->new;
	274	ok(!$im->read(file => 'testimg/short_asc.pgm', type => 'pnm'),
	275	"fail to read a short asc pgm");
	276	cmp_ok($im->errstr, '=~', 'short read - file truncated',
	277	"check error message");
	278	}
	279
	280	{
	281	my $im = Imager->new;
	282	ok(!$im->read(file => 'testimg/short_asc.pbm', type => 'pnm'),
	283	"fail to read a short asc pbm");
	284	cmp_ok($im->errstr, '=~', 'short read - file truncated',
	285	"check error message");
	286	}
	287
	288	{
	289	my $im = Imager->new;
	290	ok(!$im->read(file => 'testimg/bad_asc.ppm', type => 'pnm'),
	291	"fail to read a bad asc ppm");
	292	cmp_ok($im->errstr, '=~', 'invalid data for ascii pnm',
	293	"check error message");
	294	}
	295
	296	{
	297	my $im = Imager->new;
	298	ok(!$im->read(file => 'testimg/bad_asc.pgm', type => 'pnm'),
	299	"fail to read a bad asc pgm");
	300	cmp_ok($im->errstr, '=~', 'invalid data for ascii pnm',
	301	"check error message");
	302	}
	303
	304	{
	305	my $im = Imager->new;
	306	ok(!$im->read(file => 'testimg/bad_asc.pbm', type => 'pnm'),
	307	"fail to read a bad asc pbm");
	308	cmp_ok($im->errstr, '=~', 'invalid data for ascii pnm',
	309	"check error message");
	310	}
	311
	312	{
	313	my $im = Imager->new;
	314	ok($im->read(file => 'testimg/short_bin.ppm', type => 'pnm',
	315	allow_incomplete => 1),
	316	"partial read bin ppm");
	317	is($im->tags(name => 'i_incomplete'), 1, "partial flag set");
	318	is($im->tags(name => 'i_lines_read'), 1, "lines_read set");
	319	}
	320
	321	{
	322	my $im = Imager->new;
	323	ok($im->read(file => 'testimg/short_bin16.ppm', type => 'pnm',
	324	allow_incomplete => 1),
	325	"partial read bin16 ppm");
	326	is($im->tags(name => 'i_incomplete'), 1, "partial flag set");
	327	is($im->tags(name => 'i_lines_read'), 1, "lines_read set");
	328	is($im->bits, 16, "check correct bits");
	329	}
	330
	331	{
	332	my $im = Imager->new;
	333	ok($im->read(file => 'testimg/short_bin.pgm', type => 'pnm',
	334	allow_incomplete => 1),
	335	"partial read bin pgm");
	336	is($im->tags(name => 'i_incomplete'), 1, "partial flag set");
	337	is($im->tags(name => 'i_lines_read'), 1, "lines_read set");
	338	}
	339
	340	{
	341	my $im = Imager->new;
	342	ok($im->read(file => 'testimg/short_bin16.pgm', type => 'pnm',
	343	allow_incomplete => 1),
	344	"partial read bin16 pgm");
	345	is($im->tags(name => 'i_incomplete'), 1, "partial flag set");
	346	is($im->tags(name => 'i_lines_read'), 1, "lines_read set");
	347	}
	348
	349	{
	350	my $im = Imager->new;
	351	ok($im->read(file => 'testimg/short_bin.pbm', type => 'pnm',
	352	allow_incomplete => 1),
	353	"partial read bin pbm");
	354	is($im->tags(name => 'i_incomplete'), 1, "partial flag set");
	355	is($im->tags(name => 'i_lines_read'), 1, "lines_read set");
	356	}
	357
	358	{
	359	my $im = Imager->new;
	360	ok($im->read(file => 'testimg/short_asc.ppm', type => 'pnm',
	361	allow_incomplete => 1),
	362	"partial read asc ppm");
	363	is($im->tags(name => 'i_incomplete'), 1, "partial flag set");
	364	is($im->tags(name => 'i_lines_read'), 1, "lines_read set");
	365	}
	366
	367	{
	368	my $im = Imager->new;
	369	ok($im->read(file => 'testimg/short_asc.pgm', type => 'pnm',
	370	allow_incomplete => 1),
	371	"partial read asc pgm");
	372	is($im->tags(name => 'i_incomplete'), 1, "partial flag set");
	373	is($im->tags(name => 'i_lines_read'), 1, "lines_read set");
	374	}
	375
	376	{
	377	my $im = Imager->new;
	378	ok($im->read(file => 'testimg/short_asc.pbm', type => 'pnm',
	379	allow_incomplete => 1),
	380	"partial read asc pbm");
	381	is($im->tags(name => 'i_incomplete'), 1, "partial flag set");
	382	is($im->tags(name => 'i_lines_read'), 1, "lines_read set");
	383	}
	384
	385	{
	386	my $im = Imager->new;
	387	ok($im->read(file => 'testimg/bad_asc.ppm', type => 'pnm',
	388	allow_incomplete => 1),
	389	"partial read bad asc ppm");
	390	is($im->tags(name => 'i_incomplete'), 1, "partial flag set");
	391	is($im->tags(name => 'i_lines_read'), 1, "lines_read set");
	392	}
	393
	394	{
	395	my $im = Imager->new;
	396	ok($im->read(file => 'testimg/bad_asc.pgm', type => 'pnm',
	397	allow_incomplete => 1),
	398	"partial read bad asc pgm");
	399	is($im->tags(name => 'i_incomplete'), 1, "partial flag set");
	400	is($im->tags(name => 'i_lines_read'), 1, "lines_read set");
	401	}
	402
	403	{
	404	my $im = Imager->new;
	405	ok($im->read(file => 'testimg/bad_asc.pbm', type => 'pnm',
	406	allow_incomplete => 1),
	407	"partial read bad asc pbm");
	408	is($im->tags(name => 'i_incomplete'), 1, "partial flag set");
	409	is($im->tags(name => 'i_lines_read'), 1, "lines_read set");
	410	}
	411
	412	{
	413	print "# monochrome output\n";
	414	my $im = Imager->new(xsize => 10, ysize => 10, type => 'paletted');
	415	ok($im->addcolors(colors => [ '#000000', '#FFFFFF' ]),
	416	"add black and white");
	417	$im->box(filled => 1, xmax => 4, color => '#000000');
	418	$im->box(filled => 1, xmin => 5, color => '#FFFFFF');
	419	is($im->type, 'paletted', 'mono still paletted');
	420	ok($im->write(file => 'testout/t104_mono.pbm', type => 'pnm'),
	421	"save as pbm");
	422
	423	# check it
	424	my $imread = Imager->new;
	425	ok($imread->read(file => 'testout/t104_mono.pbm', type=>'pnm'),
	426	"read it back in")
	427	or print "# ", $imread->errstr, "\n";
	428	is($imread->type, 'paletted', "check result is paletted");
	429	is($imread->tags(name => 'pnm_type'), 4, "check type");
	430	}
	431
	432	{
	433	print "# 16-bit output\n";
	434	my $data;
	435	my $im = test_image_16();
	436
	437	# without tag, it should do 8-bit output
	438	ok($im->write(data => \$data, type => 'pnm'),
	439	"write 16-bit image as 8-bit/sample ppm");
	440	my $im8 = Imager->new;
	441	ok($im8->read(data => $data), "read it back");
	442	is($im8->tags(name => 'pnm_maxval'), 255, "check maxval");
	443	is_image($im, $im8, "check image matches");
	444
	445	# try 16-bit output
	446	$im->settag(name => 'pnm_write_wide_data', value => 1);
	447	$data = '';
	448	ok($im->write(data => \$data, type => 'pnm'),
	449	"write 16-bit image as 16-bit/sample ppm");
	450	$im->write(file=>'testout/t104_16.ppm');
	451	my $im16 = Imager->new;
	452	ok($im16->read(data => $data), "read it back");
	453	is($im16->tags(name => 'pnm_maxval'), 65535, "check maxval");
	454	$im16->write(file=>'testout/t104_16b.ppm');
	455	is_image($im, $im16, "check image matches");
	456	}
	457
209	458	sub openimage {
210	459	my $fname = shift;
211	460	local(*FH);

229	478	is($g, $gray, "compare gray");
230	479	}
231	480
232		sub check_color {
233		my ($c, $red, $green, $blue, $note) = @_;
234
235		my ($r, $g, $b) = $c->rgba;
236		is_deeply([ $r, $g, $b], [ $red, $green, $blue ],
237		"$note ($r, $g, $b) compared to ($red, $green, $blue)");
238		}

+22

-3

t/t105gif.t less more

0	0	#!perl -w
	1
1	2	=pod
2	3
3	4	IF THIS TEST CRASHES

10	11
11	12	use strict;
12	13	$\|=1;
13		use lib 't';
14		use Test::More tests => 113;
	14	use Test::More tests => 125;
15	15	use Imager qw(:all);
16	16	BEGIN { require "t/testtools.pl"; }
17	17	use Carp 'confess';

47	47	$im = Imager->new(xsize=>2, ysize=>2);
48	48	ok(!$im->write(file=>"testout/nogif.gif"), "should fail to write gif");
49	49	is($im->errstr, 'format not supported', "check no gif message");
50		skip("no gif support", 109);
	50	skip("no gif support", 121);
51	51	}
52	52	open(FH,">testout/t105.gif") \|\| die "Cannot open testout/t105.gif\n";
53	53	binmode(FH);

668	668	is($im[0]->tags(name => 'gif_delay'), 50, "first delay read back");
669	669	is($im[1]->tags(name => 'gif_delay'), 50, "second delay read back");
670	670	}
	671	SKIP:
	672	{ # check graphic control extension and ns loop tags are read correctly
	673	print "# check GCE and netscape loop extension tag values\n";
	674	my @im = Imager->read_multi(file => 'testimg/screen3.gif');
	675	is(@im, 2, "read 2 images from screen3.gif")
	676	or skip("Could not load testimg/screen3.gif:".Imager->errstr, 11);
	677	is($im[0]->tags(name => 'gif_delay'), 50, "0 - gif_delay");
	678	is($im[0]->tags(name => 'gif_disposal'), 2, "0 - gif_disposal");
	679	is($im[0]->tags(name => 'gif_trans_index'), undef, "0 - gif_trans_index");
	680	is($im[0]->tags(name => 'gif_user_input'), 0, "0 - gif_user_input");
	681	is($im[0]->tags(name => 'gif_loop'), 0, "0 - gif_loop");
	682	is($im[1]->tags(name => 'gif_delay'), 50, "1 - gif_delay");
	683	is($im[1]->tags(name => 'gif_disposal'), 2, "1 - gif_disposal");
	684	is($im[1]->tags(name => 'gif_trans_index'), 7, "1 - gif_trans_index");
	685	is($im[1]->tags(name => 'gif_trans_color'), 'color(255,255,255,0)',
	686	"1 - gif_trans_index");
	687	is($im[1]->tags(name => 'gif_user_input'), 0, "1 - gif_user_input");
	688	is($im[1]->tags(name => 'gif_loop'), 0, "1 - gif_loop");
	689	}
671	690	}
672	691
673	692	sub test_readgif_cb {

+14

-15

t/t106tiff.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 127;
4	3	use Imager qw(:all);
5	4	$^W=1; # warnings during command-line tests

141	140	# paletted reads
142	141	my $img4 = Imager->new;
143	142	ok($img4->read(file=>'testimg/comp4.tif'), "reading 4-bit paletted");
144		ok($img4->type eq 'paletted', "image isn't paletted");
	143	is($img4->type, 'paletted', "image isn't paletted");
145	144	print "# colors: ", $img4->colorcount,"\n";
146		ok($img4->colorcount <= 16, "more than 16 colors!");
	145	cmp_ok($img4->colorcount, '<=', 16, "more than 16 colors!");
147	146	#ok($img4->write(file=>'testout/t106_was4.ppm'),
148	147	# "Cannot write img4");
149	148	# I know I'm using BMP before it's test, but comp4.tif started life

155	154	ok($diff == 0, "image mismatch");
156	155	my $img8 = Imager->new;
157	156	ok($img8->read(file=>'testimg/comp8.tif'), "reading 8-bit paletted");
158		ok($img8->type eq 'paletted', "image isn't paletted");
	157	is($img8->type, 'paletted', "image isn't paletted");
159	158	print "# colors: ", $img8->colorcount,"\n";
160	159	#ok($img8->write(file=>'testout/t106_was8.ppm'),
161	160	# "Cannot write img8");

166	165	print "# diff $diff\n";
167	166	ok($diff == 0, "image mismatch");
168	167	my $bad = Imager->new;
169		ok($bad->read(file=>'testimg/comp4bad.tif'), "bad image not returned");
	168	ok($bad->read(file=>'testimg/comp4bad.tif',
	169	allow_incomplete=>1), "bad image not returned");
170	170	ok(scalar $bad->tags(name=>'i_incomplete'), "incomplete tag not set");
171	171	ok($img8->write(file=>'testout/t106_pal8.tif'), "writing 8-bit paletted");
172	172	my $cmp8 = Imager->new;
173	173	ok($cmp8->read(file=>'testout/t106_pal8.tif'),
174	174	"reading 8-bit paletted");
175	175	#print "# ",$cmp8->errstr,"\n";
176		ok($cmp8->type eq 'paletted', "pal8 isn't paletted");
177		ok($cmp8->colorcount == 256, "pal8 bad colorcount");
	176	is($cmp8->type, 'paletted', "pal8 isn't paletted");
	177	is($cmp8->colorcount, 256, "pal8 bad colorcount");
178	178	$diff = i_img_diff($img8->{IMG}, $cmp8->{IMG});
179	179	print "# diff $diff\n";
180	180	ok($diff == 0, "written image doesn't match read");
181	181	ok($img4->write(file=>'testout/t106_pal4.tif'), "writing 4-bit paletted");
182	182	ok(my $cmp4 = Imager->new->read(file=>'testout/t106_pal4.tif'),
183	183	"reading 4-bit paletted");
184		ok($cmp4->type eq 'paletted', "pal4 isn't paletted");
185		ok($cmp4->colorcount == 16, "pal4 bad colorcount");
	184	is($cmp4->type, 'paletted', "pal4 isn't paletted");
	185	is($cmp4->colorcount, 16, "pal4 bad colorcount");
186	186	$diff = i_img_diff($img4->{IMG}, $cmp4->{IMG});
187	187	print "# diff $diff\n";
188	188	ok($diff == 0, "written image doesn't match read");

259	259	\&io_closer);
260	260	ok($IO4, "new writecb obj");
261	261	ok(i_writetiff_wiol($img, $IO4), "write to cb");
262		ok($work eq $odata, "write cb match");
	262	is($work, $odata, "write cb match");
263	263	ok($did_close, "write cb did close");
264	264	open D1, ">testout/d1.tiff" or die;
265	265	print D1 $work;

276	276	\&io_closer, 1);
277	277	ok($IO5, "new writecb obj 2");
278	278	ok(i_writetiff_wiol($img, $IO5), "write to cb2");
279		ok($work eq $odata, "write cb2 match");
	279	is($work, $odata, "write cb2 match");
280	280	ok($did_close, "write cb2 did close");
281	281
282	282	open D3, ">testout/d3.tiff" or die;

298	298	ok(i_img_diff($imgs[$i]{IMG}, $out[$i]{IMG}) == 0,
299	299	"comparing image $i");
300	300	my ($tag) = $out[$i]->tags(name=>'tiff_pagename');
301		ok($tag eq "Page ".($i+1),
	301	is($tag, "Page ".($i+1),
302	302	"tag doesn't match original image");
303	303	}
304	304

323	323	"compare second fax image");
324	324
325	325	my ($format) = $imgs[0]->tags(name=>'i_format');
326		ok(defined $format && $format eq 'tiff', "check i_format tag");
	326	is($format, 'tiff', "check i_format tag");
327	327
328	328	my $unit = $imgs[0]->tags(name=>'tiff_resolutionunit');
329	329	ok(defined $unit && $unit == 2, "check tiff_resolutionunit tag");
330	330	my $unitname = $imgs[0]->tags(name=>'tiff_resolutionunit_name');
331		ok(defined $unitname && $unitname eq 'inch',
332		"check tiff_resolutionunit_name tag");
	331	is($unitname, 'inch', "check tiff_resolutionunit_name tag");
333	332
334	333	my $warned = Imager->new;
335	334	ok($warned->read(file=>"testimg/tiffwarn.tif"), "read tiffwarn.tif");

+413

-11

t/t107bmp.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3		use Test::More tests => 89;
	2	use Test::More tests => 191;
4	3	use Imager qw(:all);
	4	use Imager::Test qw(test_image_raw is_image);
5	5	init_log("testout/t107bmp.log",1);
6		#BEGIN { require 't/testtools.pl'; } # BEGIN to apply prototypes
	6
	7	my $debug_writes = 0;
7	8
8	9	my $base_diff = 0;
9	10	# if you change this make sure you generate new compressed versions

11	12	my $blue=i_color_new(0,0,255,255);
12	13	my $red=i_color_new(255,0,0,255);
13	14
14		my $img=Imager::ImgRaw::new(150,150,3);
15
16		i_box_filled($img,70,25,130,125,$green);
17		i_box_filled($img,20,25,80,125,$blue);
18		i_arc($img,75,75,30,0,361,$red);
19		i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
	15	my $img = test_image_raw();
20	16
21	17	Imager::i_tags_add($img, 'i_xres', 0, '300', 0);
22	18	Imager::i_tags_add($img, 'i_yres', 0, undef, 300);

182	178	}
183	179
184	180	{ # check file limits are checked
185		my $limit_file = "testout/t104.ppm";
	181	my $limit_file = "testout/t107_24bit.bmp";
186	182	ok(Imager->set_file_limits(reset=>1, width=>149), "set width limit 149");
187	183	my $im = Imager->new;
188	184	ok(!$im->read(file=>$limit_file),

216	212	"should succeed - just inside bytes limit");
217	213	Imager->set_file_limits(reset=>1);
218	214	}
219
	215
	216	{ # various short read failure tests, each entry has:
	217	# source filename, size, expected error
	218	# these have been selected based on code coverage, to check each
	219	# failure path is checked, where practical
	220	my @tests =
	221	(
	222	[
	223	"file truncated inside header",
	224	"winrgb2.bmp",
	225	20, "file too short to be a BMP file"
	226	],
	227	[
	228	"1-bit, truncated inside palette",
	229	"winrgb2.bmp",
	230	56, "reading BMP palette"
	231	],
	232	[
	233	"1-bit, truncated in offset region",
	234	"winrgb2off.bmp", 64, "failed skipping to image data offset"
	235	],
	236	[
	237	"1-bit, truncated in image data",
	238	"winrgb2.bmp", 96, "failed reading 1-bit bmp data"
	239	],
	240	[
	241	"4-bit, truncated inside palette",
	242	"winrgb4.bmp",
	243	56, "reading BMP palette"
	244	],
	245	[
	246	"4-bit, truncated in offset region",
	247	"winrgb4off.bmp", 120, "failed skipping to image data offset",
	248	],
	249	[
	250	"4-bit, truncate in image data",
	251	"winrgb4.bmp", 120, "failed reading 4-bit bmp data"
	252	],
	253	[
	254	"4-bit RLE, truncate in uncompressed data",
	255	"comp4.bmp", 0x229, "missing data during decompression"
	256	],
	257	[
	258	"8-bit, truncated in palette",
	259	"winrgb8.bmp", 1060, "reading BMP palette"
	260	],
	261	[
	262	"8-bit, truncated in offset region",
	263	"winrgb8off.bmp", 1080, "failed skipping to image data offset"
	264	],
	265	[
	266	"8-bit, truncated in image data",
	267	"winrgb8.bmp", 1080, "failed reading 8-bit bmp data"
	268	],
	269	[
	270	"8-bit RLE, truncate in uncompressed data",
	271	"comp8.bmp", 0x68C, "missing data during decompression"
	272	],
	273	[
	274	"24-bit, truncate in offset region",
	275	"winrgb24off.bmp", 56, "failed skipping to image data offset",
	276	],
	277	[
	278	"24-bit, truncate in image data",
	279	"winrgb24.bmp", 100, "failed reading image data",
	280	],
	281	);
	282
	283	my $test_index = 0;
	284	for my $test (@tests) {
	285	my ($desc, $srcfile, $size, $error) = @$test;
	286	my $im = Imager->new;
	287	open IMDATA, "< testimg/$srcfile"
	288	or die "$test_index - $desc: Cannot open testimg/$srcfile: $!";
	289	binmode IMDATA;
	290	my $data;
	291	read(IMDATA, $data, $size) == $size
	292	or die "$test_index - $desc: Could not read $size data from $srcfile";
	293	close IMDATA;
	294	ok(!$im->read(data => $data, type =>'bmp'),
	295	"$test_index - $desc: Should fail to read");
	296	is($im->errstr, $error, "$test_index - $desc: check message");
	297	++$test_index;
	298	}
	299	}
	300
	301	{ # various short read success tests, each entry has:
	302	# source filename, size, expected tags
	303	print "# allow_incomplete tests\n";
	304	my @tests =
	305	(
	306	[
	307	"1-bit",
	308	"winrgb2.bmp", 96,
	309	{
	310	bmp_compression_name => 'BI_RGB',
	311	bmp_compression => 0,
	312	bmp_used_colors => 2,
	313	i_lines_read => 8,
	314	},
	315	],
	316	[
	317	"4-bit",
	318	"winrgb4.bmp", 250,
	319	{
	320	bmp_compression_name => 'BI_RGB',
	321	bmp_compression => 0,
	322	bmp_used_colors => 16,
	323	i_lines_read => 11,
	324	},
	325	],
	326	[
	327	"4-bit RLE - uncompressed seq",
	328	"comp4.bmp", 0x229,
	329	{
	330	bmp_compression_name => 'BI_RLE4',
	331	bmp_compression => 2,
	332	bmp_used_colors => 16,
	333	i_lines_read => 44,
	334	},
	335	],
	336	[
	337	"4-bit RLE - start seq",
	338	"comp4.bmp", 0x97,
	339	{
	340	bmp_compression_name => 'BI_RLE4',
	341	bmp_compression => 2,
	342	bmp_used_colors => 16,
	343	i_lines_read => 8,
	344	},
	345	],
	346	[
	347	"8-bit",
	348	"winrgb8.bmp", 1250,
	349	{
	350	bmp_compression_name => 'BI_RGB',
	351	bmp_compression => 0,
	352	bmp_used_colors => 256,
	353	i_lines_read => 8,
	354	},
	355	],
	356	[
	357	"8-bit RLE - uncompressed seq",
	358	"comp8.bmp", 0x68C,
	359	{
	360	bmp_compression_name => 'BI_RLE8',
	361	bmp_compression => 1,
	362	bmp_used_colors => 256,
	363	i_lines_read => 27,
	364	},
	365	],
	366	[
	367	"8-bit RLE - initial seq",
	368	"comp8.bmp", 0x487,
	369	{
	370	bmp_compression_name => 'BI_RLE8',
	371	bmp_compression => 1,
	372	bmp_used_colors => 256,
	373	i_lines_read => 20,
	374	},
	375	],
	376	[
	377	"24-bit",
	378	"winrgb24.bmp", 800,
	379	{
	380	bmp_compression_name => 'BI_RGB',
	381	bmp_compression => 0,
	382	bmp_used_colors => 0,
	383	i_lines_read => 12,
	384	},
	385	],
	386	);
	387
	388	my $test_index = 0;
	389	for my $test (@tests) {
	390	my ($desc, $srcfile, $size, $tags) = @$test;
	391	my $im = Imager->new;
	392	open IMDATA, "< testimg/$srcfile"
	393	or die "$test_index - $desc: Cannot open testimg/$srcfile: $!";
	394	binmode IMDATA;
	395	my $data;
	396	read(IMDATA, $data, $size) == $size
	397	or die "$test_index - $desc: Could not read $size data from $srcfile";
	398	close IMDATA;
	399	ok($im->read(data => $data, type =>'bmp', allow_incomplete => 1),
	400	"$test_index - $desc: Should read successfully");
	401	# check standard tags are set
	402	is($im->tags(name => 'i_format'), 'bmp',
	403	"$test_index - $desc: i_format set");
	404	is($im->tags(name => 'i_incomplete'), 1,
	405	"$test_index - $desc: i_incomplete set");
	406	my %check_tags;
	407	for my $key (keys %$tags) {
	408	$check_tags{$key} = $im->tags(name => $key);
	409	}
	410	is_deeply(\%check_tags, $tags, "$test_index - $desc: check tags");
	411	++$test_index;
	412	}
	413	}
	414
	415	{ # check handling of reading images with negative height
	416	# each entry is:
	417	# source file, description
	418	print "# check handling of negative height values\n";
	419	my @tests =
	420	(
	421	[ "winrgb2.bmp", "1-bit, uncompressed" ],
	422	[ "winrgb4.bmp", "4-bit, uncompressed" ],
	423	[ "winrgb8.bmp", "8-bit, uncompressed" ],
	424	[ "winrgb24.bmp", "24-bit, uncompressed" ],
	425	[ "comp4.bmp", "4-bit, RLE" ],
	426	[ "comp8.bmp", "8-bit, RLE" ],
	427	);
	428	my $test_index = 0;
	429	for my $test (@tests) {
	430	my ($file, $desc) = @$test;
	431	open IMDATA, "< testimg/$file"
	432	or die "$test_index - Cannot open $file: $!";
	433	binmode IMDATA;
	434	my $data = do { local $/; <IMDATA> };
	435	close IMDATA;
	436	my $im_orig = Imager->new;
	437	$im_orig->read(data => $data)
	438	or die "Cannot load original $file: ", $im_orig->errstr;
	439
	440	# now negate the height
	441	my $orig_height = unpack("V", substr($data, 0x16, 4));
	442	my $neg_height = 0xFFFFFFFF & ~($orig_height - 1);
	443	substr($data, 0x16, 4) = pack("V", $neg_height);
	444
	445	# and read the modified image
	446	my $im = Imager->new;
	447	ok($im->read(data => $data),
	448	"$test_index - $desc: read negated height image")
	449	or print "# ", $im->errstr, "\n";
	450
	451	# flip orig to match what we should get
	452	$im_orig->flip(dir => 'v');
	453
	454	# check it out
	455	is_image($im, $im_orig, "$test_index - $desc: check image");
	456
	457	++$test_index;
	458	}
	459	}
	460
	461	{ print "# patched data read failure tests\n";
	462	# like the "various invalid format" tests, these generate fail
	463	# images from other images included with Imager without providing a
	464	# full bmp source, saving on dist size and focusing on the changes needed
	465	# to cause the failure
	466	# each entry is: source file, patches, expected error, description
	467
	468	my @tests =
	469	(
	470	# low image data offsets
	471	[
	472	"winrgb2.bmp",
	473	{ 10 => "3d 00 00 00" },
	474	"image data offset too small (61)",
	475	"1-bit, small image offset"
	476	],
	477	[
	478	"winrgb4.bmp",
	479	{ 10 => "75 00 00 00" },
	480	"image data offset too small (117)",
	481	"4-bit, small image offset"
	482	],
	483	[
	484	"winrgb8.bmp",
	485	{ 10 => "35 04 00 00" },
	486	"image data offset too small (1077)",
	487	"8-bit, small image offset"
	488	],
	489	[
	490	"winrgb24.bmp",
	491	{ 10 => "35 00 00 00" },
	492	"image data offset too small (53)",
	493	"24-bit, small image offset"
	494	],
	495	);
	496	my $test_index = 0;
	497	for my $test (@tests) {
	498	my ($filename, $patches, $error, $desc) = @$test;
	499
	500	my $data = load_patched_file("testimg/$filename", $patches);
	501	my $im = Imager->new;
	502	ok(!$im->read(data => $data, type=>'bmp'),
	503	"$test_index - $desc:should fail to read");
	504	is($im->errstr, $error, "$test_index - $desc:check message");
	505	++$test_index;
	506	}
	507	}
	508
	509	{ # various write failure tests
	510	# each entry is:
	511	# source, limit, expected error, description
	512	my @tests =
	513	(
	514	[
	515	"winrgb2.bmp", 1,
	516	"cannot write bmp header: limit reached",
	517	"1-bit, writing header"
	518	],
	519	[
	520	"winrgb4.bmp", 1,
	521	"cannot write bmp header: limit reached",
	522	"4-bit, writing header"
	523	],
	524	[
	525	"winrgb8.bmp", 1,
	526	"cannot write bmp header: limit reached",
	527	"8-bit, writing header"
	528	],
	529	[
	530	"winrgb24.bmp", 1,
	531	"cannot write bmp header: limit reached",
	532	"24-bit, writing header"
	533	],
	534	[
	535	"winrgb2.bmp", 0x38,
	536	"cannot write palette entry: limit reached",
	537	"1-bit, writing palette"
	538	],
	539	[
	540	"winrgb4.bmp", 0x38,
	541	"cannot write palette entry: limit reached",
	542	"4-bit, writing palette"
	543	],
	544	[
	545	"winrgb8.bmp", 0x38,
	546	"cannot write palette entry: limit reached",
	547	"8-bit, writing palette"
	548	],
	549	[
	550	"winrgb2.bmp", 0x40,
	551	"writing 1 bit/pixel packed data: limit reached",
	552	"1-bit, writing image data"
	553	],
	554	[
	555	"winrgb4.bmp", 0x80,
	556	"writing 4 bit/pixel packed data: limit reached",
	557	"4-bit, writing image data"
	558	],
	559	[
	560	"winrgb8.bmp", 0x440,
	561	"writing 8 bit/pixel packed data: limit reached",
	562	"8-bit, writing image data"
	563	],
	564	[
	565	"winrgb24.bmp", 0x39,
	566	"writing image data: limit reached",
	567	"24-bit, writing image data"
	568	],
	569	);
	570	print "# write failure tests\n";
	571	my $test_index = 0;
	572	for my $test (@tests) {
	573	my ($file, $limit, $error, $desc) = @$test;
	574
	575	my $im = Imager->new;
	576	$im->read(file => "testimg/$file")
	577	or die "Cannot read $file: ", $im->errstr;
	578
	579	ok(!$im->write(type => 'bmp', callback => limited_write($limit),
	580	maxbuffer => 1),
	581	"$test_index - $desc: write should fail");
	582	is($im->errstr, $error, "$test_index - $desc: check error message");
	583
	584	++$test_index;
	585	}
	586	}
	587
220	588	sub write_test {
221	589	my ($im, $filename) = @_;
222	590	local *FH;

291	659	}
292	660	}
293	661
	662	sub limited_write {
	663	my ($limit) = @_;
	664
	665	return
	666	sub {
	667	my ($data) = @_;
	668	$limit -= length $data;
	669	if ($limit >= 0) {
	670	print "# write of ", length $data, " bytes successful ($limit left)\n" if $debug_writes;
	671	return 1;
	672	}
	673	else {
	674	print "# write of ", length $data, " bytes failed\n";
	675	Imager::i_push_error(0, "limit reached");
	676	return;
	677	}
	678	};
	679	}
	680
	681	sub load_patched_file {
	682	my ($filename, $patches) = @_;
	683
	684	open IMDATA, "< $filename"
	685	or die "Cannot open $filename: $!";
	686	binmode IMDATA;
	687	my $data = do { local $/; <IMDATA> };
	688	for my $offset (keys %$patches) {
	689	(my $hdata = $patches->{$offset}) =~ tr/ //d;
	690	my $pdata = pack("H*", $hdata);
	691	substr($data, $offset, length $pdata) = $pdata;
	692	}
	693
	694	return $data;
	695	}

+0

-1

t/t108tga.t less more

0	0	#!perl -w
1	1	use Imager qw(:all);
2	2	use strict;
3		use lib 't';
4	3	use Test::More tests=>38;
5	4	BEGIN { require "t/testtools.pl"; }
6	5	init_log("testout/t108tga.log",1);

+0

-3

t/t15color.t less more

6	6	# Change 1..1 below to 1..last_test_to_print .
7	7	# (It may become useful if the test is moved to ./t subdirectory.)
8	8
9		use lib 't';
10	9	use Test::More tests => 47;
11	10
12	11	BEGIN { use_ok('Imager'); };
13
14		require "t/testtools.pl";
15	12
16	13	init_log("testout/t15color.log",1);
17	14

+0

-1

t/t16matrix.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 8;
4	3	use Imager;
5	4

+0

-1

t/t20fill.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 56;
4	3
5	4	use Imager ':handy';

+0

-1

t/t21draw.t less more

6	6	# Change 1..1 below to 1..last_test_to_print .
7	7	# (It may become useful if the test is moved to ./t subdirectory.)
8	8	use strict;
9		use lib 't';
10	9	use Test::More tests => 43;
11	10	my $loaded;
12	11

+25

-7

t/t30t1font.t less more

6	6	# Change 1..1 below to 1..last_test_to_print .
7	7	# (It may become useful if the test is moved to ./t subdirectory.)
8	8	use strict;
9		use lib 't';
10		use Test::More tests => 77;
	9	use Test::More tests => 90;
11	10	BEGIN { use_ok(Imager => ':all') }
	11	use Imager::Test qw(diff_text_with_nul);
12	12
13	13	#$Imager::DEBUG=1;
14	14

22	22	SKIP:
23	23	{
24	24	if (!(i_has_format("t1")) ) {
25		skip("t1lib unavailable or disabled", 76);
	25	skip("t1lib unavailable or disabled", 89);
26	26	}
27	27	elsif (! -f $fontname_pfb) {
28		skip("cannot find fontfile for type 1 test $fontname_pfb", 76);
	28	skip("cannot find fontfile for type 1 test $fontname_pfb", 89);
29	29	}
30	30	elsif (! -f $fontname_afm) {
31		skip("cannot find fontfile for type 1 test $fontname_afm", 76);
	31	skip("cannot find fontfile for type 1 test $fontname_afm", 89);
32	32	}
33	33
34	34	print "# has t1\n";

178	178	# names
179	179	my $face_name = Imager::i_t1_face_name($font->{id});
180	180	print "# face $face_name\n";
181		ok($face_name eq 'ExistenceTest', "face name");
	181	is($face_name, 'ExistenceTest', "face name");
182	182	$face_name = $font->face_name;
183		ok($face_name eq 'ExistenceTest', "face name");
	183	is($face_name, 'ExistenceTest', "face name");
184	184
185	185	my @glyph_names = $font->glyph_names(string=>"!J/");
186	186	is($glyph_names[0], 'exclam', "check exclam name OO");

307	307	is($bbox_utf8->advance_width, $bbox_tran->advance_width,
308	308	"advance widths should match");
309	309	}
	310	{ # string output cut off at NUL ('\0')
	311	# https://rt.cpan.org/Ticket/Display.html?id=21770 cont'd
	312	my $font = Imager::Font->new(file => 'fontfiles/dcr10.pfb', type => 't1');
	313	ok($font, "loaded dcr10.pfb");
	314
	315	diff_text_with_nul("a\\0b vs a", "a\0b", "a",
	316	font => $font, color => '#FFFFFF');
	317	diff_text_with_nul("a\\0b vs a", "a\0b", "a",
	318	font => $font, channel => 1);
	319
	320	# UTF8 encoded \xBF
	321	my $pound = pack("C*", 0xC2, 0xBF);
	322	diff_text_with_nul("utf8 pound\0pound vs pound", "$pound\0$pound", $pound,
	323	font => $font, color => '#FFFFFF', utf8 => 1);
	324	diff_text_with_nul("utf8 dash\0dash vs dash", "$pound\0$pound", $pound,
	325	font => $font, channel => 1, utf8 => 1);
	326
	327	}
310	328	}
311	329
312	330	#malloc_state();

+28

-8

t/t35ttfont.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3		use Test::More tests => 72;
	2	use Test::More tests => 85;
	3
	4	$\|=1;
4	5
5	6	BEGIN { use_ok(Imager => ':all') }
6	7	require "t/testtools.pl";
	8	use Imager::Test qw(diff_text_with_nul);
7	9
8	10	init_log("testout/t35ttfont.log",2);
9	11
10	12	SKIP:
11	13	{
12		skip("freetype 1.x unavailable or disabled", 71)
	14	skip("freetype 1.x unavailable or disabled", 84)
13	15	unless i_has_format("tt");
14	16	print "# has tt\n";
15	17

18	20
19	21	if (!ok(-f $fontname, "check test font file exists")) {
20	22	print "# cannot find fontfile for truetype test $fontname\n";
21		skip('Cannot load test font', 70);
	23	skip('Cannot load test font', 83);
22	24	}
23	25
24	26	i_init_fonts();

134	136
135	137	my $face_name = Imager::i_tt_face_name($hcfont->{id});
136	138	print "# face $face_name\n";
137		ok($face_name eq 'ExistenceTest', "face name");
	139	is($face_name, 'ExistenceTest', "face name (function)");
138	140	$face_name = $hcfont->face_name;
139		ok($face_name eq 'ExistenceTest', "face name");
	141	is($face_name, 'ExistenceTest', "face name (OO)");
140	142
141	143	# FT 1.x cheats and gives names even if the font doesn't have them
142	144	my @glyph_names = $hcfont->glyph_names(string=>"!J/");
143		ok($glyph_names[0] eq 'exclam', "check exclam name OO");
	145	is($glyph_names[0], 'exclam', "check exclam name OO");
144	146	ok(!defined($glyph_names[1]), "check for no J name OO");
145		ok($glyph_names[2] eq 'slash', "check slash name OO");
	147	is($glyph_names[2], 'slash', "check slash name OO");
146	148
147	149	print "# name table of the test font \n";
148	150	Imager::i_tt_dump_names($hcfont->{id});

257	259	"outputting just a space was crashing");
258	260	}
259	261
	262	{ # string output cut off at NUL ('\0')
	263	# https://rt.cpan.org/Ticket/Display.html?id=21770 cont'd
	264	my $font = Imager::Font->new(file=>'fontfiles/ImUgly.ttf', type=>'tt');
	265	ok($font, "loaded imugly");
	266
	267	diff_text_with_nul("a\\0b vs a", "a\0b", "a",
	268	font => $font, color => '#FFFFFF');
	269	diff_text_with_nul("a\\0b vs a", "a\0b", "a",
	270	font => $font, channel => 1);
	271
	272	# UTF8 encoded \x{2010}
	273	my $dash = pack("C*", 0xE2, 0x80, 0x90);
	274	diff_text_with_nul("utf8 dash\0dash vs dash", "$dash\0$dash", $dash,
	275	font => $font, color => '#FFFFFF', utf8 => 1);
	276	diff_text_with_nul("utf8 dash\0dash vs dash", "$dash\0$dash", $dash,
	277	font => $font, channel => 1, utf8 => 1);
	278	}
	279
260	280	ok(1, "end of code");
261	281	}

+37

-40

t/t36oofont.t less more

9	9
10	10	# Change 1..1 below to 1..last_test_to_print .
11	11	# (It may become useful if the test is moved to ./t subdirectory.)
	12	use Test::More tests => 20;
12	13
13		my $loaded;
14		BEGIN { $\| = 1; print "1..20\n"; }
15		END {print "not ok 1\n" unless $loaded;}
16		use Imager;
17		BEGIN { require "t/testtools.pl"; }
18		$loaded=1;
19		okx(1, "loaded");
	14	BEGIN { use_ok('Imager') };
20	15
21	16	init_log("testout/t36oofont.log", 1);
22	17

29	24	my $red=Imager::Color->new(205, 92, 92, 255);
30	25	die $Imager::ERRSTR unless $red;
31	26
32		if (i_has_format("t1") and -f $fontname_pfb) {
	27	SKIP:
	28	{
	29	i_has_format("t1") && -f $fontname_pfb
	30	or skip("T1lib missing or disabled", 8);
33	31
34	32	my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
35	33
36	34	my $font=Imager::Font->new(file=>$fontname_pfb,size=>25)
37	35	or die $img->{ERRSTR};
38	36
39		okx(1, "created font");
	37	ok(1, "created font");
40	38
41		okx($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
	39	ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
42	40	"draw text");
43	41	$img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
44	42
45	43	my $text="LLySja";
46	44	my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
47	45
48		isx(@bbox, 8, "bounding box list length");
	46	is(@bbox, 8, "bounding box list length");
49	47
50	48	$img->box(box=>\@bbox, color=>$green);
51	49
52	50	# "utf8" support
53	51	$text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
54		okx($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1,
	52	ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1,
55	53	overline=>1),
56	54	"draw 'utf8' hand-encoded text");
57	55
58		okx($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1,
	56	ok($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1,
59	57	underline=>1, channel=>2),
60	58	"channel 'utf8' hand-encoded text");
61	59
62		if($] >= 5.006) {
	60	SKIP:
	61	{
	62	$] >= 5.006
	63	or skip("perl too old for native utf8", 2);
63	64	eval q{$text = "A\x{2010}A"};
64		okx($img->string(font=>$font, text=>$text, 'x'=>180, 'y'=>50,
	65	ok($img->string(font=>$font, text=>$text, 'x'=>180, 'y'=>50,
65	66	strikethrough=>1),
66	67	"draw native UTF8 text");
67		okx($img->string(font=>$font, text=>$text, 'x'=>220, 'y'=>50, channel=>1),
	68	ok($img->string(font=>$font, text=>$text, 'x'=>220, 'y'=>50, channel=>1),
68	69	"channel native UTF8 text");
69	70	}
70		else {
71		skipx(2, "perl too old for native utf8");
72		}
73	71
74		okx($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'),
	72	ok($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'),
75	73	"write t36oofont1.ppm")
76	74	or print "# ",$img->errstr,"\n";
77	75
78		} else {
79		skipx(8, "T1lib missing or disabled");
80	76	}
81	77
82		if (i_has_format("tt") and -f $fontname_tt) {
	78	SKIP:
	79	{
	80	i_has_format("tt") && -f $fontname_tt
	81	or skip("FT1.x missing or disabled", 10);
83	82
84	83	my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
85	84
86	85	my $font=Imager::Font->new(file=>$fontname_tt,size=>25)
87	86	or die $img->{ERRSTR};
88	87
89		okx(1, "create TT font object");
	88	ok(1, "create TT font object");
90	89
91		okx($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
	90	ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
92	91	"draw text");
93	92
94	93	$img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);

96	95	my $text="LLySja";
97	96	my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
98	97
99		isx(@bbox, 8, "bbox list size");
	98	is(@bbox, 8, "bbox list size");
100	99
101	100	$img->box(box=>\@bbox, color=>$green);
102	101
103	102	$text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
104		okx($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1),
	103	ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1),
105	104	"draw hand-encoded UTF8 text");
106	105
107		if($] >= 5.006) {
	106	SKIP:
	107	{
	108	$] >= 5.006
	109	or skip("perl too old for native utf8", 1);
108	110	eval q{$text = "A\x{2010}A"};
109		okx($img->string(font=>$font, text=>$text, 'x'=>200, 'y'=>50),
	111	ok($img->string(font=>$font, text=>$text, 'x'=>200, 'y'=>50),
110	112	"draw native UTF8 text");
111	113	}
112		else {
113		skipx(1, "perl too old for native utf8");
114		}
115	114
116		okx($img->write(file=>"testout/t36oofont2.ppm", type=>'pnm'),
	115	ok($img->write(file=>"testout/t36oofont2.ppm", type=>'pnm'),
117	116	"write t36oofont2.ppm")
118	117	or print "# ", $img->errstr,"\n";
119	118
120		okx($font->utf8, "make sure utf8 method returns true");
	119	ok($font->utf8, "make sure utf8 method returns true");
121	120
122	121	my $has_chars = $font->has_chars(string=>"\x01A");
123		okx($has_chars eq "\x00\x01", "has_chars scalar");
	122	is($has_chars, "\x00\x01", "has_chars scalar");
124	123	my @has_chars = $font->has_chars(string=>"\x01A");
125		okx(!$has_chars[0], "has_chars list 0");
126		okx($has_chars[1], "has_chars list 1");
127		} else {
128		skipx(10, "FT1.x missing or disabled");
	124	ok(!$has_chars[0], "has_chars list 0");
	125	ok($has_chars[1], "has_chars list 1");
129	126	}
130	127
131		okx(1, "end");
	128	ok(1, "end");

+77

-6

t/t37w32font.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3		use Test::More tests => 32;
	2	use Test::More tests => 54;
4	3	BEGIN { use_ok(Imager => ':all') }
	4	use Imager::Test qw(diff_text_with_nul);
5	5	++$\|;
6	6
7	7	init_log("testout/t37w32font.log",1);
8	8
9	9	SKIP:
10	10	{
11		i_has_format('w32') or skip("no MS Windows", 31);
	11	i_has_format('w32') or skip("no MS Windows", 53);
12	12	print "# has w32\n";
13	13
14	14	my $fontname=$ENV{'TTFONTTEST'} \|\| 'Times New Roman Bold';

65	65
66	66	SKIP:
67	67	{
68		$^O eq 'cygwin' and skip("Too hard to get correct directory for test font on cygwin", 11);
	68	$^O eq 'cygwin' and skip("Too hard to get correct directory for test font on cygwin", 13);
69	69	ok(Imager::i_wf_addfont("fontfiles/ExistenceTest.ttf"), "add test font")
70	70	or print "# ",Imager::_error_as_msg(),"\n";
71	71

86	86	"check display width (roughly)");
87	87
88	88	my $im = Imager->new(xsize=>200, ysize=>200);
89		$im->string(font=>$namefont, text=>"/", x=>20, y=>100, color=>'white', size=>100);
	89	$im->box(filled => 1, color => '#202020');
	90	$im->box(box => [ 20 + $bbox->neg_width, 100-$bbox->ascent,
	91	20+$bbox->advance_width-$bbox->right_bearing, 100-$bbox->descent ],
	92	color => '#101010', filled => 1);
90	93	$im->line(color=>'blue', x1=>20, y1=>0, x2=>20, y2=>199);
91	94	my $right = 20 + $bbox->advance_width;
92	95	$im->line(color=>'blue', x1=>$right, y1=>0, x2=>$right, y2=>199);
	96	$im->line(color=>'blue', x1=>0, y1 => 100, x2=>199, y2 => 100);
	97	ok($im->string(font=>$namefont, text=>"/", x=>20, y=>100, color=>'white', size=>100),
	98	"draw / from ExistenceText")
	99	or print "# ", $im->errstr, "\n";
	100	$im->setpixel(x => 20+$bbox->neg_width, y => 100-$bbox->ascent, color => 'red');
	101	$im->setpixel(x => 20+$bbox->advance_width - $bbox->right_bearing, y => 100-$bbox->descent, color => 'red');
93	102	$im->write(file=>'testout/t37w32_slash.ppm');
94	103
95	104	# check with a char that fits inside the box

102	111	cmp_ok($bbox->right_bearing, '>', 0, "right bearing positive");
103	112	cmp_ok($bbox->display_width, '<', $bbox->advance_width,
104	113	"display smaller than advance");
	114
	115	$im = Imager->new(xsize=>200, ysize=>200);
	116	$im->box(filled => 1, color => '#202020');
	117	$im->box(box => [ 20 + $bbox->neg_width, 100-$bbox->ascent,
	118	20+$bbox->advance_width-$bbox->right_bearing, 100-$bbox->descent ],
	119	color => '#101010', filled => 1);
	120	$im->line(color=>'blue', x1=>20, y1=>0, x2=>20, y2=>199);
	121	$right = 20 + $bbox->advance_width;
	122	$im->line(color=>'blue', x1=>$right, y1=>0, x2=>$right, y2=>199);
	123	$im->line(color=>'blue', x1=>0, y1 => 100, x2=>199, y2 => 100);
	124	ok($im->string(font=>$namefont, text=>"!", x=>20, y=>100, color=>'white', size=>100),
	125	"draw / from ExistenceText")
	126	or print "# ", $im->errstr, "\n";
	127	$im->setpixel(x => 20+$bbox->neg_width, y => 100-$bbox->ascent, color => 'red');
	128	$im->setpixel(x => 20+$bbox->advance_width - $bbox->right_bearing, y => 100-$bbox->descent, color => 'red');
	129	$im->write(file=>'testout/t37w32_bang.ppm');
105	130	}
106	131
107	132	SKIP:

129	154	}
130	155	ok($im->write(file=>'testout/t37align.ppm'), "save align image");
131	156	}
132
	157	{ print "# utf 8 support\n";
	158	my $font = Imager::Font->new(face => "Arial");
	159	ok($font, "created font");
	160	my $im = Imager->new(xsize => 100, ysize => 100);
	161	ok($im->string(string => "\xE2\x98\xBA", size => 80, aa => 1, utf8 => 1,
	162	color => "white", font => $font, x => 5, y => 80),
	163	"draw in utf8 (hand encoded)")
	164	or print "# ", $im->errstr, "\n";
	165	ok($im->write(file=>'testout/t37utf8.ppm'), "save utf8 image");
	166
	167	# native perl utf8
	168	# Win32 only supported on 5.6+
	169	# since this gets compiled even on older perls we need to be careful
	170	# creating the string
	171	my $text;
	172	eval q{$text = "\x{263A}"}; # A, HYPHEN, A in our test font
	173	my $im2 = Imager->new(xsize => 100, ysize => 100);
	174	ok($im2->string(string => $text, size => 80, aa => 1,
	175	color => 'white', font => $font, x => 5, y => 80),
	176	"draw in utf8 (perl utf8)")
	177	or print "# ", $im->errstr, "\n";
	178	ok($im2->write(file=>'testout/t37utf8b.ppm'), "save utf8 image");
	179	is(Imager::i_img_diff($im->{IMG}, $im2->{IMG}), 0,
	180	"check result is the same");
	181
	182	# bounding box
	183	cmp_ok($font->bounding_box(string=>$text, size => 80)->advance_width, '<', 100,
	184	"check we only get width of single char rather than 3");
	185	}
	186
	187	{ # string output cut off at NUL ('\0')
	188	# https://rt.cpan.org/Ticket/Display.html?id=21770 cont'd
	189	my $font = Imager::Font->new(face=>'Arial', type=>'w32');
	190	ok($font, "loaded Arial");
	191
	192	diff_text_with_nul("a\\0b vs a", "a\0b - color", "a",
	193	font => $font, color => '#FFFFFF');
	194	diff_text_with_nul("a\\0b vs a", "a\0b - channel", "a",
	195	font => $font, channel => 1);
	196
	197	# UTF8 encoded \x{2010}
	198	my $dash = pack("C*", 0xE2, 0x80, 0x90);
	199	diff_text_with_nul("utf8 dash\0dash vs dash - color", "$dash\0$dash", $dash,
	200	font => $font, color => '#FFFFFF', utf8 => 1);
	201	diff_text_with_nul("utf8 dash\0dash vs dash - channel", "$dash\0$dash", $dash,
	202	font => $font, channel => 1, utf8 => 1);
	203	}
133	204	}

+62

-7

t/t38ft2font.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3		use Test::More tests => 160;
	2	use Test::More tests => 182;
4	3	++$\|;
5	4	# Before `make install' is performed this script should be runnable with
6	5	# `make test'. After `make install' it should work as `perl test.pl'

12	11
13	12	BEGIN { use_ok(Imager => ':all') }
14	13
	14	use Imager::Test qw(diff_text_with_nul is_color3);
	15
15	16	init_log("testout/t38ft2font.log",2);
16	17
17	18	my @base_color = (64, 255, 64);
18	19
19	20	SKIP:
20	21	{
21		i_has_format("ft2") or skip("no freetype2 library found", 159);
	22	i_has_format("ft2") or skip("no freetype2 library found", 181);
22	23
23	24	print "# has ft2\n";
24	25
25	26	my $fontname=$ENV{'TTFONTTEST'}\|\|'./fontfiles/dodge.ttf';
26	27
27		-f $fontname or skip("cannot find fontfile $fontname", 159);
	28	-f $fontname or skip("cannot find fontfile $fontname", 181);
28	29
29	30
30	31	my $bgcolor=i_color_new(255,0,0,0);

181	182	ok(@got == 2, "has_chars returned 2 items");
182	183	ok(!$got[0], "have no chr(1)");
183	184	ok($got[1], "have 'H'");
184		ok($oof->has_chars(string=>"H\x01") eq "\x01\x00",
	185	is($oof->has_chars(string=>"H\x01"), "\x01\x00",
185	186	"scalar has_chars()");
186	187
187	188	print "# OO bounding boxes\n";

253	254	if (Imager::Font::FreeType2::i_ft2_can_face_name()) {
254	255	my $facename = Imager::Font::FreeType2::i_ft2_face_name($exfont->{id});
255	256	print "# face name '$facename'\n";
256		ok($facename eq 'ExistenceTest', "test face name");
	257	is($facename, 'ExistenceTest', "test face name");
257	258	$facename = $exfont->face_name;
258		ok($facename eq 'ExistenceTest', "test face name OO");
	259	is($facename, 'ExistenceTest', "test face name OO");
259	260	}
260	261	else {
261	262	# make sure we get the error we expect

411	412	channel => 0, size => 8, font => $font),
412	413	"draw space non-antialiased (channel)");
413	414	}
	415
	416	{ # cannot output "0"
	417	# https://rt.cpan.org/Ticket/Display.html?id=21770
	418	my $font = Imager::Font->new(file=>'fontfiles/ImUgly.ttf', type=>'ft2');
	419	ok($font, "loaded imugly");
	420	my $imbase = Imager->new(xsize => 100, ysize => 100);
	421	my $im = $imbase->copy;
	422	ok($im->string(x => 10, y => 50, string => "0", aa => 0,
	423	color => '#FFF', size => 20, font => $font),
	424	"draw '0'");
	425	ok(Imager::i_img_diff($im->{IMG}, $imbase->{IMG}),
	426	"make sure we actually drew it");
	427	$im = $imbase->copy;
	428	ok($im->string(x => 10, y => 50, string => 0.0, aa => 0,
	429	color => '#FFF', size => 20, font => $font),
	430	"draw 0.0");
	431	ok(Imager::i_img_diff($im->{IMG}, $imbase->{IMG}),
	432	"make sure we actually drew it");
	433	}
	434	{ # string output cut off at NUL ('\0')
	435	# https://rt.cpan.org/Ticket/Display.html?id=21770 cont'd
	436	my $font = Imager::Font->new(file=>'fontfiles/ImUgly.ttf', type=>'ft2');
	437	ok($font, "loaded imugly");
	438
	439	diff_text_with_nul("a\\0b vs a", "a\0b", "a",
	440	font => $font, color => '#FFFFFF');
	441	diff_text_with_nul("a\\0b vs a", "a\0b", "a",
	442	font => $font, channel => 1);
	443
	444	# UTF8 encoded \x{2010}
	445	my $dash = pack("C*", 0xE2, 0x80, 0x90);
	446	diff_text_with_nul("utf8 dash\0dash vs dash", "$dash\0$dash", $dash,
	447	font => $font, color => '#FFFFFF', utf8 => 1);
	448	diff_text_with_nul("utf8 dash\0dash vs dash", "$dash\0$dash", $dash,
	449	font => $font, channel => 1, utf8 => 1);
	450	}
	451
	452	{ # RT 11972
	453	# when rendering to a transparent image the coverage should be
	454	# expressed in terms of the alpha channel rather than the color
	455	my $font = Imager::Font->new(file=>'fontfiles/ImUgly.ttf', type=>'ft2');
	456	my $im = Imager->new(xsize => 40, ysize => 20, channels => 4);
	457	ok($im->string(string => "AB", size => 20, aa => 1, color => '#F00',
	458	x => 0, y => 15, font => $font),
	459	"draw to transparent image");
	460	$im->write(file => "foo.png");
	461	my $im_noalpha = $im->convert(preset => 'noalpha');
	462	my $im_pal = $im->to_paletted(make_colors => 'mediancut');
	463	my @colors = $im_pal->getcolors;
	464	is(@colors, 2, "should be only 2 colors");
	465	@colors = sort { ($a->rgba)[0] <=> ($b->rgba)[0] } @colors;
	466	is_color3($colors[0], 0, 0, 0, "check we got black");
	467	is_color3($colors[1], 255, 0, 0, "and red");
	468	}
414	469	}
415	470
416	471	sub align_test {

+0

-1

t/t40scale.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 223;
4	3
5	4	BEGIN { use_ok(Imager=>':all') }

+3

-41

t/t58trans2.t less more

0	0	#!perl -w
1		BEGIN { $\| = 1; print "1..16\n"; }
2		END {print "not ok 1\n" unless $loaded;}
3		use Imager;
4
5		sub ok($$);
6		sub is($$$);
7		my $num = 1;
8
9		$loaded = 1;
10		ok(1, "loaded");
11
12		#$Imager::DEBUG=1;
	1	use strict;
	2	use Test::More tests => 16;
	3	BEGIN { use_ok('Imager'); }
13	4
14	5	Imager::init('log'=>'testout/t58trans2.log');
15	6

103	94	ok(!$im7, "expected failure on accessing invalid image");
104	95	print "# ", Imager->errstr, "\n";
105	96	ok(Imager->errstr =~ /not enough images/, "didn't get expected error");
106
107
108		sub ok ($$) {
109		my ($test, $desc) = @_;
110
111		if ($test) {
112		print "ok $num # $desc\n";
113		}
114		else {
115		print "not ok $num # $desc\n";
116		}
117		++$num;
118		$test;
119		}
120
121		sub is ($$$) {
122		my ($left, $right, $desc) = @_;
123
124		my $eq = $left == $right;
125		unless (ok($eq, $desc)) {
126		$left =~ s/\n/# \n/g;
127		$left =~ s/([^\n\x20-\x7E])/"\\x".sprintf("%02X", ord $1)/ge;
128		$right =~ s/\n/# \n/g;
129		$right =~ s/([^\n\x20-\x7E])/"\\x".sprintf("%02X", ord $1)/ge;
130		print "# not equal, left = '$left'\n";
131		print "# right = '$right'\n";
132		}
133		$eq;
134		}

+0

-1

t/t61filters.t less more

0	0	#!perl -w
1	1	use strict;
2	2	use Imager qw(:handy);
3		use lib 't';
4	3	use Test::More tests => 66;
5	4	Imager::init_log("testout/t61filters.log", 1);
6	5	# meant for testing the filters themselves

+0

-1

t/t64copyflip.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 61;
4	3	use Imager;
5	4

+0

-1

t/t65crop.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 60;
4	3	require "t/testtools.pl";
5	4	use Imager;

+0

-1

t/t66paste.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 23;
4	3
5	4	BEGIN { use_ok("Imager") }

+0

-1

t/t67convert.t less more

0	0	#!perl -w
1	1	use strict;
2	2	use Imager qw(:all :handy);
3		use lib 't';
4	3	use Test::More tests=>19;
5	4
6	5	Imager::init("log"=>'testout/t67convert.log');

+0

-1

t/t69rubthru.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More tests => 38;
4	3	BEGIN { use_ok(Imager => qw(:all :handy)); }
5	4

+19

-26

t/t80texttools.t less more

	0	#!perl -w
0	1	use strict;
1		my $loaded;
2		BEGIN {
3		require "t/testtools.pl";
4		$\| = 1; print "1..11\n";
5		}
6		END { okx(0, "loading") unless $loaded; }
7		use Imager;
8		$loaded = 1;
	2	use Test::More tests => 11;
9	3
10		okx(1, "Loaded");
	4	BEGIN { use_ok('Imager') }
11	5
12		requireokx("Imager/Font/Wrap.pm", "load basic wrapping");
	6	require_ok('Imager::Font::Wrap');
13	7
14	8	my $img = Imager->new(xsize=>400, ysize=>400);
15	9

39	33
40	34	my $font = Imager::Font->new(file=>$fontfile);
41	35
42		unless (Imager::i_has_format('tt') \|\| Imager::i_has_format('ft2')) {
43		skipx(9, "Need Freetype 1.x or 2.x to test");
44		exit;
45		}
	36	SKIP:
	37	{
	38	Imager::i_has_format('tt') \|\| Imager::i_has_format('ft2')
	39	or skip("Need Freetype 1.x or 2.x to test", 9);
46	40
47		if (okx($font, "loading font")) {
	41	ok($font, "loading font")
	42	or skip("Could not load test font", 8);
	43
48	44	Imager::Font->priorities(qw(t1 ft2 tt));
49		okx(scalar Imager::Font::Wrap->wrap_text(string => $text,
	45	ok(scalar Imager::Font::Wrap->wrap_text(string => $text,
50	46	font=>$font,
51	47	image=>$img,
52	48	size=>13,

55	51	justify=>'fill',
56	52	color=>'FFFFFF'),
57	53	"basic test");
58		okx($img->write(file=>'testout/t80wrapped.ppm'), "save to file");
59		okx(scalar Imager::Font::Wrap->wrap_text(string => $text,
	54	ok($img->write(file=>'testout/t80wrapped.ppm'), "save to file");
	55	ok(scalar Imager::Font::Wrap->wrap_text(string => $text,
60	56	font=>$font,
61	57	image=>undef,
62	58	size=>13,

66	62	color=>'FFFFFF'),
67	63	"no image test");
68	64	my $bbox = $font->bounding_box(string=>"Xx", size=>13);
69		okx($bbox, "get height for check");
	65	ok($bbox, "get height for check");
70	66
71	67	my $used;
72		okx(scalar Imager::Font::Wrap->wrap_text
	68	ok(scalar Imager::Font::Wrap->wrap_text
73	69	(string=>$text, font=>$font, image=>undef, size=>13, width=>380,
74	70	savepos=> \$used, height => $bbox->font_height), "savepos call");
75		okx($used > 20 && $used < length($text), "savepos value");
	71	ok($used > 20 && $used < length($text), "savepos value");
76	72	print "# $used\n";
77	73	my @box = Imager::Font::Wrap->wrap_text
78	74	(string=>substr($text, 0, $used), font=>$font, image=>undef, size=>13,
79	75	width=>380);
80	76
81		okx(@box == 4, "bounds list count");
	77	ok(@box == 4, "bounds list count");
82	78	print "# @box\n";
83		okx($box[3] == $bbox->font_height, "check height");
	79	ok($box[3] == $bbox->font_height, "check height");
84	80	}
85		else {
86		skipx(8, "Could not load test font");
87		}

+0

-1

t/t81hlines.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More;
4	3	use Imager;
5	4

+14

-2

t/t82inline.t less more

1	1	#
2	2	# this tests both the Inline interface and the API
3	3	use strict;
4		use lib 't';
5	4	use Test::More;
6	5	eval "require Inline::C;";
7	6	plan skip_all => "Inline required for testing API" if $@;

10	9	plan skip_all => "Inline won't work in directories with spaces"
11	10	if getcwd() =~ / /;
12	11
13		plan tests => 8;
	12	plan tests => 9;
14	13	require Inline;
15	14	Inline->import(with => 'Imager');
16	15

244	243	ok($im3, "do_lots()")
245	244	or print "# ", Imager->_error_as_msg, "\n";
246	245	ok($im3->write(file=>'testout/t82lots.ppm'), "write t82lots.ppm");
	246
	247	{ # RT #24992
	248	# the T_IMAGER_FULL_IMAGE typemap entry was returning a blessed
	249	# hash with an extra ref, causing memory leaks
	250
	251	my $im = make_10x10();
	252	my $im2 = Imager->new(xsize => 10, ysize => 10);
	253	use B;
	254	my $imb = B::svref_2object($im);
	255	my $im2b = B::svref_2object($im2);
	256	is ($imb->REFCNT, $im2b->REFCNT,
	257	"check refcnt of imager object hash between normal and typemap generated");
	258	}

+0

-1

t/t91pod.t less more

0	0	#!perl -w
1	1	use strict;
2		use lib 't';
3	2	use Test::More;
4	3	use ExtUtils::Manifest qw(maniread);
5	4	eval "use Test::Pod 1.00;";

+0

-1

t/t92samples.t less more

0	0	#!perl -w
1	1	# packaging test - make sure we included the samples in the MANIFEST <sigh>
2		use lib 't';
3	2	use Test::More;
4	3	use ExtUtils::Manifest qw(maniread);
5	4

+0

-1

t/t94kwalitee.t less more

0	0	#!perl -w
1	1	# this is intended for various kwalitee tests
2		use lib 't';
3	2	use strict;
4	3	use Test::More;
5	4	use ExtUtils::Manifest qw(maniread);

+0

-128

t/testtools.pl less more

28	28	$img;
29	29	}
30	30
31		sub skipn {
32		my ($testnum, $count, $why) = @_;
33
34		$why = '' unless defined $why;
35
36		print "ok $_ # skip $why\n" for $testnum ... $testnum+$count-1;
37		}
38
39		sub skipx {
40		my ($count, $why) = @_;
41
42		skipn($TESTNUM, $count, $why);
43		$TESTNUM += $count;
44		}
45
46		sub okx ($$) {
47		my ($ok, $comment) = @_;
48
49		return okn($TESTNUM++, $ok, $comment);
50		}
51
52		sub okn ($$$) {
53		my ($num, $ok, $comment) = @_;
54
55		defined $num or confess "No \$num supplied";
56		defined $comment or confess "No \$comment supplied";
57		if ($ok) {
58		print "ok $num # $comment\n";
59		}
60		else {
61		print "not ok $num # $comment\n";
62		}
63
64		return $ok;
65		}
66
67		sub requireokx {
68		my ($file, $comment) = @_;
69
70		eval {
71		require $file;
72		};
73		if ($@) {
74		my $msg = $@;
75		$msg =~ s/\n+$//;
76		$msg =~ s/\n/\n# /g;
77		okx(0, $comment);
78		print "# $msg\n";
79		}
80		else {
81		okx(1, $comment);
82		}
83		}
84
85		sub useokx {
86		my ($module, $comment, @imports) = @_;
87
88		my $pack = caller;
89		eval <<EOS;
90		package $pack;
91		require $module;
92		$module->import(\@imports);
93		EOS
94		unless (okx(!$@, $comment)) {
95		my $msg = $@;
96		$msg =~ s/\n+$//;
97		$msg =~ s/\n/\n# /g;
98		print "# $msg\n";
99		return 0;
100		}
101		else {
102		return 1;
103		}
104		}
105
106		sub matchn($$$$) {
107		my ($num, $str, $re, $comment) = @_;
108
109		my $match = defined($str) && $str =~ $re;
110		okn($num, $match, $comment);
111		unless ($match) {
112		print "# The value: ",_sv_str($str),"\n";
113		print "# did not match: qr/$re/\n";
114		}
115		return $match;
116		}
117
118		sub matchx($$$) {
119		my ($str, $re, $comment) = @_;
120
121		matchn($TESTNUM++, $str, $re, $comment);
122		}
123
124		sub isn ($$$$) {
125		my ($num, $left, $right, $comment) = @_;
126
127		my $match;
128		if (!defined $left && defined $right
129		\|\| defined $left && !defined $right) {
130		$match = 0;
131		}
132		elsif (!defined $left && !defined $right) {
133		$match = 1;
134		}
135		# the right of the \|\| produces a string of \0 if $left is a PV
136		# which is true
137		elsif (!length $left \|\| ($left & ~$left) \|\|
138		!length $right \|\| ($right & ~$right)) {
139		$match = $left eq $right;
140		}
141		else {
142		$match = $left == $right;
143		}
144		okn($num, $match, $comment);
145		unless ($match) {
146		print "# the following two values were not equal:\n";
147		print "# value: ",_sv_str($left),"\n";
148		print "# other: ",_sv_str($right),"\n";
149		}
150
151		$match;
152		}
153
154		sub isx ($$$) {
155		my ($left, $right, $comment) = @_;
156
157		isn($TESTNUM++, $left, $right, $comment);
158		}
159	31
160	32	sub _sv_str {
161	33	my ($value) = @_;

+0

-1

t/tr18561.t less more

1	1	# regression test for RT issue 18561
2	2	#
3	3	use strict;
4		use lib 't';
5	4	use Test::More tests => 1;
6	5	eval {
7	6	use Imager;

+0

-1

t/tr18561b.t less more

2	2	# the old _color() code could return floating colors in some cases
3	3	# but in most cases the caller couldn't handle it
4	4	use strict;
5		use lib 't';
6	5	use Test::More tests => 1;
7	6	eval {
8	7	use Imager;

+4

-0

testimg/bad_asc.pbm less more

	0	P1
	1	2 2
	2	10
	3	0x⏎

+5

-0

testimg/bad_asc.pgm less more

	0	P2
	1	2 2
	2	255
	3	255 255
	4	255 x⏎

+5

-0

testimg/bad_asc.ppm less more

	0	P3
	1	2 2
	2	255
	3	255 255 255 255 255 255
	4	255 255 x⏎

testimg/maxval_256.ppm less more

Binary diff not shown

+5

-0

testimg/pgm.pgm less more

	0	P5
	1	# CREATOR: The GIMP's PNM Filter Version 1.0
	2	2 2
	3	255
	4	şıüû⏎

+4

-0

testimg/short_asc.pbm less more

	0	P1
	1	2 2
	2	01
	3	1⏎

+5

-0

testimg/short_asc.pgm less more

	0	P2
	1	2 2
	2	255
	3	255 255
	4	255 ⏎

+5

-0

testimg/short_asc.ppm less more

	0	P3
	1	2 2
	2	255
	3	255 255 255 255 255 255
	4	255 255 255⏎

+3

-0

testimg/short_bin.pbm less more

	0	P4
	1	16 2
	2	ú€þ⏎

+5

-0

testimg/short_bin.pgm less more

	0	P5
	1	# CREATOR: The GIMP's PNM Filter Version 1.0
	2	2 2
	3	255
	4	ÿÿÿ⏎

+5

-0

testimg/short_bin.ppm less more

	0	P6
	1	# CREATOR: The GIMP's PNM Filter Version 1.0
	2	2 2
	3	255
	4	ÿÿÿÿÿÿÿÿÿ⏎

+5

-0

testimg/short_bin16.pgm less more

	0	P5
	1	# CREATOR: The GIMP's PNM Filter Version 1.0
	2	2 2
	3	65535
	4	ÿÿÿÿÿÿ⏎

+5

-0

testimg/short_bin16.ppm less more

	0	P6
	1	# CREATOR: The GIMP's PNM Filter Version 1.0
	2	2 2
	3	65535
	4	ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ⏎

+3

-0

tga.c less more

731	731	mapped = 0;
732	732	channels = 1;
733	733	break;
	734	default:
	735	i_push_error(0, "invalid or unsupported datatype code");
	736	return NULL;
734	737	}
735	738
736	739	if (!i_int_check_image_file_limits(width, height, channels,

+25

-8

tiff.c less more

150	150	/* do nothing */
151	151	}
152	152
153		static i_img read_one_tiff(TIFF tif) {
	153	static i_img read_one_tiff(TIFF tif, int allow_incomplete) {
154	154	i_img *im;
155	155	uint32 width, height;
156	156	uint16 channels;

295	295	++row;
296	296	}
297	297	if (row < height) {
	298	if (allow_incomplete) {
	299	i_tags_setn(&im->tags, "i_lines_read", row);
	300	}
	301	else {
	302	i_img_destroy(im);
	303	_TIFFfree(buffer);
	304	return NULL;
	305	}
298	306	error = 1;
299	307	}
300	308	/* Ideally we'd optimize the palette, but that could be expensive

381	389	uint32 newrows, i_row;
382	390
383	391	if (!TIFFReadRGBAStrip(tif, row, raster)) {
384		error++;
385		break;
	392	if (allow_incomplete) {
	393	i_tags_setn(&im->tags, "i_lines_read", row);
	394	error++;
	395	break;
	396	}
	397	else {
	398	i_push_error(0, "could not read TIFF image strip");
	399	_TIFFfree(raster);
	400	i_img_destroy(im);
	401	return NULL;
	402	}
386	403	}
387	404
388	405	newrows = (row+rowsperstrip > height) ? height-row : rowsperstrip;

405	422	}
406	423	if (error) {
407	424	mm_log((1, "i_readtiff_wiol: error during reading\n"));
408		i_tags_addn(&im->tags, "i_incomplete", 0, 1);
	425	i_tags_setn(&im->tags, "i_incomplete", 1);
409	426	}
410	427	if (raster)
411	428	_TIFFfree( raster );

419	436	=cut
420	437	*/
421	438	i_img*
422		i_readtiff_wiol(io_glue *ig, int length, int page) {
	439	i_readtiff_wiol(io_glue *ig, int allow_incomplete, int page) {
423	440	TIFF* tif;
424	441	TIFFErrorHandler old_handler;
425	442	TIFFErrorHandler old_warn_handler;

435	452	/* Also add code to check for mmapped code */
436	453
437	454	io_glue_commit_types(ig);
438		mm_log((1, "i_readtiff_wiol(ig %p, length %d)\n", ig, length));
	455	mm_log((1, "i_readtiff_wiol(ig %p, allow_incomplete %d, page %d)\n", ig, allow_incomplete, page));
439	456
440	457	tif = TIFFClientOpen("(Iolayer)",
441	458	"rm",

467	484	}
468	485	}
469	486
470		im = read_one_tiff(tif);
	487	im = read_one_tiff(tif, allow_incomplete);
471	488
472	489	if (TIFFLastDirectory(tif)) mm_log((1, "Last directory of tiff file\n"));
473	490	TIFFSetErrorHandler(old_handler);

525	542
526	543	*count = 0;
527	544	do {
528		i_img *im = read_one_tiff(tif);
	545	i_img *im = read_one_tiff(tif, 0);
529	546	if (!im)
530	547	break;
531	548	if (++*count > result_alloc) {

+1

-3

typemap less more

108	108	if ($var) {
109	109	SV *imobj = NEWSV(0, 0);
110	110	HV *hv = newHV();
111		SV *hvref;
112		SV *imgref;
113	111	sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
114	112	hv_store(hv, "IMG", 3, imobj, 0);
115		$arg = sv_2mortal(sv_bless(newRV((SV*)hv), gv_stashpv("Imager", 1)));
	113	$arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1)));
116	114	}
117	115	else {
118	116	$arg = &PL_sv_undef;

+152

-43

win32.c less more

13	13	if (i_wf_bbox(facename, size, text, text_len, bbox)) {
14	14	// we have the bbox
15	15	}
16		i_wf_text(face, im, tx, ty, cl, size, text, len, align, aa);
17		i_wf_cp(face, im, tx, ty, channel, size, text, len, align, aa)
	16	i_wf_text(face, im, tx, ty, cl, size, text, len, align, aa, utf8);
	17	i_wf_cp(face, im, tx, ty, channel, size, text, len, align, aa, utf8)
18	18
19	19	=head1 DESCRIPTION
20	20

30	30	static void set_logfont(const char face, int size, LOGFONT lf);
31	31
32	32	static LPVOID render_text(const char face, int size, const char text, int length, int aa,
33		HBITMAP pbm, SIZE psz, TEXTMETRIC *tm);
34
35		/*
36		=item i_wf_bbox(face, size, text, length, bbox)
	33	HBITMAP pbm, SIZE psz, TEXTMETRIC tm, int bbox, int utf8);
	34	static LPWSTR utf8_to_wide_string(char const text, int text_len, int wide_chars);
	35
	36	/*
	37	=item i_wf_bbox(face, size, text, length, bbox, utf8)
37	38
38	39	Calculate a bounding box for the text.
39	40
40	41	=cut
41	42	*/
42	43
43		int i_wf_bbox(const char face, int size, const char text, int length, int *bbox) {
	44	int i_wf_bbox(const char face, int size, const char text, int length, int *bbox,
	45	int utf8) {
44	46	LOGFONT lf;
45	47	HFONT font, oldFont;
46	48	HDC dc;

48	50	TEXTMETRIC tm;
49	51	ABC first, last;
50	52	GLYPHMETRICS gm;
51		int i;
52	53	MAT2 mat;
53	54	int ascent, descent, max_ascent = -size, min_descent = size;
54
55		mm_log((1, "i_wf_bbox(face %s, size %d, text %p, length %d, bbox %p)\n", face, size, text, length, bbox));
	55	const char *workp;
	56	int work_len;
	57	int got_first_ch = 0;
	58	unsigned long first_ch, last_ch;
	59
	60	mm_log((1, "i_wf_bbox(face %s, size %d, text %p, length %d, bbox %p, utf8 %d)\n", face, size, text, length, bbox, utf8));
56	61
57	62	set_logfont(face, size, &lf);
58	63	font = CreateFontIndirect(&lf);

68	73	}
69	74	}
70	75
71		for (i = 0; i < length; ++i) {
72		unsigned char c = text[i];
73		unsigned char cp = c > '~' ? '.' : c < ' ' ? '.' : c;
	76	workp = text;
	77	work_len = length;
	78	while (work_len > 0) {
	79	unsigned long c;
	80	unsigned char cp;
	81
	82	if (utf8) {
	83	c = i_utf8_advance(&workp, &work_len);
	84	if (c == ~0UL) {
	85	i_push_error(0, "invalid UTF8 character");
	86	return 0;
	87	}
	88	}
	89	else {
	90	c = (unsigned char)*workp++;
	91	--work_len;
	92	}
	93	if (!got_first_ch) {
	94	first_ch = c;
	95	++got_first_ch;
	96	}
	97	last_ch = c;
	98
	99	cp = c > '~' ? '.' : c < ' ' ? '.' : c;
74	100
75	101	memset(&mat, 0, sizeof(mat));
76	102	mat.eM11.value = 1;
77	103	mat.eM22.value = 1;
78		if (GetGlyphOutline(dc, c, GGO_METRICS, &gm, 0, NULL, &mat) != GDI_ERROR) {
	104	if (GetGlyphOutline(dc, (UINT)c, GGO_METRICS, &gm, 0, NULL, &mat) != GDI_ERROR) {
79	105	mm_log((2, " glyph '%c' (%02x): bbx (%u,%u) org (%d,%d) inc(%d,%d)\n",
80	106	cp, c, gm.gmBlackBoxX, gm.gmBlackBoxY, gm.gmptGlyphOrigin.x,
81	107	gm.gmptGlyphOrigin.y, gm.gmCellIncX, gm.gmCellIncY));

90	116	}
91	117	}
92	118
93		if (!GetTextExtentPoint32(dc, text, length, &sz)
94		\|\| !GetTextMetrics(dc, &tm)) {
95		SelectObject(dc, oldFont);
96		ReleaseDC(NULL, dc);
97		DeleteObject(font);
98		return 0;
99		}
100		bbox[BBOX_GLOBAL_DESCENT] = tm.tmDescent;
101		bbox[BBOX_DESCENT] = min_descent == size ? tm.tmDescent : min_descent;
	119	if (utf8) {
	120	int wide_chars;
	121	LPWSTR wide_text = utf8_to_wide_string(text, length, &wide_chars);
	122
	123	if (!wide_text)
	124	return 0;
	125
	126	if (!GetTextExtentPoint32W(dc, wide_text, wide_chars, &sz)
	127	\|\| !GetTextMetrics(dc, &tm)) {
	128	SelectObject(dc, oldFont);
	129	ReleaseDC(NULL, dc);
	130	DeleteObject(font);
	131	return 0;
	132	}
	133
	134	myfree(wide_text);
	135	}
	136	else {
	137	if (!GetTextExtentPoint32(dc, text, length, &sz)
	138	\|\| !GetTextMetrics(dc, &tm)) {
	139	SelectObject(dc, oldFont);
	140	ReleaseDC(NULL, dc);
	141	DeleteObject(font);
	142	return 0;
	143	}
	144	}
	145	bbox[BBOX_GLOBAL_DESCENT] = -tm.tmDescent;
	146	bbox[BBOX_DESCENT] = min_descent == size ? -tm.tmDescent : min_descent;
102	147	bbox[BBOX_POS_WIDTH] = sz.cx;
103	148	bbox[BBOX_ADVANCE_WIDTH] = sz.cx;
104	149	bbox[BBOX_GLOBAL_ASCENT] = tm.tmAscent;
105	150	bbox[BBOX_ASCENT] = max_ascent == -size ? tm.tmAscent : max_ascent;
106	151
107	152	if (length
108		&& GetCharABCWidths(dc, text[0], text[0], &first)
109		&& GetCharABCWidths(dc, text[length-1], text[length-1], &last)) {
110		mm_log((1, "first: %d A: %d B: %d C: %d\n", text[0],
	153	&& GetCharABCWidths(dc, first_ch, first_ch, &first)
	154	&& GetCharABCWidths(dc, last_ch, last_ch, &last)) {
	155	mm_log((1, "first: %d A: %d B: %d C: %d\n", first_ch,
111	156	first.abcA, first.abcB, first.abcC));
112		mm_log((1, "last: %d A: %d B: %d C: %d\n", text[length-1],
	157	mm_log((1, "last: %d A: %d B: %d C: %d\n", last_ch,
113	158	last.abcA, last.abcB, last.abcC));
114	159	bbox[BBOX_NEG_WIDTH] = first.abcA;
115	160	bbox[BBOX_RIGHT_BEARING] = last.abcC;

140	185
141	186	int
142	187	i_wf_text(const char face, i_img im, int tx, int ty, const i_color *cl, int size,
143		const char *text, int len, int align, int aa) {
	188	const char *text, int len, int align, int aa, int utf8) {
144	189	unsigned char *bits;
145	190	HBITMAP bm;
146	191	SIZE sz;

149	194	int ch;
150	195	TEXTMETRIC tm;
151	196	int top;
152
153		bits = render_text(face, size, text, len, aa, &bm, &sz, &tm);
	197	int bbox[BOUNDING_BOX_COUNT];
	198
	199	mm_log((1, "i_wf_text(face %s, im %p, tx %d, ty %d, cl %p, size %d, text %p, length %d, align %d, aa %d, utf8 %d)\n", face, im, tx, ty, cl, size, text, len, align, aa, aa, utf8));
	200
	201	if (!i_wf_bbox(face, size, text, len, bbox, utf8))
	202	return 0;
	203
	204	bits = render_text(face, size, text, len, aa, &bm, &sz, &tm, bbox, utf8);
154	205	if (!bits)
155	206	return 0;
156	207
	208	tx += bbox[BBOX_NEG_WIDTH];
157	209	line_width = sz.cx * 3;
158	210	line_width = (line_width + 3) / 4 * 4;
159	211	top = ty;

161	213	top -= tm.tmAscent;
162	214	}
163	215	else {
164		int bbox[BOUNDING_BOX_COUNT];
165
166		i_wf_bbox(face, size, text, len, bbox);
167	216	top -= tm.tmAscent - bbox[BBOX_ASCENT];
168	217	}
169	218

195	244
196	245	int
197	246	i_wf_cp(const char face, i_img im, int tx, int ty, int channel, int size,
198		const char *text, int len, int align, int aa) {
	247	const char *text, int len, int align, int aa, int utf8) {
199	248	unsigned char *bits;
200	249	HBITMAP bm;
201	250	SIZE sz;

203	252	int x, y;
204	253	TEXTMETRIC tm;
205	254	int top;
206
207		bits = render_text(face, size, text, len, aa, &bm, &sz, &tm);
	255	int bbox[BOUNDING_BOX_COUNT];
	256
	257	mm_log((1, "i_wf_cp(face %s, im %p, tx %d, ty %d, channel %d, size %d, text %p, length %d, align %d, aa %d, utf8 %d)\n", face, im, tx, ty, channel, size, text, len, align, aa, aa, utf8));
	258
	259	if (!i_wf_bbox(face, size, text, len, bbox, utf8))
	260	return 0;
	261
	262	bits = render_text(face, size, text, len, aa, &bm, &sz, &tm, bbox, utf8);
208	263	if (!bits)
209	264	return 0;
210	265

215	270	top -= tm.tmAscent;
216	271	}
217	272	else {
218		int bbox[BOUNDING_BOX_COUNT];
219
220		i_wf_bbox(face, size, text, len, bbox);
221	273	top -= tm.tmAscent - bbox[BBOX_ASCENT];
222	274	}
223	275

295	347	=cut
296	348	*/
297	349	static LPVOID render_text(const char face, int size, const char text, int length, int aa,
298		HBITMAP pbm, SIZE psz, TEXTMETRIC *tm) {
	350	HBITMAP pbm, SIZE psz, TEXTMETRIC tm, int bbox, int utf8) {
299	351	BITMAPINFO bmi;
300	352	BITMAPINFOHEADER *bmih = &bmi.bmiHeader;
301	353	HDC dc, bmpDc;

304	356	SIZE sz;
305	357	HBITMAP bm, oldBm;
306	358	LPVOID bits;
307
	359	int wide_count;
	360	LPWSTR wide_text;
	361
308	362	dc = GetDC(NULL);
309	363	set_logfont(face, size, &lf);
310	364

315	369	lf.lfQuality = aa ? ANTIALIASED_QUALITY : NONANTIALIASED_QUALITY;
316	370	#endif
317	371
	372	if (utf8) {
	373	wide_text = utf8_to_wide_string(text, length, &wide_count);
	374	}
	375	else {
	376	wide_text = NULL;
	377	}
	378
318	379	bmpDc = CreateCompatibleDC(dc);
319	380	if (bmpDc) {
320	381	font = CreateFontIndirect(&lf);
321	382	if (font) {
322	383	oldFont = SelectObject(bmpDc, font);
323		GetTextExtentPoint32(bmpDc, text, length, &sz);
	384
324	385	GetTextMetrics(bmpDc, tm);
	386	sz.cx = bbox[BBOX_ADVANCE_WIDTH] - bbox[BBOX_NEG_WIDTH] + bbox[BBOX_POS_WIDTH];
	387	sz.cy = bbox[BBOX_GLOBAL_ASCENT] - bbox[BBOX_GLOBAL_DESCENT];
325	388
326	389	memset(&bmi, 0, sizeof(bmi));
327	390	bmih->biSize = sizeof(*bmih);

342	405	oldBm = SelectObject(bmpDc, bm);
343	406	SetTextColor(bmpDc, RGB(255, 255, 255));
344	407	SetBkColor(bmpDc, RGB(0, 0, 0));
345		TextOut(bmpDc, 0, 0, text, length);
	408	if (utf8) {
	409	TextOutW(bmpDc, -bbox[BBOX_NEG_WIDTH], 0, wide_text, wide_count);
	410	}
	411	else {
	412	TextOut(bmpDc, -bbox[BBOX_NEG_WIDTH], 0, text, length);
	413	}
346	414	SelectObject(bmpDc, oldBm);
347	415	}
348	416	else {

352	420	DeleteObject(font);
353	421	DeleteDC(bmpDc);
354	422	ReleaseDC(NULL, dc);
	423	if (wide_text)
	424	myfree(wide_text);
355	425	return NULL;
356	426	}
357	427	SelectObject(bmpDc, oldFont);
358	428	DeleteObject(font);
359	429	}
360	430	else {
	431	if (wide_text)
	432	myfree(wide_text);
361	433	i_push_errorf(0, "Could not create logical font: %ld",
362	434	GetLastError());
363	435	DeleteDC(bmpDc);

367	439	DeleteDC(bmpDc);
368	440	}
369	441	else {
	442	if (wide_text)
	443	myfree(wide_text);
370	444	i_push_errorf(0, "Could not create rendering DC: %ld", GetLastError());
371	445	ReleaseDC(NULL, dc);
372	446	return NULL;
373	447	}
374	448
	449	if (wide_text)
	450	myfree(wide_text);
	451
375	452	ReleaseDC(NULL, dc);
376	453
377	454	*pbm = bm;

381	458	}
382	459
383	460	/*
	461	=item utf8_to_wide_string(text, text_len, wide_chars)
	462
	463	=cut
	464	*/
	465
	466	static
	467	LPWSTR
	468	utf8_to_wide_string(char const text, int text_len, int wide_chars) {
	469	int wide_count = MultiByteToWideChar(CP_UTF8, 0, text, text_len, NULL, 0);
	470	LPWSTR result;
	471
	472	if (wide_count < 0) {
	473	i_push_errorf(0, "Could not convert utf8: %ld", GetLastError());
	474	return NULL;
	475	}
	476	++wide_count;
	477	result = mymalloc(sizeof(WCHAR) * wide_count);
	478	if (MultiByteToWideChar(CP_UTF8, 0, text, text_len, result, wide_count) < 0) {
	479	i_push_errorf(0, "Could not convert utf8: %ld", GetLastError());
	480	return NULL;
	481	}
	482
	483	result[wide_count-1] = (WCHAR)'\0';
	484	*wide_chars = wide_count - 1;
	485
	486	return result;
	487	}
	488
	489
	490	/*
	491	=back
	492
384	493	=head1 BUGS
385	494
386	495	Should really use a structure so we can set more attributes.