unit Fractal;

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

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

Fractal Terrain Generation (fBm sytle textures),
based on algorithms by F. Kenton Musgrave

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


interface

uses Noise;

type
    TFBm = class
    private
        const ExpArraySize = 16;

    private
        exponent_array: array [1..ExpArraySize] of Double;

        fOctaves,
        fLacunarity: Double;

    public
        constructor Create(H: Double; // fractal increment parameter
            Lacunarity: Double;       // gap between successive frequencies
            Octaves: Double;          // number of frequencies in the fBm
            ResetNoise: Boolean);

        function Compute(point: Vector): Double;
    end;


implementation uses Math, Noises;

var
    Noise3: TNoises;


constructor TfBm.Create
            (H: Double;     // fractal increment parameter
    Lacunarity: Double;     // gap between successive frequencies
    Octaves: Double;        // number of frequencies in the fBm
    ResetNoise: Boolean);

var
    frequency: Double;
    i: Integer;

begin
    inherited Create;

    if ResetNoise then
        Noise3.Free;

    fLacunarity := Lacunarity;

    // Check that octaves is not too large for exponent array
    if Octaves > Pred(ExpArraySize) then
        fOctaves := Pred(ExpArraySize)
    else
        fOctaves := Octaves;

    if (Noise3 = nil) OR ResetNoise then
        Noise3 := TNoises.Create;

    // precompute and store spectral weights
    frequency := 1.0;
    for i := 1 to 1 + Trunc(fOctaves) do
    begin
        // compute weight for each frequency
        exponent_array[i] := power(frequency, -H);
        frequency := frequency * Lacunarity;
    end;
end;


function TfBm.Compute(point: Vector): Double;
const distort = 1.9;
var
    Value, Remainder: Double;
    i: Integer;

begin
    Value := 0.0;
    for i := 1 to Trunc(fOctaves) do
    begin
        Value := Value + Noise3.VRNoise3 (point, distort) * exponent_array[i];

        point.x := point.x * fLacunarity;
        point.y := point.y * fLacunarity;
        point.z := point.z * fLacunarity;
    end;

    Remainder := fOctaves - Trunc(fOctaves);

    if ABS(Remainder) > 0.0001 then
        // add in ``octaves''  remainder
        Value := Value + Remainder * Noise3.VRNoise3(point, distort) * exponent_array[1 + Trunc(fOctaves)];

    Result := Value;
end;

end.
