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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
type ('a, 'b) refbox = { cont : 'a; ref : 'b ref; }
type t = (Ftlow.library, unit) refbox
let init () =
let t = {cont = Ftlow.init (); ref = ref ()} in
Gc.finalise (fun v -> Ftlow.close v.cont) t;
t
type face = (Ftlow.face, t) refbox
type face_info = Ftlow.face_info = {
num_faces : int;
num_glyphs : int;
family_name : string;
style_name : string;
has_horizontal : bool;
has_vertical : bool;
has_kerning : bool;
is_scalable : bool;
is_sfnt : bool;
is_fixed_width : bool;
has_fixed_sizes : bool;
has_fast_glyphs : bool;
has_glyph_names : bool;
has_multiple_masters : bool;
}
let done_face face = Ftlow.done_face face.cont
let new_face t font idx =
let face = {cont = Ftlow.new_face t.cont font idx; ref = ref t} in
let info = Ftlow.face_info face.cont in
Gc.finalise done_face face;
face, info
let get_num_glyphs face = Ftlow.get_num_glyphs face.cont
let float_of_intfrac dotbits i =
let d = float (1 lsl dotbits) in
float i /. d
let intfrac_of_float dotbits f =
let d = float (1 lsl dotbits) in
truncate (f *. d)
let intfrac6_of_float = intfrac_of_float 6
let float_of_intfrac6 = float_of_intfrac 6
let intfrac16_of_float = intfrac_of_float 16
let float_of_intfrac16 = float_of_intfrac 16
let vector_float_of_intfrac6 (x, y) = float_of_intfrac6 x, float_of_intfrac6 y
let set_char_size face char_w char_h res_h res_v =
Ftlow.set_char_size face.cont
(intfrac6_of_float char_w)
(intfrac6_of_float char_h)
res_h res_v
let set_pixel_sizes face pixel_w pixel_h =
Ftlow.set_pixel_sizes face.cont pixel_w pixel_h
type charmap = Ftlow.charmap = { platform_id : int; encoding_id : int; }
type char_index = int
let int_of_char_index = fun x -> x
let char_index_of_int = fun x -> x
let get_charmaps face = Ftlow.get_charmaps face.cont
let set_charmap face charmap = Ftlow.set_charmap face.cont charmap
let get_char_index face code = Ftlow.get_char_index face.cont code
type render_mode = Ftlow.render_mode = | Render_Normal | Render_Mono
type load_flag = Ftlow.load_flag = | Load_no_scale | Load_no_hinting
let load_glyph face index flags =
vector_float_of_intfrac6 (Ftlow.load_glyph face.cont index flags)
let load_char face code flags =
vector_float_of_intfrac6 (Ftlow.load_char face.cont code flags)
let render_glyph_of_face face render_mode =
Ftlow.render_glyph_of_face face.cont render_mode
let render_glyph face index flags render_mode =
vector_float_of_intfrac6
(Ftlow.render_glyph face.cont index flags render_mode)
let render_char face code flags render_mode =
vector_float_of_intfrac6
(Ftlow.render_char face.cont code flags render_mode)
type matrix = { ft_xx : float; ft_xy : float; ft_yx : float; ft_yy : float; }
type vector = { ft_x : float; ft_y : float; }
let set_transform face mat vec =
Ftlow.set_transform face.cont
(intfrac16_of_float mat.ft_xx,
intfrac16_of_float mat.ft_xy,
intfrac16_of_float mat.ft_yx,
intfrac16_of_float mat.ft_yy)
(intfrac6_of_float vec.ft_x,
intfrac6_of_float vec.ft_y)
let matrix_rotate r =
let c = cos r
and s = sin r in
{ft_xx = c; ft_xy = -.s; ft_yx = s; ft_yy = c}
type bitmap_info = Ftlow.bitmap_info = {
bitmap_left : int;
bitmap_top : int;
bitmap_width : int;
bitmap_height : int;
}
let get_bitmap_info face = Ftlow.get_bitmap_info face.cont
let read_bitmap face x y = Ftlow.read_bitmap face.cont x y
type bbox = {
xmin : float;
ymin : float;
xmax : float;
ymax : float;
}
type bearing_advance = {
bearingx : float;
bearingy : float;
advance : float;
}
type glyph_metrics = {
gm_width : float;
gm_height : float;
gm_hori : bearing_advance;
gm_vert : bearing_advance;
}
let get_glyph_metrics face =
let bearing_advance_float_of_intfrac6 ba =
{ bearingx = float_of_intfrac6 ba.Ftlow.bearingx;
bearingy = float_of_intfrac6 ba.Ftlow.bearingy;
advance = float_of_intfrac6 ba.Ftlow.advance; } in
let gm = Ftlow.get_glyph_metrics face.cont in
{ gm_width = float_of_intfrac6 gm.Ftlow.gm_width;
gm_height = float_of_intfrac6 gm.Ftlow.gm_height;
gm_hori = bearing_advance_float_of_intfrac6 gm.Ftlow.gm_hori;
gm_vert = bearing_advance_float_of_intfrac6 gm.Ftlow.gm_vert; }
type size_metrics = {
x_ppem : int;
y_ppem : int;
x_scale : float;
y_scale : float;
}
let get_size_metrics face =
let low = Ftlow.get_size_metrics face.cont in
{ x_ppem = low.Ftlow.x_ppem;
y_ppem = low.Ftlow.y_ppem;
x_scale = float_of_intfrac16 low.Ftlow.x_scale;
y_scale = float_of_intfrac16 low.Ftlow.y_scale; }
type outline_tag = Ftlow.outline_tag =
| On_point | Off_point_conic | Off_point_cubic
type outline_contents = {
n_contours : int;
n_points : int;
points : (float * float) array;
tags : outline_tag array;
contours : int array;
}
let get_outline_contents face =
let oc = Ftlow.get_outline_contents face.cont in
{ n_contours = oc.Ftlow.n_contours;
n_points = oc.Ftlow.n_points;
points =
Array.map
(fun (x, y) ->
float_of_intfrac6 x, float_of_intfrac6 y)
oc.Ftlow.points;
tags = oc.Ftlow.tags;
contours = oc.Ftlow.contours; }