Perlin Noise Class

Monkey Forums/Monkey Code/Perlin Noise Class

Bladko

(Posted 2011) [#1]

basic perlin class


'==========================================
'           CLASS                          
'   BASIC PERLIN CLASS WITHOUT BITMAP
'==========================================
Class TPerlinNoiseBasic

	Field sizeX = 640
	Field sizeY = 480

	'first random noise table	
	Field noiseArr:Float[]
	'output table
	Field terrainArr:Float[]
	
	'frequency, the lower the larger terrains of same level	
	Field frequency:Float = 1.0
	'starting amplitude
	Field amplitude:Float = 1.0
	'change of amplitude of next octave
	Field persistance:Float = 0.6
	'number of octaves
	Field octaves = 8
	
	'=========================================
	'	just make some data, using fake 2D arrays
	'===========================================
	Method New(_x, _y)
		
		Self.sizeX = _x
		Self.sizeY = _y	
		Self.noiseArr = new float[_x * _y]
		Self.terrainArr = new float[_x * _y]
	
	End
	
	'==========================================
	'    to init perlin noise parameters
	'==========================================
	Method ChangeParams(fre:Float, amp:Float, pers:Float, oct)
	
		frequency = fre
		amplitude = amp
		persistance = pers
		octaves = oct
	
	End 
	
	'==========================================
	'       single field noise generation
	'=========================================
	Method GetRandomNoise:Float(x:Float, y:Float)
		
		Local fre:Float = frequency
		Local amp:Float = amplitude
		Local finalValue:Float = 0.0
		
		For Local i = 0 To octaves
			finalValue = finalValue + LinearFilterNoise(x * fre, y * fre) * amp
			fre = fre * 2.0
			amp = amp * persistance
		Next
		
		If(finalValue < - 1.0) finalValue = -1.0
		If(finalValue > 1.0) finalValue = 1.0
		
		finalValue = finalValue * 0.5 + 0.5
		
		Return finalValue
	
	End 
	
	'==========================================
	'      create output terrain array
	'==========================================
	Method MakeTerrainMap()
		
		For Local x = 0 To sizeX - 1
			For Local y = 0 To sizeY - 1
				terrainArr[x + y * sizeX] = GetRandomNoise(x, y)
			Next
		Next
	
	End 

	'============================================
	'    perlin noise with linear interpolation
	'===========================================
	Method LinearFilterNoise:Float(x:Float, y:Float)
		
		Local fractionX:Float = x - Int(x)
		Local fractionY:Float = y - Int(y)
		
		Local x1 = (Int(x) + sizeX) Mod sizeX
		Local y1 = (Int(y) + sizeY) Mod sizeY
		Local x2 = (Int(x) + sizeX - 1) Mod sizeX
		Local y2 = (Int(y) + sizeY - 1) Mod sizeY
		
		If(x1 < 0) x1 = x1 + sizeX
		If(x2 < 0) x2 = x2 + sizeX
		If(y1 < 0) y1 = y1 + sizeY
		If(y2 < 0) y2 = y2 + sizeY
		
		Local finVal:Float = 0
		
		finVal = finVal + fractionX * fractionY * noiseArr[x1 + y1*sizeX ]
		finVal = finVal + fractionX * (1 - fractionY) * noiseArr[x1 + y2*sizeX]
		finVal = finVal + (1 - fractionX) * fractionY * noiseArr[x2 + y1 * sizeX]
		finVal = finVal + (1 - fractionX) * (1 - fractionY) * noiseArr[x2 + y2*sizeX ]
		
		Return finVal
	
	End 
	
	'===========================================
	'     to fill noise array with white noise
	'===========================================
	Method InitNoise()
		
		noiseArr = New Float[sizeX * sizeY]

		For Local x = 0 To sizeX - 1
			For Local y = 0 To sizeY - 1
				noiseArr[x + y * sizeX] = (Rnd() - 0.5) * 2.0
			Next
		Next
			
	End 
	
	'===========================================
        '   might be usefull, process whole array with sinus
        '============================================
	Method terrainSinus(p:Float)
		
		For Local x = 0 To sizeX - 1
			For Local y = 0 To sizeY - 1
		
				Local md:Float = Sin(y * 180 / sizeY) * 2 - 1
				terrainArr[x + sizeX * y] = md * p + terrainArr[x + sizeX * y] * (1.0 - p)
				
			Next
		Next
	
	End 
	
End

extended class to draw data on screen and make some quantization
due to fact we cannot draw to image / backbuffer so this has limited usage



'==========================================
'           CLASS                          
'   EXTENDED PERLIN CLASS WITH BITMAP AND LEVELS
'==========================================
Class TPerlinNoise Extends TPerlinNoiseBasic
	
	'min and max colors
	Field colMin:TColor = new TColor(0, 0, 0)
	Field colMax:TColor = new TColor(200,200,200)
	
	Field levels[] = New Int[100]
	Field levelsColor:TColor[] = new TColor[20]
	
	'=========================================
	'		just make new data
	'===========================================
	Method New(_x, _y)
	
		Super.New(_x,_y)
	
		'init levels
		For Local i = 0 To 99
			Self.levels[i] = 0
		Next
		
	End
	
	'==========================================
	'   draw image
	'==========================================
	Method OnRender(scale, dx, dy)

		For Local x = 0 To sizeX - 1
			For Local y = 0 To sizeY - 1
			
				Local val# = terrainArr[x + sizeX * y]
				Local R = colMax.R * val + colMin.R * (1 - val)
				Local G = colMax.G * val + colMin.G * (1 - val)
				Local B = colMax.B * val + colMin.B * (1 - val)
								
				SetColor(R, G, B)
				DrawRect(x * scale + dx, y * scale + dy, scale, scale)
				
			Next
		Next
	End
	
	'==========================================
	'   draw image according to levels, like izolines
	'==========================================
	Method OnRenderLevel(scale, dx, dy)

		For Local x = 0 To sizeX - 1
			For Local y = 0 To sizeY - 1
			
				Local val:TColor = levelsColor[levels[terrainArr[x + sizeX * y]*99]]
				if(val = null) Continue 
				
				SetColor(val.R, val.G, val.B)
				DrawRect(x * scale + dx, y * scale + dy, scale, scale)
				
			Next
		Next
	End
	
	
	'============================================
	'      start process
	'===========================================
	Method OnCreate()
				
		InitNoise()
		MakeTerrainMap()
		
	End 
	
	'============================================
	' setup terrain N from lvl min to lvl max
        ' this is quantization of terrain to one color in range
        ' this creates area of same value = izo lines
	'===========================================	
	Method SetupLevel(levelMin, levelMax, val, R,G,B)
		levelsColor[val] = New TColor(R,G,B)
		For Local i = levelMin To levelMax - 1
			levels[i] = val
		Next
	End 
	
End

example how to use

Local Perlinek:TPerlinNoise

Perlinek = New TPerlinNoise(64,48)		'to fill screen
Perlinek.ChangeParams(0.1, 0.99, 0.65, 6)       'experiment !! 
Perlinek.colMin = New TColor(0, 50, 0)          'dark green 
Perlinek.colMax = New TColor(150, 200, 150)     'light green
		
Perlinek.SetupLevel(0,40,0,0,40,80)             'low level water
Perlinek.SetupLevel(40,80,1,40,240,40)          'medium grass
Perlinek.SetupLevel(80,100,2,140,140,0)         'high rocks
		
Perlinek.OnCreate()

'===========================================================

'draw levels quantization or draw just all
'10 is scale 64 * 10 = 640
if(SpaceKeyIsHit = 1) Perlinek.OnRenderLevel(10,0,0)
if(SpaceKeyIsHit = 0) Perlinek.OnRender(10,0,0)

output

DruggedBunny

(Posted 2011) [#2]

Nice one, thanks.

Bladko

(Posted 2011) [#3]

if any one can help me how to create such image on the fly in monkey (grab image from backbuffer)

muddy_shoes

(Posted 2011) [#4]

There's no way to access the framebuffer in the standard Monkey libraries. If you want to be able to do that you will have to write the target code and Monkey abstraction layer yourself.

jjsonick

(Posted 2011) [#5]

I'd like to test this out, but the TColor class is undefined. Can you add your code for TColor please?

Bladko

(Posted 2011) [#6]

Class TColor
	
	Field R,G,B

	'****************************
	'*  	 
	'****************************
	Method New(R,G,B)
		Self.R = R
		Self.G = G
		Self.B = B		
	End 
	
	'****************************
	'*   
	'****************************
	Method New(col)
		Self.R = col & $00FF0000		
		Self.R = Self.R / $10000
		Self.G = col & $0000FF00		
		Self.G = Self.G / $100
		Self.B = col & $000000FF		
		
	End
	
	'****************************
	'*   
	'****************************
	Method GenerateColor:Int()
	 	Return $FF000000 + (R * $10000 + G * $100 + B)
	End
	
End

Bladko

(Posted 2011) [#7]

use it with temperatur / altitude / humidity layers and pick if low temp and high hum then its tundra etc...

V. Lehtinen

(Posted 2014) [#8]

if any one can help me how to create such image on the fly in monkey (grab image from backbuffer)

Forget rendering and then grabbing an image. You have all the data you need in your TPerlinNoiseBasic class arrays. :)
Just calculate the pixel color values from your floats and put these in a new array, which is then put into an image:

Strict 'Come on.. Don't forget this..
'Create an image
Local img:= CreateImage(width, height)
'And an array
Local pixels:= New Int[width * height]

'...calculate pixels's color values
' and then
img.WritePixels(pixels, x, y, width, height)

It is also possible to create terrain images bigger than the screen, thanks to WritePixels parameters!

I use this code to get my tilemap-layers into images, and tilemaps usually are bigger than the screen:

    Method SetupChunks:Void()
        chunkWidth = fullWidth
        chunkHeight = fullHeight
        
        While chunkWidth > DeviceWidth()
            chunkWidth /= 2
        Wend
        While chunkHeight > DeviceHeight()
            chunkHeight /= 2
        Wend
        
        chunkCols = fullWidth / chunkWidth
        chunkRows = fullHeight / chunkHeight
    End
    
    Method PreRender:Void()
        Local x:Int, y:Int
        Local w:Int = data.width * tileWidth 'Layer's width * Tile width
        Local h:Int = data.height * tileHeight 'Layer's height * Tile height
        
        graphic = CreateImage(w, h)
        
        Local pixels:= New Int[chunkWidth * chunkHeight] ' We only need an array for a chunk, not whole image...
    
        For Local chunkX:Int = 0 Until chunkCols
            For Local chunkY:Int = 0 Until chunkRows
                Cls(0, 0, 0)
                
                x = chunkX * chunkWidth
                y = chunkY * chunkHeight
        
                Select renderingType
                    Case ORTHOGONAL
                        RenderOrtho(x, y, chunkWidth, chunkHeight)
                    Case ISOMETRIC
                        RenderIsometric() ' This doesn't even work yet, so don't ask... :)
                End
                
                ReadPixels(pixels, 0, 0, chunkWidth, chunkHeight) 'Read where we rendered
                MaskPixels(pixels, 0, 0, 0)
                graphic.WritePixels(pixels, x, y, chunkWidth, chunkHeight) '...but put it in right place in our image.
            Next
        Next
    End

EDIT: Sorry.. Didn't notice this was so old... T__T

V. Lehtinen

(Posted 2014) [#9]

Okay, so I played around a little and got it working with images. It "renders" the pixels straight into the image. Should there be no need for any pre-rendering. Also the terrain can be any size, even bigger than the rendering screen.

I will still be optimizing the code since there's some left-overs from the earlier rendering.. :) [DONE]
Also will be adding colormap, that isn't yet implemented. Will be using gradients which you are able to set key-colors to. [DONE]

EDIT: How it looks with 2 gradient colors (red and lighter blue):

Usage:

 'Use these, in for example OnCreate()
Local Perlinek = New TPerlinNoise(640, 480)
Perlinek.SetParams(0.05, 0.99, 0.65, 8) ' Experiment with these.. ;)
Perlinek.MakeTerrainMap()
        
Perlinek.SetLevelColor(0.0, New Color(255, 0, 0))
Perlinek.SetLevelColor(1.1, New Color(0, 128, 255)) ' Have to fix this, doesn't work as it should with key 1.0...

Perlinek.CreateTerrain()


'....

'And simply draw the image in OnRender():
DrawImage(Perlinek.image, 0, 0)

Code (updated with gradient):

Strict

'==========================================
'           CLASS                          
'   EXTENDED PERLIN CLASS WITH BITMAP AND LEVELS
'==========================================
Class TPerlinNoise Extends TPerlinNoiseBasic
    
    Field image:Image
    Field chunkWidth:Int, chunkHeight:Int
    Field chunkCols:Int, chunkRows:Int
    
    Field gradient:Gradient

    Method New(_x:Int, _y:Int)
        Super.New(_x, _y)
        InitNoise()
        gradient = New Gradient()
        
        image = CreateImage(_x, _y)
        
        SetupChunks()
    End
    
    Method Render:Void(x:Int, y:Int, w:Int, h:Int, arr:Int[])
        Local dx:Int, dy:Int, height:Float, pixel:Color
        
        For dx = x Until w
            For dy = y Until h
                height = terrainArr[dx + dy * sizeX]
                pixel = gradient.GetColor(height)
                
                arr[dx + dy * sizeX] = pixel.Rgb()
            Next
        Next
    End
    
    Method CreateTerrain:Void()
        Local x:Int, y:Int
        
        Local pixels:= New Int[chunkWidth * chunkHeight]
    
        For Local chunkX:Int = 0 Until chunkCols
            For Local chunkY:Int = 0 Until chunkRows
               
                x = chunkX * chunkWidth
                y = chunkY * chunkHeight
                Render(x, y, chunkWidth, chunkHeight, pixels)
                
                image.WritePixels(pixels, x, y, chunkWidth, chunkHeight)
            Next
        Next

    End
	
    Method SetLevelColor:Void(level:Float, color:Color)
        gradient.AddKey(level, color)
    End
    
    Method SetupChunks:Void()
        chunkWidth = image.Width()
        chunkHeight = image.Height()
        
        While chunkWidth > DeviceWidth()
            chunkWidth /= 2
        Wend
        While chunkHeight > DeviceHeight()
            chunkHeight /= 2
        Wend
        
        chunkCols = image.Width() / chunkWidth
        chunkRows = image.Height() / chunkHeight
    End
    

End



Class Gradient Extends Color
    Field keys:= New FloatMap<Color>
    
    Method AddKey:Void(position:Float, color:Color)
        keys.Set(position, color)
    End
    
    Method GetColor:Color(key:Float)
        Local thisKey:Float, thisValue:Color
        Local lastKey:Float, lastValue:Color
        Local alpha:Float
        
        For Local k:= EachIn keys.Keys()
            thisKey = k
            thisValue = keys.Get(thisKey)
            
            If thisKey > key Then
                alpha = (key - lastKey) / (thisKey - lastKey)
                
                _rtnColor.r = Lerp(lastValue.r, thisValue.r, alpha)
                _rtnColor.g = Lerp(lastValue.g, thisValue.g, alpha)
                _rtnColor.b = Lerp(lastValue.b, thisValue.b, alpha)
                
                Return _rtnColor
            End
            
            lastKey = k
            lastValue = keys.Get(lastKey)
        Next
        
        Return _nullColor
    End
    
    Private
    Field _rtnColor:= New Color(0, 0, 0)
    Field _nullColor:= New Color(0, 0, 0)
    
    Function Lerp:Float(a:Float, b:Float, c:Float)
        Return a + c * (b - a)
    End
End

Class Color

	Global _cached := new IntMap<Color>
    
	Function Get:Color(rgb:Int)
		Local colorTemp:Color = _cached.Get(rgb)
		If colorTemp = Null
			colorTemp = New Color(rgb)
			_cached.Add(rgb, colorTemp)
		EndIf
		Return colorTemp
	End
	
	Field r:Int, g:Int, b:Int, a:Int
	
	Method Rgb:Int() Property Return (a shl 24) | (r Shl 16) | (g Shl 8) | b End
	
	Method Rgb:Void(rgbNew:Int) Property
        Self.a = (rgbNew Shr 24) & $FF
		Self.r = (rgbNew Shr 16) & $FF
		Self.g = (rgbNew Shr 8) & $FF
		Self.b = rgbNew & $FF
	End
	
	Method New(r:Int, g:Int, b:Int)
		Self.r = r
		Self.g = g
		Self.b = b
        Self.a = 255
	End
    
    Method New(r:Int, g:Int, b:Int, a:Int)
		Self.r = r
		Self.g = g
		Self.b = b
        Self.a = a
	End
	
	Method New(rgb:Int)
		Self.Rgb = rgb
	End
	
	Method ToString:String(rgbValue:Bool = False)
		If rgbValue Return String(Rgb)
        Return (a + ", " + r + ", " + g + ", " + b)
	End
    
    #REM * *
     * Converts an RGB color value To HSL.Conversion formula
     * adapted from <a href="http://en.wikipedia.org/wiki/HSL_color_space." target="_blank">http://en.wikipedia.org/wiki/HSL_color_space.</a>
     * Assumes r, g, and b are contained in the set [0, 255] and
     * returns h, s, and l in the set [0, 1].
     *
     * @param   Number  r       The red color value
     * @param   Number  g       The green color value
     * @param   Number  b       The blue color value
     * @return  Array           The HSL representation
    #END 
    Function RGBtoHSL:Float[] (r:Float, g:Float, b:Float)
        r /= 255
        g /= 255
        b /= 255
        Local max:Float = Math.Max(r, g, b), min:Float = Math.Min(r, g, b)
        Local h:Float, s:Float, l:Float = (max + min) / 2;
        Local temp:Float
        
        If (max = min) ' achromatic
            h = 0
            s = 0
        Else
            Local d:Float = max - min;
            If l > 0.5 s = d / (2 - max - min) Else s = d / (max + min)
            Select max
                Case r
                    If g < b Then temp = 6 Else temp = 0
                    h = (g - b) / d + temp
                Case g
                    h = (b - r) / d + 2
                Case b
                    h = (r - g) / d + 4
            End
            h /= 6
        End
    
        Return[h, s, l]
    End
    
    #REM/ * *
     * Converts an HSL color value to RGB. Conversion formula
     * adapted from <a href="http://en.wikipedia.org/wiki/HSL_color_space." target="_blank">http://en.wikipedia.org/wiki/HSL_color_space.</a>
     * Assumes h, s, and l are contained in the set [0, 1] and
     * returns r, g, and b in the set [0, 255].
     *
     * @param   Number  h       The hue
     * @param   Number  s       The saturation
     * @param   Number  l       The lightness
     * @return  Array           The RGB representation
    #END
    Function HSLtoRGB:Float[] (h:Float, s:Float, l:Float)
        Local r:Float, g:Float, b:Float;
    
        If (s = 0) ' achromatic
            r = l
            g = l
            b = l
        Else
            Local q:Float
            Local p:Float = 2 * l - q
            
            If l < 0.5 Then q = l * (1 + s) Else q = l + s - l * s
            
            r = hue2rgb(p, q, h + 1 / 3)
            g = hue2rgb(p, q, h)
            b = hue2rgb(p, q, h - 1 / 3)
        End
    
        Return[r * 255, g * 255, b * 255]
    End
    
    Function hue2rgb:Float(p:Float, q:Float, t:Float)
        If (t < 0) t += 1
        If (t > 1) t -= 1
        If (t < 1 / 6) Return p + (q - p) * 6 * t
        If (t < 1 / 2) Return q
        If (t < 2 / 3) Return p + (q - p) * (2 / 3 - t) * 6
        Return p
    End
End

V. Lehtinen

(Posted 2014) [#10]

Here is another with Temperate-like colors:

Perlinek.SetLevelColor(1.1, New Color(2, 43, 68)) ' Water
Perlinek.SetLevelColor(0.55, New Color(9, 62, 92))
Perlinek.SetLevelColor(0.51, New Color(17, 82, 112))
Perlinek.SetLevelColor(0.5, New Color(69, 108, 118)) ' Shore
Perlinek.SetLevelColor(0.49, New Color(42, 102, 41)) ' Land
Perlinek.SetLevelColor(0.25, New Color(115, 128, 77))
Perlinek.SetLevelColor(0.15, New Color(153, 143, 92))
Perlinek.SetLevelColor(0.05, New Color(179, 160, 120))
Perlinek.SetLevelColor(0.0, New Color(220, 200, 180)) ' Mountains