From e5c2a971644746818f8764481c60c4c5cf1a80c4 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Thu, 17 Dec 2020 22:29:25 +0100 Subject: Moved path builder in a dedicated file --- script.ml | 99 +++++++++++++++++++++++++++------------------------------------ 1 file changed, 43 insertions(+), 56 deletions(-) (limited to 'script.ml') diff --git a/script.ml b/script.ml index 9cd8a22..f7db9d3 100755 --- a/script.ml +++ b/script.ml @@ -5,15 +5,15 @@ open Brr module Timer = Events.Timer module Point = Draw.Point +module Path = Draw + +module Path_Builder = Path.Builder.Make(Point) type mode = | Edit | Out -type current = - { points : Point.t list (* The list of points to draw *) - ; beziers : Shapes.Bezier.t list (* All the points already fixed *) - } +type current = Path_Builder.t type state = { mode : mode @@ -66,60 +66,47 @@ let canva E.select [click; up], pos, c +let insert_or_replace ((x, y) as p) path = + let point = 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' = Point.get_coord p1 in + + let dist = (norm (p1' - (of_tuple p))) in + if dist < 0.05 then ( + path + ) else ( + Path_Builder.add_point + point + path + ) + let do_action : events -> state -> state = fun event state -> match event, state.mode with - | `Point (_delay, point), Edit -> + | `Point (_delay, (x, y)), Edit -> (* Add the point in the list *) - let points, beziers = Point.add_point_in_path - point - state.current.points - state.current.beziers in - - let current= {points; beziers} in - + let current= Path_Builder.add_point + (Point.create x y) + state.current in { state with current } + | `Click _, Out -> Timer.start state.timer 0.3; { state with mode = Edit } - | `Out p, Edit -> + | `Out point, Edit -> Timer.stop state.timer; - (* Add the point in the list *) - - let points, beziers = match state.current.points, state.current.beziers with - | hd::(tl), beziers -> - - let open Gg.V2 in - let p' = of_tuple p - and hd' = Point.get_coord hd in - if (norm (hd' - p' )) < 0.05 then - (Point.create (fst p) (snd p))::tl - , beziers - else ( - Point.add_point_in_path - p - state.current.points - state.current.beziers - ) - | _ -> - Point.add_point_in_path - p - state.current.points - state.current.beziers - in - - -(* - let points, beziers = Point.add_point_in_path - p - state.current.points - state.current.beziers in -*) - let beziers = Draw.to_path (points, beziers) in - + let current = insert_or_replace point state.current in + let beziers = Draw.to_path @@ Path_Builder.get current in let paths = beziers::state.paths - and current = { points = []; beziers = []} in + and current = Path_Builder.empty in { state with mode = Out; paths; current } | _ -> state @@ -195,6 +182,7 @@ let on_change canva mouse_position state = set_stroke_style context (color white); set_fill_style context (color white); + (* If we are in edit mode, we add a point under the cursor. Otherwise, we would only display the previous registered point, which can @@ -202,16 +190,17 @@ let on_change canva mouse_position state = *) let pos = S.rough_value mouse_position in - let points = + let current = match state.mode, pos with | Edit, Some (x, y) -> - (Point.create x y)::state.current.points + Path_Builder.add_point (Point.create x y) state.current | _ -> - set_image_smoothing_enabled context true; - set_image_smoothing_quality context Image_smoothing_quality.high; - state.current.points in + state.current + in + + let points, beziers = Path_Builder.get current in - let path = draw_path area (points) state.current.beziers in + let path = draw_path area (points) beziers in stroke context path; List.iter state.paths @@ -234,7 +223,6 @@ let on_change canva mouse_position state = fill context p; stroke context p - ) | _ -> @@ -256,8 +244,7 @@ let page_main id = let init = { paths = [] - ; current = { points = [] - ; beziers = [] } + ; current = Path_Builder.empty ; mode = Out ; timer } in -- cgit v1.2.3