Clean up font ids

This commit is contained in:
John Whitington 2023-07-20 12:56:20 +01:00
parent 657280c720
commit c9c8a06510
5 changed files with 58 additions and 37 deletions

View File

@ -272,7 +272,9 @@ let addtext
let calc_textwidth text = let calc_textwidth text =
match fontpack with match fontpack with
| Some fontpack -> | 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 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 let widths = map (fun (charcode, fontnum, _) -> (List.nth widthss fontnum).(charcode)) triples in
fsum widths fsum widths

View File

@ -16,7 +16,8 @@ let rec of_utf8_with_newlines fontpack fontsize t =
if !currtext <> [] then items := Cpdftype.Text (rev !currtext)::!items; if !currtext <> [] then items := Cpdftype.Text (rev !currtext)::!items;
currtext := []; currtext := [];
currfont := n; currfont := n;
items := Cpdftype.Font (f, fontsize)::!items; (* FIXME font id *)
items := Cpdftype.Font ("", f, fontsize)::!items;
currtext := char_of_int c::!currtext; currtext := char_of_int c::!currtext;
end end
else else

View File

@ -18,11 +18,12 @@ let width_table_cache = null_hash ()
let rec width_of_runs runs = let rec width_of_runs runs =
match runs with match runs with
| Cpdftype.Font (f, fontsize)::Cpdftype.Text t::more -> | Cpdftype.Font (id, f, fontsize)::Cpdftype.Text t::more ->
let width_table = let width_table =
match Hashtbl.find width_table_cache (f, fontsize) with match Hashtbl.find width_table_cache (id, fontsize) with
| w -> w | 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 in
Cpdftype.width_of_string width_table t +. width_of_runs more Cpdftype.width_of_string width_table t +. width_of_runs more
| [] -> 0. | [] -> 0.
@ -39,7 +40,8 @@ let of_utf8 fontpack fontsize t =
| [] -> [] | [] -> []
| (_, _, font) as h::t -> | (_, _, font) as h::t ->
let charcodes = map (fun (c, _, _) -> char_of_int c) (h::t) in 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) collated)
(* Cpdftype codepoints from a font and PDFDocEndoding string *) (* Cpdftype codepoints from a font and PDFDocEndoding string *)
@ -50,14 +52,15 @@ let of_pdfdocencoding fontpack fontsize t =
add dots for an ellipsis *) add dots for an ellipsis *)
let rec shorten_text_inner l t = let rec shorten_text_inner l t =
match rev t with match rev t with
| Cpdftype.Text text::Cpdftype.Font (f, fs)::more -> | Cpdftype.Text text::Cpdftype.Font (id, f, fs)::more ->
let width_table = let width_table =
match Hashtbl.find width_table_cache (f, fs) with match Hashtbl.find width_table_cache (id, fs) with
| w -> w | 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 in
if Cpdftype.width_of_string width_table text > l then 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 else
t t
| _ -> t | _ -> t
@ -69,7 +72,8 @@ let shorten_text fontpack fontsize l t =
unopt (Cpdfembed.get_char fontpack (int_of_char '.')) unopt (Cpdfembed.get_char fontpack (int_of_char '.'))
in in
let charcode = char_of_int charcode 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 *) (* Calculate the used codepoints *)
let used pdf fastrefnums labels title marks = let used pdf fastrefnums labels title marks =

View File

