unit Rivers;

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

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

Unit to support the generation of rivers (diffusion model).

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

interface

uses MapTiles, CevoMap, Classes;

type
    tRivers = class
    private

    const Fudge  = 7; // Fudge factor to help avoid local maximums when running rivers.

    type
        tNeighbours = array [1..4] of tCell;

        tRData =
            record
            AltReal: integer;
            River: boolean;
        end;

        tMyTiles = array [1..LxMax, 1..LyMax] of tRData;

    private
        fMap: tMap;
        fRMap: tMyTiles;

        fPercentage: integer;

        fWidthSlots  : array of integer;
        fHeightSlots : array of integer;

    protected
        function RiverNeighbours (W, H: integer): integer;
        function NextRiverTile(W, H: integer; out NW, NH: integer): boolean;
        function GetNeighbours(W, H: integer): tNeighbours;
        function OutOfRange(N: tcell): boolean;

        function GetCoastalTiles(W, H: integer): integer;
        function RunRiver(SW, SH: integer): integer;
        function NearToRiver(W, H: integer): boolean;
        function Estuary(W, H: integer): boolean;
        function SeaTiles(W, H: integer): integer;
        function BestStart(out SW, SH: integer): boolean;
        function Getland : integer;

        procedure RandomSequence(var MyArray : array of integer);
    public
        procedure Generate;
        procedure Loaddata(Map: tMap);

        procedure Free;
        constructor Create(Percentage: integer);
    end;


implementation

uses SysUtils;

constructor tRivers.Create(Percentage: integer);
begin
    inherited Create;
    fPercentage := Percentage;

    fRMap := default(tMyTiles);
end;

procedure tRivers.Free;
begin
    SetLength (fWidthSlots,  0);
    SetLength (fHeightSlots, 0);

    inherited Free;
end;


{ Note, some neighbours will be out of height range }
{ Need to wrap width in round world }
function tRivers.GetNeighbours(W, H: integer): tNeighbours;
var MyBors: tNeighbours;
begin
    if Odd(H) then
    begin
        MyBors[1].wid := fmap.WrapCheck(Pred(W));
        MyBors[2].wid := W;
        MyBors[3].wid := W;
        MyBors[4].wid := fmap.WrapCheck(Pred(W));
    end
    else
    begin
        MyBors[1].wid := W;
        MyBors[2].wid := fmap.WrapCheck(Succ(W));
        MyBors[3].wid := fmap.WrapCheck(Succ(W));
        MyBors[4].wid := W;
    end;

    MyBors[1].hgt := H - 1;
    MyBors[2].hgt := H - 1;
    MyBors[3].hgt := H + 1;
    MyBors[4].hgt := H + 1;

    result := MyBors;
end;

function tRivers.OutOfRange(N: tcell): boolean;
begin
    result := (N.wid < 1) or (N.wid > fMap.Width) or (N.hgt < 1) or
        (N.hgt > fMap.Height);
end;

function tRivers.RiverNeighbours (W, H: integer): integer;
var MyBors: tNeighbours;
    N  : Integer;
begin
    MyBors := Getneighbours(W, H);
    Result := 0;
    for N := 1 to 4 do
        if OutOfRange(MyBors[N]) then
        {Skip it}
        else
        if fRMap[MyBors[N].Wid, MyBors[N].Hgt].River then
            inc (Result);
end;

function tRivers.NextRiverTile(W, H: integer; out NW, NH: integer): boolean;
var MyBors: tNeighbours;
    N,Myhgt,nbhgt,lwhgt: integer;
begin
    result := False;
    lwhgt := 1000; // Arbitrary large number;
    NW := 0;
    NH := 0;
    Myhgt := fRMap[W, H].AltReal;
    MyBors := Getneighbours(W, H);

    for N := 1 to 4 do
        if OutOfRange(MyBors[N]) then
        {Skip it}
        else
        if fRMap[MyBors[N].Wid, MyBors[N].Hgt].River then
        // Already a river tile
        else
        begin
            nbhgt := fRMap[MyBors[N].Wid, MyBors[N].Hgt].Altreal;
            if (MyHgt <= nbhgt + Fudge) and (nbhgt < lwhgt)
            and (SeaTiles(MyBors[N].Wid, MyBors[N].Hgt) = 0)
            and (RiverNeighbours (MyBors[N].Wid, MyBors[N].Hgt) < 3) then
            begin
                { Found a lowest higher or equal neighbour, that is not on the coast }
                result := True;
                NW := MyBors[N].Wid;
                NH := MyBors[N].Hgt;
                lwhgt := nbhgt;
            end;
        end;
