aboutsummaryrefslogtreecommitdiff
path: root/script.ml
diff options
context:
space:
mode:
Diffstat (limited to 'script.ml')
-rwxr-xr-xscript.ml104
1 files changed, 70 insertions, 34 deletions
diff --git a/script.ml b/script.ml
index f97eed2..9cd8a22 100755
--- a/script.ml
+++ b/script.ml
@@ -12,7 +12,7 @@ type mode =
type current =
{ points : Point.t list (* The list of points to draw *)
- ; beziers : Curves.Bezier.t list (* All the points already fixed *)
+ ; beziers : Shapes.Bezier.t list (* All the points already fixed *)
}
type state =
@@ -30,7 +30,7 @@ type canva_events =
type events =
[ canva_events
- | `Point of float * float ]
+ | `Point of float * (float * float) ]
type canva_signal = Point.t
@@ -70,10 +70,10 @@ let do_action
: events -> state -> state
= fun event state ->
match event, state.mode with
- | `Point (x, y), Edit ->
+ | `Point (_delay, point), Edit ->
(* Add the point in the list *)
let points, beziers = Point.add_point_in_path
- x y
+ point
state.current.points
state.current.beziers in
@@ -83,13 +83,39 @@ let do_action
| `Click _, Out ->
Timer.start state.timer 0.3;
{ state with mode = Edit }
- | `Out (x, y), _ ->
+ | `Out p, 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
- x y
+ p
state.current.points
state.current.beziers in
+*)
let beziers = Draw.to_path (points, beziers) in
let paths = beziers::state.paths
@@ -131,7 +157,7 @@ let draw_path area points beziers =
let open Brr_canvas.C2d in
let connexion = match beziers with
| [] -> None
- | hd ::_ -> Some hd.Curves.Bezier.p1 in
+ | hd ::_ -> Some hd.Shapes.Bezier.p1 in
(* Firt draw all the points most recent points *)
let path = draw ?connexion ~area points in
@@ -140,9 +166,9 @@ let draw_path area points beziers =
~init:path
~f:(fun path bezier ->
- let cx, cy = Draw.translate_point ~area bezier.Curves.Bezier.ctrl0
- and cx', cy' = Draw.translate_point ~area bezier.Curves.Bezier.ctrl1
- and x, y = Draw.translate_point ~area bezier.Curves.Bezier.p1 in
+ let cx, cy = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl0
+ and cx', cy' = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl1
+ and x, y = Draw.translate_point ~area bezier.Shapes.Bezier.p1 in
Path.ccurve_to path
~cx ~cy
@@ -178,38 +204,48 @@ let on_change canva mouse_position state =
let pos = S.rough_value mouse_position in
let points =
match state.mode, pos with
- | Edit, Some (x, y) -> (Point.create x y)::state.current.points
- | _ -> state.current.points in
+ | Edit, Some (x, y) ->
+ (Point.create x y)::state.current.points
+ | _ ->
+ set_image_smoothing_enabled context true;
+ set_image_smoothing_quality context Image_smoothing_quality.high;
+ state.current.points in
let path = draw_path area (points) state.current.beziers in
stroke context path;
List.iter state.paths
~f:(fun path ->
- let p = Path.create () in
- Draw.move_to ~area p path.Draw.path;
- Draw.draw ~area p path.Draw.path;
- Draw.go_back ~area p path.Draw.path;
- fill ~fill_rule:Fill_rule.nonzero context p;
-(*
+ (* This is ugly, and probably non efficient, but is an appropriate solution for
+ the cases of overlapping path *)
match path.Draw.path with
- | Curve c ->
- let c' = Array.init
- (Array.length c)
- ~f:(fun i ->
- Curves.Bezier.reverse @@ Array.get c ((Array.length c) -i - 1)
- )
- in
- let p' = Draw.Curve c' in
- Draw.move_to ~area p p';
- Draw.draw ~area p p';
- Draw.go_back ~area p p';
- fill ~fill_rule:Fill_rule.nonzero context p;
- ()
- | _ -> ()
-*)
+ | Draw.Curve beziers ->
+
+ Array.iter beziers
+ ~f:(fun bezier ->
+
+ let b = Draw.Curve [|bezier|] in
+ let p = Path.create () in
+ Draw.move_to ~area p b;
+ Draw.draw ~area p b;
+ Draw.go_back ~area p b;
+ Path.close p;
+ fill context p;
+ stroke context p
+
+
+ )
+
+ | _ ->
+ let p = Path.create () in
+ Draw.move_to ~area p path.Draw.path;
+ Draw.draw ~area p path.Draw.path;
+ Draw.go_back ~area p path.Draw.path;
+ Path.close p;
+ fill context p;
+ stroke context p
);
()
@@ -236,7 +272,7 @@ let page_main id =
let tick_event =
S.sample_filter mouse_position
~on:tick
- (fun pos () -> Option.map (fun p -> `Point p) pos ) in
+ (fun pos f -> Option.map (fun p -> `Point (f, p)) pos ) in
(* The first evaluation is the state. Which is the result of all the
successives events to the initial state *)