Noise Based Texture

[rdc]

I converted the Noise Texture tut from Lode's 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.

Code: [Select]

'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)


[Shockwave]

Here's a version that will work for people who still have Fb1.15 (hope you don't mind rick?)

Code: [Select]

'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.

[zawran]

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.

[rdc]

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.

[WidowMaker [retired]]

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.

[rdc]

Lode has a section on making a marble-like texture using this technique here:

http://www.student.kuleuven.be/~m0216922/CG/randomnoise.html

[Clyde]

Very cool and clever stuff RDC!

[rdc]

Heh. Thanks. I can't claim any credit though. I was just being a trained monkey and converting the code.