diff --git a/.gitignore b/.gitignore index 02b9a8a..f4785c3 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ _build -.vscode \ No newline at end of file +.vscode +.DS_Store diff --git a/examples/circle_packing.ml b/examples/circle_packing.ml new file mode 100644 index 0000000..fb6e9a1 --- /dev/null +++ b/examples/circle_packing.ml @@ -0,0 +1,109 @@ +open Joy.Shape + +(* global constants // RNG initialization *) +let resolution = (1200, 900) +let min_radius = 20 +let max_radius = 150 +let num_circles = 5_000 +let max_attempts = 100_000 +let shrink_factor = 0.85 +let _ = Stdlib.Random.self_init () + +let palette = + [ + (* purple *) + (107, 108, 163); + (* light blue *) + (135, 188, 189); + (* green *) + (111, 153, 84); + (* light purple *) + (150, 155, 199); + (* light green *) + (137, 171, 124); + (* dark purple *) + (67, 68, 117); + (* darker purple *) + (44, 45, 84); + ] + +(* utility Functions *) + +(* distance between two points *) +let distance (x1, y1) (x2, y2) = + let dx = float_of_int x2 -. float_of_int x1 in + let dy = float_of_int y2 -. float_of_int y1 in + let dist = sqrt ((dx *. dx) +. (dy *. dy)) in + int_of_float dist + +(* determines if two circles overlaps *) +let overlaps (p1, r1) (p2, r2) = + let dist = distance p1 p2 in + dist < r1 + r2 + +(* creates a random point within screen bounds *) +let rand_point () = + ( Stdlib.Random.full_int (fst resolution * 2) - fst resolution, + Stdlib.Random.full_int (snd resolution * 2) - snd resolution ) + +(* creates a circle with a random center point and radius *) +let rand_circle () = + let point = rand_point () in + (point, min_radius + Stdlib.Random.full_int (max_radius - min_radius)) + +(* creates a lis of packed circles *) +let pack_circles () = + (* checks whether a circle intersects with a list of circles *) + let check_overlaps lst current = + List.fold_right (fun curr acc -> overlaps curr current || acc) lst false + in + (* creates a new circle, checks if it intersects previous circles, + if max attempts have been reached, + or if the desired number of circles have been created. + From there it either recurses with or without the new circle, + or returns the list of circles *) + let rec pack lst attempts = + let new_circle = rand_circle () in + let does_overlap = check_overlaps lst new_circle in + let safe = List.length lst < num_circles - 1 && attempts < max_attempts in + if does_overlap && safe then pack lst (attempts + 1) + else if not safe then new_circle :: lst + else pack (new_circle :: lst) attempts + in + let attempts = 0 in + let lst = [ rand_circle () ] in + pack lst attempts + +(* pulls a random color from the 'palette' list + sets draw color with it + then draws circle *) +let draw_with_color circle = + let idx = Stdlib.Random.full_int (List.length palette - 1) in + let r, g, b = List.nth palette idx in + Graphics.set_color (Graphics.rgb r g b); + render_shape circle + +(* turns a circle into a list of concentric circles *) +let make_concentric circle = + let rec shrink lst = + let point, radius = List.hd (List.rev lst) in + if radius <= 1 then lst + else + let new_circle = + (point, int_of_float (float_of_int radius *. shrink_factor)) + in + shrink (lst @ [ new_circle ]) + in + shrink [ circle ] + +(* main fn *) +let () = + set_dimensions (fst resolution) (snd resolution); + init (); + Graphics.set_line_width 3; + let circles = pack_circles () in + let circles = List.flatten (List.map make_concentric circles) in + List.iter + (fun ((x, y), radius) -> draw_with_color (circle ~point:(point x y) radius)) + circles; + close () diff --git a/examples/complex.ml b/examples/complex.ml index b0580da..57311e5 100644 --- a/examples/complex.ml +++ b/examples/complex.ml @@ -25,7 +25,7 @@ let () = let complex_shape = complex (List.map - (fun (x, y) -> circle ~x:(x * radius) ~y:(y * radius) radius) + (fun (x, y) -> circle ~point:(point (x * radius) (y * radius)) radius) coords) in (* translating that complex shape by radius / 2 *) diff --git a/examples/dune b/examples/dune index 19d5436..f8d4627 100644 --- a/examples/dune +++ b/examples/dune @@ -102,3 +102,8 @@ (name polygon) (modules polygon) (libraries joy)) + +(executable + (name circle_packing) + (modules circle_packing) + (libraries joy)) diff --git a/examples/higher_transforms.ml b/examples/higher_transforms.ml index dcfbdc5..bd8462d 100644 --- a/examples/higher_transforms.ml +++ b/examples/higher_transforms.ml @@ -9,7 +9,7 @@ let rec range a b = if a > b then [] else a :: range (a + 1) b let () = init (); - let initial = rectangle ~point:{ x = -250; y = -250 } 100 100 in + let initial = rectangle ~point:(point (-250) (-250)) 100 100 in let match_list l = match l with | [] -> [ transform initial ] diff --git a/examples/line.ml b/examples/line.ml index 686a860..297eece 100644 --- a/examples/line.ml +++ b/examples/line.ml @@ -9,7 +9,7 @@ let lines = List.map (fun i -> let newx = i |> inc |> ( * ) line_interval in - line ~x1:newx ~y1:0 newx 500) + line ~point_a:(point newx 0) (point newx 500)) (range 0 interval) let _ = diff --git a/lib/shape.ml b/lib/shape.ml index 0a8818d..f0c432f 100644 --- a/lib/shape.ml +++ b/lib/shape.ml @@ -56,9 +56,11 @@ let rec render_shape s = | Polygon polygon' -> render_polygon polygon' | Complex complex -> List.iter render_shape complex -let circle ?x ?y r = - match (x, y) with - | Some x, Some y -> Circle { c = { x; y }; radius = r } +let point x y = { x; y } + +let circle ?point r = + match point with + | Some point -> Circle { c = point; radius = r } | _ -> Circle { c = { x = 0; y = 0 }; radius = r } let rectangle ?point length width = @@ -71,15 +73,15 @@ let rectangle ?point length width = { x = x + width; y }; ] -let ellipse ?x ?y rx ry = - match (x, y) with - | Some x, Some y -> Ellipse { c = { x; y }; rx; ry } +let ellipse ?point rx ry = + match point with + | Some point -> Ellipse { c = point; rx; ry } | _ -> Ellipse { c = { x = 0; y = 0 }; rx; ry } -let line ?x1 ?y1 x2 y2 = - match (x1, y1) with - | Some x, Some y -> Line { a = { x; y }; b = { x = x2; y = y2 } } - | _ -> Line { a = { x = 0; y = 0 }; b = { x = x2; y = y2 } } +let line ?point_a point_b = + match point_a with + | Some point_a -> Line { a = point_a; b = point_b } + | _ -> Line { a = { x = 0; y = 0 }; b = point_b } let polygon lst_points = Polygon lst_points @@ -111,9 +113,9 @@ let rec scale factor s = let scale_length len fact = round (float_of_int len *. sqrt fact) in match s with | Circle circle' -> - circle ~x:circle'.c.x ~y:circle'.c.y (scale_length circle'.radius factor) + circle ~point:circle'.c (scale_length circle'.radius factor) | Ellipse ellipse' -> - ellipse ~x:ellipse'.c.x ~y:ellipse'.c.y + ellipse ~point:ellipse'.c (scale_length ellipse'.rx factor) (scale_length ellipse'.ry factor) | Line _line' -> failwith "Not Implemented" diff --git a/lib/shape.mli b/lib/shape.mli index a169205..467a7fb 100644 --- a/lib/shape.mli +++ b/lib/shape.mli @@ -3,11 +3,12 @@ type shapes = shape list type point = { x : int; y : int } val render_shape : shape -> unit -val circle : ?x:int -> ?y:int -> int -> shape +val point : int -> int -> point +val circle : ?point:point -> int -> shape val rectangle : ?point:point -> int -> int -> shape -val ellipse : ?x:int -> ?y:int -> int -> int -> shape +val ellipse : ?point:point -> int -> int -> shape val complex : shape list -> shape -val line : ?x1:int -> ?y1:int -> int -> int -> shape +val line : ?point_a:point -> point -> shape val polygon : point list -> shape val translate : int -> int -> shape -> shape val show : shape list -> unit