unit Noise;

{***********************************************************

Project:    C-evo External Map Generator
Copyright:  1999-2023 P Blackman
License:    GPLv3+

Implementation of 'Improved' Perlin Noise
https://mrl.cs.nyu.edu/~perlin/paper445.pdf

***********************************************************}


interface

type
    Vector =
    record
        x: Double;
        y: Double;
        z: Double;
    end;

    TNoise3 = class
    private
        const PBufsize = 255;

    private
        p: array [0..PBufsize + PBufsize] of DWord;

        procedure Setup
                   (vi: Double;
            out b0, b1: DWord;
            out r0, r1: Double);

    protected
        function Compute(vec: Vector): Double;

    public
        constructor Create;
    end;


implementation

constructor TNoise3.Create;
var i, j, k: Integer;

begin
    inherited Create;

    for i := 0 to PBufsize do
        p[i] := i;

    for i := 0 to PBufsize do
    begin
        // Shuffle by swaping each element with a random one
        k    := p[i];
        j    := Random(PBufsize+1);
        p[i] := p[j];
        p[j] := k;
    end;

    // Fill top half of the array
    for i := 0 to PBufsize-1 do
        p[PBufsize+1 + i] := p[i];
end;


procedure TNoise3.Setup
           (vi: Double;
    out b0, b1: DWord;
    out r0, r1: Double);
var  t: Double;

begin
    t  := vi + 100000;
    b0 := Trunc(t) AND 255;
    b1 := (b0 + 1)  AND 255;
    r0 := t - Trunc(t);
    r1 := r0 - 1;
end;


function Grad(Q: DWord; X, Y, Z: Double): Double;
begin
    case Q AND 15 of
        0, 12: Grad  := X+Y;
        1, 13: Grad  := Y-X;
        2: Grad      := X-Y;
        3: Grad      := -X-Y;
        4: Grad      := X+Z;
        5: Grad      := Z-X;
        6: Grad      := X-Z;
        7: Grad      := -X-Z;
        8: Grad      := Y+Z;
        9, 14: Grad  := Z-Y;
        10: Grad     := Y-Z;
        11, 15: Grad := -Y-Z;

    otherwise
        Grad := 0;
    end;
end;

// s_curve 3t^2 -2t^3
function Fade(t: Double): Double; inline;
begin
    Fade := t * t * (3 - (t+t));
end;

// Linear Interpolation
function Lerp(X, A, B: Double): Double; inline;
begin
    Lerp := A + X*(B - A);
end;


function Tnoise3.Compute(vec: Vector): Double;
var i,
    bx0, bx1, by0, by1, bz0, bz1,
    b00, b10, b01, b11: DWord;

    a, b, c, d, sx, sy, sz,
    u00, v00, u01, v01, u10, v10, u11, v11,
    rx0, rx1, ry0, ry1, rz0, rz1: Double;

begin
    setup(vec.x, bx0, bx1, rx0, rx1);
    setup(vec.y, by0, by1, ry0, ry1);
    setup(vec.z, bz0, bz1, rz0, rz1);

    sx := Fade(rx0);
    sy := Fade(ry0);
    sz := Fade(rz0);

    i   := p[bx0];
    b00 := p[i + by0];
    b01 := p[i + by1];

    i   := p[bx1];
    b10 := p[i + by0];
    b11 := p[i + by1];

    u00 := Grad(p[b00 + bz0], rx0, ry0, rz0);
    v00 := Grad(p[b10 + bz0], rx1, ry0, rz0);
    u01 := Grad(p[b01 + bz0], rx0, ry1, rz0);
    v01 := Grad(p[b11 + bz0], rx1, ry1, rz0);
    u10 := Grad(p[b00 + bz1], rx0, ry0, rz1);
    v10 := Grad(p[b10 + bz1], rx1, ry0, rz1);
    u11 := Grad(p[b01 + bz1], rx0, ry1, rz1);
    v11 := Grad(p[b11 + bz1], rx1, ry1, rz1);

    a := Lerp(sx, u00, v00);
    b := Lerp(sx, u01, v01);
    c := Lerp(sy, a, b);

    a := Lerp(sx, u10, v10);
    b := Lerp(sx, u11, v11);
    d := Lerp(sy, a, b);

    Result := Lerp(sz, c, d);
end;


initialization

    Randomize;
end.
