Beginning to adapt -draw to allow -font-ttf

This commit is contained in:
John Whitington 2023-07-13 14:04:10 +01:00
parent fcccb4820f
commit acddfb1ac7
1 changed files with 35 additions and 25 deletions

View File

@ -80,7 +80,8 @@ type res =
form_xobjects : (string, (string * int)) Hashtbl.t; (* (name, (pdf name, objnum)) *) form_xobjects : (string, (string * int)) Hashtbl.t; (* (name, (pdf name, objnum)) *)
mutable page_names : string list; mutable page_names : string list;
mutable time : Cpdfstrftime.t; mutable time : Cpdfstrftime.t;
mutable current_fontpack : Cpdfembed.cpdffont; mutable current_fontpack : Cpdfembed.t;
mutable font_size : float;
mutable num : int} mutable num : int}
let empty_res () = let empty_res () =
@ -91,9 +92,9 @@ let empty_res () =
page_names = []; page_names = [];
time = Cpdfstrftime.dummy; time = Cpdfstrftime.dummy;
current_fontpack = current_fontpack =
Cpdfembed.PreMadeFontPack
(Cpdfembed.fontpack_of_standardfont (Cpdfembed.fontpack_of_standardfont
(Pdftext.StandardFont (Pdftext.TimesRoman, Pdftext.WinAnsiEncoding))); (Pdftext.StandardFont (Pdftext.TimesRoman, Pdftext.WinAnsiEncoding)));
font_size = 12.;
num = 0} num = 0}
let resstack = let resstack =
@ -135,12 +136,16 @@ let process_specials pdf endpage filename bates batespad num page s =
in in
Cpdfaddtext.process_text (res ()).time s pairs Cpdfaddtext.process_text (res ()).time s pairs
let charcodes_of_utf8 s = (* FIXME: implement for other kinds of font *)
let runs_of_utf8 s =
match (res ()).current_fontpack with match (res ()).current_fontpack with
| PreMadeFontPack fontpack -> | ((f::_, _) as fontpack) ->
let codepoints = Pdftext.codepoints_of_utf8 s in let codepoints = Pdftext.codepoints_of_utf8 s in
let charcodes = option_map (Cpdfembed.get_char fontpack) codepoints in let charcodes = option_map (Cpdfembed.get_char fontpack) codepoints in
implode (map (fun (c, _, _) -> char_of_int c) charcodes) let fontname =
fst (Hashtbl.find (res ()).fonts f)
in
[Pdfops.Op_Tf (fontname, (res ()).font_size); Pdfops.Op_Tj (implode (map (fun (c, _, _) -> char_of_int c) charcodes))]
| _ -> failwith "charcodes_of_utf8: unknown font" | _ -> failwith "charcodes_of_utf8: unknown font"
let extgstate kind v = let extgstate kind v =
@ -229,28 +234,33 @@ let rec ops_of_drawop pdf endpage filename bates batespad num page = function
| NewPage -> Pdfe.log ("NewPage remaining in graphic stream"); assert false | NewPage -> Pdfe.log ("NewPage remaining in graphic stream"); assert false
| 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)]
| Font (fontpack, size) -> | Font (cpdffont, size) ->
let font = let fontpack =
match fontpack with match cpdffont with
| PreMadeFontPack (f::_, _) -> f | PreMadeFontPack fp -> fp
| _ -> failwith "-font-ttf not impl" | EmbedInfo {fontfile; fontname; encoding} ->
Cpdfembed.embed_truetype pdf ~fontfile ~fontname ~codepoints:[int_of_char 'a'] ~encoding
| ExistingNamedFont ->
error "-draw does not support using an exsiting named font"
in in
let (n, _) = let ns =
try Hashtbl.find (res ()).fonts font with map
(fun font ->
try fst (Hashtbl.find (res ()).fonts font) with
Not_found -> Not_found ->
let o = Pdftext.write_font pdf font in let o = Pdftext.write_font pdf font in
let n = fresh_name "/F" in let n = fresh_name "/F" in
Hashtbl.add (res ()).fonts font (n, o); Hashtbl.add (res ()).fonts font (n, o);
(n, o) n)
(fst fontpack)
in in
(res ()).current_fontpack <- fontpack; (res ()).current_fontpack <- fontpack;
(res ()).page_names <- n::(res ()).page_names; (res ()).page_names <- ns @ (res ()).page_names;
[Pdfops.Op_Tf (n, size)] (res ()).font_size <- size;
[]
| TextSection ops -> [Pdfops.Op_BT] @ ops_of_drawops pdf endpage filename bates batespad num page ops @ [Pdfops.Op_ET] | TextSection ops -> [Pdfops.Op_BT] @ ops_of_drawops pdf endpage filename bates batespad num page ops @ [Pdfops.Op_ET]
| Text s -> [Pdfops.Op_Tj (charcodes_of_utf8 s)] | Text s -> runs_of_utf8 s
| SpecialText s -> | SpecialText s -> runs_of_utf8 (process_specials pdf endpage filename bates batespad num page s)
let s = process_specials pdf endpage filename bates batespad num page s in
[Pdfops.Op_Tj (charcodes_of_utf8 s)]
| Leading f -> [Pdfops.Op_TL f] | Leading f -> [Pdfops.Op_TL f]
| CharSpace f -> [Pdfops.Op_Tc f] | CharSpace f -> [Pdfops.Op_Tc f]
| WordSpace f -> [Pdfops.Op_Tw f] | WordSpace f -> [Pdfops.Op_Tw f]