diff options
| -rwxr-xr-x | path/builder.ml | 86 | ||||
| -rwxr-xr-x | path/builder.mli | 33 | ||||
| -rwxr-xr-x | path/draw.ml | 4 | ||||
| -rwxr-xr-x | path/point.ml | 54 | ||||
| -rwxr-xr-x | path/point.mli | 3 | ||||
| -rwxr-xr-x | script.ml | 99 |
6 files changed, 164 insertions, 115 deletions
diff --git a/path/builder.ml b/path/builder.ml new file mode 100755 index 0000000..f52fb9e --- /dev/null +++ b/path/builder.ml @@ -0,0 +1,86 @@ +(** Signature for points *) +module type P = sig + type t + + val get_coord : t -> Gg.v2 + +end + +module Make(P:P) = struct + + type t = P.t list * Shapes.Bezier.t list + + let get_new_segment connexion0 p5 p4 p3 p2 p1 = + let p5' = P.get_coord p5 + and p4' = P.get_coord p4 + and p3' = P.get_coord p3 + and p2' = P.get_coord p2 + and p1' = P.get_coord p1 in + + let points_to_link = + [ p1' + ; p2' + ; p3' + ; p4' + ; p5' ] in + Shapes.Bspline.to_bezier ?connexion0 points_to_link + + let empty = ([], []) + + let add_point + : P.t -> t -> t + = fun lastPoint (path, beziers) -> + let (let*) v f = + match v with + | Ok bezier -> + if Array.length bezier > 0 then + f (Array.get bezier 0) + else + lastPoint::path, beziers + | _ -> + lastPoint::path, beziers + in + + let connexion0 = match beziers with + | hd::_ -> Some hd.Shapes.Bezier.p1 + | _ -> None in + + match path with + | p4::p3::p2::p1::_ -> + let* bezier = get_new_segment connexion0 + lastPoint p4 p3 p2 p1 in + (* We remove the last point and add the bezier curve in the list*) + let firsts = lastPoint::p4::p3::p2::[] in + firsts, (Shapes.Bezier.reverse bezier)::beziers + | _ -> + lastPoint::path, beziers + + let replace_last + : P.t -> t -> t + = fun lastPoint ((path, beziers) as t) -> + match path, beziers with + | _::(tl), beziers -> + lastPoint::tl + , beziers + | _ -> + add_point lastPoint t + + let peek2 + : t -> (P.t * P.t) option + = fun (path, _) -> + match path with + | h1::h2::_ -> Some (h1, h2) + | _ -> None + + let peek + : t -> P.t option + = fun (path, _) -> + match path with + | [] -> None + | hd::_ -> Some hd + + let get + : t -> t + = fun t -> t + +end diff --git a/path/builder.mli b/path/builder.mli new file mode 100755 index 0000000..d99e0b2 --- /dev/null +++ b/path/builder.mli @@ -0,0 +1,33 @@ +(** Signature for points *) +module type P = sig + type t + + val get_coord : t -> Gg.v2 +end + + +module Make(P:P) : sig + + type t + + (** Create an empty path *) + val empty: t + + val add_point + : P.t -> t -> t + + (** Replace the last alement in the path by the one given in parameter *) + val replace_last + : P.t -> t -> t + + (** Retrieve the last element, if any *) + val peek + : t -> P.t option + + (** Retrieve the last element, if any *) + val peek2 + : t -> (P.t * P.t) option + + val get + : t -> P.t list * Shapes.Bezier.t list +end diff --git a/path/draw.ml b/path/draw.ml index 757c778..ba5272a 100755 --- a/path/draw.ml +++ b/path/draw.ml @@ -2,6 +2,7 @@ open StdLabels module Path = Brr_canvas.C2d.Path module Point = Point +module Builder = Builder (** Translate the point in the canva area *) let translate_point @@ -17,7 +18,6 @@ let translate_point' translate_point ~area (point + vect) - (* Draw a straight line between two points *) let line : Gg.v2 -> p1:Point.t -> Path.t -> unit @@ -138,7 +138,7 @@ let go_back : ?connexion:Point.t -> area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit = fun ?connexion ~area canvaPath path -> let vect = Gg.V2.of_polar @@ Gg.V2.v - 0.02 + 0.01 Gg.Float.pi_div_4 in match connexion, path with diff --git a/path/point.ml b/path/point.ml index 91b68c2..9e10200 100755 --- a/path/point.ml +++ b/path/point.ml @@ -1,5 +1,3 @@ -open StdLabels - type t = { p: Gg.v2 ; size : float @@ -24,55 +22,3 @@ let get_coord' let trans = of_polar @@ v t.size t.angle in t.p + trans -let return_segment - : Shapes.Bezier.t -> Shapes.Bezier.t list -> Shapes.Bezier.t list - = fun bezier beziers -> - (* We gave the points in reverse order, so we have to revert the - curve *) - let bezier' = Shapes.Bezier.reverse bezier in - bezier'::beziers - - -let get_new_segment connexion0 p5 p4 p3 p2 p1 = - let p5' = get_coord p5 - and p4' = get_coord p4 - and p3' = get_coord p3 - and p2' = get_coord p2 - and p1' = get_coord p1 in - - let points_to_link = - [ p1' - ; p2' - ; p3' - ; p4' - ; p5' ] in - Shapes.Bspline.to_bezier ?connexion0 points_to_link - -let add_point_in_path - : float * float -> t list -> Shapes.Bezier.t list -> t list * Shapes.Bezier.t list - = fun (x, y) path beziers -> - let lastClick = create x y in - let (let*) v f = - match v with - | Ok bezier -> - if Array.length bezier > 0 then - f (Array.get bezier 0) - else - lastClick::path, beziers - | _ -> - lastClick::path, beziers - in - - let connexion0 = match beziers with - | hd::_ -> Some hd.Shapes.Bezier.p1 - | _ -> None in - - match path with - | p4::p3::p2::p1::_ -> - let* bezier = get_new_segment connexion0 - lastClick p4 p3 p2 p1 in - (* We remove the last point and add the bezier curve in the list*) - let firsts = lastClick::p4::p3::p2::[] in - firsts, return_segment bezier beziers - | _ -> - lastClick::path, beziers diff --git a/path/point.mli b/path/point.mli index 068f4c1..4b75c3c 100755 --- a/path/point.mli +++ b/path/point.mli @@ -6,8 +6,5 @@ val get_coord : t -> Gg.v2 val create: float -> float -> t -val add_point_in_path - : (float * float) -> t list -> Shapes.Bezier.t list -> t list * Shapes.Bezier.t list - val get_coord' : t -> Gg.v2 @@ -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 |