Update

5 files changed, 173 insertions, 175 deletions

diff --git a/script.it/script.ml b/script.it/script.ml
index 200d118..a21afa9 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -332,10 +332,8 @@ let on_change canva mouse_position timer state =
   ()
 
 let spawn_worker () =
-  try
-    Ok (Brr_webworkers.Worker.create (Jstr.v "worker.js"))
-  with
-  | Jv.Error e -> Error e
+  try  Ok (Brr_webworkers.Worker.create (Jstr.v "worker.js"))
+  with Jv.Error e -> Error e
 
 let page_main id =
 
@@ -351,17 +349,6 @@ let page_main id =
         set_sidebar el State.init
     end in
 
-
-  let delete_event = E.map (fun () -> `Delete) parameters.delete
-  and export_event = E.map (fun () -> `Export) parameters.export
-  and angle_event = S.changes parameters.angle
-                    |> E.map (fun value -> `Angle value)
-  and width_event = S.changes parameters.width
-                    |> 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 ->
@@ -369,7 +356,22 @@ let page_main id =
       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 delete_event = E.map
+            (fun () -> `Generic (
+                 let module Delete = Script_event.Delete in
+                 State.E ( Delete.{ worker }
+                         , (module Delete: State.Handler with type t = Delete.t)
+                         )))
+            parameters.delete
+
+        and export_event = E.map (fun () -> `Export) parameters.export
+        and angle_event = S.changes parameters.angle
+                          |> E.map (fun value -> `Angle value)
+        and width_event = S.changes parameters.width
+                          |> E.map (fun value -> `Width value)
+        in
 
         let worker_event, worker_send = E.create () in
         let my_host = Uri.host @@ Window.location @@ G.window in
@@ -389,24 +391,27 @@ let page_main id =
 
            - 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 -> `MouseDown c
-              | `Out c ->
-
+              | `MouseDown c ->
+                let module MouseDown = Script_event.Mouse_down in
                 `Generic (
                   State.E
-                    ( Script_event.Out.{ point = c
-                                       ; worker
-                                       ; timer
-                                       }
-                    , (module Script_event.Out: State.Handler with type t = Script_event.Out.t)
-                    )
+                    ( MouseDown.{ position = c
+                                ; timer
+                                }
+                    , (module MouseDown: State.Handler with type t = MouseDown.t)))
 
-                )
+              | `Out c ->
+                let module Out = Script_event.Out in
+                `Generic (
+                  State.E
+                    ( Out.{ point = c
+                          ; worker
+                          ; timer
+                          }
+                    , (module Out: State.Handler with type t = Out.t)))
 
             ) canva_events in
 
@@ -419,7 +424,7 @@ let page_main id =
            successives events to the initial state *)
         let state =
           Application.run
-            (State.do_action worker timer)
+            (State.do_action worker)
             State.init
             (E.select
                [ worker_event
diff --git a/script.it/script_event/delete.ml b/script.it/script_event/delete.ml
new file mode 100755
index 0000000..edd5d23
--- /dev/null
+++ b/script.it/script_event/delete.ml
@@ -0,0 +1,31 @@
+(** Delete the selected element *)
+
+open StdLabels
+module State = Script_state.State
+module Selection = Script_state.Selection
+
+type t = { worker : Brr_webworkers.Worker.t }
+
+(* Click anywhere while in Out mode, we switch in edition *)
+let apply { worker } state =
+  match state.State.mode with
+  | Selection (Path id) ->
+    let paths = List.filter
+        state.State.paths
+        ~f:(fun p ->
+            p.Outline.id != id
+          ) in
+    { state with paths ; mode = Out}
+
+  | Selection (Point (id, point)) ->
+    List.iter
+      state.State.paths
+      ~f:(fun p ->
+          let id' = p.Outline.id in
+          match id' = id with
+          | false -> ()
+          | true -> State.post worker (`DeletePoint (point, p))
+        );
+    { state with mode = Selection (Path id) }
+
+  | _ -> state
diff --git a/script.it/script_event/mouse_down.ml b/script.it/script_event/mouse_down.ml
new file mode 100755
index 0000000..04ea2fd
--- /dev/null
+++ b/script.it/script_event/mouse_down.ml
@@ -0,0 +1,84 @@
+module State = Script_state.State
+module Selection = Script_state.Selection
+
+type t = { position : float * float
+         ; timer  : Elements.Timer.t }
+
+let apply { position; timer } state =
+  match state.State.mode with
+
+  | Out ->
+    let x, y = position in
+    Elements.Timer.start timer 0.3;
+
+    let width = state.width
+    and angle = state.angle in
+
+    let stamp = 0. in
+    let point =
+      match Selection.get_from_paths position state.paths with
+      | _, None ->
+        (* Start a new path with the point clicked *)
+        Path.Point.create ~x ~y ~angle ~width ~stamp
+      | _, 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 ~stamp
+    in
+
+    let current = Path.Path_Builder.add_point
+        point
+        state.current in
+    { state with
+      current
+    ; mode = Edit
+    ; mouse_down_position = Gg.V2.of_tuple (x, y)}
+
+  | (Selection (Path id))
+  | (Selection (Point (id, _))) ->
+
+    let get_any () =
+      begin match Selection.get_from_paths position state.paths with
+        | _, None ->
+          { state with
+            mode = Out
+          ; mouse_down_position = Gg.V2.of_tuple position }
+        | dist, Some selection ->
+          let _, outline, _, _ = selection in
+          if outline.Outline.id != id then (
+            let mouse_down_position = Gg.V2.of_tuple position in
+            State.select_segment position selection { state with mouse_down_position } dist
+          ) else
+            (* On the same segment, check for a point *)
+            let selection = Selection.select_point outline (Gg.V2.of_tuple position) in
+            match selection with
+            | Path _ ->
+              { state with
+                mode = Selection selection
+              ; mouse_down_position = Gg.V2.of_tuple position }
+            | Point (_, pt) ->
+              (* In order to handle the point move, start the timer *)
+              Elements.Timer.start timer 0.3;
+              { state with
+                mode = Selection selection
+              ; angle = Path.Point.get_angle pt
+              ; width = Path.Point.get_width pt
+              ; mouse_down_position = Gg.V2.of_tuple position }
+      end
+    in
+    (* First, check for a point in the selected path. If any of them in
+       found, check anything to select in all the elements *)
+    begin match Outline.find state.paths id with
+      | None -> get_any ()
+      | Some outline ->
+        begin match Selection.select_point outline (Gg.V2.of_tuple position) with
+          | Path _ -> get_any ()
+          | other ->
+            Elements.Timer.start timer 0.3;
+            {state with
+             mode = Selection other
+           ; mouse_down_position = Gg.V2.of_tuple position }
+        end
+    end
+  | Edit -> state
diff --git a/script.it/script_event/out.ml b/script.it/script_event/out.ml
index 45f05d3..b8b8599 100755
--- a/script.it/script_event/out.ml
+++ b/script.it/script_event/out.ml
@@ -8,6 +8,25 @@ type t = { point  : float * float
          ; worker : Brr_webworkers.Worker.t
          }
 
