From 6ae97ecca8b4f38213f0f45aa6eaef944cd6b497 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Tue, 5 Jan 2021 21:43:08 +0100 Subject: Responsive sliders --- script.it/script.ml | 88 ++++++++++++++++++++++++++++++++++------------------- script.it/state.ml | 52 ++++++++++++++++--------------- 2 files changed, 84 insertions(+), 56 deletions(-) (limited to 'script.it') diff --git a/script.it/script.ml b/script.it/script.ml index 131ea39..95272fb 100755 --- a/script.it/script.ml +++ b/script.it/script.ml @@ -77,9 +77,6 @@ let click_event el = Evr.unit el -let show_value input = - El.txt (Jstr.of_float input) - type 'a param_events = { width : float S.t ; angle : float S.t @@ -88,8 +85,12 @@ type 'a param_events = ; rendering : ([> State.render_event] as 'a) E.t } +type slider = + { input : El.t + ; legend : El.t } + let set_sidebar - : El.t -> State.state -> _ param_events + : El.t -> State.state -> _ param_events * slider * slider = fun element state -> let open El in @@ -122,14 +123,9 @@ let set_sidebar ] in let width = El.div [] in - Elr.def_children - width - (nib_size_event - |> S.map (fun v -> - [ txt' "Width : " - ; show_value v ] - ) - ); + let width_slider = + { input = nib_size + ; legend = width } in let input_angle, angle_event = Elements.Input.slider @@ -140,15 +136,9 @@ let set_sidebar ] in let angle = El.div [] in - Elr.def_children - angle - (angle_event - |> S.map (fun v -> - [ txt' "Angle : " - ; show_value v - ; txt' "°" ] - ) - ); + let angle_slider = + { input = input_angle + ; legend = angle } in let render = El.select @@ -156,10 +146,6 @@ let set_sidebar [ txt' "Fill"] ; El.option ~at:At.[value (Jstr.v "2")] [ txt' "Ductus"] -(* - ; El.option ~at:At.[value (Jstr.v "3")] - [ txt' "Line"] -*) ] in let rendering' = El.div @@ -196,12 +182,14 @@ let set_sidebar ] in - { delete = delete_event - ; angle = angle_event - ; width = nib_size_event - ; export = export_event - ; rendering = render_event - } + ( { delete = delete_event + ; angle = angle_event + ; width = nib_size_event + ; export = export_event + ; rendering = render_event } + , angle_slider + , width_slider + ) let backgroundColor = Blog.Nord.nord0 let white = Jstr.v "#eceff4" @@ -275,7 +263,7 @@ let page_main id = let timer, tick = Elements.Timer.create () in - let parameters = + let parameters, angle_element, width_slider = begin match Blog.Sidebar.get () with | None -> Jv.throw (Jstr.v "No sidebar") @@ -284,6 +272,8 @@ let page_main id = Blog.Sidebar.clean el; set_sidebar el State.init end in + + let delete_event = E.map (fun () -> `Delete) parameters.delete and export_event = E.map (fun () -> `Export) parameters.export and angle_event = S.changes parameters.angle @@ -359,6 +349,40 @@ let page_main id = |> Option.iter Logr.hold in + + (* Ajust the angle slide according to the state *) + let angle_signal = S.map (fun s -> Jstr.of_float s.State.angle) state in + let _ = + Elr.def_prop + Elements.Prop.value + angle_signal + angle_element.input + + and _ = Elr.def_children + angle_element.legend + (S.map + (fun v -> + [ El.txt' "Angle : " + ; El.txt v + ; El.txt' "°" ] ) + angle_signal) in + + let width_signal = S.map (fun s -> Jstr.of_float s.State.width) state in + let _ = + Elr.def_prop + Elements.Prop.value + width_signal + width_slider.input + + and _ = Elr.def_children + width_slider.legend + (S.map (fun v -> + [ El.txt' "Width : " + ; El.txt v ] + ) + width_signal + ) in + (* Draw the canva for first time *) on_change canva mouse_position timer State.init; diff --git a/script.it/state.ml b/script.it/state.ml index cfde0b0..53cc861 100755 --- a/script.it/state.ml +++ b/script.it/state.ml @@ -77,7 +77,7 @@ let insert_or_replace state ((x, y) as p) stamp path = let threshold = 20. let check_selection - : (float * float) -> Path.Fixed.t list -> (Gg.v2 * Path.Fixed.t) option + : (float * float) -> Path.Fixed.t list -> (Gg.v2 * Path.Fixed.t * Path.Point.t * Path.Point.t) option = fun position paths -> let point = Gg.V2.of_tuple position in (* If the user click on a curve, select it *) @@ -85,8 +85,8 @@ let check_selection ~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) + | Some (point', p, p0, p1) when p < dist -> + dist, Some (point', path, p0, p1) | _ -> dist, selection ) in res @@ -104,6 +104,24 @@ let update_selection id state f = ) in { state with paths } + +let select_segment point (p, selected, p0, p1) state = + let angle0 = Path.Point.get_angle p0 + and angle1 = Path.Point.get_angle p1 in + let width0 = Path.Point.get_width p0 + and width1 = Path.Point.get_width p1 in + + let dist = Gg.V2.(norm ( p - (Gg.V2.of_tuple point))) in + + let angle = angle0 +. dist *. ( angle1 -. angle0 ) in + let width = width0 +. dist *. ( width1 -. width0 ) in + + let id = Path.Fixed.id selected in + { state with + mode = (Selection id) + ; angle + ; width } + let do_action : Brr_webworkers.Worker.t -> Elements.Timer.t -> events -> state -> state = fun worker timer event state -> @@ -130,7 +148,7 @@ let do_action | None -> (* Start a new path with the point clicked *) Path.Point.create ~x ~y ~angle ~width ~stamp - | Some (p, _) -> + | 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 @@ -149,14 +167,8 @@ let do_action | 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)} + | Some selection -> + select_segment position selection state end | `Out point, Edit -> @@ -167,12 +179,6 @@ let do_action 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 stamp state.current in let paths = let last = Path.Fixed.to_fixed @@ -191,7 +197,7 @@ let do_action mode = Out ; paths; current } - (* Else, check if there is a curve undre the cursor, and remove it *) + (* Else, check if there is a curve under the cursor, and remove it *) | None -> let current = Path.Path_Builder.empty in begin match check_selection point state.paths with @@ -200,11 +206,9 @@ let do_action mode = Out ; current } - | Some (_, selected) -> - let id = Path.Fixed.id selected in - { state with - mode = (Selection id) - ; current } + | Some selection -> + select_segment point selection { state with current } + end end | `Delete, Selection id -> -- cgit v1.2.3