gh/arena_m.pas

unit arena_m;

interface

uses creature_m, trace_m;

const
    ArenaH = 33;
    ArenaW = 41;
    TotalCells = ArenaW * ArenaH;
    RandomCutThreshold = 25;

type
    arenaMatrix = array [1..ArenaH, 1..ArenaW] of boolean;

    arena = record
        captured, borders: arenaMatrix;
    end;

function ArenaSplited(var h: creature; var t: tracePtr; var a: arena): boolean;
function
HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean;
function IsOnEdge(var cr: creature): boolean;
function IsOnEdge(x, y: integer): boolean;
procedure ArenaCutPart(var hamster: creature; var t: tracePtr;
                       var cutOff: integer; var a: arena);
procedure InitArena(var a: arena);
procedure KillCapturedEnemies(var a: arena; var e: creatureList);
procedure EraseEnemies(var a: arena; var e: creatureList);
procedure MakeEnemySteps(var a: arena; var h: creature;
                         t: tracePtr; var e: creatureList);
procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
procedure SetArenaBorder(var t: tracePtr; var a: arena);
procedure TurnStubbornEnemies(var a: arena; var e: creatureList);
procedure MakeStep(var a: arena; var cr: creature);



implementation

uses arena_graphics_m, cell_m, crt, graphics_m, math_m, Math;

const
    MaxTurnAttempts = 3;
    TotalProcent = 100;

procedure Fill(var m: arenaMatrix; val: boolean);
var
    i, j: integer;
begin
    for i := 1 to ArenaH do
        for j := 1 to ArenaW do
            m[i][j] := val
end;

procedure InitArena(var a: arena);
begin
    Fill(a.captured, false);
    Fill(a.borders, false)
end;

function IsCellFree(x, y: integer; var a: arena): boolean;
begin
    IsCellFree :=
        (x <> 0) and (x <> ArenaW + 1) and
        (y <> 0) and (y <> ArenaH + 1) and
        not a.captured[y][x] and not a.borders[y][x]
end;

procedure ReleaseArenaCells(var q: QCell; var a: arena);
var
    cell: cellItemPtr;
begin
    while not QCellIsEmpty(q) do
    begin
        cell := QCellGet(q);
        a.captured[cell^.y][cell^.x] := false;
        QCellPop(q)
    end
end;

procedure TryAddCell(x, y: integer; var q: QCell; var a: arena);
var
    cell: cellItem;
begin
    if IsCellFree(x, y, a) then
    begin
        InitCell(cell, x, y);
        QCellPush(q, cell)
    end
end;

{ bfs algo iteration }
procedure AddAvailableNeighbours(var q: QCell; var curCell: cellItem;
                                 var a: arena);
var
    x, y: integer;
begin
    x := curCell.x;
    y := curCell.y;
    TryAddCell(x - 1, y, q, a);
    TryAddCell(x + 1, y, q, a);
    TryAddCell(x, y - 1, q, a);
    TryAddCell(x, y + 1, q, a)
end;

{ Kind of bfs algorithm. }
function GetFigureArea(var partCell: cellItem; var a: arena): integer;
var
    cellPtr: cellItemPtr;
    cell: cellItem;
    captureQ, releaseQ: QCell;
    result: integer = 0;
begin
    QCellInit(captureQ);
    QCellInit(releaseQ);
    QCellPush(captureQ, partCell);
    while not QCellIsEmpty(captureQ) do
    begin
        cellPtr := QCellGet(captureQ);
        InitCell(cell, cellPtr^.x, cellPtr^.y);
        QCellPop(captureQ);
        if a.captured[cell.y][cell.x] then
            continue;
        result := result + 1;
        a.captured[cell.y][cell.x] := true;
        AddAvailableNeighbours(captureQ, cell, a);
        QCellPush(releaseQ, cell)
    end;
    ReleaseArenaCells(releaseQ, a);
    GetFigureArea := result
end;

procedure
CutChosenPart(var partCell: cellItem; var a: arena; var cutOff: integer);
var
    cellPtr: cellItemPtr;
    cell: cellItem;
    captureQ: QCell;
begin
    QCellInit(captureQ);
    QCellPush(captureQ, partCell);
    while not QCellIsEmpty(captureQ) do
    begin
        cellPtr := QCellGet(captureQ);
        InitCell(cell, cellPtr^.x, cellPtr^.y);
        QCellPop(captureQ);
        if a.captured[cell.y][cell.x] then
            continue;
        cutOff := cutOff + 1;
        a.captured[cell.y][cell.x] := true;
        DrawArenaCell(cell.x, cell.y, a);
        AddAvailableNeighbours(captureQ, cell, a)
    end
