Preparing to add fontpacks to -table-of-contents

This commit is contained in:
John Whitington 2023-07-10 15:07:52 +01:00
parent 62877d1ac9
commit 62e4f6f7d1
1 changed files with 34 additions and 32 deletions

View File

@ -14,11 +14,12 @@ let rec real_newline = function
| x::r -> x::real_newline r | x::r -> x::real_newline r
| [] -> [] | [] -> []
(* Cpdftype codepoints from a font and UTF8 *) (* Run of Font / Text elements from a fontpack and UTF8 text *)
let of_utf8 f t = let of_utf8 fontpack t =
Pdftext.codepoints_of_utf8 t []
(* Pdftext.codepoints_of_utf8 t
|> option_map (Pdftext.charcode_extractor_of_font_real f) |> option_map (Pdftext.charcode_extractor_of_font_real f)
|> map char_of_int |> map char_of_int*)
(* Cpdftype codepoints from a font and PDFDocEndoding string *) (* Cpdftype codepoints from a font and PDFDocEndoding string *)
let of_pdfdocencoding f t = let of_pdfdocencoding f t =
@ -38,6 +39,7 @@ let shorten_text widths l t =
(* Calculate the used codepoints *) (* Calculate the used codepoints *)
let used pdf fastrefnums labels title marks = let used pdf fastrefnums labels title marks =
let codepoints = null_hash () in let codepoints = null_hash () in
Hashtbl.add codepoints (int_of_char '.') ();
let addtext t = let addtext t =
iter iter
(fun c -> Hashtbl.replace codepoints c ()) (fun c -> Hashtbl.replace codepoints c ())
@ -66,15 +68,13 @@ let typeset_table_of_contents ~font ~fontsize ~title ~bookmark pdf =
let refnums = Pdf.page_reference_numbers pdf in let refnums = Pdf.page_reference_numbers pdf in
let fastrefnums = hashtable_of_dictionary (combine refnums (indx refnums)) in let fastrefnums = hashtable_of_dictionary (combine refnums (indx refnums)) in
let codepoints = map fst (list_of_hashtbl (used pdf fastrefnums labels title marks)) in let codepoints = map fst (list_of_hashtbl (used pdf fastrefnums labels title marks)) in
let font = let fontpack =
match font with match font with
| Cpdfembed.PreMadeFontPack t -> hd (fst t) | Cpdfembed.PreMadeFontPack t -> t
| Cpdfembed.EmbedInfo {fontfile; fontname; encoding} -> | Cpdfembed.EmbedInfo {fontfile; fontname; encoding} ->
hd (fst (Cpdfembed.embed_truetype pdf ~fontfile ~fontname ~codepoints ~encoding)) Cpdfembed.embed_truetype pdf ~fontfile ~fontname ~codepoints ~encoding
| Cpdfembed.ExistingNamedFont -> raise (Pdf.PDFError "Cannot use existing font with -table-of-contents") | Cpdfembed.ExistingNamedFont -> raise (Pdf.PDFError "Cannot use existing font with -table-of-contents")
in in
let f, fs = (font, fontsize) in
let _, bfs as big = (font, fontsize *. 2.) in
let firstpage = hd (Pdfpage.pages_of_pagetree pdf) in let firstpage = hd (Pdfpage.pages_of_pagetree pdf) in
let width, firstpage_papersize, pmaxx, pmaxy, margin = let width, firstpage_papersize, pmaxx, pmaxy, margin =
let width, height, xmax, ymax = let width, height, xmax, ymax =
@ -88,34 +88,34 @@ let typeset_table_of_contents ~font ~fontsize ~title ~bookmark pdf =
| Some r -> Some (Pdf.parse_rectangle pdf r) | Some r -> Some (Pdf.parse_rectangle pdf r)
| None -> None | None -> None
in in
let width = (*let width =
match firstpage_cropbox with match firstpage_cropbox with
| Some (xmin, _, xmax, _) -> xmax -. xmin | Some (xmin, _, xmax, _) -> xmax -. xmin
| None -> width | None -> width
in in*)
let lines = let lines =
map map
(fun mark -> (fun mark ->
let indent = float mark.Pdfmarks.level *. fontsize *. 2. in let indent = float mark.Pdfmarks.level *. fontsize *. 2. in
let text = of_pdfdocencoding f mark.Pdfmarks.text in let textruns = of_pdfdocencoding fontpack mark.Pdfmarks.text in
let label = let labelruns =
if mark.Pdfmarks.target = NullDestination then of_pdfdocencoding f "" else if mark.Pdfmarks.target = NullDestination then of_pdfdocencoding fontpack "" else
let pde = let pde =
let pnum = Pdfpage.pagenumber_of_target ~fastrefnums pdf mark.Pdfmarks.target in let pnum = Pdfpage.pagenumber_of_target ~fastrefnums pdf mark.Pdfmarks.target in
try Pdfpagelabels.pagelabeltext_of_pagenumber pnum labels with Not_found -> string_of_int pnum try Pdfpagelabels.pagelabeltext_of_pagenumber pnum labels with Not_found -> string_of_int pnum
in in
of_pdfdocencoding f pde of_pdfdocencoding fontpack pde
in in
let widths = Cpdftype.font_widths f fontsize in (*let widths = Cpdftype.font_widths f fontsize in
let textgap = width -. margin *. 2. -. indent -. Cpdftype.width_of_string widths label in let textgap = width -. margin *. 2. -. indent -. Cpdftype.width_of_string widths label in*)
let text = shorten_text widths (textgap -. fontsize *. 3.) text in (*let text = shorten_text widths (textgap -. fontsize *. 3.) text in*) (*FIXME add back in, but in unicode not codepoints! *)
let space = textgap -. Cpdftype.width_of_string widths text in let space = 0. (*textgap -. Cpdftype.width_of_string widths text*) in
[Cpdftype.BeginDest mark.Pdfmarks.target; [Cpdftype.BeginDest mark.Pdfmarks.target;
Cpdftype.HGlue indent; Cpdftype.HGlue indent]
Cpdftype.Text text; @ textruns @
Cpdftype.HGlue space; [Cpdftype.HGlue space]
Cpdftype.Text label; @ labelruns @
Cpdftype.EndDest; [Cpdftype.EndDest;
Cpdftype.NewLine]) Cpdftype.NewLine])
(Pdfmarks.read_bookmarks pdf) (Pdfmarks.read_bookmarks pdf)
in in
@ -126,7 +126,7 @@ let typeset_table_of_contents ~font ~fontsize ~title ~bookmark pdf =
flatten flatten
(map (map
(fun l -> [Cpdftype.Text l; Cpdftype.NewLine]) (fun l -> [Cpdftype.Text l; Cpdftype.NewLine])
(split_toc_title (of_utf8 f title))) (split_toc_title (of_utf8 fontpack title)))
@ [glue] @ [glue]
in in
let lm, rm, tm, bm = let lm, rm, tm, bm =
@ -135,9 +135,11 @@ let typeset_table_of_contents ~font ~fontsize ~title ~bookmark pdf =
| Some (cminx, cminy, cmaxx, cmaxy) -> | Some (cminx, cminy, cmaxx, cmaxy) ->
(cminx +. margin, (pmaxx -. cmaxx) +. margin, cminy +. margin, (pmaxy -. cmaxy) +. margin) (cminx +. margin, (pmaxx -. cmaxx) +. margin, cminy +. margin, (pmaxy -. cmaxy) +. margin)
in in
Cpdftype.typeset lm rm tm bm firstpage_papersize pdf let firstfont =
([Cpdftype.Font (font, bfs); Cpdftype.BeginDocument] @ title @ hd (keep (function Cpdftype.Font _ -> true | _ -> false) (title @ flatten lines)) (*FIXME when title ok *)
[Cpdftype.Font (font, fs)] @ flatten lines) in
Cpdftype.typeset lm rm tm bm firstpage_papersize pdf
([firstfont; Cpdftype.BeginDocument] @ title @ flatten lines)
in in
let toc_pages = let toc_pages =
match firstpage_cropbox with match firstpage_cropbox with