summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-01-07 14:20:54 +0100
committerSébastien Dailly <sebastien@chimrod.com>2021-01-07 14:20:54 +0100
commit21c386fee208adb7b494d2677d9f49ed49a1c1ce (patch)
treeb1c77a0c1870768a4876ec58cc06962768a3fe75
parent06c39bbea3b7f8e6bfec88878ec80f9cc474184f (diff)
Local point configuration
-rwxr-xr-xlayer/ductusPrinter.ml11
-rwxr-xr-xpath/fixed.ml57
-rwxr-xr-xpath/fixed.mli3
-rwxr-xr-xpath/point.ml18
-rwxr-xr-xpath/point.mli11
-rwxr-xr-xscript.it/script.ml6
-rwxr-xr-xscript.it/state.ml153
-rwxr-xr-xscript.it/worker.ml5
8 files changed, 181 insertions, 83 deletions
diff --git a/layer/ductusPrinter.ml b/layer/ductusPrinter.ml
index 3ed1c3c..2ee96e4 100755
--- a/layer/ductusPrinter.ml
+++ b/layer/ductusPrinter.ml
@@ -46,11 +46,14 @@ module Make(Repr: Repr.PRINTER) = struct
recent point *)
let delay =
((Path.Point.get_stamp p0) -. (Path.Point.get_stamp p1))
- *. 100. /. 3.
+ *. 20.
in
- for i = 0 to (Int.of_float delay) do
- let bezier', _ = Shapes.Bezier.slice (0.1 *. (Float.of_int i)) bezier in
- let point = Path.Point.copy p1 bezier'.Shapes.Bezier.p1 in
+ for i = 0 to ((Int.of_float delay) -1) do
+ let ratio = (Float.of_int i) /. delay in
+ let bezier', _ = Shapes.Bezier.slice ratio bezier in
+
+ let point = Path.Point.mix ratio bezier'.Shapes.Bezier.p1 p0 p1 in
+
path := Repr.move_to (Path.Point.get_coord point) !path;
path := Repr.line_to (Path.Point.get_coord' point) !path;
done;
diff --git a/path/fixed.ml b/path/fixed.ml
index cb2c27f..2d42566 100755
--- a/path/fixed.ml
+++ b/path/fixed.ml
@@ -6,6 +6,8 @@ module type P = sig
val get_coord : t -> Gg.v2
+ val id : t -> int
+
end
module Make(Point:P) = struct
@@ -24,7 +26,6 @@ module Make(Point:P) = struct
; ctrl1:Gg.v2 } (* The control point *)
type path =
- | Empty
| Line of Point.t * Point.t
| Curve of bezier
@@ -74,7 +75,8 @@ module Make(Point:P) = struct
let get
: int * path list -> path array
= fun (n, t) ->
- let res = Array.make n Empty in
+
+ let res = Obj.magic (Array.make n 0) in
List.iteri t
~f:(fun i elem -> Array.set res (n - i - 1) elem );
res
@@ -106,7 +108,6 @@ module Make(Point:P) = struct
~init:(true, repr)
~f:(fun (first, path) element ->
match element with
- | Empty -> (true, path)
| Line (p0, p1) ->
let path = if first then
@@ -133,7 +134,6 @@ module Make(Point:P) = struct
Array.fold_left beziers.path
~init:None
~f:(fun res -> function
- | Empty -> None
| Line (p0, p1) ->
let box = Gg.Box2.of_pts (Point.get_coord p0) (Point.get_coord p1) in
begin match Gg.Box2.mem point box with
@@ -164,7 +164,6 @@ module Make(Point:P) = struct
= fun {id; path} f ->
let path = Array.map path
~f:(function
- | Empty -> Empty
| Line (p1, p2) -> Line (f p1, f p2)
| Curve bezier -> Curve {bezier with p0 = f bezier.p0 ; p1 = f bezier.p1}
) in
@@ -175,7 +174,6 @@ module Make(Point:P) = struct
= fun {path; _} ~f ->
Array.iter path
~f:(function
- | Empty -> ()
| Line (p1, p2) -> f p1; f p2
| Curve bezier -> f bezier.p0 ; f bezier.p1
)
@@ -193,14 +191,13 @@ module Make(Point:P) = struct
~f:(fun element ->
let res = match element with
- | Empty -> false
| Line (p0, p1)
| Curve {p0;p1;_} ->
- if p0 = point then (
+ if (Point.id p0) = (Point.id point) then (
idx := Some (!counter) ;
true
- ) else if p1 = point then (
- idx := Some (!counter +1) ;
+ ) else if (Point.id p1) = (Point.id point) then (
+ idx := Some (!counter+1) ;
true
) else
false
@@ -213,25 +210,47 @@ module Make(Point:P) = struct
| Some 0 ->
(* Remove the first point *)
let path' = Array.init
- ((Array.length path) -1)
- ~f:( fun i -> Array.get path (i + 1)) in
- {id; path=path'}
+ ((Array.length path)-1)
+ ~f:( fun i -> Array.get path (i+1)) in
+ { id
+ ; path = path'
+ }
| Some n when n = (Array.length path) ->
(* Remove the last point *)
let path' = Array.init
- ((Array.length path) -1)
+ ((Array.length path)-1)
~f:( fun i -> Array.get path i) in
- {id; path=path'}
+ { id
+ ; path=path'
+ }
| Some n ->
let path' = Array.init
- ((Array.length path) -1)
+ ((Array.length path)-1)
~f:(fun i ->
- if i < (n -1) then
+ if i < (n-1) then
Array.get path (i)
+ else if i = (n-1) then
+ (* We know that the point is not the first nor the last one.
+ So it is safe to call n-1 or n + 1 point
+
+ We have to rebuild the point and set that
+ point_(-1).id = point_(+1).id
+ *)
+ let previous_p1 =
+ match Array.get path (i-1) with
+ | Line (_, p1) -> p1
+ | Curve c -> c.p1
+ in
+
+ match Array.get path (i+1) with
+ | Line (_, p1) -> Line (previous_p1, p1)
+ | Curve c -> Curve {c with p0 = previous_p1}
+
else
- Array.get path (i +1)
+ Array.get path (i+1)
) in
- {id; path=path'}
+ { id
+ ; path=path'}
let update
: t -> path array -> t
diff --git a/path/fixed.mli b/path/fixed.mli
index f91ffc6..1f12006 100755
--- a/path/fixed.mli
+++ b/path/fixed.mli
@@ -4,6 +4,8 @@ module type P = sig
val get_coord : t -> Gg.v2
+ val id : t -> int
+
end
module Make(Point:P) : sig
@@ -51,7 +53,6 @@ module Make(Point:P) : sig
; ctrl1:Gg.v2 } (* The control point *)
type path =
- | Empty
| Line of Point.t * Point.t
| Curve of bezier
diff --git a/path/point.ml b/path/point.ml
index d49d655..4c34899 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -1,8 +1,11 @@
+let internal_id = ref 0
+
type t =
{ p: Gg.v2
; size : float
; angle: float
; stamp : float
+ ; id : int
}
let empty =
@@ -10,17 +13,23 @@ let empty =
; size = 0.
; angle = 0.
; stamp = 0.
+ ; id = 0
}
let create ~angle ~width ~stamp ~x ~y =
+
+ incr internal_id;
{ p = Gg.V2.v x y
; size = width
; angle = Gg.Float.rad_of_deg (180. -. angle )
; stamp
+ ; id = !internal_id
}
let copy point p =
- { point with p }
+ { point with
+ p
+ }
let set_angle p angle =
{ p with angle = Gg.Float.rad_of_deg (180. -. angle) }
@@ -49,6 +58,7 @@ let get_coord'
let mix
: float -> Gg.v2 -> t -> t -> t
= fun f point p0 p1 ->
+ incr internal_id;
let angle0 = p0.angle
and angle1 = p1.angle
and width0 = get_width p0
@@ -61,4 +71,8 @@ let mix
{ p = point
; size = width
; angle
- ; stamp }
+ ; stamp
+ ; id = !internal_id
+ }
+
+let id { id; _} = id
diff --git a/path/point.mli b/path/point.mli
index fab42d2..fe4cb45 100755
--- a/path/point.mli
+++ b/path/point.mli
@@ -1,5 +1,9 @@
type t
+(** Return the point id. Each id is unique *)
+val id
+ : t -> int
+
val empty : t
val (+): t -> Gg.v2 -> t
@@ -10,6 +14,12 @@ val get_stamp : t -> float
val create: angle:float -> width:float -> stamp:float -> x:float -> y:float -> t
+(** Return a copy of the point at given posistion
+
+ This is a true copy, the id will be the same for the two points
+ TODO : Should this be renamed set_position ?
+
+*)
val copy : t -> Gg.v2 -> t
val set_angle : t -> float -> t
@@ -27,3 +37,4 @@ val get_coord'
characteristics from p0 and p1 *)
val mix
: float -> Gg.v2 -> t -> t -> t
+
diff --git a/script.it/script.ml b/script.it/script.ml
index e91dc92..fc64d1e 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -281,7 +281,11 @@ let on_change canva mouse_position timer state =
~h:10.
context;
-
+ Cd2d.stroke_text
+ context
+ (Jstr.of_float @@ Path.Point.get_stamp point)
+ ~x:(x +. 15.)
+ ~y;
| _ -> ()
in
diff --git a/script.it/state.ml b/script.it/state.ml
index b91c614..585ca32 100755
--- a/script.it/state.ml
+++ b/script.it/state.ml
@@ -78,14 +78,30 @@ let threshold = 20.
(** Update the path in the selection with the given function applied to
every point *)
-let update_selection id state f =
+let update_path_selection id paths f =
+ List.map paths
+ ~f:(fun path ->
+ let id' = Path.Fixed.id path in
+ match id = id' with
+ | false -> path
+ | true -> Path.Fixed.map_point path f
+ )
+
+let update_point_selection state path_id point f =
let paths = List.map state.paths
- ~f:(fun path ->
- let id' = Path.Fixed.id path in
- match id = id' with
- | false -> path
- | true -> Path.Fixed.map_point path f
+ ~f:(fun p ->
+ match Path.Fixed.id p = path_id with
+ | false -> p
+ | true ->
+ Path.Fixed.map_point
+ p
+ (fun p ->
+ if (Path.Point.id p = Path.Point.id point) then
+ f p
+ else
+ p
+ )
) in
{ state with paths }
@@ -104,18 +120,84 @@ let select_segment _ (_, selected, p0, p1) state dist =
; angle
; width }
+(** Handle the deletion event.
+
+ Deletion only apply to a selection
+*)
+let delete state worker =
+ match state.mode with
+ | Selection (Path id) ->
+ let paths = List.filter
+ state.paths
+ ~f:(fun p ->
+ Path.Fixed.id p != id
+ ) in
+ { state with paths ; mode = Out}
+
+ | Selection (Point (id, point)) ->
+ List.iter
+ state.paths
+ ~f:(fun p ->
+ let id' = Path.Fixed.id p in
+ match id' = id with
+ | false -> ()
+ | true ->
+ (* Send the job to the worker *)
+ Brr_webworkers.Worker.post worker (`DeletePoint (id, point, p))
+ );
+ { state with mode = Selection (Path id) }
+ | _ ->
+ state
+
+(** Tick event
+
+ Tick only occurs when drawing a new path
+
+*)
+let tick (delay, point) state =
+ match state.mode with
+ | Edit ->
+ (* Add the point in the list *)
+ let current = insert_or_replace
+ state
+ point
+ delay
+ state.current in
+ { state with current }
+ | _ -> state
+
+let angle angle state =
+ match state.mode with
+ (* Change angle for the whole path *)
+ | Selection (Path s) ->
+ let state = { state with angle } in
+ let paths = update_path_selection s state.paths (fun p -> Path.Point.set_angle p angle) in
+ {state with paths }
+ (* Change angle localy *)
+ | Selection (Point (s, point)) ->
+ update_point_selection state s point
+ (fun p -> Path.Point.set_angle p angle)
+ | _ ->
+ { state with angle}
+
+let width width state =
+ match state.mode with
+ | Selection (Path s) ->
+ let state = { state with width } in
+ let paths = update_path_selection s state.paths (fun p -> Path.Point.set_width p width) in
+ {state with paths }
+ | Selection (Point (s, point)) ->
+ update_point_selection state s point
+ (fun p -> Path.Point.set_width p width)
+ | _ ->
+ { state with width }
+
let do_action
: Brr_webworkers.Worker.t -> Elements.Timer.t -> events -> state -> state
= fun worker timer event state ->
match event, state.mode with
- | `Point (delay, point), Edit ->
- (* Add the point in the list *)
- let current = insert_or_replace
- state
- point
- delay
- state.current in
- { state with current }
+ | `Point (delay, point), _ ->
+ tick (delay, point) state
(* Click anywhere while in Out mode, we switch in edition *)
| `Click ((x, y) as p), Out ->
@@ -203,26 +285,8 @@ let do_action
end
end
- | `Delete, Selection (Path id) ->
- let paths = List.filter
- state.paths
- ~f:(fun p ->
- Path.Fixed.id p != id
- ) in
- { state with paths ; mode = Out}
-
- | `Delete, Selection (Point (id, point)) ->
- List.iter
- state.paths
- ~f:(fun p ->
- let id' = Path.Fixed.id p in
- match id' = id with
- | false -> ()
- | true ->
- (* Send the job to the worker *)
- Brr_webworkers.Worker.post worker (`DeletePoint (id, point, p))
- );
- { state with mode = Selection (Path id) }
+ | `Delete, _ ->
+ delete state worker
| `Export, _ ->
let my_host = Uri.host @@ Window.location @@ G.window in
@@ -259,21 +323,11 @@ let do_action
);
state
- (* Change the select curve with the appropriate setting *)
- | `Angle angle, Selection (Path s) ->
- let state = { state with angle } in
- update_selection s state (fun p -> Path.Point.set_angle p angle)
- | `Width width, Selection (Path s) ->
- let state = { state with width } in
- update_selection s state (fun p -> Path.Point.set_width p width)
-
- | `Angle angle, _ ->
- { state with angle}
- | `Width width, _ ->
- { state with width}
+ | `Angle value , _ ->
+ angle value state
+ | `Width value, _ ->
+ width value state
- | `Delete, Out
- -> state
| `Rendering rendering, _ ->
{ state with rendering}
@@ -297,11 +351,8 @@ let do_action
(* Some non possible cases *)
| `Out _, Out
- | `Point _, Out
- | `Point _, Selection _
| `Out _, Selection _
| `Click _, Edit
- | `Delete, Edit
-> state
let init =
diff --git a/script.it/worker.ml b/script.it/worker.ml
index e68705a..6f425cd 100755
--- a/script.it/worker.ml
+++ b/script.it/worker.ml
@@ -6,26 +6,21 @@ type message = [
| `DeletePoint of (int * Path.Point.t * Path.Fixed.t)
]
-exception Empty_Element
-
let get_point
: Path.Fixed.path -> Gg.v2
= function
- | Empty -> raise Empty_Element
| Line (_, p1) -> Path.Point.get_coord p1
| Curve bezier -> Path.Point.get_coord bezier.Path.Fixed.p1
let first_point
: Path.Fixed.path -> Gg.v2
= function
- | Empty -> raise Empty_Element
| Line (p0, _) -> Path.Point.get_coord p0
| Curve bezier -> Path.Point.get_coord bezier.Path.Fixed.p0
let assoc_point
: Shapes.Bezier.t -> Path.Fixed.path -> Path.Fixed.path
= fun bezier -> function
- | Empty -> raise Empty_Element
| Line (p0, p1)
| Curve {p0; p1; _} ->
let p0' = Path.Point.copy p0 bezier.Shapes.Bezier.p0