end;

function OnEdgeX(x: integer): boolean;
begin
    OnEdgeX := (x = 1) or (x = ArenaW)
end;

function OnEdgeY(y: integer): boolean;
begin
    OnEdgeY := (y = 1) or (y = ArenaH)
end;

function IsOnEdge(x, y: integer): boolean;
begin
    IsOnEdge := (OnEdgeX(x) or OnEdgeY(y))
end;

function YNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
    YNeighboursCaptured :=
        not OnEdgeY(y) and a.captured[y + 1][x] and a.captured[y - 1][x]
end;

function XNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
    XNeighboursCaptured :=
        not OnEdgeX(x) and a.captured[y][x + 1] and a.captured[y][x - 1]
end;

function DiagonalNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
    DiagonalNeighboursCaptured :=
        not IsOnEdge(x, y) and
        a.captured[y - 1][x - 1] and a.captured[y + 1][x - 1] and
        a.captured[y - 1][x + 1] and a.captured[y + 1][x + 1]
end;

function ArenaCellCaptured(x, y: integer; var a: arena): boolean;
begin
    ArenaCellCaptured :=
        XNeighboursCaptured(x, y, a) or YNeighboursCaptured(x, y, a) or
        DiagonalNeighboursCaptured(x, y, a)
end;

procedure CaptureArenaBorder(x, y: integer; var a: arena);
begin
    a.borders[y][x] := false;
    a.captured[y][x] := true;
    DrawFieldCell(x, y, CaptureSymbol)
end;

procedure CaptureCutBorders(var a: arena; var cutOff: integer); {rename, slow}
var
    i, j: integer;
begin
    for i := 1 to ArenaH do
        for j := 1 to ArenaW do
            if a.borders[i][j] and ArenaCellCaptured(j, i, a) then
            begin
                cutOff := cutOff + 1;
                CaptureArenaBorder(j, i, a)
            end
end;

procedure SetArenaBorder(var t: tracePtr; var a: arena);
begin
    if t = nil then
        exit;
    a.borders[t^.y][t^.x] := true;
    SetArenaBorder(t^.prev, a)
end;

function IsOnEdge(var cr: creature): boolean;
begin
    IsOnEdge :=
        (cr.curX = 1) or (cr.curX = ArenaW) or (cr.curY = 1) or
        (cr.curY = ArenaH)
end;

function IsOnBorder(var x, y: integer; var a: arena): boolean;
begin
    IsOnBorder :=
        a.borders[y][x] and (
            a.captured[y + 1][x - 1] or
            a.captured[y - 1][x - 1] or
            a.captured[y + 1][x + 1] or
            a.captured[y - 1][x + 1]
        )
end;

function IsOnBorder(var cr: creature; var a: arena): boolean;
begin
    IsOnBorder :=
        a.borders[cr.curY][cr.curX] and (
            a.captured[cr.curY + 1][cr.curX - 1] or
            a.captured[cr.curY - 1][cr.curX - 1] or
            a.captured[cr.curY + 1][cr.curX + 1] or
            a.captured[cr.curY - 1][cr.curX + 1]
        )
end;

function ArenaSplited(var h: creature; var t: tracePtr; var a: arena): boolean;
begin
    ArenaSplited :=
        (t <> nil) and (IsOnBorder(h, a) or IsOnEdge(h)) and (t^.prev <> nil)
end;

procedure GetPartsCells(var t: tracePtr; var part1, part2: cellItem;
                        var a: arena);
var
    prevTrace: tracePtr;
begin
    prevTrace := t^.prev;
    if t^.y = prevTrace^.y then
    begin
        InitCell(part1, prevTrace^.x, prevTrace^.y - 1);
        InitCell(part2, prevTrace^.x, prevTrace^.y + 1)
    end
    else
    begin
        InitCell(part1, prevTrace^.x - 1, prevTrace^.y);
        InitCell(part2, prevTrace^.x + 1, prevTrace^.y)
    end
end;

function LowerToBiggerRatio(val1, val2: integer): integer;
var
    v1, v2, tmp, biggerProcent: real;
begin
    v1 := val1;
    v2 := val2;
    if v1 > v2 then
    begin
        tmp := v1;
        v1 := v2;
        v2 := tmp
    end;
    biggerProcent := v2 / TotalProcent;
    LowerToBiggerRatio := Round(TotalProcent - v1 / biggerProcent)
end;

function StepOnTrace(var hamster: creature; var t: tracePtr): boolean;
var
    nextX, nextY, idx: integer;
