path: root/script.ml

open StdLabels
open Note
open Brr

module Timer = Events.Timer

module Point = Draw.Point

type mode =
  | Edit
  | Out

type current =
  { points : Point.t list (* The list of points to draw *)
  ; beziers : Shapes.Bezier.t list (* All the points already fixed *)
  }

type state =
  { mode : mode
  ; paths : Draw.t list (* All the previous paths *)
  ; current : current
  ; timer : Timer.t
  }

(** Events *)
type canva_events =
  [ `Click of float * float
  | `Out of float * float
  ]

type events =
  [ canva_events
  | `Point of float * (float * float) ]

type canva_signal = Point.t

module Mouse = Brr_note_kit.Mouse

(** Create the element in the page, and the event handler *)
let canva
  : Brr.El.t -> [> canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t
  = fun element ->
    let module C = Brr_canvas.Canvas in
    let c = C.of_el element in

    (* Mouse events *)
    let mouse = Brr_note_kit.Mouse.on_el
        (fun x y -> (x, y)) element in

    let click =
      Brr_note_kit.Mouse.left_down mouse
      |> E.map (fun c -> `Click c) in

    let up =
      Brr_note_kit.Mouse.left_up mouse
      |> E.map (fun c -> `Out c) in

    let position = Mouse.pos mouse in

    let pos = S.l2 (fun b pos ->
        if b then
          Some pos
        else
          None
      ) (Mouse.left mouse) position in

    E.select [click; up], pos, c

let do_action
  : events -> state -> state
  = fun event state ->
    match event, state.mode with
    | `Point (_delay, point), Edit ->
      (* Add the point in the list *)
      let points, beziers = Point.add_point_in_path
          point
          state.current.points
          state.current.beziers in

      let current= {points; beziers} in

      { state with current }
    | `Click _, Out ->
      Timer.start state.timer 0.3;
      { state with mode = Edit }
    | `Out p, Edit ->
      Timer.stop state.timer;
      (* Add the point in the list *)

      let points, beziers = match state.current.points, state.current.beziers with
        | hd::(tl), beziers ->

          let open Gg.V2 in
          let p' = of_tuple p
          and hd' = Point.get_coord hd in
          if (norm (hd' - p' )) < 0.05 then
            (Point.create (fst p)  (snd p))::tl
          , beziers
          else (
            Point.add_point_in_path
              p
              state.current.points
              state.current.beziers
          )
        | _ ->
          Point.add_point_in_path
            p
            state.current.points
            state.current.beziers
      in


(*
      let points, beziers = Point.add_point_in_path
          p
          state.current.points
          state.current.beziers in
*)
      let beziers = Draw.to_path (points, beziers) in

      let paths = beziers::state.paths
      and current = { points = []; beziers = []} in
      { state with mode = Out; paths; current }
    | _ -> state

let backgroundColor = Jstr.v "#2e3440"
let white = Jstr.v "#eceff4"
let green = Jstr.v "#a3be8c"
let nord8 = Jstr.v "#81a1c1"

let draw
  : ?connexion:Gg.v2 -> area:Gg.v2 -> Point.t list -> Brr_canvas.C2d.Path.t
  = fun ?connexion ~area points ->

    let open Brr_canvas.C2d in
    let path = Path.create () in


    let () = match points with
      | [] -> ()
      | hd::_ ->
        let vect = Draw.Line (hd, Point.create 0. 0.) in
        Draw.move_to ~area path vect in

    let _ = match points with
      | []
      | _::[] -> ()
      | _::p1::[] ->
        Draw.line area ~p1 path
      | p0::p1::p2::[] ->
        Draw.three_points area ~p0 ~p1 ~p2 path
      | _ ->
        Draw.multi_points ?connexion area points path
    in path

let draw_path area points beziers =
  let open Brr_canvas.C2d in
  let connexion = match beziers with
    | [] -> None
    | hd ::_ -> Some hd.Shapes.Bezier.p1 in
  (* Firt draw all the points most recent points *)
  let path = draw ?connexion ~area points in

  (* Then add the fixed ones *)
  let path = List.fold_left beziers
      ~init:path
      ~f:(fun path bezier ->

          let cx, cy = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl0
          and cx', cy' = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl1
          and x, y = Draw.translate_point ~area bezier.Shapes.Bezier.p1 in

          Path.ccurve_to path
            ~cx ~cy
            ~cx' ~cy'
            ~x ~y;
          path
        ) in
  path

let on_change canva mouse_position state =
  let open Brr_canvas.C2d in

  let w, h = Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva) in
  let area = Gg.V2.v w h in

  let context = create canva in

  set_fill_style context (color backgroundColor);
  fill_rect context
    ~x:0.0
    ~y:0.0
    ~w
    ~h;
  set_stroke_style context (color white);
  set_fill_style context (color white);

  (* If we are in edit mode, we add a point under the cursor.

     Otherwise, we would only display the previous registered point, which can
     be far away in the past, and would give to the user a sensation of lag.

  *)
  let pos = S.rough_value mouse_position in
  let points =
    match state.mode, pos with
    | Edit, Some (x, y) ->
      (Point.create x y)::state.current.points
    | _ ->
      set_image_smoothing_enabled context true;
      set_image_smoothing_quality context Image_smoothing_quality.high;
      state.current.points in

  let path = draw_path area (points) state.current.beziers in
  stroke context path;

  List.iter state.paths
    ~f:(fun path ->

        (* This is ugly, and probably non efficient, but is an appropriate solution for
           the cases of overlapping path *)
        match path.Draw.path with
        | Draw.Curve beziers ->

          Array.iter beziers
            ~f:(fun bezier ->

                let b = Draw.Curve [|bezier|] in
                let p = Path.create () in
                Draw.move_to ~area p b;
                Draw.draw ~area p b;
                Draw.go_back ~area p b;
                Path.close p;
                fill context p;
                stroke context p


              )

        | _ ->

          let p = Path.create () in
          Draw.move_to ~area p path.Draw.path;
          Draw.draw ~area p path.Draw.path;
          Draw.go_back ~area p path.Draw.path;
          Path.close p;
          fill context p;
          stroke context p
      );
  ()


