diff --git a/Makefile b/Makefile index 69d01a2..8739cbe 100644 --- a/Makefile +++ b/Makefile @@ -39,7 +39,7 @@ all : $(TARGETS) clean :: rm -rf doc foo foo2 out.pdf out2.pdf foo.pdf decomp.pdf *.cmt *.cmti \ *.json test/*.pdf debug/*.pdf *.ps *.aux *.idx *.log *.out *.toc *.cut \ - *.ttf *.ttx + *.ttf *.ttx out.png DOC_FILES = $(foreach x,$(DOC),$(x).mli) diff --git a/cpdfpng.ml b/cpdfpng.ml index 885d4c3..f8a6ea9 100644 --- a/cpdfpng.ml +++ b/cpdfpng.ml @@ -10,21 +10,24 @@ type t = idat : bytes} (* Writing *) -let table = +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)))) + a := lxor32 (lsr32 !a 1) (land32 0xEDB88320l (i32succ (lnot32 (land32 !a 1l)))) done; !a in - Array.init 256 f + 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 table.(i32toi (land32 (lxor32 !a e) 0xffl)) (lsr32 !a 8) + a := lxor32 !tbl.(i32toi (land32 (lxor32 !a e) 0xFFl)) (lsr32 !a 8) done; !a @@ -34,37 +37,37 @@ let bytes_of_word x = i32toi (land32 0x000000FFl (sr32 x 8)), i32toi (land32 0x000000FFl x) -let write_crc o ctype cdata = - let crc = update 0xffffffffl ctype 4 in - let crc = update crc cdata (String.length cdata) in - let a, b, c, d = bytes_of_word crc in +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 = - 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; + 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 p n = +let write_word b x n = let p, q, r, s = bytes_of_word n in - Bytes.set b p (char_of_int p); - Bytes.set b (p + 1) (char_of_int q); - Bytes.set b (p + 2) (char_of_int r); - Bytes.set b (p + 3) (char_of_int s) + 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 > 2147483647 then raise (Invalid_argument "write_png: too large") else - (* Signature *) + if Array.length !tbl = 0 then mktbl (); o.output_string "\137\080\078\071\013\010\026\010"; - let ihdr = Bytes.create 13 in + 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 *) @@ -73,17 +76,16 @@ let write_png png o = 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 (Pdfio.string_of_bytes png.idat)); + 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.printf "%li\n" t; - let a = (char_of_int (i32toi (sr32 t 24))) in - let b = (char_of_int (i32toi (land32 0x000000FFl (sr32 t 16)))) in - let c = (char_of_int (i32toi (land32 0x000000FFl (sr32 t 8)))) in - let d = (char_of_int (i32toi (land32 0x000000FFl t))) in - Printf.sprintf "%c%c%c%c" a b c d + 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 @@ -92,21 +94,12 @@ let read_unsigned_4byte i = let d = i32ofi (i.input_byte ()) in lor32 (lor32 (lsl32 a 24) (lsl32 b 16)) (lor32 (lsl32 c 8) d) -let read_data l i = - Printf.printf "read_data: %li bytes\n" l; - let l = i32toi l in - let b = mkbytes l in - setinit i b 0 l; - b - let read_chunk i = - let chunklen = read_unsigned_4byte i in - Printf.printf "chunklen: %li\n" chunklen; + let chunklen = i32toi (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 = mkbytes chunklen in + setinit i chunkdata 0 chunklen; let _ (* crc *) = read_unsigned_4byte i in - flprint "5"; (string_of_tag chunktype, chunkdata) let concat_bytes ss = @@ -122,24 +115,19 @@ let concat_bytes ss = let read_png i = try i.seek_in 8; - flprint "A"; let ihdr, ihdrdata = read_chunk i in - flprint "B"; 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 - Printf.printf "width = %li, height = %li\n" width height; - flprint "C"; let bitdepth = hdr.input_byte () in - if bitdepth <> 8 then failwith "read_png: bit depth not 8" else + if bitdepth <> 8 then raise (Pdf.PDFError "read_png: bit depth not 8") else let colortype = hdr.input_byte () in - if colortype <> 2 then failwith "read_png: only 24 bit non-alpha PNGs" else + if colortype <> 2 then raise (Pdf.PDFError "read_png: only 24 bit non-alpha PNGs") else let _ (*compressionmethod*) = hdr.input_byte () in let _ (*filtermethod*) = hdr.input_byte () in let interlacemethod = hdr.input_byte () in - if interlacemethod <> 0 then failwith "read_png: interlaced PDFs not supported" else - flprint "D"; + if interlacemethod <> 0 then raise (Pdf.PDFError "read_png: interlaced PDFs not supported") else let idat = ref [] in begin try while true do @@ -149,11 +137,6 @@ let read_png i = with _ -> () end; - let r = - {width = i32toi width; height = i32toi height; idat = concat_bytes (rev !idat)} - in - let ch = open_out_bin "out.png" in - (*write_png r (Pdfio.output_of_channel ch);*) - r + {width = i32toi width; height = i32toi height; idat = concat_bytes (rev !idat)} with e -> raise (Pdf.PDFError (Printf.sprintf "read_png: failed on %s" (Printexc.to_string e))) diff --git a/cpdfpng.mli b/cpdfpng.mli index 16d6ac4..8686052 100644 --- a/cpdfpng.mli +++ b/cpdfpng.mli @@ -1,10 +1,10 @@ +(* PNG files, represented only to the extent required to roundtrip PDF image objects *) type t = {width : int; height : int; idat : Pdfio.bytes} -(* Read a non-interlaced, non-transparent 24 bit PNG for inclusion in a PDF - file. Raises BadPNG on failure. *) +(* Read a non-interlaced, non-transparent 24 bit PNG for inclusion in a PDF file. *) val read_png : Pdfio.input -> t (* Write a non-interlaced, non-transparent 24 bit PNG from PDF image contents *)