First successful PNG output

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)
 

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 output_bytes_of_word o w =
-  let crc = update 0xffffffffl ctype 4 in
+  let a, b, c, d = bytes_of_word w in
-  let crc = update crc cdata (String.length cdata) in
-  let a, b, c, d = bytes_of_word crc 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
+  output_bytes_of_word o (i32ofi (Bytes.length data));
-  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;
   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 x (char_of_int p);
-  Bytes.set b (p + 1) (char_of_int q);
+    Bytes.set b (x + 1) (char_of_int q);
-  Bytes.set b (p + 2) (char_of_int r);
+    Bytes.set b (x + 2) (char_of_int r);
-  Bytes.set b (p + 3) (char_of_int s)
+    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;
+  Printf.sprintf "%c%c%c%c"
-  let a = (char_of_int (i32toi (sr32 t 24))) in
+    (char_of_int (i32toi (sr32 t 24)))
-  let b = (char_of_int (i32toi (land32 0x000000FFl (sr32 t 16)))) in
+    (char_of_int (i32toi (land32 0x000000FFl (sr32 t 16))))
-  let c = (char_of_int (i32toi (land32 0x000000FFl (sr32 t 8)))) in
+    (char_of_int (i32toi (land32 0x000000FFl (sr32 t 8))))
-  let d = (char_of_int (i32toi (land32 0x000000FFl t))) in
+    (char_of_int (i32toi (land32 0x000000FFl t)))
-  Printf.sprintf "%c%c%c%c" a b c d
 
 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
+  let chunklen = i32toi (read_unsigned_4byte i) in
-  Printf.printf "chunklen: %li\n" chunklen;
   let chunktype = read_unsigned_4byte i in
-  Printf.printf "chunktype: %S\n" (string_of_tag chunktype);
+  let chunkdata = mkbytes chunklen in 
-  let chunkdata = read_data chunklen i 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
+    if interlacemethod <> 0 then raise (Pdf.PDFError "read_png: interlaced PDFs not supported") else
-    flprint "D";
     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)}
-        {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
   with
     e -> raise (Pdf.PDFError (Printf.sprintf "read_png: failed on %s" (Printexc.to_string e)))

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
+(* Read a non-interlaced, non-transparent 24 bit PNG for inclusion in a PDF file. *)
-   file. Raises BadPNG on failure. *)
 val read_png : Pdfio.input -> t
 
 (* Write a non-interlaced, non-transparent 24 bit PNG from PDF image contents *)