Fast noise generation module

[pjay]

Fast(er) generation of noise maps (Perlin / Value / Simplex) utilizing the GPU.

It's Windows only as I don't use any other OS; if anyone can provide the required adjustments then I'll make the necessary changes, thanks.

See code & example for usage.

Code: Select all

; Perlin module v1.0 - Phil James 2023 - Windows x64
;  - Fast perlin noise generation, utilizes GPU for creation;
;  - Filename: "Fast Noise Module.pbi"

; Commands: 
;  Perlin::Init(Width, Height, [x = -1, y = -1])  Initialize environment with Width & Height.
;          - Add X & Y co'ords in order to display opengl gadget (hidden otherwise).
;  Perlin::Generate(Seed.i = 0, Scale.f = 1.0, x.f = 0, y.f = 0, z.f = 0, Frequency.a = 1, Octaves.a = 6, Lacunarity.f = 2.5, Method = 0, Type = 0)
;  Perlin::Get_Image() ; returns a PB image with the currently generated Perlin Noise
;  Perlin::Get_Array(array arr.a(2)) ; fills a 2d pb ascii (.a) array with the currently generated Perlin Noise
;  Perlin::Finish(); call at program end to ensure proper release of GL assets.

DeclareModule Perlin
  Structure Perlin
    IsInit.a : Gadget.i : Program.i : Width.i : Height.i
    luOffset.i : luTime.i : luOctaves.i : luLacunarity.i : luMethod.i : luType.i
  EndStructure
  Define Parameters.perlin
  Declare Init(w = 512, h = 512, x = -1, y = -1)
  Declare Generate(Seed.i = 0, Scale.f = 1.0, x.f = 0.5, y.f = 0.5, z.f = 0, Octaves.a = 6, Lacunarity.f = 2.0, Method.a = 0, Type.a = 0)

  Declare Finish() 
  Declare Get_Array(Array arr.a(2))
  Declare Get_Image()
  
  ;{ GL enumerates and extension prototypes
  #GL_FRAGMENT_SHADER = $8B30 : #GL_VERTEX_SHADER = $8B31
  Prototype glUniform1f(location.l, v0.f): Global glUniform1f.glUniform1f
  Prototype glUniform2f(location.l, v0.f, v1.f): Global glUniform2f.glUniform2f
  Prototype glUniform1i(location.l, v0.l): Global glUniform1i.glUniform1i
  Prototype.l glGetUniformLocation(program.i, name.p-ascii): Global glGetUniformLocation.glGetUniformLocation
  Prototype glUseProgram(program.l) : Global glUseProgram.glUseProgram
  Prototype.l glCreateShader(type.l) : Global glCreateShader.glCreateShader
  Prototype glShaderSource(shader.l, count.l, *stringBuffer, *length) : Global glShaderSource.glShaderSource
  Prototype glCompileShader(shader.l): Global glCompileShader.glCompileShader
  Prototype.l glCreateProgram() : Global glCreateProgram.glCreateProgram
  Prototype glAttachShader(program.l, shader.l): Global glAttachShader.glAttachShader
  Prototype glLinkProgram(program.l): Global glLinkProgram.glLinkProgram
  Prototype glDeleteProgram(program.l): Global glDeleteProgram.glDeleteProgram
  Prototype glDeleteShader(shader.l): Global glDeleteShader.glDeleteShader
  ;}
