aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xindex.html14
-rwxr-xr-xpath/builder.ml159
-rwxr-xr-xpath/builder.mli31
-rwxr-xr-xpath/fillPrinter.ml71
-rwxr-xr-xpath/linePrinter.ml53
-rwxr-xr-xpath/wireFramePrinter.ml4
-rwxr-xr-xpath/wireFramePrinter.mli2
-rwxr-xr-xscript.html48
-rwxr-xr-xscript.ml151
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>
diff --git a/script.ml b/script.ml
index 351433e..02492d6 100755
--- a/script.ml
+++ b/script.ml
@@ -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*)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 00:02:27 +0000