From 20d10a93e5becb41d1145f9d35136782365b0ba4 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Thu, 17 Dec 2020 13:56:00 +0100
Subject: Refactor

---
 script.ml | 104 ++++++++++++++++++++++++++++++++++++++++++--------------------
 1 file changed, 70 insertions(+), 34 deletions(-)

(limited to 'script.ml')

diff --git a/script.ml b/script.ml
index f97eed2..9cd8a22 100755
--- a/script.ml
+++ b/script.ml
@@ -12,7 +12,7 @@ type mode =
 
 type current =
   { points : Point.t list (* The list of points to draw *)
-  ; beziers : Curves.Bezier.t list (* All the points already fixed *)
+  ; beziers : Shapes.Bezier.t list (* All the points already fixed *)
   }
 
 type state =
@@ -30,7 +30,7 @@ type canva_events =
 
 type events =
   [ canva_events
-  | `Point of float * float ]
+  | `Point of float * (float * float) ]
 
 type canva_signal = Point.t
 
@@ -70,10 +70,10 @@ let do_action
   : events -> state -> state
   = fun event state ->
     match event, state.mode with
-    | `Point (x, y), Edit ->
+    | `Point (_delay, point), Edit ->
       (* Add the point in the list *)
       let points, beziers = Point.add_point_in_path
-          x y
+          point
           state.current.points
           state.current.beziers in
 
@@ -83,13 +83,39 @@ let do_action
     | `Click _, Out ->
       Timer.start state.timer 0.3;
       { state with mode = Edit }
-    | `Out (x, y), _ ->
+    | `Out p, Edit ->
       Timer.stop state.timer;
       (* Add the point in the list *)
+
+      let points, beziers = match state.current.points, state.current.beziers with
+        | hd::(tl), beziers ->
+
+          let open Gg.V2 in
+          let p' = of_tuple p
+          and hd' = Point.get_coord hd in
+          if (norm (hd' - p' )) < 0.05 then
+            (Point.create (fst p)  (snd p))::tl
+          , beziers
+          else (
+            Point.add_point_in_path
+              p
+              state.current.points
+              state.current.beziers
+          )
+        | _ ->
+          Point.add_point_in_path
+            p
+            state.current.points
+            state.current.beziers
+      in
+
+
+(*
       let points, beziers = Point.add_point_in_path
-          x y
+          p
           state.current.points
           state.current.beziers in
+*)
       let beziers = Draw.to_path (points, beziers) in
 
       let paths = beziers::state.paths
@@ -131,7 +157,7 @@ let draw_path area points beziers =
   let open Brr_canvas.C2d in
   let connexion = match beziers with
     | [] -> None
-    | hd ::_ -> Some hd.Curves.Bezier.p1 in
+    | hd ::_ -> Some hd.Shapes.Bezier.p1 in
   (* Firt draw all the points most recent points *)
   let path = draw ?connexion ~area points in
 
@@ -140,9 +166,9 @@ let draw_path area points beziers =
       ~init:path
       ~f:(fun path bezier ->
 
-          let cx, cy = Draw.translate_point ~area bezier.Curves.Bezier.ctrl0
-          and cx', cy' = Draw.translate_point ~area bezier.Curves.Bezier.ctrl1
-          and x, y = Draw.translate_point ~area bezier.Curves.Bezier.p1 in
+          let cx, cy = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl0
+          and cx', cy' = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl1
+          and x, y = Draw.translate_point ~area bezier.Shapes.Bezier.p1 in
 
           Path.ccurve_to path
             ~cx ~cy
@@ -178,38 +204,48 @@ let on_change canva mouse_position state =
   let pos = S.rough_value mouse_position in
   let points =
     match state.mode, pos with
-    | Edit, Some (x, y) -> (Point.create x y)::state.current.points
-    | _ -> state.current.points in
+    | Edit, Some (x, y) ->
+      (Point.create x y)::state.current.points
+    | _ ->
+      set_image_smoothing_enabled context true;
+      set_image_smoothing_quality context Image_smoothing_quality.high;
+      state.current.points in
 
   let path = draw_path area (points) state.current.beziers in
   stroke context path;
 
   List.iter state.paths
     ~f:(fun path ->
-        let p = Path.create () in
-        Draw.move_to ~area p path.Draw.path;
-        Draw.draw ~area p path.Draw.path;
-        Draw.go_back ~area p path.Draw.path;
-        fill ~fill_rule:Fill_rule.nonzero context p;
 
-(*
+        (* This is ugly, and probably non efficient, but is an appropriate solution for
+           the cases of overlapping path *)
         match path.Draw.path with
-        | Curve c ->
-          let c' = Array.init
-              (Array.length c)
-              ~f:(fun i ->
-                  Curves.Bezier.reverse @@ Array.get c ((Array.length c) -i - 1)
-                )
-          in
-          let p' = Draw.Curve c' in
-          Draw.move_to ~area p p';
-          Draw.draw ~area p p';
-          Draw.go_back ~area p p';
-          fill ~fill_rule:Fill_rule.nonzero context p;
-          ()
-        | _ -> ()
-*)
+        | Draw.Curve beziers ->
+
+          Array.iter beziers
+            ~f:(fun bezier ->
+
+                let b = Draw.Curve [|bezier|] in
+                let p = Path.create () in
+                Draw.move_to ~area p b;
+                Draw.draw ~area p b;
+                Draw.go_back ~area p b;
+                Path.close p;
+                fill context p;
+                stroke context p
+
+
+              )
+
+        | _ ->
 
+          let p = Path.create () in
+          Draw.move_to ~area p path.Draw.path;
+          Draw.draw ~area p path.Draw.path;
+          Draw.go_back ~area p path.Draw.path;
+          Path.close p;
+          fill context p;
+          stroke context p
       );
   ()
 
@@ -236,7 +272,7 @@ let page_main id =
       let tick_event =
         S.sample_filter mouse_position
           ~on:tick
-          (fun pos () -> Option.map (fun p -> `Point p) pos ) in
+          (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 *)
-- 
cgit v1.2.3