begin
    nextX := Clamp(hamster.curX + hamster.dX, 1, ArenaW);
    nextY := Clamp(hamster.curY + hamster.dY, 1, ArenaH);
    idx := FindIndex(t, nextX, nextY, 1);
    StepOnTrace := idx > PreviousTraceIdx
end;

function StepBeyondEdgeX(var cr: creature): boolean;
begin
    StepBeyondEdgeX :=
        (cr.dX > 0) and (cr.curX = ArenaW) or
        (cr.dX < 0) and (cr.curX = 1)
end;

function StepBeyondEdgeY(var cr: creature): boolean;
begin
    StepBeyondEdgeY :=
        (cr.dY > 0) and (cr.curY = ArenaH) or
        (cr.dY < 0) and (cr.curY = 1)
end;

function StepBeyondEdge(var cr: creature): boolean;
begin
    StepBeyondEdge := StepBeyondEdgeX(cr) or StepBeyondEdgeY(cr)
end;

function ChooseRandomCell(p1, p2: cellItem): cellItem;
var
    rb: boolean;
begin
    rb := RandomBool;
    if rb then
        ChooseRandomCell := p1
    else
        ChooseRandomCell := p2
end;

{refactor? pass just level later}
procedure ArenaCutPart(var hamster: creature; var t: tracePtr;
                       var cutOff: integer; var a: arena);
var
    area1, area2, diffProcent: integer;
    part1, part2, cutFigure: cellItem;
begin
    GetPartsCells(t, part1, part2, a);
    area1 := GetFigureArea(part1, a);
    area2 := GetFigureArea(part2, a);
    diffProcent := LowerToBiggerRatio(area1, area2);
    if diffProcent <= RandomCutThreshold then
        cutFigure := ChooseRandomCell(part1, part2)
    else
    if area1 <= area2 then
        cutFigure := part1
    else
        cutFigure := part2;
    CutChosenPart(cutFigure, a, cutOff);
    CaptureCutBorders(a, cutOff);
    DrawArenaBorders(a);
    DrawArenaEdges;
    DrawCreature(hamster);
    DeleteTrace(t)
end;

function
HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean;
var 
    nextX, nextY, midX, midY: integer;
begin
    nextX := Clamp(h.curX + h.dX, 1, ArenaW);
    nextY := Clamp(h.curY + h.dY, 1, ArenaH);
    midX := Clamp(h.curX + (h.dX div 2), 1, ArenaW);
    midY := Clamp(h.curY + (h.dY div 2), 1, ArenaH);
    HamsterStepPossible :=
        not StepOnTrace(h, t) 
        and (not a.captured[midY][midX] or IsOnEdge(nextX, nextY))
        and not StepBeyondEdge(h)
        and not (
            not IsOnEdge(h) and a.borders[h.curY][h.curX] and
            a.captured[midY][midX]
        );
end;

function
FieldToEdge(var hamster: creature; var t: tracePtr; var a: arena): boolean;
var
    midX, midY: integer;
begin
    midX := hamster.curX - (hamster.dX div 2);
    midY := hamster.curY - (hamster.dY div 2);
    FieldToEdge :=
        IsOnEdge(hamster) and (t = nil) and not a.captured[midY][midX] and
        not a.borders[hamster.curY][hamster.curX] and
        not (IsOnEdge(midX, midY))
end;

function
IsOnField(var hamster: creature; var t: tracePtr; var a: arena): boolean;
var
    midX, midY: integer;
begin
    midX := hamster.curX - (hamster.dX div 2);
    midY := hamster.curY - (hamster.dY div 2);
    IsOnField :=
        not (IsOnEdge(hamster) and (t = nil)) and
        not a.captured[hamster.curY][hamster.curX] and
        not a.borders[midY][midX]
end;

procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
begin
    h.curX := Clamp(h.curX + h.dX, 1, ArenaW);
    h.curY := Clamp(h.curY + h.dY, 1, ArenaH);
    if FieldToEdge(h, t, a) or IsOnField(h, t, a) then
        ChangeHamsterTrace(h, t);
    DrawAfterHamsterStep(h, t, a)
end;

function GhostShouldTurn(var g: creature; var a: arena): boolean;
var
    nextX, nextY: integer;
begin
    nextX := g.curX + g.dX;
    nextY := g.curY + g.dY;
    GhostShouldTurn := StepBeyondEdge(g) or 
        a.borders[g.curY][g.curX] and a.captured[nextY][nextX]
end;

function SunShouldTurn(var g: creature; var a: arena): boolean;
begin
    SunShouldTurn := true
