diff --git a/lib/context.ml b/lib/context.ml index 33ede8f..f380448 100644 --- a/lib/context.ml +++ b/lib/context.ml @@ -1,3 +1,5 @@ +open Util + (* Global rendering context singleton definition and instantiation *) type context = { ctx : Cairo.context; @@ -22,9 +24,6 @@ let () = let fail () = raise (Context "not initialized") let resolution () = match !context with Some ctx -> ctx.size | None -> fail () -let tmap3 f (a, b, c) = (f a, f b, f c) -let tmap4 f (a, b, c, d) = (f a, f b, f c, f d) -let ( >> ) f g x = g (f x) let scale_channel n = n /. 255. let scale_color_channel = float_of_int >> scale_channel diff --git a/lib/render.ml b/lib/render.ml index 343cc53..9c67d1b 100644 --- a/lib/render.ml +++ b/lib/render.ml @@ -1,7 +1,6 @@ open Shape open Context - -let tmap f (x, y) = (f x, f y) +open Util let draw_circle ctx ({ c; radius; stroke; fill } : circle) = let stroke_circle stroke = @@ -59,25 +58,10 @@ let draw_line ctx { a; b; stroke } = Cairo.move_to ctx.ctx x y; let { x; y } = b in Cairo.line_to ctx.ctx x y; - Cairo.stroke ctx.ctx - -let rec take n lst = - match (n, lst) with - | 0, _ -> ([], lst) - | _, [] -> ([], []) - | n, x :: xs -> - let taken, rest = take (n - 1) xs in - (x :: taken, rest) - -let rec partition n ?(step = 0) lst = - match lst with - | [] -> [] - | _ -> - let taken, _ = take n lst in - if List.length taken = n then taken :: partition n ~step (List.tl lst) - else [] + Cairo.stroke ctx.ctx; + Cairo.Path.clear ctx.ctx -let draw_polygon ctx { vertices = points; stroke; fill } = +let draw_polygon ctx { vertices; stroke; fill } = let stroke_rect stroke = set_color stroke; Cairo.stroke_preserve ctx.ctx @@ -86,7 +70,7 @@ let draw_polygon ctx { vertices = points; stroke; fill } = set_color fill; Cairo.fill_preserve ctx.ctx in - let points = partition 2 ~step:1 (points @ [ List.hd points ]) in + let points = partition 2 ~step:1 (vertices @ [ List.hd vertices ]) in List.iter (fun pair -> let { x = x1; y = y1 }, { x = x2; y = y2 } = diff --git a/lib/shape.ml b/lib/shape.ml index 0727caf..758b6d5 100644 --- a/lib/shape.ml +++ b/lib/shape.ml @@ -32,15 +32,6 @@ type shape = type shapes = shape list -(* point -> point arithmetic *) -let ( /~ ) p1 p2 = { x = p1.x /. p2.x; y = p1.x /. p2.x } - -(* point -> scalar arithmetic *) -let ( -! ) { x; y } scalar = { x = x -. scalar; y = y -. scalar } -let ( /! ) { x; y } scalar = { x = x /. scalar; y = y /. scalar } -let ( *! ) { x; y } scalar = { x = x *. scalar; y = y *. scalar } -let pmap f { x; y } = { x = f x; y = f y } - let point x y = let x, y = (float_of_int x, float_of_int y) in { x; y } @@ -55,14 +46,14 @@ let polygon vertices = let rectangle ?(c = center) width height = let w, h = (float_of_int width, float_of_int height) in - let x1 = c.x -. (w /. 2.) in - let y1 = c.y -. (h /. 2.) in + let x = c.x -. (w /. 2.) in + let y = c.y -. (h /. 2.) in polygon [ - { x = x1; y = y1 }; - { x = x1; y = y1 +. h }; - { x = x1 +. w; y = y1 +. h }; - { x = x1 +. w; y = y1 }; + { x; y }; + { x; y = y +. h }; + { x = x +. w; y = y +. h }; + { x = x +. w; y }; ] let ellipse ?(c = center) rx ry = diff --git a/lib/shape.mli b/lib/shape.mli index e26994d..692a488 100644 --- a/lib/shape.mli +++ b/lib/shape.mli @@ -34,11 +34,6 @@ type shape = type shapes = shape list val point : int -> int -> float point -val ( /~ ) : float point -> float point -> float point -val ( -! ) : float point -> float -> float point -val ( /! ) : float point -> float -> float point -val ( *! ) : float point -> float -> float point -val pmap : ('a -> 'b) -> 'a point -> 'b point val circle : ?c:float point -> int -> shape val rectangle : ?c:float point -> int -> int -> shape val ellipse : ?c:float point -> int -> int -> shape diff --git a/lib/transform.ml b/lib/transform.ml index 536f936..fce5f56 100644 --- a/lib/transform.ml +++ b/lib/transform.ml @@ -31,21 +31,19 @@ let rec translate dx dy = function | Complex shapes -> Complex (List.map (translate dx dy) shapes) let scale_length fact len = len *. fact -let pmap f { x; y } = { x = f x; y = f y } - let rec scale factor = function | Circle circle' -> Circle { circle' with - c = pmap (scale_length factor) circle'.c; + c = Util.pmap (scale_length factor) circle'.c; radius = scale_length factor circle'.radius; } | Ellipse ellipse' -> Ellipse { ellipse' with - c = pmap (scale_length factor) ellipse'.c; + c = Util.pmap (scale_length factor) ellipse'.c; rx = scale_length factor ellipse'.rx; ry = scale_length factor ellipse'.ry; } @@ -54,7 +52,7 @@ let rec scale factor = function Polygon { polygon' with - vertices = List.map (pmap (scale_length factor)) polygon'.vertices; + vertices = List.map (Util.pmap (scale_length factor)) polygon'.vertices; } | Complex shapes -> Complex (List.map (scale factor) shapes) @@ -87,13 +85,12 @@ let rec rotate degrees = function | Complex shapes -> Complex (List.map (rotate degrees) shapes) let compose f g x = g (f x) -let range n = List.init n Fun.id let repeat n op shape = let match_list l = match l with [] -> [ op shape ] | last :: _ -> op last :: l in - let shapes = List.fold_right (fun _ acc -> match_list acc) (range n) [] in + let shapes = List.fold_right (fun _ acc -> match_list acc) (Util.range n) [] in complex shapes (** Takes a function and a shape and returns a new shape with the diff --git a/lib/util.ml b/lib/util.ml new file mode 100644 index 0000000..2aaed7f --- /dev/null +++ b/lib/util.ml @@ -0,0 +1,40 @@ +(* point -> point arithmetic *) +open Shape +let ( /~ ) p1 p2 = { x = p1.x /. p2.x; y = p1.x /. p2.x } + +(* point -> scalar arithmetic *) +let ( -! ) { x; y } scalar = { x = x -. scalar; y = y -. scalar } +let ( /! ) { x; y } scalar = { x = x /. scalar; y = y /. scalar } +let ( *! ) { x; y } scalar = { x = x *. scalar; y = y *. scalar } +let pmap f { x; y } = { x = f x; y = f y } + +(* Tuple/Vector ops *) +let tmap f (x, y) = (f x, f y) +let tmap3 f (a, b, c) = (f a, f b, f c) +let tmap4 f (a, b, c, d) = (f a, f b, f c, f d) + +(** Function composition *) +let ( >> ) f g x = g (f x) + +(* Partitions point in a polygon into faces *) +let rec take n lst = + match (n, lst) with + | 0, _ -> ([], lst) + | _, [] -> ([], []) + | n, x :: xs -> + let taken, rest = take (n - 1) xs in + (x :: taken, rest) + +let rec partition n ?(step = 0) lst = + match lst with + | [] -> [] + | lst' -> + let taken, _ = take n lst in + if List.length taken = n then + taken + :: + partition n ~step (List.tl lst') + else [] + +(* Misc *) +let range n = List.init n Fun.id diff --git a/lib/util.mli b/lib/util.mli new file mode 100644 index 0000000..74cadbd --- /dev/null +++ b/lib/util.mli @@ -0,0 +1,12 @@ +val ( /~ ) : float Shape.point -> float Shape.point -> float Shape.point +val ( -! ) : float Shape.point -> float -> float Shape.point +val ( /! ) : float Shape.point -> float -> float Shape.point +val ( *! ) : float Shape.point -> float -> float Shape.point +val pmap : ('a -> 'b) -> 'a Shape.point -> 'b Shape.point +val tmap : ('a -> 'b) -> 'a * 'a -> 'b * 'b +val tmap3 : ('a -> 'b) -> 'a * 'a * 'a -> 'b * 'b * 'b +val tmap4 : ('a -> 'b) -> 'a * 'a * 'a * 'a -> 'b * 'b * 'b * 'b +val ( >> ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c +val take : int -> 'a list -> 'a list * 'a list +val partition : int -> ?step:int -> 'a list -> 'a list list +val range : int -> int list