
Code: Select all
DeclareModule PerlinNoiseProcessing
EnableExplicit
Declare.f Noise(x.f, y.f, z.f)
Declare.f Noise1D(x.f)
Declare.f Noise2D(x.f, y.f)
Declare.f Noise3D(x.f, y.f, z.f)
EndDeclareModule
Module PerlinNoiseProcessing
#PERLIN_YWRAPB = 4;
#PERLIN_YWRAP = 1 << #PERLIN_YWRAPB;
#PERLIN_ZWRAPB = 8 ;
#PERLIN_ZWRAP = 1 << #PERLIN_ZWRAPB;
#PERLIN_SIZE = 4095 ;
#SINCOS_PRECISION = 0.5
#SINCOS_LENGTH = 360 / #SINCOS_PRECISION * 1
Global Perlin_octaves.l = 4; // default to medium smooth
Global Perlin_amp_falloff.f = 0.5; // 50% reduction/octave
Global Perlin_TWOPI.l, Perlin_PI.l;
Global Dim Perlin_cosTable.f(0) ;
Global Dim Perlin.f(0) ;
Procedure InitPerlinCosTable()
Protected SincosIntLength.u = Int(#SINCOS_LENGTH)
ReDim Perlin_cosTable(SincosIntLength - 1)
Protected i.u, LastIndex.u = SincosIntLength - 1
For i = 0 To LastIndex
Perlin_cosTable(i) = Cos(Radian(i) * #SINCOS_PRECISION)
Next i
EndProcedure
Procedure.f noise_fsc(i.f)
; using bagel's cosine table instead
Protected Index.u = Int((i * perlin_PI)) % perlin_TWOPI
ProcedureReturn 0.5 * (1.0 - perlin_cosTable(Index))
EndProcedure
Procedure.f Noise(x.f, y.f, z.f)
If ArraySize(perlin()) = 0
ReDim Perlin(#PERLIN_SIZE)
If ArraySize(Perlin()) = -1
;error allocating, should do something here
EndIf
Protected i.u
For i = 0 To #PERLIN_SIZE
Perlin(i) = Random(10000) / 10000.0
Next i
InitPerlinCosTable()
Perlin_TWOPI = #SINCOS_LENGTH
perlin_PI = #SINCOS_LENGTH;
Perlin_PI = Perlin_PI >> 1
EndIf
If x < 0 : x = -x : EndIf
If y < 0 : y = -y : EndIf
If z < 0 : z = -z : EndIf
Protected xi.l = Int(x), yi.l = Int(y), zi.l = Int(z)
Protected xf.f = x - xi
Protected yf.f = y - yi
Protected zf.f = z - zi
Protected rxf.f, ryf.f
Protected r.f = 0;
Protected ampl.f = 0.5
Protected.f n1,n2,n3;
For i = 0 To Perlin_octaves
Protected of.l = xi + (yi << #PERLIN_YWRAPB) + (zi << #PERLIN_ZWRAPB)
rxf = noise_fsc(xf)
ryf = noise_fsc(yf)
n1 = perlin(of & #PERLIN_SIZE);
n1 + rxf * (perlin((of+1) & #PERLIN_SIZE)-n1);
n2 = perlin((of + #PERLIN_YWRAP) & #PERLIN_SIZE);
n2 + rxf * (perlin((of + #PERLIN_YWRAP + 1) & #PERLIN_SIZE) - n2);
n1 + ryf * (n2 - n1) ;
of + #PERLIN_ZWRAP;
n2 = perlin(of & #PERLIN_SIZE);
n2 + rxf * (perlin((of+1) & #PERLIN_SIZE)-n2);
n3 = perlin((of + #PERLIN_YWRAP) & #PERLIN_SIZE);
n3 + rxf * (perlin((of + #PERLIN_YWRAP + 1) & #PERLIN_SIZE)-n3);
n2 + ryf * (n3 - n2) ;
n1 + noise_fsc(zf) * (n2-n1);
r + n1 * ampl;
ampl * perlin_amp_falloff;
xi = xi << 1 : xf * 2 ;
yi = yi << 1 : yf * 2 ;
zi = zi << 1 : zf * 2 ;
If xf >= 1.0 : xi + 1 : xf - 1 : EndIf
If yf >= 1.0 : yi + 1 : yf - 1 : EndIf
If zf >= 1.0 : zi + 1 : zf - 1 : EndIf
Next i
ProcedureReturn r
EndProcedure
Procedure.f Noise1D(x.f)
ProcedureReturn Noise(x, 0, 0)
EndProcedure
Procedure.f Noise2D(x.f, y.f)
ProcedureReturn Noise(x, y, 0)
EndProcedure
Procedure.f Noise3D(x.f, y.f, z.f)
ProcedureReturn Noise(x, y, z)
EndProcedure
DisableExplicit
EndModule
CompilerIf #PB_Compiler_IsMainFile
Procedure.i ShowTurbulence(Width.i, Height.i)
Protected noise.f, b.i, time.d, img.i
time = 3.14
img = CreateImage(#PB_Any, Width, Height)
If img
If StartDrawing(ImageOutput(img))
MaxX = Width - 1
MaxY = Height - 1
For x = 0 To MaxX
For y = 0 To MaxY
noise = PerlinNoiseProcessing::Noise3D(x / Width, y / Height, time)
b = 255 * noise
Plot(x, y, b << 16 | b << 8 | b)
Next
Next
StopDrawing()
EndIf
EndIf
ProcedureReturn img
EndProcedure
Define PerlinImage.i
PerlinImage = ShowTurbulence(320, 240)
If PerlinImage
OpenWindow(0, 0, 0, 320, 240, "Perlin Noise", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
ImageGadget(0, 0, 0, 320, 240, ImageID(PerlinImage))
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
CompilerEndIf
This ShowTurbulence was straight stolen from other Perlin noise function on the forum


viewtopic.php?f=12&t=41553&hilit=perlin+noise
Don't really know what I'm doing, so bugs, be warned!
