Dynamic width

13 files changed, 105 insertions, 31 deletions

diff --git a/blog/dune b/blog/dune
index afbefdb..fef8506 100755
--- a/blog/dune
+++ b/blog/dune
@@ -1,9 +1,21 @@
+(rule
+  (targets hash_host.ml)
+  (enabled_if (= %{profile} dev))
+  (action (run cp hash_prod/hash_localhost.ml hash_host.ml)))
+
+(rule
+  (targets hash_host.ml)
+  (enabled_if (<> %{profile} dev))
+  (action (run cp hash_prod/hash_blog.ml hash_host.ml)))
+
 (library
  (name blog)
  (libraries 
    brr
    brr.note
-   color
    elements
    )
+ (preprocess (pps ppx_hash))
+
+ 
  )
diff --git a/blog/hash_prod/hash_blog.ml b/blog/hash_prod/hash_blog.ml
new file mode 100755
index 0000000..f5e172e
--- /dev/null
+++ b/blog/hash_prod/hash_blog.ml
@@ -0,0 +1 @@
+let expected_host = [%static_hash "blog.chimrod.com"]
diff --git a/blog/hash_prod/hash_localhost.ml b/blog/hash_prod/hash_localhost.ml
new file mode 100755
index 0000000..c652b6a
--- /dev/null
+++ b/blog/hash_prod/hash_localhost.ml
@@ -0,0 +1 @@
+let expected_host = [%static_hash ""]
diff --git a/blog/nord.ml b/blog/nord.ml
index 78c4c61..f0f2772 100755
--- a/blog/nord.ml
+++ b/blog/nord.ml
@@ -1 +1,2 @@
 let nord0 = Jstr.v "#2e3440"
+let nord8 = Jstr.v "#81a1c1"
diff --git a/blog/sidebar.ml b/blog/sidebar.ml
index a1293de..1df0f1a 100755
--- a/blog/sidebar.ml
+++ b/blog/sidebar.ml
@@ -21,4 +21,3 @@ let rec clean
           else
             clean el
         )
-
diff --git a/elements/input.ml b/elements/input.ml
index 935f34a..6ae9aa8 100755
--- a/elements/input.ml
+++ b/elements/input.ml
@@ -21,5 +21,3 @@ let slider
       |> S.hold init_value
     in
     slider, event
-
-
diff --git a/path/builder.ml b/path/builder.ml
index 3ccad9c..39ff75e 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -337,14 +337,15 @@ module Make(Point:P) = struct
       |> (fun b -> Gg.Box2.add_pt b bezier.ctrl0)
       |> (fun b -> Gg.Box2.add_pt b bezier.ctrl1)
 
+  (** Return the distance between a given point and the curve. May return
+      None if the point is out of the curve *)
   let distance
     : Gg.v2 -> fixedPath -> float option =
     fun point beziers ->
 
     Array.fold_left beziers.path
       ~init:None
-      ~f:(fun res path ->
-          match path with
+      ~f:(fun res -> function
           | Empty -> None
           | Line (p0, p1) ->
             let box = Gg.Box2.of_pts (Point.get_coord p0) (Point.get_coord p1) in
@@ -377,4 +378,16 @@ module Make(Point:P) = struct
   let id
     : fixedPath -> int
     = fun {id; _} -> id
+
+  let map_point
+    : fixedPath -> (Point.t -> Point.t) -> fixedPath
+    = fun {id; path} f ->
+      let path = Array.map path
+          ~f:(function
+              | Empty -> Empty
+              | Line (p1, p2) -> Line (f p1, f p2)
+              | Curve bezier -> Curve {bezier with p0 = f bezier.p0 ; p1 = f bezier.p1}
+            ) in
+      {id; path}
+
 end
diff --git a/path/builder.mli b/path/builder.mli
index 557cdfa..ca496f7 100755
--- a/path/builder.mli
+++ b/path/builder.mli
@@ -74,4 +74,7 @@ module Make(P:P) : sig
 
   val id 
     : fixedPath -> int
+
+  val map_point 
+    : fixedPath -> (P.t -> P.t) -> fixedPath
 end
diff --git a/path/point.ml b/path/point.ml
index abb9515..06eb635 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -19,6 +19,12 @@ let create ~angle ~width ~x ~y =
 let copy point p =
   { point with p }
 
+let set_angle p angle =
+  { p with angle = Gg.Float.rad_of_deg (180. -. angle) }
+
+let set_width p size =
+  { p with size }
+
 let (+) p1 p2 =
   { p1 with p = Gg.V2.(+) p1.p p2 }
 
diff --git a/path/point.mli b/path/point.mli
index 2c687ab..649a3be 100755
--- a/path/point.mli
+++ b/path/point.mli
@@ -10,5 +10,9 @@ val create: angle:float -> width:float -> x:float -> y:float -> t
 
 val copy : t -> Gg.v2 -> t
 
+val set_angle : t -> float -> t
+
+val set_width: t -> float -> t
+
 val get_coord'
   : t -> Gg.v2
diff --git a/paths.ml b/paths.ml
index 2db8ab0..82eca48 100755
--- a/paths.ml
+++ b/paths.ml
@@ -1,2 +1,4 @@
+(** Common  module for ensuring that the function is evaluated only once *)
+
 module Path_Builder = Path.Builder.Make(Path.Point)
 
diff --git a/script.ml b/script.ml
index 5d011d9..a250c7f 100755
--- a/script.ml
+++ b/script.ml
@@ -3,7 +3,6 @@ open Note
 open Brr
 open Brr_note
 
-
 module CanvaRepr = Path.FillPrinter.Make(Layer.CanvaPrinter)
 
 module Path_Printer = Paths.Path_Builder.Draw(CanvaRepr)
@@ -13,6 +12,12 @@ type canva_signal = Path.Point.t
 
 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
@@ -128,7 +133,7 @@ let set_sidebar
     let input_angle, angle_event =
       Elements.Input.slider
         ~at:At.[ type' (Jstr.v "range")
-               ; v (Jstr.v "min") (Jstr.v "1")
+               ; v (Jstr.v "min") (Jstr.v "0")
                ; v (Jstr.v "max") (Jstr.v "90")
                ; At.value (Jstr.of_float state.angle)
                ] in
@@ -143,9 +148,6 @@ let set_sidebar
          )
       );
 
