Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: rdc on May 18, 2009
-
I converted the Noise Texture tut from Lode's (http://www.student.kuleuven.be/~m0216922/CG/randomnoise.html) site into FB. I needed a way to zoom into a tile from the overworld map in my SOL project. I am using the noise function to create a zoom map based on where the character is on the overworld.
Simple, but works quite well. Needs a better smooth function, but for my purposes, it should work all right.
'Noise texure generator
'Taken from
'http://www.student.kuleuven.be/~m0216922/CG/randomnoise.html/CG/randomnoise.html
'=======================================================================
#Define tWidth 320
#Define tHeight 240
#Define zoom 128
Dim Shared noise(tWidth, tHeight) As Double 'the noise array
Dim Shared texture(tWidth, tHeight) As Uinteger 'texture array
Dim Shared pal(256) As Uinteger 'color palette
Dim ch As String
'Interpolation code by Rattrapmax6
Sub MakePalette(sr As Integer, sg As Integer, sb As Integer, er As Integer, eg As Integer, eb As Integer)
Dim As Integer i
Dim iStart(3) As Uinteger
Dim iEnd(3) As Uinteger
Dim iShow(3) As Uinteger
Dim Rend(3) As Double
Dim InterPol(3) As Double
InterPol(0) = Ubound(pal)
iStart(1) = sr
iStart(2) = sg
iStart(3) = sb
iEnd(1) = er
iEnd(2) = eg
iEnd(3) = eb
InterPol(1) = (iStart(1) - iEnd(1)) / InterPol(0)
InterPol(2) = (iStart(2) - iEnd(2)) / InterPol(0)
InterPol(3) = (iStart(3) - iEnd(3)) / InterPol(0)
Rend(1) = iStart(1)
Rend(2) = iStart(2)
Rend(3) = iStart(3)
For i = Lbound(pal) To Ubound(pal)
iShow(1) = Rend(1)
iShow(2) = Rend(2)
iShow(3) = Rend(3)
pal(i) = Rgb(iShow(1),iShow(2),iShow(3))
Rend(1) -= InterPol(1)
Rend(2) -= InterPol(2)
Rend(3) -= InterPol(3)
Next
End Sub
'Generates random noise.
Sub GenerateNoise
For x As Integer = 0 To tWidth - 1
For y As Integer = 0 To tHeight - 1
noise(x, y) = Rnd
Next
Next
End Sub
Function smoothNoise(x As Double, y As Double) As Double
'get fractional part of x and y
Dim fractX As Double = x - Int(x)
Dim fractY As Double = y - Int(y)
'wrap around
Dim x1 As Integer = (Int(x) + tWidth) Mod tWidth
Dim y1 As Integer = (Int(y) + tHeight) Mod tHeight
'neighbor values
Dim x2 As Integer = (x1 + tWidth - 1) Mod tWidth
Dim y2 As Integer = (y1 + tHeight - 1) Mod tHeight
'smooth the noise with bilinear interpolation
Dim value As Double = 0.0
value += fractX * fractY * noise(x1, y1)
value += fractX * (1 - fractY) * noise(x1, y2)
value += (1 - fractX) * fractY * noise(x2, y1)
value += (1 - fractX) * (1 - fractY) * noise(x2, y2)
Return value
End Function
Function Turbulence(x As Double, y As Double, size As Double) As Double
Dim As Double value = 0.0, initialSize = size
Do While size >= 1
value += SmoothNoise(x / size, y / size) * size
size /= 2.0
Loop
Return (128.0 * value / initialSize)
End Function
'Builds the texture.
Sub BuildTexture
For x As Integer = 0 To tWidth - 1
For y As Integer = 0 To tHeight - 1
texture(x, y) = Turbulence(x, y, zoom)
Next
Next
End Sub
'Draws texture to screen.
Sub Drawtexture
ScreenLock
Cls
For x As Integer = 0 To tWidth - 1
For y As Integer = 0 To tHeight - 1
Pset(x, y), pal(texture(x, y))
Next
Next
ScreenUnLock
End Sub
Randomize Timer
Screen 14, 32
MakePalette 255, 255, 255, 0, 0, 255
GenerateNoise
BuildTexture
Drawtexture
Do
ch = Inkey
If ch = Chr(32) Then
GenerateNoise
BuildTexture
Drawtexture
Endif
Sleep 1
Loop Until ch = Chr(27)
-
Here's a version that will work for people who still have Fb1.15 (hope you don't mind rick?)
'Noise texure generator
'Taken from
'http://www.student.kuleuven.be/~m0216922/CG/randomnoise.html/CG/randomnoise.html
'=======================================================================
#Define tWidth 320
#Define tHeight 240
#Define zoom 128
Dim Shared noise(tWidth, tHeight) As Double 'the noise array
Dim Shared texture(tWidth, tHeight) As Uinteger 'texture array
Dim Shared pal(256) As Uinteger 'color palette
Dim ch As String
'Interpolation code by Rattrapmax6
Sub MakePalette(sr As Integer, sg As Integer, sb As Integer, er As Integer, eg As Integer, eb As Integer)
Dim As Integer i
Dim iStart(3) As Uinteger
Dim iEnd(3) As Uinteger
Dim iShow(3) As Uinteger
Dim Rend(3) As Double
Dim InterPol(3) As Double
InterPol(0) = Ubound(pal)
iStart(1) = sr
iStart(2) = sg
iStart(3) = sb
iEnd(1) = er
iEnd(2) = eg
iEnd(3) = eb
InterPol(1) = (iStart(1) - iEnd(1)) / InterPol(0)
InterPol(2) = (iStart(2) - iEnd(2)) / InterPol(0)
InterPol(3) = (iStart(3) - iEnd(3)) / InterPol(0)
Rend(1) = iStart(1)
Rend(2) = iStart(2)
Rend(3) = iStart(3)
For i = Lbound(pal) To Ubound(pal)
iShow(1) = Rend(1)
iShow(2) = Rend(2)
iShow(3) = Rend(3)
pal(i) = Rgb(iShow(1),iShow(2),iShow(3))
Rend(1) -= InterPol(1)
Rend(2) -= InterPol(2)
Rend(3) -= InterPol(3)
Next
End Sub
'Generates random noise.
Sub GenerateNoise
dim as integer x,y
For x = 0 To tWidth - 1
For y = 0 To tHeight - 1
noise(x, y) = Rnd
Next
Next
End Sub
Function smoothNoise(x As Double, y As Double) As Double
'get fractional part of x and y
Dim fractX As Double = x - Int(x)
Dim fractY As Double = y - Int(y)
'wrap around
Dim x1 As Integer = (Int(x) + tWidth) Mod tWidth
Dim y1 As Integer = (Int(y) + tHeight) Mod tHeight
'neighbor values
Dim x2 As Integer = (x1 + tWidth - 1) Mod tWidth
Dim y2 As Integer = (y1 + tHeight - 1) Mod tHeight
'smooth the noise with bilinear interpolation
Dim value As Double = 0.0
value += fractX * fractY * noise(x1, y1)
value += fractX * (1 - fractY) * noise(x1, y2)
value += (1 - fractX) * fractY * noise(x2, y1)
value += (1 - fractX) * (1 - fractY) * noise(x2, y2)
Return value
End Function
Function Turbulence(x As Double, y As Double, size As Double) As Double
Dim As Double value = 0.0, initialSize = size
Do While size >= 1
value += SmoothNoise(x / size, y / size) * size
size /= 2.0
Loop
Return (128.0 * value / initialSize)
End Function
'Builds the texture.
Sub BuildTexture
dim as double x,y
For x = 0 To tWidth - 1
For y = 0 To tHeight - 1
texture(x, y) = Turbulence(x, y, zoom)
Next
Next
End Sub
'Draws texture to screen.
Sub Drawtexture
dim as integer x,y
ScreenLock
Cls
For x = 0 To tWidth - 1
For y = 0 To tHeight - 1
Pset(x, y), pal(texture(x, y))
Next
Next
ScreenUnLock
End Sub
Randomize Timer
Screen 14, 32
MakePalette 255, 255, 255, 0, 0, 255
GenerateNoise
BuildTexture
Drawtexture
Do
ch = Inkey
If ch = Chr(32) Then
GenerateNoise
BuildTexture
Drawtexture
Endif
Sleep 1
Loop Until ch = Chr(27)
And an exe is attached.
It's a nice cloud generator indeed :) I really like it.
-
I do not have Freebasic installed anymore, but from Shockwaves exe example it looks like it produced ok results. The article is interesting for sure, and I have bookmarked it to read it completely later on.
-
Here's a version that will work for people who still have Fb1.15 (hope you don't mind rick?)
Cool.
I am actually not using this to produce textures, rather I am using it to create a procedural landscape map that represents the current zoomed-in overworld map tile. Rather than storing the data in an array, I am just storing the seed value for the tile, and then generating the map using the above code. The seed ensures that the same random pattern is generated each time.
Instead of using a completely random function to populate the initial pattern, I am using a semi-random pattern composed of the tile type plus type values from neighboring tiles to generate the map. So if the tile is mainly woods, but borders a plains tile, the plains will be mixed in with the woods along the plains side and then added to the noise function to produce the map.
-
I really liked the cloud pattern that this produces.
I was actually looking for something that does exactly this kind of thing to procedurally generate a texture that looks like polished marble which I think I can get just by altering the colour palette.
Thanks for posting it RDC, I will have a look and see how it works and write my own version of it.
-
Lode has a section on making a marble-like texture using this technique here:
http://www.student.kuleuven.be/~m0216922/CG/randomnoise.html
-
Very cool and clever stuff RDC! :)
-
Heh. Thanks. I can't claim any credit though. I was just being a trained monkey and converting the code. :)