open Bigarray

let palette = Array1.create int32 c_layout 256;;
for idx = 0 to 255 do
  palette.{idx} <- Int32.of_int (255 lsl 24 + idx);
done;;

(* 8 cells should be enough in the unlikely case that we can
   render a cloud - the last ones are to prevent overflow *)
let gridsize = 9;;
let gradients = Array3.create float64 c_layout gridsize gridsize 2;;

let initGradients =
  for y = 0 to gridsize -1 do
    for x = 0 to gridsize - 1 do
      let dx = Random.float 1. in
      let dy = Random.float 1. in
      let r = sqrt ((dx *. dx) +. (dy *. dy)) in
        gradients.{y,x,0} <- dx /. r;
        gradients.{y,x,1} <- dy /. r;
    done;
  done;;

initGradients;;

let ease p = 
  3. *. p *. p -. 2. *. p *. p *. p;;

let sample x y =
  let ix = truncate x in
  let iy = truncate y in
  let dx = x -. float ix in
  let dy = y -. float iy in
  let s = dx *. gradients.{iy, ix, 0} +. dy *. gradients.{iy, ix, 1} in
  let t = (dx -. 1.) *. gradients.{iy, ix+1, 0} +. dy *. gradients.{iy, ix+1, 1} in
  let u = dx *. gradients.{iy+1, ix, 0} +. (dy -. 1.) *. gradients.{iy+1, ix, 1} in
  let v = (dx -. 1.) *. gradients.{iy+1, ix+1, 0} +. (dy -. 1.) *. gradients.{iy+1, ix+1, 1} in
  let easex = ease dx in
  let easey = ease dy in
  let a = s +. (easex *. (t -. s)) in
  let b = u +. (easex *. (v -. u)) in
    a +. (easey *. (b -. a));;

let clamp s =
  max 0 (min 255 (truncate s));;

let sample2idx s = 
  clamp ((s *. 512.) +. 127.);;

let render array time_ms = 
  initGradients;
  let h = Array2.dim1 array in
  let w = Array2.dim2 array in
  let my = 1. /. float h in
  let mx = 1. /. float w in
    for y = 0 to h - 1 do
      for x = 0 to w - 1 do
        array.{x, y} <- palette.{sample2idx (sample (float x *. mx) (float y *. my))};
      done;
    done;;

(* C export *)
let _ = Callback.register "render" render;;
