1 files changed, 326 insertions, 0 deletions
diff --git a/script.it/script.ml b/script.it/script.ml
new file mode 100755
index 0000000..3e52f5c
--- /dev/null
+++ b/script.it/script.ml
@@ -0,0 +1,326 @@
+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)
+               ] 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 render =
+      El.select
+        [ El.option ~at:At.[value (Jstr.v "Fill")]
+            [ txt' "Fill"]
+        ; El.option ~at:At.[value (Jstr.v "Wireframe")]
+            [ txt' "Wireframe"]
+        ; El.option ~at:At.[value (Jstr.v "Ductus")]
+            [ txt' "Ductus"]
+        ] in
+    let rendering' = El.div
+        [ txt' "Rendering : "
+        ; render ] in
+
+    let () =
+      El.append_children element
+        [ hr ()
+        ; delete
+        ; export
+
+        ; rendering'
+
+        ; 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 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 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 = `Fill in
+
+  Path.to_canva (module Path.Path_Builder) current context repr;
+
+  List.iter state.paths
+    ~f:(fun path ->
+
+        let () = match state.mode with
+          | Selection id ->
+            begin match id = (Path.Fixed.id path) 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
+
+        Path.to_canva (module Path.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
+  )