1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
(* Read non-interlaced, non-transparent PNGs. Such a PNG may
be loaded into a PDF simply by extracting its width and height from the
IHDR, and concatenating all its IDAT data sections together, and specifying
the appropriate Filter and Predictor.*)
open Pdfutil
open Pdfio
type t =
{width : int;
height : int;
bitdepth : int;
colortype : int;
idat : bytes}
(* Writing *)
(*let tbl =
ref ([||] : int32 array)
let mktbl () =
let f n =
let a = ref (i32ofi n) in
for _ = 0 to 7 do
a := lxor32 (lsr32 !a 1) (land32 0xEDB88320l (i32succ (lnot32 (land32 !a 1l))))
done;
!a
in
tbl := Array.init 256 f
let update crc buf len =
let a = ref crc in
for n = 0 to len - 1 do
let e = i32ofi (int_of_char buf.[n]) in
a := lxor32 !tbl.(i32toi (land32 (lxor32 !a e) 0xFFl)) (lsr32 !a 8)
done;
!a
let bytes_of_word x =
i32toi (sr32 x 24),
i32toi (land32 0x000000FFl (sr32 x 16)),
i32toi (land32 0x000000FFl (sr32 x 8)),
i32toi (land32 0x000000FFl x)
let output_bytes_of_word o w =
let a, b, c, d = bytes_of_word w in
o.output_byte a;
o.output_byte b;
o.output_byte c;
o.output_byte d
let write_crc o ctype cdata =
let crc = update 0xFFFFFFFFl ctype 4 in
let crc = update crc cdata (String.length cdata) in
let crc = lnot32 crc in
output_bytes_of_word o crc
let write_chunk o ctype data =
output_bytes_of_word o (i32ofi (Bytes.length data));
for x = 0 to 3 do o.output_byte (int_of_char ctype.[x]) done;
o.output_string (Bytes.unsafe_to_string data);
write_crc o ctype (Bytes.unsafe_to_string data)
let write_word b x n =
let p, q, r, s = bytes_of_word n in
Bytes.set b x (char_of_int p);
Bytes.set b (x + 1) (char_of_int q);
Bytes.set b (x + 2) (char_of_int r);
Bytes.set b (x + 3) (char_of_int s)
let write_png png o =
if bytes_size png.idat > 1073741823 then raise (Invalid_argument "write_png: too large") else
if Array.length !tbl = 0 then mktbl ();
o.output_string "\137\080\078\071\013\010\026\010";
let ihdr = Bytes.make 13 '\000' in
write_word ihdr 0 (i32ofi png.width);
write_word ihdr 4 (i32ofi png.height);
Bytes.set ihdr 8 (char_of_int 8); (* bit depth *)
Bytes.set ihdr 9 (char_of_int 2); (* colour type *)
Bytes.set ihdr 10 (char_of_int 0); (* compression method *)
Bytes.set ihdr 11 (char_of_int 0); (* filter method *)
Bytes.set ihdr 12 (char_of_int 0); (* interlace method *)
write_chunk o "IHDR" ihdr;
write_chunk o "IDAT" (Bytes.unsafe_of_string (string_of_bytes png.idat));
write_chunk o "IEND" (Bytes.create 0)*)
(* Reading *)
let string_of_tag t =
Printf.sprintf "%c%c%c%c"
(char_of_int (i32toi (sr32 t 24)))
(char_of_int (i32toi (land32 0x000000FFl (sr32 t 16))))
(char_of_int (i32toi (land32 0x000000FFl (sr32 t 8))))
(char_of_int (i32toi (land32 0x000000FFl t)))
let read_unsigned_4byte i =
let a = i32ofi (i.input_byte ()) in
let b = i32ofi (i.input_byte ()) in
let c = i32ofi (i.input_byte ()) in
let d = i32ofi (i.input_byte ()) in
lor32 (lor32 (lsl32 a 24) (lsl32 b 16)) (lor32 (lsl32 c 8) d)
let read_chunk i =
let chunklen = i32toi (read_unsigned_4byte i) in
let chunktype = read_unsigned_4byte i in
let chunkdata = mkbytes chunklen in
setinit i chunkdata 0 chunklen;
let _ (* crc *) = read_unsigned_4byte i in
(string_of_tag chunktype, chunkdata)
let concat_bytes ss =
let total_length = sum (map bytes_size ss) in
let s' = mkbytes total_length in
let p = ref 0 in
iter
(fun s ->
for x = 0 to bytes_size s - 1 do bset_unsafe s' !p (bget_unsafe s x); incr p done)
ss;
s'
let read_png i =
try
i.seek_in 8;
let ihdr, ihdrdata = read_chunk i in
if ihdr <> "IHDR" then raise (Pdf.PDFError "read_png: first table not IHDR") else
let hdr = input_of_bytes ihdrdata in
let width = read_unsigned_4byte hdr in
let height = read_unsigned_4byte hdr in
let bitdepth = hdr.input_byte () in
let colortype = hdr.input_byte () in
if colortype <> 2 && colortype <> 0 && colortype <> 6 && colortype <> 4 then raise (Pdf.PDFError "read_png: only non-palette PNGs") else
let _ (*compressionmethod*) = hdr.input_byte () in
let _ (*filtermethod*) = hdr.input_byte () in
let interlacemethod = hdr.input_byte () in
if interlacemethod <> 0 then raise (Pdf.PDFError "read_png: interlaced PDFs not supported") else
let idat = ref [] in
begin try
while true do
let chunkname, chunkdata = read_chunk i in
if chunkname = "IDAT" then idat := chunkdata::!idat
done
with
_ -> ()
end;
{width = i32toi width;
height = i32toi height;
colortype;
bitdepth;
idat = concat_bytes (rev !idat)}
with
e -> raise (Pdf.PDFError (Printf.sprintf "read_png: failed on %s" (Printexc.to_string e)))
|
