diff options
| author | Sébastien Dailly <sebastien@chimrod.com> | 2020-12-20 20:58:31 +0100 |
|---|---|---|
| committer | Sébastien Dailly <sebastien@chimrod.com> | 2020-12-20 20:58:31 +0100 |
| commit | 1f1f13a3f02e7f5f5da5926a402d53f2ccbfe536 (patch) | |
| tree | d704a69ccf10b42cbe2ddba8a2291ee3d7d39091 | |
| parent | a86ede2f3d29d6de6ef7c1eab577f00d4c583660 (diff) | |
Update du soir
| -rwxr-xr-x | index.html | 14 | ||||
| -rwxr-xr-x | path/builder.ml | 159 | ||||
| -rwxr-xr-x | path/builder.mli | 31 | ||||
| -rwxr-xr-x | path/fillPrinter.ml | 71 | ||||
| -rwxr-xr-x | path/linePrinter.ml | 53 | ||||
| -rwxr-xr-x | path/wireFramePrinter.ml | 4 | ||||
| -rwxr-xr-x | path/wireFramePrinter.mli | 2 | ||||
| -rwxr-xr-x | script.html | 48 | ||||
| -rwxr-xr-x | script.ml | 151 |
9 files changed, 338 insertions, 195 deletions
diff --git a/index.html b/index.html deleted file mode 100755 index 26ba7fa..0000000 --- a/index.html +++ /dev/null @@ -1,14 +0,0 @@ -<!DOCTYPE html> -<html lang="en"> -<head> - <meta charset="utf-8"> - <meta name="viewport" content="width=device-width, - initial-scale=1.0"> - <script type="text/javascript" defer="defer" src="_build/default/canva.bc.js"></script> - <style type="text/css"> body \{ background-color: black; margin: 3em; \}</style> - <title>Drawer</title> -</head> -<body> - <noscript>Sorry, you need to enable JavaScript to see this page.</noscript> -</body> -</html> diff --git a/path/builder.ml b/path/builder.ml index 01dda87..b77c60a 100755 --- a/path/builder.ml +++ b/path/builder.ml @@ -17,9 +17,6 @@ module type REPR = sig type 'a repr - val create_path - : unit -> 'a repr - (* Start a new path. *) val start : t -> 'a repr -> 'a repr @@ -46,6 +43,15 @@ module Make(Point:P) = struct type t = Point.t list * bezier list + type path = + | Empty + | Line of Point.t * Point.t + | Curve of bezier + + type fixedPath = + { id: int + ; path : path array } + let get_new_segment connexion0 p5 p4 p3 p2 p1 = let p5' = Point.get_coord p5 and p4' = Point.get_coord p4 @@ -64,7 +70,7 @@ module Make(Point:P) = struct let empty = ([], []) let add_point - : Point.t -> t -> t + : Point.t -> t -> t * fixedPath option = fun lastPoint (path, beziers) -> let (let*) v f = match v with @@ -72,9 +78,11 @@ module Make(Point:P) = struct if Array.length bezier > 0 then f (Array.get bezier 0) else - lastPoint::path, beziers + ( (lastPoint::path, beziers) + , None ) | _ -> - lastPoint::path, beziers + ( (lastPoint::path, beziers) + , None ) in let connexion0 = match beziers with @@ -95,18 +103,22 @@ module Make(Point:P) = struct (* We remove the last point and add the bezier curve in the list*) let firsts = lastPoint::p4::p3::p2::[] in - (*firsts, (Shapes.Bezier.reverse bezier)::beziers*) - firsts, bezier_point::beziers + ( (firsts, bezier_point::beziers) + , None ) | _ -> - lastPoint::path, beziers + ( ( lastPoint::path + , beziers) + , None ) let replace_last - : Point.t -> t -> t + : Point.t -> t -> t * fixedPath option = fun lastPoint ((path, beziers) as t) -> match path, beziers with | _::(tl), beziers -> - lastPoint::tl - , beziers + + ( ( lastPoint::tl + , beziers ) + , None ) | _ -> add_point lastPoint t @@ -124,65 +136,15 @@ module Make(Point:P) = struct | [] -> None | hd::_ -> Some hd - let get - : t -> t - = fun t -> t - - (** Complete path **) - (* Transform the result by replacing each start and end point by the - version given in the list - - This allow to keep the informations like angle or nib width inside the - bezier curve - - *) - let points_to_beziers - : Point.t list -> Shapes.Bezier.t array -> bezier array - = fun points beziers -> - match points with - (* If there is no point to draw, just return empty array *) - | [] -> [||] - | first_point::_ -> - let curves = Array.make - ( (List.length points) -1) - { p0 = Point.empty - ; ctrl0 = Gg.V2.of_tuple (0., 0.) - ; ctrl1 = Gg.V2.of_tuple (0., 0.) - ; p1 = Point.empty } in - - let _ = List.fold_left points - ~init:(first_point, -1) - ~f:(fun (prev_point, i) point -> - (* In the first step, prev_point = point *) - if i < 0 then - ( prev_point - , 0) - else - - let bezier_curve = Array.get beziers i in - Array.set curves i - { p0 = Point.copy prev_point bezier_curve.Shapes.Bezier.p0 - ; ctrl0 = bezier_curve.Shapes.Bezier.ctrl0 - ; ctrl1 = bezier_curve.Shapes.Bezier.ctrl1 - ; p1 = Point.copy point bezier_curve.Shapes.Bezier.p1 }; - - ( point - , i + 1) - ) in - curves - - module Draw(Repr:REPR with type t = Point.t) = struct (** Drawing path **) let draw - : t -> 'a Repr.repr - = fun (points, beziers) -> - - let path = Repr.create_path () in + : t -> 'a Repr.repr -> 'a Repr.repr + = fun (points, beziers) path -> (* Represent the last points *) let path = match points with @@ -275,15 +237,6 @@ module Make(Point:P) = struct ) end - type path = - | Empty - | Line of Point.t * Point.t - | Curve of bezier - - type fixedPath = - { id: int - ; path : path array } - module ToFixed = struct type t = Point.t @@ -333,7 +286,7 @@ module Make(Point:P) = struct = fun t -> incr id; { id = !id - ; path = FixedBuilder.draw t + ; path = FixedBuilder.draw t (ToFixed.create_path ()) |> ToFixed.get } @@ -349,10 +302,9 @@ module Make(Point:P) = struct p let draw - : fixedPath -> 'a Repr.repr - = fun {path; _} -> + : fixedPath -> 'a Repr.repr -> 'a Repr.repr + = fun {path; _} repr -> - let repr = Repr.create_path () in let _, repr = Array.fold_left path ~init:(true, repr) ~f:(fun (first, path) element -> @@ -376,4 +328,57 @@ module Make(Point:P) = struct Repr.stop repr end + + let box + : bezier -> Gg.box2 + = fun bezier -> + Gg.Box2.of_pts + (Point.get_coord bezier.p0) + (Point.get_coord bezier.p1) + |> (fun b -> Gg.Box2.add_pt b bezier.ctrl0) + |> (fun b -> Gg.Box2.add_pt b bezier.ctrl1) + + + let distance + : Gg.v2 -> fixedPath -> float option = + fun point beziers -> + + Array.fold_left beziers.path + ~init:None + ~f:(fun res path -> + match path with + | 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 + | false -> res + | true -> + res + end + | Curve bezier -> + begin match Gg.Box2.mem point (box bezier) with + | false -> res + | true -> + + let bezier' = Shapes.Bezier.( + + { p0 = Point.get_coord bezier.p0 + ; p1 = Point.get_coord bezier.p1 + ; 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 + match res with + | None -> Some distance + | Some d -> if d < distance then res else (Some distance) + end + + + ) + + + + + end diff --git a/path/builder.mli b/path/builder.mli index f5adef1..42f433e 100755 --- a/path/builder.mli +++ b/path/builder.mli @@ -16,9 +16,6 @@ module type REPR = sig type 'a repr - val create_path - : unit -> 'a repr - (* Start a new path. *) val start : t -> 'a repr -> 'a repr @@ -35,23 +32,20 @@ end module Make(P:P) : sig - type bezier = - { p0:P.t (* The starting point *) - ; p1:P.t (* The end point *) - ; ctrl0:Gg.v2 (* The control point *) - ; ctrl1:Gg.v2 } (* The control point *) - + type bezier type t + type fixedPath + (** Create an empty path *) val empty: t val add_point - : P.t -> t -> t + : P.t -> t -> t * fixedPath option (** Replace the last alement in the path by the one given in parameter *) val replace_last - : P.t -> t -> t + : P.t -> t -> t * fixedPath option (** Retrieve the last element, if any *) val peek @@ -61,26 +55,21 @@ module Make(P:P) : sig val peek2 : t -> (P.t * P.t) option - val get - : t -> P.t list * bezier list - - val points_to_beziers - : P.t list -> Shapes.Bezier.t array -> bezier array - module Draw(Repr:REPR with type t = P.t) : sig (** Represent the the current path *) val draw - : t -> 'a Repr.repr + : t -> 'a Repr.repr -> 'a Repr.repr end - type fixedPath - val to_fixed : t -> fixedPath module DrawFixed(Repr:REPR with type t = P.t) : sig val draw - : fixedPath -> 'a Repr.repr + : fixedPath -> 'a Repr.repr -> 'a Repr.repr end + (** Return the shortest distance between the mouse and a point *) + val distance + : Gg.v2 -> fixedPath -> float option end diff --git a/path/fillPrinter.ml b/path/fillPrinter.ml new file mode 100755 index 0000000..d95030c --- /dev/null +++ b/path/fillPrinter.ml @@ -0,0 +1,71 @@ +module Repr = Layer.CanvaPrinter + +type t = Point.t + +type 'a repr = + { path: ('a Repr.t) + ; close : 'a Repr.t -> unit + } + +let create_path + : 'b -> 'a repr + = fun f -> + { close = f + ; path = Repr.create () + } + +(* Start a new path. *) +let start + : Point.t -> 'a repr -> 'a repr + = fun t {close ; path } -> + let path = Repr.move_to (Point.get_coord t) path in + { close + ; path + } + +let line_to + : Point.t -> Point.t -> 'a repr -> 'a repr + = fun p0 p1 t -> + let path = + Repr.move_to (Point.get_coord p1) t.path + |> Repr.line_to (Point.get_coord' p1) + |> Repr.line_to (Point.get_coord' p0) + |> Repr.line_to (Point.get_coord p0) + |> Repr.line_to (Point.get_coord p1) + |> Repr.close in + t.close path; + { t with path} + +let quadratic_to + : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr + = fun p0 ctrl0 ctrl1 p1 t -> + + 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 + (Point.get_coord ctrl0') + (Point.get_coord ctrl1') + (Point.get_coord p1) + |> Repr.close in + t.close path; + { t with path} + + +let stop + : 'a repr -> 'a repr + = fun t -> + t + +let get + : 'a repr -> 'a Repr.t + = fun t -> + t.path diff --git a/path/linePrinter.ml b/path/linePrinter.ml new file mode 100755 index 0000000..247d554 --- /dev/null +++ b/path/linePrinter.ml @@ -0,0 +1,53 @@ +module Repr = Layer.CanvaPrinter + +type t = Point.t + +type 'a repr = + { path: ('a Repr.t) + } + +let create_path + : 'b -> 'a repr + = fun _ -> + { path = Repr.create () + } + +(* Start a new path. *) +let start + : Point.t -> 'a repr -> 'a repr + = fun t {path} -> + let path = Repr.move_to (Point.get_coord t) path in + let path = Repr.line_to (Point.get_coord' t) path in + { path + } + +let line_to + : Point.t -> Point.t -> 'a repr -> 'a repr + = fun _ t {path} -> + let path = Repr.move_to (Point.get_coord t) path in + let path = Repr.line_to (Point.get_coord' t) path in + { path + } + +let quadratic_to + : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr + = fun _p0 _ctrl0 _ctrl1 p1 {path} -> + + let path = Repr.move_to (Point.get_coord p1) path in + let path = Repr.line_to (Point.get_coord' p1) path in + + { path + } + +let stop + : 'a repr -> 'a repr + = fun {path} -> + + + { path + } + +let get + : 'a repr -> 'a Repr.t + = fun {path; _} -> + path diff --git a/path/wireFramePrinter.ml b/path/wireFramePrinter.ml index fc27c62..13d90ad 100755 --- a/path/wireFramePrinter.ml +++ b/path/wireFramePrinter.ml @@ -9,8 +9,8 @@ type 'a repr = } let create_path - : unit -> 'a repr - = fun () -> + : 'b -> 'a repr + = fun _ -> { back = Repr.close ; path = Repr.create () ; last_point = None diff --git a/path/wireFramePrinter.mli b/path/wireFramePrinter.mli index 72bb5b7..c6b7a98 100755 --- a/path/wireFramePrinter.mli +++ b/path/wireFramePrinter.mli @@ -3,7 +3,7 @@ type 'a repr type t = Point.t val create_path - : unit -> 'a repr + : 'b -> 'a repr (* Start a new path. *) val start diff --git a/script.html b/script.html deleted file mode 100755 index cd40d37..0000000 --- a/script.html +++ /dev/null @@ -1,48 +0,0 @@ -<!DOCTYPE html> -<html lang="en"> -<head> - <meta charset="utf-8"> - <meta name="viewport" content="width=device-width, - initial-scale=1.0"> - <style type="text/css"> - html, -body { - margin: 0; - padding: 0; -} - -body { - font: 14px 'Helvetica Neue', Helvetica, Arial, sans-serif; - line-height: 1.4em; - background: #f5f5f5; - color: #4d4d4d; - min-width: 230px; - max-width: 550px; - margin: 0 auto; - -webkit-font-smoothing: antialiased; - -moz-osx-font-smoothing: grayscale; - font-weight: 300; -} - - </style> - <title>Drawer</title> -</head> -<body> - <noscript>Sorry, you need to enable JavaScript to see this page.</noscript> - <script id="drawer_js" type="text/javascript" defer="defer" src="script.js"></script> - <script> - var script = document.getElementById('drawer_js'); - script.addEventListener('load', function() { - var app = document.getElementById('slate'); - drawer.run(app); - }); - </script> - - - <section class="todoapp" id="app"> - <canvas id="slate" class="drawing-zone" width="800" height="800"> - </canvas> - </section> - <footer class="info"> </footer> -</body> -</html> @@ -4,21 +4,29 @@ open Brr module Timer = Events.Timer +module Repr = Path.FillPrinter + module Path_Builder = Path.Builder.Make(Path.Point) -module Path_Printer = Path_Builder.Draw(Path.WireFramePrinter) -module Fixed_Printer = Path_Builder.DrawFixed(Path.WireFramePrinter) +module Path_Printer = Path_Builder.Draw(Repr) +module Fixed_Printer = Path_Builder.DrawFixed(Repr) type mode = | Edit + | Selection of Path_Builder.fixedPath | Out +let timer, tick = Timer.create () + type current = Path_Builder.t +(* + The state cannt hold functionnal values, and thus cannot be used to store + elements like timer + *) type state = { mode : mode ; paths : Path_Builder.fixedPath list ; current : current - ; timer : Timer.t } (** Events *) @@ -79,38 +87,97 @@ let insert_or_replace ((x, y) as p) path = let p1' = Path.Point.get_coord p1 in let dist = (norm (p1' - (of_tuple p))) in - if dist < 0.05 then ( - path + if dist < 5. then ( + path, None ) else ( Path_Builder.add_point point path ) +let check_selection position paths = + let point = Gg.V2.of_tuple position in + (* If the user click on a curve, select it *) + List.fold_left paths + ~init:None + ~f:(fun selection path -> + + match selection with + | Some p -> Some p + | None -> + (* TODO : Add a method in the point module *) + begin match Path_Builder.distance point path with + | Some p when p < 20. -> + Some path + | _ -> None + end + ) + let do_action : events -> state -> state = fun event state -> match event, state.mode with - | `Point (_delay, (x, y)), Edit -> + | `Point (_delay, point), Edit -> (* Add the point in the list *) - let current= Path_Builder.add_point - (Path.Point.create x y) + let current, fixed_path = insert_or_replace + point state.current in - { state with current } + let paths = match fixed_path with + | None -> state.paths + | Some p -> p::state.paths in + { state with current; paths } + (* Click anywhere while in Out mode, we switch in edition *) | `Click _, Out -> - Timer.start state.timer 0.3; + Timer.start timer 0.3; { state with mode = Edit } + + (* Click anywhere while in selection mode, we either select another path, + or switch to Out mode*) + | `Click position, (Selection _) -> + begin match check_selection position state.paths with + | None -> + { state with + mode = Out } + | Some selected -> + + (* Start the timer in order to handle the mouse moves *) + Timer.start timer 0.3; + { state with + mode = (Selection selected)} + end + | `Out point, Edit -> - Timer.stop state.timer; - let current = insert_or_replace point state.current in - (* - let beziers = Path.Draw.to_path @@ Path_Builder.get current in - let paths = beziers::state.paths - *) - let paths = Path_Builder.to_fixed current::state.paths - and current = Path_Builder.empty in - { state with mode = Out; paths; current } + Timer.stop timer; + begin match Path_Builder.peek2 state.current with + (** If there is at last two points selected, handle this as a curve + creation *) + | Some _ -> + let current, fixed_path = insert_or_replace point state.current in + let paths = match fixed_path with + | None -> Path_Builder.to_fixed current::state.paths + | Some p -> p::state.paths + and current = Path_Builder.empty in + { mode = Out + ; paths; current } + + (** Else, check if there is a curve undre the cursor, and remove it *) + | None -> + let current = Path_Builder.empty in + begin match check_selection point state.paths with + | None -> + { state with + mode = Out + ; current + } + | Some selected -> + { state with + mode = (Selection selected) + ; current } + end + end + + | _ -> state let backgroundColor = Jstr.v "#2e3440" @@ -144,34 +211,54 @@ let on_change canva mouse_position state = *) let pos = S.rough_value mouse_position in - let current = - match state.mode, pos with - | Edit, Some (x, y) -> - Path_Builder.add_point (Path'.Point.create x y) state.current - | _ -> - state.current + let current, paths = + begin match state.mode, pos with + | Edit, Some point -> + begin match insert_or_replace point state.current with + | current, None -> current, state.paths + | current, Some p -> current, p::state.paths + end + | _ -> + state.current, state.paths + end in - let path = Path'.WireFramePrinter.get @@ Path_Printer.draw current in + let path = Repr.get + @@ Path_Printer.draw + current + (Repr.create_path (fun p -> fill context p)) in stroke context path; - List.iter state.paths + List.iter paths ~f:(fun path -> - let path = Path'.WireFramePrinter.get @@ Fixed_Printer.draw path in - stroke context path + let path = Repr.get + @@ Fixed_Printer.draw + path + (Repr.create_path (fun p -> fill context p)) in + stroke context path; ); + + + (* If there is a selection draw it *) + let () = match state.mode with + | Selection path -> + set_fill_style context (color nord8); + set_stroke_style context (color nord8); + let path = Repr.get + @@ Fixed_Printer.draw + path + (Repr.create_path (fun p -> fill context p)) in + stroke context path; + | _ -> () in () let page_main id = - let timer, tick = Timer.create () in - let init = { paths = [] ; current = Path_Builder.empty ; mode = Out - ; timer } in (*begin match Document.find_el_by_id G.document id with*) |