summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2020-12-28 21:17:20 +0100
committerSébastien Dailly <sebastien@chimrod.com>2020-12-28 21:17:20 +0100
commit9d65e5e6a5bd8666baf0d7d3e0474c721cafc683 (patch)
treec391ced8768eca6e2f0c8292bab10fceeb48f2ee
parentec812521b31471ce9ac3d9bdf1288b1569defbc8 (diff)
Fixed width and angle sliddes
-rwxr-xr-xblog/dune1
-rwxr-xr-xblog/nord.ml1
-rwxr-xr-xblog/sidebar.ml93
-rwxr-xr-xelements/input.ml29
-rwxr-xr-xelements/prop.ml15
-rwxr-xr-xlayer/svg.ml16
-rwxr-xr-xpath/point.ml6
-rwxr-xr-xpath/point.mli2
-rwxr-xr-xpaths.ml2
-rwxr-xr-xscript.ml342
-rwxr-xr-xstate.ml221
-rwxr-xr-xtheme/dune7
-rwxr-xr-xtheme/nord.ml39
-rwxr-xr-xtheme/theme.ml1
14 files changed, 398 insertions, 377 deletions
diff --git a/blog/dune b/blog/dune
index 43b14ed..afbefdb 100755
--- a/blog/dune
+++ b/blog/dune
@@ -3,6 +3,7 @@
(libraries
brr
brr.note
+ color
elements
)
)
diff --git a/blog/nord.ml b/blog/nord.ml
new file mode 100755
index 0000000..78c4c61
--- /dev/null
+++ b/blog/nord.ml
@@ -0,0 +1 @@
+let nord0 = Jstr.v "#2e3440"
diff --git a/blog/sidebar.ml b/blog/sidebar.ml
index 83afb13..a1293de 100755
--- a/blog/sidebar.ml
+++ b/blog/sidebar.ml
@@ -1,7 +1,5 @@
open StdLabels
open Brr
-open Brr_note
-open Note
(** Return the sidebar *)
let get
@@ -24,94 +22,3 @@ let rec clean
clean el
)
-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 * 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 export_event = click_event export in
-
-
- let nib_size, value =
- Elements.Input.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.def_children
- width
- (value
- |> S.map (fun v ->
- [ txt' "Width : "
- ; show_value v ]
- )
- );
-
- let input_angle, angle_event =
- Elements.Input.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.def_children
- angle
- (angle_event
- |> S.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, export_event
diff --git a/elements/input.ml b/elements/input.ml
index 790b15d..935f34a 100755
--- a/elements/input.ml
+++ b/elements/input.ml
@@ -3,18 +3,23 @@ open Brr_note
open Note
(** Create a slider element, and a signal with the value *)
-let slider ~at =
- let slider =
- El.input ~at () in
+let slider
+ : at:Brr.At.t list -> Brr.El.t * float S.t
- let event =
- Evr.on_el
- Ev.input (fun _ ->
- let raw_value = El.prop El.Prop.value slider in
- Jstr.to_int raw_value)
- slider
- |> S.hold (Jstr.to_int (El.prop El.Prop.value slider))
- in
- slider, event
+ = fun ~at ->
+ let slider =
+ El.input ~at () in
+
+ let init_value = (Jstr.to_float (El.prop El.Prop.value slider)) in
+
+ let event =
+ Evr.on_el
+ Ev.input (fun _ ->
+ let raw_value = El.prop El.Prop.value slider in
+ Jstr.to_float raw_value)
+ slider
+ |> S.hold init_value
+ in
+ slider, event
diff --git a/elements/prop.ml b/elements/prop.ml
new file mode 100755
index 0000000..715adec
--- /dev/null
+++ b/elements/prop.ml
@@ -0,0 +1,15 @@
+open Brr
+
+include El.Prop
+
+let offsetWidth
+ : int t
+ = El.Prop.int (Jstr.v "offsetWidth")
+
+let offsetHeight
+ : int t
+ = El.Prop.int (Jstr.v "offsetHeight")
+
+let outerHTML
+ : Jstr.t t
+ = El.Prop.jstr (Jstr.v "outerHTML")
diff --git a/layer/svg.ml b/layer/svg.ml
index f174acc..f7cc670 100755
--- a/layer/svg.ml
+++ b/layer/svg.ml
@@ -2,10 +2,8 @@
open Brr
-module Path = Brr_canvas.C2d.Path
module V2 = Gg.V2
-
let svg : El.cons
= fun ?d ?at childs ->
El.v ?d ?at (Jstr.v "svg") childs
@@ -26,20 +24,19 @@ let move_to
= fun point path ->
let x, y = V2.to_tuple point in
- Jstr.append path @@
Jstr.concat ~sep:(Jstr.v " ")
- [ Jstr.v " M"
+ [ path
+ ; Jstr.v "M"
; Jstr.of_float x
; Jstr.of_float y ]
-
let line_to
: Gg.v2 -> 'a t -> 'a t
= fun point path ->
let x, y = V2.to_tuple point in
- Jstr.append path @@
Jstr.concat ~sep:(Jstr.v " ")
- [ (Jstr.v " L")
+ [ path
+ ; (Jstr.v "L")
; (Jstr.of_float x)
; (Jstr.of_float y) ]
@@ -49,9 +46,9 @@ let quadratic_to
let cx, cy = V2.to_tuple ctrl0
and cx', cy' = V2.to_tuple ctrl1
and x, y = V2.to_tuple p1 in
- Jstr.append path @@
Jstr.concat ~sep:(Jstr.v " ")
- [ (Jstr.v " C")
+ [ path
+ ; (Jstr.v "C")
; (Jstr.of_float cx)
; (Jstr.of_float cy)
; (Jstr.v ",")
@@ -65,4 +62,3 @@ let close
: 'a t -> 'a t
= fun path ->
Jstr.append path (Jstr.v " Z")
-
diff --git a/path/point.ml b/path/point.ml
index 808310c..abb9515 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -10,10 +10,10 @@ let empty =
; angle = 0.
}
-let create x y =
+let create ~angle ~width ~x ~y =
{ p = Gg.V2.v x y
- ; size = 10.
- ; angle = Float.neg Gg.Float.pi_div_4
+ ; size = width
+ ; angle = Gg.Float.rad_of_deg (180. -. angle )
}
let copy point p =
diff --git a/path/point.mli b/path/point.mli
index 521eced..2c687ab 100755
--- a/path/point.mli
+++ b/path/point.mli
@@ -6,7 +6,7 @@ val (+): t -> Gg.v2 -> t
val get_coord : t -> Gg.v2
-val create: float -> float -> t
+val create: angle:float -> width:float -> x:float -> y:float -> t
val copy : t -> Gg.v2 -> t
diff --git a/paths.ml b/paths.ml
new file mode 100755
index 0000000..2db8ab0
--- /dev/null
+++ b/paths.ml
@@ -0,0 +1,2 @@
+module Path_Builder = Path.Builder.Make(Path.Point)
+
diff --git a/script.ml b/script.ml
index de0b48c..5d011d9 100755
--- a/script.ml
+++ b/script.ml
@@ -1,53 +1,13 @@
open StdLabels
open Note
open Brr
+open Brr_note
-module Path_Builder = Path.Builder.Make(Path.Point)
module CanvaRepr = Path.FillPrinter.Make(Layer.CanvaPrinter)
-module SVGRepr = Path.WireFramePrinter.Make(Layer.Svg)
-module Path_Printer = Path_Builder.Draw(CanvaRepr)
-module Fixed_Printer = Path_Builder.DrawFixed(CanvaRepr)
-
-module SVG_Fixed_Printer = Path_Builder.DrawFixed(SVGRepr)
-
-let expected_host = [%static_hash ""]
-
-type mode =
- | Edit
- | Selection of Path_Builder.fixedPath
- | Out
-
-let timer, tick = Elements.Timer.create ()
-
-type current = Path_Builder.t
-
-(*
- The state cannt hold functionnal values, and thus cannot be used to store
- elements like timer
- *)
-type state =
- { mode : mode
- ; paths : Path_Builder.fixedPath list
- ; current : current
- }
-
-(** Events *)
-type canva_events =
- [ `Click of float * float
- | `Out of float * float
- ]
-
-type button_events =
- [ `Delete
- | `Export
- ]
-
-type events =
- [ canva_events
- | button_events
- | `Point of float * (float * float) ]
+module Path_Printer = Paths.Path_Builder.Draw(CanvaRepr)
+module Fixed_Printer = Paths.Path_Builder.DrawFixed(CanvaRepr)
type canva_signal = Path.Point.t
@@ -55,17 +15,29 @@ 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
+ : Brr.El.t -> [> State.canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t
= fun element ->
+ (* Adapt the width to the window *)
El.set_inline_style
El.Style.width
(Jstr.v "100%")
element;
+ (* See https://stackoverflow.com/a/14855870/13882826 *)
+ El.set_inline_style
+ El.Style.height
+ (Jstr.v "100%")
+ element;
+
El.set_prop
El.Prop.width
- (El.prop (El.Prop.int (Jstr.v "offsetWidth")) element)
+ (El.prop Elements.Prop.offsetWidth element)
+ element;
+
+ El.set_prop
+ El.Prop.height
+ (El.prop Elements.Prop.offsetHeight element)
element;
El.set_inline_style
@@ -73,7 +45,6 @@ let canva
(Jstr.v "")
element;
-
let module C = Brr_canvas.Canvas in
let c = C.of_el element in
@@ -101,156 +72,99 @@ let canva
E.select [click; up], pos, c
-let insert_or_replace ((x, y) as p) path =
- let point = Path.Point.create x y in
- match Path_Builder.peek path with
- | None ->
- Path_Builder.add_point
- point
- path
- | Some p1 ->
- let open Gg.V2 in
-
- let p1' = Path.Point.get_coord p1 in
-
- let dist = (norm (p1' - (of_tuple p))) in
- if dist < 5. then (
- path, None
- ) else (
- Path_Builder.add_point
- point
- path
- )
-
-let check_selection position paths =
- let point = Gg.V2.of_tuple position in
- (* If the user click on a curve, select it *)
- List.fold_left paths
- ~init:None
- ~f:(fun selection path ->
-
- match selection with
- | Some p -> Some p
- | None ->
- (* TODO : Add a method in the point module *)
- begin match Path_Builder.distance point path with
- | Some p when p < 20. ->
- Some path
- | _ -> None
- end
- )
-
-let do_action
- : events -> state -> state
- = fun event state ->
- match event, state.mode with
- | `Point (_delay, point), Edit ->
- (* Add the point in the list *)
- let current, fixed_path = insert_or_replace
- point
- state.current in
- let paths = match fixed_path with
- | None -> state.paths
- | Some p -> p::state.paths in
- { state with current; paths }
-
- (* Click anywhere while in Out mode, we switch in edition *)
- | `Click _, Out ->
- Elements.Timer.start timer 0.3;
- { state with mode = Edit }
-
- (* Click anywhere while in selection mode, we either select another path,
- or switch to Out mode*)
- | `Click position, (Selection _) ->
- begin match check_selection position state.paths with
- | None ->
- { state with
- mode = Out }
- | Some selected ->
-
- (* Start the timer in order to handle the mouse moves *)
- Elements.Timer.start timer 0.3;
- { state with
- mode = (Selection selected)}
- end
-
- | `Out point, Edit ->
- Elements.Timer.stop timer;
- begin match Path_Builder.peek2 state.current with
- (* If there is at last two points selected, handle this as a curve
- creation *)
- | Some _ ->
- let current, fixed_path = insert_or_replace point state.current in
- let paths = match fixed_path with
- | None -> Path_Builder.to_fixed current::state.paths
- | Some p -> p::state.paths
- and current = Path_Builder.empty in
- { mode = Out
- ; paths; current }
-
- (* Else, check if there is a curve undre the cursor, and remove it *)
- | None ->
- let current = Path_Builder.empty in
- begin match check_selection point state.paths with
- | None ->
- { state with
- mode = Out
- ; current
- }
- | Some selected ->
- { state with
- mode = (Selection selected)
- ; 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}
-
-
- | `Export, _ ->
-
- let my_host = Uri.host @@ Window.location @@ G.window in
-
- if (Hashtbl.hash my_host) = expected_host then (
- (* Convert the path into an sVG element *)
- let svg = Layer.Svg.svg
- ~at:Brr.At.[
- v (Jstr.v "xmlns") (Jstr.v "http://www.w3.org/2000/svg")
- ; v (Jstr.v "xmlns:xlink") (Jstr.v "http://www.w3.org/1999/xlink") ]
- (List.map state.paths
- ~f:(fun path ->
- let repr = SVGRepr.create_path (fun _ -> ()) in
- let path = SVGRepr.get @@ SVG_Fixed_Printer.draw path repr in
-
- Layer.Svg.path
- ~at:Brr.At.[
- v (Jstr.v "fill") (Jstr.v "#000000")
- ; v (Jstr.v "stroke") (Jstr.v "#000000")
- ; v (Jstr.v "d") path ]
- []
- )) in
- let content = El.prop (El.Prop.jstr @@ Jstr.v "outerHTML") svg in
-
- let btoa = Jv.get Jv.global "btoa" in
- let base64data = Jv.apply btoa
- [| Jv.of_jstr content |] in
-
- (* Create the link to download the the element, and simulate a click on it *)
- let a = El.a
- ~at:At.[
- href Jstr.( (v "data:image/svg+xml;base64,") + (Jv.Id.of_jv base64data))
- ; v (Jstr.v "download") (Jstr.v "out.svg")
- ]
- [] in
- El.click a
+let click_event el =
+ Evr.on_el
+ Ev.click
+ Evr.unit
+ el
+
+let show_value input =
+ El.txt (Jstr.of_float input)
+
+let set_sidebar
+ : El.t -> State.state -> unit E.t * float S.t * float S.t *unit E.t
+ = fun element state ->
+
+ 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 export_event = click_event export in
+
+ let nib_size, nib_size_event =
+ Elements.Input.slider
+ ~at:At.[ type' (Jstr.v "range")
+ ; v (Jstr.v "min") (Jstr.v "1")
+ ; v (Jstr.v "max") (Jstr.v "50")
+ ; At.value (Jstr.of_float state.width)
+ ; id (Jstr.v "nib_size")
+ ] in
+
+ let width = El.div [] in
+ Elr.def_children
+ width
+ (nib_size_event
+ |> S.map (fun v ->
+ [ txt' "Width : "
+ ; show_value v ]
+ )
);
- state
- | _ -> state
+ let input_angle, angle_event =
+ Elements.Input.slider
+ ~at:At.[ type' (Jstr.v "range")
+ ; v (Jstr.v "min") (Jstr.v "1")
+ ; v (Jstr.v "max") (Jstr.v "90")
+ ; At.value (Jstr.of_float state.angle)
+ ] in
+ let angle = El.div [] in
+ Elr.def_children
+ angle
+ (angle_event
+ |> S.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 ()
-let backgroundColor = Jstr.v "#2e3440"
+ ; width
+ ; nib_size
+ ; El.br ()
+
+ ; angle
+ ; input_angle
+
+ ]
+ in
+ delete_event, angle_event, nib_size_event, export_event
+
+let backgroundColor = Blog.Nord.nord0
let white = Jstr.v "#eceff4"
let green = Jstr.v "#a3be8c"
let nord8 = Jstr.v "#81a1c1"
@@ -260,7 +174,6 @@ 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
@@ -282,9 +195,9 @@ let on_change canva mouse_position state =
*)
let pos = S.rough_value mouse_position in
let current, paths =
- begin match state.mode, pos with
+ begin match state.State.mode, pos with
| Edit, Some point ->
- begin match insert_or_replace point state.current with
+ begin match State.insert_or_replace state point state.current with
| current, None -> current, state.paths
| current, Some p -> current, p::state.paths
end
@@ -296,7 +209,8 @@ let on_change canva mouse_position state =
let path = CanvaRepr.get
@@ Path_Printer.draw
current
- (CanvaRepr.create_path (fun p -> fill context p)) in
+ (* (CanvaRepr.create_path (fun p -> fill context p)) in *)
+ (CanvaRepr.create_path (fun _ -> () )) in
stroke context path;
List.iter paths
@@ -325,24 +239,24 @@ let on_change canva mouse_position state =
let page_main id =
- let init =
- { paths = []
- ; current = Path_Builder.empty
- ; mode = Out
- } in
- let delete_event', export_event' =
+ let delete_event', angle_signal', width_signal', export_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
+ set_sidebar el State.init
end in
let delete_event = E.map (fun () -> `Delete) delete_event'
- and export_event = E.map (fun () -> `Export) export_event' in
+ and export_event = E.map (fun () -> `Export) export_event'
+ and angle_event = S.changes angle_signal'
+ |> E.map (fun value -> `Angle value)
+ and width_event = S.changes width_signal'
+ |> E.map (fun value -> `Width value)
+ in
+
(*begin match Document.find_el_by_id G.document id with*)
@@ -362,15 +276,21 @@ let page_main id =
let tick_event =
S.sample_filter mouse_position
- ~on:tick
+ ~on:State.tick
(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 *)
let state =
- E.select [canva_events; tick_event; delete_event; export_event]
- |> E.map do_action
- |> Note.S.accum init in
+ E.select
+ [ canva_events
+ ; tick_event
+ ; angle_event
+ ; width_event
+ ; delete_event
+ ; export_event ]
+ |> E.map State.do_action
+ |> Note.S.accum State.init in
(* The seconde evaluation is the canva refresh, which only occurs when
the mouse is updated, or on delete events *)
@@ -383,7 +303,7 @@ let page_main id =
(* Draw the canva for first time *)
- on_change canva mouse_position init;
+ on_change canva mouse_position State.init;
(* Hold the state *)
let _ = Logr.hold (S.log state (fun _ -> ())) in
diff --git a/state.ml b/state.ml
new file mode 100755
index 0000000..60796c8
--- /dev/null
+++ b/state.ml
@@ -0,0 +1,221 @@
+open StdLabels
+open Brr
+
+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 backgroundColor = Blog.Nord.nord0
+
+let timer, tick = Elements.Timer.create ()
+
+type mode =
+ | Edit
+ | Selection of Path_Builder.fixedPath
+ | Out
+
+type current = Path_Builder.t
+
+
+(** Events *)
+type canva_events =
+ [ `Click of float * float
+ | `Out of float * float
+ ]
+
+type button_events =
+ [ `Delete
+ | `Export
+ ]
+
+type events =
+ [ canva_events
+ | button_events
+ | `Point of float * (float * float)
+ | `Width of float
+ | `Angle of float
+ ]
+
+(*
+ The state cannt hold functionnal values, and thus cannot be used to store
+ elements like timer
+ *)
+type state =
+ { mode : mode
+ ; paths : Path_Builder.fixedPath list
+ ; current : current
+ ; width : float
+ ; angle : float
+ }
+
+let insert_or_replace state ((x, y) as p) path =
+ let width = state.width
+ and angle = state.angle in
+ let point = Path.Point.create ~x ~y ~angle ~width in
+ match Path_Builder.peek path with
+ | None ->
+ Path_Builder.add_point
+ point
+ path
+ | Some p1 ->
+ let open Gg.V2 in
+
+ let p1' = Path.Point.get_coord p1 in
+
+ let dist = (norm (p1' - (of_tuple p))) in
+ if dist < 5. then (
+ path, None
+ ) else (
+ Path_Builder.add_point
+ point
+ path
+ )
+
+let check_selection
+ : (float * float) -> Path_Builder.fixedPath list -> Path_Builder.fixedPath option
+ = fun position paths ->
+ let point = Gg.V2.of_tuple position in
+ (* If the user click on a curve, select it *)
+ List.fold_left paths
+ ~init:None
+ ~f:(fun selection path ->
+
+ match selection with
+ | Some p -> Some p
+ | None ->
+ (* TODO : Add a method in the point module *)
+ begin match Path_Builder.distance point path with
+ | Some p when p < 20. ->
+ Some path
+ | _ -> None
+ end
+ )
+
+
+let do_action
+ : events -> state -> state
+ = fun event state ->
+ match event, state.mode with
+ | `Point (_delay, point), Edit ->
+ (* Add the point in the list *)
+ let current, fixed_path = insert_or_replace
+ state
+ point
+ state.current in
+ let paths = match fixed_path with
+ | None -> state.paths
+ | Some p -> p::state.paths in
+ { state with current; paths }
+
+ (* Click anywhere while in Out mode, we switch in edition *)
+ | `Click _, Out ->
+ Elements.Timer.start timer 0.3;
+ { state with mode = Edit }
+
+ (* Click anywhere while in selection mode, we either select another path,
+ or switch to Out mode*)
+ | `Click position, (Selection _) ->
+ begin match check_selection position state.paths with
+ | None ->
+ { state with
+ mode = Out }
+ | Some selected ->
+
+ (* Start the timer in order to handle the mouse moves *)
+ Elements.Timer.start timer 0.3;
+ { state with
+ mode = (Selection selected)}
+ end
+
+ | `Out point, Edit ->
+ Elements.Timer.stop timer;
+ begin match Path_Builder.peek2 state.current with
+ (* If there is at last two points selected, handle this as a curve
+ creation *)
+ | Some _ ->
+ let current, fixed_path = insert_or_replace state point state.current in
+ let paths = match fixed_path with
+ | None -> Path_Builder.to_fixed current::state.paths
+ | Some p -> p::state.paths
+ and current = Path_Builder.empty in
+ { state with
+ mode = Out
+ ; paths; current }
+
+ (* Else, check if there is a curve undre the cursor, and remove it *)
+ | None ->
+ let current = Path_Builder.empty in
+ begin match check_selection point state.paths with
+ | None ->
+ { state with
+ mode = Out
+ ; current
+ }
+ | Some selected ->
+ { state with
+ mode = (Selection selected)
+ ; 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}
+
+
+ | `Export, _ ->
+
+ let my_host = Uri.host @@ Window.location @@ G.window in
+
+ if (Hashtbl.hash my_host) = expected_host then (
+ (* Convert the path into an sVG element *)
+ let svg = Layer.Svg.svg
+ ~at:Brr.At.[
+ v (Jstr.v "xmlns") (Jstr.v "http://www.w3.org/2000/svg")
+ ; v (Jstr.v "xmlns:xlink") (Jstr.v "http://www.w3.org/1999/xlink") ]
+ (List.map state.paths
+ ~f:(fun path ->
+ let repr = SVGRepr.create_path (fun _ -> ()) in
+ let path = SVGRepr.get @@ SVG_Fixed_Printer.draw path repr in
+
+ Layer.Svg.path
+ ~at:Brr.At.[
+ v (Jstr.v "fill") backgroundColor
+ ; v (Jstr.v "stroke") backgroundColor
+ ; v (Jstr.v "d") path ]
+ []
+ )) in
+ let content = El.prop Elements.Prop.outerHTML svg in
+
+ let btoa = Jv.get Jv.global "btoa" in
+ let base64data = Jv.apply btoa
+ [| Jv.of_jstr content |] in
+
+ (* Create the link to download the the element, and simulate a click on it *)
+ let a = El.a
+ ~at:At.[
+ href Jstr.( (v "data:image/svg+xml;base64,") + (Jv.Id.of_jv base64data))
+ ; v (Jstr.v "download") (Jstr.v "out.svg")
+ ]
+ [] in
+ El.click a
+ );
+ state
+
+ | `Angle angle, _ ->
+ { state with angle}
+ | `Width width, _ ->
+ { state with width}
+
+ | _ -> state
+
+let init =
+ { paths = []
+ ; current = Path_Builder.empty
+ ; mode = Out
+ ; angle = 30.
+ ; width = 10.
+ }
diff --git a/theme/dune b/theme/dune
deleted file mode 100755
index a812bef..0000000
--- a/theme/dune
+++ /dev/null
@@ -1,7 +0,0 @@
-(library
- (name theme)
- (libraries
- color
- gg
- )
- )
diff --git a/theme/nord.ml b/theme/nord.ml
deleted file mode 100755
index 4748d83..0000000
--- a/theme/nord.ml
+++ /dev/null
@@ -1,39 +0,0 @@
-open StdLabels
-
-let default = Color.of_rgb 5 255 255
-
-let theme =
- [| "#2e3440"
- ; "#3b4252"
- ; "#434c5e"
- ; "#4c566a"
- (* Bright *)
- ; "#d8dee9"
- ; ""
- ; "#eceff4"
- (* Frost *)
- ; "#8fbcbb"
- ; ""
- ; ""
- ; ""
- (* Aurora 11 - *)
- ; "#bf616a" (* Redd color *)
- ; ""
- ; ""
- ; "#a3be8c" (* Green color *)
-
-
- |]
- |> Array.map ~f:(fun f ->
- Color.of_hexstring f
- |> Option.value ~default
- )
-
-let set_color t f =
- let Color.Rgba'.{r; g; b; _ } = Color.to_rgba' (Array.get theme t) in
- f r g b
-
-
-let to_gg t =
- let Color.Rgba'.{r; g; b; _ } = Color.to_rgba' (Array.get theme t) in
- Gg.Color.of_srgb (Gg.V4.v r g b 1.)
diff --git a/theme/theme.ml b/theme/theme.ml
deleted file mode 100755
index 39974b1..0000000
--- a/theme/theme.ml
+++ /dev/null
@@ -1 +0,0 @@
-module Nord = Nord