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
open OCADml
open Cairo
let path_to_outlines ?(fn = 5) data =
let f (paths, ps, last_p) = function
| MOVE_TO (x, y) -> paths, ps, v2 x y
| LINE_TO (x, y) -> paths, last_p :: ps, v2 x y
| CURVE_TO (x1, y1, x2, y2, x3, y3) ->
let bez = Bezier2.make [ last_p; v2 x1 y1; v2 x2 y2; v2 x3 y3 ] in
paths, Bezier2.curve ~fn ~rev:true ~endpoint:false ~init:ps bez, v2 x3 y3
| CLOSE_PATH ->
let path =
match ps with
| [] -> [ last_p ]
| hd :: tl as ps ->
let first = List.fold_left (fun _ e -> e) hd tl in
if V2.approx first last_p then ps else last_p :: ps
in
path :: paths, [], last_p
in
let paths, _, _ = Path.fold data f ([], [], v2 0. 0.) in
List.rev_map (List.map @@ fun v -> v2 (V2.x v) (-.V2.y v)) paths
let text ?fn ?(center = false) ?slant ?weight ?(size = 10.) ~font txt =
let ctxt = create (Image.create Image.A1 ~w:1 ~h:1) in
select_font_face ?slant ?weight ctxt font;
scale ctxt 1. 1.;
set_font_size ctxt size;
let te = text_extents ctxt txt
and x_offset = 0.72 *. size /. 10. in
if center
then (
let x = x_offset -. (te.width /. 2.) -. te.x_bearing
and y = 0. -. (te.height /. 2.) -. te.y_bearing in
move_to ctxt x y )
else move_to ctxt (-.x_offset) 0.;
let f acc c =
let s = String.make 1 c in
Path.text ctxt s;
let acc =
match path_to_outlines ?fn (Path.copy ctxt) with
| [] -> acc
| outer :: tl ->
let rec aux polys outer holes = function
| [] -> Poly2.make ~holes (List.rev outer) :: polys
| (pt :: _ as hd) :: tl ->
( match Path2.point_inside outer pt with
| `Inside -> aux polys outer (hd :: holes) tl
| _ -> aux (Poly2.make ~holes (List.rev outer) :: polys) hd [] tl )
| _ -> aux polys outer holes tl
in
aux acc outer [] tl
in
let x, y = Path.get_current_point ctxt in
Path.clear ctxt;
move_to ctxt x y;
acc
in
String.fold_left f [] txt