path: root/script.it/script.ml

open StdLabels
open Note
open Brr
open Brr_note
module State = Script_state.State
module Selection = Script_state.Selection
module Path = Script_path

let post : Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit =
  Brr_webworkers.Worker.post


type canva_events =
  [ `MouseDown of float * float
  | `Out of float * float
  ]

(** 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 ->
  (* 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 -> `MouseDown c)
  in

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

  let position = Brr_note_kit.Mouse.pos mouse in

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

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


let click_event el = Evr.on_el Ev.click Evr.unit el

type 'a param_events =
  { width : float S.t
  ; angle : float S.t
  ; export : unit E.t
  ; delete : unit E.t
  ; rendering : State.event E.t
  }

type slider =
  { input : El.t
  ; legend : El.t
  }

let set_sidebar : El.t -> State.state -> _ param_events * slider * slider =
 fun element state ->
  let delete =
    El.button
      [ El.i
          ~at:At.[ class' (Jstr.v "fas"); class' (Jstr.v "fa-times-circle") ]
          []
      ; El.txt' "Delete "
      ]
  in

  let delete_event = click_event delete in

  let export =
    El.button
      [ El.i ~at:At.[ class' (Jstr.v "fas"); class' (Jstr.v "fa-download") ] []
      ; El.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)
          ]
  in

  let width = El.div [] in
  let width_slider = { input = nib_size; legend = width } in

  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
  let angle_slider = { input = input_angle; legend = angle } in

  let render =
    El.select
      [ El.option ~at:At.[ value (Jstr.v "1") ] [ El.txt' "Fill" ]
      ; El.option ~at:At.[ value (Jstr.v "3") ] [ El.txt' "Ductus" ]
      ]
  in

  let rendering' = El.div [ El.txt' "Rendering : "; render ] in

  let render_event =
    Evr.on_el
      Ev.change
      (fun _ ->
        let raw_value = El.prop El.Prop.value render |> Jstr.to_int in
        let render_type =
          match raw_value with
          | Some 1 -> `Fill
          | Some 2 -> `Line
          | Some 3 -> `Ductus
          | _ -> `Fill
        in

        let module M = struct
          type t = Layer.Paths.printer

          let process t state = { state with State.rendering = t }
        end in
        State.dispatch (module M) render_type )
      rendering'
  in

  let () =
    El.append_children
      element
      [ El.hr ()
      ; delete
      ; export
      ; rendering'
      ; El.hr ()
      ; width
      ; nib_size
      ; angle
      ; input_angle
      ]
  in
  ( { delete = delete_event
    ; angle = angle_event
    ; width = nib_size_event
    ; export = export_event
    ; rendering = render_event
    }
  , angle_slider
  , width_slider )


let backgroundColor = Blog.Nord.nord0

let white = Jstr.v "#eceff4"

let green = Jstr.v "#a3be8c"

let draw_point point context =
  let module Cd2d = Brr_canvas.C2d in
  let x, y = Gg.V2.to_tuple @@ Path.Point.get_coord point in
  Cd2d.stroke_rect ~x:(x -. 5.) ~y:(y -. 5.) ~w:10. ~h:10. context


(** Redraw the canva on update *)
let on_change canva mouse_position timer state =
  let pos = S.rough_value mouse_position in
  let pos_v2 = Option.map Gg.V2.of_tuple pos in

  let module Cd2d = Brr_canvas.C2d in
  let w, h =
    Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva)
  in

  let context = Cd2d.create canva in

  Cd2d.set_fill_style context (Cd2d.color backgroundColor);
  Cd2d.fill_rect context ~x:0.0 ~y:0.0 ~w ~h;
  Cd2d.set_stroke_style context (Cd2d.color white);
  Cd2d.set_fill_style context (Cd2d.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 current =
    match (state.State.mode, pos) with
    | Edit, Some point ->
        let stamp = Elements.Timer.delay timer in
        State.insert_or_replace state point stamp state.current
    | _ -> state.current
  in

  let back =
    Path.Path_Builder.map current (fun pt ->
        Path.Point.copy pt @@ Path.Point.get_coord' pt )
  in
  Layer.Paths.to_canva
    (module Path.Path_Builder)
    (current, back)
    context
    state.rendering;

  List.iter state.paths ~f:(fun path ->
      let () =
        match state.mode with
        | Selection (Path id) | Selection (Point (id, _)) ->
          ( match id = path.Outline.id with
          | true ->
              (* If the element is the selected one, change the color *)
              Cd2d.set_fill_style context (Cd2d.color Blog.Nord.nord8);
              Cd2d.set_stroke_style context (Cd2d.color Blog.Nord.nord8)
          | false ->
              Cd2d.set_stroke_style context (Cd2d.color white);
              Cd2d.set_fill_style context (Cd2d.color white) )
        | _ -> ()
      in

      let p = path.Outline.path in
      Layer.Paths.to_canva
        (module Path.Fixed)
        (p, path.Outline.back)
        context
        state.rendering );

  (* Draw the selected path, and operate the modifications directly as a preview  *)
  let () =
    match state.mode with
    | Selection t ->
        Cd2d.set_stroke_style context (Cd2d.color white);
        ( match (pos_v2, Selection.find_selection t state.paths) with
        (* The selected element does not exist, just do nothing *)
        | _, None -> ()
        (* There is no click on the canva, print the line *)
        | None, Some (Path outline) ->
            Layer.Paths.to_canva
              (module Path.Fixed)
              (outline.path, outline.back)
              context
              `Line
        (* The user is modifiying the path *)
        | Some pos_v2, Some (Path outline) ->
            (* Translate the path *)
            let delta = Gg.V2.(pos_v2 - state.State.mouse_down_position) in
            let path =
              Path.Fixed.map outline.Outline.path (fun pt ->
                  Path.Point.get_coord pt
                  |> Gg.V2.add delta
                  |> Path.Point.copy pt )
            in
            Layer.Paths.to_canva (module Path.Fixed) (path, path) context `Line
            (* The user is modifiying the point *)
        | Some pos_v2, Some (Point (outline, point))
          when Elements.Timer.delay timer > 0.3 ->
            let point' = Path.Point.copy point pos_v2 in
            let path =
              match Path.Fixed.replace_point outline.Outline.path point' with
              | None -> outline.Outline.path
              | Some p -> p
            in

            Layer.Paths.to_canva (module Path.Fixed) (path, path) context `Line;
            draw_point point context
        | _, Some (Point (outline, point)) ->
            Layer.Paths.to_canva
              (module Path.Fixed)
              (outline.path, outline.back)
              context
              `Line;
            draw_point point context )
    | _ -> ()
  in
  ()


let spawn_worker () =
  try Ok (Brr_webworkers.Worker.create (Jstr.v "worker.js")) with
  | Jv.Error e -> Error e


let page_main id =
  let timer, tick = Elements.Timer.create () in

  let parameters, angle_element, width_slider =
    match Blog.Sidebar.get () with
    | None -> Jv.throw (Jstr.v "No sidebar")
    | Some el ->
        Blog.Sidebar.clean el;
        set_sidebar el State.init
  in

  match Jv.is_none id with
  | true -> Console.(error [ str "No element with id '%s' found"; id ])
  | false ->
    ( match spawn_worker () with
    | Error e ->
        El.set_children
          (Jv.Id.of_jv id)
          [ El.p El.[ txt (Jv.Error.message e) ] ]
    | Ok worker ->
        let worker_event, worker_send = E.create () in

        let delete_event =
          E.map
            (fun () ->
              let module Delete = Script_event.Delete in
              State.dispatch (module Delete) Delete.{ worker } )
            parameters.delete
        and export_event =
          E.map
            (fun () ->
              let module Export = Script_event.Export in
              State.dispatch (module Export) () )
            parameters.export
        and angle_event =
          S.changes parameters.angle
          |> E.map (fun value ->
                 let module Property = Script_event.Property in
                 State.dispatch
                   (module Property)
                   Property.{ value; worker; prop = `Angle } )
        and width_event =
          S.changes parameters.width
          |> E.map (fun value ->
                 let module Property = Script_event.Property in
                 State.dispatch
                   (module Property)
                   Property.{ value; worker; prop = `Width } )
        and worker_event =
          Note.E.filter_map
            (function
              | `Other t ->
                  Console.(log [ t ]);
                  None
              | `Complete outline ->
                  let module Complete_path = Script_event.Complete_path in
                  Some (State.dispatch (module Complete_path) outline) )
            worker_event
        in

        let my_host = Uri.host @@ Window.location @@ G.window in
        ( if Hashtbl.hash my_host = Blog.Hash_host.expected_host
        then
          let target = Brr_webworkers.Worker.as_target worker in
          Ev.listen
            Brr_io.Message.Ev.message
            (fun t -> Ev.as_type t |> Brr_io.Message.Ev.data |> worker_send)
            target );

        (* 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 canva_events =
          Note.E.map
            (function
              | `MouseDown c ->
                  let module MouseDown = Script_event.Mouse_down in
                  State.dispatch
                    (module MouseDown)
                    MouseDown.{ position = c; timer }
              | `Out c ->
                  let module Click = Script_event.Click in
                  State.dispatch
                    (module Click)
                    Click.{ point = c; worker; timer } )
            canva_events
        in

        let tick_event =
          S.sample_filter mouse_position ~on:tick (fun pos f ->
              let module Tick = Script_event.Tick in
              Option.map (fun p -> State.dispatch (module Tick) (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 =
          State.run
            State.init
            (E.select
               [ worker_event
               ; canva_events
               ; tick_event
               ; angle_event
               ; width_event
               ; delete_event
               ; export_event
               ; parameters.rendering
               ] )
        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 _ -> ()) parameters.rendering
            ; E.map (fun _ -> ()) worker_event
            ; parameters.delete
            ]
          |> fun ev ->
          E.log ev (fun _ ->
              on_change canva mouse_position timer (S.value state) )
          |> Option.iter Logr.hold
        in

        (* Ajust the angle slide according to the state *)
        let angle_signal = S.map (fun s -> Jstr.of_float s.State.angle) state in
        let _ =
          Elr.def_prop Elements.Prop.value angle_signal angle_element.input
        and _ =
          Elr.def_children
            angle_element.legend
            (S.map
               (fun v -> [ El.txt' "Angle : "; El.txt v; El.txt' "°" ])
               angle_signal )
        in

        let width_signal = S.map (fun s -> Jstr.of_float s.State.width) state in
        let _ = Elr.def_prop Elements.Prop.value width_signal width_slider.input
        and _ =
          Elr.def_children
            width_slider.legend
            (S.map (fun v -> [ El.txt' "Width : "; El.txt v ]) width_signal)
        in

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

        (* Hold the state *)
        let _ = Logr.hold (S.log state (fun _ -> ())) in
        () )


let () =
  let open Jv in
  let drawer = obj [| ("run", repr page_main) |] in

  set global "drawer" drawer