gre-ilya/gh-scrum
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
gre-ilya 2026-02-28 15:42:30 +05:00
parent 267e3808ea
commit da3b6212c7
1 changed files with 77 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

132
src/gohamster.pas
View File

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