From 4f262d6540281487f79870aff589ca92f5d2f6c6 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Wed, 16 Dec 2020 14:39:42 +0100
Subject: Initial commit

---
 script.ml | 275 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 275 insertions(+)
 create mode 100755 script.ml

(limited to 'script.ml')

diff --git a/script.ml b/script.ml
new file mode 100755
index 0000000..f97eed2
--- /dev/null
+++ b/script.ml
@@ -0,0 +1,275 @@
+open StdLabels
+open Note
+open Brr
+
+module Timer = Events.Timer
+
+module Point = Draw.Point
+
+type mode =
+  | Edit
+  | Out
+
+type current =
+  { points : Point.t list (* The list of points to draw *)
+  ; beziers : Curves.Bezier.t list (* All the points already fixed *)
+  }
+
+type state =
+  { mode : mode
+  ; paths : Draw.t list (* All the previous paths *)
+  ; current : current
+  ; timer : Timer.t
+  }
+
+(** Events *)
+type canva_events =
+  [ `Click of float * float
+  | `Out of float * float
+  ]
+
+type events =
+  [ canva_events
+  | `Point of float * float ]
+
+type canva_signal = Point.t
+
+module Mouse = Brr_note_kit.Mouse
+
+(** Create the element in the page, and the event handler *)
+let canva
+  : Brr.El.t -> [> canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t
+  = fun 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
+        (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 do_action
+  : events -> state -> state
+  = fun event state ->
+    match event, state.mode with
+    | `Point (x, y), Edit ->
+      (* Add the point in the list *)
+      let points, beziers = Point.add_point_in_path
+          x y
+          state.current.points
+          state.current.beziers in
+
+      let current= {points; beziers} in
+
+      { state with current }
+    | `Click _, Out ->
+      Timer.start state.timer 0.3;
+      { state with mode = Edit }
+    | `Out (x, y), _ ->
+      Timer.stop state.timer;
+      (* Add the point in the list *)
+      let points, beziers = Point.add_point_in_path
+          x y
+          state.current.points
+          state.current.beziers in
+      let beziers = Draw.to_path (points, beziers) in
+
+      let paths = beziers::state.paths
+      and current = { points = []; beziers = []} in
+      { state with mode = Out; paths; current }
+    | _ -> state
+
+let backgroundColor = Jstr.v "#2e3440"
+let white = Jstr.v "#eceff4"
+let green = Jstr.v "#a3be8c"
+let nord8 = Jstr.v "#81a1c1"
+
+let draw
+  : ?connexion:Gg.v2 -> area:Gg.v2 -> Point.t list -> Brr_canvas.C2d.Path.t
+  = fun ?connexion ~area points ->
+
+    let open Brr_canvas.C2d in
+    let path = Path.create () in
+
+
+    let () = match points with
+      | [] -> ()
+      | hd::_ ->
+        let vect = Draw.Line (hd, Point.create 0. 0.) in
+        Draw.move_to ~area path vect in
+
+    let _ = match points with
+      | []
+      | _::[] -> ()
+      | _::p1::[] ->
+        Draw.line area ~p1 path
+      | p0::p1::p2::[] ->
+        Draw.three_points area ~p0 ~p1 ~p2 path
+      | _ ->
+        Draw.multi_points ?connexion area points path
+    in path
+
+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
+  (* Firt draw all the points most recent points *)
+  let path = draw ?connexion ~area points in
+
+  (* Then add the fixed ones *)
+  let path = List.fold_left 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
+
+          Path.ccurve_to path
+            ~cx ~cy
+            ~cx' ~cy'
+            ~x ~y;
+          path
+        ) in
+  path
+
+let on_change canva mouse_position state =
+  let open Brr_canvas.C2d in
+
+  let w, h = Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva) in
+  let area = Gg.V2.v w h in
+
+  let context = create canva in
+
+  set_fill_style context (color backgroundColor);
+  fill_rect context
+    ~x:0.0
+    ~y:0.0
+    ~w
+    ~h;
+  set_stroke_style context (color white);
+  set_fill_style context (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 points =
+    match state.mode, pos with
+    | Edit, Some (x, y) -> (Point.create x y)::state.current.points
+    | _ -> 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;
+
+(*
+        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;
+          ()
+        | _ -> ()
+*)
+
+      );
+  ()
+
+
+let page_main id =
+
+  let timer, tick = Timer.create () in
+
+  let init =
+    { paths = []
+    ; current = { points = []
+                ; beziers = [] }
+    ; mode = Out
+    ; timer
+    } 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 ->
+
+      let canva_events, mouse_position, canva = canva (Jv.Id.of_jv id) in
+
+      let tick_event =
+        S.sample_filter mouse_position
+          ~on:tick
+          (fun pos () -> Option.map (fun p -> `Point 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]
+        |> E.map do_action
+        |> Note.S.accum init in
+
+      (* The seconde evaluation is the canva refresh, which only occurs when
+         the mouse is updated *)
+      let v =
+        E.map (fun _ -> state) (S.changes mouse_position)
+        |> E.map (fun x -> on_change canva mouse_position (S.value x) )
+        |> fun ev -> E.log ev (fun _ -> ()) in
+
+      (* Draw the canva for first time *)
+      on_change canva mouse_position init;
+
+      let _ = Logr.hold (S.log state (fun _ -> ())) in
+      let _ = match v with
+        | None -> ()
+        | Some log -> Logr.hold log 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
-- 
cgit v1.2.3