Perlin 3D : done !

[Jark]

I spent a part of the week-end on it, and I just managed to make the 3D version work...

The rational was the following: to make a fast 2D perlin noise, you create a 129x129 array (or 65x65, or 33x33, depending on how many octaves you want), and you fill it via the squares division technique. The first points are the four corners, then the center (i.e. 65-65), then the 4 edges middles (1-65,65-1,129-65 and 65-129). After 7 iterations, the array is filled.

This technique can't work in 3D with QB, because you cannot declare a 129x129x129 array... So you need to calculate the proper Perlin value for a given 3D point, let's say (43,67,114). You start from the 8 corners of the cube, and you reduce the size of the cube by two at each step, until you get a 1 pixel wide cube around (43,67,114). It's easy to understand with 1 dimension only:

1-129 > (1+129)/2 = 65
1-65 >(1+65)/2 = 33
33-65 > (33+65)/2 = 49
33-49 > (33+49)/2 = 41
41-49 > (41+49)/2=45
41-45 > (41+45)/2 = 43

So you need to calculate the Perlin noise only for 1, 129,65,33,49,41 and 43...

What you need now is to control that the RND calls return always the same result for a given point (x%,y%,z%). You do this by calling RND with a NEGATIVE argument (e.g. RND(-x%)). The last step is to avoid geometric renderings (stripes, etc...) due to the fact that RND is a pseudo random number generator. I solved the issue by using:

