open StdLabels
(** Common  module for ensuring that the function is evaluated only once *)

module type REPRESENTABLE = sig
  type t

  (** Represent the path *)
  val repr
    : t -> (module Path.Repr.M with type point = Path.Point.t and type t = 's) -> 's -> 's
end

type printer =
  [ `Fill
  | `Line
  | `Ductus ]


module type P = sig
  include Path.Repr.M

  type repr

  val create_path
    : (repr -> repr) -> t

  val get
    : t -> repr
end


module MakePrinter(M:Repr.LAYER) : P with type point = M.point and type t = M.t and type repr = M.repr = struct

  type t = M.t

  type point = M.point

  type repr = M.repr

  let get
    : t -> repr
    = M.get

  let create_path
    : (repr -> repr) -> t
    = M.create_path

  let start
    : Path.Point.t -> t -> t
    = fun pt t ->
      M.start pt pt t

  let line_to
    : Path.Point.t -> Path.Point.t -> t -> t
    = fun p0 p1 t ->

      M.line_to
        ( p0
        , p1 )
        ( Path.Point.copy p0 @@ Path.Point.get_coord' p0
        , Path.Point.copy p1 @@ Path.Point.get_coord' p1 )
        t

  let quadratic_to
    : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> t -> t
    = fun (p0,  ctrl0, ctrl1, p1) t ->


      let ctrl0' = Path.Point.get_coord' @@ Path.Point.copy p0 ctrl0
      and ctrl1' = Path.Point.get_coord' @@ Path.Point.copy p1 ctrl1 in
      M.quadratic_to
        (p0, ctrl0, ctrl1, p1)
        (Path.Point.copy p0 @@ Path.Point.get_coord' p0, ctrl0', ctrl1', Path.Point.copy p1 @@ Path.Point.get_coord' p1)

        t

  let stop = M.stop
end

(* Canva representation *)

module FillCanvaRepr = MakePrinter(FillPrinter.Make(CanvaPrinter))
module DuctusCanvaRepr = MakePrinter(DuctusPrinter.Make(CanvaPrinter))
module LineCanvaRepr = MakePrinter(LinePrinter.Make(CanvaPrinter))

(* SVG representation *)

module FillSVGRepr = MakePrinter(FillPrinter.Make(Svg))
module DuctusSVGRepr = MakePrinter(DuctusPrinter.Make(Svg))


(** Draw a path to a canva *)
let to_canva
  : (module REPRESENTABLE with type t = 's)  -> 's -> Brr_canvas.C2d.t -> printer -> unit
  = fun (type s) (module R:REPRESENTABLE with type t = s) path ctx -> function
    | `Fill ->
      R.repr
        path
        (module FillCanvaRepr)
        (FillCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
      |> FillCanvaRepr.get
      |> Brr_canvas.C2d.stroke ctx
    | `Line ->
      R.repr
        path
        (module LineCanvaRepr)
        (LineCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
      |> LineCanvaRepr.get
      |> Brr_canvas.C2d.stroke ctx
    | `Ductus ->
      R.repr
        path
        (module DuctusCanvaRepr)
        (DuctusCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
      |> DuctusCanvaRepr.get
      |> Brr_canvas.C2d.stroke ctx


(** Draw a path and represent it as SVG *)
let to_svg
  : (module REPRESENTABLE with type t = 's) -> color:Jstr.t -> 's -> printer -> Brr.El.t
  = fun (type s) (module R:REPRESENTABLE with type t = s) ~color path -> function
    | `Fill ->

      (* In order to deal with over crossing path, I cut the path in as
         many segment as there is curve, and fill them all. Then, all of theme
         are grouped inside a single element *)
      let paths = ref [] in
      let _ = R.repr
          path
          (module FillSVGRepr)
          (FillSVGRepr.create_path
             (fun p ->
                let repr = Svg.path
                    ~at:Brr.At.[ v (Jstr.v "d") p ]
                    [] in

                paths := repr::!paths;
                Jstr.empty)) in

      Brr.El.v (Jstr.v "g")
        ~at:Brr.At.[
            v (Jstr.v "fill")  color
          ; v (Jstr.v "stroke") color]
        !paths

    | `Ductus ->
      let svg_path = R.repr
          path
          (module DuctusSVGRepr)
          (DuctusSVGRepr.create_path (fun _ -> Jstr.empty))
                     |> DuctusSVGRepr.get in
      Svg.path
        ~at:Brr.At.[
            v (Jstr.v "fill")  color
          ; v (Jstr.v "stroke") color
          ; v (Jstr.v "d") svg_path ]
        []
    | `Line ->
      raise Not_found

(** Transform the two fixed path, into a single one. *)
module ReprFixed = struct

  type t = Path.Fixed.t * Path.Fixed.t

  module R = struct
    type point = Path.Point.t

    type repr' =
      | Move of (point)
      | Line_to of (point * point)
      | Quadratic of (point * Gg.v2 * Gg.v2 * point)

    type t = repr' list

    let start t actions =
      (Move t)::actions

    let line_to p0 p1 actions =
      Line_to (p0, p1)::actions

    let quadratic_to
      : (point * Gg.v2 * Gg.v2 * point) -> t -> t
      = fun q actions ->
        (Quadratic q)::actions

    let stop
      : t -> t
      = fun v -> List.rev v

  end

  let repr
    : t -> (module Path.Repr.M with type point = Path.Point.t and type t = 's) -> 's -> 's
    = fun (type s) (path, _) (module Repr:Path.Repr.M with type point = Path.Point.t and type t = s) state ->
      let elems = Path.Fixed.repr path (module R) [] in

      let state = List.fold_left elems
          ~init:state
          ~f:(fun state -> function
              | R.Move pt -> Repr.start pt state
              | R.Line_to (p0, p1) -> Repr.line_to p0 p1 state
              | R.Quadratic t -> Repr.quadratic_to t state
            )
      in Repr.stop state
end