This commit is contained in:
John Whitington 2023-03-20 16:56:00 +00:00
parent d6cb104d21
commit 21ad211e03
1 changed files with 21 additions and 6 deletions

View File

@ -44,6 +44,11 @@ let write_crc o ctype cdata =
o.output_byte d o.output_byte d
let write_chunk o ctype data = let write_chunk o ctype data =
let a, b, c, d = bytes_of_word (i32ofi (Bytes.length data)) in
o.output_byte a;
o.output_byte b;
o.output_byte c;
o.output_byte d;
for x = 0 to 3 do o.output_byte (int_of_char ctype.[x]) done; for x = 0 to 3 do o.output_byte (int_of_char ctype.[x]) done;
o.output_string (Bytes.unsafe_to_string data); o.output_string (Bytes.unsafe_to_string data);
write_crc o ctype (Bytes.unsafe_to_string data) write_crc o ctype (Bytes.unsafe_to_string data)
@ -73,11 +78,12 @@ let write_png png o =
(* Reading *) (* Reading *)
let string_of_tag t = let string_of_tag t =
Printf.sprintf "%c%c%c%c" Printf.printf "%li\n" t;
(char_of_int (i32toi (sr32 t 24))) let a = (char_of_int (i32toi (sr32 t 24))) in
(char_of_int (i32toi (land32 0x000000FFl (sr32 t 16)))) let b = (char_of_int (i32toi (land32 0x000000FFl (sr32 t 16)))) in
(char_of_int (i32toi (land32 0x000000FFl (sr32 t 8)))) let c = (char_of_int (i32toi (land32 0x000000FFl (sr32 t 8)))) in
(char_of_int (i32toi (land32 0x000000FFl t))) let d = (char_of_int (i32toi (land32 0x000000FFl t))) in
Printf.sprintf "%c%c%c%c" a b c d
let read_unsigned_4byte i = let read_unsigned_4byte i =
let a = i32ofi (i.input_byte ()) in let a = i32ofi (i.input_byte ()) in
@ -87,6 +93,7 @@ let read_unsigned_4byte i =
lor32 (lor32 (lsl32 a 24) (lsl32 b 16)) (lor32 (lsl32 c 8) d) lor32 (lor32 (lsl32 a 24) (lsl32 b 16)) (lor32 (lsl32 c 8) d)
let read_data l i = let read_data l i =
Printf.printf "read_data: %li bytes\n" l;
let l = i32toi l in let l = i32toi l in
let b = mkbytes l in let b = mkbytes l in
setinit i b 0 l; setinit i b 0 l;
@ -94,9 +101,12 @@ let read_data l i =
let read_chunk i = let read_chunk i =
let chunklen = read_unsigned_4byte i in let chunklen = read_unsigned_4byte i in
Printf.printf "chunklen: %li\n" chunklen;
let chunktype = read_unsigned_4byte i in let chunktype = read_unsigned_4byte i in
Printf.printf "chunktype: %S\n" (string_of_tag chunktype);
let chunkdata = read_data chunklen i in let chunkdata = read_data chunklen i in
let _ (* crc *) = read_unsigned_4byte i in let _ (* crc *) = read_unsigned_4byte i in
flprint "5";
(string_of_tag chunktype, chunkdata) (string_of_tag chunktype, chunkdata)
let concat_bytes ss = let concat_bytes ss =
@ -112,11 +122,15 @@ let concat_bytes ss =
let read_png i = let read_png i =
try try
i.seek_in 8; i.seek_in 8;
flprint "A";
let ihdr, ihdrdata = read_chunk i in let ihdr, ihdrdata = read_chunk i in
flprint "B";
if ihdr <> "IHDR" then raise (Pdf.PDFError "read_png: first table not IHDR") else if ihdr <> "IHDR" then raise (Pdf.PDFError "read_png: first table not IHDR") else
let hdr = input_of_bytes ihdrdata in let hdr = input_of_bytes ihdrdata in
let width = read_unsigned_4byte hdr in let width = read_unsigned_4byte hdr in
let height = read_unsigned_4byte hdr in let height = read_unsigned_4byte hdr in
Printf.printf "width = %li, height = %li\n" width height;
flprint "C";
let bitdepth = hdr.input_byte () in let bitdepth = hdr.input_byte () in
if bitdepth <> 8 then failwith "read_png: bit depth not 8" else if bitdepth <> 8 then failwith "read_png: bit depth not 8" else
let colortype = hdr.input_byte () in let colortype = hdr.input_byte () in
@ -125,6 +139,7 @@ let read_png i =
let _ (*filtermethod*) = hdr.input_byte () in let _ (*filtermethod*) = hdr.input_byte () in
let interlacemethod = hdr.input_byte () in let interlacemethod = hdr.input_byte () in
if interlacemethod <> 0 then failwith "read_png: interlaced PDFs not supported" else if interlacemethod <> 0 then failwith "read_png: interlaced PDFs not supported" else
flprint "D";
let idat = ref [] in let idat = ref [] in
begin try begin try
while true do while true do
@ -138,7 +153,7 @@ let read_png i =
{width = i32toi width; height = i32toi height; idat = concat_bytes (rev !idat)} {width = i32toi width; height = i32toi height; idat = concat_bytes (rev !idat)}
in in
let ch = open_out_bin "out.png" in let ch = open_out_bin "out.png" in
write_png r (Pdfio.output_of_channel ch); (*write_png r (Pdfio.output_of_channel ch);*)
r r
with with
e -> raise (Pdf.PDFError (Printf.sprintf "read_png: failed on %s" (Printexc.to_string e))) e -> raise (Pdf.PDFError (Printf.sprintf "read_png: failed on %s" (Printexc.to_string e)))