blob: e61bd7c78f2574d3e2e2d67a947d3f98a88d9e4f (
plain)
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
|
module Path = Script_path
module Point = Path.Point
module Make (Repr : Repr.PRINTER) = struct
type t = Point.t
type repr =
{ back : Repr.t -> Repr.t
; path : Repr.t
; last_point : Point.t option
}
let create_path : 'b -> repr =
fun _ -> { back = Repr.close; path = Repr.create (); last_point = None }
(* Start a new path. *)
let start : Point.t -> repr -> repr =
fun t { back; path; _ } ->
let path = Repr.move_to (Point.get_coord t) path in
let line' = Repr.line_to (Point.get_coord' t) in
{ back = (fun p -> back @@ line' p); path; last_point = Some t }
let line_to : Point.t -> Point.t -> repr -> repr =
fun _ t { back; path; _ } ->
let line' = Repr.line_to (Point.get_coord' t) in
{ back = (fun t -> back @@ line' t)
; path = Repr.line_to (Point.get_coord t) path
; last_point = Some t
}
let quadratic_to : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> repr =
fun p0 ctrl0 ctrl1 p1 t ->
let ctrl0' = Point.copy p1 ctrl0
and ctrl1' = Point.copy p1 ctrl1 in
let line' path =
Repr.quadratic_to
(Point.get_coord' @@ ctrl1')
(Point.get_coord' ctrl0')
(Point.get_coord' p0)
path
in
let path =
Repr.quadratic_to
(Point.get_coord ctrl0')
(Point.get_coord ctrl1')
(Point.get_coord p1)
t.path
in
{ back = (fun p -> t.back @@ line' p); path; last_point = Some p1 }
let stop : repr -> repr =
fun { back; path; last_point } ->
let path =
match last_point with
| Some point -> Repr.line_to (Point.get_coord' point) path
| None -> path
in
{ back = (fun x -> x); path = back path; last_point = None }
let get : repr -> Repr.t = fun { back; path; _ } -> back path
end
|
