path: root/path/builder.ml

open StdLabels

(** Signature for points *)
module type P = sig
  type t

  val empty : t

  val get_coord : t -> Gg.v2

  val copy : t -> Gg.v2 -> t

end

module type REPR = sig
  type t

  type 'a repr

  val create_path
    : unit -> 'a repr

  (* Start a new path. *)
  val start
    : t -> 'a repr -> 'a repr

  val line_to
    : t -> 'a repr -> 'a repr

  val quadratic_to
    : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr

  val stop
    : 'a repr -> 'a repr
end

module Make(Point:P) = struct

  (** Point creation  **)

  type bezier =
    { p0:Point.t    (* The starting point *)
    ; p1:Point.t    (* The end point *)
    ; ctrl0:Gg.v2   (* The control point *)
    ; ctrl1:Gg.v2 } (* The control point *)

  type t = Point.t list * bezier list

  let get_new_segment connexion0 p5 p4 p3 p2 p1 =
    let p5' = Point.get_coord p5
    and p4' = Point.get_coord p4
    and p3' = Point.get_coord p3
    and p2' = Point.get_coord p2
    and p1' = Point.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
    : Point.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 (Point.get_coord hd.p1)
        | _ -> None in

      match path with
      | p4::p3::p2::p1::_ ->
        let* bezier = get_new_segment connexion0
            lastPoint p4 p3 p2 p1 in

        let bezier_point =
          { p0 = p2
          ; p1 = p1
          ; ctrl0 = bezier.Shapes.Bezier.ctrl1
          ; ctrl1 = bezier.Shapes.Bezier.ctrl0
          } 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*)
        firsts, bezier_point::beziers
      | _ ->
        lastPoint::path, beziers

  let replace_last
    : Point.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 -> (Point.t * Point.t) option
    = fun (path, _) ->
      match path with
      | h1::h2::_ -> Some (h1, h2)
      | _ -> None

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

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


  (**  Complete path **)

  (* Transform the result by replacing each start and end point by the
     version given in the list

     This allow to keep the informations like angle or nib width inside the
     bezier curve

  *)
  let points_to_beziers
    : Point.t list -> Shapes.Bezier.t array -> bezier array
    = fun points beziers ->
      match points with
      (* If there is no point to draw, just return empty array *)
      | [] -> [||]
      | first_point::_ ->
        let curves = Array.make
            ( (List.length points) -1)
            { p0 = Point.empty
            ; ctrl0 = Gg.V2.of_tuple (0., 0.)
            ; ctrl1 = Gg.V2.of_tuple (0., 0.)
            ; p1 = Point.empty } in

        let _ = List.fold_left points
            ~init:(first_point, -1)
            ~f:(fun (prev_point, i) point ->
                (* In the first step, prev_point = point *)
                if i < 0 then
                  ( prev_point
                  , 0)
                else

                  let bezier_curve = Array.get beziers i in
                  Array.set curves i
                    { p0 = Point.copy prev_point bezier_curve.Shapes.Bezier.p0
                    ; ctrl0 = bezier_curve.Shapes.Bezier.ctrl0
                    ; ctrl1 = bezier_curve.Shapes.Bezier.ctrl1
                    ; p1 = Point.copy point bezier_curve.Shapes.Bezier.p1 };

                  ( point
                  , i + 1)
              ) in
        curves


  module Draw(Repr:REPR with type t = Point.t) = struct

    (** Drawing path **)

    let draw
      : t -> 'a Repr.repr
      = fun (points, beziers) ->

        let path = Repr.create_path () in

        (* Represent the last points *)
        let path = match points with
          | [] ->
            ( path )
          | p1::[] ->
            ( Repr.start p1 path )
          | p1::p2::[] ->
            let path =
              Repr.start p1 path
              |> Repr.line_to p2 in
            ( path )
          | p0::p1::p2::[] ->
            let path = Repr.start p0 path in

            let b = Shapes.Bezier.quadratic_to_cubic
              @@ Shapes.Bezier.three_points_quadratic
                (Point.get_coord p0)
                (Point.get_coord p1)
                (Point.get_coord p2)
            in

            let p0' = Point.copy p0 b.Shapes.Bezier.p0
            and p2' = Point.copy p1 b.Shapes.Bezier.p1 in

            ( Repr.quadratic_to
                p0'
                b.Shapes.Bezier.ctrl0
                b.Shapes.Bezier.ctrl1
                p2'
                path )
          | (p0::_ as points) ->

            let (let*) v f =
              match v with
              | Ok beziers -> f beziers
              | _ -> path in

            let points' = List.map ~f:Point.get_coord points in
            let connexion = match beziers with
              | [] -> None
              | hd ::_ -> Some (Point.get_coord hd.p1) in

            let* beziers = Shapes.Bspline.to_bezier ?connexion1:connexion points' in

            (* Stdlib does not provide fold_left_i function and we need to map
               each bezier point with the associated point in the curve.

               So I use references here for keeping each result element

            *)
            let path = ref path in
            let point = ref p0 in

            List.iteri
              points
              ~f:(fun i pt ->

                  (* The first iteration is ignored, as we need both previous and
                     current point for the two point in the curve.

                     Do not forget that there is always n-1 bezier curve for n
                     points *)
                  if i > 0 then (

                    let bezier = Array.get beziers (i - 1) in

                    path := Repr.quadratic_to
                        !point
                        bezier.Shapes.Bezier.ctrl0
                        bezier.Shapes.Bezier.ctrl1
                        pt
                        (!path);
                    point := pt;
                  )
                );
            ( !path )
        in

        (* Now represent the already evaluated points. Much easer to do, just
           iterate on them *)
        Repr.stop @@ List.fold_left beziers
          ~init:path
          ~f:(fun path bezier ->
              let p0' = bezier.p0
              and ctrl0 = bezier.ctrl0
              and ctrl1 = bezier.ctrl1
              and p1' = bezier.p1 in
              Repr.quadratic_to p0' ctrl0 ctrl1 p1' path
            )
  end
end