path: root/script.ml

open StdLabels
open Note
open Brr

module Timer = Events.Timer

module Point = Draw.Point
module Path = Draw

module Path_Builder = Path.Builder.Make(Point)
module Path_Printer = Path_Builder.Draw(Path.WireFrame)

type mode =
  | Edit
  | Out

type current = Path_Builder.t

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
        ~normalize:false
        (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 insert_or_replace ((x, y) as p) path =
  let point = Point.create x y in
  match Path_Builder.peek path with
  | None ->
    Path_Builder.add_point
      point
      path
  | Some p1 ->
    let open Gg.V2 in

    let p1' = Point.get_coord p1 in

    let dist = (norm (p1' - (of_tuple p))) in
    if dist < 0.05 then (
      path
    ) else (
      Path_Builder.add_point
        point
        path
    )

let do_action
  : events -> state -> state
  = fun event state ->
    match event, state.mode with
    | `Point (_delay, (x, y)), Edit ->
      (* Add the point in the list *)
      let current= Path_Builder.add_point
          (Point.create x y)
          state.current in
      { state with current }

    | `Click _, Out ->
      Timer.start state.timer 0.3;
      { state with mode = Edit }
    | `Out point, Edit ->
      Timer.stop state.timer;
      let current = insert_or_replace point state.current in
      let beziers = Draw.to_path @@ Path_Builder.get current in
      let paths = beziers::state.paths
      and current = Path_Builder.empty 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 current =
    match state.mode, pos with
    | Edit, Some (x, y) ->
      Path_Builder.add_point (Point.create x y) state.current
    | _ ->
      state.current
  in

  let path = Draw.WireFrame.get @@ Path_Printer.draw current  in
  stroke context path;

(*
  let points, beziers = Path_Builder.get current in

  let path = draw_path area (points) 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 = Path_Builder.empty
    ; 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