gh/src/arena_m.pas

513 lines
13 KiB
ObjectPascal
Raw Normal View History

2025-11-24 15:34:27 +00:00
unit arena_m;
interface
uses creature_m, trace_m;
const
ArenaW = 33;
ArenaH = 41;
RandomCutThreshold = 20;
RandomOneToOne = 2;
type
arenaMatrix = array [1..ArenaH, 1..ArenaW] of boolean;
arena = record
captured, borders: arenaMatrix;
end;
function ArenaCellCaptured(x, y: integer; var a: arena): boolean;
function ArenaSplited(var h: creature; var t: tracePtr; var a: arena): boolean;
function GhostShouldTurn(var g: creature; var a: arena): boolean;
function
HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean;
function IsOnBorder(var x, y: integer; var a: arena): boolean;
function IsOnEdge(var cr: creature): boolean;
function IsOnEdge(x, y: integer): boolean;
procedure CutPart(var hamster: creature; var t: tracePtr;
var cutOff: integer; var a: arena);
procedure InitArena(var a: arena);
procedure MakeEnemyStep(var e, h: creature; t: tracePtr; var a: arena);
procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
procedure SetArenaBorder(var t: tracePtr; var a: arena);
procedure TurnGhost(var g: creature; var a: arena);
implementation
uses arena_graphics_m, cell_m, crt, graphics_m, math_m;
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 <> ArenaH + 1) and
(y <> 0) and (y <> ArenaW + 1) and
not a.captured[x][y] and not a.borders[x][y]
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^.x][cell^.y] := 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.x][cell.y] then
continue;
result := result + 1;
a.captured[cell.x][cell.y] := 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.x][cell.y] then
continue;
cutOff := cutOff + 1;
a.captured[cell.x][cell.y] := true;
DrawArenaCell(cell.x, cell.y, CaptureSymbol);
AddAvailableNeighbours(captureQ, cell, a)
end
end;
function OnEdgeX(x: integer): boolean;
begin
OnEdgeX := (x = 1) or (x = ArenaH)
end;
function OnEdgeY(y: integer): boolean;
begin
OnEdgeY := (y = 1) or (y = ArenaW)
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[x][y - 1] and a.captured[x][y + 1]
end;
function XNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
XNeighboursCaptured :=
not OnEdgeX(x) and a.captured[x + 1][y] and a.captured[x - 1][y]
end;
function DiagonalNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
DiagonalNeighboursCaptured :=
not IsOnEdge(x, y) and
a.captured[x - 1][y - 1] and a.captured[x - 1][y + 1] and
a.captured[x + 1][y - 1] and a.captured[x + 1][y + 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[x][y] := false;
a.captured[x][y] := true;
DrawArenaCell(x, y, CaptureSymbol)
end;
procedure CaptureCutBorders(var a: arena; var cutOff: integer); {rename, slow}
var
i, j: integer;
begin
for i := 1 to ArenaW do
for j := 1 to ArenaH do
if a.borders[j][i] 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
begin
a.borders[t^.x][t^.y] := true;
SetArenaBorder(t^.prev, a)
end
end;
function IsOnEdge(var cr: creature): boolean;
begin
IsOnEdge :=
(cr.curX = 1) or (cr.curX = ArenaH) or (cr.curY = 1) or
(cr.curY = ArenaW)
end;
function IsOnBorder(var x, y: integer; var a: arena): boolean;
begin
IsOnBorder :=
a.borders[x][y] and (
a.captured[x - 1][y + 1] or
a.captured[x - 1][y - 1] or
a.captured[x + 1][y + 1] or
a.captured[x + 1][y - 1]
)
end;
function IsOnBorder(var cr: creature; var a: arena): boolean;
begin
IsOnBorder :=
a.borders[cr.curX][cr.curY] and (
a.captured[cr.curX - 1][cr.curY + 1] or
a.captured[cr.curX - 1][cr.curY - 1] or
a.captured[cr.curX + 1][cr.curY + 1] or
a.captured[cr.curX + 1][cr.curY - 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 / 100;
LowerToBiggerRatio := Round(100 - 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, ArenaH);
nextY := Clamp(hamster.curY + hamster.dY, 1, ArenaW);
idx := FindIndex(t, nextX, nextY, 1);
StepOnTrace := idx > PreviousTraceIdx
end;
function StepBeyondEdge(var cr: creature): boolean;
begin
StepBeyondEdge :=
(cr.dX > 0) and (cr.curX = ArenaH) or
(cr.dX < 0) and (cr.curX = 1) or
(cr.dY > 0) and (cr.curY = ArenaW) or
(cr.dY < 0) and (cr.curY = 1)
end;
function RandomBool: boolean;
begin
if Random(RandomOneToOne) = 1 then
RandomBool := true
else
RandomBool := false
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 CutPart(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, ArenaH);
nextY := Clamp(h.curY + h.dY, 1, ArenaW);
midX := Clamp(h.curX + (h.dX div 2), 1, ArenaH);
midY := Clamp(h.curY + (h.dY div 2), 1, ArenaW);
HamsterStepPossible :=
not StepOnTrace(h, t)
and (not a.captured[midX][midY] or IsOnEdge(nextX, nextY))
and not StepBeyondEdge(h)
and not (
not IsOnEdge(h) and a.borders[h.curX][h.curY] and
a.captured[midX][midY]
)
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[midX][midY] and
not a.borders[hamster.curX][hamster.curY] 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.curX][hamster.curY] and
not a.borders[midX][midY]
end;
procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
begin
MakeStep(h);
if FieldToEdge(h, t, a) or IsOnField(h, t, a) then
ChangeHamsterTrace(h, t);
DrawAfterStep(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 := IsOnEdge(nextX, nextY) or a.borders[nextX][nextY]
end;
function BorderY(nextX, nextY: integer; var a: arena): boolean;
begin
BorderY :=
a.borders[nextX][nextY] and
(a.borders[nextX][nextY - 1] or a.borders[nextX][nextY + 1])
end;
function BorderX(nextX, nextY: integer; var a: arena): boolean;
begin
BorderX :=
a.borders[nextX][nextY] and
(a.borders[nextX - 1][nextY] or a.borders[nextX + 1][nextY])
end;
function IsCorner(x, y: integer; var a: arena): boolean;
begin
IsCorner := BorderX(x, y, a) and BorderY(x, y, a)
end;
function IsConcaveCorner(x, y: integer; var a: arena): boolean;
begin
IsConcaveCorner :=
a.borders[x - 1][y] and a.borders[x][y + 1] or
a.borders[x - 1][y] and a.borders[x][y - 1] or
a.borders[x + 1][y] and a.borders[x][y + 1] or
a.borders[x + 1][y] and a.borders[x][y - 1]
end;
function IsConvexCorner(var cr: creature; var a: arena): boolean;
var
x, y, nextX, nextY: integer;
begin
x := cr.curX;
y := cr.curY;
nextX := x + cr.dX;
nextY := y + cr.dY;
IsConvexCorner :=
IsCorner(nextX, nextY, a) and
not IsOnEdge(nextX, nextY) and
not IsConcaveCorner(x, y, a)
end;
procedure CornerTurn(var cr: creature; var a: arena);
var
x, y, nextX, nextY: integer;
begin
x := cr.curX;
y := cr.curY;
nextX := x + cr.dX;
nextY := y + cr.dY;
if not a.borders[nextX][y] and not a.borders[x][nextY] then
begin
cr.dX := cr.dX * -1;
cr.dY := cr.dY * -1
end
else
if a.borders[nextX][y] then
cr.dX := cr.dX * -1
else
cr.dY := cr.dY * -1
end;
procedure TurnGhost(var g: creature; var a: arena);
var
nextX, nextY: integer;
begin
nextX := g.curX + g.dX;
nextY := g.curY + g.dY;
if IsConvexCorner(g, a) then
begin
CornerTurn(g, a)
end
else
begin
if OnEdgeX(nextX) or BorderY(nextX, nextY, a) then
g.dX := g.dX * -1;
if OnEdgeY(nextY) or BorderX(nextX, nextY, a) then
g.dY := g.dY * -1
end
end;
procedure MakeEnemyStep(var e, h: creature; t: tracePtr; var a: arena);
var
prevX, prevY: integer;
begin
prevX := e.curX;
prevY := e.curY;
MakeStep(e);
DrawAfterEnemyStep(e, a);
if TraceCrossed(prevX, prevY, e, t) then
h.alive := false
end;
end.