Font paths for -print-font-table

This commit is contained in:
John Whitington
2024-11-21 15:50:11 +00:00
parent 3bb5019c46
commit 7428bde280

View File

@ -144,25 +144,36 @@ let missing_fonts_return pdf range =
missing_fonts ~l pdf range;
!l
let font_from_name pdf fontname pagenumber =
try
let resources = ref (select pagenumber (Pdfpage.pages_of_pagetree pdf)).Pdfpage.resources in
let chain = ref (tl (String.split_on_char '/' fontname)) in
let font = ref Pdf.Null in
while !chain <> [] do
match !chain with
| [f] ->
font := unopt (Pdf.lookup_chain pdf !resources ["/Font"; ("/" ^ f)]);
chain := []
| x::xs ->
resources := unopt (Pdf.lookup_chain pdf !resources ["/XObject"; "/" ^ x; "/Resources"]);
chain := xs
| [] -> ()
done;
!font
with
_ -> Pdfe.log (Printf.sprintf "Not found: font %s on page %i\n" fontname pagenumber); Pdf.Null
let print_font_table pdf fontname pagenumber =
let page = try List.nth (Pdfpage.pages_of_pagetree pdf) (pagenumber - 1) with e -> error "page not found" in
match Pdf.lookup_direct pdf "/Font" page.Pdfpage.resources with
| Some fontdict ->
let font =
begin match Pdf.lookup_direct pdf fontname fontdict with
| Some font -> font
| None ->
let fontdict = font_from_name pdf fontname pagenumber in
(* For each item in the fontdict, follow its value and find the basename. If it matches, return that font *)
let font = ref None in
let font = ref (Some fontdict) in
iter
(fun (k, v) ->
match Pdf.lookup_direct pdf "/BaseFont" v with
| Some (Pdf.Name n) when n = fontname -> font := Some v
| _ -> ())
(match fontdict with Pdf.Dictionary d -> d | _ -> []);
match !font with Some f -> f | None -> failwith (Printf.sprintf "print_font_encoding: font %s not found" fontname)
end
in
let font = match !font with Some f -> f | None -> failwith (Printf.sprintf "print_font_encoding: font %s not found" fontname) in
let pdftextfont = Pdftext.read_font pdf font in
let charset =
match pdftextfont with
@ -206,26 +217,6 @@ let print_font_table pdf fontname pagenumber =
Printf.printf
"%i = U+%s (%s - %s) = %s\n" x unicodenumber utf8 unicodename glyphnames
done
| _ -> failwith "addtext: font not found for width"
let font_from_name pdf fontname pagenumber =
try
let resources = ref (select pagenumber (Pdfpage.pages_of_pagetree pdf)).Pdfpage.resources in
let chain = ref (tl (String.split_on_char '/' fontname)) in
let font = ref Pdf.Null in
while !chain <> [] do
match !chain with
| [f] ->
font := unopt (Pdf.lookup_chain pdf !resources ["/Font"; ("/" ^ f)]);
chain := []
| x::xs ->
resources := unopt (Pdf.lookup_chain pdf !resources ["/XObject"; "/" ^ x; "/Resources"]);
chain := xs
| [] -> ()
done;
!font
with
_ -> Pdfe.log (Printf.sprintf "Not found: font %s on page %i\n" fontname pagenumber); Pdf.Null
let extract_fontfile pagenumber fontname filename pdf =
match Pdftext.read_font pdf (font_from_name pdf fontname pagenumber) with