aboutsummaryrefslogtreecommitdiff
path: root/path/builder.ml
blob: f52fb9ea332648240cb005be7caf8bc9cea65ab9 (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
(** Signature for points *)
module type P = sig
  type t

  val get_coord : t -> Gg.v2

end

module Make(P:P) = struct

  type t = P.t list * Shapes.Bezier.t list

  let get_new_segment connexion0 p5 p4 p3 p2 p1 =
    let p5' = P.get_coord p5
    and p4' = P.get_coord p4
    and p3' = P.get_coord p3
    and p2' = P.get_coord p2
    and p1' = P.get_coord p1 in

    let points_to_link =
      [ p1'
      ; p2'
      ; p3'
      ; p4'
      ; p5' ] in
    Shapes.Bspline.to_bezier ?connexion0 points_to_link

  let empty = ([], [])

  let add_point
    : P.t -> t -> t
    = fun lastPoint (path, beziers) ->
      let (let*) v f =
        match v with
        | Ok bezier ->
          if Array.length bezier > 0 then
            f (Array.get bezier 0)
          else
            lastPoint::path, beziers
        | _ ->
          lastPoint::path, beziers
      in

      let connexion0 = match beziers with
        | hd::_ -> Some hd.Shapes.Bezier.p1
        | _ -> None in

      match path with
      | p4::p3::p2::p1::_ ->
        let* bezier = get_new_segment connexion0
            lastPoint p4 p3 p2 p1 in
        (* We remove the last point and add the bezier curve in the list*)
        let firsts = lastPoint::p4::p3::p2::[] in
        firsts, (Shapes.Bezier.reverse bezier)::beziers
      | _ ->
        lastPoint::path, beziers

  let replace_last
    : P.t -> t -> t
    = fun lastPoint ((path, beziers) as t) ->
      match path, beziers with
      | _::(tl), beziers ->
        lastPoint::tl
      , beziers
      | _ ->
        add_point lastPoint t

  let peek2
    : t -> (P.t * P.t) option
    = fun (path, _) ->
      match path with
      | h1::h2::_ -> Some (h1, h2)
      | _ -> None

  let peek
    : t -> P.t option
    = fun (path, _) ->
      match path with
      | [] -> None
      | hd::_ -> Some hd

  let get
    : t -> t
    = fun t -> t

end