diff --git a/examples/quadtree.ml b/examples/quadtree.ml index 18dfa80..7fdaf8e 100644 --- a/examples/quadtree.ml +++ b/examples/quadtree.ml @@ -5,8 +5,7 @@ let size = 800. let half_size = size /. 2. let max_leaf_points = 4 let clusters = 32 -let point_size = 1 - +let point_size = 1 let box_color = (0, 0, 0) let point_color = (255, 1, 1) @@ -41,7 +40,6 @@ let cluster _ = (* Axis aligned bounding box *) type box = { min : point; max : point } - let box min max = { min; max } (* Returns the middle point of the box *) @@ -57,14 +55,13 @@ let quarters ({ min; max } as box) = (lu, ru, rd, ld) (* Checks whether point is within bounds of box *) -let contains { min; max } ({ x; y }: point) = +let contains { min; max } ({ x; y } : point) = x > min.x && x < max.x && y > min.y && y < max.y (* Quadtree and utils *) (* 2-tuple of bounding box * 'a list of elts whose positions are within that box *) type 'a leaf = box * 'a list - type 'a tree = Leaf of 'a leaf | Node of 'a tree list (* Constructs tree from root *) @@ -96,7 +93,7 @@ let build () = (* Converts our constructed tree into a flat list of shapes for rendering *) let to_flat_shapes tree = - let open Joy in + let open Joy in (* Converts box into rectangle *) let rect_of_bb bb = rectangle ~c:(midpoint bb) diff --git a/lib/joy.ml b/lib/joy.ml index d04c4e9..240607d 100644 --- a/lib/joy.ml +++ b/lib/joy.ml @@ -4,7 +4,6 @@ include Transform include Color let context = Context.context - let set_line_width = Context.set_line_width let init ?(background = Color.white) ?(line_width = 2) ?(size = (500, 500)) diff --git a/lib/joy.mli b/lib/joy.mli index 5c8caf4..ec8acdc 100644 --- a/lib/joy.mli +++ b/lib/joy.mli @@ -13,7 +13,7 @@ val polygon : float point list -> shape val complex : shapes -> shape val with_stroke : color -> shape -> shape val with_fill : color -> shape -> shape -val no_stroke : shape -> shape +val no_stroke : shape -> shape val no_fill : shape -> shape val rotate : int -> transformation val translate : int -> int -> transformation diff --git a/lib/render.ml b/lib/render.ml index 3e7eaeb..68bedc7 100644 --- a/lib/render.ml +++ b/lib/render.ml @@ -11,7 +11,7 @@ let draw_circle ctx ({ c; radius; stroke; fill } : circle) = set_color fill; Cairo.fill_preserve ctx.ctx in - Cairo.arc ctx.ctx c.x c.y ~r:radius ~a1:0. ~a2:(Float.pi *. 2.); + Cairo.arc ctx.ctx c.x (Float.neg c.y) ~r:radius ~a1:0. ~a2:(Float.pi *. 2.); Option.iter stroke_circle stroke; Option.iter fill_circle fill; Cairo.Path.clear ctx.ctx @@ -42,7 +42,9 @@ let draw_ellipse ctx { c; rx; ry; stroke; fill } = set_color fill; Cairo.fill_preserve ctx.ctx in - let start, curve_one, curve_two = create_control_points (c, rx, ry) in + let start, curve_one, curve_two = + create_control_points (c, rx, Float.neg ry) + in Cairo.move_to ctx.ctx start.x start.y; let x1, y1, x2, y2, x3, y3 = curve_one in Cairo.curve_to ctx.ctx x1 y1 x2 y2 x3 y3; @@ -55,9 +57,9 @@ let draw_ellipse ctx { c; rx; ry; stroke; fill } = let draw_line ctx { a; b; stroke } = set_color stroke; let { x; y } = a in - Cairo.move_to ctx.ctx x y; + Cairo.move_to ctx.ctx x (Float.neg y); let { x; y } = b in - Cairo.line_to ctx.ctx x y; + Cairo.line_to ctx.ctx x (Float.neg y); Cairo.stroke ctx.ctx let draw_polygon ctx { vertices; stroke; fill } = @@ -75,14 +77,13 @@ let draw_polygon ctx { vertices; stroke; fill } = let { x = x1; y = y1 }, { x = x2; y = y2 } = (List.nth pair 0, List.nth pair 1) in - Cairo.move_to ctx.ctx x1 y1; - Cairo.line_to ctx.ctx x2 y2) + Cairo.move_to ctx.ctx x1 (Float.neg y1); + Cairo.line_to ctx.ctx x2 (Float.neg y2)) points; Option.iter stroke_rect stroke; Option.iter fill_rect fill; Cairo.Path.clear ctx.ctx - (* Validates context before rendering *) let show shapes = let rec render ctx = function diff --git a/lib/shape.ml b/lib/shape.ml index 758b6d5..d46f947 100644 --- a/lib/shape.ml +++ b/lib/shape.ml @@ -50,10 +50,7 @@ let rectangle ?(c = center) width height = let y = c.y -. (h /. 2.) in polygon [ - { x; y }; - { x; y = y +. h }; - { x = x +. w; y = y +. h }; - { x = x +. w; y }; + { x; y }; { x; y = y +. h }; { x = x +. w; y = y +. h }; { x = x +. w; y }; ] let ellipse ?(c = center) rx ry = @@ -81,20 +78,20 @@ let rec with_fill fill = function print_endline "lines do not have a fill field!"; line' -let rec no_stroke = function - | Circle circle' -> Circle { circle' with stroke = None } - | Ellipse ellipse' -> Ellipse { ellipse' with stroke = None } - | Polygon polygon' -> Polygon { polygon' with stroke = None } - | Complex complex' -> Complex (List.map no_stroke complex') - | _ as line' -> +let rec no_stroke = function + | Circle circle' -> Circle { circle' with stroke = None } + | Ellipse ellipse' -> Ellipse { ellipse' with stroke = None } + | Polygon polygon' -> Polygon { polygon' with stroke = None } + | Complex complex' -> Complex (List.map no_stroke complex') + | _ as line' -> print_endline "Cannot remove stroke from lines"; line' -let rec no_fill = function - | Circle circle' -> Circle { circle' with fill = None } - | Ellipse ellipse' -> Ellipse { ellipse' with fill = None } - | Polygon polygon' -> Polygon { polygon' with fill = None } - | Complex complex' -> Complex (List.map no_fill complex') - | _ as line' -> - print_endline "Lines do not have a fill field!"; - line' +let rec no_fill = function + | Circle circle' -> Circle { circle' with fill = None } + | Ellipse ellipse' -> Ellipse { ellipse' with fill = None } + | Polygon polygon' -> Polygon { polygon' with fill = None } + | Complex complex' -> Complex (List.map no_fill complex') + | _ as line' -> + print_endline "Lines do not have a fill field!"; + line' diff --git a/lib/transform.ml b/lib/transform.ml index 7d27da0..fabca09 100644 --- a/lib/transform.ml +++ b/lib/transform.ml @@ -31,6 +31,7 @@ let rec translate dx dy = function | Complex shapes -> Complex (List.map (translate dx dy) shapes) let scale_length fact len = len *. fact + let rec scale factor = function | Circle circle' -> Circle @@ -52,7 +53,8 @@ let rec scale factor = function Polygon { polygon' with - vertices = List.map (Util.pmap (scale_length factor)) polygon'.vertices; + vertices = + List.map (Util.pmap (scale_length factor)) polygon'.vertices; } | Complex shapes -> Complex (List.map (scale factor) shapes) @@ -95,7 +97,6 @@ let repeat n op shape = in Complex (repeat' (n, [])) - (** Takes a function and a shape and returns a new shape with the function applied to the original's color *) let rec map_stroke f = function diff --git a/lib/util.ml b/lib/util.ml index 2aaed7f..ec23ded 100644 --- a/lib/util.ml +++ b/lib/util.ml @@ -1,5 +1,6 @@ (* point -> point arithmetic *) open Shape + let ( /~ ) p1 p2 = { x = p1.x /. p2.x; y = p1.x /. p2.x } (* point -> scalar arithmetic *) @@ -30,10 +31,7 @@ let rec partition n ?(step = 0) lst = | [] -> [] | lst' -> let taken, _ = take n lst in - if List.length taken = n then - taken - :: - partition n ~step (List.tl lst') + if List.length taken = n then taken :: partition n ~step (List.tl lst') else [] (* Misc *)