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 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, 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 repr
    : t -> (module Repr.M with type point = Point.t and type t = 's) -> 's -> 's
    = fun (type s) (points, beziers) (module Repr : Repr.M with type point = Point.t and type t = s) path ->

      (* 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 p1 p2 in
          ( path )
        | p0::p1::p2::[] ->

          let b0, b1 = Shapes.Bezier.quadratic_to_cubic
            @@ Shapes.Bezier.three_points_quadratic
              (Point.get_coord p0)
              (Point.get_coord p1)
              (Point.get_coord p2)
                       |> Shapes.Bezier.slice 0.5
          in
          let p0' = Point.copy p0 b0.Shapes.Bezier.p0
          and p1' = Point.copy p1 b0.Shapes.Bezier.p1
          and p2' = Point.copy p2 b1.Shapes.Bezier.p1 in

          Repr.start p0 path
          |> Repr.quadratic_to
            ( p0'
            , b0.Shapes.Bezier.ctrl0
            , b0.Shapes.Bezier.ctrl1
            , p1' )
          |> Repr.quadratic_to
            ( p1'
            , b1.Shapes.Bezier.ctrl0
            , b1.Shapes.Bezier.ctrl1
            , p2' )
        | (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 ->
            Repr.quadratic_to
              ( bezier.p0
              , bezier.ctrl0
              , bezier.ctrl1
              , bezier.p1 )
              path
          )

  let map
    : t -> (Point.t -> Point.t) -> t
    = fun (points, beziers) f ->
      let points = List.map
          points
          ~f
      and beziers = List.map
          beziers
          ~f:(fun bezier ->

              { p0 = f bezier.p0
              ; p1 = f bezier.p1
              ; ctrl0 = Point.(get_coord (f ( copy bezier.p0 bezier.ctrl0)))
              ; ctrl1 = Point.(get_coord (f ( copy bezier.p1 bezier.ctrl1)))
              }
            ) in
      points, beziers

end