aboutsummaryrefslogtreecommitdiff
path: root/layer/wireFramePrinter.ml
blob: 81ab27168ba8ecbe8347f28be065a8967b616ebd (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
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