end;

function VerticalBorder(nextX, nextY: integer; var a: arena): boolean;
begin
    VerticalBorder :=
        a.borders[nextY][nextX] and
        (a.borders[nextY - 1][nextX] or a.borders[nextY + 1][nextX])
end;

function HorizontalBorder(nextX, nextY: integer; var a: arena): boolean;
begin
    HorizontalBorder :=
        a.borders[nextY][nextX] and
        (a.borders[nextY][nextX - 1] or a.borders[nextY][nextX + 1])
end;

function IsCorner(x, y: integer; var a: arena): boolean;
begin
    IsCorner := HorizontalBorder(x, y, a) and VerticalBorder(x, y, a)
end;

procedure TurnGhost(var g: creature; var a: arena);
begin
    if (OnEdgeX(g.curX) or VerticalBorder(g.curX, g.curY, a)) then
        g.dX := g.dX * -1;
    if (OnEdgeY(g.curY) or HorizontalBorder(g.curX, g.curY, a)) then
        g.dY := g.dY * -1
end;

procedure TurnSun(var g: creature; var a: arena);
begin
end;

procedure MakeEnemyStep(var a: arena; var e, h: creature; t: tracePtr);
var
    prevX, prevY: integer;
begin
    prevX := e.curX;
    prevY := e.curY;
    MakeStep(a, e);
    if TraceCrossed(prevX, prevY, e, t) then
        h.alive := false
end;

procedure KillCapturedEnemies(var a: arena; var e: creatureList);
var
    tmp: creatureItemPtr;
begin
    tmp := e.first;
    while tmp <> nil do
    begin
        if tmp^.cr^.alive and a.captured[tmp^.cr^.curY][tmp^.cr^.curX] then
            KillCreature(tmp^.cr^);
        tmp := tmp^.next
    end
end;

procedure TurnEnemy(var cr: creature; var a: arena);
begin
    case cr.t of
        creatureGhost:
            TurnGhost(cr, a);
        creatureSun:
            TurnGhost(cr, a)
    end
end;

function EnemyShouldTurn(var cr: creature; var a: arena): boolean;
begin
    case cr.t of
        creatureGhost:
            EnemyShouldTurn := GhostShouldTurn(cr, a);
        creatureSun:
            EnemyShouldTurn := GhostShouldTurn(cr, a)
    end
end;

procedure TurnStubbornEnemies(var a: arena; var e: creatureList);
var
    turnCnt: integer = 0;
    tmp: creatureItemPtr;
begin
    tmp := e.first;
    while tmp <> nil do
    begin
        while tmp^.cr^.alive and EnemyShouldTurn(tmp^.cr^, a) and
            (turnCnt < MaxTurnAttempts) do
        begin
            TurnEnemy(tmp^.cr^, a);
            turnCnt := turnCnt + 1
        end;
        turnCnt := 0;
        tmp := tmp^.next
    end
end;

procedure EraseEnemies(var a: arena; var e: creatureList);
var
    tmp: creatureItemPtr;
begin
    tmp := e.first;
    while tmp <> nil do
    begin
        if tmp^.cr^.alive and not EnemyShouldTurn(tmp^.cr^, a) then
            RedrawArea(a, tmp^.cr^.curX, tmp^.cr^.curY, tmp^.cr^.t);
        tmp := tmp^.next
    end
end;

procedure MakeEnemySteps(var a: arena; var h: creature;
                         t: tracePtr; var e: creatureList);
var
    tmp: creatureItemPtr;
begin
    tmp := e.first;
    while tmp <> nil do
    begin
        if tmp^.cr^.alive and not EnemyShouldTurn(tmp^.cr^, a) then
            MakeEnemyStep(a, tmp^.cr^, h, t);
        tmp := tmp^.next
    end
end;

procedure MakeStep(var a: arena; var cr: creature);
var
    absDx, absDy, maxD, stepX, stepY, i, nX, nY: integer;
begin
    absDx := Abs(cr.dX);
    absDy := Abs(cr.dY);
    maxD := Max(absDx, absDy);
    stepX := Signum(cr.dX, 0);
    stepY := Signum(cr.dY, 0);
    for i := 1 to maxD do
    begin
        nX := cr.curX + stepX;
        nY := cr.curY + stepY;
        if a.captured[nY][nX] or (nX < 1) or (nX > ArenaW) or
            (nY < 1) or (nY > ArenaH) then
        begin
            break
        end
        else
        begin
            cr.curX := nX;
            cr.curY := nY
        end
    end
end;

end.