Perlin Noise Problem

New to FreeBASIC? Post your questions here.
Thorbenn
Posts: 41
Joined: Dec 10, 2011 13:27

Perlin Noise Problem

Postby Thorbenn » Jun 16, 2014 14:54

Hi Guys,

i am trying to translate the tutorial from here to freebasic so i could use this noise generation for my world generator. But eventhough i translated it 1:1 i somehow do not get the results like are shown in the tutorial. Am I doing something wrong because i cannot seem to find my misstake? Would be very nice if someone could help me with this :)

Here the Link from the tutorial
http://devmag.org.za/2009/04/25/perlin-noise/

Here the code from the tut in freebasic:

Code: Select all

'defining how big our Window will be
#Define screenX 640
#Define screenY 480

'declare screen with defined values
ScreenRes screenX, screenY, 32

Function LinearInterpolation(ByVal x1 As Single,ByVal x2 As Single,ByVal t As Double) As Single
   
   Dim result As Single
   result = (x1*(1-t)) + (x2*t)
   Return result
   
End Function

Sub genRandomNoise(map() As Single,ByVal mapX As Integer, ByVal mapY As Integer)
   'just generates Random Noise across the entire Array with values ranging from
   '0 to 1 (example 0.11)
   For i As Integer = 0 To mapX
      For j As Integer = 0 To mapY
         
         Randomize
         map(i,j) = Rnd*1
         
      Next
   Next

End Sub

Sub genSmoothNoise(noise() As Single,smoothNoise() As Single ,ByVal mapX As Integer,ByVal mapY As Integer, ByVal o As Integer)
   
   Dim Period As Integer
   Period = 1 Shl o
   Dim Frequency As Single
   Frequency = 1.0f  / Period
   
   For i As Integer = 0 To mapX
      
      'horizontal Indices
      Dim x1 As Integer
      x1 = (i / Period) * Period
      Dim x2 As Integer
      x2 = (x1+ Period) Mod mapX
      Dim horBlend As Single
      horBlend = (i-x1)* Frequency
      
      For j As Integer = 0 To mapY
         
         'vertical Indices
         Dim y1 As Integer
         y1 = (j / Period)*Period
         Dim y2 As Integer
         y2 = (y1 + Period) Mod mapY
         'calculation of vertical blend
         Dim verBlend As Single
         verBlend = (j-y1)*Frequency
         
         'Interpolate top corners
         Dim topCorners As Single
         topCorners = LinearInterpolation(noise(x1,y1),noise(x2,y1),horBlend)
         
         'Interpolate bottom corners
         Dim bottomCorners As Single
         bottomCorners = LinearInterpolation(noise(x1,y2),noise(x2,y2),horBlend)
         
         
         
         smoothNoise(i,j) = LinearInterpolation(topCorners,bottomCorners,verBlend)
         
      Next
      
   Next

End Sub

Sub layeredNoise(noise() As Single,layerNoise() As Single,ByVal mapX As Integer,ByVal mapY As Integer, ByVal oLayers As Integer)
   'width = mapx
   'height = mapy
   
   Dim As Single tempNoise(0 To mapX,0 To mapY)
   'genRandomNoise(noise(),mapX,mapY)
   Dim As Single smoothNoises(0 To mapX,0 To mapY,0 To oLayers)
   
   For k As Integer = 0 To oLayers-1
      
      genSmoothNoise(noise(),tempNoise(),mapX,mapY,k)
      
      For i As Integer = 0 To mapX
         For j As Integer = 0 To mapY
            smoothNoises(i,j,k) = tempNoise(i,j)
         Next
      Next
      
   Next
   
   Dim As Single amplitude
   amplitude = 1.0f
   Dim As Single totalAmplitude
   totalAmplitude = 0.0f
   Dim As Single persistance
   persistance = 0.5
   
   
   For i As Integer = 0 To mapX
         For j As Integer = 0 To mapY
            layerNoise(i,j) = 0
         Next
      Next
      
   'combine noises to one layer
   Dim o As Integer
   o= oLayers-1
   
   Do
      amplitude *= persistance
      totalAmplitude += amplitude
      
      For i As Integer = 0 To mapX
         For j As Integer = 0 To mapY
            
            layerNoise(i,j) += (smoothNoises(i,j,o) * amplitude)
            
         Next
      Next
   
   o -= 1
   Loop Until o <= 0
   
   
   
   For i As Integer = 0 To mapX
      For j As Integer = 0 To mapY

         layerNoise(i,j) = layerNoise(i,j) /totalAmplitude
         
      Next
   Next
   
