1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
(* Embed a font *)
open Pdfutil
type t = Pdftext.font list * (int, int * int) Hashtbl.t (* Table returns font number and charcode for given unicode codepoint *)
type cpdffont =
PreMadeFontPack of t
| EmbedInfo of {fontfile : Pdfio.bytes; fontname : string; encoding : Pdftext.encoding}
| ExistingNamedFont
let fontpack_of_standardfont sf =
let te = Pdftext.text_extractor_of_font_real sf in
let table = null_hash () in
for x = 0 to 255 do
let u = hd (Pdftext.codepoints_of_text te (string_of_char (char_of_int x))) in
Hashtbl.add table u (0, x)
done;
([sf], table)
let get_char (fonts, table) u =
match Hashtbl.find table u with
| (n, charcode) -> Some (charcode, n, List.nth fonts n)
| exception Not_found -> None
let fontnum = ref 0
let basename () =
incr fontnum;
"AAAAA" ^ string_of_char (char_of_int (!fontnum + 65))
let make_single_font ~fontname ~encoding pdf f =
let name_1 = basename () in
let module TT = Cpdftruetype in
let fontfile =
let len = Pdfio.bytes_size f.TT.subset_fontfile in
Pdf.Stream
{contents =
(Pdf.Dictionary
[("/Length", Pdf.Integer len); ("/Length1", Pdf.Integer len)],
Pdf.Got f.TT.subset_fontfile)}
in
let fontfile_num = Pdf.addobj pdf fontfile in
let open Pdftext in
let fontmetrics =
let a = Array.make 256 0. in
for x = f.TT.firstchar to f.TT.lastchar do
a.(x) <- float_of_int (f.TT.widths.(x - f.TT.firstchar))
done;
a
in
(f.TT.subset,
SimpleFont
{fonttype = Truetype;
basefont = Printf.sprintf "/%s+%s" name_1 fontname;
fontmetrics = Some fontmetrics;
firstchar = f.TT.firstchar;
lastchar = f.TT.lastchar;
widths = f.TT.widths;
fontdescriptor = Some
{ascent = float_of_int f.TT.ascent;
descent = float_of_int f.TT.descent;
avgwidth = float_of_int f.TT.avgwidth;
maxwidth = float_of_int f.TT.maxwidth;
flags = f.TT.flags;
italicangle = float_of_int f.TT.italicangle;
capheight = float_of_int f.TT.capheight;
xheight = float_of_int f.TT.xheight;
stemv = float_of_int f.TT.stemv;
fontbbox = (float_of_int f.TT.minx, float_of_int f.TT.miny,
float_of_int f.TT.maxx, float_of_int f.TT.maxy);
fontfile = Some (FontFile2 fontfile_num);
charset = None;
tounicode = f.TT.tounicode};
encoding})
let make_fontpack_hashtable fs =
let indexes = indx0 fs in
let table = null_hash () in
iter2
(fun i (subset, f) ->
let charcode_extractor = Pdftext.charcode_extractor_of_font_real f in
iter
(fun u ->
match charcode_extractor u with
| Some x -> Hashtbl.add table u (i, x)
| None -> Printf.printf "charcode_extractor could not find char U+%04x in make_fontpack_hashtable\n" u)
subset)
indexes fs;
table
let embed_truetype pdf ~fontfile ~fontname ~codepoints ~encoding =
if codepoints = [] then ([], null_hash ()) else (* Can't call Cpdftruetype.parse with empty codepoint set. *)
let fs = Cpdftruetype.parse ~subset:codepoints fontfile encoding in
let subsets_and_their_fonts = map (make_single_font ~fontname ~encoding pdf) fs in
(map snd subsets_and_their_fonts, make_fontpack_hashtable subsets_and_their_fonts)
let rec collate_runs cfn a = function
| [] -> rev (map rev a)
| (charcode, fontnum, font) as h::t ->
match a with
| [] -> collate_runs fontnum [[h]] t
| this::rest ->
if fontnum = cfn
then collate_runs cfn ((h::this)::rest) t
else collate_runs fontnum ([h]::this::rest) t
let collate_runs = function
| [] -> []
| (_, fontnum, _)::_ as l -> collate_runs fontnum [] l
let fontnames =
[(Pdftext.TimesRoman, ["NimbusRoman-Regular.ttf"]);
(Pdftext.TimesBold, ["NimbusRoman-Bold.ttf"]);
(Pdftext.TimesItalic, ["NimbusRoman-Italic.ttf"]);
(Pdftext.TimesBoldItalic, ["NimbusRoman-BoldItalic.ttf"]);
(Pdftext.Helvetica, ["NimbusSans-Regular.ttf"]);
(Pdftext.HelveticaBold, ["NimbusSans-Bold.ttf"]);
(Pdftext.HelveticaOblique, ["NimbusSans-Italic.ttf"]);
(Pdftext.HelveticaBoldOblique, ["NimbusSans-BoldItalic.ttf"]);
(Pdftext.Courier, ["NimbusMonoPS-Regular.ttf"]);
(Pdftext.CourierBold, ["NimbusMonoPS-Bold.ttf"]);
(Pdftext.CourierOblique, ["NimbusMonoPS-Italic.ttf"]);
(Pdftext.CourierBoldOblique, ["NimbusMonoPS-BoldItalic.ttf"]);
(Pdftext.Symbol, ["StandardSymbolsPS.ttf"]);
(Pdftext.ZapfDingbats, ["D050000L.ttf"])]
let load_substitute dirname f =
let filename = hd (List.assoc f fontnames) in
(Pdfio.bytes_of_string (contents_of_file (Filename.concat dirname filename)),
Filename.remove_extension filename)
|
