diff options
| -rwxr-xr-x | blog/dune | 4 | ||||
| -rwxr-xr-x | path/fixed.ml | 70 | ||||
| -rwxr-xr-x | script.it/script.ml | 14 |
3 files changed, 43 insertions, 45 deletions
@@ -1,12 +1,12 @@ (rule (targets hash_host.ml) (enabled_if (= %{profile} dev)) - (action (run cp hash_host/hash_localhost.ml hash_host.ml))) + (action (copy# hash_host/hash_localhost.ml hash_host.ml))) (rule (targets hash_host.ml) (enabled_if (<> %{profile} dev)) - (action (run cp hash_host/hash_blog.ml hash_host.ml))) + (action (copy# hash_host/hash_blog.ml hash_host.ml))) (library (name blog) diff --git a/path/fixed.ml b/path/fixed.ml index 0a9eace..08b9c2b 100755 --- a/path/fixed.ml +++ b/path/fixed.ml @@ -15,9 +15,10 @@ end module Make(Point:P) = struct type bezier = - { p1:Point.t (* The end point *) - ; ctrl0:Gg.v2 (* The control point *) - ; ctrl1:Gg.v2 } (* The control point *) + { ctrl0:Gg.v2 (* The control point *) + ; ctrl1:Gg.v2 (* The control point *) + ; p1:Point.t (* The end point *) + } module type BUILDER = sig type t @@ -38,7 +39,8 @@ module Make(Point:P) = struct type t = { id: int - ; path : step array } + ; path : step array + } let id : t -> int @@ -116,19 +118,14 @@ module Make(Point:P) = struct let _, repr = Array.fold_left path ~init:(true, repr) ~f:(fun (first, path) element -> + let path = if first then + Repr.start element.point path + else path in match element.move with | Line p1 -> - - let path = if first then - Repr.start element.point path - else path in - ( false , Repr.line_to element.point p1 path ) | Curve bezier -> - let path = if first then - Repr.start element.point path - else path in ( false , repr_bezier path element.point bezier ) ) in @@ -215,10 +212,6 @@ module Make(Point:P) = struct | Line p1 -> p1 | Curve bezier -> bezier.p1 - let first_point' - : step -> Point.t - = fun {point; _} -> point - (** Associate the return from the bezier point to an existing path *) let assoc_point : Shapes.Bezier.t -> step -> step @@ -290,8 +283,8 @@ module Make(Point:P) = struct ; move = Line p1 } |]} end | 2 -> - let p0 = first_point' @@ Array.get path 0 - and p1 = first_point' @@ Array.get path 1 + let p0 = (Array.get path 0).point + and p1 = (Array.get path 1).point and p2 = get_point' @@ Array.get path 1 in Some (build_from_three_points id p0 p1 p2) @@ -301,7 +294,7 @@ module Make(Point:P) = struct let points = List.init ~len:((Array.length path) ) ~f:(fun i -> Point.get_coord @@ get_point' (Array.get path i)) in - let p0 = Point.get_coord @@ first_point' (Array.get path 0)in + let p0 = Point.get_coord @@ (Array.get path 0).point in let points = p0::points in @@ -327,17 +320,16 @@ module Make(Point:P) = struct let _ = Array.exists path ~f:(fun element -> - - let res = match element.move with - | Line p1 - | Curve {p1;_} -> - if (Point.id element.point) = (Point.id point) then ( - idx := Some (!counter) ; - true - ) else if (Point.id p1) = (Point.id point) then ( + let res = + if (Point.id element.point) = (Point.id point) then ( + idx := Some (!counter) ; + true + ) else match element.move with + | Line p1 + | Curve {p1;_} when (Point.id p1) = (Point.id point) -> idx := Some (!counter+1) ; true - ) else + | _ -> false in incr counter; @@ -353,8 +345,8 @@ module Make(Point:P) = struct | 1 -> None | 2 -> (* Two segment, we get the points and transform this into a single line *) - let p0 = first_point' @@ Array.get path 0 - and p1 = first_point' @@ Array.get path 1 + let p0 = (Array.get path 0).point + and p1 = (Array.get path 1).point and p2 = get_point' @@ Array.get path 1 in let elms = List.filter [p0; p1; p2] ~f:(fun pt -> Point.id pt != Point.id point) in @@ -391,7 +383,7 @@ module Make(Point:P) = struct We have to rebuild the point and set that point_(-1).id = point_(+1).id *) - let p0 = first_point' (Array.get path i) in + let p0 = (Array.get path i).point in match (Array.get path (i+1)).move with | Line p1 -> @@ -408,6 +400,10 @@ module Make(Point:P) = struct { id ; path=path'} + let first_point + : step -> Point.t + = fun {point; _} -> point + let replace_point : t -> Point.t -> t option = fun {id; path } p -> @@ -435,8 +431,8 @@ module Make(Point:P) = struct end | 2 -> - let p0 = first_point' @@ Array.get path 0 - and p1 = first_point' @@ Array.get path 1 + let p0 = (Array.get path 0).point + and p1 = (Array.get path 1).point and p2 = get_point' @@ Array.get path 1 in let p0 = if (Point.id p0 = Point.id p) then p else p0 @@ -456,15 +452,15 @@ module Make(Point:P) = struct if n < Array.length path then p, get_point' (Array.get path n) else - first_point' (Array.get path (n -1)), p + (Array.get path (n -1)).point, p in let min_idx = max (n-3) 0 in let points = - add_path path (n-3) first_point' - @@ add_path path (n-2) first_point' - @@ add_path path (n-1) first_point' + add_path path (n-3) first_point + @@ add_path path (n-2) first_point + @@ add_path path (n-1) first_point @@ (fun tl -> (Point.get_coord p)::tl) @@ add_path path n get_point' @@ add_path path (n+1) get_point' diff --git a/script.it/script.ml b/script.it/script.ml index 3133269..ffdff9a 100755 --- a/script.it/script.ml +++ b/script.it/script.ml @@ -54,12 +54,14 @@ let canva let position = Brr_note_kit.Mouse.pos mouse in - let pos = S.l2 (fun b pos -> - if b then - Some pos - else - None - ) (Brr_note_kit.Mouse.left mouse) position in + let pos = S.l2 + (fun b pos -> + if b then + Some pos + else + None ) + (Brr_note_kit.Mouse.left mouse) + position in E.select [click; up], pos, c |