/pliant/graphic/filter/ppm.pli
1	abstract
2	[The popular among free softwares PPM file format interface.] ; eol
3	[PPM is not recommended because the header (3 lines) is sadely designed ]
4	[(it should be any nomber of lines, followed by a blank line), but it's ]
5	[still a trivial file format that you may need in order to pipe an image ]
6	[to another software.]
7
8	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
9	#
10	# This program is free software; you can redistribute it and/or
11	# modify it under the terms of the GNU General Public License version 2
12	# as published by the Free Software Foundation.
13	#
14	# This program is distributed in the hope that it will be useful,
15	# but WITHOUT ANY WARRANTY; without even the implied warranty of
16	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17	# GNU General Public License for more details.
18	#
19	# You should have received a copy of the GNU General Public License
20	# version 2 along with this program; if not, write to the Free Software
21	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
22
23
24	module "/pliant/language/compiler.pli"
25	module "/pliant/language/stream.pli"
26	module "prototype.pli"
27	module "/pliant/graphic/color/gamut.pli"
28	module "/pliant/graphic/misc/bytes.pli"
29
30
31	type ImageReadFilterPpm
32	field Pointer:Stream stream
33	field Int line_size
34	field CBool negative
35	field Address buffer
36
37	ImageReadFilter maybe ImageReadFilterPpm
38
39
40	method f open stream options h -> status
41	arg_rw ImageReadFilterPpm f ; arg_rw Stream stream ; arg Str options ; arg_w ImagePrototype h ; arg ExtendedStatus status
42	f stream :> stream
43	var Str mode := stream readline ; var Str gamut_name ; var Int pixel_size
44	if mode="P6"
45	gamut_name := "rgb" ; pixel_size := 3
46	eif mode="P5"
47	gamut_name := "grey" ; pixel_size := 1
48	else
49	return (failure "This is not a ppmraw or pgmraw image ("+(mode 0 16)+")")
50	stream readline # comment
51	if not (stream:readline parse (var Int size_x) (var Int size_y))
52	return failure:"Invalid image header"
53	stream readline # maximal value
54	var Float rx ry
55	if ((options (options option_position "resolution" options:len) options:len) parse word:"resolution" rx ry any)
56	void
57	eif ((options (options option_position "resolution" options:len) options:len) parse word:"resolution" rx any)
58	ry := rx
59	else
60	rx := 72 ; ry := 72
61	h := image_prototype 0 0 size_x/rx*25.4 size_y/ry*25.4 size_x size_y color_gamut:gamut_name
62	f line_size := h line_size
63	f negative := options option "negative"
64	if f:negative
65	f buffer := memory_allocate f:line_size addressof:f
66	status := success
67
68	method f readline adr -> status
69	arg_rw ImageReadFilterPpm f ; arg Address adr ; arg Status status
70	if f:negative
71	f:stream raw_read f:buffer f:line_size
72	bytes_copy_255minus f:buffer 1 adr 1 f:line_size
73	else
74	f:stream raw_read adr f:line_size
75	status := success
76
77	method f close -> status
78	arg_rw ImageReadFilterPpm f ; arg ExtendedStatus status
79	if f:negative
80	memory_free f:buffer
81	status := success
82
83
84
85
86
87	type ImageWriteFilterPpm
88	field Pointer:Stream stream
89	field Int line_size
90	field CBool negative
91	field Address buffer
92
93	ImageWriteFilter maybe ImageWriteFilterPpm
94
95
96	method f open stream options h -> status
97	arg_rw ImageWriteFilterPpm f ; arg_rw Stream stream ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status
98	if h:gamut:name<>"rgb" and h:gamut:pixel_size<>1
99	return failure:"Only RGB or grey images can be saved as .ppm or .pgm"
100	f stream :> stream
101	f line_size := h line_size
102	f negative := options option "negative"
103	if f:negative
104	f buffer := memory_allocate f:line_size addressof:f
105	stream writeline (shunt h:gamut:pixel_size=1 "P5" "P6")
106	stream writeline "# Pliant GhostScript postprocessor"
107	stream writeline (string h:size_x)+" "+(string h:size_y)
108	stream writeline "255"
109	status := success
110
111	method f writeline adr -> status
112	arg_rw ImageWriteFilterPpm f ; arg Address adr ; arg Status status
113	if f:negative
114	bytes_copy_255minus adr 1 f:buffer 1 f:line_size
115	f:stream raw_write f:buffer f:line_size
116	else
117	f:stream raw_write adr f:line_size
118	status := success
119
120	method f close -> status
121	arg_rw ImageWriteFilterPpm f ; arg ExtendedStatus status
122	if f:negative
123	memory_free f:buffer
124	status := success
125
126	image_record_filters ".ppm" ImageReadFilterPpm false ImageWriteFilterPpm false
127	image_record_filters ".pgm" ImageReadFilterPpm false ImageWriteFilterPpm false
128
129