path: root/script.ml

open StdLabels
open Note
open Brr

module Timer = Events.Timer

module Repr = Path.FillPrinter

module Path_Builder = Path.Builder.Make(Path.Point)
module Path_Printer = Path_Builder.Draw(Repr)
module Fixed_Printer = Path_Builder.DrawFixed(Repr)

type mode =
  | Edit
  | Selection of Path_Builder.fixedPath
  | Out

let timer, tick = Timer.create ()

type current = Path_Builder.t

(*
 The state cannt hold functionnal values, and thus cannot be used to store
 elements like timer
 *)
type state =
  { mode : mode
  ; paths : Path_Builder.fixedPath list
  ; current : current
  }

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

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

type canva_signal = Path.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 = Path.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' = Path.Point.get_coord p1 in

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

let check_selection position paths =
  let point = Gg.V2.of_tuple position in
  (* If the user click on a curve, select it *)
  List.fold_left paths
    ~init:None
    ~f:(fun selection path ->

        match selection with
        | Some p -> Some p
        | None ->
          (* TODO : Add a method in the point module *)
          begin match Path_Builder.distance point path with
            | Some p when p < 20. ->
              Some path
            | _ -> None
          end
      )

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 current, fixed_path = insert_or_replace
          point
          state.current in
      let paths = match fixed_path with
        | None -> state.paths
        | Some p -> p::state.paths in
      { state with current; paths }

    (* Click anywhere while in Out mode, we switch in edition *)
    | `Click _, Out ->
      Timer.start timer 0.3;
      { state with mode = Edit }

    (* Click anywhere while in selection mode, we either select another path,
       or switch to Out mode*)
    | `Click position, (Selection _) ->
      begin match check_selection position state.paths with
        | None ->
          { state with
            mode = Out }
        | Some selected ->

          (* Start the timer in order to handle the mouse moves *)
          Timer.start timer 0.3;
          { state with
            mode = (Selection selected)}
      end

    | `Out point, Edit ->
      Timer.stop timer;
      begin match Path_Builder.peek2 state.current with
        (** If there is at last two points selected, handle this as a curve
            creation *)
        | Some _ ->
          let current, fixed_path = insert_or_replace point state.current in
          let paths = match fixed_path with
            | None -> Path_Builder.to_fixed current::state.paths
            | Some p -> p::state.paths
          and current = Path_Builder.empty in
          { mode = Out
          ; paths; current }

        (** Else, check if there is a curve undre the cursor, and remove it *)
        | None ->
          let current = Path_Builder.empty in
          begin match check_selection point state.paths with
            | None ->
              { state with
                mode = Out
              ; current
              }
            | Some selected ->
              { state with
                mode = (Selection selected)
              ; current }
          end
      end


    | _ -> state

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

let on_change canva mouse_position state =
  let module Path' = Path in
  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, paths =
    begin match state.mode, pos with
      | Edit, Some point ->
        begin match insert_or_replace point state.current with
          | current, None -> current, state.paths
          | current, Some p -> current, p::state.paths
        end
      | _ ->
        state.current, state.paths
    end
  in

  let path = Repr.get
    @@ Path_Printer.draw
      current
      (Repr.create_path (fun p -> fill context p)) in
  stroke context path;

  List.iter paths
    ~f:(fun path ->
        let path = Repr.get
          @@ Fixed_Printer.draw
            path
            (Repr.create_path (fun p -> fill context p)) in
        stroke context path;
      );


  (* If there is a selection draw it *)
  let () = match state.mode with
    | Selection path ->
      set_fill_style context (color nord8);
      set_stroke_style context (color nord8);
      let path = Repr.get
        @@ Fixed_Printer.draw
          path
          (Repr.create_path (fun p -> fill context p)) in
      stroke context path;
    | _ -> () in
  ()


let page_main id =

  let init =
    { paths = []
    ; current = Path_Builder.empty
    ; mode = Out
    } 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