+(** Long click, move the selected element if any *)
+let longClick mouse_coord state worker = function
+  | State.Selection t ->
+    let mouse_v2 = Gg.V2.of_tuple mouse_coord in
+    begin match Selection.find_selection t state.State.paths with
+      | None -> state
+      | Some (Point (path, point)) ->
+        let point' = Path.Point.copy point mouse_v2 in
+        State.post worker (`TranslatePoint (point', path));
+        (* Just replace the position of the selected point *)
+        { state with mode = Selection (Point (path.id, point')) }
+      | Some (Path path) ->
+        let delta = Gg.V2.(mouse_v2 - state.State.mouse_down_position) in
+        State.post worker (`TranslatePath (path, delta));
+        state
+    end
+  (*  TODO Long click in out mode should translate the slate *)
+  | _ -> state
+
 let apply {point; timer ; worker} state =
   match state.State.mode with
 
@@ -61,9 +80,9 @@ let apply {point; timer ; worker} state =
         end
     end
 
-  | mode when Elements.Timer.delay timer < 0.3 ->
-    State.click state mode
+  | _ when Elements.Timer.delay timer < 0.3 ->
+    state
 
   | _ ->
-    State.longClick point state worker state.mode
+    longClick point state worker state.mode
 
diff --git a/script.it/state/state.ml b/script.it/state/state.ml
index d7cb13e..4cf6992 100755
--- a/script.it/state/state.ml
+++ b/script.it/state/state.ml
@@ -7,14 +7,6 @@ type mode =
   | Out
 
 (** Events *)
-type canva_events =
-  [ `MouseDown of float * float
-  ]
-
-type button_events =
-  [ `Delete
-  | `Export
-  ]
 type render_event =
   [
     `Rendering of Layer.Paths.printer
@@ -47,8 +39,7 @@ end
 type t = E : 'a * (module Handler with type t = 'a) -> t
 
 type events =
