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

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 update t state = { state with State.rendering = t }
            end
            in

            State.E
              ( render_type
              ,  (module M: State.Event with type t = Layer.Paths.printer ))

          )  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 =
    begin 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
    end
  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, _)) ->
            begin 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);
            end
          | _ -> ()
        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);
      begin 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 = begin match Path.Fixed.replace_point outline.Outline.path point' with
            | None -> outline.Outline.path
            | Some p -> p
          end 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

      end
    | _ -> ()
  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 =
    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

  begin 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.E
                 ( Delete.{ worker }
                 , (module Delete: State.Event with type t = Delete.t )))
            parameters.delete

        and export_event =
          E.map (fun () ->
              let module Export = Script_event.Export in
              State.E
                ( ()
                , (module Export: State.Event with type t = Export.t )))
            parameters.export
        and angle_event = S.changes parameters.angle
                          |> E.map (fun value ->
                              let module Property = Script_event.Property in
                              State.E
                                ( Property.{ value ; worker ; prop = `Angle }
                                , (module Property: State.Event with type t = Property.t )))

        and width_event = S.changes parameters.width
                          |> E.map (fun value ->
                              let module Property = Script_event.Property in
                              State.E
                                ( Property.{ value ; worker ; prop = `Width }
                                , (module Property: State.Event with type t = Property.t )))
        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.E
                    ( outline
                    , (module Complete_path: State.Event with type t = Complete_path.t ))))

            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.E
                  ( MouseDown.{ position = c ; timer }
                  , (module MouseDown: State.Event with type t = MouseDown.t ))

              | `Out c ->
                let module Click = Script_event.Click in
                State.E
                  ( Click.{ point = c ; worker; timer }
                  , (module Click: State.Event with type t = Click.t ))
            ) 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.E
                     ( (f, p)
                     , (module Tick: State.Event with type t = Tick.t )))
                 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
        ()

  end

let () =

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

  set global "drawer" drawer