diff options
| -rwxr-xr-x | layer/ductusPrinter.ml | 4 | ||||
| -rwxr-xr-x | layer/fillPrinter.ml | 68 | ||||
| -rwxr-xr-x | layer/paths.ml | 6 | ||||
| -rwxr-xr-x | path/fixed.ml | 27 | ||||
| -rwxr-xr-x | path/fixed.mli | 9 | ||||
| -rwxr-xr-x | path/point.ml | 1 | ||||
| -rwxr-xr-x | script.it/script.ml | 2 | ||||
| -rwxr-xr-x | script.it/selection.ml | 4 | ||||
| -rwxr-xr-x | script.it/state.ml | 31 |
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 } |