Rehabilitating -toc for fontpacks

This commit is contained in:
John Whitington 2023-07-12 12:49:03 +01:00
parent 5852c184a8
commit 8bd457db93
2 changed files with 22 additions and 24 deletions

View File

@ -109,11 +109,11 @@ let typeset_table_of_contents ~font ~fontsize ~title ~bookmark pdf =
| Some r -> Some (Pdf.parse_rectangle pdf r)
| None -> None
in
(*let width =
let width =
match firstpage_cropbox with
| Some (xmin, _, xmax, _) -> xmax -. xmin
| None -> width
in*)
in
let lines =
map
(fun mark ->
@ -141,15 +141,15 @@ let typeset_table_of_contents ~font ~fontsize ~title ~bookmark pdf =
(Pdfmarks.read_bookmarks pdf)
in
let toc_pages =
(*let title =
let title =
let glue = Cpdftype.VGlue (fontsize *. 2.) in
if title = "" then [] else
flatten
(map
(fun l -> [Cpdftype.Text l; Cpdftype.NewLine])
(split_toc_title (of_utf8 fontpack (fontsize *. 2.) title)))
(fun l -> l @ [Cpdftype.NewLine])
(map (of_utf8 fontpack (fontsize *. 2.)) (map implode (split_toc_title (explode title)))))
@ [glue]
in*)
in
let lm, rm, tm, bm =
match firstpage_cropbox with
| None -> (margin, margin, margin, margin)
@ -157,10 +157,10 @@ let typeset_table_of_contents ~font ~fontsize ~title ~bookmark pdf =
(cminx +. margin, (pmaxx -. cmaxx) +. margin, cminy +. margin, (pmaxy -. cmaxy) +. margin)
in
let firstfont =
hd (keep (function Cpdftype.Font _ -> true | _ -> false) ((*title @ *)flatten lines)) (*FIXME when title ok *)
hd (keep (function Cpdftype.Font _ -> true | _ -> false) (title @ flatten lines))
in
Cpdftype.typeset lm rm tm bm firstpage_papersize pdf
([firstfont; Cpdftype.BeginDocument] @ (*title @*) flatten lines)
([firstfont; Cpdftype.BeginDocument] @ title @ flatten lines)
in
let toc_pages =
match firstpage_cropbox with

View File

@ -2,11 +2,10 @@
open Pdfutil
open Pdfio
(* FIXME Base on bytes not bits - all uses of mk_b *)
let dbg = ref false
(*let _ =
let dbg =
(*let _ =
Pdfe.logger := (fun s -> print_string s; flush stdout)*)
ref false
type t =
{flags : int;
@ -129,7 +128,7 @@ let read_format_4_encoding_table b =
done;
t
let print_encoding_table format (table : (int, int) Hashtbl.t) =
let print_encoding_table fmt table =
let unicodedata = Cpdfunicodedata.unicodedata () in
let unicodetable = Hashtbl.create 16000 in
iter
@ -137,7 +136,7 @@ let print_encoding_table format (table : (int, int) Hashtbl.t) =
Hashtbl.add unicodetable x.Cpdfunicodedata.code_value x.Cpdfunicodedata.character_name)
unicodedata;
let l = sort compare (list_of_hashtbl table) in
if !dbg then Printf.printf "Format table %i: There are %i characters in this font\n" format (length l);
if !dbg then Printf.printf "Format table %i: There are %i characters in this font\n" fmt (length l);
iter
(fun (c, gi) ->
let str = Printf.sprintf "%04X" c in
@ -297,7 +296,7 @@ let write_glyf_table subset cmap bs mk_b glyfoffset loca =
if !dbg then
(Printf.printf "Byte ranges: ";
iter (fun (a, b) -> Printf.printf "(%li, %li) " a b) byteranges; Printf.printf "\n");
let len = List.fold_left i32add 0l (map (fun (a, b) -> i32sub b a) byteranges) in
let len = fold_left i32add 0l (map (fun (a, b) -> i32sub b a) byteranges) in
let write_bytes bs a l =
if !dbg then Printf.printf "glyf: write_bytes %li %li\n" a l;
let b = mk_b (i32toi (i32add glyfoffset a)) in
@ -336,7 +335,7 @@ let calculate_widths unitsPerEm encoding firstchar lastchar subset cmapdata hmtx
Not_found -> 0
in
if lastchar < firstchar then Cpdferror.error "lastchar < firstchar" else
(*if !dbg then List.iter (fun (a, b) -> Printf.printf "%i -> %i\n" a b) (sort compare (list_of_hashtbl cmapdata));*)
(*if !dbg then iter (fun (a, b) -> Printf.printf "%i -> %i\n" a b) (sort compare (list_of_hashtbl cmapdata));*)
let encoding_table = Pdftext.table_of_encoding encoding in
let glyphlist_table = Pdfglyphlist.glyph_hashes () in
Array.init
@ -653,7 +652,7 @@ let parse ~subset data encoding =
(fun subset ->
if subset = [] then None else
let h = null_hash () in
List.iter2
iter2
(fun n u ->
let s = implode (tl (tl (explode (Pdftext.utf16be_of_codepoints [u])))) in
Hashtbl.add h n s)
@ -664,8 +663,9 @@ let parse ~subset data encoding =
in
let one =
{flags = flags_1; minx; miny; maxx; maxy; italicangle; ascent; descent;
capheight; stemv; xheight; avgwidth; maxwidth; firstchar = firstchar_1; lastchar = lastchar_1;
widths = widths_1; subset_fontfile = main_subset; subset = subset_1; tounicode = None}
capheight; stemv; xheight; avgwidth; maxwidth; firstchar = firstchar_1;
lastchar = lastchar_1; widths = widths_1; subset_fontfile = main_subset;
subset = subset_1; tounicode = None}
in
let twos =
map6
@ -675,11 +675,9 @@ let parse ~subset data encoding =
widths; subset_fontfile; subset; tounicode})
firstchars_2 lastchars_2 widths_2 seconds_subsets subsets_2 seconds_tounicodes
in
(*Printf.printf "\nMain subset:\n";
debug_t one;*)
(*Printf.printf "\nMain subset:\n"; debug_t one;*)
write_font "one.ttf" one.subset_fontfile;
(*Printf.printf "\nHigher subset:\n";
debug_t (hd twos);*)
(*Printf.printf "\nHigher subset:\n"; debug_t (hd twos);*)
if twos <> [] then write_font "two.ttf" (hd twos).subset_fontfile;
one::twos