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,8 +253,11 @@ 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 -> ()
(*Printf.printf "Cpdfdraw: using existing fontpack %s\n" identifier*)
| exception Not_found ->
(*Printf.printf "Cpdfdraw: storing new fontpack %s\n" identifier;*)
let fontpack = let fontpack =
match cpdffont with match cpdffont with
| PreMadeFontPack fp -> fp | PreMadeFontPack fp -> fp
@ -262,7 +268,7 @@ let rec ops_of_drawop dryrun pdf endpage filename bates batespad num page = func
| ExistingNamedFont -> | ExistingNamedFont ->
error "-draw does not support using an existing named font" error "-draw does not support using an existing named font"
in in
Hashtbl.add fontpacks identifier fontpack; Hashtbl.add fontpacks identifier (fontpack, codepoints);
let ns = let ns =
map map
(fun font -> (fun font ->
@ -274,11 +280,14 @@ let rec ops_of_drawop dryrun pdf endpage filename bates batespad num page = func
n) n)
(fst fontpack) (fst fontpack)
in in
(res ()).page_names <- ns @ (res ()).page_names; (res ()).page_names <- ns @ (res ()).page_names
end;
[] []
| Font (identifier, size) -> | Font (identifier, size) ->
Printf.printf "Changing to stored font %s\n" identifier; (*Printf.printf "Changing to stored font %s\n" identifier;*)
(res ()).current_fontpack <- Hashtbl.find fontpacks 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; (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]
@ -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)