diff options
| -rwxr-xr-x | path/path.ml (renamed from paths.ml) | 38 | ||||
| -rwxr-xr-x | script.ml | 43 | ||||
| -rwxr-xr-x | state.ml | 42 |
3 files changed, 68 insertions, 55 deletions
@@ -1,35 +1,35 @@ (** Common module for ensuring that the function is evaluated only once *) -module Path_Builder = Path.Builder.Make(Path.Point) -module Fixed = Path.Fixed.Make(Path.Point) +module Point = Point -(* Canva representation *) +module type REPRESENTABLE = sig + type t -module FillCanvaRepr = Path.FillPrinter.Make(Layer.CanvaPrinter) -module LineCanvaRepr = Path.LinePrinter.Make(Layer.CanvaPrinter) -module WireCanvaRepr = Path.WireFramePrinter.Make(Layer.CanvaPrinter) + (** Represent the path *) + val repr + : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's +end +module Path_Builder = Builder.Make(Point) +module Fixed = Fixed.Make(Point) -(* SVG representation *) +(* Canva representation *) -module FillSVGRepr = Path.FillPrinter.Make(Layer.Svg) -module LineSVGRepr = Path.LinePrinter.Make(Layer.Svg) -module WireSVGRepr = Path.WireFramePrinter.Make(Layer.Svg) +module FillCanvaRepr = FillPrinter.Make(Layer.CanvaPrinter) +module LineCanvaRepr = LinePrinter.Make(Layer.CanvaPrinter) +module WireCanvaRepr = WireFramePrinter.Make(Layer.CanvaPrinter) +(* SVG representation *) -module type REPRESENTABLE = sig - type t +module FillSVGRepr = FillPrinter.Make(Layer.Svg) +module LineSVGRepr = LinePrinter.Make(Layer.Svg) +module WireSVGRepr = WireFramePrinter.Make(Layer.Svg) - (** Represent the path *) - val repr - : t -> (module Path.Repr.M with type t = Path.Point.t and type repr = 's) -> 's -> 's -end type printer = [ `Fill | `Line - | `Wire - ] + | `Wire ] (** Draw a path to a canva *) let to_canva @@ -110,5 +110,3 @@ let to_svg ; v (Jstr.v "stroke") color ; v (Jstr.v "d") svg_path ] [] - - @@ -142,6 +142,18 @@ let set_sidebar ) ); + + let br = El.br () in + let render = + El.select + [ El.option ~at:At.[value (Jstr.v "Fill")] + [ txt' "Fill"] + ; El.option ~at:At.[value (Jstr.v "Wireframe")] + [ txt' "Wireframe"] + ; El.option ~at:At.[value (Jstr.v "Ductus")] + [ txt' "Ductus"] + ] in + let () = El.append_children element [ hr () @@ -155,6 +167,9 @@ let set_sidebar ; angle ; input_angle + ; br + ; render + ] in delete_event, angle_event, nib_size_event, export_event @@ -165,20 +180,20 @@ let green = Jstr.v "#a3be8c" (** Redraw the canva on update *) let on_change canva mouse_position state = - let open Brr_canvas.C2d in + let module Cd2d = Brr_canvas.C2d in let w, h = Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva) in - let context = create canva in + let context = Cd2d.create canva in - set_fill_style context (color backgroundColor); - fill_rect context + Cd2d.set_fill_style context (Cd2d.color backgroundColor); + Cd2d.fill_rect context ~x:0.0 ~y:0.0 ~w ~h; - set_stroke_style context (color white); - set_fill_style context (color white); + Cd2d.set_stroke_style context (Cd2d.color white); + Cd2d.set_fill_style context (Cd2d.color white); (* If we are in edit mode, we add a point under the cursor. @@ -197,28 +212,28 @@ let on_change canva mouse_position state = end in - let repr = `Wire in + let repr = `Fill in - Paths.to_canva (module Paths.Path_Builder) current context repr; + Path.to_canva (module Path.Path_Builder) current context repr; List.iter state.paths ~f:(fun path -> let () = match state.mode with | Selection id -> - begin match id = (Paths.Fixed.id path) with + begin match id = (Path.Fixed.id path) with | true -> (* If the element is the selected one, change the color *) - set_fill_style context (color Blog.Nord.nord8); - set_stroke_style context (color Blog.Nord.nord8) + Cd2d.set_fill_style context (Cd2d.color Blog.Nord.nord8); + Cd2d.set_stroke_style context (Cd2d.color Blog.Nord.nord8) | false -> - set_stroke_style context (color white); - set_fill_style context (color white); + Cd2d.set_stroke_style context (Cd2d.color white); + Cd2d.set_fill_style context (Cd2d.color white); end | _ -> () in - Paths.to_canva (module Paths.Fixed) path context repr + Path.to_canva (module Path.Fixed) path context repr ); () @@ -12,7 +12,7 @@ type mode = | Selection of int | Out -type current = Paths.Path_Builder.t +type current = Path.Path_Builder.t (** Events *) @@ -40,7 +40,7 @@ type events = *) type state = { mode : mode - ; paths : Paths.Fixed.t list + ; paths : Path.Fixed.t list ; current : current ; width : float ; angle : float @@ -50,9 +50,9 @@ let insert_or_replace state ((x, y) as p) path = let width = state.width and angle = state.angle in let point = Path.Point.create ~x ~y ~angle ~width in - match Paths.Path_Builder.peek path with + match Path.Path_Builder.peek path with | None -> - Paths.Path_Builder.add_point + Path.Path_Builder.add_point point path | Some p1 -> @@ -64,7 +64,7 @@ let insert_or_replace state ((x, y) as p) path = if dist < 5. then ( path ) else ( - Paths.Path_Builder.add_point + Path.Path_Builder.add_point point path ) @@ -72,14 +72,14 @@ let insert_or_replace state ((x, y) as p) path = let threshold = 20. let check_selection - : (float * float) -> Paths.Fixed.t list -> (Gg.v2 * Paths.Fixed.t) option + : (float * float) -> Path.Fixed.t list -> (Gg.v2 * Path.Fixed.t) option = fun position paths -> let point = Gg.V2.of_tuple position in (* If the user click on a curve, select it *) let _, res = List.fold_left paths ~init:(threshold, None) ~f:(fun (dist, selection) path -> - match Paths.Fixed.distance point path with + match Path.Fixed.distance point path with | Some (point', p) when p < dist -> dist, Some (point', path) | _ -> dist, selection @@ -92,10 +92,10 @@ let update_selection id state f = let paths = List.map state.paths ~f:(fun path -> - let id' = Paths.Fixed.id path in + let id' = Path.Fixed.id path in match id = id' with | false -> path - | true -> Paths.Fixed.map_point path f + | true -> Path.Fixed.map_point path f ) in { state with paths} @@ -130,7 +130,7 @@ let do_action Path.Point.create ~x ~y ~angle ~width in - let current = Paths.Path_Builder.add_point + let current = Path.Path_Builder.add_point point state.current in { state with current; mode = Edit } @@ -146,7 +146,7 @@ let do_action (* Start the timer in order to handle the mouse moves *) - let id = Paths.Fixed.id selected in + let id = Path.Fixed.id selected in Elements.Timer.start timer 0.3; { state with mode = (Selection id)} @@ -154,7 +154,7 @@ let do_action | `Out point, Edit -> Elements.Timer.stop timer; - begin match Paths.Path_Builder.peek2 state.current with + begin match Path.Path_Builder.peek2 state.current with (* If there is at last two points selected, handle this as a curve creation. And we add the new point in the current path *) | Some _ -> @@ -167,19 +167,19 @@ let do_action let current = insert_or_replace state point state.current in let paths = - let last = Paths.Fixed.to_fixed - (module Paths.Path_Builder) + let last = Path.Fixed.to_fixed + (module Path.Path_Builder) current in last::state.paths - and current = Paths.Path_Builder.empty in + and current = Path.Path_Builder.empty in { state with mode = Out ; paths; current } (* Else, check if there is a curve undre the cursor, and remove it *) | None -> - let current = Paths.Path_Builder.empty in + let current = Path.Path_Builder.empty in begin match check_selection point state.paths with | None -> { state with @@ -187,14 +187,14 @@ let do_action ; current } | Some (_, selected) -> - let id = Paths.Fixed.id selected in + let id = Path.Fixed.id selected in { state with mode = (Selection id) ; current } end end | `Delete, Selection id -> - let paths = List.filter state.paths ~f:(fun p -> Paths.Fixed.id p != id) in + let paths = List.filter state.paths ~f:(fun p -> Path.Fixed.id p != id) in { state with paths ; mode = Out} @@ -211,9 +211,9 @@ let do_action (List.map state.paths ~f:(fun path -> - Paths.to_svg + Path.to_svg ~color:backgroundColor - (module Paths.Fixed) + (module Path.Fixed) path `Fill @@ -262,7 +262,7 @@ let do_action let init = { paths = [] - ; current = Paths.Path_Builder.empty + ; current = Path.Path_Builder.empty ; mode = Out ; angle = 30. ; width = 10. |