Maybe Perlin Noise

[Marcus]

I'm doing some 3d random terrain generation experiments. I've implemented the Midpoint Displacement algorithm before but don't like the look of the clouds it generates. So I briefed through the information about Perlin Noise on Wikipedia and then implemented my ... quick perception of that algorithm   So I'm not sure if this is actually Perlin Noise, but it gives a nice result. This example just shows some clouds with different detail levels, but you can also use it to create really cool plasma images (I might post some of that later). These clouds can be used as heightmaps for terrain.

Code:

' Maybe perlin noise ...
' ----------------------

set window "test", 512, 512 + 16
set redraw off

randomize 15

w = 256;  h = 256
img = createimage(w, h)

' Create a couple of clouds of different resolutions and put them in an array.
octaves = [CloudMap(4, 4), CloudMap(8, 8), CloudMap(16, 16), CloudMap(32, 32), CloudMap(64, 64)]
for i = 0 to sizeof(octaves) - 1
    set color 0, 0, 0
    cls
    set color 255, 255, 255
    set caret 0, 0
    wln "Generating cloud ..."
    redraw
   
    ' Draw to image img.
    set image img
    for y = 0 to h - 1  for x = 0 to w - 1
        ' The parameter ranges of a cloud is [0..1], so divide x and y by the width and height of
        ' image to get coordinates in that range. Note that the parameters you send to ValueAt are
        ' wrapped and that the cloud is seamless.
        nx = x/w;  ny = y/h
        ' Add values from the first i clouds to add more and more details.
        v = 0;  amp = 1
        for j = 0 to i
            v = v + octaves[j].ValueAt(nx, ny)*amp
            amp = amp*0.5
        next
        ' ValueAt returns values in the range [-1..1], so multiply with 0.5, add 0.5 and multiply
        ' with 255 to get values [0..255].
        v = 255*(0.5 + 0.5*v)
        set color v, v, v
        set pixel x, y
    next
    set image primary
    ' Draw four images to confirm that they're seamless.
    set color 255, 255, 255
    draw image img, 0, 0
    draw image img, w, 0
    draw image img, 0, h
    draw image img, w, h
    set caret width(primary)/2, 512
    center "Press spacebar to continue ..."
    redraw
    while not keydown(KEY_SPACE, true)  fwait 60
next

' CloudMap
' --------
function CloudMap(resX, resY)
    map = []
   
    ' Create grid of random unit vectors.
    map.m = dim(resX, resY)
    for y = 0 to resY - 1  for x = 0 to resX - 1
        a = rnd()*PI*2
        map.m[x][y] = [x: cos(a), y: sin(a)]
    next
   
    ' ValueAt
    ' -------
    ' Return value, [-1..1] at coordinates (x, y), The size of the cloud is 1x1, but the coordinates
    ' are wrapped and the cloud is always seamless.
    map.ValueAt = function(x, y)
        m = this.m
        w = sizeof(m);  h = sizeof(m[0])
        x = (x*w)%w;  y = (y*h)%h
        x0 = floor(x);  y0 = floor(y)
        x1 = (x0 + 1)%w;  y1 = (y0 + 1)%h
        fx = x - x0;  fy = y - y0
        tl = -fx*m[x0][y0].x - fy*m[x0][y0].y
        tr = (1 - fx)*m[x1][y0].x - fy*m[x1][y0].y
        bl = -fx*m[x0][y1].x + (1 - fy)*m[x0][y1].y
        br = (1 - fx)*m[x1][y1].x + (1 - fy)*m[x1][y1].y
        return Bilinear(tl, tr, bl, br, Quad(0, 1, fx), Quad(0, 1, fy))
       
        ' Bilinear
        ' --------
        function Bilinear(tl, tr, bl, br, x, y)
            ix = 1 - x
            return (1 - y)*(ix*tl + x*tr) + y*(ix*bl + x*br)
        endfunc

        ' Quad
        ' ----
        function Quad(a, b, p)
            return a - 3*a*p^2 + 2*a*p^3 + 3*b*p^2 - 2*b*p^3
        endfunc
    endfunc
   
    return map
endfunc