From 20addbe8fd0ac4c79c8a69a4f888ec320a9ca4c3 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sat, 2 Jan 2021 16:20:42 +0100 Subject: Refactor --- state.ml | 266 --------------------------------------------------------------- 1 file changed, 266 deletions(-) delete mode 100755 state.ml (limited to 'state.ml') diff --git a/state.ml b/state.ml deleted file mode 100755 index 5a1ef8f..0000000 --- a/state.ml +++ /dev/null @@ -1,266 +0,0 @@ -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