diff --git a/src/gohamster.pas b/src/gohamster.pas index 9caca21..c39ce30 100644 --- a/src/gohamster.pas +++ b/src/gohamster.pas @@ -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;