diff options
| -rwxr-xr-x | layer/ductusPrinter.ml | 11 | ||||
| -rwxr-xr-x | path/fixed.ml | 57 | ||||
| -rwxr-xr-x | path/fixed.mli | 3 | ||||
| -rwxr-xr-x | path/point.ml | 18 | ||||
| -rwxr-xr-x | path/point.mli | 11 | ||||
| -rwxr-xr-x | script.it/script.ml | 6 | ||||
| -rwxr-xr-x | script.it/state.ml | 153 | ||||
| -rwxr-xr-x | script.it/worker.ml | 5 |
8 files changed, 181 insertions, 83 deletions
diff --git a/layer/ductusPrinter.ml b/layer/ductusPrinter.ml index 3ed1c3c..2ee96e4 100755 --- a/layer/ductusPrinter.ml +++ b/layer/ductusPrinter.ml @@ -46,11 +46,14 @@ module Make(Repr: Repr.PRINTER) = struct recent point *) let delay = ((Path.Point.get_stamp p0) -. (Path.Point.get_stamp p1)) - *. 100. /. 3. + *. 20. in - for i = 0 to (Int.of_float delay) do - let bezier', _ = Shapes.Bezier.slice (0.1 *. (Float.of_int i)) bezier in - let point = Path.Point.copy p1 bezier'.Shapes.Bezier.p1 in + for i = 0 to ((Int.of_float delay) -1) do + let ratio = (Float.of_int i) /. delay in + let bezier', _ = Shapes.Bezier.slice ratio bezier in + + let point = Path.Point.mix ratio bezier'.Shapes.Bezier.p1 p0 p1 in + path := Repr.move_to (Path.Point.get_coord point) !path; path := Repr.line_to (Path.Point.get_coord' point) !path; done; diff --git a/path/fixed.ml b/path/fixed.ml index cb2c27f..2d42566 100755 --- a/path/fixed.ml +++ b/path/fixed.ml @@ -6,6 +6,8 @@ module type P = sig val get_coord : t -> Gg.v2 + val id : t -> int + end module Make(Point:P) = struct @@ -24,7 +26,6 @@ module Make(Point:P) = struct ; ctrl1:Gg.v2 } (* The control point *) type path = - | Empty | Line of Point.t * Point.t | Curve of bezier @@ -74,7 +75,8 @@ module Make(Point:P) = struct let get : int * path list -> path array = fun (n, t) -> - let res = Array.make n Empty in + + let res = Obj.magic (Array.make n 0) in List.iteri t ~f:(fun i elem -> Array.set res (n - i - 1) elem ); res @@ -106,7 +108,6 @@ module Make(Point:P) = struct ~init:(true, repr) ~f:(fun (first, path) element -> match element with - | Empty -> (true, path) | Line (p0, p1) -> let path = if first then @@ -133,7 +134,6 @@ module Make(Point:P) = struct Array.fold_left beziers.path ~init:None ~f:(fun res -> function - | 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 @@ -164,7 +164,6 @@ module Make(Point:P) = struct = fun {id; path} f -> let path = Array.map path ~f:(function - | Empty -> Empty | Line (p1, p2) -> Line (f p1, f p2) | Curve bezier -> Curve {bezier with p0 = f bezier.p0 ; p1 = f bezier.p1} ) in @@ -175,7 +174,6 @@ module Make(Point:P) = struct = fun {path; _} ~f -> Array.iter path ~f:(function - | Empty -> () | Line (p1, p2) -> f p1; f p2 | Curve bezier -> f bezier.p0 ; f bezier.p1 ) @@ -193,14 +191,13 @@ module Make(Point:P) = struct ~f:(fun element -> let res = match element with - | Empty -> false | Line (p0, p1) | Curve {p0;p1;_} -> - if p0 = point then ( + if (Point.id p0) = (Point.id point) then ( idx := Some (!counter) ; true - ) else if p1 = point then ( - idx := Some (!counter +1) ; + ) else if (Point.id p1) = (Point.id point) then ( + idx := Some (!counter+1) ; true ) else false @@ -213,25 +210,47 @@ module Make(Point:P) = struct | Some 0 -> (* Remove the first point *) let path' = Array.init - ((Array.length path) -1) - ~f:( fun i -> Array.get path (i + 1)) in - {id; path=path'} + ((Array.length path)-1) + ~f:( fun i -> Array.get path (i+1)) in + { id + ; path = path' + } | Some n when n = (Array.length path) -> (* Remove the last point *) let path' = Array.init - ((Array.length path) -1) + ((Array.length path)-1) ~f:( fun i -> Array.get path i) in - {id; path=path'} + { id + ; path=path' + } | Some n -> let path' = Array.init - ((Array.length path) -1) + ((Array.length path)-1) ~f:(fun i -> - if i < (n -1) then + if i < (n-1) then Array.get path (i) + else if i = (n-1) then + (* We know that the point is not the first nor the last one. + So it is safe to call n-1 or n + 1 point + + We have to rebuild the point and set that + point_(-1).id = point_(+1).id + *) + let previous_p1 = + match Array.get path (i-1) with + | Line (_, p1) -> p1 + | Curve c -> c.p1 + in + + match Array.get path (i+1) with + | Line (_, p1) -> Line (previous_p1, p1) + | Curve c -> Curve {c with p0 = previous_p1} + else - Array.get path (i +1) + Array.get path (i+1) ) in - {id; path=path'} + { id + ; path=path'} let update : t -> path array -> t diff --git a/path/fixed.mli b/path/fixed.mli index f91ffc6..1f12006 100755 --- a/path/fixed.mli +++ b/path/fixed.mli @@ -4,6 +4,8 @@ module type P = sig val get_coord : t -> Gg.v2 + val id : t -> int + end module Make(Point:P) : sig @@ -51,7 +53,6 @@ module Make(Point:P) : sig ; ctrl1:Gg.v2 } (* The control point *) type path = - | Empty | Line of Point.t * Point.t | Curve of bezier diff --git a/path/point.ml b/path/point.ml index d49d655..4c34899 100755 --- a/path/point.ml +++ b/path/point.ml @@ -1,8 +1,11 @@ +let internal_id = ref 0 + type t = { p: Gg.v2 ; size : float ; angle: float ; stamp : float + ; id : int } let empty = @@ -10,17 +13,23 @@ let empty = ; size = 0. ; angle = 0. ; stamp = 0. + ; id = 0 } let create ~angle ~width ~stamp ~x ~y = + + incr internal_id; { p = Gg.V2.v x y ; size = width ; angle = Gg.Float.rad_of_deg (180. -. angle ) ; stamp + ; id = !internal_id } let copy point p = - { point with p } + { point with + p + } let set_angle p angle = { p with angle = Gg.Float.rad_of_deg (180. -. angle) } @@ -49,6 +58,7 @@ 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 @@ -61,4 +71,8 @@ let mix { p = point ; size = width ; angle - ; stamp } + ; stamp + ; id = !internal_id + } + +let id { id; _} = id diff --git a/path/point.mli b/path/point.mli index fab42d2..fe4cb45 100755 --- a/path/point.mli +++ b/path/point.mli @@ -1,5 +1,9 @@ type t +(** Return the point id. Each id is unique *) +val id + : t -> int + val empty : t val (+): t -> Gg.v2 -> t @@ -10,6 +14,12 @@ val get_stamp : t -> float val create: angle:float -> width:float -> stamp:float -> x:float -> y:float -> t +(** Return a copy of the point at given posistion + + This is a true copy, the id will be the same for the two points + TODO : Should this be renamed set_position ? + +*) val copy : t -> Gg.v2 -> t val set_angle : t -> float -> t @@ -27,3 +37,4 @@ val get_coord' characteristics from p0 and p1 *) val mix : float -> Gg.v2 -> t -> t -> t + diff --git a/script.it/script.ml b/script.it/script.ml index e91dc92..fc64d1e 100755 --- a/script.it/script.ml +++ b/script.it/script.ml @@ -281,7 +281,11 @@ 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/state.ml b/script.it/state.ml index b91c614..585ca32 100755 --- a/script.it/state.ml +++ b/script.it/state.ml @@ -78,14 +78,30 @@ let threshold = 20. (** Update the path in the selection with the given function applied to every point *) -let update_selection id state f = +let update_path_selection id paths f = + List.map paths + ~f:(fun path -> + let id' = Path.Fixed.id path in + match id = id' with + | false -> path + | true -> Path.Fixed.map_point path f + ) + +let update_point_selection state path_id point f = let paths = List.map state.paths - ~f:(fun path -> - let id' = Path.Fixed.id path in - match id = id' with - | false -> path - | true -> Path.Fixed.map_point path f + ~f:(fun p -> + match Path.Fixed.id p = path_id with + | false -> p + | true -> + Path.Fixed.map_point + p + (fun p -> + if (Path.Point.id p = Path.Point.id point) then + f p + else + p + ) ) in { state with paths } @@ -104,18 +120,84 @@ let select_segment _ (_, selected, p0, p1) state dist = ; angle ; width } +(** Handle the deletion event. + + Deletion only apply to a selection +*) +let delete state worker = + match state.mode with + | Selection (Path id) -> + let paths = List.filter + state.paths + ~f:(fun p -> + Path.Fixed.id p != id + ) in + { state with paths ; mode = Out} + + | Selection (Point (id, point)) -> + List.iter + state.paths + ~f:(fun p -> + let id' = Path.Fixed.id p in + match id' = id with + | false -> () + | true -> + (* Send the job to the worker *) + Brr_webworkers.Worker.post worker (`DeletePoint (id, point, p)) + ); + { state with mode = Selection (Path id) } + | _ -> + state + +(** Tick event + + Tick only occurs when drawing a new path + +*) +let tick (delay, point) state = + match state.mode with + | Edit -> + (* Add the point in the list *) + let current = insert_or_replace + state + point + delay + state.current in + { state with current } + | _ -> state + +let angle angle state = + match state.mode with + (* Change angle for the whole path *) + | Selection (Path s) -> + let state = { state with angle } in + let paths = update_path_selection s state.paths (fun p -> Path.Point.set_angle p angle) in + {state with paths } + (* Change angle localy *) + | Selection (Point (s, point)) -> + update_point_selection state s point + (fun p -> Path.Point.set_angle p angle) + | _ -> + { state with angle} + +let width width state = + match state.mode with + | Selection (Path s) -> + let state = { state with width } in + 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) + | _ -> + { state with width } + let do_action : Brr_webworkers.Worker.t -> Elements.Timer.t -> events -> state -> state = fun worker timer event state -> match event, state.mode with - | `Point (delay, point), Edit -> - (* Add the point in the list *) - let current = insert_or_replace - state - point - delay - state.current in - { state with current } + | `Point (delay, point), _ -> + tick (delay, point) state (* Click anywhere while in Out mode, we switch in edition *) | `Click ((x, y) as p), Out -> @@ -203,26 +285,8 @@ let do_action end end - | `Delete, Selection (Path id) -> - let paths = List.filter - state.paths - ~f:(fun p -> - Path.Fixed.id p != id - ) in - { state with paths ; mode = Out} - - | `Delete, Selection (Point (id, point)) -> - List.iter - state.paths - ~f:(fun p -> - let id' = Path.Fixed.id p in - match id' = id with - | false -> () - | true -> - (* Send the job to the worker *) - Brr_webworkers.Worker.post worker (`DeletePoint (id, point, p)) - ); - { state with mode = Selection (Path id) } + | `Delete, _ -> + delete state worker | `Export, _ -> let my_host = Uri.host @@ Window.location @@ G.window in @@ -259,21 +323,11 @@ let do_action ); state - (* Change the select curve with the appropriate setting *) - | `Angle angle, Selection (Path s) -> - let state = { state with angle } in - update_selection s state (fun p -> Path.Point.set_angle p angle) - | `Width width, Selection (Path s) -> - let state = { state with width } in - update_selection s state (fun p -> Path.Point.set_width p width) - - | `Angle angle, _ -> - { state with angle} - | `Width width, _ -> - { state with width} + | `Angle value , _ -> + angle value state + | `Width value, _ -> + width value state - | `Delete, Out - -> state | `Rendering rendering, _ -> { state with rendering} @@ -297,11 +351,8 @@ let do_action (* Some non possible cases *) | `Out _, Out - | `Point _, Out - | `Point _, Selection _ | `Out _, Selection _ | `Click _, Edit - | `Delete, Edit -> state let init = diff --git a/script.it/worker.ml b/script.it/worker.ml index e68705a..6f425cd 100755 --- a/script.it/worker.ml +++ b/script.it/worker.ml @@ -6,26 +6,21 @@ type message = [ | `DeletePoint of (int * Path.Point.t * Path.Fixed.t) ] -exception Empty_Element - let get_point : Path.Fixed.path -> Gg.v2 = function - | Empty -> raise Empty_Element | Line (_, p1) -> Path.Point.get_coord p1 | Curve bezier -> Path.Point.get_coord bezier.Path.Fixed.p1 let first_point : Path.Fixed.path -> Gg.v2 = function - | Empty -> raise Empty_Element | Line (p0, _) -> Path.Point.get_coord p0 | Curve bezier -> Path.Point.get_coord bezier.Path.Fixed.p0 let assoc_point : Shapes.Bezier.t -> Path.Fixed.path -> Path.Fixed.path = fun bezier -> function - | Empty -> raise Empty_Element | Line (p0, p1) | Curve {p0; p1; _} -> let p0' = Path.Point.copy p0 bezier.Shapes.Bezier.p0 |