1
(***********************************************************************)
5
(* Fran�ois Pessaux, projet Cristal, INRIA Rocquencourt *)
6
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
7
(* Jun Furuse, projet Cristal, INRIA Rocquencourt *)
9
(* Copyright 1999, 2004 *)
10
(* Institut National de Recherche en Informatique et en Automatique. *)
11
(* Distributed only by permission. *)
13
(***********************************************************************)
15
(* $Id: ppm.ml,v 1.1 2007/01/18 10:29:57 rousse Exp $ *)
17
(* Manipulating images in portable format: PPM, PGM, and PBM.
19
PPM: portable pixmap (pixels (picture element) map).
20
PGM: portable greymap (grey scale map).
21
PBM: portable bitmap (binary digit map).
27
(* Reading PPM images. *)
29
type ppm_magic_number = | P1 | P2 | P3 | P4 | P5 | P6;;
30
(* Magic numbers for PPM images.
31
P1 and P4 indicate bitmaps (P1 is ascii encoding, P4 is raw encoding).
32
P2 and P5 indicate greymaps, in raw or ascii encoding.
33
P3 and P6 indicate pixmaps (P3 is ascii encoding, P6 is raw encoding).
35
The library systematically saves images in raw form (which is more compact).
38
let magic_number_of_string = function
39
| "P1" (* BITMAP, ASCII form *) -> P1
40
| "P2" (* BITMAP, ASCII form *) -> P2
41
| "P3" (* PIXMAP, ASCII form *) -> P3
42
| "P4" (* BITMAP, RAW form *) -> P4
43
| "P5" (* BITMAP, ASCII form *) -> P5
44
| "P6" (* PIXMAP, RAW form *) -> P6
45
| s -> invalid_arg ("Unknown magic number for PPM image: " ^ s);;
47
let read_ppm_magic_number ic = magic_number_of_string (input_line ic);;
49
let string_of_magic_number = function
57
(* Auxiliaries: skipping comments and reading numbers into strings. *)
58
let rec skip_comment ic =
60
match input_char ic with
66
match input_char ic with
71
(* Read a sequence of digits eventually followed by a single space. *)
72
let read_int_accu accu ic =
74
match input_char ic with
75
| '0' .. '9' as c -> read1 (10 * accu + int_of_char c - 48)
78
| _ -> invalid_arg "read_int"
81
match input_char ic with
82
| '0' .. '9' as c -> read1 (10 * accu + int_of_char c - 48)
86
let read_int ic = read_int_accu 0 ic;;
89
let cols = read_int_accu (int_of_char c - 48) ic in
90
let lines = read_int ic in
93
let read_max ic = read_int ic;;
95
let read_ppm_header ic =
96
(* Reads something like
98
# CREATOR: XV Version 3.10 Rev: 12/16/94
102
let mn = read_ppm_magic_number ic in
103
let char = skip_comment ic in
104
let c, l = read_dims char ic in
107
let check_header filename =
108
let ic = open_in_bin filename in
110
let mn, l, c = read_ppm_header ic in
118
raise Wrong_file_type;;
120
(* Reading pixmaps. *)
121
let read_raw_pixel24 ic =
122
let r = input_byte ic in
123
let g = input_byte ic in
124
let b = input_byte ic in
125
{r = r; g = g; b = b};;
127
let read_ascii_pixel24 ic =
128
let r = read_int ic in
129
let g = read_int ic in
130
let b = read_int ic in
131
{r = r; g = g; b = b};;
133
let read_raw_ppm_ic ic l c max =
134
let img = Rgb24.create c l in
135
for i = 0 to l - 1 do
136
for j = 0 to c - 1 do
137
Rgb24.set img j i (read_raw_pixel24 ic)
142
let read_ascii_ppm_ic ic l c max =
143
let img = Rgb24.create c l in
144
for i = 0 to l - 1 do
145
for j = 0 to c - 1 do
146
Rgb24.set img j i (read_ascii_pixel24 ic)
151
(* Reading greymaps. *)
152
let read_raw_grey = input_byte;;
154
let read_ascii_grey = read_int;;
156
let read_raw_gen_ic read_pixel ic l c max =
157
let img = Index8.create c l in
161
let make_grey i = {r = i; g = i; b = i} in
162
Array.init (max + 1) make_grey} in
163
img.Index8.colormap <- greymap;
164
for i = 0 to l - 1 do
165
for j = 0 to c - 1 do
166
Index8.set img j i (read_pixel ic)
171
let read_raw_pgm_ic ic = read_raw_gen_ic read_raw_grey ic;;
173
let read_ascii_pgm_ic ic = read_raw_gen_ic read_ascii_grey ic;;
175
let black = 0 and white = 255;;
178
(* Reading bitmaps. *)
179
let read_raw_pbm_ic ic l c =
180
let img = Index8.create c l in
182
{ Color.max = max_byte;
184
let make_grey i = {r = i; g = i; b = i} in
185
Array.init (max_byte + 1) make_grey} in
186
img.Index8.colormap <- greymap;
187
for i = 0 to l - 1 do
188
let rec loop j bn byte =
189
if j = c then () else
190
if bn = 8 then loop j 0 (input_byte ic) else
192
match byte land 0x80 with
195
Index8.set img j i color;
196
let new_byte = byte lsl 1 in
197
loop (j + 1) (bn + 1) new_byte
199
loop 0 0 (input_byte ic)
203
let rec read_ascii_bit ic =
204
match input_char ic with
206
| ' ' -> read_ascii_bit ic
207
| '\n' -> read_ascii_bit ic
210
let read_ascii_pbm_ic ic l c = read_raw_gen_ic read_ascii_bit ic l c max_byte;;
212
let rec read_ppm_ic ic =
213
let mn, l, c = read_ppm_header ic in
216
| P1 -> Index8 (read_ascii_pbm_ic ic l c)
217
| P4 -> Index8 (read_raw_pbm_ic ic l c)
218
| P2 | P3 | P5 | P6 ->
219
let max = read_max ic in
221
| P2 -> Index8 (read_ascii_pgm_ic ic l c max)
222
| P3 -> Rgb24 (read_ascii_ppm_ic ic l c max)
223
| P5 -> Index8 (read_raw_pgm_ic ic l c max)
224
| _ -> Rgb24 (read_raw_ppm_ic ic l c max) in
228
let ic = open_in_bin s in
230
let img = read_ppm_ic ic in
234
close_in ic; invalid_arg "read_ppm: premature end of file";;
237
match read_ppm s with
239
| _ -> invalid_arg (s ^ " is not a ppm file.");;
243
let save_ppm_header img mn oc l c =
244
output_string oc (Printf.sprintf "%s\n" (string_of_magic_number mn));
245
output_string oc "# CREATOR: CamlImages package\n";
246
output_string oc (Printf.sprintf "%d %d\n" c l);
247
if mn <> P1 && mn <> P4 then output_string oc (Printf.sprintf "%d\n" 255);;
249
let bit_set = 1 and bit_cleared = 0;;
251
let gen_save_raw_pbm_oc is_white img oc l c =
252
save_ppm_header img P4 oc l c;
253
for i = 0 to l - 1 do
254
let rec loop j bn byte =
256
if bn = 0 then () else
257
let byte = byte lsl (8 - bn) in
258
output_byte oc byte else
259
if bn = 8 then (output_byte oc byte; loop j 0 0) else
261
if is_white (Index8.get_rgb img j i) then bit_set else bit_cleared in
262
let new_byte = (byte lsl 1) lor color in
263
loop (j + 1) (bn + 1) new_byte
268
(* Save a bitmap in raw form. *)
269
let save_raw_pbm_oc =
270
gen_save_raw_pbm_oc (fun c -> c.r = 255 && c.g = 255 && c.b = 255);;
273
(* Save a transparency mask as a bitmap in raw form. *)
274
let save_mask = gen_save_raw_pbm_oc (fun c -> c = transp);;
277
(* Save a pixmap in raw form. *)
278
let save_raw_ppm_oc img oc l c =
279
save_ppm_header img P6 oc l c;
280
let has_transp = ref false in
281
for i = 0 to l - 1 do
282
for j = 0 to c - 1 do
283
let color = Rgb24.get img j i in
284
output_byte oc color.r;
285
output_byte oc color.g;
286
output_byte oc color.b
291
let save_ppm_oc img oc =
292
let l = img.Rgb24.height in
293
if l = 0 then invalid_arg "save_ppm: invalid null line number";
294
let c = img.Rgb24.width in
295
if c = 0 then invalid_arg "save_ppm: invalid null column number";
297
let has_transp = save_raw_ppm_oc img oc l c in
300
(* Save the transparency mask *)
302
save_mask img oc l c;
303
(* and correct the magic number *)
310
let oc = open_out_bin s in
314
let save_bitmap_oc img oc =
315
let l = img.Index8.height in
316
if l = 0 then invalid_arg "save_ppm: invalid null line number";
317
let c = img.Index8.width in
318
if c = 0 then invalid_arg "save_ppm: invalid null column number";
319
save_raw_pbm_oc img oc l c;;
321
let save_bitmap s img =
322
let oc = open_out_bin s in
323
save_bitmap_oc img oc;
326
let load s _ = read_ppm s;;
331
| _ -> invalid_arg "Not a pbm file.";;
333
let save s _ = function
334
| Index8 t -> save_bitmap s t
335
| Rgb24 t -> save_ppm s t
336
| _ -> invalid_arg "Ppm.save";;
339
{ check_header = check_header;
342
load_sequence = None;
343
save_sequence = None};;
added
removed
src/ppm.ml
