feat/TD-006-add-captured-borders-draw

This commit is contained in:
gre-ilya 2026-02-28 15:42:30 +05:00
parent 267e3808ea
commit da3b6212c7

View File

@ -109,8 +109,7 @@ end;
function IsTerminalValid: boolean;
begin
IsTerminalValid :=
(ScreenWidth >= ScreenW) and (ScreenHeight >= ScreenH)
IsTerminalValid := (ScreenWidth >= ScreenW) and (ScreenHeight >= ScreenH)
end;
procedure PrintTerminalHelp;
@ -216,11 +215,17 @@ begin
cr.symbol := symbol
end;
function IsOnBorder(var cr: creature): boolean;
function IsOnBorder(var cr: creature; var borders, captured: arena): boolean;
begin
IsOnBorder :=
(cr.curX = 1) or (cr.curX = ArenaW) or (cr.curY = 1) or
(cr.curY = ArenaH)
(cr.curY = ArenaH) or
borders[cr.curX][cr.curY] and (
captured[cr.curX - 1][cr.curY] or
captured[cr.curX + 1][cr.curY] or
captured[cr.curX][cr.curY - 1] or
captured[cr.curX][cr.curY + 1]
)
end;
procedure FillArenaCell(arenaX, arenaY: integer; symbol: char);
@ -268,13 +273,13 @@ 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)
InitCell(figure1, t^.prev^.x, t^.prev^.y - 1);
InitCell(figure2, t^.prev^.x, t^.prev^.y + 1)
end
else
begin
InitCell(figure1, t^.x - 1, t^.y);
InitCell(figure2, t^.x + 1, t^.y)
InitCell(figure1, t^.prev^.x - 1, t^.prev^.y);
InitCell(figure2, t^.prev^.x + 1, t^.prev^.y)
end
end;
@ -365,19 +370,19 @@ begin
end;
{ Kind of bfs algorithm. }
procedure CaptureFigure(var startCell: cellItem; var areaCaptured: integer;
procedure CaptureFigure(var startCell: cellItem; var capturedN: integer;
var borders, captured: arena);
var
curCell: cellItemPtr;
q: QCell;
begin
areaCaptured := 0;
capturedN := 0;
QCellInit(q);
QCellPush(q, startCell);
captured[startCell.x][startCell.y] := true;
while not QCellIsEmpty(q) do
begin
areaCaptured := areaCaptured + 1;
capturedN := capturedN + 1;
curCell := QCellGet(q);
AddAvailableNeighbours(q, curCell, borders, captured);
{
@ -458,25 +463,41 @@ var
begin
for i := 1 to ArenaH do
for j := 1 to ArenaW do
if borders[j][i] or captured[j][i] then
if captured[j][i] then
FillArenaCell(j, i, VoidSymbol)
else
if borders[j][i] then
FillArenaCell(j, i, BorderSymbol)
end;
procedure CutField(var t: tracePtr; var arenaBorders, arenaCaptured: arena);
procedure CutField(var t: tracePtr; var borders, captured: arena);
var
areaCaptured1, areaCaptured2: integer;
captured1, captured2: 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)
if captured[figure1.x][figure1.y] then
begin
CaptureFigure(figure2, captured2, borders, captured)
end
else
ReleaseFigure(figure1, arenaCaptured);
if captured[figure2.x][figure2.y] then
begin
CaptureFigure(figure1, captured1, borders, captured)
end
else
begin
Debug;
CaptureFigure(figure1, captured1, borders, captured);
CaptureFigure(figure2, captured2, borders, captured);
if captured1 <= captured2 then
ReleaseFigure(figure2, captured)
else
ReleaseFigure(figure1, captured)
end;
{ Later move to another subroutine }
FillCaptured(arenaBorders, arenaCaptured)
FillCaptured(borders, captured)
end;
procedure RemoveTraceData(var t: tracePtr);
@ -502,15 +523,24 @@ begin
IsTraceExists := IsTraceExists(t^.prev, x, y)
end;
function FindIdx(var t: tracePtr; x, y, curIdx: integer): integer;
function FindTraceIdx(var t: tracePtr; x, y, curIdx: integer): integer;
begin
if t = nil then
FindIdx := -1
FindTraceIdx := -1
else
if (t^.x = x) and (t^.y = y) then
FindIdx := curIdx
FindTraceIdx := curIdx
else
FindIdx := FindIdx(t^.prev, x, y, curIdx + 1)
FindTraceIdx := FindTraceIdx(t^.prev, x, y, curIdx + 1)
end;
function Clamp(val, min, max: integer): integer;
begin
Clamp := val;
if val < min then
Clamp := min;
if val > max then
Clamp := max
end;
function { continue here }
@ -519,10 +549,11 @@ HamsterMovePossible(var h: creature; var t: tracePtr; var captured: arena):
var
nextX, nextY, idx: integer;
begin
nextX := h.curX + h.dX;
nextY := h.curY + h.dY;
idx := FindIdx(t, nextX, nextY, 1);
HamsterMovePossible := (idx <= PreviousTraceIdx)
nextX := Clamp(h.curX + h.dX, 1, ArenaW);
nextY := Clamp(h.curY + h.dY, 1, ArenaH);
idx := FindTraceIdx(t, nextX, nextY, 1);
HamsterMovePossible :=
(idx <= PreviousTraceIdx) and not captured[nextX][nextY]
end;
procedure StopCreature(var cr: creature);
@ -565,15 +596,6 @@ begin
end
end;
function Clamp(val, min, max: integer): integer;
begin
Clamp := val;
if val < min then
Clamp := min;
if val > max then
Clamp := max
end;
procedure MoveCreature(var cr: creature);
begin
cr.curX := Clamp(cr.curX + cr.dX, 1, ArenaW);
@ -592,7 +614,7 @@ begin
end;
procedure
AddBorderTrace(var t: tracePtr; var hamster: creature; var arenaBorders: arena);
AddBorderTrace(var t: tracePtr; var hamster: creature; var borders: arena);
begin
if hamster.dX = 2 then
AddTrace(t, hamster.curX - 2, hamster.curY)
@ -605,7 +627,7 @@ begin
else
AddTrace(t, hamster.curX, hamster.curY + 2);
FillArenaCell(t^.x, t^.y, TraceSymbol);
arenaBorders[t^.x][t^.y] := true
borders[t^.x][t^.y] := true
end;
function IsOnTrace(var t: tracePtr; var cr: creature): boolean;
@ -636,7 +658,7 @@ begin
end;
procedure
AddHamsterTrace(var t: tracePtr; var h: creature; var arenaBorders: arena);
AddHamsterTrace(var t: tracePtr; var h: creature; var borders: arena);
var
nextX, nextY: integer;
begin
@ -670,22 +692,22 @@ begin
end;
AddTrace(t, nextX, nextY);
FillArenaCell(t^.x, t^.y, TraceSymbol);
arenaBorders[t^.x][t^.y] := true
borders[t^.x][t^.y] := true
end;
procedure
ChangeHamsterTrace(var t: tracePtr; var h: creature;
var arenaBorders: arena; var redrawArena: boolean);
var borders: arena; var redrawArena: boolean);
var
i: integer;
begin
if IsOnTrace(t, h) then
begin
for i := 1 to HamsterDelta do
PopHamsterTrace(t, arenaBorders);
PopHamsterTrace(t, borders);
if GetTraceLength(t) = 1 then
begin
PopHamsterTrace(t, arenaBorders);
PopHamsterTrace(t, borders);
redrawArena := true
end
end
@ -693,11 +715,11 @@ begin
begin
if t = nil then
begin
AddBorderTrace(t, h, arenaBorders);
AddBorderTrace(t, h, borders);
redrawArena := true
end;
for i := 1 to HamsterDelta do
AddHamsterTrace(t, h, arenaBorders)
AddHamsterTrace(t, h, borders)
end
end;
@ -730,41 +752,41 @@ end;
procedure RunLevel;
var
hamster: creature;
arenaCaptured, arenaBorders: arena;
captured, borders: arena;
hamsterTrace: tracePtr = nil;
continueLevel: boolean = true;
redrawArena: boolean = false;
begin
FillArena(arenaCaptured, false);
FillArena(arenaBorders, false);
FillArena(captured, false);
FillArena(borders, false);
InitiateCreature(hamster, 5, 1, 0, 0, HamsterSymbol);
FillArenaCell(hamster.curX, hamster.curY, hamster.symbol);
while continueLevel do
begin
delay(DelaySizeMs);
if (hamsterTrace <> nil) and IsOnBorder(hamster) and
if (hamsterTrace <> nil) and IsOnBorder(hamster, borders, captured) and
(hamsterTrace^.prev <> nil) then
begin
CutField(hamsterTrace, arenaBorders, arenaCaptured);
CutField(hamsterTrace, borders, captured);
RemoveTraceData(hamsterTrace);
DrawArena;
FillArenaCell(hamster.curX, hamster.curY, hamster.symbol)
end;
if keypressed then
HandleKey(hamster, continueLevel);
if not HamsterMovePossible(hamster, hamsterTrace, arenaCaptured) then
if not HamsterMovePossible(hamster, hamsterTrace, captured) then
StopCreature(hamster);
if (hamster.dX = 0) and (hamster.dY = 0) then
continue;
if not IsOnBorder(hamster) then
if not IsOnBorder(hamster, borders, captured) then
FillArenaCell(hamster.curX, hamster.curY, TraceSymbol)
else
FillArenaCell(hamster.curX, hamster.curY, ' ');
MoveCreature(hamster);
if IsOnBorder(hamster) and (hamsterTrace = nil) then
if IsOnBorder(hamster, borders, captured) and (hamsterTrace = nil) then
redrawArena := true
else
ChangeHamsterTrace(hamsterTrace, hamster, arenaBorders, redrawArena);
ChangeHamsterTrace(hamsterTrace, hamster, borders, redrawArena);
if redrawArena then
begin
DrawArena;