aboutsummaryrefslogtreecommitdiff
path: root/layer/fillPrinter.ml
blob: 2297d15fb03e58d3814164d51b21eaf0eff2db01 (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
module Point = Path.Point
module Make(Repr: Repr.PRINTER) = struct

  type t = Point.t

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

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

  (* Start a new path. *)
  let start
    : Path.Point.t -> repr -> repr
    = fun t {close ; path } ->
      let path = Repr.move_to (Point.get_coord t) path in
      { close
      ; path
      }

  let line_to
    : Point.t -> Point.t -> repr -> repr
    = fun p0 p1 t ->
      let path =
        Repr.move_to (Point.get_coord p1) t.path
        |> Repr.line_to (Point.get_coord' p1)
        |> Repr.line_to (Point.get_coord' p0)
        |> Repr.line_to (Point.get_coord p0)
        |> Repr.line_to (Point.get_coord p1)
        |> Repr.close in
      let path = t.close path in
      { t with path}

  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 path =
        Repr.move_to (Point.get_coord p1) t.path
        |> Repr.line_to (Point.get_coord' p1)
        |> Repr.quadratic_to
          (Point.get_coord' ctrl1')
          (Point.get_coord' ctrl0')
          (Point.get_coord' p0)
        |> Repr.line_to (Point.get_coord p0)
        |> Repr.quadratic_to
          (Point.get_coord ctrl0')
          (Point.get_coord ctrl1')
          (Point.get_coord p1)
        |> Repr.close in
      let path = t.close path in
      { t with path}


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

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