EndDeclareModule
Module Perlin
  EnableExplicit
  Macro GetGLExt(var, extname)
    var = wglGetProcAddress_(extname) : If Var = 0 : MessageRequester("Error..","Required extension: "+extname +" returned null") : End : EndIf
  EndMacro

  Procedure _Shader_Compile_Link(Vertex.s,Fragment.s)
    Protected VertShader, FragShader, *TxtPointer, Program
    VertShader = glCreateShader(#GL_VERTEX_SHADER) : *TxtPointer = Ascii(Vertex)
    glShaderSource(VertShader, 1, @*TxtPointer, #Null) : glCompileShader(VertShader) : FreeMemory(*TxtPointer)
    FragShader = glCreateShader(#GL_FRAGMENT_SHADER) : *TxtPointer = Ascii(Fragment)
    glShaderSource(FragShader, 1, @*TxtPointer, #Null) : glCompileShader(FragShader) : FreeMemory(*TxtPointer)
    Program = glCreateProgram()
    glAttachShader(Program,VertShader) : glAttachShader(Program,FragShader) : glLinkProgram(Program)
    glDeleteShader(VertShader) : glDeleteShader(FragShader)
    ProcedureReturn Program
  EndProcedure
  Procedure _Init() ; Single run only
    Shared Parameters
    Protected Txt.s, Vsh.s, Fsh.s, *Mem = AllocateMemory(8192), *Com = AllocateMemory(8192), Pos.i, MyLoop.i

    ;{ get required gl extensions
    GetGLExt(glCreateShader,"glCreateShader")
    GetGLExt(glUseProgram,"glUseProgram")
    GetGLExt(glShaderSource,"glShaderSource")
    GetGLExt(glGetUniformLocation,"glGetUniformLocation")
    GetGLExt(glUniform1i,"glUniform1i")
    GetGLExt(glUniform1f,"glUniform1f")
    GetGLExt(glUniform2f,"glUniform2f")
    GetGLExt(glCompileShader,"glCompileShader")
    GetGLExt(glCreateProgram,"glCreateProgram")
    GetGLExt(glAttachShader,"glAttachShader")
    GetGLExt(glDeleteShader,"glDeleteShader")
    GetGLExt(glLinkProgram,"glLinkProgram")
    GetGLExt(glDeleteProgram,"glDeleteProgram") ;}
    
    ;{ unpack and compile shader program - get uniforms
    
    UseZipPacker()

    Read.s Txt ;/ Perlin shader
    Txt.s = PeekS(*com,UncompressMemory(*Mem,Base64Decoder(Txt,*Mem,8192),*com,8192,#PB_PackerPlugin_Zip),#PB_Ascii)
    Vsh = ReplaceString(StringField(txt,1,#CRLF$),#CR$,#CRLF$)
    Fsh = ReplaceString(StringField(txt,4,#CRLF$),#CR$,#CRLF$)
    Parameters\Program = _Shader_Compile_Link(Vsh,Fsh)
    Parameters\luOffset = glGetUniformLocation(Parameters\Program,"uOffset")
    Parameters\luTime = glGetUniformLocation(Parameters\Program,"uTime")
    Parameters\luOctaves = glGetUniformLocation(Parameters\Program,"uOctaves")
    Parameters\luLacunarity = glGetUniformLocation(Parameters\Program,"uLacunarity")
    Parameters\luMethod = glGetUniformLocation(Parameters\Program,"uNoiseMethod")
    Parameters\luType = glGetUniformLocation(Parameters\Program,"uNoiseType")
    ;}

    Parameters\IsInit = #True
  EndProcedure
  Procedure _IsValid()
    Shared Parameters
    If IsGadget(Parameters\Gadget)
      If GadgetType(Parameters\Gadget) = #PB_GadgetType_OpenGL : ProcedureReturn #True : EndIf
    EndIf
    ProcedureReturn #False
  EndProcedure
  Procedure Finish()
    Shared Parameters
    If Parameters\IsInit = #True : glDeleteProgram(Parameters\Program) : FreeGadget(Parameters\Gadget) : EndIf
  EndProcedure
  Procedure Get_Image()
    Define image : Shared Parameters
    If Not _IsValid() : ProcedureReturn : EndIf
    image = CreateImage(#PB_Any,Parameters\Width,Parameters\Height,32)
    If IsImage(image)
      StartDrawing(ImageOutput(image))
      glReadBuffer_(#GL_FRONT)
      glReadPixels_(0,0,OutputWidth(),OutputHeight(),#GL_BGRA_EXT,#GL_UNSIGNED_BYTE,DrawingBuffer())
      StopDrawing()
      ProcedureReturn image
    EndIf
  EndProcedure
  Procedure Get_Array(Array arr.a(2))
    Shared Parameters
    If Not _IsValid() : ProcedureReturn : EndIf
    If ArraySize(arr(),1) <> Parameters\Height-1 Or ArraySize(arr(),2) <> Parameters\Width-1
      Dim arr.a(Parameters\Height-1,Parameters\Width-1) ; in case passed-in array has wrong dimensions
    EndIf
    glReadBuffer_(#GL_FRONT) : glPixelStorei_(#GL_PACK_ROW_LENGTH,0)
    glReadPixels_(0,0,Parameters\Width,Parameters\Height,#GL_RED,#GL_UNSIGNED_BYTE,@arr())
  EndProcedure
  Procedure Init(w = 512, h = 512, x = -1, y = -1) ; initialize gl gadget & parameters
    Shared Parameters
    If Parameters\IsInit = #False
      Parameters\Gadget = OpenGLGadget(#PB_Any,x,y,w / DesktopResolutionX(),h/ DesktopResolutionY(),#PB_OpenGL_NoDepthBuffer|#PB_OpenGL_NoAccumulationBuffer|#PB_OpenGL_NoStencilBuffer|#PB_OpenGL_NoFlipSynchronization)
      Parameters\Width = W : Parameters\Height = H 
      glOrtho_(-1,1,1,-1,-1,1) : glDisable_(#GL_DEPTH_TEST) ;: glEnable_(#GL_CULL_FACE) : glCullFace_(#GL_BACK)
      If x = -1 And y = -1 : HideGadget(Parameters\Gadget,1) : EndIf
      _Init() ; get extensions and compile shader
      Perlin::Generate()
    EndIf
  EndProcedure
  Procedure Generate(Seed.i = 0, Scale.f = 1.0, x.f = 0.5, y.f = 0.5, z.f = 0, Octaves.a = 6, Lacunarity.f = 2.0, Method.a = 0, Type.a = 0)
    Shared Parameters 
    If Not _IsValid() : ProcedureReturn : EndIf
    SetGadgetAttribute(Parameters\Gadget,#PB_OpenGL_SetContext,#True)
    glDrawBuffer_(#GL_FRONT)
    glUseProgram(Parameters\Program)
    glUniform2f(glGetUniformLocation(Parameters\Program,"uResolution"),Parameters\Width * Scale,Parameters\Height * Scale)
    RandomSeed(Seed) ; seed is spoofed as a random offset on x & y
    glUniform2f(Parameters\luOffset,x + (Random(10000)/100.0),y + (Random(10000)/100.0))
    glUniform1f(Parameters\luTime,z)
    glUniform1i(Parameters\luOctaves,Octaves)
    glUniform1f(Parameters\luLacunarity,Lacunarity)
    glUniform1i(Parameters\luMethod,Method)
    glUniform1i(Parameters\luType,Type)
    glBegin_(#GL_QUADS) : glVertex2f_(-1,-1) : glVertex2f_(1,-1) : glVertex2f_(1,1) : glVertex2f_(-1,1) : glEnd_()
    glFlush_() : glFinish_()
    glUseProgram(0)
  EndProcedure
  
  DataSection ; Perlin glsl Shader:
    Data.s "eNrFV0tz2zYQvneG/wEzvpAWDXMJPeywOaXTS5q408ndw4ighSlFsiQlS8r4v2cXIClQr9SZTi1bfGAXu9/utwIWV2tZ1arImRCB42Txtlg1zM2KedzQ6HsWeEzlbC3nISuLOnKcdaEStoxV7nrsm8Oessc/i1q12qg3dlHPZwEPUp+BFzkvjvML/V0NXK1ylRbV0lhe/SXrIluRkaiXpFkRN2z1RS3lflDlOPS5ULX8JJtFkZySfNmW8sjMH/F8lceVarYHUx7mTbyWdXSA6CFNa9lEDuWDomL48KHIiopSIOeCLeJ68ZAlQrj6tfS+Mac0KRAuS4rGLX39DOGMgy8A+MxnszGfeZ5vy8PpPZ/4cCe48MPxlMOBHECgPJwBv/chHPOp52FWK9msqpzdAA/YiIV4vWZpFc8bt0ZqSu96LGaTOz4ZTwSEwouQBZOJDjf0uDsBgr8M+0deF0deifyrRKYql+zTw2/CZIdDIMDnGNj0Hm9idjfzLHQ9NIHYSoGwjAt8vNZW0C4+j1q4wkdNvt1tEBHcc7i/iBP1OWnSFA9H8b7T2elJ7Rl9lfvNbvRj5zr6AYJr8u8zPTbSWGhka0a2+5GNZ1G4jrOVfMyp1vckmgdFcLOiqLAEonYsxbGS3aCwHXmmgZSCp4srEOFNi7NM9wEs1cZ16ELflhh0MDIkBvgbx38q1iMZ7GXPCN2/YAAuGIDeAF53nn8RDFwAA/8GDFwAA8dgnpE9Xd+Gk1JWmcr/H1I0MfpJV2CKigNK/K6OT7CFQocNp8H5abCfpkM/7xXOe4ULXuG8V+i9Dsk/8g7nY4Y+5iPncD5ksEM+5xLOu4TzLuG8y4N4D+qrVssyk5vDApsXed20e9xHoP2ai+4TDaWhlsLUfGZt2Vm1iXDc0ixNfKuvO1ohP0JXtEnQFq2r9EXrKq2rWt2w05WoWjeyNGsedgO0qVFJJwGt1Z2aIsySCh50wUu+22x7IUG2xi21HhLN13ZdNHWjtW0YSbiXh/0PypKLXm4si4HCWO+Ky3iDEUwNk2NdDUlA4bQbdYLsJdC9hHgPuxfcHRJB1UAZaE1So7RAJ/Z3YLgtEOVZ9rsxynXfIZAvWxB6ll9LgKHZTQNpaIcCuIApzsmt3UVX2GO9Wh42CKkuIMSXVvIfw0wQ6Z6nxAjGHF9Uytx9E8be6/4R5xcV5h+7Laq2IMLbr/vGi6nRiHzQjqotXw8XUzIeUvYYubIaOVKMHDOFkE2iF9aFmEbs5QQa+Bk09nb7CjDMRnMKTPgzYIbrQPl6IMc8P8Zf67fjmpyf5PvtCNf5OEH627FOiA6Z/6+of6TW/QT9w/qgzoVGSZkalAmf6C1io58DvfROtM7oWGl7oGQlyCzDT7L53G1sePha961TUXdHqtXaLJOha50W+ebWfsO+GfROo0+N7JaBWXbboCKnflbNfNFRYo6QxMc8riUL3g3jpoOsF32tZPx3ZDTg3anMHGqFJ7R0krXmSxe9joqyFOgsBTozL4cHbHPyNkkIXTxt/17FTx9wv0bct2yQii39QDH7/dlVp3BeZDi7TzDx2B1luwM7qpjEER/fAe4vggI="    
  EndDataSection
EndModule

CompilerIf #PB_Compiler_IsMainFile ;- demo code
  Enumeration ;/ windows / image / gadget
    #MyWindow_Main : #MyGad_Canvas = 0
    #MyGad_Seed_Txt : #MyGad_Seed_Slider : #MyGad_Seed_Value
    #MyGad_Scale_Txt : #MyGad_Scale_Slider : #MyGad_Scale_Value
    #MyGad_X_Txt : #MyGad_X_Slider : #MyGad_X_Value
    #MyGad_Y_Txt : #MyGad_Y_Slider : #MyGad_Y_Value
    #MyGad_Z_Txt : #MyGad_Z_Slider : #MyGad_Z_Value
    #MyGad_Animate_Checkbox
    #MyGad_Lacunarity_Txt : #MyGad_Lacunarity_Slider : #MyGad_Lacunarity_Value
    #MyGad_Octaves_Txt : #MyGad_Octaves_Slider : #MyGad_Octaves_Value
    
    #MyGad_NoiseMethod_Txt : #MyGad_NoiseMethod_Slider : #MyGad_NoiseMethod_Value
    #MyGad_NoiseType_Txt : #MyGad_NoiseType_Slider : #MyGad_NoiseType_Value
  EndEnumeration
  
  #App$ = "Fast Perlin Noise demo 1: Phil James 2023"
  ;Global Event, PerlinZ.f, Time.f, ToolWidth = 320, Width = 1024, Height = 768, Y,Refresh = #True, Image.i
  Global Event, PerlinZ.f, Time.f, ToolWidth = 320, Width = 1920, Height = 1080, Y,Refresh = #True, Image.i
  Global Seed, scale.f, px.f, py.f, pz.f, Octaves, Type.a, Method.a, lacunarity.f, apz.f
  
  OpenWindow(#MyWindow_Main,0,0, (Width / DesktopResolutionX()) + ToolWidth + 4, (Height + 4) / DesktopResolutionY(), #App$,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
  AddWindowTimer(#MyWindow_Main,0,16)
  LoadFont(0,"Tahoma",14) : SetGadgetFont(#PB_Default,FontID(0))
  
  Y = 4
  TextGadget(#MyGad_Seed_Txt,4,Y,80,32,"Seed:") : TrackBarGadget(#MyGad_Seed_Slider,84,Y+2,160,32,0,9999) : TextGadget(#MyGad_Seed_Value,250,Y,70,32,"") : Y + 32
  TextGadget(#MyGad_Scale_Txt,4,Y,80,32,"Scale:") : TrackBarGadget(#MyGad_Scale_Slider,84,Y+2,160,32,100,50000) : TextGadget(#MyGad_Scale_Value,250,Y,70,32,"") : Y + 32
  SetGadgetState(#MyGad_Scale_Slider,5000)
  TextGadget(#MyGad_X_Txt,4,Y,80,32,"X:") : TrackBarGadget(#MyGad_X_Slider,84,Y+2,160,32,0,1000) : TextGadget(#MyGad_X_Value,250,Y,70,32,"") : Y + 32
  TextGadget(#MyGad_Y_Txt,4,Y,80,32,"Y:") : TrackBarGadget(#MyGad_Y_Slider,84,Y+2,160,32,0,1000) : TextGadget(#MyGad_Y_Value,250,Y,70,32,"") : Y + 32
  TextGadget(#MyGad_Z_Txt,4,Y,80,32,"Z:") : TrackBarGadget(#MyGad_Z_Slider,84,Y+2,160,32,0,10000) : TextGadget(#MyGad_Z_Value,250,Y,70,32,"") : Y + 32
  CheckBoxGadget(#MyGad_Animate_Checkbox,84,Y,180,32,"Animate Z (time)?") : Y + 42
  SetGadgetState(#MyGad_Animate_Checkbox,1)
  TextGadget(#MyGad_Octaves_Txt,4,Y,80,32,"Octaves:") : TrackBarGadget(#MyGad_Octaves_Slider,84,Y+2,160,32,1,8) : TextGadget(#MyGad_Octaves_Value,250,Y,70,32,"") : Y + 32
  SetGadgetState(#MyGad_Octaves_Slider,6)
  TextGadget(#MyGad_Lacunarity_Txt,4,Y,112,32,"Lacunarity:") : TrackBarGadget(#MyGad_Lacunarity_Slider,114,Y+2,130,32,100,250) : TextGadget(#MyGad_Lacunarity_Value,250,Y,70,32,"") : Y + 32
  SetGadgetState(#MyGad_Lacunarity_Slider,200)
  
  TextGadget(#MyGad_NoiseMethod_Txt,4,Y,112,32,"Method:") : TrackBarGadget(#MyGad_NoiseMethod_Slider,84,Y+2,130,32,0,2) : TextGadget(#MyGad_NoiseMethod_Value,220,Y,90,32,"") : Y + 32
  GadgetToolTip(#MyGad_NoiseMethod_Slider,"Standard / Abs / Exp(Abs)")
  TextGadget(#MyGad_NoiseType_Txt,4,Y,112,32,"Type:") : TrackBarGadget(#MyGad_NoiseType_Slider,84,Y+2,130,32,0,2) : TextGadget(#MyGad_NoiseType_Value,220,Y,90,32,"") : Y + 32
  GadgetToolTip(#MyGad_NoiseType_Slider,"0: Perlin  -  1: Value  -  2: Simplex")

  Macro SetGadgetText_(gadget,txt) ; deflicker ui update when not handling updates individually
    If GetGadgetText(gadget) <> txt : SetGadgetText(gadget,txt) : EndIf
  EndMacro
  
  Perlin::Init(Width,Height,ToolWidth,0)
  
  Repeat
    Event = WaitWindowEvent()
    Select Event
      Case #PB_Event_CloseWindow : Perlin::Finish() : End
      Case #PB_Event_Gadget
        Refresh = #True
      Case #PB_Event_Timer : If GetGadgetState(#MyGad_Animate_Checkbox) : apz + 0.01 : Refresh = #True : EndIf
    EndSelect
    
    If Refresh = #True
      Refresh = #False
      Seed = GetGadgetState(#MyGad_Seed_Slider) : SetGadgetText_(#MyGad_Seed_Value,Str(Seed))
      Scale = GetGadgetState(#MyGad_Scale_Slider) / 5000.0 : SetGadgetText_(#MyGad_Scale_Value,StrF(Scale,3))
      px = GetGadgetState(#MyGad_X_Slider) / 100.0 : SetGadgetText_(#MyGad_X_Value,StrF(px,2))
      py = GetGadgetState(#MyGad_Y_Slider) / 100.0 : SetGadgetText_(#MyGad_Y_Value,StrF(py,2))
      pz = GetGadgetState(#MyGad_Z_Slider) / 1000.0 : SetGadgetText_(#MyGad_Z_Value,StrF(pz,3))
      If GetGadgetState(#MyGad_Animate_Checkbox) : pz = apz : EndIf
      Octaves = GetGadgetState(#MyGad_Octaves_Slider) : SetGadgetText_(#MyGad_Octaves_Value,Str(Octaves))
      lacunarity = GetGadgetState(#MyGad_Lacunarity_Slider) / 100.0 : SetGadgetText_(#MyGad_Lacunarity_Value,StrF(lacunarity,2))
      Type = GetGadgetState(#MyGad_NoiseType_Slider)
      Select Type
        Case 0 : SetGadgetText_(#MyGad_NoiseType_Value,"Perlin")
        Case 1 : SetGadgetText_(#MyGad_NoiseType_Value,"Value")
        Case 2 : SetGadgetText_(#MyGad_NoiseType_Value,"Simplex")
      EndSelect
      Method = GetGadgetState(#MyGad_NoiseMethod_Slider) 
      Select Method
        Case 0 : SetGadgetText_(#MyGad_NoiseMethod_Value,"Standard")
        Case 1 : SetGadgetText_(#MyGad_NoiseMethod_Value,"Abs()")
        Case 2 : SetGadgetText_(#MyGad_NoiseMethod_Value,"Abs(Sin())")
      EndSelect
        
      time = ElapsedMilliseconds()
      Perlin::Generate(Seed,Scale,px,py,pz,Octaves,lacunarity,Method,Type)
      time = ElapsedMilliseconds() - Time
      SetWindowTitle(#MyWindow_Main, #App$ + " - Perlin Noise Generation time: "+Str(time)+" ms")
    EndIf
  ForEver
CompilerEndIf

Demo:

Code: Select all

; Perlin module demo 2 - Phil James 2023
EnableExplicit

XIncludeFile "..\Includes\Fast Noise Module.pbi"

Enumeration ;/ windows / image / gadget
  #MyWindow_Main : #MyGad_Canvas = 0
EndEnumeration

#Width = 1280 : #Height = 600 : #App$ = "Perlin Noise demo 2: PJames 2023"

Define Event, x, y, tf.f, col, px, t,Refresh = #True, z.f

OpenWindow(#MyWindow_Main,0,0, #Width / DesktopResolutionX(), #Height/ DesktopResolutionY(), #App$,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
CanvasGadget(#MyGad_Canvas,0, 0, #Width / DesktopResolutionX(), #Height / DesktopResolutionY())
CreateImage(0,#Width,#Height,32)
AddWindowTimer(0,0,15)

; load colours from datasection and create expanded lookup
Dim rgblup.l(8) : CopyMemory(?pal0rgba,@rgblup(),8 * SizeOf(long)) : Dim rgblup2.l(255)
For x = 0 To 255 : y = Round(x / 32,#PB_Round_Down) : t = x % 32
  tf.f = (1.0 / 32.0) * t : tf + 0.45 : If tf > 1.0 : tf = 1.0 : EndIf : If y = 0 : tf = 1.0 : t = 1 : EndIf
  If t = 0 : col = 0 : Else : col = RGB(Red(rgblup(y)) * tf,Green(rgblup(y)) * tf, Blue(rgblup(y)) * tf) : EndIf
  rgblup2(x) = col
Next

Perlin::Init(#Width,#Height) ; initialize the perlin environment

Dim arr.a(#Height-1,#Width-1) ; array to grab the noise data into
Dim img.l(#height-1,#width-1) ; array to hold colourized noise data

Repeat
  Event = WaitWindowEvent()
  Select Event
    Case #PB_Event_CloseWindow : Perlin::Finish() : End
    Case #PB_Event_Timer : z + 0.005 : Refresh = #True
  EndSelect
  
  If Refresh = #True : Refresh = #False
    Perlin::Generate(1, 3.0, 0, 0, z, 2, 1.0, 0, 2) ; generate noise
    Perlin::Get_Array(arr())                        ; grab noise into arr() array
    
    ;/ create image array from noise array
    For y = 0 To #Height - 1 : For x = 0 To #Width - 1 : img(y,x) = rgblup2(arr(y,x)) : Next : Next
    
    ;/ draw image array into pb image, then display image on canvas
    StartDrawing(ImageOutput(0)) : CopyMemory(@img(),DrawingBuffer(),#width*#height*4) : StopDrawing()
    StartDrawing(CanvasOutput(#MyGad_Canvas)) : DrawImage(ImageID(0),0,0) : StopDrawing()
  EndIf
ForEver

DataSection
  pal0RGBA:  ; argb
  Data.l $ffFFB647, $ffFE8C50, $ffFA5C53, $ffF93E69, $ffE1307E, $ffC32294, $ff9815A3, $ff6610b1
EndDataSection

[jacdelad]

Very, very nice! Thanks for sharing!!

[Caronte3D]

Very fast! Thanks!

[BillBoard_67]

Hello pjay,

Thanks a lot for this nice piece of code.

I haven't tested it yet. I'm still studying your code line by line and i think that the solution to my initial problem is in your procedures get_image and get_array with the use of glReadBuffer_, glPixelStorei_ and glReadPixels_. Very smart solution
+ the use of wglGetProcAddress to return the address of OpenGL extension functions needed in your program .

A little Gem !!!

[pf shadoko]

great!

is there any way to see the shader in clear ?

[Fred]

You can put 'Debug Txt' afte the line:

Code: Select all

Txt.s = PeekS(*com,UncompressMemory(*Mem,Base64Decoder(Txt,*Mem,8192),*com,8192,#PB_PackerPlugin_Zip),#PB_Ascii)

and it should display it

[Michael Vogel]

Wonderful, when converting these results to seemless tiles they will be perfect wallpapers for the desktop

[BillBoard_67]

Hi everyone,

@pf Shadoko : To complete Fred's answer, here is the shader code (in GLSL)


#version 330

layout (location = 0) in vec2 pos;

void main() {
gl_Position = vec4(pos, 0.0f, 1);
}

#version 330

uniform vec2 uResolution;
uniform float uTime;
uniform int uNoiseMethod;
uniform int uNoiseType;
uniform float uLacunarity;
uniform int uOctaves;
uniform vec2 uOffset;
out vec4 outColor;

vec3 hashOld33(vec3 p){
p = vec3( dot(p,vec3(127.1,311.7, 74.7)), dot(p,vec3(269.5,183.3,246.1)), dot(p,vec3(113.5,271.9,124.6)));
return -1.0 + 2.0 * fract(sin(p)*43758.5453123);}

float hashOld31(vec3 p){
float h = dot(p,vec3(127.1,311.7, 74.7));
return -1.0 + 2.0 * fract(sin(h)*43758.5453123);
}

#define MOD3 vec3(.1031,.11369,.13787)
float hash31(vec3 p3){
p3 = fract(p3 * MOD3);
p3 += dot(p3, p3.yzx + 19.19);
return -1.0 + 2.0 * fract((p3.x + p3.y) * p3.z);}

vec3 hash33(vec3 p3){
p3 = fract(p3 * MOD3);
p3 += dot(p3, p3.yxz+19.19);
return -1.0 + 2.0 * fract(vec3((p3.x + p3.y)*p3.z, (p3.x+p3.z)*p3.y, (p3.y+p3.z)*p3.x));}

float value_noise(vec3 p){
vec3 pi = floor(p);
vec3 pf = p - pi;
vec3 w = pf * pf * (3.0 - 2.0 * pf);
return mix(
mix(mix(hash31(pi + vec3(0, 0, 0)), hash31(pi + vec3(1, 0, 0)), w.x),mix(hash31(pi + vec3(0, 0, 1)), hash31(pi + vec3(1, 0, 1)), w.x), w.z),
mix(mix(hash31(pi + vec3(0, 1, 0)), hash31(pi + vec3(1, 1, 0)), w.x),mix(hash31(pi + vec3(0, 1, 1)), hash31(pi + vec3(1, 1, 1)), w.x), w.z),w.y);
}

float perlin_noise(vec3 p){
vec3 pi = floor(p);
vec3 pf = p - pi;
vec3 w = pf * pf * (3.0 - 2.0 * pf);
return mix(mix(
mix(dot(pf - vec3(0, 0, 0), hash33(pi + vec3(0, 0, 0))),
dot(pf - vec3(1, 0, 0), hash33(pi + vec3(1, 0, 0))),w.x),
mix(dot(pf - vec3(0, 0, 1), hash33(pi + vec3(0, 0, 1))),
dot(pf - vec3(1, 0, 1), hash33(pi + vec3(1, 0, 1))),w.x),w.z),
mix(mix(dot(pf - vec3(0, 1, 0), hash33(pi + vec3(0, 1, 0))),
dot(pf - vec3(1, 1, 0), hash33(pi + vec3(1, 1, 0))),w.x),mix(dot(pf - vec3(0, 1, 1), hash33(pi + vec3(0, 1, 1))),
dot(pf - vec3(1, 1, 1), hash33(pi + vec3(1, 1, 1))),w.x),w.z),w.y);
}

float simplex_noise(vec3 p){
const float K1 = 0.333333333;
const float K2 = 0.166666667;
vec3 i = floor(p + (p.x + p.y + p.z) * K1);
vec3 d0 = p - (i - (i.x + i.y + i.z) * K2);
vec3 e = step(vec3(0.0), d0 - d0.yzx);
vec3 i1 = e * (1.0 - e.zxy);
vec3 i2 = 1.0 - e.zxy * (1.0 - e);
vec3 d1 = d0 - (i1 - 1.0 * K2);
vec3 d2 = d0 - (i2 - 2.0 * K2);
vec3 d3 = d0 - (1.0 - 3.0 * K2);
vec4 h = max(0.6 - vec4(dot(d0, d0), dot(d1, d1), dot(d2, d2), dot(d3, d3)), 0.0);
vec4 n = h * h * h * h * vec4(dot(d0, hash33(i)), dot(d1, hash33(i + i1)), dot(d2, hash33(i + i2)), dot(d3, hash33(i + 1.0)));
return dot(vec4(31.316), n);}

float noise_sum(vec3 p){
float f = 0.0, freq = 1.00;
p = p * 4.0;
if (uNoiseType == 0) {
for (int i = 0; i < uOctaves; i++){
f += freq * perlin_noise(p * 2.0); p = uLacunarity * p;
freq *= 0.5;}
return f; }
if (uNoiseType == 1) {
for (int i = 0; i < uOctaves; i++){
f += freq * value_noise(p * 2.0); p = uLacunarity * p;
freq *= 0.5; }
return f;}
if (uNoiseType == 2) {
for (int i = 0; i < uOctaves; i++){
f += freq * simplex_noise(p); p = uLacunarity * p;
freq *= 0.5; }
return f;}}

float noise_sum_abs(vec3 p){
float f = 0.0, freq = 1.00;
p = p * 4.0;
if (uNoiseType == 0) {
for (int i = 0; i < uOctaves; i++){
f += freq * abs(perlin_noise(p * 2.0)); p = uLacunarity * p;
freq *= 0.5;}
return f; }
if (uNoiseType == 1) {
for (int i = 0; i < uOctaves; i++){
f += freq * abs(value_noise(p * 2.0)); p = uLacunarity * p;
freq *= 0.5; }
return f;}
if (uNoiseType == 2) {
for (int i = 0; i < uOctaves; i++){
f += freq * abs(simplex_noise(p)); p = uLacunarity * p;
freq *= 0.5; }
return f;}}

float noise_sum_abs_sin(vec3 p){
float f = noise_sum_abs(p);
f = sin(f * 5.5 + p.x * 5.0 - 1.5);
f += sin(f * 5.5 + p.y * 5.0 - 1.5);
return f;}

vec3 getNoise(vec2 uv){
vec3 pos = vec3(uv * vec2(uResolution.x/uResolution.y, 1.0), uTime / 10.0);
float f;
switch (uNoiseMethod) {
case 0: f = noise_sum(pos);break;
case 1: f = noise_sum_abs(pos);break;
case 2: f = noise_sum_abs_sin(pos);}
return vec3(f * 0.5 + 0.5);
}

void main() {
vec2 p = vec2(gl_FragCoord) / uResolution.xy;
p += uOffset;
vec3 col = getNoise(p);
outColor = vec4(col, 1.0);}


This code is 'Base64' encoded and compressed in the code of pjay