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 =
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

View File

@ -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

View File

@ -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 =

View File

@ -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,21 +36,29 @@ 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 =
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
@ -63,6 +71,9 @@ let font_widths f fontsize =
| 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 ->

View File

@ -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