Refactor

8 files changed, 143 insertions, 77 deletions

diff --git a/script.it/dune b/script.it/dune
index ceae76c..dd1f7d2 100755
--- a/script.it/dune
+++ b/script.it/dune
@@ -1,16 +1,9 @@
-(library 
-  (name outline)
- (libraries 
-   path)
- (modules outline)
- (preprocess (pps ppx_hash js_of_ocaml-ppx))
- )
-
 (executable
  (name script)
  (libraries 
    brr
    brr.note
+   script_state
    shapes
    elements
    blog
@@ -20,7 +13,7 @@
    outline
    )
  (modes js)
- (modules script state selection)
+ (modules script)
  (preprocess (pps ppx_hash js_of_ocaml-ppx))
  (link_flags (:standard -no-check-prims))
  )
diff --git a/script.it/outline/dune b/script.it/outline/dune
new file mode 100755
index 0000000..db080a3
--- /dev/null
+++ b/script.it/outline/dune
@@ -0,0 +1,9 @@
+(library 
+  (name outline)
+ (libraries 
+   path)
+ (modules outline)
+ (preprocess (pps ppx_hash js_of_ocaml-ppx))
+ )
+
+
diff --git a/script.it/outline.ml b/script.it/outline/outline.ml
index 1df7588..1df7588 100755
--- a/script.it/outline.ml
+++ b/script.it/outline/outline.ml
diff --git a/script.it/script.ml b/script.it/script.ml
index ba6b828..bc79a22 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -3,13 +3,88 @@ open Note
 open Brr
 open Brr_note
 
+module State = Script_state.State
+module Selection = Script_state.Selection
+
+module Out = struct
+  type t = { point  : float * float
+           ; timer  : Elements.Timer.t
+           ; worker : Brr_webworkers.Worker.t
+           }
+
+  let apply {point; timer ; worker} state =
+    match state.State.mode with
+
+    | Edit ->
+      let stamp = Elements.Timer.delay timer in
+      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 current = State.insert_or_replace state point stamp state.current in
+          let path = Path.Fixed.to_fixed
+              (module Path.Path_Builder)
+              current in
+
+          (* Create a copy from the path with all the interior points *)
+          let back = Path.Fixed.map
+              path
+              (fun pt -> Path.Point.copy pt @@ Path.Point.get_coord' pt) in
+
+          let last =
+            Outline.{ path
+                    ; back
+                    ; id = Outline.get_id ()
+                    }
+          in
+
+          (* Send to the worker for a full review *)
+          let () = State.post worker (`Complete last) in
+
+          let state =
+            { state with
+              mode = Out
+            ; paths = last::state.paths
+            ; current = Path.Path_Builder.empty } in
+          state
+
+        (* Else, check if there is a curve under the cursor, and remove it *)
+        | None ->
+          let current = Path.Path_Builder.empty in
+          begin match Selection.get_from_paths point state.paths with
+            | _, None ->
+              { state with
+                mode = Out
+              ; current
+              }
+            | dist, Some selection ->
+              State.select_segment point selection { state with current } dist
+
+          end
+      end
+
+    | mode when Elements.Timer.delay timer < 0.3 ->
+      State.click state mode
+
+    | _ ->
+      State.longClick point state worker state.mode
+
+end
+
 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 -> [> State.canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t
+  : 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 *)
@@ -384,6 +459,26 @@ let page_main id =
 
         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 ->
+
+                `Generic (
+                  State.E
+                    ( Out.{ point = c
+                          ; worker
+                          ; timer
+                          }
+                    , (module Out: State.Handler with type t = Out.t)
+
+
+                    )
+
+                )
+
+            ) canva_events in
+
         let tick_event =
           S.sample_filter mouse_position
             ~on:tick
diff --git a/script.it/state/dune b/script.it/state/dune
new file mode 100755
index 0000000..7d4ef3f
--- /dev/null
+++ b/script.it/state/dune
@@ -0,0 +1,13 @@
+(library
+ (name script_state)
+ (libraries 
+   brr
+   brr.note
+   blog
+   application
+   worker_messages
+   outline
+   layer
+   path
+   )
+ )
diff --git a/script.it/selection.ml b/script.it/state/selection.ml
index f5f135a..f5f135a 100755
--- a/script.it/selection.ml
+++ b/script.it/state/selection.ml
diff --git a/script.it/selection.mli b/script.it/state/selection.mli
index 9792a2d..9792a2d 100755
--- a/script.it/selection.mli
+++ b/script.it/state/selection.mli
diff --git a/script.it/state.ml b/script.it/state/state.ml
index 77a24a3..d7cb13e 100755
--- a/script.it/state.ml
+++ b/script.it/state/state.ml
@@ -9,7 +9,6 @@ type mode =
 (** Events *)
 type canva_events =
   [ `MouseDown of float * float
-  | `Out of float * float
   ]
 
 type button_events =
@@ -23,16 +22,6 @@ type render_event =
 
 type worker_event = Worker_messages.from_worker
 
-type events =
-  [ canva_events
-  | button_events
-  | render_event
-  | worker_event
-  | `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
@@ -47,6 +36,27 @@ type state =
   ; mouse_down_position : Gg.v2
   }
 
+module type Handler = sig
+
+  type t
+
+  val apply: t -> state -> state
+
+end
+
+type t = E : 'a * (module Handler with type t = 'a) -> t
+
+type events =
+  [ canva_events
+  | button_events
+  | render_event
+  | worker_event
+  | `Point of float * (float * float)
+  | `Width of float
+  | `Angle of float
+  | `Generic of t
+  ]
+
 let post
   : Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit
   = Brr_webworkers.Worker.post
@@ -198,6 +208,8 @@ let do_action
   : Brr_webworkers.Worker.t -> Elements.Timer.t -> (events, state) Application.t
   = fun worker timer event state ->
     match event, state.mode with
+    | `Generic (E (t, (module Handler))), _ ->
+      Handler.apply t state
     | `Point (delay, point), _ ->
       tick (delay, point) state
 
@@ -279,62 +291,6 @@ let do_action
           end
       end
 
-    | `Out point, Edit ->
-      let stamp = Elements.Timer.delay timer in
-      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 current = insert_or_replace state point stamp state.current in
-          let path = Path.Fixed.to_fixed
-              (module Path.Path_Builder)
-              current in
-
-          (* Create a copy from the path with all the interior points *)
-          let back = Path.Fixed.map
-              path
-              (fun pt -> Path.Point.copy pt @@ Path.Point.get_coord' pt) in
-
-          let last =
-            Outline.{ path
-                    ; back
-                    ; id = Outline.get_id ()
-                    }
-          in
-
-          (* Send to the worker for a full review *)
-          let () = post worker (`Complete last) in
-
-          let state =
-            { state with
-              mode = Out
-            ; paths = last::state.paths
-            ; current = Path.Path_Builder.empty } in
-          state
-
-        (* Else, check if there is a curve under the cursor, and remove it *)
-        | None ->
-          let current = Path.Path_Builder.empty in
-          begin match Selection.get_from_paths point state.paths with
-            | _, None ->
-              { state with
-                mode = Out
-              ; current
-              }
-            | dist, Some selection ->
-              select_segment point selection { state with current } dist
-
-          end
-      end
-
-    | `Out _, mode when Elements.Timer.delay timer < 0.3 ->
-      click state mode
-
-    | `Out mouse_coord, mode ->
-      longClick mouse_coord state worker mode
-
     | `Delete, _ ->
       delete state worker