aike/PerlinNoise3D.ksp

## PerlinNoise3D.ksp
{
  3D 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
    ~pn_ay := 0.0
    ~pn_az := 0.0
    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_ay := 0.0
  declare ~pn_az := 0.0
  declare ~pn_x
  declare ~pn_y
  declare ~pn_z
  declare ~pn_xf
  declare ~pn_yf
  declare ~pn_zf
  declare ~pn_x1
  declare ~pn_y1
  declare ~pn_x2
  declare ~pn_y2
  declare ~pn_u
  declare ~pn_v
  declare ~pn_w
  declare ~pn_gx
  declare ~pn_gy
  declare ~pn_gz
  declare ~pn_lerp_a
  declare ~pn_lerp_b
  declare ~pn_lerp_w
  declare ~pn_ret
  declare $pn_x
  declare $pn_y
  declare $pn_z
  declare $pn_xi
  declare $pn_yi
  declare $pn_zi
  declare $pn_aaa
  declare $pn_aba
  declare $pn_aab
  declare $pn_abb
  declare $pn_baa
  declare $pn_bba
  declare $pn_bab
  declare $pn_bbb
  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 )

  { 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

  declare $j

  set_listener($NI_SIGNAL_TIMER_MS, 30000)
end on

function grad
  { grad function }

  select ($pn_hash .and. 15)
    case 0
      ~pn_ret :=  ~pn_x + ~pn_y
    case 1
      ~pn_ret := -~pn_x + ~pn_y
    case 2
      ~pn_ret :=  ~pn_x - ~pn_y
    case 3
      ~pn_ret := -~pn_x - ~pn_y
    case 4
      ~pn_ret :=  ~pn_x + ~pn_z
    case 5
      ~pn_ret := -~pn_x + ~pn_z
    case 6
      ~pn_ret :=  ~pn_x - ~pn_z
    case 7
      ~pn_ret := -~pn_x - ~pn_z
    case 8
      ~pn_ret :=  ~pn_y + ~pn_z
    case 9
      ~pn_ret := -~pn_y + ~pn_z
    case 10
      ~pn_ret :=  ~pn_y - ~pn_z
    case 11
      ~pn_ret := -~pn_y - ~pn_z
    case 12
      ~pn_ret :=  ~pn_y + ~pn_x
    case 13
      ~pn_ret := -~pn_y + ~pn_z
    case 14
      ~pn_ret :=  ~pn_y - ~pn_x
    case 15
      ~pn_ret := -~pn_y - ~pn_z
  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
  ~pn_y := ~pn_ay
  ~pn_z := ~pn_az

  if ($pn_rep > 0)
    $pn_x := int(~pn_x)
    $pn_y := int(~pn_y)
    $pn_z := int(~pn_z)
    $pn_x := $pn_x mod $pn_rep
    $pn_y := $pn_y mod $pn_rep
    $pn_z := $pn_z mod $pn_rep
  end if

  $pn_xi := $pn_x .and. 255
  $pn_yi := $pn_y .and. 255
  $pn_zi := $pn_z .and. 255

  ~pn_xf := ~pn_x - floor(~pn_x)
  ~pn_yf := ~pn_y - floor(~pn_y)
  ~pn_zf := ~pn_z - floor(~pn_z)

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

  { hash }
  $pn_aaa := %pn_p[%pn_p[%pn_p[$pn_xi] + $pn_yi] + $pn_zi]
  $pn_aba := %pn_p[%pn_p[%pn_p[$pn_xi] + (($pn_yi + 1) mod $pn_rep)] + $pn_zi]
  $pn_aab := %pn_p[%pn_p[%pn_p[$pn_xi] + $pn_yi] + (($pn_zi + 1) mod $pn_rep)]
  $pn_abb := %pn_p[%pn_p[%pn_p[$pn_xi] + (($pn_yi + 1) mod $pn_rep)] + (($pn_zi + 1) mod $pn_rep)]
  $pn_baa := %pn_p[%pn_p[%pn_p[(($pn_xi + 1) mod $pn_rep)] + $pn_yi] + $pn_zi]
  $pn_bba := %pn_p[%pn_p[%pn_p[(($pn_xi + 1) mod $pn_rep)] + (($pn_yi + 1) mod $pn_rep)] + $pn_zi]
  $pn_bab := %pn_p[%pn_p[%pn_p[(($pn_xi + 1) mod $pn_rep)] + $pn_yi] + (($pn_zi + 1) mod $pn_rep)]
  $pn_bbb := %pn_p[%pn_p[%pn_p[(($pn_xi + 1) mod $pn_rep)] + (($pn_yi + 1) mod $pn_rep)] + (($pn_zi + 1) mod $pn_rep)]

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

  { lerp 2 }
  $pn_hash := $pn_aba
  ~pn_x := ~pn_xf
  ~pn_y := ~pn_yf - 1.0
  ~pn_z := ~pn_zf
  call grad
  ~pn_lerp_a := ~pn_ret
  $pn_hash := $pn_bba
  ~pn_x := ~pn_xf - 1.0
  ~pn_y := ~pn_yf - 1.0
  ~pn_z := ~pn_zf
  call grad
  ~pn_lerp_b := ~pn_ret
  ~pn_lerp_w := ~pn_u
  call lerp
  ~pn_x2 := ~pn_ret

  { lerp 3 }
  ~pn_lerp_a := ~pn_x1
  ~pn_lerp_b := ~pn_x2
  ~pn_lerp_w := ~pn_v
  call lerp
  ~pn_y1 := ~pn_ret

  { lerp 4 }
  $pn_hash := $pn_aab
  ~pn_x := ~pn_xf
  ~pn_y := ~pn_yf
  ~pn_z := ~pn_zf - 1.0
  call grad
  ~pn_lerp_a := ~pn_ret
  $pn_hash := $pn_bab
  ~pn_x := ~pn_xf - 1.0
  ~pn_y := ~pn_yf
  ~pn_z := ~pn_zf - 1.0
  call grad
  ~pn_lerp_b := ~pn_ret
  ~pn_lerp_w := ~pn_u
  call lerp
  ~pn_x1 := ~pn_ret

  { lerp 5 }
  $pn_hash := $pn_abb
  ~pn_x := ~pn_xf
  ~pn_y := ~pn_yf - 1.0
  ~pn_z := ~pn_zf - 1.0
  call grad
  ~pn_lerp_a := ~pn_ret

  $pn_hash := $pn_bbb
  ~pn_x := ~pn_xf - 1.0
  ~pn_y := ~pn_yf - 1.0
  ~pn_z := ~pn_zf - 1.0
  call grad
  ~pn_lerp_b := ~pn_ret
  ~pn_lerp_w := ~pn_u
  call lerp
  ~pn_x2 := ~pn_ret

  { lerp 6 }
  ~pn_lerp_a := ~pn_x1
  ~pn_lerp_b := ~pn_x2
  ~pn_lerp_w := ~pn_v
  call lerp
  ~pn_y2 := ~pn_ret

  { return }
  ~pn_lerp_a := ~pn_y1
  ~pn_lerp_b := ~pn_y2
  ~pn_lerp_w := ~pn_w
  call lerp
  ~pn_ret := (~pn_ret + 1.0) / 2.0
  inc($j)
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
	{
	3D 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
	~pn_ay := 0.0
	~pn_az := 0.0
	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_ay := 0.0
	declare ~pn_az := 0.0
	declare ~pn_x
	declare ~pn_y
	declare ~pn_z
	declare ~pn_xf
	declare ~pn_yf
	declare ~pn_zf
	declare ~pn_x1
	declare ~pn_y1
	declare ~pn_x2
	declare ~pn_y2
	declare ~pn_u
	declare ~pn_v
	declare ~pn_w
	declare ~pn_gx
	declare ~pn_gy
	declare ~pn_gz
	declare ~pn_lerp_a
	declare ~pn_lerp_b
	declare ~pn_lerp_w
	declare ~pn_ret
	declare $pn_x
	declare $pn_y
	declare $pn_z
	declare $pn_xi
	declare $pn_yi
	declare $pn_zi
	declare $pn_aaa
	declare $pn_aba
	declare $pn_aab
	declare $pn_abb
	declare $pn_baa
	declare $pn_bba
	declare $pn_bab
	declare $pn_bbb
	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 )

	{ 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

	declare $j

	set_listener($NI_SIGNAL_TIMER_MS, 30000)
	end on

	function grad
	{ grad function }

	select ($pn_hash .and. 15)
	case 0
	~pn_ret := ~pn_x + ~pn_y
	case 1
	~pn_ret := -~pn_x + ~pn_y
	case 2
	~pn_ret := ~pn_x - ~pn_y
	case 3
	~pn_ret := -~pn_x - ~pn_y
	case 4
	~pn_ret := ~pn_x + ~pn_z
	case 5
	~pn_ret := -~pn_x + ~pn_z
	case 6
	~pn_ret := ~pn_x - ~pn_z
	case 7
	~pn_ret := -~pn_x - ~pn_z
	case 8
	~pn_ret := ~pn_y + ~pn_z
	case 9
	~pn_ret := -~pn_y + ~pn_z
	case 10
	~pn_ret := ~pn_y - ~pn_z
	case 11
	~pn_ret := -~pn_y - ~pn_z
	case 12
	~pn_ret := ~pn_y + ~pn_x
	case 13
	~pn_ret := -~pn_y + ~pn_z
	case 14
	~pn_ret := ~pn_y - ~pn_x
	case 15
	~pn_ret := -~pn_y - ~pn_z
	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
	~pn_y := ~pn_ay
	~pn_z := ~pn_az

	if ($pn_rep > 0)
	$pn_x := int(~pn_x)
	$pn_y := int(~pn_y)
	$pn_z := int(~pn_z)
	$pn_x := $pn_x mod $pn_rep
	$pn_y := $pn_y mod $pn_rep
	$pn_z := $pn_z mod $pn_rep
	end if

	$pn_xi := $pn_x .and. 255
	$pn_yi := $pn_y .and. 255
	$pn_zi := $pn_z .and. 255

	~pn_xf := ~pn_x - floor(~pn_x)
	~pn_yf := ~pn_y - floor(~pn_y)
	~pn_zf := ~pn_z - floor(~pn_z)

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

	{ hash }
	$pn_aaa := %pn_p[%pn_p[%pn_p[$pn_xi] + $pn_yi] + $pn_zi]
	$pn_aba := %pn_p[%pn_p[%pn_p[$pn_xi] + (($pn_yi + 1) mod $pn_rep)] + $pn_zi]
	$pn_aab := %pn_p[%pn_p[%pn_p[$pn_xi] + $pn_yi] + (($pn_zi + 1) mod $pn_rep)]
	$pn_abb := %pn_p[%pn_p[%pn_p[$pn_xi] + (($pn_yi + 1) mod $pn_rep)] + (($pn_zi + 1) mod $pn_rep)]
	$pn_baa := %pn_p[%pn_p[%pn_p[(($pn_xi + 1) mod $pn_rep)] + $pn_yi] + $pn_zi]
	$pn_bba := %pn_p[%pn_p[%pn_p[(($pn_xi + 1) mod $pn_rep)] + (($pn_yi + 1) mod $pn_rep)] + $pn_zi]
	$pn_bab := %pn_p[%pn_p[%pn_p[(($pn_xi + 1) mod $pn_rep)] + $pn_yi] + (($pn_zi + 1) mod $pn_rep)]
	$pn_bbb := %pn_p[%pn_p[%pn_p[(($pn_xi + 1) mod $pn_rep)] + (($pn_yi + 1) mod $pn_rep)] + (($pn_zi + 1) mod $pn_rep)]

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

	{ lerp 2 }
	$pn_hash := $pn_aba
	~pn_x := ~pn_xf
	~pn_y := ~pn_yf - 1.0
	~pn_z := ~pn_zf
	call grad
	~pn_lerp_a := ~pn_ret
	$pn_hash := $pn_bba
	~pn_x := ~pn_xf - 1.0
	~pn_y := ~pn_yf - 1.0
	~pn_z := ~pn_zf
	call grad
	~pn_lerp_b := ~pn_ret
	~pn_lerp_w := ~pn_u
	call lerp
	~pn_x2 := ~pn_ret

	{ lerp 3 }
	~pn_lerp_a := ~pn_x1
	~pn_lerp_b := ~pn_x2
	~pn_lerp_w := ~pn_v
	call lerp
	~pn_y1 := ~pn_ret

	{ lerp 4 }
	$pn_hash := $pn_aab
	~pn_x := ~pn_xf
	~pn_y := ~pn_yf
	~pn_z := ~pn_zf - 1.0
	call grad
	~pn_lerp_a := ~pn_ret
	$pn_hash := $pn_bab
	~pn_x := ~pn_xf - 1.0
	~pn_y := ~pn_yf
	~pn_z := ~pn_zf - 1.0
	call grad
	~pn_lerp_b := ~pn_ret
	~pn_lerp_w := ~pn_u
	call lerp
	~pn_x1 := ~pn_ret

	{ lerp 5 }
	$pn_hash := $pn_abb
	~pn_x := ~pn_xf
	~pn_y := ~pn_yf - 1.0
	~pn_z := ~pn_zf - 1.0
	call grad
	~pn_lerp_a := ~pn_ret

	$pn_hash := $pn_bbb
	~pn_x := ~pn_xf - 1.0
	~pn_y := ~pn_yf - 1.0
	~pn_z := ~pn_zf - 1.0
	call grad
	~pn_lerp_b := ~pn_ret
	~pn_lerp_w := ~pn_u
	call lerp
	~pn_x2 := ~pn_ret

	{ lerp 6 }
	~pn_lerp_a := ~pn_x1
	~pn_lerp_b := ~pn_x2
	~pn_lerp_w := ~pn_v
	call lerp
	~pn_y2 := ~pn_ret

	{ return }
	~pn_lerp_a := ~pn_y1
	~pn_lerp_b := ~pn_y2
	~pn_lerp_w := ~pn_w
	call lerp
	~pn_ret := (~pn_ret + 1.0) / 2.0
	inc($j)
	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