From b4b3fabd9064263b8331bfc86432d5f35a3288dd Mon Sep 17 00:00:00 2001 From: gre-ilya Date: Sat, 28 Feb 2026 15:45:56 +0500 Subject: [PATCH] feat/TD-007-captured-cells-blocked --- src/gohamster.pas | 159 +++++++++++++++++++++++++++++++++------------- 1 file changed, 114 insertions(+), 45 deletions(-) diff --git a/src/gohamster.pas b/src/gohamster.pas index c39ce30..04035c9 100644 --- a/src/gohamster.pas +++ b/src/gohamster.pas @@ -78,13 +78,6 @@ type first, last: cellItemPtr end; -procedure Debug; -begin - GotoXY(2, DebugTmp); - writeln(DebugMsg); - DebugTmp := DebugTmp + 1 -end; - procedure DebugCell(curCell: cellItemPtr); begin GotoXY(2, DebugTmp); @@ -92,7 +85,7 @@ begin DebugTmp := DebugTmp + 1 end; -procedure DebugPrintArena(var a, b: arena); +procedure DebugOrArenas(var a, b: arena); var i, j: integer; begin @@ -107,6 +100,21 @@ begin end end; +procedure DebugPrintArena(var a: arena); +var + i, j: integer; +begin + for i := 1 to ArenaH do + begin + for j := 1 to ArenaW do + if a[j][i] then + write(1, ' ') + else + write(0, ' '); + writeln + end +end; + function IsTerminalValid: boolean; begin IsTerminalValid := (ScreenWidth >= ScreenW) and (ScreenHeight >= ScreenH) @@ -215,16 +223,21 @@ begin cr.symbol := symbol 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 cr: creature; var borders, captured: arena): boolean; begin IsOnBorder := - (cr.curX = 1) or (cr.curX = ArenaW) or (cr.curY = 1) or - (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] + captured[cr.curX - 1][cr.curY + 1] or + captured[cr.curX - 1][cr.curY - 1] or + captured[cr.curX + 1][cr.curY + 1] or + captured[cr.curX + 1][cr.curY - 1] ) end; @@ -269,17 +282,24 @@ begin c.next := nil end; -procedure GetFiguresCells(var t: tracePtr; var figure1, figure2: cellItem); +procedure GetFiguresCells(var t: tracePtr; var figure1, figure2: cellItem; + var captured: arena); +var + prevTrace: tracePtr; begin - if (t^.x = 1) or (t^.x = ArenaW) then + prevTrace := t^.prev; + {if (t^.x = 1) or (t^.x = ArenaW) or + (t^.y <> 1) and captured[prevTrace^.x][prevTrace^.y - 1] or + (t^.y <> ArenaH) and captured[prevTrace^.x][prevTrace^.y + 1] then} + if t^.y = prevTrace^.y then begin - InitCell(figure1, t^.prev^.x, t^.prev^.y - 1); - InitCell(figure2, t^.prev^.x, t^.prev^.y + 1) + InitCell(figure1, prevTrace^.x, prevTrace^.y - 1); + InitCell(figure2, prevTrace^.x, prevTrace^.y + 1) end else begin - InitCell(figure1, t^.prev^.x - 1, t^.prev^.y); - InitCell(figure2, t^.prev^.x + 1, t^.prev^.y) + InitCell(figure1, prevTrace^.x - 1, prevTrace^.y); + InitCell(figure2, prevTrace^.x + 1, prevTrace^.y) end end; @@ -388,7 +408,7 @@ begin { clrscr; writeln('x: ', curCell^.x, ' y: ', curCell^.y); - DebugPrintArena(borders, captured); + DebugOrArenas(borders, captured); } QCellPop(q) end @@ -475,7 +495,7 @@ var captured1, captured2: integer; figure1, figure2: cellItem; begin - GetFiguresCells(t, figure1, figure2); + GetFiguresCells(t, figure1, figure2, captured); if captured[figure1.x][figure1.y] then begin CaptureFigure(figure2, captured2, borders, captured) @@ -487,7 +507,6 @@ begin end else begin - Debug; CaptureFigure(figure1, captured1, borders, captured); CaptureFigure(figure2, captured2, borders, captured); if captured1 <= captured2 then @@ -500,7 +519,25 @@ begin FillCaptured(borders, captured) end; -procedure RemoveTraceData(var t: tracePtr); +procedure RemoveCutedBorders(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] and + (((j = 1) or (i = 1) or captured[j - 1][i - 1] or borders[j - 1][i - 1]) and + ((i = 1) or captured[j + 1][i - 1] or borders[j + 1][i - 1]) and + ((j = 1) or captured[j - 1][i + 1] or borders[j - 1][i + 1]) and + (captured[j + 1][i + 1] or borders[j + 1][i + 1])) then + begin + borders[j][i] := false; + captured[j][i] := true; + FillArenaCell(j, i, VoidSymbol) + end +end; + +procedure DisposeTraces(var t: tracePtr); var tmpT: tracePtr; begin @@ -562,12 +599,22 @@ begin cr.dY := 0 end; -procedure DrawArena; +procedure DrawArenaEdge; begin DrawRectangle(1, InterfaceBarH, ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient) end; +procedure DrawArenaBorders(var borders: arena); +var + i, j: integer; +begin + for i := 1 to ArenaH do + for j := 1 to ArenaW do + if borders[j][i] then + FillArenaCell(j, i, BorderSymbol) +end; + procedure UpdateDelta(keyCode: integer; var cr: creature); { Refactor later } begin case keyCode of @@ -697,7 +744,7 @@ end; procedure ChangeHamsterTrace(var t: tracePtr; var h: creature; - var borders: arena; var redrawArena: boolean); + var borders: arena; var redrawEdge: boolean); var i: integer; begin @@ -708,7 +755,7 @@ begin if GetTraceLength(t) = 1 then begin PopHamsterTrace(t, borders); - redrawArena := true + redrawEdge := true end end else @@ -716,7 +763,7 @@ begin if t = nil then begin AddBorderTrace(t, h, borders); - redrawArena := true + redrawEdge := true end; for i := 1 to HamsterDelta do AddHamsterTrace(t, h, borders) @@ -755,7 +802,8 @@ var captured, borders: arena; hamsterTrace: tracePtr = nil; continueLevel: boolean = true; - redrawArena: boolean = false; + redrawEdge: boolean = false; + redrawBorders: boolean = false; begin FillArena(captured, false); FillArena(borders, false); @@ -764,13 +812,21 @@ begin while continueLevel do begin delay(DelaySizeMs); - if (hamsterTrace <> nil) and IsOnBorder(hamster, borders, captured) and + if (hamsterTrace <> nil) and + (IsOnBorder(hamster, borders, captured) or IsOnEdge(hamster)) and (hamsterTrace^.prev <> nil) then begin CutField(hamsterTrace, borders, captured); - RemoveTraceData(hamsterTrace); - DrawArena; - FillArenaCell(hamster.curX, hamster.curY, hamster.symbol) + RemoveCutedBorders(borders, captured); + DisposeTraces(hamsterTrace); + DrawArenaBorders(borders); + DrawArenaEdge; + FillArenaCell(hamster.curX, hamster.curY, hamster.symbol); + {debug} + { + clrscr; + DebugOrArenas(borders, captured) + } end; if keypressed then HandleKey(hamster, continueLevel); @@ -778,19 +834,32 @@ begin StopCreature(hamster); if (hamster.dX = 0) and (hamster.dY = 0) then continue; - if not IsOnBorder(hamster, borders, captured) then - FillArenaCell(hamster.curX, hamster.curY, TraceSymbol) - else - FillArenaCell(hamster.curX, hamster.curY, ' '); - MoveCreature(hamster); - if IsOnBorder(hamster, borders, captured) and (hamsterTrace = nil) then - redrawArena := true - else - ChangeHamsterTrace(hamsterTrace, hamster, borders, redrawArena); - if redrawArena then + if not IsOnEdge(hamster) and + not IsOnBorder(hamster, borders, captured) then begin - DrawArena; - redrawArena := false + FillArenaCell(hamster.curX, hamster.curY, TraceSymbol) + end + else + begin + FillArenaCell(hamster.curX, hamster.curY, ' ') + end; + MoveCreature(hamster); + if IsOnEdge(hamster) and (hamsterTrace = nil) then + redrawEdge := true + else + if IsOnBorder(hamster, borders, captured) and (hamsterTrace = nil) then + redrawBorders := true + else + ChangeHamsterTrace(hamsterTrace, hamster, borders, redrawEdge); + if redrawEdge then + begin + DrawArenaEdge; + redrawEdge := false + end; + if redrawBorders then + begin + DrawArenaBorders(borders); + redrawBorders := false end; FillArenaCell(hamster.curX, hamster.curY, hamster.symbol) end