From c9c8a06510bf3a79834eecdef57d2c7840d7ce31 Mon Sep 17 00:00:00 2001 From: John Whitington Date: Thu, 20 Jul 2023 12:56:20 +0100 Subject: [PATCH] Clean up font ids --- cpdfaddtext.ml | 4 +++- cpdftexttopdf.ml | 3 ++- cpdftoc.ml | 22 ++++++++++------- cpdftype.ml | 62 +++++++++++++++++++++++++++++------------------- cpdftype.mli | 4 ++-- 5 files changed, 58 insertions(+), 37 deletions(-) diff --git a/cpdfaddtext.ml b/cpdfaddtext.ml index cb7e3d1..61a284b 100644 --- a/cpdfaddtext.ml +++ b/cpdfaddtext.ml @@ -272,7 +272,9 @@ let addtext let calc_textwidth text = match fontpack with | Some fontpack -> - let widthss = map (fun font -> Cpdftype.font_widths font fontsize) (fst fontpack) in + let widthss = + map2 (fun n font -> Cpdftype.font_widths (fontname ^ string_of_int n) font fontsize) (indx (fst fontpack)) (fst fontpack) + in let triples = option_map (Cpdfembed.get_char fontpack) (Pdftext.codepoints_of_utf8 text) in let widths = map (fun (charcode, fontnum, _) -> (List.nth widthss fontnum).(charcode)) triples in fsum widths diff --git a/cpdftexttopdf.ml b/cpdftexttopdf.ml index 799e25d..5170809 100644 --- a/cpdftexttopdf.ml +++ b/cpdftexttopdf.ml @@ -16,7 +16,8 @@ let rec of_utf8_with_newlines fontpack fontsize t = if !currtext <> [] then items := Cpdftype.Text (rev !currtext)::!items; currtext := []; currfont := n; - items := Cpdftype.Font (f, fontsize)::!items; + (* FIXME font id *) + items := Cpdftype.Font ("", f, fontsize)::!items; currtext := char_of_int c::!currtext; end else diff --git a/cpdftoc.ml b/cpdftoc.ml index 926236c..ce25ec4 100644 --- a/cpdftoc.ml +++ b/cpdftoc.ml @@ -18,11 +18,12 @@ let width_table_cache = null_hash () let rec width_of_runs runs = match runs with - | Cpdftype.Font (f, fontsize)::Cpdftype.Text t::more -> + | Cpdftype.Font (id, f, fontsize)::Cpdftype.Text t::more -> let width_table = - match Hashtbl.find width_table_cache (f, fontsize) with + match Hashtbl.find width_table_cache (id, fontsize) with | w -> w - | exception Not_found -> let ws = Cpdftype.font_widths f fontsize in Hashtbl.add width_table_cache (f, fontsize) ws; ws + | exception Not_found -> + let ws = Cpdftype.font_widths id f fontsize in Hashtbl.add width_table_cache (id, fontsize) ws; ws in Cpdftype.width_of_string width_table t +. width_of_runs more | [] -> 0. @@ -39,7 +40,8 @@ let of_utf8 fontpack fontsize t = | [] -> [] | (_, _, font) as h::t -> let charcodes = map (fun (c, _, _) -> char_of_int c) (h::t) in - [Cpdftype.Font (font, fontsize); Cpdftype.Text charcodes]) + (*FIXME id *) + [Cpdftype.Font ("", font, fontsize); Cpdftype.Text charcodes]) collated) (* Cpdftype codepoints from a font and PDFDocEndoding string *) @@ -50,14 +52,15 @@ let of_pdfdocencoding fontpack fontsize t = add dots for an ellipsis *) let rec shorten_text_inner l t = match rev t with - | Cpdftype.Text text::Cpdftype.Font (f, fs)::more -> + | Cpdftype.Text text::Cpdftype.Font (id, f, fs)::more -> let width_table = - match Hashtbl.find width_table_cache (f, fs) with + match Hashtbl.find width_table_cache (id, fs) with | w -> w - | exception Not_found -> let ws = Cpdftype.font_widths f fs in Hashtbl.add width_table_cache (f, fs) ws; ws + | exception Not_found -> + let ws = Cpdftype.font_widths id f fs in Hashtbl.add width_table_cache (id, fs) ws; ws in if Cpdftype.width_of_string width_table text > l then - shorten_text_inner l (rev (Cpdftype.Text (all_but_last text)::Cpdftype.Font (f, fs)::more)) + shorten_text_inner l (rev (Cpdftype.Text (all_but_last text)::Cpdftype.Font (id, f, fs)::more)) else t | _ -> t @@ -69,7 +72,8 @@ let shorten_text fontpack fontsize l t = unopt (Cpdfembed.get_char fontpack (int_of_char '.')) in let charcode = char_of_int charcode in - short @ [Cpdftype.Font (dotfont, fontsize); Cpdftype.Text [charcode; charcode; charcode]] + (* FIXME ID *) + short @ [Cpdftype.Font ("", dotfont, fontsize); Cpdftype.Text [charcode; charcode; charcode]] (* Calculate the used codepoints *) let used pdf fastrefnums labels title marks = diff --git a/cpdftype.ml b/cpdftype.ml index af1ad0e..c1a4b47 100644 --- a/cpdftype.ml +++ b/cpdftype.ml @@ -14,7 +14,7 @@ type element = | VGlue of float | NewLine | NewPage -| Font of (Pdftext.font * float) +| Font of string * Pdftext.font * float | BeginDest of Pdfdest.t | EndDest | BeginDocument @@ -36,33 +36,44 @@ type t = element list type state = {mutable font : Pdftext.font option; + mutable fontid : string option; mutable fontsize : float; mutable width_table : float array; (* Widths for charcodes 0..255 *) mutable xpos : float; mutable ypos : float; mutable dest : Pdfdest.t option} +let width_table_cache = null_hash () + let initial_state () = {font = None; + fontid = None; fontsize = 0.; width_table = [||]; xpos = 0.; ypos = 0.; dest = None} -let font_widths f fontsize = - match f with - | Pdftext.StandardFont (sf, encoding) -> - Array.init - 256 - (fun x -> - fontsize - *. float_of_int - (Pdfstandard14.textwidth false encoding sf (string_of_char (char_of_int x))) - /. 1000.) - | Pdftext.SimpleFont {fontmetrics = Some m} -> - Array.map (fun x -> fontsize *. x /. 1000. ) m - | _ -> raise (Pdf.PDFError "Cpdftype: Unsupported font") +let font_widths id f fontsize = + match Hashtbl.find width_table_cache (id, fontsize) with + | x -> x + | exception Not_found -> + let newtable = + match f with + | Pdftext.StandardFont (sf, encoding) -> + Array.init + 256 + (fun x -> + fontsize + *. float_of_int + (Pdfstandard14.textwidth false encoding sf (string_of_char (char_of_int x))) + /. 1000.) + | Pdftext.SimpleFont {fontmetrics = Some m} -> + Array.map (fun x -> fontsize *. x /. 1000. ) m + | _ -> raise (Pdf.PDFError "Cpdftype: Unsupported font") + in + Hashtbl.add width_table_cache (id, fontsize) newtable; + newtable let width_of_string ws s = let w = ref 0. in @@ -108,9 +119,9 @@ let layout lmargin rmargin papersize i = let xpos_max = width -. lmargin in s.xpos <- lmargin; let rec layout_element = function - | Font (f, fontsize) -> - s.width_table <- font_widths f fontsize; - o := Font (f, fontsize) :: !o + | Font (id, f, fontsize) -> + s.width_table <- font_widths id f fontsize; + o := Font (id, f, fontsize) :: !o | Text text -> if text = [] then () else begin @@ -151,10 +162,11 @@ let paginate tmargin bmargin papersize i = s.ypos <- s.ypos +. s.fontsize *. 1.3; o := NewLine::!o; if s.ypos > max_ypos then process NewPage - | Font (f, fs) -> + | Font (id, f, fs) -> s.font <- Some f; + s.fontid <- Some id; s.fontsize <- fs; - o := Font (f, fs)::!o + o := Font (id, f, fs)::!o | NewPage -> s.ypos <- tmargin +. s.fontsize; o := NewPage::!o @@ -178,6 +190,7 @@ let make_annotations pdf annots = NewPage elements. Split on NewPages, typeset each page, add font dictionaries. New page only creates a page when that page has content. *) let typeset lmargin rmargin tmargin bmargin papersize pdf i = + Hashtbl.clear width_table_cache; let debug = false in if debug then (print_endline "***input:\n\n"; print_endline (to_string i)); let i = layout lmargin rmargin papersize i in @@ -222,18 +235,19 @@ let typeset lmargin rmargin tmargin bmargin papersize pdf i = thisdestrectangles := (minx, miny, minx +. width_of_string s.width_table cps, miny +. s.fontsize)::!thisdestrectangles end; s.xpos <- s.xpos +. width_of_string s.width_table cps - | Font (f, fontsize) -> + | Font (id, f, fontsize) -> let name, objnum = - match List.assoc_opt f !fonts with + match List.assoc_opt id !fonts with | Some objnum -> ("/F" ^ string_of_int objnum, objnum) | None -> let num = Pdftext.write_font pdf f in let n = "/F" ^ string_of_int num in - fonts := (f, num) :: !fonts; + fonts := (id, num) :: !fonts; (n, num) in - s.width_table <- font_widths f fontsize; + s.width_table <- font_widths id f fontsize; s.font <- Some f; + s.fontid <- Some id; s.fontsize <- fontsize; thispagefontnums := objnum :: !thispagefontnums; ops := Pdfops.Op_Tf (name, fontsize)::!ops @@ -249,7 +263,7 @@ let typeset lmargin rmargin tmargin bmargin papersize pdf i = thispagefontnums := []; thispageannotations := []; ops := []; - if s.font <> None then typeset_element (Font (unopt s.font, s.fontsize)); + if s.font <> None && s.fontid <> None then typeset_element (Font (unopt s.fontid, unopt s.font, s.fontsize)); s.xpos <- lmargin; s.ypos <- tmargin +. s.fontsize | BeginDocument -> diff --git a/cpdftype.mli b/cpdftype.mli index 29b29cc..89a9173 100644 --- a/cpdftype.mli +++ b/cpdftype.mli @@ -5,7 +5,7 @@ type element = | VGlue of float | NewLine | NewPage -| Font of (Pdftext.font * float) +| Font of string * Pdftext.font * float | BeginDest of Pdfdest.t | EndDest | BeginDocument @@ -14,7 +14,7 @@ type t = element list val to_string : t -> string -val font_widths : Pdftext.font -> float -> float array +val font_widths : string -> Pdftext.font -> float -> float array val width_of_string : float array -> char list -> float