end;

function tRivers.GetCoastalTiles(W, H: integer): integer;
var N,NW,NH: integer;
begin
    result := 0;
    for N := 1 to 8 do
    begin
        fMap.SetNeighbour(W, H, N, NW, NH);

        if fRMap[NW, NH].AltReal = -1 then
            Inc(result);
    end;
end;

function tRivers.NearToRiver(W, H: integer): boolean;
var N,NW,NH: integer;
begin
    result := False;
    for N := 0 to 20 do
    begin
        // Nothing to do with  cities, but convenient to use this function
        fMap.GetCityNeighbour(W, H, N, NW, NH);

        if (NH > 0) and (NH <= fMap.Height) then
            if fRMap[NW, NH].River then
                result := True;
    end;
end;

function tRivers.Estuary(W, H: integer): boolean;
var C : Integer;
begin
    if SeaTiles (W,H) = 1 then
        C := GetCoastalTiles(W, H)
    else
        C := 0;

    Estuary := C in [1,2,3];
end;

function tRivers.SeaTiles(W, H: integer): integer;
var N: integer;
    MyBors: tNeighbours;
begin
    result := 0;
    MyBors := GetNeighbours(W, H);

    for N := 1 to 4 do
        if OutofRange(MyBors[N]) then
        // skip
        else
        if fRMap[MyBors[N].Wid, MyBors[N].hgt].ALtReal = -1 then
            Inc(result);
end;

function tRivers.BestStart(out SW, SH: integer): boolean;
var GCT,CS,W,H,WS,HS: integer;
begin
    result := False;
    SW := 0;
    SH := 0;
    CS := 9; // Impossible result

    // slots indexed from 0, Map indexed from 1
    for W := 0 to fMap.Width-1 do
    begin
        WS := fWidthSlots[W] +1;
        for H := 0 to fMap.Height-1 do
        begin
            HS := fHeightSlots[H] +1;

            if NearToRiver(WS, HS) then
                // Space out River starts
            else
            if Estuary(WS, HS) then
            begin
                GCT := GetCoastalTiles(WS, HS);
                if (GCT > 0) and (GCT < CS) then
                    if (GCT = 1) and (CS < 9) then
                        // Try avoid starting river from a puddle
                    else
                    begin
                        // Best so far
                        SW := WS;
                        SH := HS;
                        CS := GCT;
                        result := True;
                    end;
            end;
        end;
    end;
end;

function tRivers.RunRiver(SW, SH: integer): integer;
var NW,NH: integer;
begin
    fRMap[SW, SH].River := True;
    fMap.Tiles[SW, SH].River := True;
    result := 1;
    while NextRiverTile(SW, SH, NW, NH) do
    begin
        SW := NW;
        SH := NH;
        fRMap[SW, SH].River := True;
        fMap.Tiles[SW, SH].River := True;
        Inc(result);
    end;

    //Writeln('Run River ', result);
end;

function tRivers.Getland : integer;
var W,H: integer;
begin
    result := 0;
    for W := 1 to fMap.Width do
      for H := 1 to fMap.Height do
        if fRMap[W, H].AltReal <> -1 then
            Inc(result);
end;

procedure tRivers.Generate;
var SW,SH,Target: integer;
begin
    Target := (GetLand * fPercentage) div 100;

    while Target > 0 do
        if BestStart(SW, SH) then
            Target := Target - RunRiver(SW, SH)
        else
            Target := 0 // Terminate loop
end;


procedure tRivers.RandomSequence(var MyArray : array of integer);
var I,J,tmp : integer;
begin
    for I := low(MyArray) to high(MyArray) do
        MyArray[I] := I;

    // Shuffle by swaping each element with a random one
    for I := low(MyArray) to high(MyArray) do
    begin
        tmp         := MyArray[I];
        J           := Random(high(MyArray)+1);
        MyArray[I]  := MyArray[J];
        MyArray[J]  := tmp;
    end;
end;

procedure tRivers.LoadData(Map: tMap);
var W,H: integer;
begin
    fMap := Map;

    for W := 1 to fMap.Width do
      for H := 1 to fMap.Height do
        if fMap.GetVal(Altitude, W, H) < fMap.SeaLevel then
            { Ocean tile }
            fRMap[W, H].AltReal := -1
        else
            fRMap[W, H].AltReal := fMap.GetVal(Altitude, W, H) - fMap.SeaLevel;

    SetLength (fWidthSlots,  fMap.Width);
    SetLength (fHeightSlots, fMap.Height);

    RandomSequence (fWidthSlots);
    RandomSequence (fHeightSlots);
end;

end.