From 267e3808ea5e7987539c70acc3a69c6cc937193c Mon Sep 17 00:00:00 2001 From: gre-ilya Date: Sat, 28 Feb 2026 15:40:16 +0500 Subject: [PATCH] feat/TD-005-add-fill-captured --- src/gohamster.pas | 418 +++++++++++++++++++++++++++++++++++++++------- 1 file changed, 356 insertions(+), 62 deletions(-) diff --git a/src/gohamster.pas b/src/gohamster.pas index ced5a30..9caca21 100644 --- a/src/gohamster.pas +++ b/src/gohamster.pas @@ -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) + for i := 1 to HamsterDelta do + 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;