Merge pull request #99 from FayCarsons/utils

Created utility module

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
 

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 } =

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 =

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

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 

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

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