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

  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 -> t -> t -> 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 = lastPoint
          ; p1 = p4
          ; ctrl0 = bezier.Shapes.Bezier.ctrl0
          ; ctrl1 = bezier.Shapes.Bezier.ctrl1
          } 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:(true, first_point, 0)
            ~f:(fun (first, prev_point, i) point ->
                if first then (false, prev_point, i)
                else

                  let bezier_curve = Array.get beziers i in

                  Array.set curves i
                    { p0 = prev_point
                    ; ctrl0 = bezier_curve.Shapes.Bezier.ctrl1
                    ; ctrl1 = bezier_curve.Shapes.Bezier.ctrl0
                    ; p1 = point };


                  (false, point, i + 1)
              ) in
        curves


  (** Drawing path **)

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

      let path = Point.create_path () in
      let path, last = match points with
        | [] ->
          ( path
          , None )
        | p1::[] ->
          ( Point.start p1 path
          , Some p1 )
        | p1::p2::[] ->
          let path =
            Point.start p1 path
            |> Point.line_to p2 in
          ( path
          , Some p2 )
        | p0::p1::p2::[] ->
          let path = Point.start p0 path in

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

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

          ( Point.quadratic_to p0' ctrl0 ctrl1 p2' path
          , Some p2 )
        | (p0::_ as points) ->

          let (let*) v f =
            match v with
            | Ok beziers -> f beziers
            | _ -> path, None 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 ->

                if i < Array.length beziers then (

                  let bezier = Array.get beziers i in

                  let p0' = Point.copy pt bezier.Shapes.Bezier.p0
                  and ctrl0 = Point.copy (!point) bezier.Shapes.Bezier.ctrl0
                  and ctrl1 = Point.copy pt bezier.Shapes.Bezier.ctrl1
                  and p1' = Point.copy pt bezier.Shapes.Bezier.p1 in

                  path := Point.quadratic_to p0' ctrl0 ctrl1 p1' (!path);

                  let () = if i > 0 then
                      point := pt in
                  ()
                )
              );
          ( !path
          , Some !point )
      in

      let path = match last with
        | None -> path
        | Some pt ->

          (* TODO : instead of copying the last point, keeep a track for each
             point as declared in the type P.t *)

          List.fold_left beziers
            ~init:path
            ~f:(fun path bezier ->
                let p0' = bezier.p0
                and ctrl0 = Point.copy pt bezier.ctrl0
                and ctrl1 = Point.copy pt bezier.ctrl1
                and p1' = bezier.p1 in
                Point.quadratic_to p0' ctrl0 ctrl1 p1' path
              )
      in Point.stop path
end