From 20addbe8fd0ac4c79c8a69a4f888ec320a9ca4c3 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sat, 2 Jan 2021 16:20:42 +0100 Subject: Refactor --- script.it/state.ml | 266 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 266 insertions(+) create mode 100755 script.it/state.ml (limited to 'script.it/state.ml') diff --git a/script.it/state.ml b/script.it/state.ml new file mode 100755 index 0000000..5a1ef8f --- /dev/null +++ b/script.it/state.ml @@ -0,0 +1,266 @@ +open StdLabels +open Brr + +let expected_host = Blog.Hash_host.expected_host + +let backgroundColor = Blog.Nord.nord0 + +let timer, tick = Elements.Timer.create () + +type mode = + | Edit + | Selection of int + | Out + +(** 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 cant hold functionnal values, and thus cannot be used to store + elements like timer + *) +type state = + { mode : mode + ; paths : Path.Fixed.t list + ; current : Path.Path_Builder.t + ; 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.Path_Builder.peek path with + | None -> + Path.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 + ) else ( + Path.Path_Builder.add_point + point + path + ) + +let threshold = 20. + +let check_selection + : (float * float) -> Path.Fixed.t list -> (Gg.v2 * Path.Fixed.t) option + = fun position paths -> + let point = Gg.V2.of_tuple position in + (* If the user click on a curve, select it *) + let _, res = List.fold_left paths + ~init:(threshold, None) + ~f:(fun (dist, selection) path -> + match Path.Fixed.distance point path with + | Some (point', p) when p < dist -> + dist, Some (point', path) + | _ -> dist, selection + ) in + res + +(** Update the path in the selection with the given function applied to + every point *) +let update_selection id state f = + + let paths = List.map state.paths + ~f:(fun path -> + let id' = Path.Fixed.id path in + match id = id' with + | false -> path + | true -> Path.Fixed.map_point path f + ) in + { state with paths } + +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 = insert_or_replace + state + point + state.current in + { state with current } + + (* Click anywhere while in Out mode, we switch in edition *) + | `Click ((x, y) as p), Out -> + Elements.Timer.start timer 0.3; + + let width = state.width + and angle = state.angle in + + let point = + match check_selection p state.paths with + | None -> + (* Start a new path with the point clicked *) + Path.Point.create ~x ~y ~angle ~width + | Some (p, _) -> + (* If the point is close to an existing path, we use the closest + point in the path instead *) + let x, y = Gg.V2.to_tuple p in + Path.Point.create ~x ~y ~angle ~width + in + + let current = Path.Path_Builder.add_point + point + state.current in + { state with current; 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 *) + + let id = Path.Fixed.id selected in + Elements.Timer.start timer 0.3; + { state with + mode = (Selection id)} + end + + | `Out point, Edit -> + Elements.Timer.stop timer; + begin match Path.Path_Builder.peek2 state.current with + (* If there is at last two points selected, handle this as a curve + creation. And we add the new point in the current path *) + | Some _ -> + +(* + let point = match check_selection point state.paths with + | None -> point + | Some (p, _) -> Gg.V2.to_tuple p in +*) + + let current = insert_or_replace state point state.current in + let paths = + let last = Path.Fixed.to_fixed + (module Path.Path_Builder) + current + in + last::state.paths + and current = Path.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.Path_Builder.empty in + begin match check_selection point state.paths with + | None -> + { state with + mode = Out + ; current + } + | Some (_, selected) -> + let id = Path.Fixed.id selected in + { state with + mode = (Selection id) + ; current } + end + end + | `Delete, Selection id -> + let paths = List.filter state.paths ~f:(fun p -> Path.Fixed.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 -> + + Path.to_svg + ~color:backgroundColor + (module Path.Fixed) + path + `Fill + + )) 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 + + (* 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} + + | `Delete, Out + -> state + + (* Some non possible cases *) + | `Out _, Out + | `Point _, Out + | `Point _, Selection _ + | `Out _, Selection _ + | `Click _, Edit + | `Delete, Edit + -> state + +let init = + { paths = [] + ; current = Path.Path_Builder.empty + ; mode = Out + ; angle = 30. + ; width = 10. + } -- cgit v1.2.3