commit 2f436d8e898c6d30fe7fc4ca7065edb88989d21c Author: gre-ilya Date: Mon Nov 24 20:34:27 2025 +0500 init diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..801cddc --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +*.swp +*.o +*.ppu + diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..6f100e4 --- /dev/null +++ b/Makefile @@ -0,0 +1,14 @@ +compile: + fpc src/go + +play: + ./src/go + +# After that you can use in VIM Ctrl-] and Ctrl-^ on functions and procedures +tags: + ctags src/* + cd src/ && ctags * + +wc: + cat src/*.pas | wc -l + diff --git a/README.md b/README.md new file mode 100644 index 0000000..f44b700 --- /dev/null +++ b/README.md @@ -0,0 +1,23 @@ +# Go Hamster + +Это калька на игру с телефона Samsung SGH-S500 под названием Go! Hamster, +играл в неё в далёком детстве :). Решил реализовать в качестве этюда. +Инструментом для реализации выбрал Object Pascal, пишу под терминал UNIX-like +систем. С небольшой правкой в исходниках можно компилить и под Windows, но +библиотека crt слишком медленно там работает, так что ставьте Linux^W^W^W^W^W. +После завершения разработки игры опубликую куда-нибудь в opensource, олды +вспомнят... Для завершения этюда требуется ещё ~10-15 часов работы. + +## FAQ +q: Pascal??? +a: Антихайп. + +## Сборка +```bash +fpc src/go.pas +``` + +## Запуск: +```bash +./src/go +``` diff --git a/src/arena_graphics_m.pas b/src/arena_graphics_m.pas new file mode 100644 index 0000000..e1a982d --- /dev/null +++ b/src/arena_graphics_m.pas @@ -0,0 +1,348 @@ +unit arena_graphics_m; + +interface + +uses arena_m, creature_m, graphics_m, trace_m, level_m; + +const + ArenaSymbol = ' '; + CaptureSymbol = '.'; + +procedure DrawAfterEnemyStep(var cr: creature; var a: arena); +procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena); +procedure DrawArenaBorders(var a: arena); +procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char); +procedure DrawArenaEdges; +procedure DrawCompleteBar; { TODO: IMPLEMENT LATER } +procedure DrawCreature(var cr: creature); +procedure DrawEdge(x, y: integer; var a: arena); +procedure DrawInterface; +procedure DrawLevel(var level: levelState); +procedure DrawLifes(n: integer); +procedure DrawScore(s: integer); +procedure EraseStepTrace(var hamster: creature; t: tracePtr); +procedure EraseTrace(t: tracePtr; var a: arena); + +implementation + +uses crt, math_m; + +const + ArenaPauseLowerMarginY = 14; + ArenaPauseMarginX = 9; + ArenaPauseUpperMarginY = 7; + InterfaceBarH = ScreenW - ArenaW * CellSize - BorderSize * 2; { 14 } + InterfaceCellW = ScreenW div 3; + InterfaceMarginX = InterfaceCellW div 4; + InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1; + LifeBarX = 33; + MidCellDelimiter = '_'; + Notation = 10; + +procedure DrawCompleteBar; +begin +end; + +procedure DrawCreature(var cr: creature); +begin + DrawArenaCell(cr.curX, cr.curY, cr.symbol) +end; + +procedure DrawAfterEnemyStep(var cr: creature; var a: arena); +var + prevX, prevY: integer; +begin + prevX := cr.curX - cr.dX; + prevY := cr.curY - cr.dY; + if IsOnEdge(prevX, prevY) and a.captured[prevX][prevY] then + DrawArenaCell(prevX, prevY, CaptureSymbol) + else + if IsOnBorder(prevX, prevY, a) then + DrawArenaCell(prevX, prevY, BorderSymbol) + else + DrawArenaCell(prevX, prevY, ArenaSymbol); + DrawCreature(cr) +end; + +procedure DrawStepTrace(t: tracePtr; hamsterDelta: integer); +var + i: integer; +begin + for i := 1 to HamsterDelta do + begin + t := t^.prev; + DrawArenaCell(t^.x, t^.y, TraceSymbol) + end +end; + +procedure +DrawPreviousCell(var hamster: creature; var t: tracePtr; var a: arena); +var + prevX, prevY: integer; +begin + prevX := hamster.curX - hamster.dX; + prevY := hamster.curY - hamster.dY; + if t = nil then + DrawEdge(prevX, prevY, a); + if (a.borders[prevX][prevY]) and (t = nil) then + DrawArenaCell(prevX, prevY, BorderSymbol) +end; + +procedure EraseStepTrace(var hamster: creature; t: tracePtr); +var + i: integer; +begin + for i := 1 to hamster.movespeed do + begin + DrawArenaCell(t^.x, t^.y, ArenaSymbol); + t := t^.prev + end; + if GetLength(t) = 1 then + begin + if IsOnEdge(hamster) then + DrawArenaCell(t^.x, t^.y, ArenaSymbol) + else + DrawArenaCell(t^.x, t^.y, BorderSymbol) + end +end; + +procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena); +var + prevX, prevY: integer; +begin + prevX := hamster.curX - hamster.dX; + prevY := hamster.curY - hamster.dY; + if IsOnEdge(prevX, prevY) and a.captured[prevX][prevY] then + DrawArenaCell(prevX, prevY, CaptureSymbol) + else + if IsOnBorder(prevX, prevY, a) then + DrawArenaCell(prevX, prevY, BorderSymbol) + else + DrawArenaCell(prevX, prevY, ArenaSymbol); + if t <> nil then + DrawStepTrace(t, hamster.movespeed); + DrawCreature(hamster); + DrawPreviousCell(hamster, t, a) +end; + +procedure FillPauseCells(var a: arena); +var + i, j: integer; +begin + for i := ArenaPauseUpperMarginY to (ArenaW - ArenaPauseLowerMarginY) do + for j := (1 + ArenaPauseMarginX) to (ArenaH - ArenaPauseMarginX) do + if a.borders[j][i] then + DrawArenaCell(j, i, BorderSymbol) + else + if a.captured[j][i] then + DrawArenaCell(j, i, CaptureSymbol) +end; + +procedure DrawTrace(t: tracePtr); +begin + if t <> nil then + t := t^.prev; + while t <> nil do + begin + DrawArenaCell(t^.x, t^.y, TraceSymbol); + t := t^.prev + end +end; + +type + stackIntPtr = ^stackIntItem; + + stackIntItem = record + val: integer; + next: stackIntPtr + end; + + StackInt = record + top: stackIntPtr + end; + +procedure StackIntInit(var s: StackInt); +begin + s.top := nil +end; + +procedure StackPush(var st: StackInt; val: integer); +var + tmp: stackIntPtr; +begin + new(tmp); + tmp^.val := val; + tmp^.next := st.top; + st.top := tmp +end; + +procedure StackPop(var st: StackInt); +var + tmp: stackIntPtr; +begin + tmp := st.top; + st.top := st.top^.next; + dispose(tmp) +end; + +procedure DrawInterfaceNumber(interfaceX: integer; s: longint); +var + x, y: integer; + i: integer = 0; + st: StackInt; +begin + StackIntInit(st); + if s = 0 then + StackPush(st, 0); + while s <> 0 do + begin + StackPush(st, s mod Notation); + s := s div Notation + end; + x := interfaceX + InterfaceMarginX; + y := InterfaceMarginY; + while st.top <> nil do + begin + DrawDigit(x + (DigitWidth + DigitSpaceWidth) * i, y, st.top^.val); + StackPop(st); + i := i + 1 + end +end; + +procedure DrawScore(s: integer); +var + killBarX: integer = InterfaceCellW * 2 * WidthCoefficient + BorderSize; +begin + DrawInterfaceNumber(killBarX, s) +end; + +procedure DrawLifes(n: integer); +begin + DrawInterfaceNumber(LifeBarX, n) +end; + +procedure DrawLevel(var level: levelState); +begin + DrawInterface; + FillPauseCells(level.a); + DrawTrace(level.t); + DrawCreature(level.h); + DrawCreature(level.g); + DrawScore(level.score); + DrawLifes(level.life) +end; + + +procedure DrawInterface; +begin + DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient, BorderSymbol); + + {DrawLineX(InterfaceCellW * WidthCoefficient, + InterfaceBarH div 2, + InterfaceCellW * WidthCoefficient + 1, MidCellDelimiter);} + DrawLineY(InterfaceCellW * WidthCoefficient, 1, + InterfaceBarH, BorderSymbol); + DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1, + InterfaceBarH, BorderSymbol) +end; + +procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char); +var + i, screenX, screenY: integer; +begin + screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient; + screenY := InterfaceBarH + (arenaY - 1) * CellSize; + GotoXY(screenX, screenY); + for i := 1 to CellSize * WidthCoefficient do + write(symbol); + GotoXY(screenX, screenY + 1); { later change to nested for } + for i := 1 to CellSize * WidthCoefficient do + write(symbol); + GotoXY(1, 1) +end; + +procedure DrawArenaEdges; +begin + DrawRectangle(1, InterfaceBarH, + ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient, + BorderSymbol) +end; + +procedure DrawLeftEdge(y: integer); +var + terminalY: integer; +begin + y := Clamp(y, 1, ArenaW); + terminalY := InterfaceBarH + (y - 1) * CellSize; + DrawLineY(1, terminalY, CellSize, BorderSymbol) +end; + +procedure DrawRightEdge(y: integer); +var + terminalY: integer; +begin + y := Clamp(y, 1, ArenaW); + terminalY := InterfaceBarH + (y - 1) * CellSize; + DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize, BorderSymbol) +end; + +procedure DrawUpperEdge(x: integer); +var + terminalX, sizeX: integer; +begin + x := Clamp(x, 1, ArenaH); + terminalX := (x - 1) * CellSize * WidthCoefficient + 1; + sizeX := CellSize * WidthCoefficient; + DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbol) +end; + +procedure DrawLowerEdge(x: integer); +var + terminalX, sizeX: integer; +begin + x := Clamp(x, 1, ArenaH); + terminalX := (x - 1) * CellSize * WidthCoefficient + 1; + sizeX := CellSize * WidthCoefficient; + DrawLineX(terminalX, InterfaceBarH + ArenaW * CellSize - 1, + sizeX, BorderSymbol) +end; + +procedure DrawArenaBorders(var a: arena); +var + i, j: integer; +begin + for i := 1 to ArenaW do + for j := 1 to ArenaH do + if a.borders[j][i] then + DrawArenaCell(j, i, BorderSymbol) +end; + +procedure DrawEdge(x, y: integer; var a: arena); +begin + if a.captured[x][y] then + DrawArenaCell(x, y, CaptureSymbol) + else + DrawArenaCell(x, y, ArenaSymbol); + if x = 1 then + DrawLeftEdge(y); + if x = ArenaH then + DrawRightEdge(y); + if y = 1 then + DrawUpperEdge(x); + if y = ArenaW then + DrawLowerEdge(x) +end; + +procedure EraseTrace(t: tracePtr; var a: arena); +begin + while t <> nil do + begin + if t^.prev = nil then + DrawEdge(t^.x, t^.y, a) + else + DrawArenaCell(t^.x, t^.y, ArenaSymbol); + t := t^.prev + end +end; + +end. diff --git a/src/arena_m.pas b/src/arena_m.pas new file mode 100644 index 0000000..ec749da --- /dev/null +++ b/src/arena_m.pas @@ -0,0 +1,512 @@ +unit arena_m; + +interface + +uses creature_m, trace_m; + +const + ArenaW = 33; + ArenaH = 41; + RandomCutThreshold = 20; + RandomOneToOne = 2; + +type + arenaMatrix = array [1..ArenaH, 1..ArenaW] of boolean; + + arena = record + captured, borders: arenaMatrix; + end; + +function ArenaCellCaptured(x, y: integer; var a: arena): boolean; +function ArenaSplited(var h: creature; var t: tracePtr; var a: arena): boolean; +function GhostShouldTurn(var g: creature; var a: arena): boolean; +function +HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean; +function IsOnBorder(var x, y: integer; var a: arena): boolean; +function IsOnEdge(var cr: creature): boolean; +function IsOnEdge(x, y: integer): boolean; +procedure CutPart(var hamster: creature; var t: tracePtr; + var cutOff: integer; var a: arena); +procedure InitArena(var a: arena); +procedure MakeEnemyStep(var e, h: creature; t: tracePtr; var a: arena); +procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena); +procedure SetArenaBorder(var t: tracePtr; var a: arena); +procedure TurnGhost(var g: creature; var a: arena); + +implementation + +uses arena_graphics_m, cell_m, crt, graphics_m, math_m; + +procedure Fill(var m: arenaMatrix; val: boolean); +var + i, j: integer; +begin + for i := 1 to ArenaH do + for j := 1 to ArenaW do + m[i][j] := val +end; + +procedure InitArena(var a: arena); +begin + Fill(a.captured, false); + Fill(a.borders, false) +end; + +function IsCellFree(x, y: integer; var a: arena): boolean; +begin + IsCellFree := + (x <> 0) and (x <> ArenaH + 1) and + (y <> 0) and (y <> ArenaW + 1) and + not a.captured[x][y] and not a.borders[x][y] +end; + +procedure ReleaseArenaCells(var q: QCell; var a: arena); +var + cell: cellItemPtr; +begin + while not QCellIsEmpty(q) do + begin + cell := QCellGet(q); + a.captured[cell^.x][cell^.y] := false; + QCellPop(q) + end +end; + +procedure TryAddCell(x, y: integer; var q: QCell; var a: arena); +var + cell: cellItem; +begin + if IsCellFree(x, y, a) then + begin + InitCell(cell, x, y); + QCellPush(q, cell) + end +end; + +{ bfs algo iteration } +procedure AddAvailableNeighbours(var q: QCell; var curCell: cellItem; + var a: arena); +var + x, y: integer; +begin + x := curCell.x; + y := curCell.y; + TryAddCell(x - 1, y, q, a); + TryAddCell(x + 1, y, q, a); + TryAddCell(x, y - 1, q, a); + TryAddCell(x, y + 1, q, a) +end; + +{ Kind of bfs algorithm. } +function GetFigureArea(var partCell: cellItem; var a: arena): integer; +var + cellPtr: cellItemPtr; + cell: cellItem; + captureQ, releaseQ: QCell; + result: integer = 0; +begin + QCellInit(captureQ); + QCellInit(releaseQ); + QCellPush(captureQ, partCell); + while not QCellIsEmpty(captureQ) do + begin + cellPtr := QCellGet(captureQ); + InitCell(cell, cellPtr^.x, cellPtr^.y); + QCellPop(captureQ); + if a.captured[cell.x][cell.y] then + continue; + result := result + 1; + a.captured[cell.x][cell.y] := true; + AddAvailableNeighbours(captureQ, cell, a); + QCellPush(releaseQ, cell) + end; + ReleaseArenaCells(releaseQ, a); + GetFigureArea := result +end; + +procedure +CutChosenPart(var partCell: cellItem; var a: arena; var cutOff: integer); +var + cellPtr: cellItemPtr; + cell: cellItem; + captureQ: QCell; +begin + QCellInit(captureQ); + QCellPush(captureQ, partCell); + while not QCellIsEmpty(captureQ) do + begin + cellPtr := QCellGet(captureQ); + InitCell(cell, cellPtr^.x, cellPtr^.y); + QCellPop(captureQ); + if a.captured[cell.x][cell.y] then + continue; + cutOff := cutOff + 1; + a.captured[cell.x][cell.y] := true; + DrawArenaCell(cell.x, cell.y, CaptureSymbol); + AddAvailableNeighbours(captureQ, cell, a) + end +end; + +function OnEdgeX(x: integer): boolean; +begin + OnEdgeX := (x = 1) or (x = ArenaH) +end; + +function OnEdgeY(y: integer): boolean; +begin + OnEdgeY := (y = 1) or (y = ArenaW) +end; + +function IsOnEdge(x, y: integer): boolean; +begin + IsOnEdge := (OnEdgeX(x) or OnEdgeY(y)) +end; + +function YNeighboursCaptured(x, y: integer; var a: arena): boolean; +begin + YNeighboursCaptured := + not OnEdgeY(y) and a.captured[x][y - 1] and a.captured[x][y + 1] +end; + +function XNeighboursCaptured(x, y: integer; var a: arena): boolean; +begin + XNeighboursCaptured := + not OnEdgeX(x) and a.captured[x + 1][y] and a.captured[x - 1][y] +end; + +function DiagonalNeighboursCaptured(x, y: integer; var a: arena): boolean; +begin + DiagonalNeighboursCaptured := + not IsOnEdge(x, y) and + a.captured[x - 1][y - 1] and a.captured[x - 1][y + 1] and + a.captured[x + 1][y - 1] and a.captured[x + 1][y + 1] +end; + +function ArenaCellCaptured(x, y: integer; var a: arena): boolean; +begin + ArenaCellCaptured := + XNeighboursCaptured(x, y, a) or YNeighboursCaptured(x, y, a) or + DiagonalNeighboursCaptured(x, y, a) +end; + +procedure CaptureArenaBorder(x, y: integer; var a: arena); +begin + a.borders[x][y] := false; + a.captured[x][y] := true; + DrawArenaCell(x, y, CaptureSymbol) +end; + +procedure CaptureCutBorders(var a: arena; var cutOff: integer); {rename, slow} +var + i, j: integer; +begin + for i := 1 to ArenaW do + for j := 1 to ArenaH do + if a.borders[j][i] and ArenaCellCaptured(j, i, a) then + begin + cutOff := cutOff + 1; + CaptureArenaBorder(j, i, a) + end; +end; + +procedure SetArenaBorder(var t: tracePtr; var a: arena); +begin + if t <> nil then + begin + a.borders[t^.x][t^.y] := true; + SetArenaBorder(t^.prev, a) + end +end; + +function IsOnEdge(var cr: creature): boolean; +begin + IsOnEdge := + (cr.curX = 1) or (cr.curX = ArenaH) or (cr.curY = 1) or + (cr.curY = ArenaW) +end; + +function IsOnBorder(var x, y: integer; var a: arena): boolean; +begin + IsOnBorder := + a.borders[x][y] and ( + a.captured[x - 1][y + 1] or + a.captured[x - 1][y - 1] or + a.captured[x + 1][y + 1] or + a.captured[x + 1][y - 1] + ) +end; + +function IsOnBorder(var cr: creature; var a: arena): boolean; +begin + IsOnBorder := + a.borders[cr.curX][cr.curY] and ( + a.captured[cr.curX - 1][cr.curY + 1] or + a.captured[cr.curX - 1][cr.curY - 1] or + a.captured[cr.curX + 1][cr.curY + 1] or + a.captured[cr.curX + 1][cr.curY - 1] + ) +end; + +function ArenaSplited(var h: creature; var t: tracePtr; var a: arena): boolean; +begin + ArenaSplited := + (t <> nil) and (IsOnBorder(h, a) or IsOnEdge(h)) and (t^.prev <> nil) +end; + +procedure GetPartsCells(var t: tracePtr; var part1, part2: cellItem; + var a: arena); +var + prevTrace: tracePtr; +begin + prevTrace := t^.prev; + if t^.y = prevTrace^.y then + begin + InitCell(part1, prevTrace^.x, prevTrace^.y - 1); + InitCell(part2, prevTrace^.x, prevTrace^.y + 1) + end + else + begin + InitCell(part1, prevTrace^.x - 1, prevTrace^.y); + InitCell(part2, prevTrace^.x + 1, prevTrace^.y) + end +end; + +function LowerToBiggerRatio(val1, val2: integer): integer; +var + v1, v2, tmp, biggerProcent: real; +begin + v1 := val1; + v2 := val2; + + if v1 > v2 then + begin + tmp := v1; + v1 := v2; + v2 := tmp + end; + biggerProcent := v2 / 100; + LowerToBiggerRatio := Round(100 - v1 / biggerProcent) +end; + +function StepOnTrace(var hamster: creature; var t: tracePtr): boolean; +var + nextX, nextY, idx: integer; +begin + nextX := Clamp(hamster.curX + hamster.dX, 1, ArenaH); + nextY := Clamp(hamster.curY + hamster.dY, 1, ArenaW); + idx := FindIndex(t, nextX, nextY, 1); + StepOnTrace := idx > PreviousTraceIdx +end; + +function StepBeyondEdge(var cr: creature): boolean; +begin + StepBeyondEdge := + (cr.dX > 0) and (cr.curX = ArenaH) or + (cr.dX < 0) and (cr.curX = 1) or + (cr.dY > 0) and (cr.curY = ArenaW) or + (cr.dY < 0) and (cr.curY = 1) +end; + +function RandomBool: boolean; +begin + if Random(RandomOneToOne) = 1 then + RandomBool := true + else + RandomBool := false +end; + +function ChooseRandomCell(p1, p2: cellItem): cellItem; +var + rb: boolean; +begin + rb := RandomBool; + if rb then + ChooseRandomCell := p1 + else + ChooseRandomCell := p2 +end; + +{refactor? pass just level later} +procedure CutPart(var hamster: creature; var t: tracePtr; + var cutOff: integer; var a: arena); +var + area1, area2, diffProcent: integer; + part1, part2, cutFigure: cellItem; +begin + GetPartsCells(t, part1, part2, a); + + area1 := GetFigureArea(part1, a); + area2 := GetFigureArea(part2, a); + + diffProcent := LowerToBiggerRatio(area1, area2); + if diffProcent <= RandomCutThreshold then + cutFigure := ChooseRandomCell(part1, part2) + else + if area1 <= area2 then + cutFigure := part1 + else + cutFigure := part2; + CutChosenPart(cutFigure, a, cutOff); + CaptureCutBorders(a, cutOff); + DrawArenaBorders(a); + DrawArenaEdges; + DrawCreature(hamster); + DeleteTrace(t) +end; + +function +HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean; +var + nextX, nextY, midX, midY: integer; +begin + nextX := Clamp(h.curX + h.dX, 1, ArenaH); + nextY := Clamp(h.curY + h.dY, 1, ArenaW); + midX := Clamp(h.curX + (h.dX div 2), 1, ArenaH); + midY := Clamp(h.curY + (h.dY div 2), 1, ArenaW); + HamsterStepPossible := + not StepOnTrace(h, t) + and (not a.captured[midX][midY] or IsOnEdge(nextX, nextY)) + and not StepBeyondEdge(h) + and not ( + not IsOnEdge(h) and a.borders[h.curX][h.curY] and + a.captured[midX][midY] + ) +end; + +function +FieldToEdge(var hamster: creature; var t: tracePtr; var a: arena): boolean; +var + midX, midY: integer; +begin + midX := hamster.curX - (hamster.dX div 2); + midY := hamster.curY - (hamster.dY div 2); + FieldToEdge := + IsOnEdge(hamster) and (t = nil) and not a.captured[midX][midY] and + not a.borders[hamster.curX][hamster.curY] and + not (IsOnEdge(midX, midY)) +end; + +function +IsOnField(var hamster: creature; var t: tracePtr; var a: arena): boolean; +var + midX, midY: integer; +begin + midX := hamster.curX - (hamster.dX div 2); + midY := hamster.curY - (hamster.dY div 2); + IsOnField := + not (IsOnEdge(hamster) and (t = nil)) and + not a.captured[hamster.curX][hamster.curY] and + not a.borders[midX][midY] +end; + +procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena); +begin + MakeStep(h); + if FieldToEdge(h, t, a) or IsOnField(h, t, a) then + ChangeHamsterTrace(h, t); + DrawAfterStep(h, t, a) +end; + +function GhostShouldTurn(var g: creature; var a: arena): boolean; +var + nextX, nextY: integer; +begin + nextX := g.curX + g.dX; + nextY := g.curY + g.dY; + GhostShouldTurn := IsOnEdge(nextX, nextY) or a.borders[nextX][nextY] +end; + +function BorderY(nextX, nextY: integer; var a: arena): boolean; +begin + BorderY := + a.borders[nextX][nextY] and + (a.borders[nextX][nextY - 1] or a.borders[nextX][nextY + 1]) +end; + +function BorderX(nextX, nextY: integer; var a: arena): boolean; +begin + BorderX := + a.borders[nextX][nextY] and + (a.borders[nextX - 1][nextY] or a.borders[nextX + 1][nextY]) +end; + +function IsCorner(x, y: integer; var a: arena): boolean; +begin + IsCorner := BorderX(x, y, a) and BorderY(x, y, a) +end; + +function IsConcaveCorner(x, y: integer; var a: arena): boolean; +begin + IsConcaveCorner := + a.borders[x - 1][y] and a.borders[x][y + 1] or + a.borders[x - 1][y] and a.borders[x][y - 1] or + a.borders[x + 1][y] and a.borders[x][y + 1] or + a.borders[x + 1][y] and a.borders[x][y - 1] +end; + +function IsConvexCorner(var cr: creature; var a: arena): boolean; +var + x, y, nextX, nextY: integer; +begin + x := cr.curX; + y := cr.curY; + nextX := x + cr.dX; + nextY := y + cr.dY; + IsConvexCorner := + IsCorner(nextX, nextY, a) and + not IsOnEdge(nextX, nextY) and + not IsConcaveCorner(x, y, a) +end; + +procedure CornerTurn(var cr: creature; var a: arena); +var + x, y, nextX, nextY: integer; +begin + x := cr.curX; + y := cr.curY; + nextX := x + cr.dX; + nextY := y + cr.dY; + if not a.borders[nextX][y] and not a.borders[x][nextY] then + begin + cr.dX := cr.dX * -1; + cr.dY := cr.dY * -1 + end + else + if a.borders[nextX][y] then + cr.dX := cr.dX * -1 + else + cr.dY := cr.dY * -1 +end; + +procedure TurnGhost(var g: creature; var a: arena); +var + nextX, nextY: integer; +begin + nextX := g.curX + g.dX; + nextY := g.curY + g.dY; + if IsConvexCorner(g, a) then + begin + CornerTurn(g, a) + end + else + begin + if OnEdgeX(nextX) or BorderY(nextX, nextY, a) then + g.dX := g.dX * -1; + if OnEdgeY(nextY) or BorderX(nextX, nextY, a) then + g.dY := g.dY * -1 + end +end; + +procedure MakeEnemyStep(var e, h: creature; t: tracePtr; var a: arena); +var + prevX, prevY: integer; +begin + prevX := e.curX; + prevY := e.curY; + MakeStep(e); + DrawAfterEnemyStep(e, a); + if TraceCrossed(prevX, prevY, e, t) then + h.alive := false +end; + +end. diff --git a/src/ascii_arts_m.pas b/src/ascii_arts_m.pas new file mode 100644 index 0000000..3b4f794 --- /dev/null +++ b/src/ascii_arts_m.pas @@ -0,0 +1,303 @@ +unit ascii_arts_m; + +interface + +const + DigitHeight = 5; + DigitWidth = 5; + DigitsAscii: array[0..9] of array[1..DigitHeight] of string = ( + ( + '@@@@@', + '@ @', + '@ @', + '@ @', + '@@@@@' + ), + ( + ' @ ', + ' @@ ', + '@ @ ', + ' @ ', + '@@@@@' + ), + ( + '@@@@@', + ' @', + '@@@@@', + '@ ', + '@@@@@' + ), + ( + '@@@@@', + ' @', + '@@@@@', + ' @', + '@@@@@' + ), + ( + '@ @', + '@ @', + '@@@@@', + ' @', + ' @' + ), + ( + '@@@@@', + '@ ', + '@@@@@', + ' @', + '@@@@@' + ), + ( + '@@@@@', + '@ ', + '@@@@@', + '@ @', + '@@@@@' + ), + ( + '@@@@@', + ' @', + ' @', + ' @', + ' @' + ), + ( + '@@@@@', + '@ @', + '@@@@@', + '@ @', + '@@@@@' + ), + ( + '@@@@@', + '@ @', + '@@@@@', + ' @', + '@@@@@' + ) + ); + + GameMenuHeight = 44; + GameMenuScreen: array[1..GameMenuHeight] of string = ( + ' _____ _ _ _ _', + ' / ____| | | | | | | | |', + '| | __ ___ | | | |__| | __ _ _ __ ___ ___| |_ ___ _ __', + '| | |_ |/ _ \| | | __ |/ _` | ''_ ` _ \/ __| __/ _ \ ''__|', + '| |__| | (_) |_| | | | | (_| | | | | | \__ \ || __/ |', + ' \_____|\___/(_) |_| |_|\__,_|_| |_| |_|___/\__\___|_|', + '', + '', + '', + '', + '', + '', + '', + '', + ' _ _ _____', + '| \ | | / ____|', + '| \| | _____ __ | | __ __ _ _ __ ___ ___', + '| . ` |/ _ \ \ /\ / / | | |_ |/ _` | ''_ ` _ \ / _ \', + '| |\ | __/\ V V / | |__| | (_| | | | | | | __/', + '|_| \_|\___| \_/\_/ \_____|\__,_|_| |_| |_|\___|', + '', + '', + ' _ _ _ _ _____', + '| | | (_) | | / ____|', + '| |__| |_ __ _| |__ | (___ ___ ___ _ __ ___', + '| __ | |/ _` | ''_ \ \___ \ / __/ _ \| ''__/ _ \', + '| | | | | (_| | | | | ____) | (_| (_) | | | __/', + '|_| |_|_|\__, |_| |_| |_____/ \___\___/|_| \___|', + ' __/ |', + ' |___/', + ' _ __ _____ __', + '| |/ / |_ _| / _|', + '| '' / ___ _ _ | | _ __ | |_ ___', + '| < / _ \ | | | | | | ''_ \| _/ _ \', + '| . \ __/ |_| | _| |_| | | | || (_) |', + '|_|\_\___|\__, | |_____|_| |_|_| \___/', + ' __/ |', + ' |___/', + ' _____ _ _ ', + ' / ____| | | (_) ', + '| | ___ _ __ | |_ _ _ __ _ _ ___ ', + '| | / _ \| ''_ \| __| | ''_ \| | | |/ _ \', + '| |___| (_) | | | | |_| | | | | |_| | __/', + ' \_____\___/|_| |_|\__|_|_| |_|\__,_|\___|' + ); + GameNameHeight = 6; + GameNameWidth = 58; + NewGameHeight = 6; + HighScoreHeight = 8; + MenuInfoHeight = 8; + ContinueHeight = 6; + ContinueWidth = 41; + + ExitScreenHeight = 16; + ExitWidth = 70; + ExitHeight = 8; + ExitScreen: array[1..ExitScreenHeight] of string = ( +' ______ _ _ _ _ ___', +'| ____| (_) | | | | | |__ \', +'| |__ __ ___| |_ | |_| |__ ___ __ _ __ _ _ __ ___ ___ ) |', +'| __| \ \/ / | __| | __| ''_ \ / _ \ / _` |/ _` | ''_ ` _ \ / _ \/ /', +'| |____ > <| | |_ | |_| | | | __/ | (_| | (_| | | | | | | __/_|', +'|______/_/\_\_|\__| \__|_| |_|\___| \__, |\__,_|_| |_| |_|\___(_)', +' __/ |', +' |___/', +'', +'', +' _ _ ___ ___ _ __ ___', +'| | | |/ _ \/ __| | ''_ \ / _ \', +'| |_| | __/\__ \ | | | | (_) |', +' \__, |\___||___/ |_| |_|\___/', +' __/ |', +' |___/' + ); + + PauseHeight = 22; + PauseWidth = 76; + + { Too long strings :(, lets following linux styleguide } + PauseAscii: array[1..PauseHeight] of string = ( +' _', +' | |', +' _ __ __ _ _ _ ___ ___ __| |', +' | ''_ \ / _` | | | / __|/ _ \/ _` |', +' | |_) | (_| | |_| \__ \ __/ (_| |', +' | .__/ \__,_|\__,_|___/\___|\__,_| ', +' | | ', +' |_| _ _', +' | | (_)', +' ___ _ __ __ _ __ ___ ___ ___ _ __ | |_ _ _ __ _ _ ___', +'/ __| ''_ \ / _` |/ __/ _ \ ______ / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \', +'\__ \ |_) | (_| | (_| __/ |______| | (_| (_) | | | | |_| | | | | |_| | __/', +'|___/ .__/ \__,_|\___\___| \___\___/|_| |_|\__|_|_| |_|\__,_|\___|', +'====| |===================', +' |_| _ _ _', +' (_) | | |', +' __ _ __ _ _ _ _| |_ | |_ ___ _ __ ___ ___ _ __ _ _', +' / _` | ______ / _` | | | | | __| | __/ _ \ | ''_ ` _ \ / _ \ ''_ \| | | |', +'| (_| | |______| | (_| | |_| | | |_ | || (_) | | | | | | | __/ | | | |_| |', +' \__, | \__, |\__,_|_|\__| \__\___/ |_| |_| |_|\___|_| |_|\__,_|', +'====| |= | |', +' |_| |_|' + ); + + + YesHeight = 6; + NoHeight = 4; + NoWidth = 13; + HamsterHeight = 5; + HamsterWidth = 7; + HamsterStayAscii: array[1..HamsterHeight] of string = ( + ' (\_/)', + '( 0_0 )', + '/-----\', + ' |___|', + ' / \' + ); + HamsterGGAscii: array[1..HamsterHeight] of string = ( + ' (\_/)', + '( G_G )', + '/-----\', + ' |___|', + ' / \' + ); + + GameOverHeight = 40; + GameOverWidth = 62; + GameOverScreen: array[1..GameOverHeight] of string = ( + ' _____ __ __ ______ ', + ' / ____| /\ | \/ | ____|', + ' | | __ / \ | \ / | |__ ', + ' | | |_ | / /\ \ | |\/| | __|', + ' | |__| |/ ____ \| | | | |____', + ' \_____/_/ \_\_| |_|______|', + ' ______ ________ _____', + ' / __ \ \ / / ____| __ \', + ' | | | \ \ / /| |__ | |__) |', + ' | | | |\ \/ / | __| | _ /', + ' | |__| | \ / | |____| | \ \', + ' \____/ \/ |______|_| \_\', + '', + ' ____ ____', + ' / o@@\ /@@o \', + ' / /``\@\ __,-==-,__ /@/``\ \', + ' / /` `||//\______/ \||` `\ \', + ' | |` // __ __ \\ `| |', + ' \ \` (/ /;g\ /g;\ \) `/ |', + ' \_\__(( " .. " )____/_/', + ' \ " __ " / ', + ' @@@@@@(||)@@@@`@@`@@@@(||)@@@@@@@', + ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@', + ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@', + ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@', + ' ', + ' _ _ ___', + ' | | (_) |__ \', + ' ___ ___ _ __ | |_ _ _ __ _ _ ___ ) |', + ' / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \ / /', + ' | (_| (_) | | | | |_| | | | | |_| | __/ |_|', + ' \___\___/|_| |_|\__|_|_| |_|\__,_|\___| (_)', + ' ___ ___ __ ___ ___', + '| _| |_ | \ \ | _| |_ |', + '| | _ _ | | ___ ___ \ \ | | _ __ | | ___', + '| | | | | | | |/ _ \/ __| \ \ | | | ''_ \ | |/ _ \', + '| | | |_| | | | __/\__ \ \ \ | | | | | | | | (_) |', + '| |_ \__, | _| |\___||___/ \ \ | |_ |_| |_| _| |\___/', + '|___|=====/ |=|___| \_\ |___|=========|___|', + ' |___/' +); + + + KeyInfoHeight = 42; + KeyInfoWidth = 98; + KeyInfoScreen: array[1..KeyInfoHeight] of string = ( +' _', +' | |', +' _ __ ___ _____ _____ | | _____ _ _ ___ _', +' | ''_ ` _ \ / _ \ \ / / _ \ | |/ / _ \ | | / __| (_)', +' | | | | | | (_) \ V / __/ | < __/ |_| \__ \ _', +' |_| |_| |_|\___/ \_/ \___| |_|\_\___|\__, |___/ (_)', +' __/ |', +' _ |___/', +' / \', +' / . \', +' / / \ \', +' /_/| |\_\', +' | |', +' |_|', +' __ ========= __', +' / / (\_/) \ \', +' / /_____ ( 0_0 ) ______\ \ ', +' { ______| /-----\ |_______ }', +' \ \ |___| / /', +' \_\ / \ /_/', +' ========== _ ===========', +' | |', +' _ | | _ ', +' \ \| |/ /', +' \ \ / / ', +' \ ` / ', +' \_/', +' =========', +' _ _ _ ', +' | | | | | |', +' ___ _ __ __ _ ___ ___ ___| |_ ___ _ __ | |__ __ _ _ __ ___ ___| |_ ___ _ __', +' / __| ''_ \ / _` |/ __/ _ \ ______ / __| __/ _ \| ''_ \ | ''_ \ / _` | ''_ ` _ \/ __| __/ _ \ ''__|', +' \__ \ |_) | (_| | (_| __/ |______| \__ \ || (_) | |_) | | | | | (_| | | | | | \__ \ || __/ |', +' |___/ .__/ \__,_|\___\___| |___/\__\___/| .__/ |_| |_|\__,_|_| |_| |_|___/\__\___|_|', +' ====| |=================== | |', +' |_| |_|', +' ___ ___ ___ _ __ __ _ _ _ ___ ___', +' / _ \/ __|/ __| ______ | ''_ \ / _` | | | / __|/ _ \', +'| __/\__ \ (__ |______| | |_) | (_| | |_| \__ \ __/', +' \___||___/\___| | .__/ \__,_|\__,_|___/\___|', +'================ | |', +' |_|' +); + +implementation +end. + diff --git a/src/cell_m.pas b/src/cell_m.pas new file mode 100644 index 0000000..61a3739 --- /dev/null +++ b/src/cell_m.pas @@ -0,0 +1,80 @@ +unit cell_m; + +interface + +type + cellItemPtr = ^cellItem; + + cellItem = record + x, y: integer; + next: cellItemPtr + end; + + QCell = record + first, last: cellItemPtr + end; + +procedure InitCell(var c: cellItem; x, y: integer); +procedure QCellInit(var q: QCell); +procedure QCellPush(var q: QCell; var c: cellItem); +function QCellIsEmpty(var q: QCell): boolean; +function QCellGet(var q: QCell): cellItemPtr; +procedure QCellPop(var q: QCell); + +implementation + +procedure InitCell(var c: cellItem; x, y: integer); +begin + c.x := x; + c.y := y; + c.next := nil +end; + +procedure QCellInit(var q: QCell); +begin + q.first := nil; + q.last := nil +end; + +procedure QCellPush(var q: QCell; var c: cellItem); +var + tmp: cellItemPtr; +begin + new(tmp); + tmp^.x := c.x; + tmp^.y := c.y; + tmp^.next := nil; + if q.last = nil then + begin + q.first := tmp; + q.last := q.first + end + else + begin + q.last^.next := tmp; + q.last := q.last^.next + 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; + +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; + +end. diff --git a/src/creature_m.pas b/src/creature_m.pas new file mode 100644 index 0000000..0b09f0b --- /dev/null +++ b/src/creature_m.pas @@ -0,0 +1,52 @@ +unit creature_m; + +interface + +type + creature = record + curX, curY, dX, dY, moveSpeed: integer; + symbol: char; + alive: boolean + end; + +procedure +InitCreature(var cr: creature; curX, curY, movespeed: integer; symbol: char); +procedure KillCreature(var cr: creature); +procedure StopCreature(var cr: creature); +procedure MakeStep(var cr: creature); + +implementation + +uses arena_graphics_m, arena_m, math_m; + +procedure +InitCreature(var cr: creature; curX, curY, movespeed: integer; symbol: char); +begin + cr.curX := curX; + cr.curY := curY; + cr.dX := 0; + cr.dY := 0; + cr.movespeed := moveSpeed; + cr.alive := true; + cr.symbol := symbol +end; + +procedure StopCreature(var cr: creature); +begin + cr.dX := 0; + cr.dY := 0 +end; + +procedure MakeStep(var cr: creature); +begin + cr.curX := Clamp(cr.curX + cr.dX, 1, ArenaH); + cr.curY := Clamp(cr.curY + cr.dY, 1, ArenaW) +end; + +procedure KillCreature(var cr: creature); +begin + cr.alive := false; + DrawArenaCell(cr.curX, cr.curY, CaptureSymbol) +end; + +end. diff --git a/src/debug_m.pas b/src/debug_m.pas new file mode 100644 index 0000000..de79f63 --- /dev/null +++ b/src/debug_m.pas @@ -0,0 +1,64 @@ +unit debug_m; + +interface + +uses arena_m, cell_m, creature_m; + +procedure Debug; +procedure DebugCell(cell: cellItemPtr); +procedure Print(var m: arenaMatrix); + +procedure PrintCreatureDebug(var cr: creature); + +implementation + +uses crt; + +const + DebugMsg = '===============DEBUG==============='; + +var + DebugTmp: integer = 2; + +procedure Debug; +begin + GotoXY(2, DebugTmp); + writeln(DebugMsg); + DebugTmp := DebugTmp + 1 +end; + +procedure DebugCell(cell: cellItemPtr); +begin + GotoXY(2, DebugTmp); + writeln('Cur X: ', cell^.x, ' Cur Y: ', cell^.y); + DebugTmp := DebugTmp + 1 +end; + +procedure Print(var m: arenaMatrix); +var + i, j: integer; +begin + for i := 1 to ArenaW do + begin + for j := 1 to ArenaH do + if m[j][i] then + write(1, ' ') + else + write(0, ' '); + writeln + end; + GotoXY(1, 1) +end; + +procedure PrintCreatureDebug(var cr: creature); +var + i: integer; +begin + GotoXY(2, 2); + for i := 1 to 20 do + write(' '); + GotoXY(2, 2); + writeln(cr.curX, ' ', cr.curY, ' ', cr.dX, ' ', cr.dY) +end; + +end. diff --git a/src/game_m.pas b/src/game_m.pas new file mode 100644 index 0000000..deca790 --- /dev/null +++ b/src/game_m.pas @@ -0,0 +1,247 @@ +{ MainLoop -- main loop } +unit game_m; + +interface + +uses level_m; + +type + state = (gameExit, gameMenu, gameStartLevel, gameScore, gameKeyInfo, + gamePause, gameContinueLevel, gameOver); + menuState = (menuNewGame, menuHighScore, menuKeyInfo, menuContinue); + exitState = (exitYes, exitNo); + gameState = record + curExit: exitState; + curMenu: menuState; + curState: state; + level: integer; + shutdown, continueAllowed: boolean; + end; + +procedure DecreaseLife(var level: levelState); +procedure RunGameOver(var g: gameState; var level: levelState); +procedure InitGame(var g: gameState); +procedure NextExitState(var g: gameState); +procedure PreviousExitState(var g: gameState); +procedure RunExit(var g: gameState); +procedure MainLoop(var g: gameState); + +implementation + +uses arena_m, arena_graphics_m, crt, creature_m, ghost_m, graphics_m, + hamster_m, keys_m, trace_m; + +const + KeyDelayMs = 25; + LevelDelayMs = 100; + +procedure DecreaseLife(var level: levelState); +begin + level.life := level.life - 1; + DrawLifes(level.life) +end; + +procedure InitGame(var g: gameState); +begin + g.continueAllowed := false; + g.curMenu := menuNewGame; + g.curState := gameMenu; + g.level := 1; + g.shutdown := false; + { + g.slowBonus := StartSlowBonus; + g.speedBonus := StartSpeedBonus + } +end; + +procedure RunExit(var g: gameState); +begin + DrawExit(g); + while g.curState = gameExit do + begin + delay(KeyDelayMs); + if keypressed then + HandleExitKey(g) + end; + EraseExit +end; + +procedure RunScore(var g: gameState); +begin + {DrawHighScore;} + while g.curState = gameScore do + begin + delay(KeyDelayMs); + if keypressed then + HandleScoreKey(g) + end; +end; + +procedure RunKeyInfo(var g: gameState); +begin + DrawKeyInfo; + while g.curState = gameKeyInfo do + begin + delay(KeyDelayMs); + if keypressed then + HandleInfoKey(g) + end; + EraseKeyInfo +end; + +procedure RunPause(var g: gameState); +begin + DrawPause(g); + while g.curState = gamePause do + begin + delay(KeyDelayMs); + if keypressed then + HandlePauseKey(g) + end; + if g.curState = gameMenu then + EraseLevel; + if g.curState = gameContinueLevel then + ErasePause(g) +end; + +procedure RunGameOver(var g: gameState; var level: levelState); +begin + DrawGameOver; + while g.curState = gameOver do + begin + delay(KeyDelayMs); + if keypressed then + HandleGameOverKey(g) + end; + EraseGameOver; + if g.curState = gameContinueLevel then + InitLevel(level) +end; + +procedure LevelLoop(var g: gameState; var level: levelState); +begin + while level.continueLevel do + begin + delay(LevelDelayMs); + if ArenaSplited(level.h, level.t, level.a) then + begin + SetArenaBorder(level.t, level.a); + CutPart(level.h, level.t, level.score, level.a); + DrawScore(level.score) + end; + if level.g.alive then + MakeEnemyStep(level.g, level.h, level.t, level.a); + while level.g.alive and GhostShouldTurn(level.g, level.a) do + TurnGhost(level.g, level.a); + if not level.h.alive then + begin + if level.life <= 0 then + begin + g.curState := gameOver; + EraseLevel; + break + end; + DecreaseLife(level); + KillHamster(level.h, level.t, level.a); + level.h.alive := true + end; + if keypressed then + HandleLevelKey(level.h, level.a, level.t, g); + if not HamsterStepPossible(level.h, level.t, level.a) then + StopCreature(level.h); + if not ((level.h.dX = 0) and (level.h.dY = 0)) then + MakeHamsterStep(level.h, level.t, level.a); + if level.g.alive and + level.a.captured[level.g.curX][level.g.curY] then + begin + KillCreature(level.g) + end; + if g.curState = gamePause then + break + end; +end; + +procedure StartLevel(var g: gameState; var level: levelState); +begin + InitLevel(level); + DrawLevel(level); + LevelLoop(g, level) +end; + +procedure ContinueLevel(var g: gameState; var level: levelState); +begin + DrawLevel(level); + LevelLoop(g, level) +end; + +procedure RunMenu(var g: gameState); +var + prevMenu: boolean = false; +begin + g.curState := gameMenu; + while g.curState = gameMenu do + begin + if (g.curState = gameMenu) and not prevMenu then + begin + DrawMenu(g); + prevMenu := true + end; + delay(KeyDelayMs); + if keypressed then + HandleMenuKey(g); + if (g.curState <> gameMenu) and prevMenu then + begin + EraseMenu; + prevMenu := false + end; + if (g.curState <> gameMenu) then + if g.shutdown then + break + end +end; + +procedure MainLoop(var g: gameState); +var + level: levelState; +begin + while not g.shutdown do + begin + case g.curState of + gameExit: + RunExit(g); + gameScore: + RunScore(g); + gameKeyInfo: + RunKeyInfo(g); + gamePause: + RunPause(g); + gameStartLevel: + StartLevel(g, level); + gameContinueLevel: {Maybe here should be gameStartLevel} + ContinueLevel(g, level); + gameOver: + RunGameOver(g, level); + gameMenu: + RunMenu(g) + end + end; + EraseAll +end; + +procedure NextExitState(var g: gameState); +begin + if g.curExit = exitNo then + g.curExit := exitYes + else + g.curExit := succ(g.curExit) +end; + +procedure PreviousExitState(var g: gameState); +begin + if g.curExit = exitYes then + g.curExit := exitNo + else + g.curExit := pred(g.curExit) +end; + +end. diff --git a/src/ghost_m.pas b/src/ghost_m.pas new file mode 100644 index 0000000..7395024 --- /dev/null +++ b/src/ghost_m.pas @@ -0,0 +1,26 @@ +unit ghost_m; + +interface + +uses creature_m; + +const + GhostStartX = 5; + GhostStartY = 5; + GhostMovespeed = 1; + GhostStartDX = GhostMovespeed; + GhostStartDY = GhostMovespeed; + GhostSymbol = 'g'; + +procedure InitGhost(var g: creature); + +implementation + +procedure InitGhost(var g: creature); +begin + InitCreature(g, GhostStartX, GhostStartY, GhostMovespeed, GhostSymbol); + g.dX := GhostStartDX; + g.dY := GhostStartDY +end; + +end. diff --git a/src/go.pas b/src/go.pas new file mode 100644 index 0000000..62f0e0a --- /dev/null +++ b/src/go.pas @@ -0,0 +1,40 @@ +program go_hamster; +uses crt, keys_m, arena_graphics_m, graphics_m, game_m, debug_m; +{uses crt, keys_m, arena_graphics_m, graphics_m, game_m, ascii_digits_m, debug_m;} + +function IsTerminalValid: boolean; +begin + IsTerminalValid := ( + (ScreenWidth >= ScreenW * WidthCoefficient) and + (ScreenHeight >= ScreenH) + ) +end; + +procedure PrintTerminalHelp; +begin + writeln('Increase your terminal size and try again.'); + if ScreenWidth < ScreenW * WidthCoefficient then + begin + writeln('Your terminal width: ', ScreenWidth, + '. Required: ', ScreenW * WidthCoefficient, '.') + end; + if ScreenHeight < ScreenH then + begin + writeln('Your terminal height: ', ScreenHeight, + '. Required: ', ScreenH, '.') + end +end; + +var + g: gameState; +begin + if not IsTerminalValid then + begin + PrintTerminalHelp; + exit + end; + InitGame(g); + EraseAll; + MainLoop(g) +end. + diff --git a/src/graphics_m.pas b/src/graphics_m.pas new file mode 100644 index 0000000..941308e --- /dev/null +++ b/src/graphics_m.pas @@ -0,0 +1,304 @@ +unit graphics_m; + +interface + +uses arena_m, creature_m, trace_m, game_m, level_m; + +const + BorderSize = 1; + BorderSymbol = '|'; + CellSize = 2; + DigitSpaceWidth = 1; + DigitWidth = 6; + InterfaceH = 6; + ScreenH = (ArenaW + InterfaceH) * CellSize + BorderSize; + ScreenW = (ArenaH - 1) * CellSize + BorderSize * 2; { 82 } + WidthCoefficient = 2; + +procedure DrawDigit(x, y, digit: integer); +procedure DrawExitState(s: exitState); +procedure DrawExit(var g: gameState); +procedure DrawGameOver; +procedure DrawKeyInfo; +procedure DrawLineX(x, y, len: integer; ch: char); +procedure DrawLineY(x, y, len: integer; ch: char); +procedure DrawRectangle(x0, y0, h, w: integer; ch: char); +procedure DrawMenuState(s: menuState); +procedure DrawMenu(var g: gameState); +procedure DrawPause(var g: gameState); +procedure EraseAll; +procedure EraseExit; +procedure EraseExitState(s: exitState); +procedure EraseGameOver; +procedure EraseKeyInfo; +procedure EraseLevel; +procedure EraseMenu; +procedure EraseMenuState(s: menuState); +procedure ErasePause(var g: gameState); + +implementation + +uses crt, math_m, ascii_arts_m; + +const + BigLetterWidth = 8; + BorderN = 2; + GameNameY = 12; + NameHeightPadding = 8; + NewGameY = GameNameY + GameNameHeight + NameHeightPadding; + MenuHeightPadding = 2; + HighScoreY = NewGameY + NewGameHeight + MenuHeightPadding; + MenuInfoY = HighScoreY + HighScoreHeight; + ContinueY = MenuInfoY + MenuInfoHeight; + ExitGameY = (ScreenH - ExitScreenHeight) div 2 - MenuHeightPadding; + ExitYesY = ExitGameY + ExitHeight - 1 + MenuHeightPadding; + ExitHamsterY = ExitYesY; + GameNameX = ScreenW * WidthCoefficient div 3 + 4; + MenuWidthPadding = 4; + MenuHamsterX = GameNameX - HamsterWidth - MenuWidthPadding; + ExitYesX = MenuHamsterX; + ExitNoX = ScreenW * WidthCoefficient - ExitYesX - NoWidth; + GameOverX = ScreenW * WidthCoefficient div 2 - GameNameWidth div 2; + GameOverY = ScreenH div 2 - GameOverHeight div 2; + HamsterNoX = ExitNoX - HamsterWidth - MenuWidthPadding; + HamsterYesX = ExitYesX - HamsterWidth - MenuWidthPadding; + KeyInfoX = ScreenW * WidthCoefficient div 2 - KeyInfoWidth div 2; + KeyInfoY = ScreenH div 2 - KeyInfoHeight div 2 - 1; + LetterWidth = 5; + PauseXPadding = 3 * WidthCoefficient; + PauseX = (ScreenW * WidthCoefficient - PauseWidth) div 2; + PauseYPadding = 1; + PauseY = (ScreenH - PauseHeight) div 2; + PunctuationWidth = 3; + +var + firstMenuDraw: boolean = true; + +procedure DrawAscii(x, y, h: integer; var a: array of string); +var + i: integer; +begin + for i := 1 to h do + begin + GotoXY(x, y + i - 1); + write(a[i - 1]) + end; + GotoXY(1, 1) +end; + +procedure DrawDigit(x, y, digit: integer); +begin + DrawAscii(x, y, DigitHeight, DigitsAscii[digit]) +end; + +procedure DrawExitState(s: exitState); +begin + case s of + exitYes: + DrawAscii(HamsterYesX, ExitHamsterY, + HamsterHeight, HamsterGGAscii); + exitNo: + DrawAscii(HamsterNoX, ExitHamsterY, + HamsterHeight, HamsterStayAscii) + end +end; + +procedure DrawExit(var g: gameState); +var + realX: integer = ScreenW * WidthCoefficient; +begin + DrawAscii((realX - ExitWidth) div 2, ExitGameY, + ExitScreenHeight, ExitScreen); + DrawExitState(g.curExit) +end; + +procedure DrawGameOver; +begin + DrawAscii(GameOverX, GameOverY, GameOverHeight, GameOverScreen) +end; + +procedure DrawKeyInfo; +begin + DrawAscii(KeyInfoX, KeyInfoY, KeyInfoHeight, KeyInfoScreen) +end; + +procedure DrawLineX(x, y, len: integer; ch: char); +var + i: integer; +begin + GotoXY(x, y); + for i := 1 to len do + write(ch); + GotoXY(1, 1) +end; + +procedure DrawLineY(x, y, len: integer; ch: char); +var + i: integer; +begin + for i := 1 to len do + begin + GotoXY(x, y + i - 1); + write(ch) + end; + GotoXY(1, 1) +end; + +procedure DrawMenuState(s: menuState); +begin + case s of + menuNewGame: + DrawAscii(MenuHamsterX, NewGameY + 1, + HamsterHeight, HamsterStayAscii); + menuHighScore: + DrawAscii(MenuHamsterX, HighScoreY + 1, + HamsterHeight, HamsterStayAscii); + menuKeyInfo: + DrawAscii(MenuHamsterX, MenuInfoY + 1, + HamsterHeight, HamsterStayAscii); + menuContinue: + DrawAscii(MenuHamsterX, ContinueY + 1, + HamsterHeight, HamsterStayAscii) + end +end; + +procedure DrawRectangle(x0, y0, h, w: integer; ch: char); +var + i: integer; +begin + DrawLineX(x0, y0, w, ch); + for i := 1 to h - 2 do + begin + GotoXY(x0, y0 + i); + write(ch); + GotoXY(x0 + w - 1, y0 + i); + write(ch) + end; + DrawLineX(x0, y0 + h - 1, w, ch); + GotoXY(1, 1) +end; + +procedure DrawMenu(var g: gameState); +var + y: integer = GameNameY; +begin + if firstMenuDraw then { REFACTOR LATER } + begin + DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient, BorderSymbol); + firstMenuDraw := not firstMenuDraw + end; + DrawAscii(GameNameX, y, GameMenuHeight, GameMenuScreen); + if not g.continueAllowed then + DrawLineX(GameNameX, ContinueY + ContinueHeight div 2, + ContinueWidth, '-'); + DrawMenuState(g.curMenu) +end; + +procedure FillRectangle(x, y, w, h: integer; ch: char); +var + i, j: integer; +begin + for i := 0 to h - 1 do + begin + GotoXY(x, y + i); + for j := 0 to w do + write(ch) + end; + GotoXY(1, 1) +end; + +procedure EraseRectangle(x, y, w, h: integer); +begin + FillRectangle(x, y, w, h, ' ') +end; + +procedure DrawPause(var g: gameState); +begin + EraseRectangle(PauseX - PauseXPadding, + PauseY - PauseYPadding, + PauseWidth + PauseXPadding * 2 - 1, + PauseHeight + PauseYPadding * 2 + 1); + DrawRectangle(PauseX - PauseXPadding, + PauseY - PauseYPadding, + PauseHeight + PauseYPadding * 2 + 1, + PauseWidth + PauseXPadding * 2, + BorderSymbol); + DrawAscii(PauseX, PauseY, PauseHeight, PauseAscii) +end; + +procedure EraseAll; +begin + EraseRectangle(1, 1, ScreenW * WidthCoefficient, ScreenH) +end; + +procedure EraseExit; +begin + EraseRectangle(HamsterYesX, ExitGameY, + ExitWidth + HamsterWidth + MenuWidthPadding, + ExitScreenHeight + MenuHeightPadding + YesHeight) +end; + +procedure EraseExitState(s: exitState); +begin + case s of + exitYes: + EraseRectangle(HamsterYesX, ExitHamsterY, + HamsterWidth, HamsterHeight); + exitNo: + EraseRectangle(HamsterNoX, ExitHamsterY, + HamsterWidth, HamsterHeight) + end +end; + +procedure EraseGameOver; +begin + EraseRectangle(GameOverX, GameOverY, GameOverWidth, GameOverHeight) +end; + +procedure EraseKeyInfo; +begin + EraseRectangle(KeyInfoX, KeyInfoY, KeyInfoWidth, KeyInfoHeight) +end; + +procedure EraseLevel; +begin + EraseRectangle(2, 2, + ScreenW * WidthCoefficient - BorderSize * BorderN, + ScreenH - BorderSize * BorderN); + DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient, BorderSymbol) +end; + +procedure EraseMenu; +begin + EraseRectangle(MenuHamsterX, GameNameY, + GameNameWidth + HamsterWidth + MenuWidthPadding, + ScreenH - GameNameY * 2) +end; + +procedure EraseMenuState(s: menuState); +begin + case s of + menuNewGame: + EraseRectangle(MenuHamsterX, NewGameY + 1, + HamsterWidth, HamsterHeight); + menuHighScore: + EraseRectangle(MenuHamsterX, HighScoreY + 1, + HamsterWidth, HamsterHeight); + menuKeyInfo: + EraseRectangle(MenuHamsterX, MenuInfoY + 1, + HamsterWidth, HamsterHeight); + menuContinue: + EraseRectangle(MenuHamsterX, ContinueY + 1, + HamsterWidth, HamsterHeight) + end +end; + +procedure ErasePause(var g: gameState); +begin + EraseRectangle(PauseX - PauseXPadding, + PauseY - PauseYPadding, + PauseWidth + PauseXPadding * 2 - 1, + PauseHeight + PauseYPadding * 2 + 1) +end; + +end. diff --git a/src/hamster_m.pas b/src/hamster_m.pas new file mode 100644 index 0000000..4f80e1f --- /dev/null +++ b/src/hamster_m.pas @@ -0,0 +1,50 @@ +unit hamster_m; + +interface + +uses arena_graphics_m, arena_m, creature_m, trace_m; + +const + HamsterStartX = 5; + HamsterStartY = 1; + HamsterStartDX = 0; + HamsterStartDY = 0; + HamsterMovespeed = 2; + HamsterSymbol = 'h'; + +procedure InitHamster(var h: creature); +procedure KillHamster(var h: creature; var t: tracePtr; var a: arena); + +implementation + +uses graphics_m; + +procedure InitHamster(var h: creature); +begin + InitCreature(h, HamsterStartX, HamsterStartY, + HamsterMovespeed, HamsterSymbol); + h.dX := HamsterStartDX; + h.dY := HamsterStartDY +end; + +procedure KillHamster(var h: creature; var t: tracePtr; var a: arena); +var + traceStart: tracePtr; +begin + DrawArenaCell(h.curX, h.curY, ArenaSymbol); + EraseTrace(t, a); + if IsOnEdge(h) then + DrawEdge(h.curX, h.curY, a) + else + if a.borders[h.curX][h.curY] then + DrawArenaCell(h.curX, h.curY, BorderSymbol); + GetStart(traceStart, t); + h.curX := traceStart^.x; + h.curY := traceStart^.y; + h.dX := HamsterStartDX; + h.dY := HamsterStartDY; + DeleteTrace(t); + DrawCreature(h) +end; + +end. diff --git a/src/keys_m.pas b/src/keys_m.pas new file mode 100644 index 0000000..f5d244c --- /dev/null +++ b/src/keys_m.pas @@ -0,0 +1,282 @@ +unit keys_m; + +interface + +uses crt, creature_m, arena_m, game_m, trace_m, hamster_m, debug_m; + +const + ArrowDownOrd = -80; + ArrowLeftOrd = -75; + ArrowRightOrd = -77; + ArrowUpOrd = -72; + CtrlCOrd = 3; + EnterOrd = 13; + EscOrd = 27; + LowerNOrd = 110; + LowerYOrd = 121; + SpaceOrd = 32; + UpperNOrd = 78; + UpperYOrd = 89; + + OneOrd = 49; + TwoOrd = 50; + ThreeOrd = 51; + FourOrd = 52; + UpperQOrd = 81; + LowerQOrd = 113; + + { Debug } + BOrd = 98; + COrd = 99; + LOrd = 108; + { Debug } + +procedure GetKey(var keyCode: integer); +procedure HandleExitKey(var g: gameState); +procedure HandleLevelKey(var h: creature; var a: arena; + var t: tracePtr; var g: gameState); +procedure HandleMenuKey(var g: gameState); +procedure HandleInfoKey(var g: gameState); +procedure HandleGameOverKey(var g: gameState); +procedure HandleScoreKey(var g: gameState); +procedure HandlePauseKey(var g: gameState); + +implementation + +uses graphics_m; + +procedure GetKey(var keyCode: integer); +var + c: char; +begin + c := ReadKey; + if c = #0 then + begin + c := ReadKey; + keyCode := -ord(c) + end + else + begin + keyCode := ord(c) + end +end; + +procedure ChangeHamsterDelta(k: integer; var h: creature); +begin + h.dX := 0; + h.dY := 0; + case k of + ArrowLeftOrd: + h.dX := -h.movespeed; + ArrowRightOrd: + h.dX := h.movespeed; + ArrowUpOrd: + h.dY := -h.movespeed; + ArrowDownOrd: + h.dY := h.movespeed; + SpaceOrd: + StopCreature(h) + end +end; + +procedure HandleLevelKey(var h: creature; var a: arena; + var t: tracePtr; var g: gameState); +var + k: integer; +begin + GetKey(k); + {DEBUG} + if k = BOrd then + Print(a.borders); + if k = COrd then + Print(a.captured); + if k = LOrd then + begin + GotoXY(2, 60); + write(' '); + GotoXY(2, 60); + writeln(GetLength(t)); + GotoXY(1, 1) + end; + {DEBUG} + if (k = ArrowLeftOrd) or (k = ArrowRightOrd) or (k = ArrowUpOrd) or + (k = ArrowDownOrd) or (k = SpaceOrd) then + begin + ChangeHamsterDelta(k, h) + end; + if k = EscOrd then + g.curState := gamePause + { + if k = CtrlCOrd then + continueLevel := false + } +end; + +procedure PreviousMenuState(var g: gameState); +begin + if (g.curMenu = menuNewGame) and not g.continueAllowed then + g.curMenu := menuKeyInfo + else + if g.curMenu = menuNewGame then + g.curMenu := menuContinue + else + g.curMenu := pred(g.curMenu) +end; + +procedure NextMenuState(var g: gameState); +begin + if (g.curMenu = menuKeyInfo) and not g.continueAllowed or + (g.curMenu = menuContinue) then + begin + g.curMenu := menuNewGame + end + else + begin + g.curMenu := succ(g.curMenu) + end +end; + +procedure ChangeMenuState(k: integer; var g: gameState); +begin + case k of + ArrowUpOrd: + PreviousMenuState(g); + ArrowDownOrd: + NextMenuState(g) + end +end; + +procedure ChooseMenuNum(k: integer; var g: gameState); +begin + if (k = FourOrd) and not g.continueAllowed then + exit; + case k of + OneOrd: + g.curState := gameStartLevel; + TwoOrd: + g.curState := gameScore; + ThreeOrd: + g.curState := gameKeyInfo; + FourOrd: + g.curState := gameContinueLevel + end +end; + +procedure ChooseMenuMarked(var g: gameState); +begin + case g.curMenu of + menuNewGame: + g.curState := gameStartLevel; + menuHighScore: + g.curState := gameScore; + menuKeyInfo: + g.curState := gameKeyInfo; + menuContinue: + g.curState := gameContinueLevel + end +end; + +procedure HandleMenuKey(var g: gameState); +var + k: integer; +begin + GetKey(k); + if (k = ArrowUpOrd) or (k = ArrowDownOrd) then + begin + EraseMenuState(g.curMenu); + ChangeMenuState(k, g); + DrawMenuState(g.curMenu) + end; + if (k = OneOrd) or (k = TwoOrd) or (k = ThreeOrd) or (k = FourOrd) then + ChooseMenuNum(k, g); + if (k = EscOrd) or (k = UpperQOrd) or (k = LowerQOrd) then + g.curState := gameExit; + if (k = EnterOrd) or (k = SpaceOrd) then + ChooseMenuMarked(g); +end; + +procedure HandleGameOverKey(var g: gameState); +var + k: integer; +begin + GetKey(k); + case k of + UpperYOrd, LowerYOrd: + g.curState := gameContinueLevel; + UpperNOrd, LowerNOrd: + g.curState := gameMenu; + end +end; + +procedure ChangeExitState(k: integer; var g: gameState); +begin + case k of + ArrowRightOrd: + NextExitState(g); + ArrowLeftOrd: + PreviousExitState(g) + end +end; + +procedure HandleExitKey(var g: gameState); +var + k: integer; +begin + GetKey(k); + if (k = ArrowLeftOrd) or (k = ArrowRightOrd) then + begin + EraseExitState(g.curExit); + ChangeExitState(k, g); + DrawExitState(g.curExit); + exit + end; + if (k = EnterOrd) or (k = SpaceOrd) then + begin + if g.curExit = exitYes then + g.shutdown := true + else + g.curExit := exitYes; + end; + if (k = UpperYOrd) or (k = LowerYOrd) or (k = OneOrd) then + g.shutdown := true; + if (k = UpperNOrd) or (k = LowerNOrd) or (k = EscOrd) or (k = TwoOrd) then + g.curExit := exitYes; + g.curState := gameMenu +end; + +procedure HandlePauseKey(var g: gameState); +var + k: integer; +begin + GetKey(k); + if (k = EscOrd) or (k = SpaceOrd) then + g.curState := gameContinueLevel; + if (k = UpperQOrd) or (k = LowerQOrd) then + g.curState := gameMenu; +end; + +procedure HandleInfoKey(var g: gameState); +var + k: integer; +begin + GetKey(k); + if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) or + (k = UpperQOrd) or (k = LowerQOrd) then + begin + g.curState := gameMenu; + end +end; + +procedure HandleScoreKey(var g: gameState); +var + k: integer; +begin + GetKey(k); + if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) or + (k = UpperQOrd) or (k = LowerQOrd) then + begin + g.curState := gameMenu; + end +end; + +end. diff --git a/src/level_m.pas b/src/level_m.pas new file mode 100644 index 0000000..d9e6b70 --- /dev/null +++ b/src/level_m.pas @@ -0,0 +1,43 @@ +unit level_m; + +interface + +uses arena_m, trace_m, creature_m; + +type + levelState = record + a: arena; + t: tracePtr; + levelStarted, continueLevel, hamsterAlive: boolean; + h, g: creature; + life, score: integer + end; + +procedure InitLevel(var level: levelState); + +implementation +uses hamster_m, ghost_m; + +const + StartScore = 0; + StartLifes = 0; + { + BonusTurns = 45; + StartSpeedBonus = 0; + StartSlowBonus = 0; + } + +procedure InitLevel(var level: levelState); +begin + InitArena(level.a); + InitHamster(level.h); + InitGhost(level.g); + level.levelStarted := true; + level.continueLevel := true; + level.hamsterAlive := true; + level.t := nil; + level.life := StartLifes; + level.score := StartScore +end; + +end. diff --git a/src/math_m.pas b/src/math_m.pas new file mode 100644 index 0000000..51ec6ae --- /dev/null +++ b/src/math_m.pas @@ -0,0 +1,36 @@ +unit math_m; +interface + +function Clamp(val, min, max: integer): integer; +function Signum(a, b: integer): integer; + +implementation + +function Clamp(val, min, max: integer): integer; +begin + Clamp := val; + if val < min then + Clamp := min; + if val > max then + Clamp := max +end; + +function Signum(a, b: integer): integer; +begin + if a < b then + Signum := -1 + else + if a > b then + Signum := 1 + else + Signum := 0 +end; + +function Abs(val: integer): integer; +begin + if val < 0 then + val := val * -1; + Abs := val +end; + +end. diff --git a/src/trace_m.pas b/src/trace_m.pas new file mode 100644 index 0000000..a2626a2 --- /dev/null +++ b/src/trace_m.pas @@ -0,0 +1,188 @@ +unit trace_m; + +interface + +uses creature_m, math_m; + +const + PreviousTraceIdx = 3; + TraceSymbol = '+'; + +type + tracePtr = ^trace; + + trace = record + x, y: integer; + prev: tracePtr + end; + +function FindIndex(var t: tracePtr; x, y, curIdx: integer): integer; +function GetLength(var t: tracePtr): integer; +function IsOnTrace(var cr: creature; t: tracePtr): boolean; +function IsOnTrace(x, y: integer; t: tracePtr): boolean; +function +TraceCrossed(prevX, prevY: integer; var cr: creature; t: tracePtr): boolean; +procedure ChangeHamsterTrace(var h: creature; var t: tracePtr); +procedure DecreaseTrace(var hamster: creature; var t: tracePtr); +procedure DeleteTrace(var t: tracePtr); +procedure GetStart(var traceStart: tracePtr; t: tracePtr); +procedure IncreaseTrace(var hamster: creature; var t: tracePtr); +procedure Pop(var t: tracePtr); + +implementation + +uses arena_graphics_m; + +function GetLength(var t: tracePtr): integer; +begin + if t = nil then + GetLength := 0 + else + GetLength := 1 + GetLength(t^.prev) +end; + +procedure GetStart(var traceStart: tracePtr; t: tracePtr); +begin + while t <> nil do + begin + if t^.prev = nil then + traceStart := t; + t := t^.prev + end +end; + +procedure DeleteTrace(var t: tracePtr); +var + tmpT: tracePtr; +begin + while t <> nil do + begin + tmpT := t^.prev; + dispose(t); + t := tmpT + end +end; + +function FindIndex(var t: tracePtr; x, y, curIdx: integer): integer; +begin + if t = nil then + FindIndex := -1 + else + if (t^.x = x) and (t^.y = y) then + FindIndex := curIdx + else + FindIndex := FindIndex(t^.prev, x, y, curIdx + 1) +end; + +function IsOnTrace(x, y: integer; t: tracePtr): boolean; +begin + if t = nil then + IsOnTrace := false + else + if (t^.x = x) and (t^.y = y) then + IsOnTrace := true + else + IsOnTrace := IsOnTrace(x, y, t^.prev) +end; + +procedure Add(var t: tracePtr; x, y: integer); +var + nextTrace: tracePtr; +begin + new(nextTrace); + nextTrace^.x := x; + nextTrace^.y := y; + nextTrace^.prev := t; + t := nextTrace +end; + +procedure Pop(var t: tracePtr); +var + tmpPrev: tracePtr; +begin + tmpPrev := t^.prev; + dispose(t); + t := tmpPrev +end; + +function IsOnTrace(var cr: creature; t: tracePtr): boolean; +begin + IsOnTrace := IsOnTrace(cr.curX, cr.curY, t) +end; + +procedure AddStepTrace(var h: creature; var t: tracePtr); +var + nextX, nextY, dX, dY: integer; +begin + dX := Signum(h.curX, t^.x); + dY := Signum(h.curY, t^.y); + nextX := t^.x + dX; + nextY := t^.y + dY; + Add(t, nextX, nextY) +end; + +procedure AddFirstTrace(var hamster: creature; var t: tracePtr); +var + traceX, traceY, dX, dY: integer; +begin + dX := Signum(hamster.curX - hamster.dX, hamster.curX) * hamster.movespeed; + dY := Signum(hamster.curY - hamster.dY, hamster.curY) * hamster.movespeed; + traceX := hamster.curX + dX; + traceY := hamster.curY + dY; + Add(t, traceX, traceY) +end; + +procedure IncreaseTrace(var hamster: creature; var t: tracePtr); +var + i: integer; +begin + if t = nil then + AddFirstTrace(hamster, t); + for i := 1 to hamster.movespeed do + AddStepTrace(hamster, t) +end; + +procedure DecreaseTrace(var hamster: creature; var t: tracePtr); +var + i: integer; +begin + for i := 1 to hamster.movespeed do + Pop(t); + if GetLength(t) = 1 then + Pop(t) +end; + +procedure ChangeHamsterTrace(var h: creature; var t: tracePtr); +begin + if IsOnTrace(h, t) then + begin + EraseStepTrace(h, t); + DecreaseTrace(h, t) + end + else + begin + IncreaseTrace(h, t) + end +end; + +function +TraceCrossed(prevX, prevY: integer; var cr: creature; t: tracePtr): boolean; +var + dX, dY: integer; +begin + dX := Signum(cr.curX, prevX); + dY := Signum(cr.curY, prevY); + while (prevX <> cr.curX) and (prevY <> cr.curY) do + begin + if IsOnTrace(prevX, prevY, t) then + begin + TraceCrossed := true; + exit + end; + prevX := prevX + dX; + prevY := prevY + dY + end; + TraceCrossed := false +end; + +end.