Skip to content

Commit

Permalink
merge main
Browse files Browse the repository at this point in the history
  • Loading branch information
FayCarsons committed Mar 1, 2024
2 parents 5d260cf + ed3bd4e commit 4f950ba
Show file tree
Hide file tree
Showing 25 changed files with 500 additions and 117 deletions.
2 changes: 1 addition & 1 deletion examples/axes.ml
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,6 @@ let _ =
init ~axes:true ();
(* set background to opaque white *)
let c = circle 50 in
render c;
show [ c ];
(* Write to PNG! *)
write ~filename:"axes.png" ()
2 changes: 1 addition & 1 deletion examples/circle.ml
Original file line number Diff line number Diff line change
Expand Up @@ -3,5 +3,5 @@ open Joy
let () =
init ();
let c = circle 50 in
render c;
show [ c ];
write ~filename:"circle.png" ()
2 changes: 1 addition & 1 deletion examples/color.ml
Original file line number Diff line number Diff line change
Expand Up @@ -3,5 +3,5 @@ open Joy
let _ =
init ();
let c = circle 50 |> with_stroke red in
render c;
show [ c ];
write ~filename:"color.png" ()
2 changes: 1 addition & 1 deletion examples/concentric_circles.ml
Original file line number Diff line number Diff line change
Expand Up @@ -12,5 +12,5 @@ let () =
| _, _ -> arr
in
let circles = complex (make_concentric [] 21) in
render circles;
show [ circles ];
write ~filename:"concentric_circles.png" ()
10 changes: 10 additions & 0 deletions examples/dune
Original file line number Diff line number Diff line change
Expand Up @@ -103,6 +103,16 @@
(modules donut_with_scale)
(libraries joy))

(executable
(name quadtree)
(modules quadtree)
(libraries joy))

(executable
(name flowfield)
(modules flowfield noise)
(libraries joy base))

