summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-01-01 23:18:35 +0100
committerSébastien Dailly <sebastien@chimrod.com>2021-01-01 23:18:35 +0100
commit7bb561f31e0ee57a388032b760b7db943dd6b36c (patch)
tree4e95d17cd8b62e286b026181c2590fe6ccdec401
parent74cd42c5cae6644914334448e198d562f4145511 (diff)
Update
-rwxr-xr-xpath/path.ml (renamed from paths.ml)38
-rwxr-xr-xscript.ml43
-rwxr-xr-xstate.ml42
3 files changed, 68 insertions, 55 deletions
diff --git a/paths.ml b/path/path.ml
index 9d968f0..9b6b9c4 100755
--- a/paths.ml
+++ b/path/path.ml
@@ -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 ]
[]
-
-
diff --git a/script.ml b/script.ml
index d501b10..398e4f2 100755
--- a/script.ml
+++ b/script.ml
@@ -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
);
()
diff --git a/state.ml b/state.ml
index 57007b3..52fe5a6 100755
--- a/state.ml
+++ b/state.ml
@@ -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.