fenix
/
cpdf-source
mirror of https://github.com/johnwhitington/cpdf-source.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

First successful PNG output

This commit is contained in:
John Whitington 2023-03-20 21:02:10 +00:00
parent 21ad211e03
commit c20411eb14
3 changed files with 39 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -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)

89
cpdfpng.ml
View File

@ -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)))

4
cpdfpng.mli
View File

@ -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 *)