Blog integration

6 files changed, 205 insertions, 21 deletions

diff --git a/blog/dune b/blog/dune
new file mode 100755
index 0000000..532a7ee
--- /dev/null
+++ b/blog/dune
@@ -0,0 +1,8 @@
+(library
+ (name blog)
+ (libraries 
+   brr
+   brr.note
+   js_of_ocaml-tyxml)
+ (preprocess (pps tyxml-ppx))
+ )
diff --git a/blog/sidebar.ml b/blog/sidebar.ml
new file mode 100755
index 0000000..ed4b856
--- /dev/null
+++ b/blog/sidebar.ml
@@ -0,0 +1,131 @@
+open StdLabels
+open Brr
+open Brr_note
+open Note
+
+(** Return the sidebar *)
+let get
+  : unit -> El.t option
+  = fun () ->
+
+    List.find_opt (El.children @@ Document.body G.document)
+      ~f:(fun t -> El.has_tag_name El.Name.aside t)
+
+let rec clean
+  : El.t -> unit
+  = fun el ->
+    List.iter (El.children el)
+      ~f:(fun el ->
+          (* Remove the links from the sidebar, keep h1 and other stuff *)
+          if (El.has_tag_name (Jstr.v "nav") el)
+          || (El.has_tag_name (Jstr.v "ul") el) then
+            El.remove el
+          else
+            clean el
+        )
+
+(** Create a slider element, and the event on change *)
+let slider ~at =
+  let slider =
+    El.input ~at () in
+
+  let event =
+    Evr.on_el
+      Ev.input
+      (fun _ ->
+         let raw_value = El.prop El.Prop.value slider in
+         Jstr.to_int raw_value)
+      slider
+  in
+  slider, event
+
+let click_event el =
+  Evr.on_el
+    Ev.click
+    Evr.unit
+    el
+
+let show_value = function
+  | None -> El.txt' ""
+  | Some input ->
+    El.txt (Jstr.of_int input)
+
+let add_button
+  : El.t -> unit E.t
+  = fun element ->
+
+    let open El in
+
+    let delete =
+      button
+        [ El.i
+            ~at:At.[ class' (Jstr.v "fas")
+                   ; class' (Jstr.v "fa-times-circle") ]
+            []
+        ; txt' "Delete "] in
+
+    let delete_event = click_event delete in
+
+    let export =
+      button
+        [ El.i
+            ~at:At.[ class' (Jstr.v "fas")
+                   ; class' (Jstr.v "fa-download") ]
+            []
+        ; txt' "Download"] in
+
+
+    let nib_size, value  =
+      slider
+        ~at:At.[ type' (Jstr.v "range")
+               ; v (Jstr.v "min") (Jstr.v "0")
+               ; v (Jstr.v "max") (Jstr.v "50")
+               ; id (Jstr.v "nib_size")
+               ] in
+
+    let width = El.div [] in
+    Elr.set_children
+      width
+      ~on:(value
+           |> E.map (fun v ->
+               [ txt' "Width : "
+               ; show_value v ]
+             )
+          );
+
+    let input_angle, angle_event =
+      slider
+        ~at:At.[ type' (Jstr.v "range")
+               ; v (Jstr.v "min") (Jstr.v "0")
+               ; v (Jstr.v "max") (Jstr.v "90")] in
+    let angle = El.div [] in
+    Elr.set_children
+      angle
+      ~on:(angle_event
+           |> E.map (fun v ->
+               [ txt' "Angle : "
+               ; show_value v
+               ; txt' "°" ]
+             )
+          );
+
+    let click = Evr.on_el Ev.click Evr.unit delete in
+    let _ = click in
+
+    let () =
+      El.append_children element
+        [ hr ()
+        ; delete
+        ; export
+        ; hr ()
+
+        ; width
+        ; nib_size
+        ; El.br ()
+
+        ; angle
+        ; input_angle
+
+        ]
+    in
+    delete_event
diff --git a/dune b/dune
index f3149ef..ea5d723 100755
--- a/dune
+++ b/dune
@@ -9,10 +9,11 @@
    messages 
    messages_json
    worker
-   path
    shapes
    tools
    events
+   blog
+   path
    )
  (modes js)
  (preprocess (pps js_of_ocaml-ppx))
diff --git a/path/builder.ml b/path/builder.ml
index b77c60a..3ccad9c 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -328,7 +328,6 @@ module Make(Point:P) = struct
         Repr.stop repr
   end
 
-
   let box
     : bezier -> Gg.box2
     = fun bezier ->
@@ -338,7 +337,6 @@ module Make(Point:P) = struct
       |> (fun b -> Gg.Box2.add_pt b bezier.ctrl0)
       |> (fun b -> Gg.Box2.add_pt b bezier.ctrl1)
 
-
   let distance
     : Gg.v2 -> fixedPath -> float option =
     fun point beziers ->
@@ -353,6 +351,7 @@ module Make(Point:P) = struct
             begin match Gg.Box2.mem point box with
               | false -> res
               | true ->
+                (* TODO Evaluate the normal *)
                 res
             end
           | Curve bezier ->
@@ -373,12 +372,9 @@ module Make(Point:P) = struct
                 | None -> Some distance
                 | Some d -> if d < distance then res else (Some distance)
             end
-
-
         )
 
-
-
-
-
+  let id
+    : fixedPath -> int
+    = fun {id; _} -> id
 end
diff --git a/path/builder.mli b/path/builder.mli
index 42f433e..557cdfa 100755
--- a/path/builder.mli
+++ b/path/builder.mli
@@ -32,7 +32,6 @@ end
 
 module Make(P:P) : sig
 
-  type bezier 
   type t
 
   type fixedPath
@@ -72,4 +71,7 @@ module Make(P:P) : sig
   (** Return the shortest distance between the mouse and a point *)
   val distance
     : Gg.v2 -> fixedPath -> float option 
+
+  val id 
+    : fixedPath -> int
 end
diff --git a/script.ml b/script.ml
index 02492d6..58eae1e 100755
--- a/script.ml
+++ b/script.ml
@@ -6,6 +6,7 @@ module Timer = Events.Timer
 
 module Repr = Path.FillPrinter
 
+
 module Path_Builder = Path.Builder.Make(Path.Point)
 module Path_Printer = Path_Builder.Draw(Repr)
 module Fixed_Printer = Path_Builder.DrawFixed(Repr)
@@ -35,8 +36,12 @@ type canva_events =
   | `Out of float * float
   ]
 
+type button_events =
+  [ `Delete ]
+
 type events =
   [ canva_events
+  | button_events
   | `Point of float * (float * float) ]
 
 type canva_signal = Path.Point.t
@@ -47,6 +52,23 @@ module Mouse = Brr_note_kit.Mouse
 let canva
   : Brr.El.t -> [> canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t
   = fun element ->
+
+    El.set_inline_style
+      El.Style.width
+      (Jstr.v "100%")
+      element;
+
+    El.set_prop
+      El.Prop.width
+      (El.prop (El.Prop.int (Jstr.v "offsetWidth")) element)
+      element;
+
+    El.set_inline_style
+      El.Style.width
+      (Jstr.v "")
+      element;
+
+
     let module C = Brr_canvas.Canvas in
     let c = C.of_el element in
 
@@ -176,8 +198,10 @@ let do_action
               ; current }
           end
       end
-
-
+    | `Delete, Selection s ->
+      let id = Path_Builder.id s in
+      let paths = List.filter state.paths ~f:(fun p -> Path_Builder.id p != id) in
+      { state with paths ; mode = Out}
     | _ -> state
 
 let backgroundColor = Jstr.v "#2e3440"
@@ -261,11 +285,32 @@ let page_main id =
     ; mode = Out
     } in
 
+  let delete_event' =
+    begin match Blog.Sidebar.get () with
+      | None ->
+        Jv.throw (Jstr.v "No sidebar")
+      | Some el ->
+
+        Blog.Sidebar.clean el;
+        let event = Blog.Sidebar.add_button el in
+        event
+    end in
+  let delete_event = E.map (fun () -> `Delete) delete_event' 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 ->
 
+      (* Add the events to the canva :
+
+         - The mouse position is a signal used for both the update and the
+           canva refresh
+
+         - Get also the click event for starting to draw
+      *)
+
       let canva_events, mouse_position, canva = canva (Jv.Id.of_jv id) in
 
       let tick_event =
@@ -276,24 +321,25 @@ let page_main id =
       (* 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.select [canva_events; tick_event; delete_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
+         the mouse is updated, or on delete events  *)
+      let _ =
+        E.select
+          [ E.map (fun _ -> ()) (S.changes mouse_position)
+          ; delete_event' ]
+        |> fun ev -> E.log ev (fun _ -> on_change canva mouse_position (S.value state) )
+                     |> Option.iter Logr.hold in
+
 
       (* Draw the canva for first time *)
       on_change canva mouse_position init;
 
+      (* Hold the state *)
       let _ = Logr.hold (S.log state (fun _ -> ())) in
-      let _ = match v with
-        | None -> ()
-        | Some log -> Logr.hold log in
       ()
 
   end