@ -14,7 +14,7 @@ type element =
| VGlue of float | VGlue of float
| NewLine | NewLine
| NewPage | NewPage
| Font of (Pdftext.font * float) | Font of string * Pdftext.font * float
| BeginDest of Pdfdest.t | BeginDest of Pdfdest.t
| EndDest | EndDest
| BeginDocument | BeginDocument
@ -36,33 +36,44 @@ type t = element list
type state = type state =
{mutable font : Pdftext.font option; {mutable font : Pdftext.font option;
mutable fontid : string option;
mutable fontsize : float; mutable fontsize : float;
mutable width_table : float array; (* Widths for charcodes 0..255 *) mutable width_table : float array; (* Widths for charcodes 0..255 *)
mutable xpos : float; mutable xpos : float;
mutable ypos : float; mutable ypos : float;
mutable dest : Pdfdest.t option} mutable dest : Pdfdest.t option}
let width_table_cache = null_hash ()
let initial_state () = let initial_state () =
{font = None; {font = None;
fontid = None;
fontsize = 0.; fontsize = 0.;
width_table = [||]; width_table = [||];
xpos = 0.; xpos = 0.;
ypos = 0.; ypos = 0.;
dest = None} dest = None}
let font_widths f fontsize = let font_widths id f fontsize =
match f with match Hashtbl.find width_table_cache (id, fontsize) with
| Pdftext.StandardFont (sf, encoding) -> | x -> x
Array.init | exception Not_found ->
256 let newtable =
(fun x -> match f with
fontsize | Pdftext.StandardFont (sf, encoding) ->
*. float_of_int Array.init
(Pdfstandard14.textwidth false encoding sf (string_of_char (char_of_int x))) 256
/. 1000.) (fun x ->
| Pdftext.SimpleFont {fontmetrics = Some m} -> fontsize
Array.map (fun x -> fontsize *. x /. 1000. ) m *. float_of_int
| _ -> raise (Pdf.PDFError "Cpdftype: Unsupported font") (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 width_of_string ws s =
let w = ref 0. in let w = ref 0. in
@ -108,9 +119,9 @@ let layout lmargin rmargin papersize i =
let xpos_max = width -. lmargin in let xpos_max = width -. lmargin in
s.xpos <- lmargin; s.xpos <- lmargin;
let rec layout_element = function let rec layout_element = function
| Font (f, fontsize) -> | Font (id, f, fontsize) ->
s.width_table <- font_widths f fontsize; s.width_table <- font_widths id f fontsize;
o := Font (f, fontsize) :: !o o := Font (id, f, fontsize) :: !o
| Text text -> | Text text ->
if text = [] then () else if text = [] then () else
begin begin
@ -151,10 +162,11 @@ let paginate tmargin bmargin papersize i =
s.ypos <- s.ypos +. s.fontsize *. 1.3; s.ypos <- s.ypos +. s.fontsize *. 1.3;
o := NewLine::!o; o := NewLine::!o;
if s.ypos > max_ypos then process NewPage if s.ypos > max_ypos then process NewPage
| Font (f, fs) -> | Font (id, f, fs) ->
s.font <- Some f; s.font <- Some f;
s.fontid <- Some id;
s.fontsize <- fs; s.fontsize <- fs;
o := Font (f, fs)::!o o := Font (id, f, fs)::!o
| NewPage -> | NewPage ->
s.ypos <- tmargin +. s.fontsize; s.ypos <- tmargin +. s.fontsize;
o := NewPage::!o o := NewPage::!o
@ -178,6 +190,7 @@ let make_annotations pdf annots =
NewPage elements. Split on NewPages, typeset each page, add font NewPage elements. Split on NewPages, typeset each page, add font
dictionaries. New page only creates a page when that page has content. *) dictionaries. New page only creates a page when that page has content. *)
let typeset lmargin rmargin tmargin bmargin papersize pdf i = let typeset lmargin rmargin tmargin bmargin papersize pdf i =
Hashtbl.clear width_table_cache;
let debug = false in let debug = false in
if debug then (print_endline "***input:\n\n"; print_endline (to_string i)); if debug then (print_endline "***input:\n\n"; print_endline (to_string i));
let i = layout lmargin rmargin papersize i in 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 thisdestrectangles := (minx, miny, minx +. width_of_string s.width_table cps, miny +. s.fontsize)::!thisdestrectangles
end; end;
s.xpos <- s.xpos +. width_of_string s.width_table cps s.xpos <- s.xpos +. width_of_string s.width_table cps
| Font (f, fontsize) -> | Font (id, f, fontsize) ->
let name, objnum = 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) | Some objnum -> ("/F" ^ string_of_int objnum, objnum)
| None -> | None ->
let num = Pdftext.write_font pdf f in let num = Pdftext.write_font pdf f in
let n = "/F" ^ string_of_int num in let n = "/F" ^ string_of_int num in
fonts := (f, num) :: !fonts; fonts := (id, num) :: !fonts;
(n, num) (n, num)
in in
s.width_table <- font_widths f fontsize; s.width_table <- font_widths id f fontsize;
s.font <- Some f; s.font <- Some f;
s.fontid <- Some id;
s.fontsize <- fontsize; s.fontsize <- fontsize;
thispagefontnums := objnum :: !thispagefontnums; thispagefontnums := objnum :: !thispagefontnums;
ops := Pdfops.Op_Tf (name, fontsize)::!ops ops := Pdfops.Op_Tf (name, fontsize)::!ops
@ -249,7 +263,7 @@ let typeset lmargin rmargin tmargin bmargin papersize pdf i =
thispagefontnums := []; thispagefontnums := [];
thispageannotations := []; thispageannotations := [];
ops := []; 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.xpos <- lmargin;
s.ypos <- tmargin +. s.fontsize s.ypos <- tmargin +. s.fontsize
| BeginDocument -> | BeginDocument ->

View File

@ -5,7 +5,7 @@ type element =
| VGlue of float | VGlue of float
| NewLine | NewLine
| NewPage | NewPage
| Font of (Pdftext.font * float) | Font of string * Pdftext.font * float
| BeginDest of Pdfdest.t | BeginDest of Pdfdest.t
| EndDest | EndDest
| BeginDocument | BeginDocument
@ -14,7 +14,7 @@ type t = element list
val to_string : t -> string 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 val width_of_string : float array -> char list -> float