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
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
open StdLabels
(** Signature for points *)
module type P = sig
type t
val empty : t
val get_coord : t -> Gg.v2
val copy : t -> Gg.v2 -> t
end
module Make(Point:P) = struct
(** Point creation **)
type bezier =
{ p0:Point.t (* The starting point *)
; p1:Point.t (* The end point *)
; ctrl0:Gg.v2 (* The control point *)
; ctrl1:Gg.v2 } (* The control point *)
type t = Point.t list * bezier list
let get_new_segment connexion0 p5 p4 p3 p2 p1 =
let p5' = Point.get_coord p5
and p4' = Point.get_coord p4
and p3' = Point.get_coord p3
and p2' = Point.get_coord p2
and p1' = Point.get_coord p1 in
let points_to_link =
[ p1'
; p2'
; p3'
; p4'
; p5' ] in
Shapes.Bspline.to_bezier ?connexion0 points_to_link
let empty = ([], [])
let add_point
: Point.t -> t -> t
= fun lastPoint (path, beziers) ->
let (let*) v f =
match v with
| Ok bezier ->
if Array.length bezier > 0 then
f (Array.get bezier 0)
else
(lastPoint::path, beziers)
| _ ->
(lastPoint::path, beziers)
in
let connexion0 = match beziers with
| hd::_ -> Some (Point.get_coord hd.p1)
| _ -> None in
match path with
| p4::p3::p2::p1::_ ->
let* bezier = get_new_segment connexion0
lastPoint p4 p3 p2 p1 in
let bezier_point =
{ p0 = p2
; p1 = p1
; ctrl0 = bezier.Shapes.Bezier.ctrl1
; ctrl1 = bezier.Shapes.Bezier.ctrl0
} in
(* We remove the last point and add the bezier curve in the list*)
let firsts = lastPoint::p4::p3::p2::[] in
(firsts, bezier_point::beziers)
| _ ->
( lastPoint::path
, beziers)
let replace_last
: Point.t -> t -> t
= fun lastPoint ((path, beziers) as t) ->
match path, beziers with
| _::(tl), beziers ->
( lastPoint::tl
, beziers )
| _ ->
add_point lastPoint t
let peek2
: t -> (Point.t * Point.t) option
= fun (path, _) ->
match path with
| h1::h2::_ -> Some (h1, h2)
| _ -> None
let peek
: t -> Point.t option
= fun (path, _) ->
match path with
| [] -> None
| hd::_ -> Some hd
let repr
: t -> (module Repr.M with type point = Point.t and type t = 's) -> 's -> 's
= fun (type s) (points, beziers) (module Repr : Repr.M with type point = Point.t and type t = s) path ->
(* Represent the last points *)
let path = match points with
| [] ->
( path )
| p1::[] ->
( Repr.start p1 path )
| p1::p2::[] ->
let path =
Repr.start p1 path
|> Repr.line_to p1 p2 in
( path )
| p0::p1::p2::[] ->
let b0, b1 = Shapes.Bezier.quadratic_to_cubic
@@ Shapes.Bezier.three_points_quadratic
(Point.get_coord p0)
(Point.get_coord p1)
(Point.get_coord p2)
|> Shapes.Bezier.slice 0.5
in
let p0' = Point.copy p0 b0.Shapes.Bezier.p0
and p1' = Point.copy p1 b0.Shapes.Bezier.p1
and p2' = Point.copy p2 b1.Shapes.Bezier.p1 in
Repr.start p0 path
|> Repr.quadratic_to
( p0'
, b0.Shapes.Bezier.ctrl0
, b0.Shapes.Bezier.ctrl1
, p1' )
|> Repr.quadratic_to
( p1'
, b1.Shapes.Bezier.ctrl0
, b1.Shapes.Bezier.ctrl1
, p2' )
| (p0::_ as points) ->
let (let*) v f =
match v with
| Ok beziers -> f beziers
| _ -> path in
let points' = List.map ~f:Point.get_coord points in
let connexion = match beziers with
| [] -> None
| hd ::_ -> Some (Point.get_coord hd.p1) in
let* beziers = Shapes.Bspline.to_bezier ?connexion1:connexion points' in
(* Stdlib does not provide fold_left_i function and we need to map
each bezier point with the associated point in the curve.
So I use references here for keeping each result element
*)
let path = ref path in
let point = ref p0 in
List.iteri
points
~f:(fun i pt ->
(* The first iteration is ignored, as we need both previous and
current point for the two point in the curve.
Do not forget that there is always n-1 bezier curve for n
points *)
if i > 0 then (
let bezier = Array.get beziers (i - 1) in
path := Repr.quadratic_to
( !point
, bezier.Shapes.Bezier.ctrl0
, bezier.Shapes.Bezier.ctrl1
, pt )
(!path);
point := pt;
)
);
( !path )
in
(* Now represent the already evaluated points. Much easer to do, just
iterate on them *)
Repr.stop @@ List.fold_left beziers
~init:path
~f:(fun path bezier ->
Repr.quadratic_to
( bezier.p0
, bezier.ctrl0
, bezier.ctrl1
, bezier.p1 )
path
)
let map
: t -> (Point.t -> Point.t) -> t
= fun (points, beziers) f ->
let points = List.map
points
~f
and beziers = List.map
beziers
~f:(fun bezier ->
{ p0 = f bezier.p0
; p1 = f bezier.p1
; ctrl0 = Point.(get_coord (f ( copy bezier.p0 bezier.ctrl0)))
; ctrl1 = Point.(get_coord (f ( copy bezier.p1 bezier.ctrl1)))
}
) in
points, beziers
end
|
