aboutsummaryrefslogtreecommitdiff
path: root/script.ml
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2020-12-17 22:29:25 +0100
committerSébastien Dailly <sebastien@chimrod.com>2020-12-17 22:29:25 +0100
commite5c2a971644746818f8764481c60c4c5cf1a80c4 (patch)
tree2719a0c0c64f71c3277addb33ab1562602ba10cc /script.ml
parent20d10a93e5becb41d1145f9d35136782365b0ba4 (diff)
Moved path builder in a dedicated file
Diffstat (limited to 'script.ml')
-rwxr-xr-xscript.ml99
1 files changed, 43 insertions, 56 deletions
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