summaryrefslogtreecommitdiff
path: root/path/fillPrinter.ml
blob: d95030c2862c631961751c65cb9673f8ed9589ea (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
module Repr = Layer.CanvaPrinter

type t = Point.t

type 'a repr =
  { path: ('a Repr.t)
  ; close : 'a Repr.t -> unit
  }

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

(* Start a new path. *)
let start
  : Point.t -> 'a repr -> 'a 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 -> 'a repr -> 'a 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
    t.close path;
    { t with path}

let quadratic_to
  : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a 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
    t.close path;
    { t with path}


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

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