open StdLabels

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

  val empty : t

  val get_coord : t -> Gg.v2

  (** Copy a point and all thoses properties to the given location *)
  val copy : t -> Gg.v2 -> t

end

module Make(Point:P) = struct

  module type BUILDER = sig
    type t

    val repr
      : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
  end

  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 path =
    | Empty
    | Line of Point.t * Point.t
    | Curve of bezier

  type t =
    { id: int
    ; path : path array }

  let id
    : t -> int
    = fun {id; _} -> id

  let path
    : t -> path array
    = fun {path; _} -> path

  module ToFixed = struct
    type t = Point.t

    type repr = int * path list

    let create_path () = 0, []

    (* Start a new path. *)
    let start point t =
      let _ = point in
      t

    let line_to
      : t -> t -> repr -> repr
      = fun p1 p2 (i, t) ->
        ( i + 1
        , Line (p1, p2)::t)

    let quadratic_to
      : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr
      = fun p0 ctrl0 ctrl1 p1 (i, t) ->
        let curve = Curve
            { p0
            ; ctrl0
            ; ctrl1
            ; p1} in
        ( i + 1
        , curve::t)

    let stop t = t

    let get
      : int * path list -> path array
      = fun (n, t) ->
        let res = Array.make n Empty in
        List.iteri t
          ~f:(fun i elem -> Array.set res (n - i - 1) elem );
        res
  end

  let internal_id = ref 0

  let to_fixed
    : (module BUILDER with type t = 'a) -> 'a -> t
    = fun (type s) (module Builder: BUILDER with type t = s) t ->
      incr internal_id;
      { id = !internal_id
      ; path = Builder.repr t (module ToFixed) (ToFixed.create_path ())
               |> ToFixed.get
      }

  let repr
    : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
    = fun (type s) {path; _} (module Repr : Repr.M with type t = Point.t and type repr = s) repr ->
      let repr_bezier p bezier =
        Repr.quadratic_to
          bezier.p0
          bezier.ctrl0
          bezier.ctrl1
          bezier.p1
          p in

      let _, repr = Array.fold_left path
          ~init:(true, repr)
          ~f:(fun (first, path) element ->
              match element with
              | Empty -> (true, path)
              | Line (p0, p1) ->

                let path =  if first then
                    Repr.start p0 path
                  else path in

                ( false
                , Repr.line_to p0 p1 path )
              | Curve bezier ->
                let path =  if first then
                    Repr.start bezier.p0 path
                  else path in
                ( false
                , repr_bezier path bezier )
            ) in
      Repr.stop repr

  (** Return the distance between a given point and the curve. May return
      None if the point is out of the curve *)
  let distance
    : Gg.v2 -> t -> (Gg.v2 * float * Point.t * Point.t) option
    = fun point beziers ->

      Array.fold_left beziers.path
        ~init:None
        ~f:(fun res -> function
            | Empty -> None
            | Line (p0, p1) ->
              let box = Gg.Box2.of_pts (Point.get_coord p0) (Point.get_coord p1) in
              begin match Gg.Box2.mem point box with
                | false -> res
                | true ->
                  (* TODO Evaluate the normal *)
                  res
              end
            | Curve bezier ->

              let bezier' = Shapes.Bezier.(

                  { p0 = Point.get_coord bezier.p0
                  ; p1 = Point.get_coord bezier.p1
                  ; ctrl0 = bezier.ctrl0
                  ; ctrl1 = bezier.ctrl1 }
                ) in
              let _, point' = Shapes.Bezier.get_closest_point point bezier' in
              let distance = Gg.V2.( norm (point - point') ) in
              match res with
              | None -> Some (point', distance, bezier.p0, bezier.p1)
              | Some (_, d, _, _) when d < distance -> res
              | _ -> (Some (point', distance, bezier.p0, bezier.p1))
          )

  let map_point
    : t -> (Point.t -> Point.t) -> t
    = fun {id; path} f ->
      let path = Array.map path
          ~f:(function
              | Empty -> Empty
              | Line (p1, p2) -> Line (f p1, f p2)
              | Curve bezier -> Curve {bezier with p0 = f bezier.p0 ; p1 = f bezier.p1}
            ) in
      {id; path}

  let iter
    : t -> f:(Point.t -> unit) -> unit
    = fun {path; _} ~f ->
      Array.iter path
        ~f:(function
            | Empty -> ()
            | Line (p1, p2) -> f p1; f p2
            | Curve bezier -> f bezier.p0 ; f bezier.p1
          )


  let remove_point
    : t -> Point.t -> t
    = fun {id; path} point ->

      (* First search the element to remove *)
      let idx = ref None
      and counter = ref 0  in

      let _ = Array.exists
          path
          ~f:(fun element ->

              let res = match element with
                | Empty -> false
                | Line (p0, p1)
                | Curve {p0;p1;_} ->
                  if p0 = point then (
                    idx := Some (!counter) ;
                    true
                  ) else if p1 = point then (
                    idx := Some (!counter +1) ;
                    true
                  ) else
                    false
              in
              incr counter;
              res) in

      match !idx with
      | None -> {id; path}
      | Some 0 ->
        (* Remove the first point *)
        let path' = Array.init
            ((Array.length path) -1)
            ~f:( fun i -> Array.get path (i + 1)) in
        {id; path=path'}
      | Some n when n = (Array.length path) ->
        (* Remove the last point *)
        let path' = Array.init
            ((Array.length path) -1)
            ~f:( fun i -> Array.get path i) in
        {id; path=path'}
      | Some n ->
        let path' = Array.init
            ((Array.length path) -1)
            ~f:(fun i ->
                if i < (n -1) then
                  Array.get path (i)
                else
                  Array.get path (i +1)
              ) in
        {id; path=path'}

  let update
    : t -> path array -> t
    = fun {id; _} path -> {id; path}

end