(executable
(name color)
(modules color)
Expand Down
2 changes: 1 addition & 1 deletion examples/ellipse.ml
Original file line number Diff line number Diff line change
Expand Up @@ -5,5 +5,5 @@ let () =
(* create an ellipse *)
let e = ellipse 100 75 in
(* render it *)
render e;
show [ e ];
write ~filename:"ellipse.png" ()
106 changes: 106 additions & 0 deletions examples/flowfield.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,106 @@
(* Constants *)
let size = 1200
let tau = 2. *. Float.pi
let num_steps = 6
let grid_divisor = 128
let _ = Random.self_init ()
let octaves = 4
let noise_scale = 2. +. Random.float 3.

(* Utilities & color palette *)

(* Randomly shuffles a list *)
let shuffle xs =
let pairs = List.map (fun c -> (Random.bits (), c)) xs in
let sorted = List.sort compare pairs in
List.map snd sorted

let palette =
[
(74, 58, 59);
(152, 65, 54);
(194, 106, 122);
(236, 192, 161);
(240, 240, 228);
]
|> shuffle

let clamp = function
| n when n > size - 1 -> size - 1
| n when n < 0 -> 0
| n -> n

let fclamp max = function f when f > max -> max | f when f < 0. -> 0. | f -> f

(* Initialize flowfield, a large 2D array containing angles determined by
seeded simplex noise sampled at each coordinate *)
let flowfield () =
let seed = Random.float 100. in
Bigarray.Array2.init Bigarray.Float32 Bigarray.c_layout size size (fun x y ->
let noise =
Noise.fractal2 octaves
((float_of_int x /. float_of_int size *. noise_scale) +. seed)
((float_of_int y /. float_of_int size *. noise_scale) +. seed)
in
let uni = (noise *. 0.5) +. 0.5 in
fclamp tau uni *. tau)

(* Create a n*n grid of points where lines will be placed *)
let grid divison =
let grid_size = size / divison in
let spacing = size / grid_size in
List.init (grid_size * grid_size) (fun i ->
(i / grid_size * spacing, i mod grid_size * spacing))

(* scale 0-n coordinates to [-n/2..n/2] *)
let uni_to_bi (x, y) =
let x = x - (size / 2) in
let y = y - (size / 2) in
(float_of_int x, float_of_int y)

(* Create a 2D vector from an angle *)
let vector_of_angle angle =
( sin angle |> Float.round |> int_of_float,
cos angle |> Float.round |> int_of_float )

(* Step along the flowfield, following the angles at each point visited *)
let rec step n (x, y) flowfield =
if n >= 0 then
let cx, cy = (clamp x, clamp y) in
let angle = Bigarray.Array2.get flowfield cx cy in
let dx, dy = vector_of_angle angle in
step (n - 1) (x + dx, y + dy) flowfield
else (x, y)

(* Given a coordinate, draws a line starting at that point, following flowfield *)
let make_line flowfield (x, y) =
let cx, cy = (clamp x, clamp y) in
let angle = Bigarray.Array2.get flowfield cx cy in
let dx, dy = vector_of_angle angle in
let next = (x + dx, y + dy) in
let final = step num_steps next flowfield in
let ax, ay = uni_to_bi (x, y) in
let bx, by = uni_to_bi final in
(Joy.line ~a:{ x = ax; y = ay } { x = bx; y = by }, (cx, cy))

(* Adds color to line, based on its angle *)
let add_color flowfield line (x, y) =
let color =
Bigarray.Array2.get flowfield x y /. tau
|> ( *. ) (float_of_int (List.length palette))
|> int_of_float |> List.nth palette
in
line |> Joy.with_stroke color

let () =
let open Joy in
init ();
set_line_width 3;
let flowfield = flowfield () in
let interval = size / grid_divisor in
let indices = grid interval in
let lines, points = List.map (make_line flowfield) indices |> List.split in
let centered = List.map (translate interval interval) lines in
let lines = List.map2 (add_color flowfield) centered points in
show lines;
write ~filename:"flowfield.png" ()
2 changes: 1 addition & 1 deletion examples/higher_transforms.ml
Original file line number Diff line number Diff line change
Expand Up @@ -10,5 +10,5 @@ let () =
init ();
let initial = rectangle ~c:(point (-250) (-250)) 100 100 in
let shapes = repeat 32 transform initial in
render shapes;
show [ shapes ];
write ~filename:"higher_transforms.png" ()
124 changes: 124 additions & 0 deletions examples/noise.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,124 @@
open Base

(* borrowed from
https://gist.githubusercontent.com/tjammer/509981fed4d50683cdb800da5bf16ab1/raw/da2b8cc86718ef7e93e2e2c707dcfe443809d7cc/simplex.ml *)
let permutation =
[|
151; 160; 137; 91; 90; 15; 131; 13; 201; 95; 96; 53; 194; 233; 7; 225; 140;
36; 103; 30; 69; 142; 8; 99; 37; 240; 21; 10; 23; 190; 6; 148; 247; 120;
234; 75; 0; 26; 197; 62; 94; 252; 219; 203; 117; 35; 11; 32; 57; 177; 33;
88; 237; 149; 56; 87; 174; 20; 125; 136; 171; 168; 68; 175; 74; 165; 71;
134; 139; 48; 27; 166; 77; 146; 158; 231; 83; 111; 229; 122; 60; 211; 133;
230; 220; 105; 92; 41; 55; 46; 245; 40; 244; 102; 143; 54; 65; 25; 63; 161;
1; 216; 80; 73; 209; 76; 132; 187; 208; 89; 18; 169; 200; 196; 135; 130;
116; 188; 159; 86; 164; 100; 109; 198; 173; 186; 3; 64; 52; 217; 226; 250;
124; 123; 5; 202; 38; 147; 118; 126; 255; 82; 85; 212; 207; 206; 59; 227;
47; 16; 58; 17; 182; 189; 28; 42; 223; 183; 170; 213; 119; 248; 152; 2; 44;
154; 163; 70; 221; 153; 101; 155; 167; 43; 172; 9; 129; 22; 39; 253; 19; 98;
108; 110; 79; 113; 224; 232; 178; 185; 112; 104; 218; 246; 97; 228; 251; 34;
242; 193; 238; 210; 144; 12; 191; 179; 162; 241; 81; 51; 145; 235; 249; 14;
239; 107; 49; 192; 214; 31; 181; 199; 106; 157; 184; 84; 204; 176; 115; 121;
50; 45; 127; 4; 150; 254; 138; 236; 205; 93; 222; 114; 67; 29; 24; 72; 243;
141; 128; 195; 78; 66; 215; 61; 156; 180;
|]
[@@ocamlformat "break-collection-expressions=wrap"]

let hash n = permutation.(Int.of_float n land 255)

let grad1 hash x =
let h = hash land 0x0F in
(* gradient value 1.0, 2.0 .. 8.0 *)
let grad = 1.0 +. Float.of_int (h land 7) in
let grad = if h land 8 <> 0 then -.grad else grad in
grad *. x

let grad2 hash x y =
let h = hash land 0x3F in
let u, v = if h < 4 then (x, y) else (y, x) in
(if h land 1 <> 0 then -.u else u)
+. if h land 2 <> 0 then -2.0 *. v else 2.0 *. v

let snoise1 x =
let i0 = Float.round_down x in
let i1 = i0 +. 1.0 in
let x0 = x -. i0 in
let x1 = x0 -. 1.0 in
let t0 = 1.0 -. (x0 *. x0) in
let t0 = t0 *. t0 in
let n0 = t0 *. t0 *. grad1 (hash i0) x0 in
let t1 = 1.0 -. (x1 *. x1) in
let t1 = t1 *. t1 in
let n1 = t1 *. t1 *. grad1 (hash i1) x1 in
(* The maximum value of this noise is 8*(3/4)^4 = 2.53125 *)
(* A factor of 0.395 scales to fit exactly within [-1,1] *)
0.395 *. (n0 +. n1)

let snoise2 x y =
let _F2 = 0.366025403 in
(* F2 = (sqrt(3) - 1) / 2*)
let _G2 = 0.211324865 in
(*G2 = (3 - sqrt(3)) / 6 = F2 / (1 + 2 * K)*)
(* skew the input space to determine which simplex cell we're in *)
let s = (x +. y) *. _F2 in
let xs, ys = (x +. s, y +. s) in
let i, j = Float.(round_down xs, round_down ys) in
(* unskew the cell origin back to (x, y) space *)
let t = (i +. j) *. _G2 in
let _X0 = i -. t in
let _Y0 = j -. t in
let x0, y0 = (x -. _X0, y -. _Y0) in
(* determine which simplex we're in *)
let i1, j1 = if Poly.(x0 > y0) then (1., 0.) else (0., 1.) in
(* A step of (1,0) in (i,j) means a step of (1-c,-c) in (x,y), and *)
(* a step of (0,1) in (i,j) means a step of (-c,1-c) in (x,y), where *)
(* c = (3-sqrt(3))/6 *)
let x1, y1 = Float.(x0 - i1 + _G2, y0 - j1 + _G2) in
let x2, y2 = Float.(x0 - 1.0 + (2.0 * _G2), y0 - 1.0 + (2.0 * _G2)) in
(* Work out the hashed gradient indices of the three simplex corners *)
let gi0 = (j |> hash |> Float.of_int) +. i |> hash in
let gi1 = (j +. j1 |> hash |> Float.of_int) +. i +. i1 |> hash in
let gi2 = (j +. 1. |> hash |> Float.of_int) +. i +. 1. |> hash in
let contrib x y gi =
let t = 0.5 -. (x *. x) -. (y *. y) in
if Float.(t < 0.0) then 0.0
else
let t = t *. t in
t *. t *. grad2 gi x y
in
(* Calculate the contribution from the first corner *)
let n0 = contrib x0 y0 gi0 in
(* Calculate the contribution from the second corner *)
let n1 = contrib x1 y1 gi1 in
(* Calculate the contribution from the third corner *)
let n2 = contrib x2 y2 gi2 in
45.23065 *. (n0 +. n1 +. n2)

(* constants *)
let frequency = ref 1.0
let amplitude = ref 1.0
let lacunarity = ref 2.0
let persistence = ref 0.5

let fractal1 octaves x =
let rec loop noise amp i =
if i = 0 then noise /. amp
else
let frequency = !frequency *. Float.int_pow !lacunarity (i - 1) in
let amplitude = !amplitude *. Float.int_pow !persistence (i - 1) in
loop
(noise +. (amplitude *. snoise1 (x *. frequency)))
(amp +. amplitude) (i - 1)
in
loop 0.0 0.0 octaves

let fractal2 octaves x y =
let rec loop noise amp i =
if i = 0 then noise /. amp
else
let frequency = !frequency *. Float.int_pow !lacunarity (i - 1) in
let amplitude = !amplitude *. Float.int_pow !persistence (i - 1) in
loop
(noise +. (amplitude *. snoise2 (x *. frequency) (y *. frequency)))
(amp +. amplitude) (i - 1)
in
loop 0.0 0.0 octaves
12 changes: 12 additions & 0 deletions examples/noise.mli
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
val permutation : int array
val hash : float -> int
val grad1 : int -> float -> float
val grad2 : int -> float -> float -> float
val snoise1 : float -> float
val snoise2 : float -> float -> float
val frequency : float ref
val amplitude : float ref
val lacunarity : float ref
val persistence : float ref
val fractal1 : int -> float -> float
val fractal2 : int -> float -> float -> float
2 changes: 1 addition & 1 deletion examples/polygon.ml
Original file line number Diff line number Diff line change
Expand Up @@ -8,5 +8,5 @@ let () =
polygon
[ { x = -.size; y = 0. }; { x = 0.; y = size }; { x = size; y = 0. } ]
in
render poly;
show [ poly ];
write ~filename:"polygon.png" ()
Loading

0 comments on commit 4f950ba

Please sign in to comment.