End Sub

'the later size of the map
Dim Shared As Integer worldMapX,worldMapY
worldMapX = 640
worldMapY = 480

'creating the 2d arrays needed
Dim Shared As Single worldMap(0 To worldMapX,0 To worldMapY)
Dim Shared As Single hMap(0 To worldMapX,0 To worldMapY)

genRandomNoise(hMap(),worldMapX,worldMapY)

layeredNoise(hMap(),worldMap(),worldMapX,worldMapY,20)

'greyscaleing for printing on screen
Dim Shared As UInteger greyMap(0 To worldMapX,0 To worldMapY)
For i As Integer = 0 To worldMapX
   For j As Integer = 0 To worldMapY
      
      Dim As Integer grey
      grey = Int(255*worldMap(i,j))
      Dim finalcol As UInteger
      finalcol = RGBA(grey,grey,grey,255)
      
      greyMap(i,j) = finalcol
      
   Next
Next


'print the greymap
Dim tempPTR As UInteger Ptr
Dim screenPointer As UInteger Ptr
screenPointer = ScreenPtr     
'lock screen for drawing
ScreenLock
'clear screen
Cls
'declare i and j to use in the for loops
Dim As Integer i, j
'draw to screen from buffer
For i = 0 To screenX
For j = 0 To screenY
    tempPTR = screenPointer + (j * screenX + i)
    *tempPTR = greyMap(i,j)
Next
Next
'unlock screen again
ScreenUnLock

Sleep
End
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

Re: Perlin Noise Problem

Postby frisian » Jun 17, 2014 12:36

Thorbenn

In FB the result of x1 = (i / Period) * Period is equal to i the calculation is not stored in between calculations, to get the result you want add INT to floor the division.

x1 = (i / Period) * Period ==> x1 =INT (i / Period) * Period
y1 = (j / Period)*Period ==> y1 = INT(j / Period)*Period


And try a lower value than 20 in layeredNoise(hMap(),worldMap(),worldMapX,worldMapY,20) for example 6.
Thorbenn
Posts: 41
Joined: Dec 10, 2011 13:27

Re: Perlin Noise Problem

Postby Thorbenn » Jun 17, 2014 12:56

Ah okay. Thank you very much! Works now just like from the Site.
counting_pine
Site Admin
Posts: 6230
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Perlin Noise Problem

Postby counting_pine » Jun 17, 2014 16:14

A more direct translation would be the Integer Division operator, which is '\' instead of '/'.
Thorbenn
Posts: 41
Joined: Dec 10, 2011 13:27

Re: Perlin Noise Problem

Postby Thorbenn » Jun 18, 2014 13:06

Thanks yeah that makes it more direct but casting it to an int makes it faster understandable when flying over the code :)
counting_pine
Site Admin
Posts: 6230
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Perlin Noise Problem

Postby counting_pine » Jun 18, 2014 14:21

Int doesn't actually cast the result, but just rounds it down to a whole number.
It's actually quite a slow operation and '\' should be faster.
I suppose for clarity and speed you could do Int(a\b). Calling Int on an integer returns an integer, in recent versions at least, and should be pretty much a no-op.
Thorbenn
Posts: 41
Joined: Dec 10, 2011 13:27

Re: Perlin Noise Problem

Postby Thorbenn » Jun 18, 2014 18:36

Ah ok thanks for the calrification. I will try all three combinations and check them out comparing speed. A line of comment to clear up what happens in the code won't kill me :p
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

Re: Perlin Noise Problem

Postby frisian » Jun 20, 2014 21:11

Here a somewhat cleaned up and faster version of Thorbenn perlin noise program.

Code: Select all

'defining how big our Window will be
#Define screenX 640
#Define screenY 480

