Skip to content

Commit

Permalink
fmt
Browse files Browse the repository at this point in the history
  • Loading branch information
FayCarsons committed Mar 1, 2024
1 parent d48966f commit 45cdfa6
Show file tree
Hide file tree
Showing 7 changed files with 28 additions and 35 deletions.
11 changes: 4 additions & 7 deletions examples/quadtree.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -30,7 +29,7 @@ let rand_point () : point =
{ x = Random.float size -. half_size; y = Random.float size -. half_size }

(* Creates a point within 50 units of a center *)
let centered_point (center : point) _: point =
let centered_point (center : point) _ : point =
let offset () = Random.float 100. -. 50. in
center +~ { x = offset (); y = offset () }

Expand All @@ -44,7 +43,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 *)
Expand All @@ -60,14 +58,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 *)
Expand Down Expand Up @@ -99,7 +96,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)
Expand Down
1 change: 0 additions & 1 deletion lib/joy.ml
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,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))
Expand Down
2 changes: 1 addition & 1 deletion lib/joy.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
5 changes: 3 additions & 2 deletions lib/render.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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, Float.neg 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;
Expand Down Expand Up @@ -82,7 +84,6 @@ let draw_polygon ctx { vertices; stroke; fill } =
Option.iter fill_rect fill;
Cairo.Path.clear ctx.ctx


(* Validates context before rendering *)
let show shapes =
let rec render ctx = function
Expand Down
33 changes: 15 additions & 18 deletions lib/shape.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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'
5 changes: 3 additions & 2 deletions lib/transform.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)

Expand Down Expand Up @@ -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
Expand Down
6 changes: 2 additions & 4 deletions lib/util.ml
Original file line number Diff line number Diff line change
@@ -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 *)
Expand Down Expand Up @@ -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 *)
Expand Down

0 comments on commit 45cdfa6

Please sign in to comment.