let page_main id =

  let timer, tick = Timer.create () in

  let init =
    { paths = []
    ; current = { points = []
                ; beziers = [] }
    ; mode = Out
    ; timer
    } in

  (*begin match Document.find_el_by_id G.document id with*)
  begin match (Jv.is_none id) with
    | true -> Console.(error [str "No element with id '%s' found"; id])
    | false ->

      let canva_events, mouse_position, canva = canva (Jv.Id.of_jv id) in

      let tick_event =
        S.sample_filter mouse_position
          ~on:tick
          (fun pos f -> Option.map (fun p -> `Point (f, p)) pos ) in

      (* The first evaluation is the state. Which is the result of all the
         successives events to the initial state *)
      let state =
        E.select [canva_events; tick_event]
        |> E.map do_action
        |> Note.S.accum init in

      (* The seconde evaluation is the canva refresh, which only occurs when
         the mouse is updated *)
      let v =
        E.map (fun _ -> state) (S.changes mouse_position)
        |> E.map (fun x -> on_change canva mouse_position (S.value x) )
        |> fun ev -> E.log ev (fun _ -> ()) in

      (* Draw the canva for first time *)
      on_change canva mouse_position init;

      let _ = Logr.hold (S.log state (fun _ -> ())) in
      let _ = match v with
        | None -> ()
        | Some log -> Logr.hold log in
      ()

  end

let () =
  if Brr_webworkers.Worker.ami () then
    ()
  else
    let open Jv in
    let drawer  = obj
        [| "run", (repr page_main)
        |] in

    set global "drawer" drawer