From 9d65e5e6a5bd8666baf0d7d3e0474c721cafc683 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 28 Dec 2020 21:17:20 +0100 Subject: Fixed width and angle sliddes --- state.ml | 221 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 221 insertions(+) create mode 100755 state.ml (limited to 'state.ml') 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. + } -- cgit v1.2.3