Dim Shared As Integer mapX = screenX - 1
Dim Shared As Integer mapY = ScreenY - 1

Dim Shared As Single smoothNoises()
Dim Shared As Single noise()

'declare screen with defined values
ScreenRes screenX, screenY, 32

#Macro LinearInterpolation(x1, x2, t)
(x1 * (1 - t)) + (x2 * t)
#EndMacro

Sub genRandomNoise()
  'just generates Random Noise across the entire Array with values ranging from
  '0 to 1 (example 0.11)
  Randomize
  For i As Integer = 0 To mapX
    For j As Integer = 0 To mapY

      'Randomize ' ### overkill
      noise(i,j) = Rnd'*1

    Next
  Next

End Sub

Sub genSmoothNoise(ByVal octave As Integer)

  Dim As Integer Period = 1 Shl octave
  Dim As Single Frequency = 1 / Period

  For i As Integer = 0 To mapX

    'horizontal Indices
    Dim As Integer x1 = i Shr octave Shl octave
    Dim As Integer x2 = (x1 + Period) Mod mapX
    Dim As Single horBlend = (i - x1) * Frequency

    For j As Integer = 0 To mapY

      'vertical Indices
      Dim As Integer y1 = j Shr octave Shl octave
      Dim As Integer y2 = (y1 + Period) Mod mapY
      'calculation of vertical blend
      Dim As Single verBlend = (j - y1) * Frequency

      'Interpolate top corners
      Dim As Single topCorners = LinearInterpolation(noise(x1, y1), noise(x2, y1), horBlend)

      'Interpolate bottom corners
      Dim As Single bottomCorners = LinearInterpolation(noise(x1, y2), noise(x2, y2), horBlend)

      smoothNoises(i, j, octave) = LinearInterpolation(topCorners, bottomCorners, verBlend)

    Next

  Next

End Sub

Sub layeredNoise(layerNoise() As Single, ByVal oLayers As Integer)
 
  ReDim smoothNoises(0 To mapX, 0 To mapY, 0 To oLayers)

  For k As Integer = 0 To oLayers - 1

    genSmoothNoise(k)

  Next

  Dim As Single amplitude = 1
  Dim As Single totalAmplitude
  Dim As Single persistance = 0.5

  'combine noises to one layer
  Dim As Integer octave = oLayers - 1

  Do While octave > 0
    amplitude *= persistance
    totalAmplitude += amplitude

    For i As Integer = 0 To mapX
      For j As Integer = 0 To mapY

        layerNoise(i, j) += (smoothNoises(i, j, octave) * amplitude)

      Next
    Next

    octave -= 1
  Loop

  ' two for the price of one

  amplitude *= persistance
  totalAmplitude += amplitude

  For i As Integer = 0 To mapX
    For j As Integer = 0 To mapY

      layerNoise(i, j) = (layerNoise(i, j)+ (smoothNoises(i, j, octave) * amplitude)) / totalAmplitude

    Next
  Next

End Sub

'======start main ===========

Dim As Double t = Timer

'creating the 2d arrays needed
ReDim noise(0 To mapX, 0 To mapY)
Dim Shared As Single worldMap(0 To mapX, 0 To mapY)
Dim As Integer i, j

genRandomNoise()

layeredNoise(worldMap(), 6)

'greyscaleing for printing on screen

'look up table
Dim As UInteger colormap(0 To 256)
For i = 0 To 255
  colormap(i) = RGBA(0, i, 255-i, 255)   ' RGBA(i, i, i, 255) for gray scale
Next
colormap(256) = colormap(255) ' playing safe

'print the color/grey map
'lock screen for drawing
ScreenLock
'clear screen
Cls

Dim As UInteger Ptr tempPTR = ScreenPtr
For j = 0 To mapY
  For i = 0 To mapX
    *tempPTR = colormap(Int(256 * worldMap(i, j)))
    tempPTR += 1
  Next
Next

'unlock screen again
ScreenUnlock
t = Timer - t

WindowTitle "time = " + Left(Str(t),6)+ " sec.   hit any key to end program"

Sleep
End

Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 7 guests