feat/TD-005-add-fill-captured
This commit is contained in:
parent
8e6137af9d
commit
267e3808ea
@ -22,6 +22,9 @@ uses crt;
|
||||
{ Implement snake animation }
|
||||
{ Implement bobr animation }
|
||||
|
||||
var
|
||||
DebugTmp: integer = 2;
|
||||
|
||||
const
|
||||
ArenaH = 33;
|
||||
ArenaW = 41;
|
||||
@ -36,6 +39,7 @@ const
|
||||
BorderSymbol = '#';
|
||||
HamsterSymbol = '*';
|
||||
TraceSymbol = '@';
|
||||
VoidSymbol = '.';
|
||||
DelaySizeMs = 150;
|
||||
SpaceOrd = 32;
|
||||
EscOrd = 27;
|
||||
@ -57,11 +61,51 @@ type
|
||||
tracePtr = ^trace;
|
||||
|
||||
trace = record
|
||||
curX, curY: integer;
|
||||
x, y: integer;
|
||||
prev: tracePtr
|
||||
end;
|
||||
|
||||
arena = array [1..ArenaH, 1..ArenaW] of boolean;
|
||||
arena = array [1..ArenaW, 1..ArenaH] of boolean;
|
||||
|
||||
cellItemPtr = ^cellItem;
|
||||
|
||||
cellItem = record
|
||||
x, y: integer;
|
||||
next: cellItemPtr
|
||||
end;
|
||||
|
||||
QCell = record
|
||||
first, last: cellItemPtr
|
||||
end;
|
||||
|
||||
procedure Debug;
|
||||
begin
|
||||
GotoXY(2, DebugTmp);
|
||||
writeln(DebugMsg);
|
||||
DebugTmp := DebugTmp + 1
|
||||
end;
|
||||
|
||||
procedure DebugCell(curCell: cellItemPtr);
|
||||
begin
|
||||
GotoXY(2, DebugTmp);
|
||||
writeln('Cur X: ', curCell^.x, ' Cur Y: ', curCell^.y);
|
||||
DebugTmp := DebugTmp + 1
|
||||
end;
|
||||
|
||||
procedure DebugPrintArena(var a, b: arena);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for i := 1 to ArenaH do
|
||||
begin
|
||||
for j := 1 to ArenaW do
|
||||
if a[j][i] or b[j][i] then
|
||||
write(1, ' ')
|
||||
else
|
||||
write(0, ' ');
|
||||
writeln
|
||||
end
|
||||
end;
|
||||
|
||||
function IsTerminalValid: boolean;
|
||||
begin
|
||||
@ -153,6 +197,15 @@ begin
|
||||
DrawInterface
|
||||
end;
|
||||
|
||||
procedure FillArena(var a: arena; val: boolean);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for i := 1 to ArenaW do
|
||||
for j := 1 to ArenaH do
|
||||
a[i][j] := val
|
||||
end;
|
||||
|
||||
procedure
|
||||
InitiateCreature(var cr: creature; curX, curY, dX, dY: integer; symbol: char);
|
||||
begin
|
||||
@ -185,20 +238,256 @@ begin
|
||||
GotoXY(1, 1)
|
||||
end;
|
||||
|
||||
procedure CutField(var t: tracePtr);
|
||||
var
|
||||
traceTmp: tracePtr;
|
||||
function GetTraceLength(var t: tracePtr): integer;
|
||||
begin
|
||||
if t = nil then
|
||||
GetTraceLength := 0
|
||||
else
|
||||
GetTraceLength := 1 + GetTraceLength(t^.prev)
|
||||
end;
|
||||
|
||||
function NewCellItem(x, y: integer): cellItemPtr;
|
||||
var
|
||||
newCell: cellItemPtr;
|
||||
begin
|
||||
new(newCell);
|
||||
newCell^.x := x;
|
||||
newCell^.y := y;
|
||||
newCell^.next := nil;
|
||||
NewCellItem := newCell
|
||||
end;
|
||||
|
||||
procedure InitCell(var c: cellItem; x, y: integer);
|
||||
begin
|
||||
c.x := x;
|
||||
c.y := y;
|
||||
c.next := nil
|
||||
end;
|
||||
|
||||
procedure GetFiguresCells(var t: tracePtr; var figure1, figure2: cellItem);
|
||||
begin
|
||||
if (t^.x = 1) or (t^.x = ArenaW) then
|
||||
begin
|
||||
InitCell(figure1, t^.x, t^.y - 1);
|
||||
InitCell(figure2, t^.x, t^.y + 1)
|
||||
end
|
||||
else
|
||||
begin
|
||||
InitCell(figure1, t^.x - 1, t^.y);
|
||||
InitCell(figure2, t^.x + 1, t^.y)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure QCellInit(var q: QCell);
|
||||
begin
|
||||
q.first := nil;
|
||||
q.last := nil
|
||||
end;
|
||||
|
||||
procedure QCellPush(var q: QCell; var c: cellItem);
|
||||
begin
|
||||
if q.last = nil then
|
||||
begin
|
||||
new(q.first);
|
||||
q.first^.x := c.x;
|
||||
q.first^.y := c.y;
|
||||
q.first^.next := nil;
|
||||
q.last := q.first
|
||||
end
|
||||
else
|
||||
begin
|
||||
new(q.last^.next);
|
||||
q.last := q.last^.next;
|
||||
q.last^.x := c.x;
|
||||
q.last^.y := c.y;
|
||||
q.last^.next := nil
|
||||
end
|
||||
end;
|
||||
|
||||
function QCellIsEmpty(var q: QCell): boolean;
|
||||
begin
|
||||
QCellIsEmpty := (q.last = nil)
|
||||
end;
|
||||
|
||||
function QCellGet(var q: QCell): cellItemPtr;
|
||||
begin
|
||||
QCellGet := q.first
|
||||
end;
|
||||
|
||||
function IsCellFree(x, y: integer; var borders, captured: arena): boolean;
|
||||
begin
|
||||
IsCellFree :=
|
||||
(x <> 0) and (x <> ArenaW + 1) and
|
||||
(y <> 0) and (y <> ArenaH + 1) and
|
||||
not captured[x][y] and not borders[x][y]
|
||||
end;
|
||||
|
||||
procedure QCellPop(var q: QCell);
|
||||
var
|
||||
removeItem: cellItemPtr;
|
||||
begin
|
||||
removeItem := QCellGet(q);
|
||||
q.first := removeItem^.next;
|
||||
if q.first = nil then
|
||||
q.last := q.first;
|
||||
dispose(removeItem)
|
||||
end;
|
||||
|
||||
procedure AddAvailableNeighbours(var q: QCell; var curCell: cellItemPtr;
|
||||
var borders, captured: arena);
|
||||
var
|
||||
addCell: cellItem;
|
||||
begin
|
||||
if IsCellFree(curCell^.x - 1, curCell^.y, borders, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x - 1, curCell^.y);
|
||||
captured[addCell.x][addCell.y] := true;
|
||||
QCellPush(q, addCell)
|
||||
end;
|
||||
if IsCellFree(curCell^.x + 1, curCell^.y, borders, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x + 1, curCell^.y);
|
||||
captured[addCell.x][addCell.y] := true;
|
||||
QCellPush(q, addCell)
|
||||
end;
|
||||
if IsCellFree(curCell^.x, curCell^.y - 1, borders, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x, curCell^.y - 1);
|
||||
captured[addCell.x][addCell.y] := true;
|
||||
QCellPush(q, addCell)
|
||||
end;
|
||||
if IsCellFree(curCell^.x, curCell^.y + 1, borders, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x, curCell^.y + 1);
|
||||
captured[addCell.x][addCell.y] := true;
|
||||
QCellPush(q, addCell)
|
||||
end
|
||||
end;
|
||||
|
||||
{ Kind of bfs algorithm. }
|
||||
procedure CaptureFigure(var startCell: cellItem; var areaCaptured: integer;
|
||||
var borders, captured: arena);
|
||||
var
|
||||
curCell: cellItemPtr;
|
||||
q: QCell;
|
||||
begin
|
||||
areaCaptured := 0;
|
||||
QCellInit(q);
|
||||
QCellPush(q, startCell);
|
||||
captured[startCell.x][startCell.y] := true;
|
||||
while not QCellIsEmpty(q) do
|
||||
begin
|
||||
areaCaptured := areaCaptured + 1;
|
||||
curCell := QCellGet(q);
|
||||
AddAvailableNeighbours(q, curCell, borders, captured);
|
||||
{
|
||||
clrscr;
|
||||
writeln('x: ', curCell^.x, ' y: ', curCell^.y);
|
||||
DebugPrintArena(borders, captured);
|
||||
}
|
||||
QCellPop(q)
|
||||
end
|
||||
end;
|
||||
|
||||
function IsCellCaptured(x, y: integer; var captured: arena): boolean;
|
||||
begin
|
||||
IsCellCaptured :=
|
||||
(x <> 0) and (x <> ArenaW + 1) and
|
||||
(y <> 0) and (y <> ArenaH + 1) and
|
||||
captured[x][y]
|
||||
end;
|
||||
|
||||
procedure BfsReleaseCell(x, y: integer; var q: QCell; var captured: arena);
|
||||
var
|
||||
addCell: cellItem;
|
||||
begin
|
||||
InitCell(addCell, x, y);
|
||||
QCellPush(q, addCell);
|
||||
captured[x][y] := false
|
||||
end;
|
||||
|
||||
procedure AddCapturedNeighbours(var q: QCell; var curCell: cellItemPtr;
|
||||
var captured: arena);
|
||||
var
|
||||
addCell: cellItem;
|
||||
begin
|
||||
if IsCellCaptured(curCell^.x - 1, curCell^.y, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x - 1, curCell^.y);
|
||||
captured[addCell.x][addCell.y] := false;
|
||||
QCellPush(q, addCell)
|
||||
end;
|
||||
if IsCellCaptured(curCell^.x + 1, curCell^.y, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x + 1, curCell^.y);
|
||||
captured[addCell.x][addCell.y] := false;
|
||||
QCellPush(q, addCell)
|
||||
end;
|
||||
if IsCellCaptured(curCell^.x, curCell^.y - 1, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x, curCell^.y - 1);
|
||||
captured[addCell.x][addCell.y] := false;
|
||||
QCellPush(q, addCell)
|
||||
end;
|
||||
if IsCellCaptured(curCell^.x, curCell^.y + 1, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x, curCell^.y + 1);
|
||||
captured[addCell.x][addCell.y] := false;
|
||||
QCellPush(q, addCell)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure ReleaseFigure(var startCell: cellItem; var captured: arena);
|
||||
var
|
||||
curCell: cellItemPtr;
|
||||
q: QCell;
|
||||
begin
|
||||
QCellInit(q);
|
||||
QCellPush(q, startCell);
|
||||
while not QCellIsEmpty(q) do
|
||||
begin
|
||||
curCell := QCellGet(q);
|
||||
AddCapturedNeighbours(q, curCell, captured);
|
||||
QCellPop(q)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure FillCaptured(var borders, captured: arena);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for i := 1 to ArenaH do
|
||||
for j := 1 to ArenaW do
|
||||
if borders[j][i] or captured[j][i] then
|
||||
FillArenaCell(j, i, VoidSymbol)
|
||||
end;
|
||||
|
||||
procedure CutField(var t: tracePtr; var arenaBorders, arenaCaptured: arena);
|
||||
var
|
||||
areaCaptured1, areaCaptured2: integer;
|
||||
figure1, figure2: cellItem;
|
||||
begin
|
||||
GetFiguresCells(t, figure1, figure2);
|
||||
CaptureFigure(figure1, areaCaptured1, arenaBorders, arenaCaptured);
|
||||
CaptureFigure(figure2, areaCaptured2, arenaBorders, arenaCaptured);
|
||||
if areaCaptured1 <= areaCaptured2 then
|
||||
ReleaseFigure(figure2, arenaCaptured)
|
||||
else
|
||||
ReleaseFigure(figure1, arenaCaptured);
|
||||
|
||||
{ Later move to another subroutine }
|
||||
FillCaptured(arenaBorders, arenaCaptured)
|
||||
end;
|
||||
|
||||
procedure RemoveTraceData(var t: tracePtr);
|
||||
var
|
||||
tmpT: tracePtr;
|
||||
begin
|
||||
GotoXY(2, 2);
|
||||
writeln(' ');
|
||||
GotoXY(2, 2);
|
||||
writeln(t^.curX, ' ', t^.curY);
|
||||
while t <> nil do
|
||||
begin
|
||||
FillArenaCell(t^.curX, t^.curY, ' ');
|
||||
traceTmp := t^.prev;
|
||||
tmpT := t^.prev;
|
||||
dispose(t);
|
||||
t := traceTmp
|
||||
t := tmpT
|
||||
end
|
||||
end;
|
||||
|
||||
@ -207,7 +496,7 @@ begin
|
||||
if t = nil then
|
||||
IsTraceExists := false
|
||||
else
|
||||
if (t^.curX = x) and (t^.curY = y) then
|
||||
if (t^.x = x) and (t^.y = y) then
|
||||
IsTraceExists := true
|
||||
else
|
||||
IsTraceExists := IsTraceExists(t^.prev, x, y)
|
||||
@ -218,13 +507,15 @@ begin
|
||||
if t = nil then
|
||||
FindIdx := -1
|
||||
else
|
||||
if (t^.curX = x) and (t^.curY = y) then
|
||||
if (t^.x = x) and (t^.y = y) then
|
||||
FindIdx := curIdx
|
||||
else
|
||||
FindIdx := FindIdx(t^.prev, x, y, curIdx + 1)
|
||||
end;
|
||||
|
||||
function HamsterMovePossible(var h: creature; var t: tracePtr): boolean;
|
||||
function { continue here }
|
||||
HamsterMovePossible(var h: creature; var t: tracePtr; var captured: arena):
|
||||
boolean;
|
||||
var
|
||||
nextX, nextY, idx: integer;
|
||||
begin
|
||||
@ -294,13 +585,14 @@ var
|
||||
nextTrace: tracePtr;
|
||||
begin
|
||||
new(nextTrace);
|
||||
nextTrace^.curX := nextX;
|
||||
nextTrace^.curY := nextY;
|
||||
nextTrace^.x := nextX;
|
||||
nextTrace^.y := nextY;
|
||||
nextTrace^.prev := t;
|
||||
t := nextTrace
|
||||
end;
|
||||
|
||||
procedure AddBorderTrace(var t: tracePtr; var hamster: creature; var a: arena);
|
||||
procedure
|
||||
AddBorderTrace(var t: tracePtr; var hamster: creature; var arenaBorders: arena);
|
||||
begin
|
||||
if hamster.dX = 2 then
|
||||
AddTrace(t, hamster.curX - 2, hamster.curY)
|
||||
@ -312,25 +604,19 @@ begin
|
||||
AddTrace(t, hamster.curX, hamster.curY - 2)
|
||||
else
|
||||
AddTrace(t, hamster.curX, hamster.curY + 2);
|
||||
FillArenaCell(t^.curX, t^.curY, TraceSymbol);
|
||||
a[t^.curX][t^.curY] := true
|
||||
FillArenaCell(t^.x, t^.y, TraceSymbol);
|
||||
arenaBorders[t^.x][t^.y] := true
|
||||
end;
|
||||
|
||||
function IsOnTrace(var t: tracePtr; var cr: creature): boolean;
|
||||
var
|
||||
tmp: tracePtr;
|
||||
begin
|
||||
tmp := t;
|
||||
IsOnTrace := false;
|
||||
while tmp <> nil do
|
||||
begin
|
||||
if (tmp^.curX = cr.curX) and (tmp^.curY = cr.curY) then
|
||||
begin
|
||||
IsOnTrace := true;
|
||||
break
|
||||
end;
|
||||
tmp := tmp^.prev
|
||||
end
|
||||
if t = nil then
|
||||
IsOnTrace := false
|
||||
else
|
||||
if (t^.x = cr.curX) and (t^.y = cr.curY) then
|
||||
IsOnTrace := true
|
||||
else
|
||||
IsOnTrace := IsOnTrace(t^.prev, cr)
|
||||
end;
|
||||
|
||||
procedure PopTrace(var t: tracePtr);
|
||||
@ -344,37 +630,38 @@ end;
|
||||
|
||||
procedure PopHamsterTrace(var t: tracePtr; var a: arena);
|
||||
begin
|
||||
FillArenaCell(t^.curX, t^.curY, ' ');
|
||||
a[t^.curY][t^.curX] := false;
|
||||
FillArenaCell(t^.x, t^.y, ' ');
|
||||
a[t^.x][t^.y] := false;
|
||||
PopTrace(t)
|
||||
end;
|
||||
|
||||
procedure AddHamsterTrace(var t: tracePtr; var h: creature; var a: arena);
|
||||
procedure
|
||||
AddHamsterTrace(var t: tracePtr; var h: creature; var arenaBorders: arena);
|
||||
var
|
||||
nextX, nextY: integer;
|
||||
begin
|
||||
if h.curX > t^.curX then
|
||||
if h.curX > t^.x then
|
||||
begin { to right }
|
||||
nextX := t^.curX + 1;
|
||||
nextY := t^.curY
|
||||
nextX := t^.x + 1;
|
||||
nextY := t^.y
|
||||
end
|
||||
else
|
||||
if h.curX < t^.curX then
|
||||
if h.curX < t^.x then
|
||||
begin { to left }
|
||||
nextX := t^.curX - 1;
|
||||
nextY := t^.curY
|
||||
nextX := t^.x - 1;
|
||||
nextY := t^.y
|
||||
end
|
||||
else
|
||||
if h.curY > t^.curY then
|
||||
if h.curY > t^.y then
|
||||
begin { to down }
|
||||
nextX := t^.curX;
|
||||
nextY := t^.curY + 1
|
||||
nextX := t^.x;
|
||||
nextY := t^.y + 1
|
||||
end
|
||||
else
|
||||
if h.curY < t^.curY then
|
||||
if h.curY < t^.y then
|
||||
begin { to up }
|
||||
nextX := t^.curX;
|
||||
nextY := t^.curY - 1
|
||||
nextX := t^.x;
|
||||
nextY := t^.y - 1
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -382,33 +669,35 @@ begin
|
||||
nextY := h.curY
|
||||
end;
|
||||
AddTrace(t, nextX, nextY);
|
||||
FillArenaCell(t^.curX, t^.curY, TraceSymbol);
|
||||
a[t^.curY][t^.curX] := true
|
||||
FillArenaCell(t^.x, t^.y, TraceSymbol);
|
||||
arenaBorders[t^.x][t^.y] := true
|
||||
end;
|
||||
|
||||
procedure
|
||||
ChangeHamsterTrace(var t: tracePtr; var h: creature;
|
||||
var a: arena; var redrawArena: boolean);
|
||||
var arenaBorders: arena; var redrawArena: boolean);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if IsOnTrace(t, h) then
|
||||
begin
|
||||
if t^.prev = nil then { Hamster backed to border }
|
||||
PopHamsterTrace(t, a)
|
||||
else
|
||||
for i := 1 to HamsterDelta do
|
||||
PopHamsterTrace(t, a)
|
||||
PopHamsterTrace(t, arenaBorders);
|
||||
if GetTraceLength(t) = 1 then
|
||||
begin
|
||||
PopHamsterTrace(t, arenaBorders);
|
||||
redrawArena := true
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
if t = nil then
|
||||
begin
|
||||
AddBorderTrace(t, h, a);
|
||||
AddBorderTrace(t, h, arenaBorders);
|
||||
redrawArena := true
|
||||
end;
|
||||
for i := 1 to HamsterDelta do
|
||||
AddHamsterTrace(t, h, a)
|
||||
AddHamsterTrace(t, h, arenaBorders)
|
||||
end
|
||||
end;
|
||||
|
||||
@ -441,11 +730,13 @@ end;
|
||||
procedure RunLevel;
|
||||
var
|
||||
hamster: creature;
|
||||
arenaCells: arena;
|
||||
arenaCaptured, arenaBorders: arena;
|
||||
hamsterTrace: tracePtr = nil;
|
||||
continueLevel: boolean = true;
|
||||
redrawArena: boolean = false;
|
||||
begin
|
||||
FillArena(arenaCaptured, false);
|
||||
FillArena(arenaBorders, false);
|
||||
InitiateCreature(hamster, 5, 1, 0, 0, HamsterSymbol);
|
||||
FillArenaCell(hamster.curX, hamster.curY, hamster.symbol);
|
||||
while continueLevel do
|
||||
@ -454,11 +745,14 @@ begin
|
||||
if (hamsterTrace <> nil) and IsOnBorder(hamster) and
|
||||
(hamsterTrace^.prev <> nil) then
|
||||
begin
|
||||
CutField(hamsterTrace)
|
||||
CutField(hamsterTrace, arenaBorders, arenaCaptured);
|
||||
RemoveTraceData(hamsterTrace);
|
||||
DrawArena;
|
||||
FillArenaCell(hamster.curX, hamster.curY, hamster.symbol)
|
||||
end;
|
||||
if keypressed then
|
||||
HandleKey(hamster, continueLevel);
|
||||
if not HamsterMovePossible(hamster, hamsterTrace) then
|
||||
if not HamsterMovePossible(hamster, hamsterTrace, arenaCaptured) then
|
||||
StopCreature(hamster);
|
||||
if (hamster.dX = 0) and (hamster.dY = 0) then
|
||||
continue;
|
||||
@ -470,7 +764,7 @@ begin
|
||||
if IsOnBorder(hamster) and (hamsterTrace = nil) then
|
||||
redrawArena := true
|
||||
else
|
||||
ChangeHamsterTrace(hamsterTrace, hamster, arenaCells, redrawArena);
|
||||
ChangeHamsterTrace(hamsterTrace, hamster, arenaBorders, redrawArena);
|
||||
if redrawArena then
|
||||
begin
|
||||
DrawArena;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user