aboutsummaryrefslogtreecommitdiff
path: root/path/point.ml
diff options
context:
space:
mode:
Diffstat (limited to 'path/point.ml')
-rwxr-xr-xpath/point.ml86
1 files changed, 84 insertions, 2 deletions
diff --git a/path/point.ml b/path/point.ml
index 9e10200..7a32ae1 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -4,12 +4,21 @@ type t =
; angle: float
}
+let empty =
+ { p = Gg.V2.of_tuple (0., 0.)
+ ; size = 0.
+ ; angle = 0.
+ }
+
let create x y =
{ p = Gg.V2.v x y
- ; size = 0.1
- ; angle = Gg.Float.pi_div_4
+ ; size = 20.
+ ; angle = Float.neg Gg.Float.pi_div_4
}
+let copy point p =
+ { point with p }
+
let (+) p1 p2 =
{ p1 with p = Gg.V2.(+) p1.p p2 }
@@ -22,3 +31,76 @@ let get_coord'
let trans = of_polar @@ v t.size t.angle in
t.p + trans
+module Repr = CanvaPrinter
+
+type 'a repr =
+ { back: ('a Repr.t -> 'a Repr.t)
+ ; path: ('a Repr.t)
+ ; last_point : t option
+ }
+
+let create_path
+ : unit -> 'a repr
+ = fun () ->
+ { back = Repr.close
+ ; path = Repr.create ()
+ ; last_point = None
+ }
+
+(* Start a new path. *)
+let start
+ : t -> 'a repr -> 'a repr
+ = fun t {back; path; _} ->
+ let path = Repr.move_to (get_coord t) path in
+ let line' = Repr.line_to (get_coord' t) in
+ { back = (fun p -> back @@ line' p)
+ ; path
+ ; last_point = Some t
+ }
+
+let line_to
+ : t -> 'a repr -> 'a repr
+ = fun t {back; path; _} ->
+ let line' = Repr.line_to (get_coord' t) in
+ { back = (fun t -> back @@ line' t)
+ ; path = Repr.line_to t.p path
+ ; last_point = Some t
+ }
+
+let quadratic_to
+ : t -> t -> t -> t -> 'a repr -> 'a repr
+ = fun p0 ctrl0 ctrl1 p1 t ->
+
+ let line' path =
+ Repr.quadratic_to
+ (get_coord' ctrl1)
+ (get_coord' ctrl0)
+ (get_coord' p0) path in
+
+ let path = Repr.quadratic_to
+ (get_coord ctrl0)
+ (get_coord ctrl1)
+ (get_coord p1)
+ t.path in
+ { back = (fun p -> t.back @@ line' p)
+ ; path
+ ; last_point = Some p1
+ }
+
+let stop
+ : 'a repr -> 'a repr
+ = fun {back; path; last_point} ->
+
+ let path =
+ match last_point with
+ | Some point -> Repr.line_to (get_coord' point) path
+ | None -> path in
+
+ { back = (fun x -> x)
+ ; path = back path
+ ; last_point = None }
+
+let get
+ : 'a repr -> 'a Repr.t
+ = fun {back; path; _} ->
+ back path