Skip to content

Commit

Permalink
Merge branch 'main' into polygon
Browse files Browse the repository at this point in the history
  • Loading branch information
nikochiko committed Dec 13, 2023
2 parents 5c07272 + 704c2b6 commit f1af0f0
Show file tree
Hide file tree
Showing 8 changed files with 137 additions and 19 deletions.
3 changes: 2 additions & 1 deletion .gitignore
Original file line number Diff line number Diff line change
@@ -1,2 +1,3 @@
_build
.vscode
.vscode
.DS_Store
109 changes: 109 additions & 0 deletions examples/circle_packing.ml
Original file line number Diff line number Diff line change
@@ -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 ()
2 changes: 1 addition & 1 deletion examples/complex.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 *)
Expand Down
5 changes: 5 additions & 0 deletions examples/dune
Original file line number Diff line number Diff line change
Expand Up @@ -102,3 +102,8 @@
(name polygon)
(modules polygon)
(libraries joy))

(executable
(name circle_packing)
(modules circle_packing)
(libraries joy))
2 changes: 1 addition & 1 deletion examples/higher_transforms.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 ]
Expand Down
2 changes: 1 addition & 1 deletion examples/line.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 _ =
Expand Down
26 changes: 14 additions & 12 deletions lib/shape.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand All @@ -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

Expand Down Expand Up @@ -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"
Expand Down
7 changes: 4 additions & 3 deletions lib/shape.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit f1af0f0

Please sign in to comment.