Source file Perlin.ml

(* Claude Code
 *
 * Copyright (C) 2026 Yoann Padioleau
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Library General Public License
 * (LGPL) as published by the Free Software Foundation; either version
 * 2 of the License, or (at your option) any later version.
 *)

(* See Perlin.mli *)

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

(* twice over, so that p.(i + 1) needs no wrapping *)
let p = Array.init 512 (fun i -> permutation.(i land 255))

let fade (t : float) : float = t *. t *. t *. ((t *. ((t *. 6.) -. 15.)) +. 10.)
let lerp (t : float) (a : float) (b : float) : float = a +. (t *. (b -. a))

(* one of 12 gradients, the edges' middles of a cube (and 4 again),
 * dotted with (x, y, z) *)
let grad (hash : int) (x : float) (y : float) (z : float) : float =
  let h = hash land 15 in
  let u = if h < 8 then x else y in
  let v = if h < 4 then y else if h = 12 || h = 14 then x else z in
  (if h land 1 = 0 then u else -.u) +. if h land 2 = 0 then v else -.v

let noise (x : float) (y : float) (z : float) : float =
  let fx = Float.floor x and fy = Float.floor y and fz = Float.floor z in
  let xi = int_of_float fx land 255 and yi = int_of_float fy land 255 and zi = int_of_float fz land 255 in
  let x = x -. fx and y = y -. fy and z = z -. fz in
  let u = fade x and v = fade y and w = fade z in
  let a = p.(xi) + yi in
  let aa = p.(a) + zi and ab = p.(a + 1) + zi in
  let b = p.(xi + 1) + yi in
  let ba = p.(b) + zi and bb = p.(b + 1) + zi in
  lerp w
    (lerp v
       (lerp u (grad p.(aa) x y z) (grad p.(ba) (x -. 1.) y z))
       (lerp u (grad p.(ab) x (y -. 1.) z) (grad p.(bb) (x -. 1.) (y -. 1.) z)))
    (lerp v
       (lerp u (grad p.(aa + 1) x y (z -. 1.)) (grad p.(ba + 1) (x -. 1.) y (z -. 1.)))
       (lerp u (grad p.(ab + 1) x (y -. 1.) (z -. 1.)) (grad p.(bb + 1) (x -. 1.) (y -. 1.) (z -. 1.))))

let turbulence (octaves : int) ((x, y, z) : Vec3.t) : float =
  let sum = ref 0. and f = ref 1. in
  for _ = 1 to octaves do
    sum := !sum +. (Float.abs (noise (x *. !f) (y *. !f) (z *. !f)) /. !f);
    f := !f *. 2.
  done;
  !sum