Public Class FournierFussellCarpenterNoise
Private Shared rnd As New Random()
Public Shared Function Generate(depth As Integer, roughness As Single, c1 As Color, c2 As Color, c3 As Color) As Color()
Dim wh As Integer = 1 << depth 'Actual supposed dimension of the heightmap
Dim heightmap(wh - 1, wh - 1) As Single
Dim rval(wh * wh - 1) As Color
Dim k As Integer = 0
Dim linecount As Integer = 1
Dim stepsize As Integer = 1 << (depth - 1)
Dim x, y As Integer
Dim xa, xb, xc, ya, yb, yc As Integer
'Actually sets the 4 corner-values to roughness * [0.8; 0.9[, since the texture is seamlessly implemented.
heightmap(0, 0) = roughness * (Convert.ToSingle(rnd.NextDouble()) / 10.0F + 0.8F)
While stepsize > 0
'The square step------------------------------------------------------
y = stepsize
For i As Integer = 1 To linecount
x = stepsize
ya = y + stepsize
yb = y - stepsize
yc = y
If ya < 0 Then ya += wh
If ya >= wh Then ya -= wh
If yb < 0 Then yb += wh
If yb >= wh Then yb -= wh
If yc >= wh Then yc -= wh
For j As Integer = 1 To linecount
xa = x + stepsize
xb = x - stepsize
xc = x
If xa < 0 Then xa += wh
If xa >= wh Then xa -= wh
If xb < 0 Then xb += wh
If xb >= wh Then xb -= wh
If xc >= wh Then xc -= wh
heightmap(xc, yc) = (heightmap(xa, ya) + heightmap(xa, yb) + _
heightmap(xb, ya) + heightmap(xb, yb)) / 4.0F + _
roughness * Convert.ToSingle(rnd.NextDouble() - 0.5)
x += 2 * stepsize
Next
y += 2 * stepsize
Next
'The diamond step-------------------------------------------------------
For i As Integer = 1 To linecount
x = 0
y = stepsize * (2 * i - 1)
While y <= wh
xa = x + stepsize
xb = x - stepsize
xc = x
ya = y + stepsize
yb = y - stepsize
yc = y
If xa < 0 Then xa += wh
If xa >= wh Then xa -= wh
If xb < 0 Then xb += wh
If xb >= wh Then xb -= wh
If xc >= wh Then xc -= wh
If ya < 0 Then ya += wh
If ya >= wh Then ya -= wh
If yb < 0 Then yb += wh
If yb >= wh Then yb -= wh
If yc >= wh Then yc -= wh
heightmap(xc, yc) = (heightmap(xc, ya) + heightmap(xc, yb) + _
heightmap(xa, yc) + heightmap(xb, yc)) / 4.0F + _
roughness * Convert.ToSingle(rnd.NextDouble() - 0.5)
heightmap(yc, xc) = (heightmap(yc, xa) + heightmap(yc, xb) + _
heightmap(ya, xc) + heightmap(yb, xc)) / 4.0F + _
roughness * Convert.ToSingle(rnd.NextDouble() - 0.5)
x += stepsize
y += stepsize
End While
Next
linecount *= 2
stepsize \= 2
roughness /= 2
End While
'Conversion to bitmap
For i As Integer = 0 To wh - 1
For j As Integer = 0 To wh - 1
Dim v As Single = heightmap(i, j)
If v < 0.0F Then v = 0.0F
If v > 1.0F Then 'Anything above 1.0 will interpolate colors c2 and c3
rval(k) = Color.Lerp(c2, c3, v - 1.0F)
ElseIf v > 0.6F Then 'Anything between 0.6 and 1.0 will interpolate c1 and c2
rval(k) = Color.Lerp(c1, c2, (v - 0.6F) * 2.5F)
Else 'Anything below 0.6 will be c1 (color of sky
rval(k) = c1
End If
k += 1
Next
Next
Return rval
End Function
End Class