diff options
Diffstat (limited to 'script.ml')
| -rwxr-xr-x | script.ml | 118 |
1 files changed, 18 insertions, 100 deletions
@@ -4,11 +4,9 @@ open Brr module Timer = Events.Timer -module Point = Draw.Point -module Path = Draw - -module Path_Builder = Path.Builder.Make(Point) -module Path_Printer = Path_Builder.Draw(Path.WireFrame) +module Path_Builder = Path.Builder.Make(Path.Point) +module Path_Printer = Path_Builder.Draw(Path.WireFramePrinter) +module Fixed_Printer = Path_Builder.DrawFixed(Path.WireFramePrinter) type mode = | Edit @@ -18,7 +16,7 @@ type current = Path_Builder.t type state = { mode : mode - ; paths : Draw.t list (* All the previous paths *) + ; paths : Path_Builder.fixedPath list ; current : current ; timer : Timer.t } @@ -33,7 +31,7 @@ type events = [ canva_events | `Point of float * (float * float) ] -type canva_signal = Point.t +type canva_signal = Path.Point.t module Mouse = Brr_note_kit.Mouse @@ -69,7 +67,7 @@ let canva E.select [click; up], pos, c let insert_or_replace ((x, y) as p) path = - let point = Point.create x y in + let point = Path.Point.create x y in match Path_Builder.peek path with | None -> Path_Builder.add_point @@ -78,7 +76,7 @@ let insert_or_replace ((x, y) as p) path = | Some p1 -> let open Gg.V2 in - let p1' = Point.get_coord p1 in + let p1' = Path.Point.get_coord p1 in let dist = (norm (p1' - (of_tuple p))) in if dist < 0.05 then ( @@ -96,7 +94,7 @@ let do_action | `Point (_delay, (x, y)), Edit -> (* Add the point in the list *) let current= Path_Builder.add_point - (Point.create x y) + (Path.Point.create x y) state.current in { state with current } @@ -106,8 +104,11 @@ let do_action | `Out point, Edit -> Timer.stop state.timer; let current = insert_or_replace point state.current in - let beziers = Draw.to_path @@ Path_Builder.get 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 } | _ -> state @@ -117,61 +118,12 @@ let white = Jstr.v "#eceff4" let green = Jstr.v "#a3be8c" let nord8 = Jstr.v "#81a1c1" -let draw - : ?connexion:Gg.v2 -> area:Gg.v2 -> Point.t list -> Brr_canvas.C2d.Path.t - = fun ?connexion ~area points -> - - let open Brr_canvas.C2d in - let path = Path.create () in - - - let () = match points with - | [] -> () - | hd::_ -> - let vect = Draw.Line (hd, Point.create 0. 0.) in - Draw.move_to ~area path vect in - - let _ = match points with - | [] - | _::[] -> () - | _::p1::[] -> - Draw.line area ~p1 path - | p0::p1::p2::[] -> - Draw.three_points area ~p0 ~p1 ~p2 path - | _ -> - Draw.multi_points ?connexion area points path - in path - -let draw_path area points beziers = - let open Brr_canvas.C2d in - let connexion = match beziers with - | [] -> None - | hd ::_ -> Some hd.Shapes.Bezier.p1 in - (* Firt draw all the points most recent points *) - let path = draw ?connexion ~area points in - - (* Then add the fixed ones *) - let path = List.fold_left beziers - ~init:path - ~f:(fun path bezier -> - - 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 - ~cx' ~cy' - ~x ~y; - path - ) in - path - let on_change canva mouse_position state = + let module Path' = Path in let open Brr_canvas.C2d in let w, h = Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva) in - let area = Gg.V2.v w h in + let _area = Gg.V2.v w h in let context = create canva in @@ -195,52 +147,18 @@ let on_change canva mouse_position state = let current = match state.mode, pos with | Edit, Some (x, y) -> - Path_Builder.add_point (Point.create x y) state.current + Path_Builder.add_point (Path'.Point.create x y) state.current | _ -> state.current in - let path = Draw.WireFrame.get @@ Path_Printer.draw current in - stroke context path; - -(* - let points, beziers = Path_Builder.get current in - - let path = draw_path area (points) beziers in + let path = Path'.WireFramePrinter.get @@ Path_Printer.draw current in stroke context path; -*) List.iter state.paths ~f:(fun path -> - - (* This is ugly, and probably non efficient, but is an appropriate solution for - the cases of overlapping path *) - match path.Draw.path with - | 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 + let path = Path'.WireFramePrinter.get @@ Fixed_Printer.draw path in + stroke context path ); () |