-  [ canva_events
-  | button_events
+  [ `Export
   | render_event
   | worker_event
   | `Point of float * (float * float)
@@ -98,30 +89,6 @@ let select_segment _ (_, selected, p0, p1) state dist =
   ; angle
   ; width }
 
-(** Delete the selected element *)
-let delete state worker =
-  match state.mode with
-  | Selection (Path id) ->
-    let paths = List.filter
-        state.paths
-        ~f:(fun p ->
-            p.Outline.id != id
-          ) in
-    { state with paths ; mode = Out}
-
-  | Selection (Point (id, point)) ->
-    List.iter
-      state.paths
-      ~f:(fun p ->
-          let id' = p.Outline.id in
-          match id' = id with
-          | false -> ()
-          | true -> post worker (`DeletePoint (point, p))
-        );
-    { state with mode = Selection (Path id) }
-  | _ ->
-    state
-
 (** Tick event
 
     Tick only occurs when drawing a new path
@@ -180,119 +147,15 @@ let angle worker angle state =
   | _ -> { state with angle }
 
 
-(** Short click on any element, just do nothing (each element is on MouseDown
-    event) *)
-let click state = function
-  | _ -> state
-
-(** Long click, move the selected element if any *)
-let longClick mouse_coord state worker = function
-  | Selection t ->
-    let mouse_v2 = Gg.V2.of_tuple mouse_coord in
-    begin match Selection.find_selection t state.paths with
-      | None -> state
-      | Some (Point (path, point)) ->
-        let point' = Path.Point.copy point mouse_v2 in
-        post worker (`TranslatePoint (point', path));
-        (* Just replace the position of the selected point *)
-        { state with mode = Selection (Point (path.id, point')) }
-      | Some (Path path) ->
-        let delta = Gg.V2.(mouse_v2 - state.mouse_down_position) in
-        post worker (`TranslatePath (path, delta));
-        state
-    end
-  (*  TODO Long click in out mode should translate the slate *)
-  | _ -> state
-
 let do_action
-  : Brr_webworkers.Worker.t -> Elements.Timer.t -> (events, state) Application.t
-  = fun worker timer event state ->
+  : Brr_webworkers.Worker.t -> (events, state) Application.t
+  = fun worker event state ->
     match event, state.mode with
     | `Generic (E (t, (module Handler))), _ ->
       Handler.apply t state
     | `Point (delay, point), _ ->
       tick (delay, point) state
 
-    (* Click anywhere while in Out mode, we switch in edition *)
-    | `MouseDown ((x, y) as p), Out ->
-      Elements.Timer.start timer 0.3;
-
-      let width = state.width
-      and angle = state.angle in
-
-      let stamp = 0. in
-      let point =
-        match Selection.get_from_paths p state.paths with
-        | _, None ->
-          (* Start a new path with the point clicked *)
-          Path.Point.create ~x ~y ~angle ~width ~stamp
-        | _, 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 ~stamp
-      in
-
-      let current = Path.Path_Builder.add_point
-          point
-          state.current in
-      { state with
-        current
-      ; mode = Edit
-      ; mouse_down_position = Gg.V2.of_tuple (x, y)}
-
-    (* Click anywhere while in selection mode, we either select another path,
-       or switch to Out mode*)
-    | `MouseDown position, (Selection (Path id))
-    | `MouseDown position, (Selection (Point (id, _))) ->
-
-      let get_any () =
-        begin match Selection.get_from_paths position state.paths with
-          | _, None ->
-            { state with
-              mode = Out
-            ; mouse_down_position = Gg.V2.of_tuple position }
-          | dist, Some selection ->
-            let _, outline, _, _ = selection in
-            if outline.Outline.id != id then (
-              let mouse_down_position = Gg.V2.of_tuple position in
-              select_segment position selection { state with mouse_down_position } dist
-            ) else
-              (* On the same segment, check for a point *)
-              let selection = Selection.select_point outline (Gg.V2.of_tuple position) in
-              match selection with
-              | Path _ ->
-                { state with
-                  mode = Selection selection
-                ; mouse_down_position = Gg.V2.of_tuple position }
-              | Point (_, pt) ->
-                (* In order to handle the point move, start the timer *)
-                Elements.Timer.start timer 0.3;
-                { state with
-                  mode = Selection selection
-                ; angle = Path.Point.get_angle pt
-                ; width = Path.Point.get_width pt
-                ; mouse_down_position = Gg.V2.of_tuple position }
-        end
-      in
-
-      (* First, check for a point in the selected path. If any of them in
-         found, check anything to select in all the elements *)
-      begin match Outline.find state.paths id with
-        | None -> get_any ()
-        | Some outline ->
-          begin match Selection.select_point outline (Gg.V2.of_tuple position) with
-            | Path _ -> get_any ()
-            | other ->
-              Elements.Timer.start timer 0.3;
-              {state with
-               mode = Selection other
-             ; mouse_down_position = Gg.V2.of_tuple position }
-          end
-      end
-
-    | `Delete, _ ->
-      delete state worker
 
     | `Export, _ ->
       let my_host = Uri.host @@ Window.location @@ G.window in
@@ -342,10 +205,6 @@ let do_action
       { state with paths }
 
 
-    (* Some non possible cases *)
-    | `MouseDown _, Edit
-      -> state
-
 let init =
   { paths = []
   ; current = Path.Path_Builder.empty