First successful embedded fonts with -draw

This commit is contained in:
John Whitington 2023-07-17 12:20:08 +01:00
parent dcf387d0a0
commit cb3f29b59f
1 changed files with 41 additions and 30 deletions

View File

@ -149,8 +149,11 @@ let process_specials pdf endpage filename bates batespad num page s =
let runs_of_utf8 s = let runs_of_utf8 s =
let fontpack = (res ()).current_fontpack in let fontpack = (res ()).current_fontpack in
let codepoints = Pdftext.codepoints_of_utf8 s in let codepoints = Pdftext.codepoints_of_utf8 s in
(*Printf.printf "%i codepoints\n" (length codepoints);*)
let triples = option_map (Cpdfembed.get_char fontpack) codepoints in let triples = option_map (Cpdfembed.get_char fontpack) codepoints in
(*Printf.printf "%i triples\n" (length triples);*)
let collated = Cpdfembed.collate_runs triples in let collated = Cpdfembed.collate_runs triples in
(*Printf.printf "Collated of length %i\n" (length collated);*)
flatten flatten
(map (map
(fun l -> (fun l ->
@ -250,37 +253,43 @@ let rec ops_of_drawop dryrun pdf endpage filename bates batespad num page = func
| Opacity v -> [Pdfops.Op_gs (extgstate "/ca" v)] | Opacity v -> [Pdfops.Op_gs (extgstate "/ca" v)]
| SOpacity v -> [Pdfops.Op_gs (extgstate "/CA" v)] | SOpacity v -> [Pdfops.Op_gs (extgstate "/CA" v)]
| FontPack (identifier, cpdffont, codepoints) -> | FontPack (identifier, cpdffont, codepoints) ->
Printf.printf "Cpdfdraw: storing fontpack %s\n" identifier; begin match Hashtbl.find fontpacks identifier with
if dryrun then (res ()).current_fontpack_codepoints <- codepoints; | fontpack -> ()
let fontpack = (*Printf.printf "Cpdfdraw: using existing fontpack %s\n" identifier*)
match cpdffont with | exception Not_found ->
| PreMadeFontPack fp -> fp (*Printf.printf "Cpdfdraw: storing new fontpack %s\n" identifier;*)
| EmbedInfo {fontfile; fontname; encoding} -> let fontpack =
let codepoints = map fst (list_of_hashtbl codepoints) in match cpdffont with
if codepoints = [] then default_fontpack else | PreMadeFontPack fp -> fp
Cpdfembed.embed_truetype pdf ~fontfile ~fontname ~codepoints ~encoding | EmbedInfo {fontfile; fontname; encoding} ->
| ExistingNamedFont -> let codepoints = map fst (list_of_hashtbl codepoints) in
error "-draw does not support using an existing named font" if codepoints = [] then default_fontpack else
in Cpdfembed.embed_truetype pdf ~fontfile ~fontname ~codepoints ~encoding
Hashtbl.add fontpacks identifier fontpack; | ExistingNamedFont ->
let ns = error "-draw does not support using an existing named font"
map in
(fun font -> Hashtbl.add fontpacks identifier (fontpack, codepoints);
try fst (Hashtbl.find (res ()).fonts font) with let ns =
Not_found -> map
let o = if dryrun then 0 else Pdftext.write_font pdf font in (fun font ->
let n = fresh_name "/F" in try fst (Hashtbl.find (res ()).fonts font) with
Hashtbl.add (res ()).fonts font (n, o); Not_found ->
n) let o = if dryrun then 0 else Pdftext.write_font pdf font in
(fst fontpack) let n = fresh_name "/F" in
in Hashtbl.add (res ()).fonts font (n, o);
(res ()).page_names <- ns @ (res ()).page_names; n)
[] (fst fontpack)
| Font (identifier, size) -> in
Printf.printf "Changing to stored font %s\n" identifier; (res ()).page_names <- ns @ (res ()).page_names
(res ()).current_fontpack <- Hashtbl.find fontpacks identifier; end;
(res ()).font_size <- size;
[] []
| Font (identifier, size) ->
(*Printf.printf "Changing to stored font %s\n" identifier;*)
let fontpack, codepoints = Hashtbl.find fontpacks identifier in
(res ()).current_fontpack <- fontpack;
if dryrun then (res ()).current_fontpack_codepoints <- codepoints;
(res ()).font_size <- size;
[]
| TextSection ops -> [Pdfops.Op_BT] @ ops_of_drawops dryrun pdf endpage filename bates batespad num page ops @ [Pdfops.Op_ET] | TextSection ops -> [Pdfops.Op_BT] @ ops_of_drawops dryrun pdf endpage filename bates batespad num page ops @ [Pdfops.Op_ET]
| Text s -> | Text s ->
if dryrun then iter (fun c -> Hashtbl.replace (res ()).current_fontpack_codepoints c ()) (Pdftext.codepoints_of_utf8 s); if dryrun then iter (fun c -> Hashtbl.replace (res ()).current_fontpack_codepoints c ()) (Pdftext.codepoints_of_utf8 s);
@ -371,6 +380,7 @@ let draw_single ~fast ~underneath ~filename ~bates ~batespad fast range pdf draw
let r = save_whole_stack () in let r = save_whole_stack () in
ignore (ops_of_drawops true pdf endpage filename bates batespad 0 (hd pages) drawops); ignore (ops_of_drawops true pdf endpage filename bates batespad 0 (hd pages) drawops);
restore_whole_stack r; restore_whole_stack r;
Hashtbl.clear fontpacks;
Some (ops_of_drawops false pdf endpage filename bates batespad 0 (hd pages) drawops) Some (ops_of_drawops false pdf endpage filename bates batespad 0 (hd pages) drawops)
end end
in in
@ -385,6 +395,7 @@ let draw_single ~fast ~underneath ~filename ~bates ~batespad fast range pdf draw
let r = save_whole_stack () in let r = save_whole_stack () in
ignore (ops_of_drawops true pdf endpage filename bates batespad n p drawops); ignore (ops_of_drawops true pdf endpage filename bates batespad n p drawops);
restore_whole_stack r; restore_whole_stack r;
Hashtbl.clear fontpacks;
ops_of_drawops false pdf endpage filename bates batespad n p drawops) ops_of_drawops false pdf endpage filename bates batespad n p drawops)
else []) else [])
(ilist 1 endpage) (ilist 1 endpage)