-    let click = Evr.on_el Ev.click Evr.unit delete in
-    let _ = click in
-
     let () =
       El.append_children element
         [ hr ()
@@ -155,7 +157,6 @@ let set_sidebar
 
         ; width
         ; nib_size
-        ; El.br ()
 
         ; angle
         ; input_angle
@@ -167,8 +168,8 @@ let set_sidebar
 let backgroundColor = Blog.Nord.nord0
 let white = Jstr.v "#eceff4"
 let green = Jstr.v "#a3be8c"
-let nord8 = Jstr.v "#81a1c1"
 
+(** Redraw the canva on update *)
 let on_change canva mouse_position state =
   let module Path' = Path in
   let open Brr_canvas.C2d in
@@ -215,25 +216,26 @@ let on_change canva mouse_position state =
 
   List.iter paths
     ~f:(fun path ->
+
+        let () = match state.mode with
+          | Selection s ->
+            begin match (Paths.Path_Builder.id s) = (Paths.Path_Builder.id path) with
+              | true ->
+                set_fill_style context (color Blog.Nord.nord8);
+                set_stroke_style context (color Blog.Nord.nord8)
+              | false  ->
+                set_stroke_style context (color white);
+                set_fill_style context (color white);
+            end
+          | _ -> ()
+        in
+
         let path = CanvaRepr.get
           @@ Fixed_Printer.draw
             path
             (CanvaRepr.create_path (fun p -> fill context p)) in
         stroke context path;
       );
-
-
-  (* If there is a selection draw it *)
-  let () = match state.mode with
-    | Selection path ->
-      set_fill_style context (color nord8);
-      set_stroke_style context (color nord8);
-      let path = CanvaRepr.get
-        @@ Fixed_Printer.draw
-          path
-          (CanvaRepr.create_path (fun p -> fill context p)) in
-      stroke context path;
-    | _ -> () in
   ()
 
 
@@ -258,7 +260,6 @@ let page_main id =
   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])
@@ -297,6 +298,8 @@ let page_main id =
       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
diff --git a/state.ml b/state.ml
index 60796c8..e41c328 100755
--- a/state.ml
+++ b/state.ml
@@ -5,8 +5,7 @@ module Path_Builder = Paths.Path_Builder
 module SVGRepr = Path.WireFramePrinter.Make(Layer.Svg)
 module SVG_Fixed_Printer = Path_Builder.DrawFixed(SVGRepr)
 
-
-let expected_host = [%static_hash ""]
+let expected_host = Blog.Hash_host.expected_host
 
 let backgroundColor = Blog.Nord.nord0
 
@@ -40,7 +39,7 @@ type events =
   ]
 
 (*
- The state cannt hold functionnal values, and thus cannot be used to store
+ The state cant hold functionnal values, and thus cannot be used to store
  elements like timer
  *)
 type state =
@@ -94,6 +93,20 @@ let check_selection
             end
         )
 
+(** Update the path in the selection with the given function applied to
+    every point *)
+let update_selection s state f =
+  let s = Path_Builder.map_point s f
+  and id = Path_Builder.id s in
+
+  let paths = List.map state.paths
+      ~f:(fun path ->
+          let id' = Path_Builder.id path in
+          match id = id' with
+          | false -> path
+          | true -> s
+        ) in
+  { state with mode = Selection s ; paths}
 
 let do_action
   : events -> state -> state
@@ -205,12 +218,30 @@ let do_action
       );
       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}
 
-    | _ -> state
+    | `Delete, Out
+      -> state
+
+    (* Some non possible cases *)
+    | `Out _, Out
+    | `Point _, Out
+    | `Point _, Selection _
+    | `Out _, Selection _
+    | `Click _, Edit
+    | `Delete, Edit
+      -> state
 
 let init =
   { paths = []