diff --git a/cpdfpng.ml b/cpdfpng.ml index 7a02b75..7955b42 100644 --- a/cpdfpng.ml +++ b/cpdfpng.ml @@ -9,6 +9,72 @@ type t = height : int; idat : bytes} +(* Writing *) +let crc_table = + let f n = + let c = ref (i32ofi n) in + for _ = 0 to 7 do + c := lxor32 (lsr32 !c 1) (land32 0xedb88320l (i32succ (lnot32 (land32 !c 1l)))) + done; + !c + in + Array.init 256 f + +let update_crc crc buf len = + let c = ref crc in + for n = 0 to len - 1 do + let e = i32ofi (int_of_char buf.[n]) in + c := lxor32 crc_table.(i32toi (land32 (lxor32 !c e) 0xffl)) (lsr32 !c 8) + done; + !c + +let png_crc buf len = + lnot32 (update_crc 0xffffffffl buf len) + +let bytes_of_word x = + i32toi (Int32.shift_right x 24), + i32toi (land32 0x000000FFl (Int32.shift_right x 16)), + i32toi (land32 0x000000FFl (Int32.shift_right x 8)), + i32toi (land32 0x000000FFl x) + +let write_crc o ctype cdata = + let crc = update_crc 0xffffffffl ctype 4 in + let crc = update_crc 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_chunk o ctype data = + for x = 0 to 4 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 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) + +let write_png png o = + if bytes_size png.idat > 2147483647 then raise (Invalid_argument "write_png: too large") else + (* Signature *) + o.output_string "\137\080\078\071\013\010\026\010"; + let ihdr = Bytes.create 13 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 (Pdfio.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 (Int32.shift_right t 24))) @@ -74,58 +140,3 @@ let read_png i = {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))) - -let (>>) = Int32.shift_right_logical -let (&) = Int32.logand -let (^) = Int32.logxor - -let crc_table = - let elem n = - let c = ref (Int32.of_int n) in - for _ = 0 to 7 do - c := (!c >> 1) ^ (0xedb88320l & (Int32.succ (Int32.lognot (!c & 1l)))) - done; !c - in Array.init 256 elem - -let update_crc crc buf len = - let c = ref crc in - for n = 0 to len - 1 do - let e = Int32.of_int (int_of_char buf.[n]) in - c := crc_table.(Int32.to_int ((!c ^ e) & 0xffl)) ^ (!c >> 8) - done; !c - -let png_crc buf len = - Int32.lognot (update_crc 0xffffffffl buf len) - -let write_crc o ctype cdata = - o.output_byte 0; - o.output_byte 0; - o.output_byte 0; - o.output_byte 0 - -let write_chunk o ctype data = - for x = 0 to 4 do o.output_byte (int_of_char ctype.[x]) done; - o.output_string (Bytes.unsafe_to_string data); - write_crc o ctype data - -let write_word b p n = - Bytes.set b p ' '; - Bytes.set b (p + 1) ' '; - Bytes.set b (p + 2) ' '; - Bytes.set b (p + 3) ' ' - -let write_png png o = - if bytes_size png.idat > 2147483647 then raise (Invalid_argument "write_png: too large") else - (* Signature *) - o.output_string "\137\080\078\071\013\010\026\010"; - let ihdr = Bytes.create 13 in - write_word ihdr 0 png.width; - write_word ihdr 4 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 (Pdfio.string_of_bytes png.idat)); - write_chunk o "IEND" (Bytes.create 0)