summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xlayer/ductusPrinter.ml4
-rwxr-xr-xlayer/fillPrinter.ml68
-rwxr-xr-xlayer/paths.ml6
-rwxr-xr-xpath/fixed.ml27
-rwxr-xr-xpath/fixed.mli9
-rwxr-xr-xpath/point.ml1
-rwxr-xr-xscript.it/script.ml2
-rwxr-xr-xscript.it/selection.ml4
-rwxr-xr-xscript.it/state.ml31
9 files changed, 115 insertions, 37 deletions
diff --git a/layer/ductusPrinter.ml b/layer/ductusPrinter.ml
index 2ee96e4..8383a9c 100755
--- a/layer/ductusPrinter.ml
+++ b/layer/ductusPrinter.ml
@@ -46,9 +46,9 @@ module Make(Repr: Repr.PRINTER) = struct
recent point *)
let delay =
((Path.Point.get_stamp p0) -. (Path.Point.get_stamp p1))
- *. 20.
+ *. 30.
in
- for i = 0 to ((Int.of_float delay) -1) do
+ for i = 0 to ((Int.of_float delay) ) do
let ratio = (Float.of_int i) /. delay in
let bezier', _ = Shapes.Bezier.slice ratio bezier in
diff --git a/layer/fillPrinter.ml b/layer/fillPrinter.ml
index 2297d15..3093ada 100755
--- a/layer/fillPrinter.ml
+++ b/layer/fillPrinter.ml
@@ -1,6 +1,47 @@
module Point = Path.Point
+
+
+
module Make(Repr: Repr.PRINTER) = struct
+ (* Divide a curve in subelements *)
+ let rec divide level p0 ctrl0 ctrl1 p1 path =
+
+ let bezier =
+ { Shapes.Bezier.p0 = Path.Point.get_coord p0
+ ; ctrl0
+ ; ctrl1
+ ; p1 = Path.Point.get_coord p1
+ } in
+
+ let ratio = 0.5 in
+ let bezier0, bezier1 = Shapes.Bezier.slice ratio bezier in
+ let point = Path.Point.mix ratio bezier0.Shapes.Bezier.p1 p0 p1 in
+
+ let ctrl0_0 = Point.copy p0 bezier0.Shapes.Bezier.ctrl0
+ and ctrl0_1 = Point.copy point bezier0.Shapes.Bezier.ctrl1
+
+ and ctrl1_0 = Point.copy point bezier1.Shapes.Bezier.ctrl0
+ and ctrl1_1 = Point.copy p1 bezier1.Shapes.Bezier.ctrl1 in
+
+
+ match level with
+ | 0 ->
+ path :=
+ Repr.quadratic_to
+ (Point.get_coord' @@ ctrl1_1)
+ (Point.get_coord' @@ ctrl1_0)
+ (Point.get_coord' point) !path;
+
+ path :=
+ Repr.quadratic_to
+ (Point.get_coord' @@ ctrl0_1)
+ (Point.get_coord' @@ ctrl0_0)
+ (Point.get_coord' p0) !path;
+ | n ->
+ divide (n-1) point (Point.get_coord ctrl1_0) (Point.get_coord ctrl1_1) p1 path;
+ divide (n-1) p0 (Point.get_coord ctrl0_0) (Point.get_coord ctrl0_1) point path;
+
type t = Point.t
type repr =
@@ -44,19 +85,24 @@ module Make(Repr: Repr.PRINTER) = struct
let ctrl0' = Point.copy p1 ctrl0
and ctrl1' = Point.copy p1 ctrl1 in
- let path =
- Repr.move_to (Point.get_coord p1) t.path
- |> Repr.line_to (Point.get_coord' p1)
- |> Repr.quadratic_to
- (Point.get_coord' ctrl1')
- (Point.get_coord' ctrl0')
- (Point.get_coord' p0)
- |> Repr.line_to (Point.get_coord p0)
- |> Repr.quadratic_to
+ let path = Repr.move_to (Point.get_coord p1) t.path
+ |> Repr.line_to (Point.get_coord' p1) in
+ let path = ref path in
+
+ (* Backward *)
+ divide 3 p0 ctrl0 ctrl1 p1 path ;
+ path := Repr.line_to (Point.get_coord p0) !path;
+
+ (* Forward *)
+ path := Repr.quadratic_to
(Point.get_coord ctrl0')
(Point.get_coord ctrl1')
- (Point.get_coord p1)
- |> Repr.close in
+ (Point.get_coord p1) !path;
+
+ let path = !path in
+
+ let path = Repr.close path in
+
let path = t.close path in
{ t with path}
diff --git a/layer/paths.ml b/layer/paths.ml
index 59215df..927a5f9 100755
--- a/layer/paths.ml
+++ b/layer/paths.ml
@@ -85,9 +85,9 @@ let to_svg
| `Ductus ->
let svg_path = R.repr
path
- (module WireSVGRepr)
- (WireSVGRepr.create_path (fun _ -> ()))
- |> WireSVGRepr.get in
+ (module DuctusSVGRepr)
+ (DuctusSVGRepr.create_path (fun _ -> ()))
+ |> DuctusSVGRepr.get in
Svg.path
~at:Brr.At.[
v (Jstr.v "fill") color
diff --git a/path/fixed.ml b/path/fixed.ml
index 2d42566..176d818 100755
--- a/path/fixed.ml
+++ b/path/fixed.ml
@@ -76,6 +76,9 @@ module Make(Point:P) = struct
: int * path list -> path array
= fun (n, t) ->
+ (* The array is initialized with a magic number, and just after
+ filled with the values from the list in reverse. All the elements are set.
+ *)
let res = Obj.magic (Array.make n 0) in
List.iteri t
~f:(fun i elem -> Array.set res (n - i - 1) elem );
@@ -125,10 +128,18 @@ module Make(Point:P) = struct
) in
Repr.stop repr
+
+ type approx =
+ { distance : float
+ ; closest_point : Gg.v2
+ ; ratio : float
+ ; p0 : Point.t
+ ; p1 : Point.t }
+
(** Return the distance between a given point and the curve. May return
None if the point is out of the curve *)
let distance
- : Gg.v2 -> t -> (Gg.v2 * float * Point.t * Point.t) option
+ : Gg.v2 -> t -> approx option
= fun point beziers ->
Array.fold_left beziers.path
@@ -151,12 +162,16 @@ module Make(Point:P) = struct
; ctrl0 = bezier.ctrl0
; ctrl1 = bezier.ctrl1 }
) in
- let _, point' = Shapes.Bezier.get_closest_point point bezier' in
- let distance = Gg.V2.( norm (point - point') ) in
+ let ratio, point' = Shapes.Bezier.get_closest_point point bezier' in
+ let distance' = Gg.V2.( norm (point - point') ) in
match res with
- | None -> Some (point', distance, bezier.p0, bezier.p1)
- | Some (_, d, _, _) when d < distance -> res
- | _ -> (Some (point', distance, bezier.p0, bezier.p1))
+ | Some {distance; _} when distance < distance' -> res
+ | _ -> Some
+ { closest_point = point'
+ ; distance = distance'
+ ; p0 = bezier.p0
+ ; p1 = bezier.p1
+ ; ratio }
)
let map_point
diff --git a/path/fixed.mli b/path/fixed.mli
index 1f12006..06b3539 100755
--- a/path/fixed.mli
+++ b/path/fixed.mli
@@ -32,10 +32,17 @@ module Make(Point:P) : sig
val repr
: t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
+ type approx =
+ { distance : float
+ ; closest_point : Gg.v2
+ ; ratio : float
+ ; p0 : Point.t
+ ; p1 : Point.t }
+
(** Return the distance between a given point and the curve. May return
None if the point is out of the curve *)
val distance
- : Gg.v2 -> t -> (Gg.v2 * float * Point.t * Point.t) option
+ : Gg.v2 -> t -> approx option
val iter
: t -> f:(Point.t -> unit) -> unit
diff --git a/path/point.ml b/path/point.ml
index 4c34899..ec6f8ad 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -58,7 +58,6 @@ 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
diff --git a/script.it/script.ml b/script.it/script.ml
index fc64d1e..ede47be 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -281,11 +281,13 @@ 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/selection.ml b/script.it/selection.ml
index c0360fb..591ea38 100755
--- a/script.it/selection.ml
+++ b/script.it/selection.ml
@@ -15,8 +15,8 @@ let get_from_paths
~init:(threshold, None)
~f:(fun (dist, selection) path ->
match Path.Fixed.distance point path with
- | Some (point', p, p0, p1) when p < dist ->
- dist, Some (point', path, p0, p1)
+ | Some { closest_point ; distance; p0; p1 ; ratio} when distance < dist ->
+ ratio, Some (closest_point, path, p0, p1)
| _ -> dist, selection
)
diff --git a/script.it/state.ml b/script.it/state.ml
index 585ca32..185be4f 100755
--- a/script.it/state.ml
+++ b/script.it/state.ml
@@ -111,8 +111,8 @@ let select_segment _ (_, selected, p0, p1) state dist =
let point' = Path.Point.mix dist (Path.Point.get_coord p0) p0 p1 in
- let angle = Path.Point.get_angle point'
- and width = Path.Point.get_width point' in
+ let angle = (Float.round @@ 10. *. Path.Point.get_angle point') /. 10.
+ and width = (Float.round @@ 10. *. Path.Point.get_width point') /. 10. in
let id = Selection.select_path selected in
{ state with
@@ -175,8 +175,9 @@ let angle angle state =
{state with paths }
(* Change angle localy *)
| Selection (Point (s, point)) ->
- update_point_selection state s point
- (fun p -> Path.Point.set_angle p angle)
+ let state = update_point_selection state s point
+ (fun p -> Path.Point.set_angle p angle) in
+ { state with angle }
| _ ->
{ state with angle}
@@ -187,8 +188,9 @@ let width width state =
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)
+ let state = update_point_selection state s point
+ (fun p -> Path.Point.set_width p width) in
+ { state with width }
| _ ->
{ state with width }
@@ -239,10 +241,17 @@ let do_action
else
(* On the same segment, check for a point *)
let selection = Selection.select_point path (Gg.V2.of_tuple position) in
-
- (* In order to handle the point move, start the timer *)
- Elements.Timer.start timer 0.3;
- {state with mode= Selection selection}
+ match selection with
+ | Path _ ->
+ { state with mode = Selection selection }
+ | Point (_, pt) ->
+ (* In order to handle the point move, start the timer *)
+ Elements.Timer.start timer 0.3;
+ { state with
+ mode = Selection selection
+ ; angle = Path.Point.get_angle pt
+ ; width = Path.Point.get_width pt
+ }
end
| `Out point, Edit ->
@@ -344,7 +353,7 @@ let do_action
match id = id' with
| false -> path
| true ->
- Path.Fixed.update path paths
+ (Path.Fixed.update path paths)
) in
{ state with paths }