blob: 92f94c72209e52c54902a9362c1ece87bcbfd572 (
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
70
|
module Path = Script_path
module Make (Layer : Repr.PRINTER) = struct
type point = Path.Point.t
type repr = Layer.t
type t =
{ path : Layer.t
; close : Layer.t -> Layer.t
}
let create_path : (Layer.t -> Layer.t) -> t =
fun f -> { close = f; path = Layer.create () }
(* Start a new path. *)
let start : point -> point -> t -> t =
fun p1 _ { close; path } ->
let path = Layer.move_to (Path.Point.get_coord p1) path in
{ close; path }
let line_to : point * point -> point * point -> t -> t =
fun (p0, p1) (p0', p1') t ->
let p0 = Path.Point.get_coord p0
and p1 = Path.Point.get_coord p1
and p0' = Path.Point.get_coord p0'
and p1' = Path.Point.get_coord p1' in
let path =
Layer.move_to p1 t.path
|> Layer.line_to p1'
|> Layer.line_to p0'
|> Layer.line_to p0
|> Layer.line_to p1
|> Layer.close
in
let path = t.close path in
{ t with path }
let quadratic_to :
point * Gg.v2 * Gg.v2 * point -> point * Gg.v2 * Gg.v2 * point -> t -> t =
fun (p0, ctrl0, ctrl1, p1) (p0', ctrl0', ctrl1', p1') t ->
let p0 = Path.Point.get_coord p0
and p1 = Path.Point.get_coord p1
and p0' = Path.Point.get_coord p0'
and p1' = Path.Point.get_coord p1' in
let path =
Layer.move_to p1 t.path
|> Layer.line_to p1'
(* Backward *)
|> Layer.quadratic_to ctrl1' ctrl0' p0'
|> Layer.line_to p0
(* Forward *)
|> Layer.quadratic_to ctrl0 ctrl1 p1
|> Layer.close
|> t.close
in
{ t with path }
let stop : t -> t = fun t -> t
let get : t -> Layer.t = fun t -> t.path
end
|
