From 20d10a93e5becb41d1145f9d35136782365b0ba4 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Thu, 17 Dec 2020 13:56:00 +0100 Subject: Refactor --- curves/bezier.ml | 197 ------------------------------------------ curves/bezier.mli | 40 --------- curves/bspline.ml | 149 -------------------------------- curves/bspline.mli | 24 ------ curves/dd_splines.pdf | Bin 184248 -> 0 bytes curves/dune | 7 -- draw/draw.ml | 233 -------------------------------------------------- draw/dune | 8 -- draw/point.ml | 78 ----------------- draw/point.mli | 13 --- dune | 2 +- events/timer.ml | 39 ++++++--- events/timer.mli | 6 +- path/draw.ml | 229 +++++++++++++++++++++++++++++++++++++++++++++++++ path/dune | 8 ++ path/point.ml | 78 +++++++++++++++++ path/point.mli | 13 +++ script.ml | 104 ++++++++++++++-------- shapes/bezier.ml | 203 +++++++++++++++++++++++++++++++++++++++++++ shapes/bezier.mli | 40 +++++++++ shapes/bspline.ml | 149 ++++++++++++++++++++++++++++++++ shapes/bspline.mli | 24 ++++++ shapes/dd_splines.pdf | Bin 0 -> 184248 bytes shapes/dune | 7 ++ worker/dune | 2 +- 25 files changed, 856 insertions(+), 797 deletions(-) delete mode 100755 curves/bezier.ml delete mode 100755 curves/bezier.mli delete mode 100755 curves/bspline.ml delete mode 100755 curves/bspline.mli delete mode 100755 curves/dd_splines.pdf delete mode 100755 curves/dune delete mode 100755 draw/draw.ml delete mode 100755 draw/dune delete mode 100755 draw/point.ml delete mode 100755 draw/point.mli create mode 100755 path/draw.ml create mode 100755 path/dune create mode 100755 path/point.ml create mode 100755 path/point.mli create mode 100755 shapes/bezier.ml create mode 100755 shapes/bezier.mli create mode 100755 shapes/bspline.ml create mode 100755 shapes/bspline.mli create mode 100755 shapes/dd_splines.pdf create mode 100755 shapes/dune diff --git a/curves/bezier.ml b/curves/bezier.ml deleted file mode 100755 index 3dedc70..0000000 --- a/curves/bezier.ml +++ /dev/null @@ -1,197 +0,0 @@ -(** - - Bezier curve -*) - -module Utils = Tools.Utils - -type quadratic = - { p0:Gg.v2 (* The starting point *) - ; p1:Gg.v2 (* The end point *) - ; ctrl:Gg.v2 } (* The control point *) - - -type t = - { p0:Gg.v2 (* The starting point *) - ; p1:Gg.v2 (* The end point *) - ; ctrl0:Gg.v2 (* The control point *) - ; ctrl1:Gg.v2 } (* The control point *) - - -(** - Build a control point for a quadratic curve for passing throuht 3 points. - taken from https://xuhehuan.com/2608.html - - - also look to https://pomax.github.io/bezierinfo/#pointcurves -*) -let three_points_quadratic - : Gg.v2 -> Gg.v2 -> Gg.v2 -> quadratic - = fun p0 c1 p1 -> - - let open Gg.V2 in - - let vect_1 = p0 - c1 - and vect_2 = p1 - c1 in - let norm1 = norm vect_1 - and norm2 = norm vect_2 in - let v = (Float.sqrt (norm1 *. norm2)) /. 2. in - - let ctrl = c1 - v * (( vect_1 / norm1) + (vect_2 / norm2)) in - {p0; p1; ctrl} - -(** - - Convert a cubic bezier curve into a quadratic one - -*) -let quadratic_to_cubic - : quadratic -> t - = fun {p0; p1; ctrl} -> - - let coef = 2. /. 3. in - - let open Gg.V2 in - { p0 - ; p1 - ; ctrl0 = mix p0 ctrl coef - ; ctrl1 = mix p1 ctrl coef } - - - -let abc_ratio - : int -> float -> float - = fun n t -> - let n' = Float.of_int n in - let bottom = (Float.pow t n') +. (Float.pow (1. -. t) n') in - let top = bottom -. 1. in - Float.abs (top /. bottom) - -let half_cubic_ratio = abc_ratio 3 0.5 - -exception Not_found - -(** - - https://pomax.github.io/bezierinfo/#pointcurves - -*) -let three_points_cubic - : float -> Gg.v2 -> Gg.v2 -> Gg.v2 -> t - = fun f p0 p1 p2 -> - - let open Gg.V2 in - - let c = half ( p0 + p2) in - let a = p1 + ((p1 - c) / half_cubic_ratio) in - - let vect1_0 = p1 - p0 in - let vect2_0 = p2 - p0 in - - let d1 = norm vect1_0 - and d2 = norm (p2 - p1) in - let t = d1 /. (d1 +. d2) in - - let angle_1_0 = angle vect1_0 - and angle_2_0 = angle vect2_0 in - - (* get our e1-e2 distances *) - let angle = mod_float - (Gg.Float.two_pi - +. angle_2_0 - -. angle_1_0) - Gg.Float.two_pi in - - let distance = (norm vect2_0) *. f in - - let bc = - if angle < 0. || angle > Gg.Float.pi then - Float.(neg distance) - else - distance in - let de1 = t *. bc - and de2 = (1. -. t) *. bc in - - (* get the circle-aligned slope as normalized dx/dy *) - let center = Utils.center p0 p1 p2 in - match center with - | None -> raise Not_found - | Some center -> - let t' = p1 - center in - let tangent0 = v - ((x p1) -. (y t')) - ((y p1) +. (x t')) - and tangent1 = v - ((x p1) +. (y t')) - ((y p1) -. (x t')) in - - let d = unit (tangent1 - tangent0) in - - (* then set up an e1 and e2 parallel to the baseline *) - let e1 = p1 + de1 * d - and e2 = p1 - de2 * d in - - (* then use those e1/e2 to derive the new hull coordinates *) - let v1 = a + (e1 - a) / (1. -. t) - and v2 = a + (e2 - a) / t in - - let ctrl0 = p0 + (v1 - p0) / t - and ctrl1 = p2 + (v2 -p2) / (1. -. t) in - - {p0; p1 = p2; ctrl0; ctrl1} - -(** Split a bezier curve in two at a given position *) -let slice - : float -> t -> t * t - = fun t {p0; p1; ctrl0; ctrl1} -> - - let mix p1 p2 = Gg.V2.mix p1 p2 t in - - let p12 = mix p0 ctrl0 - and p23 = mix ctrl0 ctrl1 - and p34 = mix ctrl1 p1 in - - let p123 = mix p12 p23 - and p234 = mix p23 p34 in - - let p1234 = mix p123 p234 in - - ( { p0 - ; ctrl0 = p12 - ; ctrl1 = p123 - ; p1 = p1234 } - , { p0 = p1234 - ; ctrl0 = p234 - ; ctrl1 = p34 - ; p1 } ) - - -let rec get_closest_point - : Gg.v2 -> t -> Gg.v2 - = fun point t -> - (* First devide the curve in two *) - let seq_0, seq_1 = slice 0.5 t in - - let p0 = t.p0 - and p1 = t.p1 - and p01 = seq_0.p1 in (* seq_0.p1 = seq_1.p0 *) - - let open Gg.V2 in - let center0 = mix p0 p01 0.5 - and center1 = mix p01 p1 0.5 in - - if Tools.Utils.equal_point 0.001 p0 p1 then - p01 - else if (norm (point - center0)) < (norm (point - center1)) then - get_closest_point point seq_0 - else - get_closest_point point seq_1 - -let reverse - : t -> t - = fun bezier -> - { - p0 = bezier.p1 - ; p1 = bezier.p0 - ; ctrl0 = bezier.ctrl1 - ; ctrl1 = bezier.ctrl0 } diff --git a/curves/bezier.mli b/curves/bezier.mli deleted file mode 100755 index e90163c..0000000 --- a/curves/bezier.mli +++ /dev/null @@ -1,40 +0,0 @@ -type t = - { p0:Gg.v2 (* The starting point *) - ; p1:Gg.v2 (* The end point *) - ; ctrl0:Gg.v2 (* The control point *) - ; ctrl1:Gg.v2 } (* The control point *) - -type quadratic - -(** - Build a control point for a quadratic curve for passing throuht 3 points. - taken from https://xuhehuan.com/2608.html - - - also look to https://pomax.github.io/bezierinfo/#pointcurves -*) -val three_points_quadratic - : Gg.v2 -> Gg.v2 -> Gg.v2 -> quadratic - -(** - Create a curve from three points. - - This is an implementation for - https://pomax.github.io/bezierinfo/#pointcurves - -*) -val three_points_cubic - : float -> Gg.v2 -> Gg.v2 -> Gg.v2 -> t - -val quadratic_to_cubic - : quadratic -> t - -(** Split a bezier curve in two at a given position *) -val slice - : float -> t -> t * t - -(** Return the closest point to the curve by approximation *) -val get_closest_point - : Gg.v2 -> t -> Gg.v2 - -val reverse: t -> t diff --git a/curves/bspline.ml b/curves/bspline.ml deleted file mode 100755 index bb60227..0000000 --- a/curves/bspline.ml +++ /dev/null @@ -1,149 +0,0 @@ -open StdLabels - -type err = [`InvalidPath ] - -module M = Matrix.MakeMatrix (struct - - type t = Float.t - - let compare a b = - - let v = Float.compare a b in - if v = 0 then Matrix.Order.Equal - else if v > 0 then Matrix.Order.Greater - else Matrix.Order.Less - - let zero = Float.zero - let one = Float.one - - let divide = (/.) - let multiply = ( *. ) - let add = (+.) - let subtract = (-.) - exception NonElt - - - end) - -type t = Gg.v2 list - -let from_points - : Gg.v2 array -> (Gg.v2 array, [> `InvalidPath]) Result.t - = fun points -> - - let n = (Array.length points - 2) in - - if n <= 1 then - Result.error `InvalidPath - else - - (* Create the initial matrix. - - The matrix is augmented with two additionals columns, which will be - populated with the points from the path. - *) - let arr = Array.init n ~f:(fun line -> - Array.init (n +2) ~f:(fun row -> - match row - line with - | (-1) -> 1. - | 0 -> 4. - | 1 -> 1. - | _ -> 0. - ) - ) in - let matrix = M.from_array arr in - - (* Add the points from the augmented matrix *) - let points_array = points in - for line = 0 to (n -1) do - - let point = - if line = 0 then - let p0 = points_array.(0) - and p1 = points_array.(1) in - Gg.V2.(6. * p1 - p0) - else if (line + 1) = n then - let p_n_2 = points_array.(n) - and p_n_1 = points_array.(n + 1) in - Gg.V2.(6. * p_n_2 - p_n_1) - else - let n' = line + 1 in - Gg.V2.(6. * points_array.(n')) - in - let x = (Gg.V2.x point) - and y = (Gg.V2.y point) in - - - M.set_elt matrix (line + 1, n + 1) x; - M.set_elt matrix (line + 1, n + 2) y; - done; - - (* Resolve the matrix *) - let res' = M.row_reduce matrix in - - (* Extract the result as points *) - let _, col_x = M.get_column res' (n + 1) - and _, col_y = M.get_column res' (n + 2) in - - (* Build the result *) - let res = Array.make (n + 2) (Array.get points_array (n + 1) ) in - for i = 1 to n do - let point = Gg.V2.v col_x.(i - 1) col_y.(i - 1) in - Array.set res i point; - done; - Array.set res 0 (Array.get points_array 0); - Result.ok res - -let (let*) = Result.bind - -(** Build a continue curve from path - - see https://www.math.ucla.edu/~baker/149.1.02w/handouts/dd_splines.pdf -*) -let to_bezier - : ?connexion0:Gg.v2 -> ?connexion1:Gg.v2 -> t -> (Bezier.t array, [> `InvalidPath]) Result.t - = fun ?connexion0 ?connexion1 points -> - - let points' = match connexion0 with - | None -> points - | Some pt -> pt::points in - - let arr_points = match connexion1 with - | None -> Array.of_list points' - | Some pt -> - let arr = Array.make (1 + (List.length points')) pt in - List.iteri points' - ~f:(fun i value -> Array.set arr i value); - arr in - - let* bspline_points = from_points arr_points in - - let start = match connexion0 with - | None -> 1 - | Some _ -> 2 - and end_ = match connexion1 with - | None -> (Array.length bspline_points) - 1 - | Some _ -> (Array.length bspline_points) - 2 in - - let result = Array.init (end_ - start + 1) ~f:(fun i -> - - let i = i + start in - - let prev_b = Array.get bspline_points (i - 1) - and bpoint = Array.get bspline_points i - and prev_p = Array.get arr_points (i - 1) - and point = Array.get arr_points i in - let ctrl0 = Gg.V2.(mix prev_b bpoint (1. /. 3.)) - and ctrl1 = Gg.V2.(mix prev_b bpoint (2. /. 3.)) in - - let bezier = - { Bezier.p0 = prev_p - ; Bezier.p1 = point - ; Bezier.ctrl0 - ; Bezier.ctrl1 } in - - bezier - - ) in - Result.Ok result - diff --git a/curves/bspline.mli b/curves/bspline.mli deleted file mode 100755 index 074658d..0000000 --- a/curves/bspline.mli +++ /dev/null @@ -1,24 +0,0 @@ -type t - -type err = - [ `InvalidPath (* Too few points in the path for building the curve *) - ] - -(** Convert a list of points into a beziers curves. - - At least 4 points are required for building the path. - - [to_bezier ~connexion points] create a list of beziers segments joining all - the points together. - - [connexion0] add a virtual point in the begining for helping to get the - appropriate tangent when connecting path together - - [connexion1] does the same at the end - -*) -val to_bezier - : ?connexion0:Gg.v2 - -> ?connexion1:Gg.v2 - -> Gg.v2 list - -> (Bezier.t array, [> err]) Result.t diff --git a/curves/dd_splines.pdf b/curves/dd_splines.pdf deleted file mode 100755 index 2618162..0000000 Binary files a/curves/dd_splines.pdf and /dev/null differ diff --git a/curves/dune b/curves/dune deleted file mode 100755 index 34c87fb..0000000 --- a/curves/dune +++ /dev/null @@ -1,7 +0,0 @@ -(library - (name curves) - (libraries - tools - matrix - ) - ) diff --git a/draw/draw.ml b/draw/draw.ml deleted file mode 100755 index 12a1abc..0000000 --- a/draw/draw.ml +++ /dev/null @@ -1,233 +0,0 @@ -open StdLabels -module Path = Brr_canvas.C2d.Path - -module Point = Point - -(** Translate the point in the canva area *) -let translate_point - : area:Gg.v2 -> Gg.v2 -> (float * float) - = fun ~area point -> - let x, y = Gg.V2.(to_tuple @@ mul area point) in - x, ((Gg.V2.y area) -. y) - -let translate_point' - : area:Gg.v2 -> Gg.v2 -> Gg.v2 -> (float * float) - = fun ~area vect point -> - let open Gg.V2 in - translate_point ~area - (point + vect) - - -(* Draw a straight line between two points *) -let line - : Gg.v2 -> p1:Point.t -> Path.t -> unit - = fun area ~p1 path -> - let x, y = translate_point ~area (Point.get_coord p1) in - Path.line_to path ~x ~y - -(* Draw a simple bezier curve from the three given points *) -let three_points - : Gg.v2 -> p0:Point.t -> p1:Point.t -> p2:Point.t -> Path.t -> unit - = fun area ~p0 ~p1 ~p2 path -> - let p0 = Point.get_coord p0 - and p1 = Point.get_coord p1 - and p2 = Point.get_coord p2 in - let bezier = Curves.Bezier.three_points_quadratic p0 p1 p2 - |> Curves.Bezier.quadratic_to_cubic in - let cx, cy = translate_point ~area bezier.Curves.Bezier.ctrl0 - and cx', cy' = translate_point ~area bezier.Curves.Bezier.ctrl1 - and x, y = translate_point ~area bezier.Curves.Bezier.p1 in - - Path.ccurve_to path - ~cx ~cy - ~cx' ~cy' - ~x ~y - -let multi_points - : ?connexion:Gg.v2 -> Gg.v2 -> Point.t list -> Path.t -> unit - = fun ?connexion area points path -> - - let (let*) v f = - match v with - | Ok beziers -> f beziers - | _ -> () in - - let points = List.map ~f:Point.get_coord points in - - let* beziers = Curves.Bspline.to_bezier ?connexion1:connexion points in - Array.iter beziers - ~f:(fun bezier -> - let cx, cy = translate_point ~area bezier.Curves.Bezier.ctrl0 - and cx', cy' = translate_point ~area bezier.Curves.Bezier.ctrl1 - and x, y = translate_point ~area bezier.Curves.Bezier.p1 in - - Path.ccurve_to path - ~cx ~cy - ~cx' ~cy' - ~x ~y - ) - -let circle - : Gg.v2 -> center:Gg.v2 -> float -> Path.t -> Path.t - = fun area ~center r path -> - - let cx, cy = translate_point ~area center in - Path.arc - path - ~cx ~cy - ~r - ~start:0. - ~stop:Gg.Float.two_pi; - path - -type path = - | Empty - | Line of Point.t * Point.t - | Three_point of Point.t * Point.t * Point.t - | Curve of Curves.Bezier.t array - -type t = - { id : int - ; path : path } - -let move_to - : area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit - = fun ~area canvaPath path -> - match path with - | Empty -> () - | Line (p0, _) - | Three_point (p0, _, _) -> - let x, y = translate_point ~area (Point.get_coord p0) in - Path.move_to canvaPath ~x ~y - | Curve beziers -> - try - let bezier = Array.get beziers 0 in - let x, y = translate_point ~area bezier.Curves.Bezier.p0 in - Path.move_to canvaPath ~x ~y - with _ -> () - -let draw - : ?connexion:Point.t -> area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit - = fun ?connexion ~area canvaPath path -> - match connexion, path with - - | _, Empty -> () - | None, Line (_, p1) -> - ignore @@ line area ~p1 canvaPath - - | Some p0, Line (p1, p2) - | None, Three_point (p0, p1, p2) - | Some _, Three_point (p0, p1, p2) -> - ignore @@ three_points area ~p0 ~p1 ~p2 canvaPath - - | _, Curve beziers -> - Array.iter beziers - ~f:(fun bezier -> - - let cx, cy = translate_point ~area bezier.Curves.Bezier.ctrl0 - and cx', cy' = translate_point ~area bezier.Curves.Bezier.ctrl1 - and x, y = translate_point ~area bezier.Curves.Bezier.p1 in - - Path.ccurve_to canvaPath - ~cx ~cy - ~cx' ~cy' - ~x ~y - ) - -let go_back - : ?connexion:Point.t -> area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit - = fun ?connexion ~area canvaPath path -> - let vect = Gg.V2.of_polar @@ Gg.V2.v - 0.02 - Gg.Float.pi_div_4 - in - match connexion, path with - | _, Empty -> () - | _, Three_point (p0, p1, p2) -> - let open Point in - let p0' = p0 + vect - and p1' = p1 + vect - and p2' = p2 + vect in - - let x, y = translate_point' ~area vect @@ Point.get_coord p2 in - Path.line_to canvaPath ~x ~y; - ignore @@ three_points area ~p0:p2' ~p1:p1' ~p2:p0' canvaPath - | _, Curve beziers -> - let last = Array.get beziers ((Array.length beziers) -1) in - - let x, y = - last.Curves.Bezier.p1 - |> translate_point' vect ~area in - - Path.line_to canvaPath ~x ~y; - - for i = 1 to Array.length beziers do - - let i = (Array.length beziers) - i in - let bezier = Array.get beziers i in - - let cx, cy = translate_point' vect ~area bezier.Curves.Bezier.ctrl1 - and cx', cy' = translate_point' vect ~area bezier.Curves.Bezier.ctrl0 - and x, y = translate_point' vect ~area bezier.Curves.Bezier.p0 in - - Path.ccurve_to canvaPath - ~cx ~cy - ~cx' ~cy' - ~x ~y - done; - let x, y = - (Array.get beziers 0).Curves.Bezier.p0 - |> translate_point' vect ~area in - Path.line_to canvaPath ~x ~y; - - | _ -> () - -type quick_path = Point.t list * Curves.Bezier.t list - -let id = ref 0 - -let to_path - : quick_path -> t - = fun (points, beziers) -> - - incr id; - let id = !id in - match beziers with - | [] -> - begin match points with - | p0::p1::[] -> {id; path=Line (p0, p1)} - | p0::p1::p2::[] -> {id; path=Three_point (p0, p1, p2)} - | points -> - - let (let*) v f = - match v with - | Ok beziers -> f beziers - | _ -> {id; path=Empty} in - - let points' = List.map ~f:Point.get_coord points in - - let* beziers = Curves.Bspline.to_bezier points' in - {id; path=Curve beziers} - end - | _ -> - let (let*) v f = - match v with - | Ok beziers -> f beziers - | _ -> {id; path=Curve (Array.of_list beziers)} in - - let connexion = match beziers with - | hd::_ -> Some hd.Curves.Bezier.p1 - | _ -> None in - - let* beziers' = Curves.Bspline.to_bezier - ?connexion1:connexion - (List.map points ~f:Point.get_coord) in - - - (* Create a new array with both lenght *) - let t = Array.append - beziers' - (Array.of_list beziers) - in - - {id; path = Curve t} diff --git a/draw/dune b/draw/dune deleted file mode 100755 index 1791604..0000000 --- a/draw/dune +++ /dev/null @@ -1,8 +0,0 @@ -(library - (name draw) - (libraries - gg - brr - curves - ) - ) diff --git a/draw/point.ml b/draw/point.ml deleted file mode 100755 index 150bc8e..0000000 --- a/draw/point.ml +++ /dev/null @@ -1,78 +0,0 @@ -open StdLabels - -type t = - { p: Gg.v2 - ; size : float - ; angle: float - } - -let create x y = - { p = Gg.V2.v x y - ; size = 0.1 - ; angle = Gg.Float.pi_div_4 - } - -let (+) p1 p2 = - { p1 with p = Gg.V2.(+) p1.p p2 } - -let get_coord { p; _ } = p - -let get_coord' - : t -> Gg.v2 - = fun t -> - let open Gg.V2 in - let trans = of_polar @@ v t.size t.angle in - t.p + trans - -let return_segment - : Curves.Bezier.t -> Curves.Bezier.t list -> Curves.Bezier.t list - = fun bezier beziers -> - (* We gave the points in reverse order, so we have to revert the - curve *) - let bezier' = Curves.Bezier.reverse bezier in - bezier'::beziers - - -let get_new_segment connexion0 p5 p4 p3 p2 p1 = - let p5' = get_coord p5 - and p4' = get_coord p4 - and p3' = get_coord p3 - and p2' = get_coord p2 - and p1' = get_coord p1 in - - let points_to_link = - [ p1' - ; p2' - ; p3' - ; p4' - ; p5' ] in - Curves.Bspline.to_bezier ?connexion0 points_to_link - -let add_point_in_path - : float -> float -> t list -> Curves.Bezier.t list -> t list * Curves.Bezier.t list - = fun x y path beziers -> - let lastClick = create x y in - let (let*) v f = - match v with - | Ok bezier -> - if Array.length bezier > 0 then - f (Array.get bezier 0) - else - lastClick::path, beziers - | _ -> - lastClick::path, beziers - in - - let connexion0 = match beziers with - | hd::_ -> Some hd.Curves.Bezier.p1 - | _ -> None in - - match path with - | p4::p3::p2::p1::_ -> - let* bezier = get_new_segment connexion0 - lastClick p4 p3 p2 p1 in - (* We remove the last point and add the bezier curve in the list*) - let firsts = lastClick::p4::p3::p2::[] in - firsts, return_segment bezier beziers - | _ -> - lastClick::path, beziers diff --git a/draw/point.mli b/draw/point.mli deleted file mode 100755 index 8e3f5aa..0000000 --- a/draw/point.mli +++ /dev/null @@ -1,13 +0,0 @@ -type t - -val (+): t -> Gg.v2 -> t - -val get_coord : t -> Gg.v2 - -val create: float -> float -> t - -val add_point_in_path - : float -> float -> t list -> Curves.Bezier.t list -> t list * Curves.Bezier.t list - -val get_coord' - : t -> Gg.v2 diff --git a/dune b/dune index 36edb56..314dc63 100755 --- a/dune +++ b/dune @@ -10,7 +10,7 @@ messages_json worker draw - curves + shapes tools events ) diff --git a/events/timer.ml b/events/timer.ml index def9a81..0a75e12 100755 --- a/events/timer.ml +++ b/events/timer.ml @@ -1,24 +1,41 @@ -type t = Brr.G.timer_id ref * unit Note.E.send +open Brr_note_kit + +type t = + { mutable id : Brr.G.timer_id + ; send : float Note.E.send + ; mutable counter : Time.counter + } let create - : unit -> (t * unit Note.E.t) + : unit -> (t * Brr_note_kit.Time.span Note.E.t) = fun () -> - let event, send = Note.E.create () in - (ref (-1), send), event + let event, send = Note.E.create () + and counter = (Time.counter ()) in + {id = (-1); send; counter}, event let stop : t -> unit - = fun (id, _) -> - Brr.G.stop_timer !id + = fun {id; _} -> + Brr.G.stop_timer id let start : t -> float -> unit - = fun (id, send) d -> + = fun t d -> + let {id; send; _} = t in + t.counter <- Time.counter (); + - Brr.G.stop_timer !id; + Brr.G.stop_timer id; let timer_id = Brr.G.set_interval ~ms:(int_of_float @@ d *. 1000.) - (fun () -> send ()) in - ignore @@ Brr.G.set_timeout ~ms:0 send; - id:= timer_id; + (fun () -> + + let span = Time.counter_value t.counter in + t.counter <- Time.counter (); + send span) in + ignore @@ Brr.G.set_timeout ~ms:0 (fun () -> send 0.); + t.id <- timer_id + +let delay : t -> float + = fun t -> Time.counter_value t.counter diff --git a/events/timer.mli b/events/timer.mli index 4bf8a9b..0509ad0 100755 --- a/events/timer.mli +++ b/events/timer.mli @@ -1,7 +1,11 @@ +open Brr_note_kit + type t -val create : unit -> t * unit Note.E.t +val create : unit -> t * Time.span Note.E.t val start: t -> float -> unit val stop: t -> unit + +val delay : t -> float diff --git a/path/draw.ml b/path/draw.ml new file mode 100755 index 0000000..757c778 --- /dev/null +++ b/path/draw.ml @@ -0,0 +1,229 @@ +open StdLabels +module Path = Brr_canvas.C2d.Path + +module Point = Point + +(** Translate the point in the canva area *) +let translate_point + : area:Gg.v2 -> Gg.v2 -> (float * float) + = fun ~area point -> + let x, y = Gg.V2.(to_tuple @@ mul area point) in + x, ((Gg.V2.y area) -. y) + +let translate_point' + : area:Gg.v2 -> Gg.v2 -> Gg.v2 -> (float * float) + = fun ~area vect point -> + let open Gg.V2 in + translate_point ~area + (point + vect) + + +(* Draw a straight line between two points *) +let line + : Gg.v2 -> p1:Point.t -> Path.t -> unit + = fun area ~p1 path -> + let x, y = translate_point ~area (Point.get_coord p1) in + Path.line_to path ~x ~y + +(* Draw a simple bezier curve from the three given points *) +let three_points + : Gg.v2 -> p0:Point.t -> p1:Point.t -> p2:Point.t -> Path.t -> unit + = fun area ~p0 ~p1 ~p2 path -> + let p0 = Point.get_coord p0 + and p1 = Point.get_coord p1 + and p2 = Point.get_coord p2 in + let bezier = Shapes.Bezier.three_points_quadratic p0 p1 p2 + |> Shapes.Bezier.quadratic_to_cubic in + let cx, cy = translate_point ~area bezier.Shapes.Bezier.ctrl0 + and cx', cy' = translate_point ~area bezier.Shapes.Bezier.ctrl1 + and x, y = translate_point ~area bezier.Shapes.Bezier.p1 in + + Path.ccurve_to path + ~cx ~cy + ~cx' ~cy' + ~x ~y + +let multi_points + : ?connexion:Gg.v2 -> Gg.v2 -> Point.t list -> Path.t -> unit + = fun ?connexion area points path -> + + let (let*) v f = + match v with + | Ok beziers -> f beziers + | _ -> () in + + let points = List.map ~f:Point.get_coord points in + + let* beziers = Shapes.Bspline.to_bezier ?connexion1:connexion points in + Array.iter beziers + ~f:(fun bezier -> + let cx, cy = translate_point ~area bezier.Shapes.Bezier.ctrl0 + and cx', cy' = translate_point ~area bezier.Shapes.Bezier.ctrl1 + and x, y = translate_point ~area bezier.Shapes.Bezier.p1 in + + Path.ccurve_to path + ~cx ~cy + ~cx' ~cy' + ~x ~y + ) + +let circle + : Gg.v2 -> center:Gg.v2 -> float -> Path.t -> Path.t + = fun area ~center r path -> + + let cx, cy = translate_point ~area center in + Path.arc + path + ~cx ~cy + ~r + ~start:0. + ~stop:Gg.Float.two_pi; + path + +type path = + | Empty + | Line of Point.t * Point.t + | Three_point of Point.t * Point.t * Point.t + | Curve of Shapes.Bezier.t array + +type t = + { id : int + ; path : path } + +let move_to + : area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit + = fun ~area canvaPath path -> + match path with + | Empty -> () + | Line (p0, _) + | Three_point (p0, _, _) -> + let x, y = translate_point ~area (Point.get_coord p0) in + Path.move_to canvaPath ~x ~y + | Curve beziers -> + try + let bezier = Array.get beziers 0 in + let x, y = translate_point ~area bezier.Shapes.Bezier.p0 in + Path.move_to canvaPath ~x ~y + with _ -> () + +let draw + : ?connexion:Point.t -> area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit + = fun ?connexion ~area canvaPath path -> + match connexion, path with + + | _, Empty -> () + | None, Line (_, p1) -> + ignore @@ line area ~p1 canvaPath + + | Some p0, Line (p1, p2) + | None, Three_point (p0, p1, p2) + | Some _, Three_point (p0, p1, p2) -> + ignore @@ three_points area ~p0 ~p1 ~p2 canvaPath + + | _, Curve beziers -> + Array.iter beziers + ~f:(fun bezier -> + + let cx, cy = translate_point ~area bezier.Shapes.Bezier.ctrl0 + and cx', cy' = translate_point ~area bezier.Shapes.Bezier.ctrl1 + and x, y = translate_point ~area bezier.Shapes.Bezier.p1 in + + Path.ccurve_to canvaPath + ~cx ~cy + ~cx' ~cy' + ~x ~y + ) + +let go_back + : ?connexion:Point.t -> area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit + = fun ?connexion ~area canvaPath path -> + let vect = Gg.V2.of_polar @@ Gg.V2.v + 0.02 + Gg.Float.pi_div_4 + in + match connexion, path with + | _, Empty -> () + | _, Three_point (p0, p1, p2) -> + let open Point in + let p0' = p0 + vect + and p1' = p1 + vect + and p2' = p2 + vect in + + let x, y = translate_point' ~area vect @@ Point.get_coord p2 in + Path.line_to canvaPath ~x ~y; + ignore @@ three_points area ~p0:p2' ~p1:p1' ~p2:p0' canvaPath + | _, Curve beziers -> + let last = Array.get beziers ((Array.length beziers) -1) in + + let x, y = + last.Shapes.Bezier.p1 + |> translate_point' vect ~area in + + Path.line_to canvaPath ~x ~y; + + for i = 1 to Array.length beziers do + + let i = (Array.length beziers) - i in + let bezier = Array.get beziers i in + + let cx, cy = translate_point' vect ~area bezier.Shapes.Bezier.ctrl1 + and cx', cy' = translate_point' vect ~area bezier.Shapes.Bezier.ctrl0 + and x, y = translate_point' vect ~area bezier.Shapes.Bezier.p0 in + + Path.ccurve_to canvaPath + ~cx ~cy + ~cx' ~cy' + ~x ~y + done; + + | _ -> () + +type quick_path = Point.t list * Shapes.Bezier.t list + +let id = ref 0 + +let to_path + : quick_path -> t + = fun (points, beziers) -> + + incr id; + let id = !id in + match beziers with + | [] -> + begin match points with + | p0::p1::[] -> {id; path=Line (p0, p1)} + | p0::p1::p2::[] -> {id; path=Three_point (p0, p1, p2)} + | points -> + + let (let*) v f = + match v with + | Ok beziers -> f beziers + | _ -> {id; path=Empty} in + + let points' = List.map ~f:Point.get_coord points in + + let* beziers = Shapes.Bspline.to_bezier points' in + {id; path=Curve beziers} + end + | _ -> + let (let*) v f = + match v with + | Ok beziers -> f beziers + | _ -> {id; path=Curve (Array.of_list beziers)} in + + let connexion = match beziers with + | hd::_ -> Some hd.Shapes.Bezier.p1 + | _ -> None in + + let* beziers' = Shapes.Bspline.to_bezier + ?connexion1:connexion + (List.map points ~f:Point.get_coord) in + + + (* Create a new array with both lenght *) + let t = Array.append + beziers' + (Array.of_list beziers) + in + + {id; path = Curve t} diff --git a/path/dune b/path/dune new file mode 100755 index 0000000..c9eff46 --- /dev/null +++ b/path/dune @@ -0,0 +1,8 @@ +(library + (name draw) + (libraries + gg + brr + shapes + ) + ) diff --git a/path/point.ml b/path/point.ml new file mode 100755 index 0000000..91b68c2 --- /dev/null +++ b/path/point.ml @@ -0,0 +1,78 @@ +open StdLabels + +type t = + { p: Gg.v2 + ; size : float + ; angle: float + } + +let create x y = + { p = Gg.V2.v x y + ; size = 0.1 + ; angle = Gg.Float.pi_div_4 + } + +let (+) p1 p2 = + { p1 with p = Gg.V2.(+) p1.p p2 } + +let get_coord { p; _ } = p + +let get_coord' + : t -> Gg.v2 + = fun t -> + let open Gg.V2 in + let trans = of_polar @@ v t.size t.angle in + t.p + trans + +let return_segment + : Shapes.Bezier.t -> Shapes.Bezier.t list -> Shapes.Bezier.t list + = fun bezier beziers -> + (* We gave the points in reverse order, so we have to revert the + curve *) + let bezier' = Shapes.Bezier.reverse bezier in + bezier'::beziers + + +let get_new_segment connexion0 p5 p4 p3 p2 p1 = + let p5' = get_coord p5 + and p4' = get_coord p4 + and p3' = get_coord p3 + and p2' = get_coord p2 + and p1' = get_coord p1 in + + let points_to_link = + [ p1' + ; p2' + ; p3' + ; p4' + ; p5' ] in + Shapes.Bspline.to_bezier ?connexion0 points_to_link + +let add_point_in_path + : float * float -> t list -> Shapes.Bezier.t list -> t list * Shapes.Bezier.t list + = fun (x, y) path beziers -> + let lastClick = create x y in + let (let*) v f = + match v with + | Ok bezier -> + if Array.length bezier > 0 then + f (Array.get bezier 0) + else + lastClick::path, beziers + | _ -> + lastClick::path, beziers + in + + let connexion0 = match beziers with + | hd::_ -> Some hd.Shapes.Bezier.p1 + | _ -> None in + + match path with + | p4::p3::p2::p1::_ -> + let* bezier = get_new_segment connexion0 + lastClick p4 p3 p2 p1 in + (* We remove the last point and add the bezier curve in the list*) + let firsts = lastClick::p4::p3::p2::[] in + firsts, return_segment bezier beziers + | _ -> + lastClick::path, beziers diff --git a/path/point.mli b/path/point.mli new file mode 100755 index 0000000..068f4c1 --- /dev/null +++ b/path/point.mli @@ -0,0 +1,13 @@ +type t + +val (+): t -> Gg.v2 -> t + +val get_coord : t -> Gg.v2 + +val create: float -> float -> t + +val add_point_in_path + : (float * float) -> t list -> Shapes.Bezier.t list -> t list * Shapes.Bezier.t list + +val get_coord' + : t -> Gg.v2 diff --git a/script.ml b/script.ml index f97eed2..9cd8a22 100755 --- a/script.ml +++ b/script.ml @@ -12,7 +12,7 @@ type mode = type current = { points : Point.t list (* The list of points to draw *) - ; beziers : Curves.Bezier.t list (* All the points already fixed *) + ; beziers : Shapes.Bezier.t list (* All the points already fixed *) } type state = @@ -30,7 +30,7 @@ type canva_events = type events = [ canva_events - | `Point of float * float ] + | `Point of float * (float * float) ] type canva_signal = Point.t @@ -70,10 +70,10 @@ let do_action : events -> state -> state = fun event state -> match event, state.mode with - | `Point (x, y), Edit -> + | `Point (_delay, point), Edit -> (* Add the point in the list *) let points, beziers = Point.add_point_in_path - x y + point state.current.points state.current.beziers in @@ -83,13 +83,39 @@ let do_action | `Click _, Out -> Timer.start state.timer 0.3; { state with mode = Edit } - | `Out (x, y), _ -> + | `Out p, Edit -> Timer.stop state.timer; (* Add the point in the list *) + + let points, beziers = match state.current.points, state.current.beziers with + | hd::(tl), beziers -> + + let open Gg.V2 in + let p' = of_tuple p + and hd' = Point.get_coord hd in + if (norm (hd' - p' )) < 0.05 then + (Point.create (fst p) (snd p))::tl + , beziers + else ( + Point.add_point_in_path + p + state.current.points + state.current.beziers + ) + | _ -> + Point.add_point_in_path + p + state.current.points + state.current.beziers + in + + +(* let points, beziers = Point.add_point_in_path - x y + p state.current.points state.current.beziers in +*) let beziers = Draw.to_path (points, beziers) in let paths = beziers::state.paths @@ -131,7 +157,7 @@ let draw_path area points beziers = let open Brr_canvas.C2d in let connexion = match beziers with | [] -> None - | hd ::_ -> Some hd.Curves.Bezier.p1 in + | hd ::_ -> Some hd.Shapes.Bezier.p1 in (* Firt draw all the points most recent points *) let path = draw ?connexion ~area points in @@ -140,9 +166,9 @@ let draw_path area points beziers = ~init:path ~f:(fun path bezier -> - let cx, cy = Draw.translate_point ~area bezier.Curves.Bezier.ctrl0 - and cx', cy' = Draw.translate_point ~area bezier.Curves.Bezier.ctrl1 - and x, y = Draw.translate_point ~area bezier.Curves.Bezier.p1 in + let cx, cy = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl0 + and cx', cy' = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl1 + and x, y = Draw.translate_point ~area bezier.Shapes.Bezier.p1 in Path.ccurve_to path ~cx ~cy @@ -178,38 +204,48 @@ let on_change canva mouse_position state = let pos = S.rough_value mouse_position in let points = match state.mode, pos with - | Edit, Some (x, y) -> (Point.create x y)::state.current.points - | _ -> state.current.points in + | Edit, Some (x, y) -> + (Point.create x y)::state.current.points + | _ -> + set_image_smoothing_enabled context true; + set_image_smoothing_quality context Image_smoothing_quality.high; + state.current.points in let path = draw_path area (points) state.current.beziers in stroke context path; List.iter state.paths ~f:(fun path -> - let p = Path.create () in - Draw.move_to ~area p path.Draw.path; - Draw.draw ~area p path.Draw.path; - Draw.go_back ~area p path.Draw.path; - fill ~fill_rule:Fill_rule.nonzero context p; -(* + (* This is ugly, and probably non efficient, but is an appropriate solution for + the cases of overlapping path *) match path.Draw.path with - | Curve c -> - let c' = Array.init - (Array.length c) - ~f:(fun i -> - Curves.Bezier.reverse @@ Array.get c ((Array.length c) -i - 1) - ) - in - let p' = Draw.Curve c' in - Draw.move_to ~area p p'; - Draw.draw ~area p p'; - Draw.go_back ~area p p'; - fill ~fill_rule:Fill_rule.nonzero context p; - () - | _ -> () -*) + | Draw.Curve beziers -> + + Array.iter beziers + ~f:(fun bezier -> + + let b = Draw.Curve [|bezier|] in + let p = Path.create () in + Draw.move_to ~area p b; + Draw.draw ~area p b; + Draw.go_back ~area p b; + Path.close p; + fill context p; + stroke context p + + + ) + + | _ -> + let p = Path.create () in + Draw.move_to ~area p path.Draw.path; + Draw.draw ~area p path.Draw.path; + Draw.go_back ~area p path.Draw.path; + Path.close p; + fill context p; + stroke context p ); () @@ -236,7 +272,7 @@ let page_main id = let tick_event = S.sample_filter mouse_position ~on:tick - (fun pos () -> Option.map (fun p -> `Point p) pos ) in + (fun pos f -> Option.map (fun p -> `Point (f, p)) pos ) in (* The first evaluation is the state. Which is the result of all the successives events to the initial state *) diff --git a/shapes/bezier.ml b/shapes/bezier.ml new file mode 100755 index 0000000..bf7aaaa --- /dev/null +++ b/shapes/bezier.ml @@ -0,0 +1,203 @@ +(** + + Bezier curve +*) + +module Utils = Tools.Utils + +type quadratic = + { p0:Gg.v2 (* The starting point *) + ; p1:Gg.v2 (* The end point *) + ; ctrl:Gg.v2 } (* The control point *) + + +type t = + { p0:Gg.v2 (* The starting point *) + ; p1:Gg.v2 (* The end point *) + ; ctrl0:Gg.v2 (* The control point *) + ; ctrl1:Gg.v2 } (* The control point *) + + +(** + Build a control point for a quadratic curve for passing throuht 3 points. + taken from https://xuhehuan.com/2608.html + + + also look to https://pomax.github.io/bezierinfo/#pointcurves +*) +let three_points_quadratic + : Gg.v2 -> Gg.v2 -> Gg.v2 -> quadratic + = fun p0 c1 p1 -> + + let open Gg.V2 in + + let vect_1 = p0 - c1 + and vect_2 = p1 - c1 in + let norm1 = norm vect_1 + and norm2 = norm vect_2 in + let v = (Float.sqrt (norm1 *. norm2)) /. 2. in + + let ctrl = c1 - v * (( vect_1 / norm1) + (vect_2 / norm2)) in + {p0; p1; ctrl} + +(** + + Convert a cubic bezier curve into a quadratic one + +*) +let quadratic_to_cubic + : quadratic -> t + = fun {p0; p1; ctrl} -> + + let coef = 2. /. 3. in + + let open Gg.V2 in + { p0 + ; p1 + ; ctrl0 = mix p0 ctrl coef + ; ctrl1 = mix p1 ctrl coef } + + + +let abc_ratio + : int -> float -> float + = fun n t -> + let n' = Float.of_int n in + let bottom = (Float.pow t n') +. (Float.pow (1. -. t) n') in + let top = bottom -. 1. in + Float.abs (top /. bottom) + +let half_cubic_ratio = abc_ratio 3 0.5 + +exception Not_found + +(** + + https://pomax.github.io/bezierinfo/#pointcurves + +*) +let three_points_cubic + : float -> Gg.v2 -> Gg.v2 -> Gg.v2 -> t + = fun f p0 p1 p2 -> + + let open Gg.V2 in + + let c = half ( p0 + p2) in + let a = p1 + ((p1 - c) / half_cubic_ratio) in + + let vect1_0 = p1 - p0 in + let vect2_0 = p2 - p0 in + + let d1 = norm vect1_0 + and d2 = norm (p2 - p1) in + let t = d1 /. (d1 +. d2) in + + let angle_1_0 = angle vect1_0 + and angle_2_0 = angle vect2_0 in + + (* get our e1-e2 distances *) + let angle = mod_float + (Gg.Float.two_pi + +. angle_2_0 + -. angle_1_0) + Gg.Float.two_pi in + + let distance = (norm vect2_0) *. f in + + let bc = + if angle < 0. || angle > Gg.Float.pi then + Float.(neg distance) + else + distance in + let de1 = t *. bc + and de2 = (1. -. t) *. bc in + + (* get the circle-aligned slope as normalized dx/dy *) + let center = Utils.center p0 p1 p2 in + match center with + | None -> raise Not_found + | Some center -> + let t' = p1 - center in + let tangent0 = v + ((x p1) -. (y t')) + ((y p1) +. (x t')) + and tangent1 = v + ((x p1) +. (y t')) + ((y p1) -. (x t')) in + + let d = unit (tangent1 - tangent0) in + + (* then set up an e1 and e2 parallel to the baseline *) + let e1 = p1 + de1 * d + and e2 = p1 - de2 * d in + + (* then use those e1/e2 to derive the new hull coordinates *) + let v1 = a + (e1 - a) / (1. -. t) + and v2 = a + (e2 - a) / t in + + let ctrl0 = p0 + (v1 - p0) / t + and ctrl1 = p2 + (v2 -p2) / (1. -. t) in + + {p0; p1 = p2; ctrl0; ctrl1} + +(** Split a bezier curve in two at a given position *) +let slice + : float -> t -> t * t + = fun t {p0; p1; ctrl0; ctrl1} -> + + let mix p1 p2 = Gg.V2.mix p1 p2 t in + + let p12 = mix p0 ctrl0 + and p23 = mix ctrl0 ctrl1 + and p34 = mix ctrl1 p1 in + + let p123 = mix p12 p23 + and p234 = mix p23 p34 in + + let p1234 = mix p123 p234 in + + ( { p0 + ; ctrl0 = p12 + ; ctrl1 = p123 + ; p1 = p1234 } + , { p0 = p1234 + ; ctrl0 = p234 + ; ctrl1 = p34 + ; p1 } ) + + +let get_closest_point + : Gg.v2 -> t -> float * Gg.v2 + = fun point t -> + + let rec f min max t = + + (* First devide the curve in two *) + let seq_0, seq_1 = slice 0.5 t in + let avg = (min +. max) /. 2. in + + let p0 = t.p0 + and p1 = t.p1 + and p01 = seq_0.p1 in (* seq_0.p1 = seq_1.p0 *) + + let open Gg.V2 in + let center0 = mix p0 p01 0.5 + and center1 = mix p01 p1 0.5 in + + if Tools.Utils.equal_point 0.001 p0 p1 then + avg, p01 + else if (norm (point - center0)) < (norm (point - center1)) then + f min avg seq_0 + else + f avg max seq_1 + + in f 0. 1. t + +let reverse + : t -> t + = fun bezier -> + { + p0 = bezier.p1 + ; p1 = bezier.p0 + ; ctrl0 = bezier.ctrl1 + ; ctrl1 = bezier.ctrl0 } diff --git a/shapes/bezier.mli b/shapes/bezier.mli new file mode 100755 index 0000000..2f5bbcf --- /dev/null +++ b/shapes/bezier.mli @@ -0,0 +1,40 @@ +type t = + { p0:Gg.v2 (* The starting point *) + ; p1:Gg.v2 (* The end point *) + ; ctrl0:Gg.v2 (* The control point *) + ; ctrl1:Gg.v2 } (* The control point *) + +type quadratic + +(** + Build a control point for a quadratic curve for passing throuht 3 points. + taken from https://xuhehuan.com/2608.html + + + also look to https://pomax.github.io/bezierinfo/#pointcurves +*) +val three_points_quadratic + : Gg.v2 -> Gg.v2 -> Gg.v2 -> quadratic + +(** + Create a curve from three points. + + This is an implementation for + https://pomax.github.io/bezierinfo/#pointcurves + +*) +val three_points_cubic + : float -> Gg.v2 -> Gg.v2 -> Gg.v2 -> t + +val quadratic_to_cubic + : quadratic -> t + +(** Split a bezier curve in two at a given position *) +val slice + : float -> t -> t * t + +(** Return the closest point to the curve by approximation *) +val get_closest_point + : Gg.v2 -> t -> float * Gg.v2 + +val reverse: t -> t diff --git a/shapes/bspline.ml b/shapes/bspline.ml new file mode 100755 index 0000000..bb60227 --- /dev/null +++ b/shapes/bspline.ml @@ -0,0 +1,149 @@ +open StdLabels + +type err = [`InvalidPath ] + +module M = Matrix.MakeMatrix (struct + + type t = Float.t + + let compare a b = + + let v = Float.compare a b in + if v = 0 then Matrix.Order.Equal + else if v > 0 then Matrix.Order.Greater + else Matrix.Order.Less + + let zero = Float.zero + let one = Float.one + + let divide = (/.) + let multiply = ( *. ) + let add = (+.) + let subtract = (-.) + exception NonElt + + + end) + +type t = Gg.v2 list + +let from_points + : Gg.v2 array -> (Gg.v2 array, [> `InvalidPath]) Result.t + = fun points -> + + let n = (Array.length points - 2) in + + if n <= 1 then + Result.error `InvalidPath + else + + (* Create the initial matrix. + + The matrix is augmented with two additionals columns, which will be + populated with the points from the path. + *) + let arr = Array.init n ~f:(fun line -> + Array.init (n +2) ~f:(fun row -> + match row - line with + | (-1) -> 1. + | 0 -> 4. + | 1 -> 1. + | _ -> 0. + ) + ) in + let matrix = M.from_array arr in + + (* Add the points from the augmented matrix *) + let points_array = points in + for line = 0 to (n -1) do + + let point = + if line = 0 then + let p0 = points_array.(0) + and p1 = points_array.(1) in + Gg.V2.(6. * p1 - p0) + else if (line + 1) = n then + let p_n_2 = points_array.(n) + and p_n_1 = points_array.(n + 1) in + Gg.V2.(6. * p_n_2 - p_n_1) + else + let n' = line + 1 in + Gg.V2.(6. * points_array.(n')) + in + let x = (Gg.V2.x point) + and y = (Gg.V2.y point) in + + + M.set_elt matrix (line + 1, n + 1) x; + M.set_elt matrix (line + 1, n + 2) y; + done; + + (* Resolve the matrix *) + let res' = M.row_reduce matrix in + + (* Extract the result as points *) + let _, col_x = M.get_column res' (n + 1) + and _, col_y = M.get_column res' (n + 2) in + + (* Build the result *) + let res = Array.make (n + 2) (Array.get points_array (n + 1) ) in + for i = 1 to n do + let point = Gg.V2.v col_x.(i - 1) col_y.(i - 1) in + Array.set res i point; + done; + Array.set res 0 (Array.get points_array 0); + Result.ok res + +let (let*) = Result.bind + +(** Build a continue curve from path + + see https://www.math.ucla.edu/~baker/149.1.02w/handouts/dd_splines.pdf +*) +let to_bezier + : ?connexion0:Gg.v2 -> ?connexion1:Gg.v2 -> t -> (Bezier.t array, [> `InvalidPath]) Result.t + = fun ?connexion0 ?connexion1 points -> + + let points' = match connexion0 with + | None -> points + | Some pt -> pt::points in + + let arr_points = match connexion1 with + | None -> Array.of_list points' + | Some pt -> + let arr = Array.make (1 + (List.length points')) pt in + List.iteri points' + ~f:(fun i value -> Array.set arr i value); + arr in + + let* bspline_points = from_points arr_points in + + let start = match connexion0 with + | None -> 1 + | Some _ -> 2 + and end_ = match connexion1 with + | None -> (Array.length bspline_points) - 1 + | Some _ -> (Array.length bspline_points) - 2 in + + let result = Array.init (end_ - start + 1) ~f:(fun i -> + + let i = i + start in + + let prev_b = Array.get bspline_points (i - 1) + and bpoint = Array.get bspline_points i + and prev_p = Array.get arr_points (i - 1) + and point = Array.get arr_points i in + let ctrl0 = Gg.V2.(mix prev_b bpoint (1. /. 3.)) + and ctrl1 = Gg.V2.(mix prev_b bpoint (2. /. 3.)) in + + let bezier = + { Bezier.p0 = prev_p + ; Bezier.p1 = point + ; Bezier.ctrl0 + ; Bezier.ctrl1 } in + + bezier + + ) in + Result.Ok result + diff --git a/shapes/bspline.mli b/shapes/bspline.mli new file mode 100755 index 0000000..a36aa22 --- /dev/null +++ b/shapes/bspline.mli @@ -0,0 +1,24 @@ +type t + +type err = + [ `InvalidPath (* Too few points in the path for building the curve *) + ] + +(** Convert a list of points into a beziers curves. + + At least 4 points are required for building the path. + + [to_bezier ~connexion points] create a list of beziers segments joining all + the points together. + + [connexion0] add a virtual point in the begining for helping to get the + appropriate tangent when connecting path together + + [connexion1] does the same at the end + +*) +val to_bezier + : ?connexion0:Gg.v2 + -> ?connexion1:Gg.v2 + -> Gg.v2 list + -> (Bezier.t array, [> err]) Result.t diff --git a/shapes/dd_splines.pdf b/shapes/dd_splines.pdf new file mode 100755 index 0000000..2618162 Binary files /dev/null and b/shapes/dd_splines.pdf differ diff --git a/shapes/dune b/shapes/dune new file mode 100755 index 0000000..d03a217 --- /dev/null +++ b/shapes/dune @@ -0,0 +1,7 @@ +(library + (name shapes) + (libraries + tools + matrix + ) + ) diff --git a/worker/dune b/worker/dune index 9f95cf8..508055e 100755 --- a/worker/dune +++ b/worker/dune @@ -4,6 +4,6 @@ gg brr note - curves + shapes ) ) -- cgit v1.2.3