1D Perlin Noise for KONTAKT KSP

PerlinNoise1D.ksp

{
  1D Perlin Noise for KONTAKT KSP

  reference:
    http://adrianb.io/2014/08/09/perlinnoise.html
    https://gist.github.com/Flafla2/f0260a861be0ebdeef76

  example:
    ~pn_ax := 0.1
    call perlin
    message(~pn_ret)
}

on init
  message("")

  { Visualiser }
  declare ui_knob $Rate(1, 100, 1)
  $Rate := 15
  declare ui_knob $Depth(1, 100, 1)
  $Depth := 100

  set_ui_height_px(240)
  make_perfview

  declare ui_table %table[128] (1, 16, 100)
  set_control_par(get_ui_id(%table), $CONTROL_PAR_POS_X, 50)
  set_control_par(get_ui_id(%table), $CONTROL_PAR_POS_Y, 50)
  set_control_par(get_ui_id(%table), $CONTROL_PAR_HEIGHT, 170)
  set_control_par(get_ui_id(%table), $CONTROL_PAR_WIDTH, 518)

  declare $n

  { Perlin Noise valiables }
  declare $pn_rep := 256
  declare $pn_n

  declare ~pn_ax := 0.0
  declare ~pn_x
  declare ~pn_xf
  declare ~pn_x1
  declare ~pn_u
  declare ~pn_gx
  declare ~pn_lerp_a
  declare ~pn_lerp_b
  declare ~pn_lerp_w
  declare ~pn_ret
  declare $pn_x
  declare $pn_xi
  declare $pn_aaa
  declare $pn_baa
  declare $pn_hash

  declare %pn_perm[256] := ( 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 )

  { Perlin Noise initialize }
  declare %pn_p[512]
  $pn_n := 0
  while ($pn_n < 512)
    %pn_p[$pn_n] := %pn_perm[$pn_n mod 256]
    inc($pn_n)
  end while

  set_listener($NI_SIGNAL_TIMER_MS, 30000)
end on

function grad
  { grad function }
  select ($pn_hash .and. 15)
    case 0
      ~pn_ret :=  ~pn_x
    case 1
      ~pn_ret := -~pn_x
    case 2
      ~pn_ret :=  ~pn_x
    case 3
      ~pn_ret := -~pn_x
    case 4
      ~pn_ret :=  ~pn_x
    case 5
      ~pn_ret := -~pn_x
    case 6
      ~pn_ret :=  ~pn_x
    case 7
      ~pn_ret := -~pn_x
    case 8 to 11
      ~pn_ret := 0
    case 12
      ~pn_ret := ~pn_x
    case 13
      ~pn_ret := 0
    case 14
      ~pn_ret := -~pn_x
    case 15
      ~pn_ret := 0
  end select
end function

function lerp
  ~pn_ret := ~pn_lerp_a + ~pn_lerp_w * (~pn_lerp_b - ~pn_lerp_a)
end function

{ Perlin function }
function perlin
  ~pn_x := ~pn_ax
  if ($pn_rep > 0)
    $pn_x := int(~pn_x)
    $pn_x := $pn_x mod $pn_rep
  end if
  $pn_xi := $pn_x .and. 255
  ~pn_xf := ~pn_x - floor(~pn_x)

  { fade }
  ~pn_u := 6.0 * pow(~pn_xf, 5.0) - 15.0 * pow(~pn_xf, 4.0) + 10.0 * pow(~pn_xf, 3.0)

  { hash }
  $pn_aaa := %pn_p[%pn_p[%pn_p[$pn_xi]]]
  $pn_baa := %pn_p[%pn_p[%pn_p[(($pn_xi + 1) mod $pn_rep)]]]

  { lerp 1 }
  $pn_hash := $pn_aaa
  ~pn_x := ~pn_xf
  call grad
  ~pn_lerp_a := ~pn_ret
  $pn_hash := $pn_baa
  ~pn_x := ~pn_xf - 1.0
  call grad
  ~pn_lerp_b := ~pn_ret
  ~pn_lerp_w := ~pn_u
  call lerp
  ~pn_x1 := ~pn_ret

  { return }
  ~pn_ret := (~pn_x1 + 1.0) / 2.0
end function


on persistence_changed
  $n := 0
  while ($n < 128)
    call perlin
    %table[$n] := int(~pn_ret * real($Depth) * 1.27)
    ~pn_ax := ~pn_ax + real($Rate) * 0.002
    inc($n)
  end while
end on

on listener
  if ($NI_SIGNAL_TYPE = $NI_SIGNAL_TIMER_MS)
    $n := 0
    while ($n < 127)
      %table[$n] := %table[$n + 1]
      inc($n)
    end while
    call perlin
    %table[127] := int(~pn_ret * real($Depth) * 1.27)
    ~pn_ax := ~pn_ax + real($Rate) * 0.002
    set_engine_par($ENGINE_PAR_CUTOFF, %table[0] * 10000, -1, 0, -1)
  end if
end on