From 6354358caa1dfbf2fe1d481f6ac5fba3775938fc Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Tue, 22 Dec 2020 21:42:55 +0100
Subject: Blog integration
---
blog/dune | 8 ++++
blog/sidebar.ml | 131 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
dune | 3 +-
path/builder.ml | 12 ++---
path/builder.mli | 4 +-
script.ml | 68 ++++++++++++++++++++++++-----
6 files changed, 205 insertions(+), 21 deletions(-)
create mode 100755 blog/dune
create mode 100755 blog/sidebar.ml
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
--
cgit v1.2.3