RND(-RND(f(x,y,z))) instead of RND(-f(x,y,z).

Here's the result, that provides a 3D Perlin value ranging from 0 to 255 for any point (m%,n%,p%). The number of octaves can be huge, the persistence can be modified at will...

To finalise that, you just need to add your favorite interpolation routine, and you get a complete Perlin3D!(x!,y!,z!) function.

Nota: it's quite easy to make the cube tileable, by pre-calculating 3 sides of the cube and by duplicating each of them to the opposite side (I did that in 2D in TC-Ray).

Code:

DECLARE FUNCTION Noise3! (a%, b%, c%)
DECLARE FUNCTION Perlin3D% (m%, n%, p%)

DIM SHARED Seed&, Noise%(129, 129)
DIM SHARED Octaves%, Persistence!, Span%
DIM SHARED Power2%(8), Amplitude!(8)
CLS
RANDOMIZE TIMER: Seed& = 103476 * RND
Octaves% = 7: Persistence! = 1.5: Span% = 2 ^ Octaves% + 1

FOR k% = 0 TO 7
Power2%(k%) = 2 ^ k%
Amplitude!(k%) = (1 / Persistence!) ^ k%
NEXT k%

SCREEN 13
CLS

PALETTE 0, 0
FOR i = 1 TO 255
Green = INT(i / 4)
Blue = INT(255 / 4)
Red = INT(i / 4)
PALETTE i, 65536 * Blue + 256 * Green + Red
NEXT i
t0 = TIMER
FOR k% = 1 TO 129
FOR m% = 1 TO 129
PSET (k%, m%), Perlin3D%(k%, m%, 1)
PSET (k% + 132, m%), Perlin3D%(k%, m%, 5)
NEXT m%
NEXT k%
dt = TIMER - t0
LOCATE 18, 1
PRINT dt

FUNCTION Noise3! (a%, b%, c%)
Noise3! = RND(-RND(-a% * b%) * RND(-c%) * Seed&) - .5
END FUNCTION

FUNCTION Perlin3D% (m%, n%, p%)

Rank% = 0
x% = m%: y% = n%: z% = p%
ax% = 1: bx% = Span%
ay% = 1: by% = Span%
az% = 1: bz% = Span%
z1% = 128: z2% = 128: z3% = 128: z4% = 128
z5% = 128: z6% = 128: z7% = 128: z8% = 128

DO UNTIL (bx% = x% OR x% = ax%) AND (by% = y% OR y% = ay%) AND (bz% = z% OR z% = az%)
Rank% = Rank% + 1
Grid% = Power2%(Octaves% - Rank%)

IF bx% - x% > x% - ax% THEN
bx% = bx% - Grid%
    IF by% - y% > y% - ay% THEN
    by% = by% - Grid%
        IF bz% - z% > z% - az% THEN
        bz% = bz% - Grid%
        z1n% = z1%
        z2n% = (z1% + z2%) / 2
        z3n% = (z1% + z2% + z3% + z4%) / 4
        z4n% = (z1% + z4%) / 2
        z5n% = (z1% + z5%) / 2
        z6n% = (z1% + z2% + z5% + z6%) / 4
        z7n% = (z1% + z2% + z3% + z4% + z5% + z6% + z7% + z8%) / 8
        z8n% = (z1% + z4% + z5% + z8%) / 4
z1% = z1n%
z2% = z2n% * (1 + Noise3!(bx%, ay%, az%) * Amplitude!(Rank%))
z3% = z3n% * (1 + Noise3!(bx%, by%, az%) * Amplitude!(Rank%))
z4% = z4n% * (1 + Noise3!(ax%, by%, az%) * Amplitude!(Rank%))
z5% = z5n% * (1 + Noise3!(ax%, ay%, bz%) * Amplitude!(Rank%))
z6% = z6n% * (1 + Noise3!(bx%, ay%, bz%) * Amplitude!(Rank%))
z7% = z7n% * (1 + Noise3!(bx%, by%, bz%) * Amplitude!(Rank%))
z8% = z8n% * (1 + Noise3!(ax%, by%, bz%) * Amplitude!(Rank%))
      
        ELSE
        az% = az% + Grid%
        z1n% = (z1% + z5%) / 2
        z2n% = (z1% + z2% + z5% + z6%) / 4
        z3n% = (z1% + z2% + z3% + z4% + z5% + z6% + z7% + z8%) / 8
        z4n% = (z1% + z4% + z5% + z8%) / 4
        z5n% = z5%
        z6n% = (z5% + z6%) / 2
        z7n% = (z5% + z6% + z7% + z8%) / 4
        z8n% = (z5% + z8%) / 2
z1% = z1n% * (1 + Noise3!(ax%, ay%, az%) * Amplitude!(Rank%))
z2% = z2n% * (1 + Noise3!(bx%, ay%, az%) * Amplitude!(Rank%))
z3% = z3n% * (1 + Noise3!(bx%, by%, az%) * Amplitude!(Rank%))
z4% = z4n% * (1 + Noise3!(ax%, by%, az%) * Amplitude!(Rank%))
z5% = z5n%
z6% = z6n% * (1 + Noise3!(bx%, ay%, bz%) * Amplitude!(Rank%))
z7% = z7n% * (1 + Noise3!(bx%, by%, bz%) * Amplitude!(Rank%))
z8% = z8n% * (1 + Noise3!(ax%, by%, bz%) * Amplitude!(Rank%))
      
        END IF
    ELSE
    ay% = ay% + Grid%
        IF bz% - z% > z% - az% THEN
        bz% = bz% - Grid%
        z1n% = (z1% + z4%) / 2
        z2n% = (z1% + z2% + z3% + z4%) / 4
        z3n% = (z3% + z4%) / 2
        z4n% = z4%
        z5n% = (z1% + z4% + z5% + z8%) / 4
        z6n% = (z1% + z2% + z3% + z4% + z5% + z6% + z7% + z8%) / 8
        z7n% = (z4% + z3% + z7% + z8%) / 4
        z8n% = (z4% + z8%) / 2
z1% = z1n% * (1 + Noise3!(ax%, ay%, az%) * Amplitude!(Rank%))
z2% = z2n% * (1 + Noise3!(bx%, ay%, az%) * Amplitude!(Rank%))
z3% = z3n% * (1 + Noise3!(bx%, by%, az%) * Amplitude!(Rank%))
z4% = z4n%
z5% = z5n% * (1 + Noise3!(ax%, ay%, bz%) * Amplitude!(Rank%))
z6% = z6n% * (1 + Noise3!(bx%, ay%, bz%) * Amplitude!(Rank%))
z7% = z7n% * (1 + Noise3!(bx%, by%, bz%) * Amplitude!(Rank%))
z8% = z8n% * (1 + Noise3!(ax%, by%, bz%) * Amplitude!(Rank%))
        ELSE
        az% = az% + Grid%
        z1n% = (z1% + z4% + z5% + z8%) / 4
        z2n% = (z1% + z2% + z3% + z4% + z5% + z6% + z7% + z8%) / 8
        z3n% = (z4% + z3% + z7% + z8%) / 4
        z4n% = (z4% + z8%) / 2
        z5n% = (z5% + z8%) / 2
        z6n% = (z5% + z6% + z7% + z8%) / 4
        z7n% = (z7% + z8%) / 2
        z8n% = z8%
z1% = z1n% * (1 + Noise3!(ax%, ay%, az%) * Amplitude!(Rank%))
z2% = z2n% * (1 + Noise3!(bx%, ay%, az%) * Amplitude!(Rank%))
z3% = z3n% * (1 + Noise3!(bx%, by%, az%) * Amplitude!(Rank%))
z4% = z4n% * (1 + Noise3!(ax%, by%, az%) * Amplitude!(Rank%))
z5% = z5n% * (1 + Noise3!(ax%, ay%, bz%) * Amplitude!(Rank%))
z6% = z6n% * (1 + Noise3!(bx%, ay%, bz%) * Amplitude!(Rank%))
z7% = z7n% * (1 + Noise3!(bx%, by%, bz%) * Amplitude!(Rank%))
z8% = z8n%
        END IF
    END IF

ELSE
ax% = ax% + Grid%
    IF by% - y% > y% - ay% THEN
    by% = by% - Grid%
        IF bz% - z% > z% - az% THEN
        bz% = bz% - Grid%
        z1n% = (z1% + z2%) / 2
        z2n% = z2%
        z3n% = (z3% + z2%) / 2
        z4n% = (z1% + z2% + z3% + z4%) / 4
        z5n% = (z1% + z2% + z5% + z6%) / 4
        z6n% = (z6% + z2%) / 2
        z7n% = (z2% + z3% + z6% + z7%) / 4
        z8n% = (z1% + z2% + z3% + z4% + z5% + z6% + z7% + z8%) / 8
z1% = z1n% * (1 + Noise3!(ax%, ay%, az%) * Amplitude!(Rank%))
z2% = z2n%
z3% = z3n% * (1 + Noise3!(bx%, by%, az%) * Amplitude!(Rank%))
z4% = z4n% * (1 + Noise3!(ax%, by%, az%) * Amplitude!(Rank%))
z5% = z5n% * (1 + Noise3!(ax%, ay%, bz%) * Amplitude!(Rank%))
z6% = z6n% * (1 + Noise3!(bx%, ay%, bz%) * Amplitude!(Rank%))
z7% = z7n% * (1 + Noise3!(bx%, by%, bz%) * Amplitude!(Rank%))
z8% = z8n% * (1 + Noise3!(ax%, by%, bz%) * Amplitude!(Rank%))
        ELSE
        az% = az% + Grid%
        z1n% = (z1% + z2% + z5% + z6%) / 4
        z2n% = (z2% + z6%) / 2
        z3n% = (z2% + z3% + z6% + z7%) / 4
        z4n% = (z1% + z2% + z3% + z4% + z5% + z6% + z7% + z8%) / 8
        z5n% = (z5% + z6%) / 2
        z6n% = z6%
        z7n% = (z6% + z7%) / 2
        z8n% = (z5% + z6% + z7% + z8%) / 4
z1% = z1n% * (1 + Noise3!(ax%, ay%, az%) * Amplitude!(Rank%))
z2% = z2n% * (1 + Noise3!(bx%, ay%, az%) * Amplitude!(Rank%))
z3% = z3n% * (1 + Noise3!(bx%, by%, az%) * Amplitude!(Rank%))
z4% = z4n% * (1 + Noise3!(ax%, by%, az%) * Amplitude!(Rank%))
z5% = z5n% * (1 + Noise3!(ax%, ay%, bz%) * Amplitude!(Rank%))
z6% = z6n%
z7% = z7n% * (1 + Noise3!(bx%, by%, bz%) * Amplitude!(Rank%))
z8% = z8n% * (1 + Noise3!(ax%, by%, bz%) * Amplitude!(Rank%))
        END IF
    ELSE
    ay% = ay% + Grid%
        IF bz% - z% > z% - az% THEN
        bz% = bz% - Grid%
        z1n% = (z1% + z2% + z3% + z4%) / 4
        z2n% = (z3% + z2%) / 2
        z3n% = z3%
        z4n% = (z4% + z3%) / 2
        z5n% = (z1% + z2% + z3% + z4% + z5% + z6% + z7% + z8%) / 8
        z6n% = (z2% + z3% + z6% + z7%) / 4
        z7n% = (z3% + z7%) / 2
        z8n% = (z3% + z4% + z7% + z8%) / 4
z1% = z1n% * (1 + Noise3!(ax%, ay%, az%) * Amplitude!(Rank%))
z2% = z2n% * (1 + Noise3!(bx%, ay%, az%) * Amplitude!(Rank%))
z3% = z3n%
z4% = z4n% * (1 + Noise3!(ax%, by%, az%) * Amplitude!(Rank%))
z5% = z5n% * (1 + Noise3!(ax%, ay%, bz%) * Amplitude!(Rank%))
z6% = z6n% * (1 + Noise3!(bx%, ay%, bz%) * Amplitude!(Rank%))
z7% = z7n% * (1 + Noise3!(bx%, by%, bz%) * Amplitude!(Rank%))
z8% = z8n% * (1 + Noise3!(ax%, by%, bz%) * Amplitude!(Rank%))
        ELSE
        az% = az% + Grid%
        z1n% = (z1% + z2% + z3% + z4% + z5% + z6% + z7% + z8%) / 8
        z2n% = (z2% + z3% + z6% + z7%) / 4
        z3n% = (z3% + z7%) / 2
        z4n% = (z3% + z4% + z7% + z8%) / 4
        z5n% = (z5% + z6% + z7% + z8%) / 4
        z6n% = (z6% + z7%) / 2
        z7n% = z7%
        z8n% = (z7% + z8%) / 2
z1% = z1n% * (1 + Noise3!(ax%, ay%, az%) * Amplitude!(Rank%))
z2% = z2n% * (1 + Noise3!(bx%, ay%, az%) * Amplitude!(Rank%))
z3% = z3n% * (1 + Noise3!(bx%, by%, az%) * Amplitude!(Rank%))
z4% = z4n% * (1 + Noise3!(ax%, by%, az%) * Amplitude!(Rank%))
z5% = z5n% * (1 + Noise3!(ax%, ay%, bz%) * Amplitude!(Rank%))
z6% = z6n% * (1 + Noise3!(bx%, ay%, bz%) * Amplitude!(Rank%))
z7% = z7n%
z8% = z8n% * (1 + Noise3!(ax%, by%, bz%) * Amplitude!(Rank%))
        END IF
END IF

END IF
LOOP

IF ax% = x% AND ay% = y% AND az% = z% THEN zp% = z1%
IF bx% = x% AND ay% = y% AND az% = z% THEN zp% = z2%
IF bx% = x% AND by% = y% AND az% = z% THEN zp% = z3%
IF ax% = x% AND by% = y% AND az% = z% THEN zp% = z4%
IF ax% = x% AND ay% = y% AND bz% = z% THEN zp% = z5%
IF bx% = x% AND ay% = y% AND bz% = z% THEN zp% = z6%
IF bx% = x% AND by% = y% AND bz% = z% THEN zp% = z7%
IF ax% = x% AND by% = y% AND bz% = z% THEN zp% = z8%

Perlin3D% = zp%


END FUNCTION