summaryrefslogtreecommitdiff
path: root/layer/fillPrinter.ml
blob: f3717c2a573d1837932786c894a3a62aecef1a29 (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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
module Make(Repr: Repr.PRINTER) = struct

  type point = Path.Point.t

  type repr = Repr.t

  type t =
    { path: Repr.t
    ; close : Repr.t -> Repr.t
    }

  let create_path
    : (Repr.t -> Repr.t) -> t
    = fun f ->
      { close = f
      ; path = Repr.create ()
      }

  (* Start a new path. *)

  let start
    : point -> point -> t -> t
    = fun p1 _ {close ; path } ->
      let path = Repr.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 =
        Repr.move_to p1 t.path
        |> Repr.line_to p1'
        |> Repr.line_to p0'
        |> Repr.line_to p0
        |> Repr.line_to p1
        |> Repr.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 =
        Repr.move_to p1 t.path
        |> Repr.line_to p1'

        (* Backward *)
        |> Repr.quadratic_to
          ctrl1'
          ctrl0'
          p0'
        |> Repr.line_to p0

        (* Forward *)
        |> Repr.quadratic_to
          ctrl0
          ctrl1
          p1
        |> Repr.close
        |> t.close in


      { t with path }

  let stop
    : t -> t
    = fun t ->
      t

  let get
    : t -> Repr.t
    = fun t ->
      t.path
end