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 Reduce = 120; // somewhat arbirary reduction factor is Reduce/(Reduce+1)
          Fudge  = 5; // Fudge factor to help avoid local maximums when running rivers.

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

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

        tMyTiles = array [1..LxMax, 1..LyMax] of tRData;
        tSizeArray = array [1..1000] of integer;  // Arbitrary large size

    private
        fMap: tMap;
        fRMap: tMyTiles;

        fIslandSizes: tSizeArray;
        fPercentage: integer;

    protected
        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 LargestIsland: 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(Island: integer; out SW, SH: integer): boolean;

		procedure Validate;
        procedure CheckIsland(W, H, IC: integer);
        procedure RunRivers;
        procedure SetIslands;
    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);
    fIslandSizes := default(tSizeArray);
end;

procedure tRivers.Free;
begin
    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.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) 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;

procedure tRivers.CheckIsland(W, H, IC: integer);
var N,NW,NH: integer;
    MyBors: tNeighbours;
begin
    fRMap[W, H].Island := IC;
    Inc(fIslandSizes[IC]);

    MyBors := GetNeighbours(W, H);
    for N := 1 to 4 do
        if OutOfRange(MyBors[N]) then
        {Skip it}
        else
        begin
            NW := MyBors[N].Wid;
            NH := MyBors[N].Hgt;

            if fRMap[NW, NH].AltReal = -1 then
            // Ocean
            else
            if fRMap[NW, NH].Island > 0 then
            // Already allocated to an island
            else
            begin
                fRMap[NW, NH].Island := IC;

                //Recurse
                CheckIsland(NW, NH, IC);
            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.LargestIsland: integer;
var I: integer;
begin
    LargestIsland := 0;

    for I := low(fIslandSizes) to high(fIslandSizes) do
        if fIslandSizes[I] > LargestIsland then
            LargestIsland := I;

    // Reduce priority of this Island
    fIslandSizes[LargestIsland] := (Reduce * fIslandSizes[LargestIsland]) div (Reduce+1);
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,N,NW,NH : Integer;
begin
    C := 0;
    if SeaTiles (W,H) = 1 then
        for N := 1 to 8 do
        begin
            fMap.SetNeighbour(W,H,N,NW,NH);
            if fRMap[NW,NH].ALtReal = -1 then
                inc (C);
        end;

    Estuary := C in [1,2];
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(Island: integer; out SW, SH: integer): boolean;
var GCT,CS,W,H: integer;
begin
    result := False;
    SW := 0;
    SH := 0;
    CS := 9; // Impossible result

    for W := 1 to fMap.Width do
      for H := 1 to fMap.Height do
        if fRMap[W, H].Island <> Island then
            // Not this island
        else
        if NearToRiver(W, H) then
            // Space out River starts
        else
        if Estuary(W, H) then
        begin
            GCT := GetCoastalTiles(W, H);
            if (GCT > 0) and (GCT < CS) then
            begin
                // Best so far
                SW := W;
                SH := H;
                CS := GCT;
                result := True;
            end;
        end;

    {if result then
        Writeln('Best Start ', Island, ' ', fIslandSizes[Island], '  ', SW,
            ',', SH, '  ', fMap.MapIndex(SW, SH) - 1);}
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;

procedure tRivers.RunRivers;
var I,SW,SH,Land,Target,Island: integer;
begin
    Land := 0;
    for I := low(fIslandSizes) to high (fIslandSizes) do
        Land := Land + fIslandSizes[I];

    Target := (Land * fPercentage) div 100;
    
    while Target > 0 do
    begin
        Island := LargestIsland;

        if fIslandSizes[Island] = 0 then
            Target := 0 // Terminate loop
        else
        if BestStart(Island, SW, SH) then
            Target := Target - RunRiver(SW, SH);
    end;
end;

procedure tRivers.Validate;
var IC,W,H,I: integer;
begin
	for I := low(fIslandSizes) to high(fIslandSizes) do
		if fIslandSizes[I] <> 0 then
		begin
			IC := 0;
			for W := 1 to fMap.Width do
				for H := 1 to fMap.Height do
					if fRMap[W, H].Island = I then
						inc (IC);
			Assert (fIslandSizes[I] =IC);
		end;
end;

procedure tRivers.SetIslands;
var IC,W,H: integer;
begin
    IC := 0;
    for W := 1 to fMap.Width do
      for H := 1 to fMap.Height do
        if fRMap[W, H].AltReal = -1 then
        // Ignore Ocean squares
        else
        begin
            if fRMap[W, H].Island = 0 then
            begin
                Inc(IC);

                CheckIsland(W, H, IC);
            end;
        end;
    Validate;
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;
end;


procedure tRivers.Generate;
begin
    SetIslands;
    RunRivers;
end;

end.
