Procedural Noise

**Charles Pegge** · 16-12-2010, 14:43

It is very useful to have an efficient noise generator for creating textures and height maps. You can feed an ordered series of numbers (eg 1,2,3,4) to the noise function and be sure to get a chaotic but entirely deterministic series in return. Unlike a RND function, the noise function has no memory of its previous seeded state.

I found this one works well:

  '----------------------------
  Function Noiseb(sys i) As sys
  '============================
  mov eax,i
  xor eax,35353535
  imul eax,eax
  ror eax,17
  imul eax,eax
  ror eax,7
  and eax,255 'byte mask
  mov _return,eax
  End Function

Here is a demo using Oxygen and TBGL

' Oxygen Texture generation with procedural noise
' Charles Pegge 2010
'
' Using example of rendering colored, lighted and textured shape with GBuffers
' Petr Schreiber, 2010


Uses "TBGL", "Oxygen"

Begin Const
  %tBricks = 1
End Const

Function TBMAIN()
  Local i,j,k     As Long
  Local hWnd      As DWord
  Local FrameRate As Double
  
  ' -- Create and show window
  hWnd = TBGL_CreateWindowEx("GBuffers: textured shape press ESC to quit", 640, 480, 32, %TBGL_WS_WINDOWED Or %TBGL_WS_CLOSEBOX) 
  TBGL_ShowWindow   
  
  TBGL_BackColor 255,255,255,255
  
  ' -- Load texture
  'TBGL_LoadTexture APP_SourcePath+"bricks.bmp", %tBricks, %TBGL_TEX_MIPMAP
  

  
  
  '=======
  'TEXTURE
  '=======   
  
  Dim Texture(65536*4) As tbgl_tRGBA
  '
  '----------------------------------------
  'OXYGEN COMPILE & EXEC TEXTURE GENERATION
  '----------------------------------------
  '
  dim src as string
  src="
  basic 

  '------------------------------
  Function Noise(sys i) As Single
  '==============================
  Static As Single f, d=1/0x7fffffff
  mov eax,i
  xor eax,35353535
  imul eax,eax
  ror eax,17
  imul eax,eax
  ror eax,7
  push eax
  fild dWord [esp]
  add esp,4
  fmul dWord d
  fstp dWord _return
  End Function

  '----------------------------
  Function Noiseb(sys i) As sys
  '============================
  mov eax,i
  xor eax,35353535
  imul eax,eax
  ror eax,17
  imul eax,eax
  ror eax,7
  and eax,255 'byte mask
  mov _return,eax
  End Function


  type rgba  r as byte, g as byte, b as byte, a as byte
  dim axrng,x,y,r,sc,stp as double
  dim px,py,p as long
  dim n as long
  dim v as long 'byte
  dim as rgba  tex at p : p=#texture 'LINK TO THINBASIC Texture()
  axrng=10 : sc=255 : stp=0.04
  y=-axrng


  for py=1 to 512
    x=-axrng
    for px=1 to 512
      v=noiseb(n)
      tex.r=v
      tex.g=v
      tex.b=v
      n+=1
      p+=sizeof tex 'ADVANCE TEXTURE ARRAY POINTER
    Next
    'y+=stp
  Next
  "
  '
  'msgbox 0,o2_prep src
  o2_asmo src
  if len(o2_error) then
    msgbox 0,o2_error
    stop
  else
    o2_exec
  end if
  '
  
  Local TexString As String = Peek$(VarPtr(Texture(1)), 65536*4*SizeOf(tbgl_tRGBA))
  
  
  
  ' Making BMP file from TexString variable, size 512*512, to slot #2 with 16x anisotropic filtering 
  TBGL_MakeTexture TexString, %TBGL_DATA_RGBA, 512, 512, 2, %TBGL_TEX_ANISO, 16 

  ' -- Create 3D triangle buffer
  Dim gbQuad As DWord = TBGL_GBufferCreate(%TBGL_Quads, %TBGL_3D)
  
  ' -- Define data for it
  Dim VertexA(4)    As TBGL_tVector3F
  Dim ColorA(4)     As TBGL_tRGBA   
  Dim NormalA(4)    As TBGL_tVector3F   
  Dim TexCoordA(4)  As TBGL_tVector2F
  
  ' -- Vertices
  VertexA(1).x = -1
  VertexA(1).y = -1
  VertexA(1).z =  0
  
  VertexA(2).x =  1
  VertexA(2).y = -1     
  VertexA(2).z =  0  
  
  VertexA(3).x =  1
  VertexA(3).y =  1
  VertexA(3).z =  0  

  VertexA(4).x = -1
  VertexA(4).y =  1
  VertexA(4).z =  0  
  
  ' -- Normals
  For i = 1 To 4
    NormalA(i).x = 0
    NormalA(i).y = 0
    NormalA(i).z = 1
  Next   
  
  ' -- Colors
  '
  for i=1 to 4
    ColorA(i).r = 255
    ColorA(i).g = 255
    ColorA(i).b = 255      
    ColorA(i).a = 255
  next
  '
  ' -- Texture coordinates
  For i = 1 To 4
    TexCoordA(i).x = VertexA(i).x
    TexCoordA(i).y = VertexA(i).y
  Next  
  
  ' -- Create buffer dynamically linked to the arrays above
  TBGL_GBufferDefineFromArray(gbQuad, %TBGL_Dynamic, 4, VertexA(1), ColorA(1), NormalA(1), TexCoordA(1))
        
  TBGL_UseLighting(%TRUE)
  TBGL_UseLightSource(%GL_LIGHT0, %TRUE)                
        
  TBGL_UseTexturing(%TRUE)
  TBGL_BindTexture(2)  
  
  'TBGL_UseAlphaTest(%TRUE)    
  'TBGL_AlphaFunc(%TBGL_GREATER, 0.1)
  TBGL_BlendFunc(%GL_DST_ALPHA, %GL_SRC_ALPHA)
  TBGL_UseBlend(%TRUE)         
  
  ' -- Resets status of all keys 
  TBGL_ResetKeyState()

  ' -- Main loop
  While TBGL_IsWindow(hWnd) 
    FrameRate = TBGL_GetFrameRate

    TBGL_ClearFrame 
    TBGL_Camera(0, 0, 5, 0, 0, 0)

    tbgl_pushmatrix
    tbgl_translate 0,0,-1
    tbgl_scale 2,2,1      
    tbgl_GBufferRender(gbQuad)
    tbgl_popmatrix


      ' -- Turn
      'TBGL_Rotate GetTickCount/100, 1, 0, 0
      'TBGL_Rotate GetTickCount/105, 0, 1, 0
      TBGL_Rotate GetTickCount/60, 0, 0, 1
                              
      ' -- Modify Texture coordinates
      '
      For i = 1 To 4
        TexCoordA(i).x = VertexA(i).x*(Sin(GetTickCount/400)*.25+.75)
        TexCoordA(i).y = VertexA(i).y*(cos(GetTickCount/500)*.25+.75)
      Next
  

      ' -- Render it 
      '                             
      tbgl_GBufferRender(gbQuad)           

    TBGL_DrawFrame 

    ' -- ESCAPE key to exit application
    If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then Exit While 

  Wend         
  ' -- Destroying the buffer is not necessary,
  ' -- the garbage collector will take care of it

  ' -- Destroy window
  TBGL_DestroyWindow
End Function

If you have problems running this code - the latest Oxygen is available here:

http://www.thinbasic.com/community/s...iler-Downloads

Charles

**Petr Schreiber** · 16-12-2010, 15:35

Thanks a lot Charles!

After updating Oxygen it worked great here.
The noise generation was very fast, there is no noticeable lag on loading.

Petr

**Lionheart008** · 16-12-2010, 21:13

thanks charles for this nice noise effects that works here with new oxygen update

my question: what's the sense of dimension

65536*4

in

Dim Texture(65536*4) As tbgl_tRGBA

?
I have changed a little the example with another noise effect. I think it's also possible to texture a usual quad cube too, isn't it? nice evening, thanks, frank

**Charles Pegge** · 17-12-2010, 00:50

Many thanks for testing guys.

Since I last produced any examples here, there have been 23 alpha releases. So I could not be sure this would work with an older Oxygen.

To clarify the texture dimensioning: 65536*4 looks a lot better in hexadecimal: &h40000. The noise function is iterated through &h200 x &h200 dwords (RGBA)

You can wrap this texture around any surface from cubes to terrains.

Slight changes to the noise function will yield complex repeating patterns rather than chaos. - something to explore.

Charles