Merge pull request #82 from FayCarsons/flowfield-example

Added flowfield example

examples/dune

@@ -103,6 +103,11 @@
  (modules donut_with_scale)
  (libraries joy))
 
+(executable
+ (name flowfield)
+ (modules flowfield noise)
+ (libraries joy base))
+
 (executable
  (name color)
  (modules color)

examples/flowfield.ml

@@ -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" ()

examples/noise.ml

@@ -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

examples/noise.mli

@@ -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

lib/render.ml

@@ -58,8 +58,7 @@ let draw_line ctx { a; b; stroke } =
   Cairo.move_to ctx.ctx x y;
   let { x; y } = b in
   Cairo.line_to ctx.ctx x y;
-  Cairo.stroke ctx.ctx;
-  Cairo.Path.clear ctx.ctx
+  Cairo.stroke ctx.ctx
 
 let draw_polygon ctx { vertices; stroke; fill } =
   let stroke_rect stroke =