path: root/script.ml

open StdLabels
open Note
open Brr
open Brr_note


module Mouse = Brr_note_kit.Mouse

let get_height el =
  match El.at (Jstr.v "height") el with
  | None -> 0
  | Some att ->
    Option.value ~default:0 (Jstr.to_int att)

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

    (* Adapt the width to the window *)
    El.set_inline_style
      El.Style.width
      (Jstr.v "100%")
      element;

    (* See https://stackoverflow.com/a/14855870/13882826 *)
    El.set_inline_style
      El.Style.height
      (Jstr.v "100%")
      element;

    El.set_prop
      El.Prop.width
      (El.prop Elements.Prop.offsetWidth element)
      element;

    El.set_prop
      El.Prop.height
      (El.prop Elements.Prop.offsetHeight element)
      element;

    El.set_inline_style
      El.Style.width
      (Jstr.v "")
      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 click_event el =
  Evr.on_el
    Ev.click
    Evr.unit
    el

let show_value input =
  El.txt (Jstr.of_float input)

let set_sidebar
  : El.t -> State.state -> unit E.t * float S.t * float S.t *unit E.t
  = fun element state ->

    let open El in

    let delete =
      button
        [ El.i
            ~at:At.[ class' (Jstr.v "fas")
                   ; class' (Jstr.v "fa-times-circle") ]
            []
        ; txt' "Delete "] in

    let delete_event = click_event delete in

    let export =
      button
        [ El.i
            ~at:At.[ class' (Jstr.v "fas")
                   ; class' (Jstr.v "fa-download") ]
            []
        ; txt' "Download"] in
    let export_event = click_event export in

    let nib_size, nib_size_event  =
      Elements.Input.slider
        ~at:At.[ type' (Jstr.v "range")
               ; v (Jstr.v "min") (Jstr.v "1")
               ; v (Jstr.v "max") (Jstr.v "50")
               ; At.value (Jstr.of_float state.width)
               ; id (Jstr.v "nib_size")
               ] in

    let width = El.div [] in
    Elr.def_children
      width
      (nib_size_event
       |> S.map (fun v ->
           [ txt' "Width : "
           ; show_value v ]
         )
      );

    let input_angle, angle_event =
      Elements.Input.slider
        ~at:At.[ type' (Jstr.v "range")
               ; v (Jstr.v "min") (Jstr.v "0")
               ; v (Jstr.v "max") (Jstr.v "90")
               ; At.value (Jstr.of_float state.angle)
               ] in
    let angle = El.div [] in
    Elr.def_children
      angle
      (angle_event
       |> S.map (fun v ->
           [ txt' "Angle : "
           ; show_value v
           ; txt' "°" ]
         )
      );

    let () =
      El.append_children element
        [ hr ()
        ; delete
        ; export
        ; hr ()

        ; width
        ; nib_size

        ; angle
        ; input_angle

        ]
    in
    delete_event, angle_event, nib_size_event, export_event

let backgroundColor = Blog.Nord.nord0
let white = Jstr.v "#eceff4"
let green = Jstr.v "#a3be8c"

(** Redraw the canva on update *)
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 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 =
    begin match state.State.mode, pos with
      | Edit, Some point ->
        State.insert_or_replace state point state.current
      | _ ->
        state.current
    end
  in

  let repr = `Wire in

  Paths.to_canva (module Paths.Path_Builder) current context repr;

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

        let () = match state.mode with
          | Selection id ->
            begin match id = (Paths.Fixed.id path) with
              | true ->
                (* If the element is the selected one, change the color *)
                set_fill_style context (color Blog.Nord.nord8);
                set_stroke_style context (color Blog.Nord.nord8)
              | false  ->
                set_stroke_style context (color white);
                set_fill_style context (color white);
            end
          | _ -> ()
        in

        Paths.to_canva (module Paths.Fixed) path context repr
      );
  ()


let page_main id =

  let delete_event', angle_signal', width_signal', export_event' =
    begin match Blog.Sidebar.get () with
      | None ->
        Jv.throw (Jstr.v "No sidebar")
      | Some el ->

        Blog.Sidebar.clean el;
        set_sidebar el State.init
    end in
  let delete_event = E.map (fun () -> `Delete) delete_event'
  and export_event = E.map (fun () -> `Export) export_event'
  and angle_event = S.changes angle_signal'
                    |> E.map (fun value -> `Angle value)
  and width_event = S.changes width_signal'
                    |> E.map (fun value -> `Width value)
  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 ->

      (* Add the events to the canva :

         - The mouse position is a signal used for both the update and the
           canva refresh

         - Get also the click event for starting to draw
      *)

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

      let tick_event =
        S.sample_filter mouse_position
          ~on:State.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
          ; angle_event
          ; width_event
          ; delete_event
          ; export_event ]
        |> E.map State.do_action
        |> Note.S.accum State.init in

      (* The seconde evaluation is the canva refresh, which only occurs when
         the mouse is updated, or on delete events  *)
      let _ =
        E.select
          [ E.map (fun _ -> ()) (S.changes mouse_position)
          ; E.map (fun _ -> ()) (S.changes angle_signal')
          ; E.map (fun _ -> ()) (S.changes width_signal')
          ; delete_event' ]
        |> fun ev -> E.log ev (fun _ -> on_change canva mouse_position (S.value state) )
                     |> Option.iter Logr.hold in


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

      (* Hold the state *)
      let _ = Logr.hold (S.log state (fun _ -> ())) 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
  )