fenix
/
cpdf-source
mirror of https://github.com/johnwhitington/cpdf-source.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
cpdftoc.ml
View File

@ -109,11 +109,11 @@ 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 ->
@ -141,15 +141,15 @@ let typeset_table_of_contents ~font ~fontsize ~title ~bookmark pdf =
(Pdfmarks.read_bookmarks pdf) (Pdfmarks.read_bookmarks pdf)
in in
let toc_pages = let toc_pages =
(*let title = let title =
let glue = Cpdftype.VGlue (fontsize *. 2.) in let glue = Cpdftype.VGlue (fontsize *. 2.) in
if title = "" then [] else if title = "" then [] else
flatten flatten
(map (map
(fun l -> [Cpdftype.Text l; Cpdftype.NewLine]) (fun l -> l @ [Cpdftype.NewLine])
(split_toc_title (of_utf8 fontpack (fontsize *. 2.) title))) (map (of_utf8 fontpack (fontsize *. 2.)) (map implode (split_toc_title (explode title)))))
@ [glue] @ [glue]
in*) in
let lm, rm, tm, bm = let lm, rm, tm, bm =
match firstpage_cropbox with match firstpage_cropbox with
| None -> (margin, margin, margin, margin) | 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) (cminx +. margin, (pmaxx -. cmaxx) +. margin, cminy +. margin, (pmaxy -. cmaxy) +. margin)
in in
let firstfont = 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 in
Cpdftype.typeset lm rm tm bm firstpage_papersize pdf Cpdftype.typeset lm rm tm bm firstpage_papersize pdf
([firstfont; Cpdftype.BeginDocument] @ (*title @*) flatten lines) ([firstfont; Cpdftype.BeginDocument] @ title @ flatten lines)
in in
let toc_pages = let toc_pages =
match firstpage_cropbox with match firstpage_cropbox with

30
cpdftruetype.ml
View File

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