458 lines
12 KiB
ObjectPascal
458 lines
12 KiB
ObjectPascal
|
unit arena_m;
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses creature_m, trace_m, hamster_m, debug_m;
|
||
|
|
|
||
|
|
const
|
||
|
|
ArenaH = 33;
|
||
|
|
ArenaW = 41;
|
||
|
|
CaptureSymbol = '.';
|
||
|
|
BorderSymbol = '|';
|
||
|
|
ArenaSymbol = ' ';
|
||
|
|
|
||
|
|
type
|
||
|
|
arenaBooleanMatrix = array [1..ArenaW, 1..ArenaH] of boolean;
|
||
|
|
|
||
|
|
arena = record
|
||
|
|
captured, borders: arenaBooleanMatrix;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function ArenaSplited(var h: creature; var t: tracePtr; var a: arena): boolean;
|
||
|
|
procedure CutSmallerPart(var hamster: creature; var t: tracePtr; var a: arena);
|
||
|
|
function GhostShouldTurn(var g: creature; var a: arena): boolean;
|
||
|
|
function
|
||
|
|
HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean;
|
||
|
|
procedure Init(var a: arena);
|
||
|
|
function IsOnBorder(var x, y: integer; var a: arena): boolean;
|
||
|
|
function IsOnEdge(var cr: creature): boolean;
|
||
|
|
function IsOnEdge(x, y: integer): boolean;
|
||
|
|
procedure MakeEnemyStep(var e: creature; 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 cell_m, graphics_m, math_m;
|
||
|
|
|
||
|
|
procedure Fill(var m: arenaBooleanMatrix; val: boolean);
|
||
|
|
var
|
||
|
|
i, j: integer;
|
||
|
|
begin
|
||
|
|
for i := 1 to ArenaW do
|
||
|
|
for j := 1 to ArenaH do
|
||
|
|
m[i][j] := val
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure Init(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[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 CutPart(var partCell: cellItem; var a: arena);
|
||
|
|
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;
|
||
|
|
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 = 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 YNeighborsCaptured(x, y: integer; var a: arena): boolean;
|
||
|
|
begin
|
||
|
|
YNeighborsCaptured :=
|
||
|
|
not OnEdgeY(y) and a.captured[x][y - 1] and a.captured[x][y + 1]
|
||
|
|
end;
|
||
|
|
|
||
|
|
function XNeighborsCaptured(x, y: integer; var a: arena): boolean;
|
||
|
|
begin
|
||
|
|
XNeighborsCaptured :=
|
||
|
|
not OnEdgeX(x) and a.captured[x + 1][y] and a.captured[x - 1][y]
|
||
|
|
end;
|
||
|
|
|
||
|
|
function DiagonalNeighborsCaptured(x, y: integer; var a: arena): boolean;
|
||
|
|
begin
|
||
|
|
DiagonalNeighborsCaptured :=
|
||
|
|
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 :=
|
||
|
|
XNeighborsCaptured(x, y, a) or YNeighborsCaptured(x, y, a) or
|
||
|
|
DiagonalNeighborsCaptured(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); { rename, slow }
|
||
|
|
var
|
||
|
|
i, j: integer;
|
||
|
|
begin
|
||
|
|
for i := 1 to ArenaH do
|
||
|
|
for j := 1 to ArenaW do
|
||
|
|
if a.borders[j][i] and ArenaCellCaptured(j, i, a) then
|
||
|
|
CaptureArenaBorder(j, i, a)
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure SetArenaBorder(var t: tracePtr; var a: arena);
|
||
|
|
begin
|
||
|
|
if t = nil then
|
||
|
|
exit;
|
||
|
|
a.borders[t^.x][t^.y] := 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[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 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 StepBeyondEdge(var cr: creature): boolean;
|
||
|
|
begin
|
||
|
|
StepBeyondEdge :=
|
||
|
|
(cr.dX > 0) and (cr.curX = ArenaW) or
|
||
|
|
(cr.dX < 0) and (cr.curX = 1) or
|
||
|
|
(cr.dY > 0) and (cr.curY = ArenaH) or
|
||
|
|
(cr.dY < 0) and (cr.curY = 1)
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure CutSmallerPart(var hamster: creature; var t: tracePtr; var a: arena);
|
||
|
|
var {refactor?}
|
||
|
|
area1, area2: integer;
|
||
|
|
part1, part2, smallerFigure: cellItem;
|
||
|
|
begin
|
||
|
|
GetPartsCells(t, part1, part2, a);
|
||
|
|
area1 := GetFigureArea(part1, a);
|
||
|
|
area2 := GetFigureArea(part2, a);
|
||
|
|
if area1 <= area2 then
|
||
|
|
smallerFigure := part1
|
||
|
|
else
|
||
|
|
smallerFigure := part2;
|
||
|
|
CutPart(smallerFigure, a);
|
||
|
|
CaptureCutBorders(a);
|
||
|
|
DrawArenaBorders(a);
|
||
|
|
DrawArenaEdges;
|
||
|
|
DrawCreature(hamster);
|
||
|
|
Delete(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[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: creature; var a: arena);
|
||
|
|
begin
|
||
|
|
MakeStep(e);
|
||
|
|
DrawAfterStep(e, a)
|
||
|
|
end;
|
||
|
|
|
||
|
|
end.
|