This commit is contained in:
John Whitington 2022-10-06 15:28:36 +01:00
parent d56d6c9ace
commit 09d0d0d05c
1 changed files with 42 additions and 29 deletions

View File

@ -173,48 +173,60 @@ let write_loca_table subset cmap indexToLocFormat bs loca =
Hashtbl.add locnums 0 (); (* .notdef *) Hashtbl.add locnums 0 (); (* .notdef *)
iter iter
(fun u -> (fun u ->
let locnum = Hashtbl.find cmap u + 1 in let locnum = Hashtbl.find cmap u in
Printf.printf "Unicode %i is at location number %i\n" u locnum; if !dbg then Printf.printf "write_loca_table: Unicode %i is at location number %i\n" u locnum;
Hashtbl.add locnums locnum ()) Hashtbl.add locnums locnum ())
subset; subset;
let pos = ref 0l in let write_entry loc position =
let len = ref 0l in match indexToLocFormat with
| 0 -> putval bs 16 (i32div position 2l)
| 1 -> putval bs 32 position
| _ -> raise (Pdf.PDFError "Unknown indexToLocFormat in write_loca_table")
in
let pos = ref 0l in
let pairs =
map
(fun loc ->
let len = i32sub loca.(loc + 1) loca.(loc) in
let r = (loc, !pos) in
pos := i32add !pos len;
r)
(sort compare (map fst (list_of_hashtbl locnums)))
in
let pairs = Array.of_list (pairs @ [(Array.length loca - 1, !pos)]) in
Array.iteri Array.iteri
(fun i _ -> (fun i (loc, off) ->
let position = if i <> Array.length pairs - 1 then
match Hashtbl.find locnums i with begin
| () -> pos := i32add !pos !len; len := 0l; let r = !pos in len := i32sub loca.(i + 1) loca.(i); r write_entry loc off;
| exception Not_found -> !pos let loc', off' = pairs.(i + 1) in
in for x = 0 to loc' - loc - 2 do write_entry (loc + x) off' done
Printf.printf "For location %i, writing offset %li in glyph table\n" i position; end
match indexToLocFormat with else
| 0 -> putval bs 16 (i32div position 2l) write_entry loc off)
| 1 -> putval bs 32 position pairs
| _ -> raise (Pdf.PDFError "Unknown indexToLocFormat in write_loca_table"))
loca
(* Write the notdef glyf, and any others in the subset *) (* Write the notdef glyf, and any others in the subset *)
let write_glyf_table subset cmap bs mk_b glyfoffset loca = let write_glyf_table subset cmap bs mk_b glyfoffset loca =
if !dbg then Printf.printf "***write_glyf_table\n";
let locnums = null_hash () in let locnums = null_hash () in
Hashtbl.add locnums 0 (); (* .notdef *) Hashtbl.add locnums 0 (); (* .notdef *)
iter iter
(fun u -> (fun u ->
let locnum = Hashtbl.find cmap u in let locnum = Hashtbl.find cmap u in
Printf.printf "Unicode %i is at location number %i\n" u locnum; if !dbg then Printf.printf "write_glyf_table: Unicode %i is at location number %i\n" u locnum;
Hashtbl.add locnums locnum ()) Hashtbl.add locnums locnum ())
subset; subset;
let locnums = sort compare (map fst (list_of_hashtbl locnums)) in let locnums = sort compare (map fst (list_of_hashtbl locnums)) in
Printf.printf "We want glyfs for locations: "; iter (Printf.printf "%i ") locnums; Printf.printf "\n"; if !dbg then (Printf.printf "We want glyfs for locations: "; iter (Printf.printf "%i ") locnums; Printf.printf "\n");
let byteranges = map (fun x -> (loca.(x), loca.(x + 1))) locnums in let byteranges = map (fun x -> (loca.(x), loca.(x + 1))) locnums in
Printf.printf "Byte ranges: "; iter (fun (a, b) -> Printf.printf "(%li, %li) " a b) byteranges; Printf.printf "\n"; if !dbg then (Printf.printf "Byte ranges: "; iter (fun (a, b) -> Printf.printf "(%li, %li) " a b) byteranges; Printf.printf "\n");
let write_bytes bs a l = let write_bytes bs a l =
Printf.printf "glyf: write_bytes %li %li\n" a l; if !dbg then Printf.printf "glyf: write_bytes %li %li\n" a l;
let b = mk_b (i32toi (i32add glyfoffset a)) in let b = mk_b (i32toi (i32add glyfoffset a)) in
for x = 1 to i32toi l do putval bs 8 (getval_32 b 8) done for x = 1 to i32toi l do putval bs 8 (getval_32 b 8) done
in in
iter iter (fun (a, b) -> write_bytes bs a (i32sub b a)) byteranges
(fun (a, b) -> write_bytes bs a (i32sub b a))
byteranges
let read_os2_table unitsPerEm b blength = let read_os2_table unitsPerEm b blength =
let version = read_ushort b in let version = read_ushort b in
@ -307,16 +319,17 @@ let remove_unneeded_tables major minor tables indexToLocFormat subset encoding c
tables; tables;
(* Reduce offsets by the reduction in header table size *) (* Reduce offsets by the reduction in header table size *)
let header_size_reduction = i32ofi (16 * (Array.length tables - length !tablesout)) in let header_size_reduction = i32ofi (16 * (Array.length tables - length !tablesout)) in
let new_glyf_length =
let bs = make_write_bitstream () in
write_glyf_table subset cmap bs mk_b glyfoffset loca;
i32ofi (bytes_size (bytes_of_write_bitstream bs))
in
let newtables = let newtables =
Array.of_list Array.of_list
(map (map
(fun (tag, checksum, offset, ttlength) -> (fun (tag, checksum, offset, ttlength) ->
let ttlength = if string_of_tag tag = "glyf" then new_glyf_length else ttlength in let ttlength =
if string_of_tag tag = "glyf" && subset <> [] then
let bs = make_write_bitstream () in
write_glyf_table subset cmap bs mk_b glyfoffset loca;
i32ofi (bytes_size (bytes_of_write_bitstream bs))
else ttlength
in
(tag, checksum, i32sub offset header_size_reduction, ttlength)) (tag, checksum, i32sub offset header_size_reduction, ttlength))
(rev !tablesout)) (rev !tablesout))
in in