Perlin noise module

Share your advanced PureBasic knowledge/code with the community.
ricardo_sdl
Enthusiast
Enthusiast
Posts: 141
Joined: Sat Sep 21, 2019 4:24 pm

Perlin noise module

Post by ricardo_sdl »

Here is an implementation of Perlin Noise, straight stolen :twisted: from the Processing noise java function:https://github.com/processing/processin ... t.java#L53

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
Usage example: - the code above alread has an example thanks to infratec.

This ShowTurbulence was straight stolen from other Perlin noise function on the forum :twisted: :twisted: , here:
viewtopic.php?f=12&t=41553&hilit=perlin+noise

Don't really know what I'm doing, so bugs, be warned! :wink:
Last edited by ricardo_sdl on Thu Jan 07, 2021 1:54 pm, edited 1 time in total.
You can check my games at:
https://ricardo-sdl.itch.io/
infratec
Always Here
Always Here
Posts: 7619
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Perlin noise module

Post by infratec »

You forgot

Code: Select all

ProcedureReturn Noise(x, y, 0)
And if you use

Code: Select all

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
You can directly include the example in the module pbi file.
So we can simply copy the code in a new file and run it.
ricardo_sdl
Enthusiast
Enthusiast
Posts: 141
Joined: Sat Sep 21, 2019 4:24 pm

Re: Perlin noise module

Post by ricardo_sdl »

Thanks infratec! Changed the code with the fix and your suggestions!
You can check my games at:
https://ricardo-sdl.itch.io/
Post Reply