Refactor

3 files changed, 618 insertions, 0 deletions

diff --git a/script.it/dune b/script.it/dune
new file mode 100755
index 0000000..1536f2b
--- /dev/null
+++ b/script.it/dune
@@ -0,0 +1,26 @@
+(executables
+ (names script)
+ (libraries 
+   js_of_ocaml 
+   brr
+   brr.note
+   vg
+   vg.htmlc
+   messages 
+   messages_json
+   worker
+   shapes
+   tools
+   elements
+   blog
+   path
+   )
+ (modes js)
+ (preprocess (pps ppx_hash))
+ (link_flags (:standard -no-check-prims))
+ )
+
+(rule
+  (targets script.js)
+  (deps script.bc.js)
+  (action (run cp %{deps} %{targets})))
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
+  )
diff --git a/script.it/state.ml b/script.it/state.ml
new file mode 100755
index 0000000..5a1ef8f
--- /dev/null
+++ b/script.it/state.ml
@@ -0,0 +1,266 @@
+open StdLabels
+open Brr
+
+let expected_host = Blog.Hash_host.expected_host
+
+let backgroundColor = Blog.Nord.nord0
+
+let timer, tick = Elements.Timer.create ()
+
+type mode =
+  | Edit
+  | Selection of int
+  | Out
+
+(** Events *)
+type canva_events =
+  [ `Click of float * float
+  | `Out of float * float
+  ]
+
+type button_events =
+  [ `Delete
+  | `Export
+  ]
+
+type events =
+  [ canva_events
+  | button_events
+  | `Point of float * (float * float)
+  | `Width of float
+  | `Angle of float
+  ]
+
+(*
+ The state cant hold functionnal values, and thus cannot be used to store
+ elements like timer
+ *)
+type state =
+  { mode : mode
+  ; paths : Path.Fixed.t list
+  ; current : Path.Path_Builder.t
+  ; width : float
+  ; angle : float
+  }
+
+let insert_or_replace state ((x, y) as p) path =
+  let width = state.width
+  and angle = state.angle in
+  let point = Path.Point.create ~x ~y ~angle ~width in
+  match Path.Path_Builder.peek path with
+  | None ->
+    Path.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
+    ) else (
+      Path.Path_Builder.add_point
+        point
+        path
+    )
+
+let threshold = 20.
+
+let check_selection
+  : (float * float) -> Path.Fixed.t list -> (Gg.v2 * Path.Fixed.t) option
+  = fun position paths ->
+    let point = Gg.V2.of_tuple position in
+    (* If the user click on a curve, select it *)
+    let _, res = List.fold_left paths
+        ~init:(threshold, None)
+        ~f:(fun (dist, selection) path ->
+            match Path.Fixed.distance point path with
+            | Some (point', p) when p < dist ->
+              dist, Some (point', path)
+            | _ -> dist, selection
+          ) in
+    res
+
+(** Update the path in the selection with the given function applied to
+    every point *)
+let update_selection id state f =
+
+  let paths = List.map state.paths
+      ~f:(fun path ->
+          let id' = Path.Fixed.id path in
+          match id = id' with
+          | false -> path
+          | true -> Path.Fixed.map_point path f
+        ) in
+  { state with paths }
+
+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 = insert_or_replace
+          state
+          point
+          state.current in
+      { state with current }
+
+    (* Click anywhere while in Out mode, we switch in edition *)
+    | `Click ((x, y) as p), Out ->
+      Elements.Timer.start timer 0.3;
+
+      let width = state.width
+      and angle = state.angle in
+
+      let point =
+        match check_selection p state.paths with
+        | None ->
+          (* Start a new path with the point clicked *)
+          Path.Point.create ~x ~y ~angle ~width
+        | Some (p, _) ->
+          (* If the point is close to an existing path, we use the closest
+             point in the path instead *)
+          let x, y = Gg.V2.to_tuple p in
+          Path.Point.create ~x ~y ~angle ~width
+      in
+
+      let current = Path.Path_Builder.add_point
+          point
+          state.current in
+      { state with current; 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 *)
+
+          let id = Path.Fixed.id selected in
+          Elements.Timer.start timer 0.3;
+          { state with
+            mode = (Selection id)}
+      end
+
+    | `Out point, Edit ->
+      Elements.Timer.stop timer;
+      begin match Path.Path_Builder.peek2 state.current with
+        (* If there is at last two points selected, handle this as a curve
+            creation. And we add the new point in the current path *)
+        | Some _ ->
+
+(*
+          let point = match check_selection point state.paths with
+            | None -> point
+            | Some (p, _) -> Gg.V2.to_tuple p in
+*)
+
+          let current = insert_or_replace state point state.current in
+          let paths =
+            let last = Path.Fixed.to_fixed
+                (module Path.Path_Builder)
+                current
+            in
+            last::state.paths
+          and current = Path.Path_Builder.empty in
+          { state with
+            mode = Out
+          ; paths; current }
+
+        (* Else, check if there is a curve undre the cursor, and remove it *)
+        | None ->
+          let current = Path.Path_Builder.empty in
+          begin match check_selection point state.paths with
+            | None ->
+              { state with
+                mode = Out
+              ; current
+              }
+            | Some (_, selected) ->
+              let id = Path.Fixed.id selected in
+              { state with
+                mode = (Selection id)
+              ; current }
+          end
+      end
+    | `Delete, Selection id ->
+      let paths = List.filter state.paths ~f:(fun p -> Path.Fixed.id p != id) in
+      { state with paths ; mode = Out}
+
+
+    | `Export, _ ->
+
+      let my_host = Uri.host @@ Window.location @@ G.window in
+
+      if (Hashtbl.hash my_host) = expected_host then (
+        (* Convert the path into an sVG element *)
+        let svg = Layer.Svg.svg
+            ~at:Brr.At.[
+                v (Jstr.v "xmlns") (Jstr.v "http://www.w3.org/2000/svg")
+              ; v (Jstr.v "xmlns:xlink") (Jstr.v "http://www.w3.org/1999/xlink") ]
+            (List.map state.paths
+               ~f:(fun path ->
+
+                   Path.to_svg
+                     ~color:backgroundColor
+                     (module Path.Fixed)
+                     path
+                     `Fill
+
+                 )) in
+        let content = El.prop Elements.Prop.outerHTML svg in
+
+        let btoa = Jv.get Jv.global "btoa" in
+        let base64data = Jv.apply btoa
+            [| Jv.of_jstr content |] in
+
+        (* Create the link to download the the element, and simulate a click on it *)
+        let a = El.a
+            ~at:At.[
+                href Jstr.( (v "data:image/svg+xml;base64,") + (Jv.Id.of_jv base64data))
+              ; v (Jstr.v "download") (Jstr.v "out.svg")
+              ]
+            [] in
+        El.click a
+      );
+      state
+
+    (* Change the select curve with the appropriate setting *)
+    | `Angle angle, Selection s ->
+      let state = { state with angle } in
+      update_selection s state (fun p -> Path.Point.set_angle p angle)
+    | `Width width, Selection s ->
+      let state = { state with width } in
+      update_selection s state (fun p -> Path.Point.set_width p width)
+
+    | `Angle angle, _ ->
+      { state with angle}
+    | `Width width, _ ->
+      { state with width}
+
+    | `Delete, Out
+      -> state
+
+    (* Some non possible cases *)
+    | `Out _, Out
+    | `Point _, Out
+    | `Point _, Selection _
+    | `Out _, Selection _
+    | `Click _, Edit
+    | `Delete, Edit
+      -> state
+
+let init =
+  { paths = []
+  ; current = Path.Path_Builder.empty
+  ; mode = Out
+  ; angle = 30.
+  ; width = 10.
+  }