aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-01-10 17:05:47 +0100
committerSébastien Dailly <sebastien@chimrod.com>2021-01-11 13:55:42 +0100
commit12e99cb08790b9e67913e4137da4a4dbcb82f362 (patch)
treed8d89742df8bfc34c727007e0633261f2690f0a4
parent143994822a98df2afe14431f879b90d5e3a7922c (diff)
Update compilation rule
-rwxr-xr-xblog/dune4
-rwxr-xr-xpath/fixed.ml70
-rwxr-xr-xscript.it/script.ml14
3 files changed, 43 insertions, 45 deletions
diff --git a/blog/dune b/blog/dune
index c38558e..648990f 100755
--- a/blog/dune
+++ b/blog/dune
@@ -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