This commit is contained in:
gre-ilya 2026-01-14 20:45:40 +05:00
commit fe94208b7f
34 changed files with 4444 additions and 0 deletions

7
.gitignore vendored Normal file
View File

@ -0,0 +1,7 @@
*.o
*.ppu
*.swp
convbanners
gohamster
_autobanners_m.pas

8
Makefile Normal file
View File

@ -0,0 +1,8 @@
default:
cd src && $(MAKE)
clean:
cd src && $(MAKE) clean
play:
cd src && $(MAKE) play

14
README.md Normal file
View File

@ -0,0 +1,14 @@
# Go Hamster
Это калька на одноимённую игру с телефона Samsung SGH-C100, играл неё в
далёком детстве :), решил реализовать в качестве упражнения. В качестве
инструмента для реализации этюда выбрал Object Pascal.
## Сборка
```bash
make
```
## Запуск:
```bash
make play
```

29
src/Makefile Normal file
View File

@ -0,0 +1,29 @@
FPC = fpc
CONVBANNERS_SRC = convbanners.pas
BANNERS_SRC = completed.txt exit.txt keys.txt paused.txt menu.txt \
level.txt gameover.txt
GAME_SRC = _autobanners_m.pas arena_graphics_m.pas arena_m.pas \
ascii_arts_m.pas cell_m.pas creature_m.pas enemy_packs_m.pas \
game_m.pas ghost_m.pas gohamster.pas graphics_m.pas hamster_m.pas \
keys_m.pas level_m.pas math_m.pas sun_m.pas trace_m.pas snake_m.pas \
drop_m.pas
all: gohamster
play: gohamster
./gohamster
gohamster: $(GAME_SRC)
$(FPC) $@.pas
_autobanners_m.pas: convbanners $(BANNERS_SRC)
./convbanners
convbanners: $(CONVBANNERS_SRC)
$(FPC) $@.pas
clean:
rm *.o *.ppu convbanners _autobanners_m.pas gohamster

700
src/arena_graphics_m.pas Normal file
View File

@ -0,0 +1,700 @@
unit arena_graphics_m;
interface
uses arena_m, creature_m, trace_m, level_m, _autobanners_m;
const
ArenaSymbol = ' ';
CaptureSymbol = '.';
procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena);
procedure DrawAliveEnemies(var e: creatureList);
procedure RedrawArea(var a: arena; arenaX, arenaY: integer; t: creatureType);
procedure DrawArenaBorders(var a: arena);
procedure DrawCreature(var cr: creature);
procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char);
procedure DrawArenaEdges;
procedure DrawPause;
procedure DrawTrace(a: tracePtr);
procedure DrawHamster(var h: creature);
procedure FillCellsCapture(var a: arena);
procedure FillCompleteBar(s: integer);
procedure DrawArenaCell(x, y: integer; var a: arena);
procedure DrawLevel(var level: levelState; life, score: integer);
procedure DrawLevelUnpause(var level: levelState);
procedure DrawLifesNumber(n: integer);
procedure DrawScore(s: integer);
procedure EraseStepTrace(var hamster: creature; a: tracePtr);
procedure EraseLifesNumber(n: integer);
procedure EraseTrace(tp: tracePtr; var a: arena);
procedure RedrawInterfaceArea(x: integer; t: creatureType);
procedure ShowLifeUp;
procedure ShowSpeedUp;
procedure ShowSpeedDown;
implementation
uses ascii_arts_m, crt, math_m, hamster_m, graphics_m;
const
ArenaPauseLowerMarginY = 14;
ArenaPauseMarginX = 9;
ArenaPauseUpperMarginY = 7;
InterfaceBarH = ScreenH - ArenaH * CellSize + BorderSize; { 14 }
InterfaceCellW = ScreenW div 3;
InterfaceMarginX = InterfaceCellW div 4;
InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1;
CompleteBarMarginY = 4;
CompleteBarMarginX = 5;
CompleteBarX = (
InterfaceCellW * WidthCoefficient + BorderSize + CompleteBarMarginX
);
CompleteBarY = BorderSize + CompleteBarMarginY + 1;
TotalProcent = 100;
CompleteBarH = InterfaceBarH - BorderSize * 2 - CompleteBarMarginY * 2;
CompleteBarW = (
InterfaceCellW * WidthCoefficient - CompleteBarMarginX * 2
);
BarWinX = CompleteBarW * LevelCompleteThreshold div TotalProcent;
LifeBarX = 17;
LifeNumberX = 27;
MidCellDelimiter = '_';
HamsterLifeY = 5;
DecimalBase = 10;
PauseXPadding = 3 * WidthCoefficient;
PauseX = (ScreenW * WidthCoefficient - PauseBannerWidth) div 2;
PauseYPadding = 1;
PauseY = (ScreenH - PauseBannerHeight) div 2;
InterfaceArenaCellX1 = 15;
InterfaceArenaCellX2 = 29;
type
redrawAreaBox = record
lX, lY, rX, rY: integer
end;
const
RedrawAreas: array[creatureType] of redrawAreaBox = (
(
lX: -HamsterWidth div CellSize div WidthCoefficient;
lY: -HamsterHeight div CellSize; rX: 0; rY: 0
),
(
lX: -GhostWidth div CellSize div WidthCoefficient;
lY: 0; rX: 0; rY: GhostHeight div CellSize
),
(
lX: -SunWidth div CellSize div WidthCoefficient;
lY: -SunHeight div CellSize; rX: 0; rY: 0
),
(
lX: -SnakeWidth div CellSize div WidthCoefficient;
lY: -SnakeHeight div CellSize; rX: 0; rY: 1
),
(
lX: -DropWidth div CellSize div WidthCoefficient;
lY: -DropHeight div CellSize; rX: 0; rY: 1
)
);
procedure DrawCompleteBar;
begin
FillRectangle(CompleteBarX, CompleteBarY, CompleteBarW, CompleteBarH, '-');
FillRectangle(CompleteBarX + BarWinX, CompleteBarY,
1, CompleteBarH, '|')
end;
procedure FillCompleteBar(s: integer);
var
cutedProcent: integer = 0;
fillW: integer;
begin
if s <> 0 then
cutedProcent := round(s / (TotalCells / TotalProcent));
fillW := round(CompleteBarW / TotalProcent * cutedProcent);
FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '+')
end;
procedure DrawAliveEnemies(var e: creatureList);
var
tmp: creatureItemPtr;
begin
tmp := e.first;
while tmp <> nil do
begin
if tmp^.cr^.alive then
DrawCreature(tmp^.cr^);
tmp := tmp^.next
end
end;
procedure DrawFieldAscii(arenaX, arenaY, h, w: integer; var a: CreatureImage);
var
screenX, screenY: integer;
begin
screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient;
screenY := InterfaceBarH + (arenaY - 1) * CellSize;
DrawCreatureImage(screenX, screenY, h, a)
end;
procedure DrawStepTrace(a: tracePtr; hamsterDelta: integer);
var
i: integer;
t: tracePtr;
begin
t := a;
for i := 1 to HamsterDelta + 2 do
begin
t := t^.prev;
if t = nil then
break;
DrawFieldCell(t^.x, t^.y, TraceSymbol)
end
end;
procedure DrawPreviousCell(var cr: creature; var a: arena);
var
prevX, prevY: integer;
begin
prevX := cr.curX - cr.dX;
prevY := cr.curY - cr.dY;
DrawArenaCell(prevX, prevY, a)
end;
procedure EraseStepTrace(var hamster: creature; a: tracePtr);
var
i: integer;
t: tracePtr;
begin
t := a;
for i := 1 to hamster.movespeed do
begin
DrawFieldCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
end;
if GetLength(t) = 1 then
begin
if IsOnEdge(hamster) then
DrawFieldCell(t^.x, t^.y, ArenaSymbol)
else
DrawFieldCell(t^.x, t^.y, BorderSymbol)
end
end;
procedure EraseHamsterInterface(x: integer);
begin
if x <= 0 then
exit;
DrawFieldCell(x, 0, ' ');
DrawFieldCell(x, -1, ' ');
DrawFieldCell(x - 1, 0, ' ');
DrawFieldCell(x - 1, -1, ' ')
end;
procedure EraseSunInterface(x: integer);
begin
if x <= 0 then
exit;
DrawFieldCell(x, 0, ' ');
DrawFieldCell(x - 1, 0, ' ')
end;
procedure RedrawEnemyInterfaceArea(x: integer);
var
h: integer = SunHeight div 2;
begin
EraseSunInterface(x);
if (x = 1) or (x = 2) then
DrawLineY(1, InterfaceBarH - h, h, BorderSymbol)
else
if (x = InterfaceArenaCellX1) or (x = InterfaceArenaCellX1 + -1) then
DrawLineY(InterfaceCellW * WidthCoefficient,
InterfaceBarH - h, h, BorderSymbol)
else
if (x = InterfaceArenaCellX2) or (x = InterfaceArenaCellX2 - 1) then
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1,
InterfaceBarH - h, h, BorderSymbol)
else
if x = ArenaW then
DrawLineY(ArenaW * CellSize * WidthCoefficient,
InterfaceBarH - h, h, BorderSymbol)
end;
procedure RedrawHamsterInterfaceArea(x: integer);
begin
EraseHamsterInterface(x);
if (x = 1) or (x = 2) then
DrawLineY(1, InterfaceBarH - HamsterHeight,
HamsterHeight, BorderSymbol)
else
if x = InterfaceArenaCellX1 then
DrawLineY(InterfaceCellW * WidthCoefficient,
InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol)
else
if x = InterfaceArenaCellX2 then
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1,
InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol)
else
if x = ArenaW then
DrawLineY(ArenaW * CellSize * WidthCoefficient,
InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol)
end;
procedure RedrawInterfaceArea(x: integer; t: creatureType);
begin
case t of
creatureHamster:
RedrawHamsterInterfaceArea(x);
creatureSun, creatureSnake, creatureDrop:
RedrawEnemyInterfaceArea(x)
end
end;
procedure RedrawArea(var a: arena; arenaX, arenaY: integer; t: creatureType);
var
i, j: integer;
r: redrawAreaBox;
begin
r := RedrawAreas[t];
for i := r.lY to r.rY do
begin
for j := r.lX to r.rX do
begin
if (arenaX + j > 0) and (arenaX + j < ArenaW + 1) and
(arenaY + i > 0) and (arenaY + i < ArenaH + 1) then
begin
DrawArenaCell(arenaX + j, arenaY + i, a)
end
end
end
end;
procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena);
var
arenaX, arenaY: integer;
begin
{Later move to erase hamster}
arenaX := h.curX - h.dX;
arenaY := h.curY - h.dY;
if arenaY = 1 then
RedrawInterfaceArea(arenaX, h.t);
RedrawArea(a, arenaX, arenaY, h.t);
if t <> nil then
DrawTrace(t);
if t = nil then
DrawPreviousCell(h, a)
end;
procedure FillCells(var a: arena; x1, y1, x2, y2: integer);
var
i, j: integer;
begin
for i := y1 to y2 do
for j := x1 to x2 do
if a.borders[i][j] then
DrawFieldCell(j, i, BorderSymbol)
else
if a.captured[i][j] then
DrawFieldCell(j, i, CaptureSymbol)
end;
procedure FillCellsUnpause(var a: arena);
begin
FillCells(a, 1 + ArenaPauseMarginX, ArenaPauseUpperMarginY,
ArenaW - ArenaPauseMarginX, ArenaH - ArenaPauseLowerMarginY)
end;
procedure DrawPause;
begin
EraseRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseBannerWidth + PauseXPadding * 2,
PauseBannerHeight + PauseYPadding * 2 + 1);
DrawRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseBannerHeight + PauseYPadding * 2 + 1,
PauseBannerWidth + PauseXPadding * 2,
BorderSymbol);
DrawBannerImage(PauseX, PauseY, PauseBannerHeight, PauseBanner);
GotoXY(1, 1)
end;
procedure DrawTrace(a: tracePtr);
var
t: tracePtr;
begin
if a = nil then
exit;
t := a^.prev;
while t <> nil do
begin
DrawFieldCell(t^.x, t^.y, TraceSymbol);
t := t^.prev
end
end;
procedure EraseInterfaceNumber(interfaceX: integer; num: longint);
var
cnt: integer = 0;
x, w, s: integer;
begin
s := num;
while s <> 0 do
begin
s := s div DecimalBase;
cnt += 1
end;
x := interfaceX + InterfaceMarginX;
w := (DigitWidth + DigitSpaceWidth) * cnt;
EraseRectangle(x, InterfaceMarginY, w, DigitHeight)
end;
procedure DrawInterfaceNumber(interfaceX: integer; n: longint);
begin
DrawNumber(interfaceX + InterfaceMarginX, InterfaceMarginY, n)
end;
procedure DrawScore(s: integer);
var
scoreX: integer = InterfaceCellW * 2 * WidthCoefficient + BorderSize;
begin
DrawInterfaceNumber(scoreX, s)
end;
procedure EraseLifesNumber(n: integer);
begin
EraseInterfaceNumber(LifeNumberX, n)
end;
procedure DrawLifesNumber(n: integer);
begin
DrawInterfaceNumber(LifeNumberX, n)
end;
procedure DrawLifes(n: integer);
begin
DrawCreatureImage(LifeBarX, HamsterLifeY,
HamsterHeight, HamsterLifesAscii);
DrawInterfaceNumber(LifeNumberX, n)
end;
procedure DrawInterface;
begin
DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient, BorderSymbol);
DrawLineY(InterfaceCellW * WidthCoefficient, 1,
InterfaceBarH, BorderSymbol);
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1,
InterfaceBarH, BorderSymbol)
end;
procedure DrawLevel(var level: levelState; life, score: integer);
begin
DrawInterface;
FillCells(level.a, 1, 1, ArenaW, ArenaH);
DrawArenaEdges;
DrawTrace(level.t);
DrawCreature(level.h);
DrawAliveEnemies(level.enemyList);
DrawLifes(life);
DrawCompleteBar;
FillCompleteBar(level.cut);
DrawScore(score)
end;
procedure ErasePause;
begin
EraseRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseBannerWidth + PauseXPadding * 2,
PauseBannerHeight + PauseYPadding * 2 + 1)
end;
procedure DrawLevelUnpause(var level: levelState);
begin
ErasePause;
FillCellsUnpause(level.a);
DrawTrace(level.t);
DrawAliveEnemies(level.enemyList);
DrawCreature(level.h)
end;
procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char);
var
i, j, screenX, screenY: integer;
begin
screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient;
screenY := InterfaceBarH + (arenaY - 1) * CellSize;
for i := 1 to CellSize do
begin
GotoXY(screenX, screenY + i - 1);
for j := 1 to CellSize * WidthCoefficient do
begin
if (screenX + j - 1 >= 1) and
(screenX + j - 1 <= ScreenW * WidthCoefficient) then
begin
write(symbol)
end
end
end
end;
procedure DrawArenaEdges;
begin
DrawRectangle(1, InterfaceBarH,
ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient,
BorderSymbol)
end;
procedure DrawLeftEdge(y: integer);
var
terminalY, clampedY: integer;
begin
clampedY := Clamp(y, 1, ArenaH);
terminalY := InterfaceBarH + (clampedY - 1) * CellSize;
DrawLineY(1, terminalY, CellSize, BorderSymbol)
end;
procedure DrawRightEdge(y: integer);
var
terminalY, clampedY: integer;
begin
clampedY := Clamp(y, 1, ArenaH);
terminalY := InterfaceBarH + (clampedY - 1) * CellSize;
DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize, BorderSymbol)
end;
procedure DrawUpperEdge(x: integer);
var
terminalX, sizeX, clampedX: integer;
begin
clampedX := Clamp(x, 1, ArenaW);
terminalX := (clampedX - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbol)
end;
procedure DrawLowerEdge(x: integer);
var
terminalX, sizeX, clampedX: integer;
begin
clampedX := Clamp(x, 1, ArenaW);
terminalX := (clampedX - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH + ArenaH * CellSize - 1,
sizeX, BorderSymbol)
end;
procedure DrawArenaBorders(var a: arena);
var
i, j: integer;
begin
for i := 1 to ArenaH do
for j := 1 to ArenaW do
if a.borders[i][j] then
DrawFieldCell(j, i, BorderSymbol)
end;
procedure DrawEdge(x, y: integer);
begin
if x = 1 then
DrawLeftEdge(y)
else
if x = ArenaW then
DrawRightEdge(y);
if y = 1 then
DrawUpperEdge(x)
else
if y = ArenaH then
DrawLowerEdge(x)
end;
procedure DrawArenaCell(x, y: integer; var a: arena);
begin
if a.captured[y][x] then
DrawFieldCell(x, y, CaptureSymbol)
else
if a.borders[y][x] then
DrawFieldCell(x, y, BorderSymbol)
else
DrawFieldCell(x, y, ArenaSymbol);
if IsOnEdge(x, y) then
DrawEdge(x, y)
end;
procedure DrawCapturedCell(x, y: integer);
begin
DrawFieldCell(x, y, CaptureSymbol);
if IsOnEdge(x, y) then
DrawEdge(x, y)
end;
procedure EraseTrace(tp: tracePtr; var a: arena);
var
t: tracePtr;
begin
if tp = nil then
exit;
t := tp;
while t <> nil do
begin
if t^.prev = nil then
DrawArenaCell(t^.x, t^.y, a)
else
DrawFieldCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
end
end;
procedure FillCellsCapture(var a: arena);
var
i, j: integer;
begin
for i := 1 to ArenaH do
for j := 1 to ArenaW do
begin
if not a.captured[i][j] then
DrawCapturedCell(j, i)
end
end;
procedure DrawHamsterRunX(var h: creature);
var
xIdx: integer;
img: ^creatureImage;
begin
if h.dX = 0 then
exit;
xIdx := h.curX div h.moveSpeed mod HamsterRunNX + 1;
if h.dX > 0 then
img := @(HamsterRightAscii[xIdx])
else
img := @(HamsterLeftAscii[xIdx]);
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth, img^);
end;
procedure DrawHamsterRunY(var h: creature);
var
yIdx: integer;
img: ^creatureImage;
begin
if h.dY = 0 then
exit;
yIdx := h.curY div h.moveSpeed mod HamsterRunNY + 1;
if h.dY > 0 then
img := @(HamsterDownAscii[yIdx])
else
img := @(HamsterUpAscii[yIdx]);
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth, img^)
end;
procedure DrawHamster(var h: creature);
begin
if (h.dX = 0) and (h.dY = 0) then
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth,
HamsterStayAscii)
else
if h.dX <> 0 then
DrawHamsterRunX(h)
else
if h.dY <> 0 then
DrawHamsterRunY(h);
GotoXY(1, 1)
end;
procedure DrawGhost(var g: creature);
var
asciiIdx: integer;
begin
asciiIdx := g.curX div g.moveSpeed mod GhostRunN + 1;
DrawFieldAscii(g.curX - GhostWidth div WidthCoefficient div 2,
g.curY - GhostHeight div 2 + 1,
GhostHeight, GhostWidth, GhostAscii[asciiIdx])
end;
procedure DrawSun(var g: creature);
var
asciiIdx, h: integer;
img: ^creatureImage;
begin
if g.rageMode then
begin
img := @(GoidaSunAscii);
h := GoidaSunHeight
end
else
begin
asciiIdx := g.curX div g.moveSpeed mod SunRunN + 1;
img := @(SunAscii[asciiIdx]);
h := SunHeight
end;
DrawFieldAscii(g.curX - SunWidth div WidthCoefficient div 2,
g.curY - h div 2 + 1, h, SunWidth, img^)
end;
procedure DrawSnake(var g: creature);
var
asciiIdx: integer;
begin
asciiIdx := g.curX div g.moveSpeed mod SnakeRunN + 1;
DrawFieldAscii(g.curX - SnakeWidth div WidthCoefficient div 2,
g.curY - SnakeHeight div 2 + 1,
SnakeHeight, SnakeWidth, SnakeAscii[asciiIdx])
end;
procedure DrawDrop(var g: creature);
begin
DrawFieldAscii(g.curX - DropWidth div WidthCoefficient div 2,
g.curY - DropHeight div 2 + 1, DropHeight,
DropWidth, DropAscii)
end;
procedure DrawCreature(var cr: creature);
begin
case cr.t of
creatureHamster:
DrawHamster(cr);
creatureGhost:
DrawGhost(cr);
creatureSun:
DrawSun(cr);
creatureSnake:
DrawSnake(cr);
creatureDrop:
DrawDrop(cr)
end
end;
procedure ShowLifeUp;
begin
DrawBannerImage((ScreenW * WidthCoefficient - LifeupBannerWidth) div 2,
(ScreenH - LifeupBannerHeight) div 2,
LifeupBannerHeight,
LifeupBanner)
end;
procedure ShowSpeedUp;
begin
DrawBannerImage((ScreenW * WidthCoefficient - SpeedupBannerWidth) div 2,
(ScreenH - SpeedupBannerHeight) div 2,
SpeedupBannerHeight,
SpeedupBanner)
end;
procedure ShowSpeedDown;
begin
DrawBannerImage((ScreenW * WidthCoefficient - SpeeddownBannerWidth) div 2,
(ScreenH - SpeeddownBannerHeight) div 2,
SpeeddownBannerHeight,
SpeeddownBanner)
end;
end.

643
src/arena_m.pas Normal file
View File

@ -0,0 +1,643 @@
unit arena_m;
interface
uses creature_m, cell_m, trace_m;
const
ArenaH = 33;
ArenaW = 41;
TotalCells = ArenaW * ArenaH;
RandomCutThreshold = 25;
type
arenaMatrix = array [1..ArenaH, 1..ArenaW] of boolean;
arena = record
captured, borders: arenaMatrix;
end;
function ArenaSplited(var h: creature; var t: tracePtr; var a: arena): boolean;
function
HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean;
function IsOnEdge(var cr: creature): boolean;
function IsOnEdge(x, y: integer): boolean;
procedure ArenaCutPart(var hamster: creature; var t: tracePtr;
var cutOff: integer; var a: arena);
procedure InitArena(var a: arena);
procedure KillCapturedEnemies(var a: arena; var e: creatureList);
procedure EraseEnemies(var a: arena; var e: creatureList);
procedure MakeEnemySteps(var a: arena; var h: creature;
t: tracePtr; var e: creatureList);
procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
procedure SetArenaBorder(var t: tracePtr; var a: arena);
procedure TurnStubbornEnemies(var a: arena; var e: creatureList);
procedure MakeStep(var a: arena; var enemy: creature);
implementation
uses arena_graphics_m, crt, graphics_m, snake_m, drop_m, math_m, Math;
const
MaxTurnAttempts = 3;
TotalProcent = 100;
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 <> ArenaW + 1) and
(y <> 0) and (y <> ArenaH + 1) and
not a.captured[y][x] and not a.borders[y][x]
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^.y][cell^.x] := 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.y][cell.x] then
continue;
result := result + 1;
a.captured[cell.y][cell.x] := 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.y][cell.x] then
continue;
cutOff := cutOff + 1;
a.captured[cell.y][cell.x] := true;
DrawArenaCell(cell.x, cell.y, a);
AddAvailableNeighbours(captureQ, cell, a)
end
end;
function OnEdgeX(x: integer): boolean;
begin
OnEdgeX := (x = 1) or (x = ArenaW)
end;
function OnEdgeY(y: integer): boolean;
begin
OnEdgeY := (y = 1) or (y = ArenaH)
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[y + 1][x] and a.captured[y - 1][x]
end;
function XNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
XNeighboursCaptured :=
not OnEdgeX(x) and a.captured[y][x + 1] and a.captured[y][x - 1]
end;
function DiagonalNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
DiagonalNeighboursCaptured :=
not IsOnEdge(x, y) and
a.captured[y - 1][x - 1] and a.captured[y + 1][x - 1] and
a.captured[y - 1][x + 1] and a.captured[y + 1][x + 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[y][x] := false;
a.captured[y][x] := true;
DrawFieldCell(x, y, CaptureSymbol)
end;
procedure CaptureCutBorders(var a: arena; var cutOff: integer); {rename, slow}
var
i, j: integer;
begin
for i := 1 to ArenaH do
for j := 1 to ArenaW do
if a.borders[i][j] 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
exit;
a.borders[t^.y][t^.x] := true;
SetArenaBorder(t^.prev, a)
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 x, y: integer; var a: arena): boolean;
begin
IsOnBorder :=
a.borders[y][x] and (
a.captured[y + 1][x - 1] or
a.captured[y - 1][x - 1] or
a.captured[y + 1][x + 1] or
a.captured[y - 1][x + 1]
)
end;
function IsOnBorder(var cr: creature; var a: arena): boolean;
begin
IsOnBorder :=
a.borders[cr.curY][cr.curX] and (
a.captured[cr.curY + 1][cr.curX - 1] or
a.captured[cr.curY - 1][cr.curX - 1] or
a.captured[cr.curY + 1][cr.curX + 1] or
a.captured[cr.curY - 1][cr.curX + 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 / TotalProcent;
LowerToBiggerRatio := Round(TotalProcent - 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, ArenaW);
nextY := Clamp(hamster.curY + hamster.dY, 1, ArenaH);
idx := FindIndex(t, nextX, nextY, 1);
StepOnTrace := idx > PreviousTraceIdx
end;
function StepBeyondEdgeX(var cr: creature): boolean;
begin
StepBeyondEdgeX :=
(cr.dX > 0) and (cr.curX = ArenaW) or
(cr.dX < 0) and (cr.curX = 1)
end;
function StepBeyondEdgeY(var cr: creature): boolean;
begin
StepBeyondEdgeY :=
(cr.dY > 0) and (cr.curY = ArenaH) or
(cr.dY < 0) and (cr.curY = 1)
end;
function StepBeyondEdge(var cr: creature): boolean;
begin
StepBeyondEdge := StepBeyondEdgeX(cr) or StepBeyondEdgeY(cr)
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 ArenaCutPart(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, ArenaW);
nextY := Clamp(h.curY + h.dY, 1, ArenaH);
midX := Clamp(h.curX + (h.dX div 2), 1, ArenaW);
midY := Clamp(h.curY + (h.dY div 2), 1, ArenaH);
HamsterStepPossible :=
not StepOnTrace(h, t)
and (not a.captured[midY][midX] or IsOnEdge(nextX, nextY))
and not StepBeyondEdge(h)
and not (
not IsOnEdge(h) and a.borders[h.curY][h.curX] and
a.captured[midY][midX]
);
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[midY][midX] and
not a.borders[hamster.curY][hamster.curX] 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.curY][hamster.curX] and
not a.borders[midY][midX]
end;
procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
begin
h.curX := Clamp(h.curX + h.dX, 1, ArenaW);
h.curY := Clamp(h.curY + h.dY, 1, ArenaH);
if FieldToEdge(h, t, a) or IsOnField(h, t, a) then
ChangeHamsterTrace(h, t);
DrawAfterHamsterStep(h, t, a)
end;
function VerticalBorder(var a: arena; nextX, nextY: integer): boolean;
begin
VerticalBorder :=
a.borders[nextY][nextX] and
(a.borders[nextY - 1][nextX] or a.borders[nextY + 1][nextX])
end;
function HorizontalBorder(var a: arena; nextX, nextY: integer): boolean;
begin
HorizontalBorder :=
a.borders[nextY][nextX] and
(a.borders[nextY][nextX - 1] or a.borders[nextY][nextX + 1])
end;
function IsCorner(x, y: integer; var a: arena): boolean;
begin
IsCorner := HorizontalBorder(a, x, y) and VerticalBorder(a, x, y)
end;
procedure TpDrop(var a: arena; var e: creature);
var
nx, ny: integer;
begin
while true do
begin
nx := RandomLR(1, ArenaW);
ny := RandomLR(1, ArenaH);
if not a.captured[ny][nx] then
break
end;
e.curX := nx;
e.curY := ny
end;
procedure MakeEnemyStep(var a: arena; var e, hamster: creature; t: tracePtr);
var
prevX, prevY: integer;
begin
if (e.t = creatureDrop) and (e.beforeTransform = 0) then
begin
TpDrop(a, e);
exit
end;
prevX := e.curX;
prevY := e.curY;
MakeStep(a, e);
if TraceCrossed(prevX, prevY, e, t) then
hamster.alive := false
end;
procedure KillCapturedEnemies(var a: arena; var e: creatureList);
var
tmp: creatureItemPtr;
begin
tmp := e.first;
while tmp <> nil do
begin
if tmp^.cr^.alive and a.captured[tmp^.cr^.curY][tmp^.cr^.curX] then
KillCreature(tmp^.cr^);
tmp := tmp^.next
end
end;
procedure TurnOtherwise(var a: arena; var g: creature);
begin
if (OnEdgeX(g.curX) or VerticalBorder(a, g.curX, g.curY)) then
g.dX := g.dX * -1;
if (OnEdgeY(g.curY) or HorizontalBorder(a, g.curX, g.curY)) then
g.dY := g.dY * -1
end;
procedure SetVerticalMove(var g: creature; ms: integer);
begin
g.dX := 0;
g.dY := ms;
if RandomBool then
g.dY := -g.dY
end;
procedure SetHorizontalMove(var g: creature; ms: integer);
begin
g.dX := ms;
g.dY := 0;
if RandomBool then
g.dX := -g.dX
end;
procedure TurnToDiagonal(var g: creature; ms: integer);
begin
if (g.dX <> 0) and (g.dY <> 0) then
begin
g.dX := -g.dX;
g.dY := -g.dY
end
else
begin
g.dX := ms;
if RandomBool then
g.dX := -g.dX;
g.dY := ms;
if RandomBool then
g.dY := -g.dY
end
end;
procedure EightDimensionTurn(var a: arena; var g: creature;
var diagonalMove: boolean; ms: integer);
begin
if RandomBool then
diagonalMove := not diagonalMove;
if diagonalMove then
begin
TurnToDiagonal(g, ms)
end
else
begin
if OnEdgeX(g.curX) or VerticalBorder(a, g.curX, g.curY) then
SetVerticalMove(g, ms)
else
SetHorizontalMove(g, ms)
end
end;
procedure TurnEnemy(var cr: creature; var a: arena);
begin
case cr.t of
creatureGhost:
TurnOtherwise(a, cr);
creatureSun:
TurnOtherwise(a, cr);
creatureSnake, creatureDrop:
begin
if cr.t = creatureSnake then
EightDimensionTurn(a, cr, cr.diagonalMove, SnakeMovespeed)
else
EightDimensionTurn(a, cr, cr.diagonalMove, DropMovespeed)
end;
end
end;
function EnemyShouldTurn(var e: creature; var a: arena): boolean;
var
oldX, oldY, newX, newY: integer;
begin
oldX := e.curX;
oldY := e.curY;
MakeStep(a, e);
newX := e.curX;
newY := e.curY;
e.curX := oldX;
e.curY := oldY;
EnemyShouldTurn := (oldX = newX) and (oldY = newY)
end;
procedure TurnStubbornEnemies(var a: arena; var e: creatureList);
var
turnCnt: integer = 0;
tmp: creatureItemPtr;
begin
tmp := e.first;
while tmp <> nil do
begin
while tmp^.cr^.alive and EnemyShouldTurn(tmp^.cr^, a) and
(turnCnt < MaxTurnAttempts) do
begin
TurnEnemy(tmp^.cr^, a);
turnCnt := turnCnt + 1
end;
turnCnt := 0;
tmp := tmp^.next
end
end;
procedure EraseEnemies(var a: arena; var e: creatureList);
var
tmp: creatureItemPtr;
begin
tmp := e.first;
while tmp <> nil do
begin
if tmp^.cr^.curY = 1 then
RedrawInterfaceArea(tmp^.cr^.curX, tmp^.cr^.t);
if tmp^.cr^.alive and not EnemyShouldTurn(tmp^.cr^, a) then
RedrawArea(a, tmp^.cr^.curX, tmp^.cr^.curY, tmp^.cr^.t);
tmp := tmp^.next
end
end;
procedure MakeEnemySteps(var a: arena; var h: creature;
t: tracePtr; var e: creatureList);
var
tmp: creatureItemPtr;
begin
tmp := e.first;
while tmp <> nil do
begin
if tmp^.cr^.alive and not EnemyShouldTurn(tmp^.cr^, a) then
MakeEnemyStep(a, tmp^.cr^, h, t);
tmp := tmp^.next
end
end;
procedure MakeStep(var a: arena; var enemy: creature);
var
absDx, absDy, maxD, stepX, stepY, i, nX, nY: integer;
begin
absDx := Abs(enemy.dX);
absDy := Abs(enemy.dY);
maxD := Max(absDx, absDy);
stepX := Signum(enemy.dX, 0);
stepY := Signum(enemy.dY, 0);
for i := 1 to maxD do
begin
nX := enemy.curX + stepX;
nY := enemy.curY + stepY;
if a.captured[nY][nX] or (nX < 1) or (nX > ArenaW) or
(nY < 1) or (nY > ArenaH) then
begin
break
end
else
begin
enemy.curX := nX;
enemy.curY := nY
end
end
end;
end.

307
src/ascii_arts_m.pas Normal file
View File

@ -0,0 +1,307 @@
unit ascii_arts_m;
interface
const
HamsterHeight = 5;
HamsterLifesWidth = 13;
MaxBannerWidth = 98;
MaxBannerHeight = 42;
DigitHeight = 5;
DigitWidth = 5;
type
CreatureImage = array[1..HamsterHeight] of string[HamsterLifesWidth];
BannerImage = array[1..MaxBannerHeight] of string[MaxBannerWidth];
DigitImage = array[1..DigitHeight] of string[DigitWidth];
const
DigitsAscii: array[0..9] of DigitImage = (
(
'@@@@@',
'@ @',
'@ @',
'@ @',
'@@@@@'
),
(
' @ ',
' @@ ',
'@ @ ',
' @ ',
'@@@@@'
),
(
'@@@@@',
' @',
'@@@@@',
'@ ',
'@@@@@'
),
(
'@@@@@',
' @',
'@@@@@',
' @',
'@@@@@'
),
(
'@ @',
'@ @',
'@@@@@',
' @',
' @'
),
(
'@@@@@',
'@ ',
'@@@@@',
' @',
'@@@@@'
),
(
'@@@@@',
'@ ',
'@@@@@',
'@ @',
'@@@@@'
),
(
'@@@@@',
' @',
' @',
' @',
' @'
),
(
'@@@@@',
'@ @',
'@@@@@',
'@ @',
'@@@@@'
),
(
'@@@@@',
'@ @',
'@@@@@',
' @',
'@@@@@'
)
);
const
YesHeight = 6;
NoHeight = 4;
NoWidth = 13;
HamsterWidth = 7;
HamsterStayAscii: CreatureImage = (
' (\_/)',
'( 0_0 )',
'/-----\',
' |___|',
' / \'
);
{
HamsterStayAscii: CreatureImage = (
' (\_/)',
'( 0_0 )',
'/-----\',
' |___|',
' / \'
);
}
HamsterRunNX = 4;
HamsterRightAscii: array[1..HamsterRunNX] of CreatureImage = (
(
' _/)',
' ( 0)',
' | \_',
' |___|',
'-- \'
),
(
' _/)',
' ( 0)',
' | |_|',
' |___|',
' |>'
),
(
' _/)',
' ( 0)',
' |/_ |-',
' |___|',
'-- \'
),
(
' _/) ',
' ( 0)',
' | |_|',
' |___|',
' >| '
)
);
HamsterLeftAscii: array[1..HamsterRunNX] of CreatureImage = (
(
' (\_ ',
' (0 )',
' _/ |',
' |___|',
' / --'
),
(
' (\_ ',
' (0 )',
' |_| |',
' |___|',
' <|'
),
(
' (\_',
' (0 )',
'-| _\|',
' |___|',
' / --'
),
(
' (\_',
' (0 )',
' |_| |',
' |___|',
' |<'
)
);
HamsterRunNY = 2;
HamsterDownAscii: array[1..HamsterRunNY] of CreatureImage = (
(
' (\_/)',
'( 0_o )',
'\----- ',
' |___|\',
' - |'
),
(
' (\_/)',
'( o_0 )',
' -----/',
'/|___|',
' | -'
)
);
HamsterUpAscii: array[1..HamsterRunNY] of CreatureImage = (
(
' (\_/)',
'( )',
'\----- ',
' |_*_|\',
' - |'
),
(
' (\_/)',
'( )',
' -----/',
'/|_*_|',
' | -'
)
);
HamsterGGAscii: CreatureImage = (
' (\_/)',
'( G_G )',
'/-----\',
' |___|',
' / \'
);
HamsterLifesAscii: CreatureImage = (
' (\_/) ',
'( 0_0 ) \ /',
'/-----\ X ',
' |___| / \',
' / \ '
);
GhostHeight = 3;
GhostWidth = 7;
GhostRunN = 2;
GhostAscii: array[1..GhostRunN] of CreatureImage = (
(
' ___',
' /0 0\',
'\/VvV\/',
'',
''
),
(
' ___',
' /0 0\',
'\_____/',
'',
''
)
);
SunHeight = 4;
SunWidth = 7;
SunRunN = 2;
SunAscii: array[1..SunRunN] of CreatureImage = (
(
' _A_',
' / \',
'<|o o|>',
' \_^_/',
''
),
(
' _A_',
' / \',
'{-o o-}',
' \_^_/',
''
)
);
GoidaSunHeight = 4;
GoidaSunAscii: CreatureImage = (
' ___',
' / Z \',
'||> <||',
' \___/',
''
);
SnakeHeight = 5;
SnakeWidth = 7;
SnakeRunN = 2;
SnakeAscii: array[1..SnakeRunN] of CreatureImage = (
(
' /v\ ',
'3 |o |',
'\\ \ / ',
' \\_\\ ',
' \_// '
),
(
' /v\ ',
' o ',
'\\ \ / ',
' ',
' \_// '
)
);
DropHeight = 5;
DropWidth = 7;
DropAscii: CreatureImage = (
' _',
' / \',
' / \',
'/ 0_0 \',
'\_____/'
);
implementation
end.

80
src/cell_m.pas Normal file
View File

@ -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.

16
src/completed.txt Normal file
View File

@ -0,0 +1,16 @@
GameCompleteScoreWidth 50
== BANNER START ==
' _____ _ _ _ ',
' / ____| | | | | | |',
'| | __ __ _ _ __ ___ ___ ___ ___ _ __ ___ _ __ | | ___| |_ ___| |',
'| | |_ |/ _` | ''_ ` _ \ / _ \ / __/ _ \| ''_ ` _ \| ''_ \| |/ _ \ __/ _ \ |',
'| |__| | (_| | | | | | | __/ | (_| (_) | | | | | | |_) | | __/ || __/_|',
' \_____|\__,_|_| |_| |_|\___| \___\___/|_| |_| |_| .__/|_|\___|\__\___(_)',
' | |',
' |_|',
'__ __',
'\ \ / / _ ',
' \ \_/ /__ _ _ _ __ ___ ___ ___ _ __ ___(_)',
' \ / _ \| | | | ''__| / __|/ __/ _ \| ''__/ _ \',
' | | (_) | |_| | | \__ \ (_| (_) | | | __/_ ',
' |_|\___/ \__,_|_| |___/\___\___/|_| \___(_)'

276
src/convbanners.pas Normal file
View File

@ -0,0 +1,276 @@
program convbanners;
uses Math;
const
AutobannerModuleName = '_autobanners_m.pas';
BannerStartS = '== BANNER START ==';
BannersN = 10;
MenuFile = 'menu.txt';
LevelFile = 'level.txt';
PauseFile = 'paused.txt';
GameOverFile = 'gameover.txt';
GameCompleteFile = 'completed.txt';
KeyInfoFile = 'keys.txt';
ExitFile = 'exit.txt';
LifeupFile = 'lifeup.txt';
SpeedupFile = 'speedup.txt';
SpeeddownFile = 'speeddown.txt';
BannerFiles: array[1..BannersN] of string = (
MenuFile, LevelFile, PauseFile, GameOverFile, GameCompleteFile,
KeyInfoFile, ExitFile, LifeupFile, SpeedupFile, SpeeddownFile
);
MenuVarsPrefix = 'MenuBanner';
LevelVarsPrefix = 'LevelAnnounceBanner';
PauseVarsPrefix = 'PauseBanner';
GameOverVarsPrefix = 'GameOverBanner';
GameCompleteVarsPrefix = 'GameCompleteBanner';
KeysVarsPrefix = 'KeysInfoBanner';
ExitVarsPrefix = 'ExitBanner';
SpeedupVarsPrefix = 'SpeedupBanner';
SpeeddownVarsPrefix = 'SpeeddownBanner';
LifeupVarsPrefix = 'LifeupBanner';
VarsPrefixes: array[1..BannersN] of string = (
MenuVarsPrefix, LevelVarsPrefix, PauseVarsPrefix, GameOverVarsPrefix,
GameCompleteVarsPrefix, KeysVarsPrefix, ExitVarsPrefix,
LifeupVarsPrefix, SpeedupVarsPrefix, SpeeddownVarsPrefix
);
DecimalBase = 10;
AfterImageLinesN = 2;
ModuleBeginH = 13;
ModuleBegin: array[1..ModuleBeginH] of string = (
'{ ************************************************** }',
'{ ************************************************** }',
'{ *** *** }',
'{ *** *** }',
'{ *** AUTOMATICALLY GENERATED FILE. DO NOT EDIT. *** }',
'{ *** *** }',
'{ *** *** }',
'{ ************************************************** }',
'{ ************************************************** }',
'unit _autobanners_m;',
'',
'interface',
''
);
BannerImageTypeStr =
'BannerImage = array[1..MaxBannerHeight] of string[MaxBannerWidth];';
ModuleEndH = 2;
ModuleEnd: array[1..ModuleEndH] of string = (
'implementation',
'end.'
);
procedure AppendText(var f: text; var t: array of string; h: integer);
var
i: integer;
begin
for i := 1 to h do
writeln(f, t[i - 1])
end;
function ParsedStrLength(var s: string): integer;
var
res: integer = 0;
backtickCnt: integer = 0;
i, sLen: integer;
begin
sLen := Length(s);
res := sLen;
for i := 1 to Length(s) do
if s[i] = '''' then
backtickCnt := backtickCnt + 1;
if s[sLen] = ',' then
res := res - 1;
res := res - 2; {Subtract first and last '}
backtickCnt := backtickCnt - 2; {Subtract first and last '}
ParsedStrLength := res - (backtickCnt div 2)
end;
procedure GetMaxBannersDimensions(var h, w: integer);
var
i, len: integer;
curH: integer = 0;
t: text;
ln: string;
isBanner: boolean = false;
begin
h := 0;
w := 0;
for i := 1 to BannersN do
begin
curH := 0;
isBanner := false;
assign(t, BannerFiles[i]);
reset(t);
while not eof(t) do
begin
readln(t, ln);
if not isBanner then
begin
isBanner := (ln = BannerStartS);
continue
end;
curH := curH + 1;
len := ParsedStrLength(ln);
w := Max(w, len);
if len > 0 then
h := max(h, curH)
end
end
end;
procedure AppendMaxBannersDimensions(var t: text; maxH, maxW: integer);
begin
writeln(t, 'MaxBannerHeight = ', maxH, ';');
writeln(t, 'MaxBannerWidth = ', maxW, ';');
writeln(t, '')
end;
procedure AppendBannersType(var t: text);
begin
writeln(t, 'type');
writeln(t, BannerImageTypeStr);
writeln(t, '')
end;
procedure GetBannerDimensions(var fileName: string; var h, w: integer);
var
sLen: integer;
hNow: integer = 0;
fileFrom: text;
ln: string;
isBanner: boolean = false;
begin
w := 0;
h := 0;
assign(fileFrom, fileName);
reset(fileFrom);
while not eof(fileFrom) do
begin
readln(fileFrom, ln);
if not isBanner then
begin
isBanner := (ln = BannerStartS);
continue
end;
sLen := ParsedStrLength(ln);
w := Max(w, sLen);
hNow := hNow + 1;
if sLen > 0 then
h := hNow
end
end;
procedure ParseNum(var ln, res: string; idx: integer);
var
i, n: integer;
begin
n := Length(ln);
for i := idx to n do
begin
if (ln[i] <= '0') or (ln[i] >= '9') then
begin
res := copy(ln, idx, i - 1);
break
end;
if i = n then
res := copy(ln, idx, i)
end
end;
procedure AppendConst(var fileTo: text; var ln: string);
var
idx: integer = 1;
lenS: integer;
num: string;
constName: string = '';
begin
lenS := Length(ln);
while (idx <= lenS) do
begin
if ln[idx] = ' ' then
break;
idx := idx + 1
end;
if (idx >= lenS) or (idx = 1) then
exit;
constName := copy(ln, 1, idx - 1);
ParseNum(ln, num, idx + 1);
writeln(fileTo, constName, ' = ', num, ';')
end;
procedure AppendConsts(var fileFrom, fileTo: text);
var
isBanner: boolean = false;
ln: string;
begin
while not isBanner do
begin
readln(fileFrom, ln);
isBanner := (ln = BannerStartS);
if not isBanner and (Length(ln) > 0) then
AppendConst(fileTo, ln)
end;
end;
procedure AppendBanner(var fileTo: text; bannerImageH: integer;
var fileName, varPrefix: string);
var
w, h, i: integer;
fileFrom: text;
ln: string;
begin
GetBannerDimensions(fileName, h, w);
writeln(fileTo, varPrefix, 'Height = ', h, ';');
writeln(fileTo, varPrefix, 'Width = ', w, ';');
assign(fileFrom, fileName);
reset(fileFrom);
AppendConsts(fileFrom, fileTo);
writeln(fileTo, varPrefix, ': BannerImage = (');
while not eof(fileFrom) do
begin
readln(fileFrom, ln);
if (ln[Length(ln)] = ',') or (h = bannerImageH) then
writeln(fileTo, ln)
else
writeln(fileTo, ln, ',')
end;
for i := 1 to (bannerImageH - h - 1) do
writeln(fileTo, ''''',');
if bannerImageH <> h then
writeln(fileTo, '''''');
writeln(fileTo, ');');
writeln(fileTo, '')
end;
procedure CreateAutobannerModule;
var
i, maxH, maxW: integer;
newModule: text;
begin
assign(newModule, AutobannerModuleName);
rewrite(newModule);
AppendText(newModule, ModuleBegin, ModuleBeginH);
writeln(newModule, 'const');
GetMaxBannersDimensions(maxH, maxW);
AppendMaxBannersDimensions(newModule, maxH, maxW);
AppendBannersType(newModule);
writeln(newModule, 'const');
for i := 1 to BannersN do
AppendBanner(newModule, maxH, BannerFiles[i], VarsPrefixes[i]);
AppendText(newModule, ModuleEnd, ModuleEndH);
close(newModule)
end;
begin
CreateAutobannerModule
end.

171
src/creature_m.pas Normal file
View File

@ -0,0 +1,171 @@
unit creature_m;
interface
type
creatureType = (creatureHamster, creatureGhost, creatureSun,
creatureSnake, creatureDrop);
creaturePtr = ^creature;
creature = record
curX, curY, dX, dY, moveSpeed, animation: integer;
alive: boolean;
t: creatureType;
rageMode: boolean; {for sun }
bigStep: boolean; {for sun }
beforeTransform: integer; {for sun and drop }
diagonalMove: boolean; {for snake and drop}
beforeReverse: integer; {for snake and drop}
end;
creatureItemPtr = ^creatureItem;
creatureItem = record
cr: creaturePtr;
next: creatureItemPtr
end;
creatureList = record
len: integer;
first, last: creatureItemPtr;
end;
function RandomLR(l, r: integer): integer;
procedure AppendCreature(var lst: creatureList; c: creaturePtr);
procedure DisposeCreatureList(var lst: creatureList);
procedure KillCreature(var cr: creature);
procedure InitCreatureList(var lst: creatureList);
procedure StopCreature(var cr: creature);
procedure UpdateEnemyStates(var lst: creatureList);
implementation
uses arena_graphics_m, arena_m, math_m, ascii_arts_m, sun_m, snake_m, drop_m;
function RandomLR(l, r: integer): integer;
begin
RandomLR := l + Random(r - l + 1)
end;
procedure AppendCreature(var lst: creatureList; c: creaturePtr);
var
item: creatureItemPtr;
begin
new(item);
item^.cr := c;
item^.next := nil;
if lst.first = nil then
lst.first := item
else
lst.last^.next := item;
lst.last := item
end;
procedure DisposeCreatureList(var lst: creatureList);
var
tmp: creatureItemPtr;
begin
while lst.first <> nil do
begin
tmp := lst.first;
lst.first := lst.first^.next;
if lst.first = nil then
lst.last := nil;
dispose(tmp^.cr);
dispose(tmp);
lst.len := lst.len - 1
end
end;
procedure KillCreature(var cr: creature);
begin
cr.alive := false
end;
procedure InitCreatureList(var lst: creatureList);
begin
lst.len := 0;
lst.first := nil;
lst.last := nil
end;
procedure StopCreature(var cr: creature);
begin
cr.dX := 0;
cr.dY := 0
end;
procedure UpdateEnemyCreatureState(var cr: creature);
begin
case cr.t of
creatureSun:
UpdateSunState(cr);
creatureSnake:
UpdateSnakeState(cr);
creatureDrop:
UpdateDropState(cr)
end
end;
procedure UpdateEnemyStates(var lst: creatureList);
var
tmp: creatureItemPtr;
begin
tmp := lst.first;
while tmp <> nil do
begin
if tmp^.cr^.t <> creatureGhost then
UpdateEnemyCreatureState(tmp^.cr^);
tmp := tmp^.next
end
end;
procedure SpeedDownCreatures(var lst: creatureList);
var
tmp: creatureItemPtr;
begin
tmp := lst.first;
while tmp <> nil do
begin
tmp^.cr^.moveSpeed := tmp^.cr^.moveSpeed - 1;
if tmp^.cr^.dX > 0 then
tmp^.cr^.dX := tmp^.cr^.dX - 1;
if tmp^.cr^.dX < 0 then
tmp^.cr^.dX := tmp^.cr^.dX + 1;
if tmp^.cr^.dY > 0 then
tmp^.cr^.dY := tmp^.cr^.dY - 1;
if tmp^.cr^.dY < 0 then
tmp^.cr^.dY := tmp^.cr^.dY + 1;
tmp := tmp^.next
end
end;
procedure RestoreCreaturesMovespeed(var lst: creatureList);
var
tmp: creatureItemPtr;
begin
tmp := lst.first;
while tmp <> nil do
begin
tmp^.cr^.moveSpeed := tmp^.cr^.moveSpeed + 1;
if tmp^.cr^.dX > 0 then
tmp^.cr^.dX := tmp^.cr^.dX + 1;
if tmp^.cr^.dX < 0 then
tmp^.cr^.dX := tmp^.cr^.dX - 1;
if tmp^.cr^.dY > 0 then
tmp^.cr^.dY := tmp^.cr^.dY + 1;
if tmp^.cr^.dY < 0 then
tmp^.cr^.dY := tmp^.cr^.dY - 1;
tmp := tmp^.next
end
end;
end.

112
src/debug_m.pas Normal file
View File

@ -0,0 +1,112 @@
unit debug_m;
interface
uses arena_m, cell_m, creature_m;
procedure Debug;
procedure DebugCell(cell: cellItemPtr);
procedure Print(var m: arenaMatrix);
procedure PrintCallTime(s: string; y: integer);
procedure PrintCreatureDebug(var cr: creature);
procedure PrintEnemies(var lst: creatureList);
implementation
uses crt;
const
DebugMsg = '===============DEBUG===============';
DebugPrintY = 10;
DebugPrintX = 10;
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 ArenaH do
begin
for j := 1 to ArenaW do
if m[i][j] 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;
function EnemyToString(cr: creaturePtr): string;
begin
case cr^.t of
creatureHamster:
EnemyToString := 'Hamster';
creatureGhost:
EnemyToString := 'Ghost';
creatureSun:
EnemyToString := 'Sun';
creatureSnake:
EnemyToString := 'Snake';
creatureDrop:
EnemyToString := 'Drop'
end
end;
procedure PrintEnemies(var lst: creatureList);
var
y: integer = DebugPrintY;
tmp: creatureItemPtr;
s: string;
begin
tmp := lst.first;
while tmp <> nil do
begin
GotoXY(DebugPrintX, y);
s := EnemyToString(tmp^.cr);
write(s, ', Y: ', tmp^.cr^.curY, ', X: ', tmp^.cr^.curX);
tmp := tmp^.next;
y := y + 1
end
end;
var
callCnt: integer = 0;
procedure PrintCallTime(s: string; y: integer);
begin
GotoXY(10, 80 + y);
writeln(callCnt, ' GameCutPart');
callCnt := callCnt + 1;
GotoXY(1, 1)
end;
end.

52
src/drop_m.pas Normal file
View File

@ -0,0 +1,52 @@
unit drop_m;
interface
uses creature_m;
procedure UpdateDropState(var d: creature);
procedure InitRandomDrop(var s: creature);
const
DropMovespeed = 2;
implementation
uses arena_m, Math, math_m;
const
MinToTp = 10;
MaxToTp = 75;
procedure InitDrop(var s: creature; x, y, sigdx, sigdy: integer);
begin
s.t := creatureDrop;
s.curX := x;
s.curY := y;
s.dX := DropMovespeed * sigdx;
s.dY := DropMovespeed * sigdy;
s.alive := true;
s.moveSpeed := DropMovespeed;
s.beforeTransform := RandomLR(MinToTp, MaxToTp);
s.diagonalMove := false
end;
procedure InitRandomDrop(var s: creature);
var
x, y, sigdx, sigdy: integer;
begin
sigdx := IfThen(RandomBool, 1, -1);
sigdy := IfThen(RandomBool, 1, -1);
x := RandomLR(2, ArenaW - 1);
y := RandomLR(2, ArenaH - 1);
InitDrop(s, x, y, sigdx, sigdy)
end;
procedure UpdateDropState(var d: creature);
begin
if d.beforeTransform = 0 then
d.beforeTransform := RandomLR(MinToTp, MaxToTp);
d.beforeTransform := d.beforeTransform - 1
end;
end.

92
src/enemy_packs_m.pas Normal file
View File

@ -0,0 +1,92 @@
unit enemy_packs_m;
interface
uses creature_m;
type
enemyPackType = (enemyPack1, enemyPack2, enemyPack3, enemyPack4,
enemyPack5, enemyPack6, enemyPack7, enemyPack8,
enemyPack9, enemyPack10);
procedure AppendEnemies(var lst: creatureList; t: enemyPackType);
implementation
uses ghost_m, sun_m, snake_m, drop_m;
const
LevelGhostN: array[enemyPackType] of integer = (
4, 4, 2, 4, 4, 2, 4, 2, 4, 4
);
LevelSunN: array[enemyPackType] of integer = (
0, 1, 4, 2, 0, 2, 2, 2, 2, 0
);
LevelSnakeN: array[enemyPackType] of integer = (
0, 0, 0, 1, 2, 2, 2, 4, 2, 2
);
LevelDropN: array[enemyPackType] of integer = (
0, 0, 0, 0, 2, 2, 1, 1, 2, 4
);
procedure AppendRandomGhosts(var lst: creatureList; t: enemyPackType);
var
i: integer;
c: creaturePtr;
begin
for i := 1 to LevelGhostN[t] do
begin
new(c);
InitRandomGhost(c^);
AppendCreature(lst, c)
end
end;
procedure AppendRandomSuns(var lst: creatureList; t: enemyPackType);
var
i: integer;
c: creaturePtr;
begin
for i := 1 to LevelSunN[t] do
begin
new(c);
InitRandomSun(c^);
AppendCreature(lst, c)
end
end;
procedure AppendRandomSnakes(var lst: creatureList; t: enemyPackType);
var
i: integer;
c: creaturePtr;
begin
for i := 1 to LevelSnakeN[t] do
begin
new(c);
InitRandomSnake(c^);
AppendCreature(lst, c)
end
end;
procedure AppendRandomDrops(var lst: creatureList; t: enemyPackType);
var
i: integer;
c: creaturePtr;
begin
for i := 1 to LevelDropN[t] do
begin
new(c);
InitRandomDrop(c^);
AppendCreature(lst, c)
end
end;
procedure AppendEnemies(var lst: creatureList; t: enemyPackType);
begin
AppendRandomGhosts(lst, t);
AppendRandomSuns(lst, t);
AppendRandomSnakes(lst, t);
AppendRandomDrops(lst, t)
end;
end.

19
src/exit.txt Normal file
View File

@ -0,0 +1,19 @@
ExitHeight 8
== BANNER START ==
' ______ _ _ _ _ ___',
'| ____| (_) | | | | | |__ \',
'| |__ __ ___| |_ | |_| |__ ___ __ _ __ _ _ __ ___ ___ ) |',
'| __| \ \/ / | __| | __| ''_ \ / _ \ / _` |/ _` | ''_ ` _ \ / _ \/ /',
'| |____ > <| | |_ | |_| | | | __/ | (_| | (_| | | | | | | __/_|',
'|______/_/\_\_|\__| \__|_| |_|\___| \__, |\__,_|_| |_| |_|\___(_)',
' __/ |',
' |___/',
'',
'',
' _ _ ___ ___ _ __ ___',
'| | | |/ _ \/ __| | ''_ \ / _ \',
'| |_| | __/\__ \ | | | | (_) |',
' \__, |\___||___/ |_| |_|\___/',
' __/ |',
' |___/'

440
src/game_m.pas Normal file
View File

@ -0,0 +1,440 @@
unit game_m;
interface
uses level_m, enemy_packs_m;
type
state = (
gameLevelAnnounce, gameExit, gameMenu, gameStartLevel, gameKeyInfo,
gamePause, gameUnpauseLevel, gameOver, gameComplete,
gameLevelComplete, gameLevelLoop, gameContinueLevel
);
menuState = (menuNewGame, menuKeyInfo, menuContinue);
gameState = record
curExit: boolean;
curMenu: menuState;
curState: state;
level, score, life: integer;
enemyPack: enemyPackType;
shutdown, newGame, unpause, levelInited, skipScene: boolean;
end;
procedure InitGame(var g: gameState);
procedure MainLoop(var g: gameState);
procedure ChangeOtherExitState(var g: gameState);
implementation
uses arena_m, arena_graphics_m, crt, creature_m, graphics_m, hamster_m,
keys_m, debug_m;
const
KeyDelayMs = 125;
MoveDelayMs = 125;
EraseLifeThreshold = 10;
AnnounceDelayMs = 1500;
LevelCompleteDelayMs = 1500;
LevelCount = 20;
StartLifeN = 3;
ScoreAddDivisor = 3;
{BonusThreshold = 750;}
BonusThreshold = 375;
BonusN = 3;
LifeUpBonus = 0;
SpeedUpBonus = 1;
SpeedDownBonus = 2;
procedure DecreaseLife(var life: integer);
begin
if life = EraseLifeThreshold then
EraseLifesNumber(life);
life := life - 1;
DrawLifesNumber(life)
end;
procedure InitGame(var g: gameState);
begin
g.curMenu := menuNewGame;
g.curState := gameMenu;
g.enemyPack := enemyPack1;
g.score := 0;
g.shutdown := false;
g.newGame := false;
g.skipScene := false;
g.life := StartLifeN
end;
procedure RunExitState(var g: gameState; var level: levelState);
begin
DrawExit(g);
while (g.curState = gameExit) and not g.shutdown do
begin
delay(KeyDelayMs);
if keypressed then
HandleKey(g, level)
end;
EraseExit
end;
procedure RunInfoState(var g: gameState; var level: levelState);
begin
DrawKeyInfo;
while (g.curState = gameKeyInfo) and not g.shutdown do
begin
delay(KeyDelayMs);
if keypressed then
HandleKey(g, level)
end;
EraseKeyInfo
end;
procedure RunPauseState(var g: gameState; var level: levelState);
begin
DrawPause;
while (g.curState = gamePause) and not g.shutdown do
begin
delay(KeyDelayMs);
if keypressed then
HandleKey(g, level)
end;
if g.curState = gameMenu then
EraseLevel;
if g.curState = gameUnpauseLevel then
begin
DrawLevelUnpause(level);
level.unpause := true
end
end;
procedure RunGameOverState(var g: gameState; var level: levelState);
begin
DrawGameOver;
DisposeCreatureList(level.enemyList);
g.score := 0;
g.life := StartLifeN;
while (g.curState = gameOver) and not g.shutdown do
begin
delay(KeyDelayMs);
if keypressed then
HandleKey(g, level)
end;
EraseGameOver;
if g.curState = gameLevelAnnounce then
begin
InitLevel(level, g.enemyPack)
end
else
begin
g.levelInited := false;
DisposeCreatureList(level.enemyList)
end
end;
procedure GiveBonus(var g: gameState; var level: levelState);
var
bonus: integer;
begin
bonus := random(BonusN);
if bonus = LifeUpBonus then
begin
g.life := g.life + 1;
DrawLifesNumber(g.life);
ShowLifeUp
end
else
if bonus = SpeedUpBonus then
begin
SpeedUpHamster(level);
ShowSpeedUp
end
else
if bonus = SpeedDownBonus then
begin
SpeedDownEnemies(level);
ShowSpeedDown
end
end;
procedure GameCutPart(var g: gameState; var level: levelState);
var
scoreAdd: integer = 0;
beforeCut, tmp: integer;
begin
beforeCut := level.cut;
SetArenaBorder(level.t, level.a);
ArenaCutPart(level.h, level.t, level.cut, level.a);
FillCompleteBar(level.cut);
tmp := level.cut - beforeCut;
while tmp <> 0 do
begin
scoreAdd := scoreAdd + tmp;
tmp := tmp div ScoreAddDivisor
end;
g.score := g.score + scoreAdd;
DrawScore(g.score)
{
if scoreAdd > BonusThreshold then
GiveBonus(g, level)
}
end;
procedure GameNextLevel(var g: gameState; var level: levelState);
begin
DisposeCreatureList(level.enemyList);
if g.level = LevelCount then
begin
g.levelInited := false;
g.curState := gameComplete;
exit
end;
g.level := g.level + 1;
g.curState := gameLevelComplete;
if g.level mod 2 = 1 then
g.enemyPack := succ(g.enemyPack)
end;
procedure GameKillHamster(var g: gameState; var level: levelState);
begin
if g.life <= 0 then
begin
g.curState := gameOver;
Exit
end;
DecreaseLife(g.life);
KillHamster(level.h, level.t, level.a);
DrawAliveEnemies(level.enemyList);
level.h.alive := true
end;
procedure PollGameKeys(var g: gameState; var level: levelState);
var
i: integer;
begin
for i := 1 to (MoveDelayMs div KeyDelayMs) do
begin
delay(KeyDelayMs);
if keypressed then
HandleKey(g, level);
if g.curState = gamePause then
break
end
end;
procedure MakeEnemyTurnStages(var level: levelState);
begin
KillCapturedEnemies(level.a, level.enemyList);
TurnStubbornEnemies(level.a, level.enemyList);
EraseEnemies(level.a, level.enemyList);
MakeEnemySteps(level.a, level.h, level.t, level.enemyList);
UpdateEnemyStates(level.enemyList);
DrawAliveEnemies(level.enemyList)
end;
procedure MakeHamsterTurnStages(var g: gameState; var level: levelState);
begin
if not level.h.alive then
GameKillHamster(g, level);
if g.curState = gameOver then
exit;
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);
DrawCreature(level.h)
end;
procedure UpdateLevelBonuses(var level: levelState);
begin
if level.speedUp = 1 then
begin
level.h.movespeed := HamsterMovespeed;
level.h.dX := level.h.dX div 2;
level.h.dY := level.h.dY div 2;
end;
if level.speedUp > 0 then
level.speedUp := level.speedUp - 1;
if level.speedDown > 0 then
level.speedDown := level.speedDown - 1
end;
procedure LevelLoop(var g: gameState; var level: levelState);
begin
while (g.curState = gameLevelLoop) and not g.shutdown do
begin
PollGameKeys(g, level);
if g.curState = gamePause then
break;
if ArenaSplited(level.h, level.t, level.a) then
GameCutPart(g, level);
if IsLevelComplete(level) then
begin
GameNextLevel(g, level);
if g.curState = gameComplete then
EraseLevel;
break
end;
MakeEnemyTurnStages(level);
MakeHamsterTurnStages(g, level);
if (level.speedUp > 0) or (level.speedDown > 0) then
UpdateLevelBonuses(level);
if g.curState = gameOver then
begin
EraseLevel;
break
end
end
end;
procedure RunLevelState(var g: gameState; var level: levelState);
begin
if g.newGame then
begin
g.levelInited := true;
g.level := 1;
g.life := StartLifeN;
g.newGame := false;
g.score := 0
end;
g.curState := gameLevelLoop;
InitLevel(level, g.enemyPack);
DrawLevel(level, g.life, g.score);
LevelLoop(g, level)
end;
procedure UnpauseLevel(var g: gameState; var level: levelState);
begin
if level.unpause then
level.unpause := false
else
DrawLevel(level, g.life, g.score);
g.curState := gameLevelLoop;
LevelLoop(g, level)
end;
procedure ContinueLevel(var g: gameState; var level: levelState);
begin
DrawLevel(level, g.life, g.score);
g.curState := gamePause
end;
procedure RunMenuState(var g: gameState; var level: levelState);
var
prevMenu: boolean = false;
begin
g.curState := gameMenu;
while (g.curState = gameMenu) and not g.shutdown do
begin
if (g.curState = gameMenu) and not prevMenu then
begin
DrawMenu(g);
GotoXY(1, 1);
prevMenu := true
end;
delay(KeyDelayMs);
if keypressed then
HandleKey(g, level);
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 RunAnnounceState(var g: gameState; var level: levelState);
var
i: integer;
begin
DrawAnnounce(g.level);
GotoXY(1, 1);
for i := 1 to AnnounceDelayMs div KeyDelayMs do
begin
delay(KeyDelayMs);
if keypressed then
HandleKey(g, level);
if g.shutdown then
exit;
if g.skipScene then
break
end;
g.skipScene := false;
g.curState := gameStartLevel;
EraseAnnounce(g.level)
end;
procedure RunLevelCompleteState(var g: gameState; var level: levelState);
var
i: integer;
begin
FillCellsCapture(level.a);
DrawCreature(level.h);
for i := 1 to LevelCompleteDelayMs div KeyDelayMs do
begin
delay(KeyDelayMs);
if keypressed then
HandleKey(g, level);
if g.shutdown then
exit;
if g.skipScene then
break
end;
g.skipScene := false;
g.curState := gameLevelAnnounce;
EraseLevel
end;
procedure RunGameCompleteState(var g: gameState; var level: levelState);
begin
DrawGameComplete(g.score);
while (g.curState = gameComplete) and not g.shutdown do
begin
delay(KeyDelayMs);
if keypressed then
HandleKey(g, level)
end;
EraseLevel
end;
procedure MainLoop(var g: gameState);
var
level: levelState;
begin
while not g.shutdown do
case g.curState of
gameLevelAnnounce:
RunAnnounceState(g, level);
gameExit:
RunExitState(g, level);
gameKeyInfo:
RunInfoState(g, level);
gamePause:
RunPauseState(g, level);
gameStartLevel:
RunLevelState(g, level);
gameUnpauseLevel:
UnpauseLevel(g, level);
gameContinueLevel:
ContinueLevel(g, level);
gameOver:
RunGameOverState(g, level);
gameMenu:
RunMenuState(g, level);
gameLevelComplete:
RunLevelCompleteState(g, level);
gameComplete:
RunGameCompleteState(g, level)
end;
clrscr
end;
procedure ChangeOtherExitState(var g: gameState);
begin
g.curExit := not g.curExit
end;
end.

41
src/gameover.txt Normal file
View File

@ -0,0 +1,41 @@
== BANNER START ==
' _____ __ __ ______ ',
' / ____| /\ | \/ | ____|',
' | | __ / \ | \ / | |__ ',
' | | |_ | / /\ \ | |\/| | __|',
' | |__| |/ ____ \| | | | |____',
' \_____/_/ \_\_| |_|______|',
' ______ ________ _____',
' / __ \ \ / / ____| __ \',
' | | | \ \ / /| |__ | |__) |',
' | | | |\ \/ / | __| | _ /',
' | |__| | \ / | |____| | \ \',
' \____/ \/ |______|_| \_\',
'',
' ____ ____',
' / o@@\ /@@o \',
' / /``\@\ __,-==-,__ /@/``\ \',
' / /` `||//\______/ \||` `\ \',
' | |` // __ __ \\ `| |',
' \ \` (/ /;g\ /g;\ \) `/ |',
' \_\__(( " .. " )____/_/',
' \ " __ " / ',
' @@@@@@(||)@@@@`@@`@@@@(||)@@@@@@@',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',
' ',
' _ _ ___',
' | | (_) |__ \',
' ___ ___ _ __ | |_ _ _ __ _ _ ___ ) |',
' / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \ / /',
' | (_| (_) | | | | |_| | | | | |_| | __/ |_|',
' \___\___/|_| |_|\__|_|_| |_|\__,_|\___| (_)',
' ___ ___ __ ___ ___',
'| _| |_ | \ \ | _| |_ |',
'| | _ _ | | ___ ___ \ \ | | _ __ | | ___',
'| | | | | | | |/ _ \/ __| \ \ | | | ''_ \ | |/ _ \',
'| | | |_| | | | __/\__ \ \ \ | | | | | | | | (_) |',
'| |_ \__, | _| |\___||___/ \ \ | |_ |_| |_| _| |\___/',
'|___|=====/ |=|___| \_\ |___|=========|___|',
' |___/'

41
src/ghost_m.pas Normal file
View File

@ -0,0 +1,41 @@
unit ghost_m;
interface
uses creature_m;
const
GhostMovespeed = 1;
GhostStartDX = GhostMovespeed;
GhostStartDY = GhostMovespeed;
GhostSymbol = 'g';
procedure InitRandomGhost(var g: creature);
implementation
uses arena_m, Math, math_m;
procedure InitGhost(var g: creature; x, y, sigdx, sigdy: integer);
begin
g.t := creatureGhost;
g.curX := x;
g.curY := y;
g.dX := GhostStartDX * sigdx;
g.dY := GhostStartDY * sigdy;
g.moveSpeed := GhostMovespeed;
g.alive := true
end;
procedure InitRandomGhost(var g: creature);
var
x, y, sigdx, sigdy: integer;
begin
sigdx := IfThen(RandomBool, 1, -1);
sigdy := IfThen(RandomBool, 1, -1);
x := RandomLR(2, ArenaW - 1);
y := RandomLR(2, ArenaH - 1);
InitGhost(g, x, y, sigdx, sigdy)
end;
end.

40
src/gohamster.pas Normal file
View File

@ -0,0 +1,40 @@
program go_hamster;
uses crt, graphics_m, game_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);
clrscr;
MainLoop(g)
end.

437
src/graphics_m.pas Normal file
View File

@ -0,0 +1,437 @@
unit graphics_m;
interface
uses arena_m, creature_m, trace_m, game_m, level_m, _autobanners_m,
ascii_arts_m;
const
BorderSize = 1;
InterfaceH = 6;
WidthCoefficient = 2;
CellSize = 2;
BorderSymbol = '|';
DigitSpaceWidth = 1;
ScreenH = (ArenaH + InterfaceH) * CellSize + BorderSize;
ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 82 }
procedure DrawAnnounce(lvl: integer);
procedure DrawBannerImage(x, y, h: integer; var a: BannerImage);
procedure DrawCreatureImage(x, y, h: integer; var a: CreatureImage);
procedure DrawExitState(b: boolean);
procedure DrawExit(var g: gameState);
procedure DrawGameOver;
procedure DrawGameComplete(score: integer);
procedure DrawKeyInfo;
procedure DrawLineX(x, y, len: integer; ch: char);
procedure DrawLineY(x, y, len: integer; ch: char);
procedure DrawNumber(x, y: integer; n: longint);
procedure DrawRectangle(x0, y0, h, w: integer; ch: char);
procedure DrawMenuState(s: menuState);
procedure DrawMenu(var g: gameState);
procedure EraseAnnounce(lvl: integer);
procedure EraseExit;
procedure EraseExitState(b: boolean);
procedure EraseGameOver;
procedure EraseKeyInfo;
procedure EraseLevel;
procedure EraseMenu;
procedure EraseMenuState(s: menuState);
procedure EraseRectangle(x, y, w, h: integer);
procedure FillRectangle(x, y, w, h: integer; ch: char);
implementation
uses crt, math_m;
const
AnnounceY = (ScreenH - LevelAnnounceBannerHeight) div 2;
BigLetterWidth = 8;
BorderN = 2;
DecimalDelimiter = 10;
GameNameY = 16;
NameHeightPadding = 8;
NewGameY = GameNameY + GameNameHeight + NameHeightPadding;
MenuHeightPadding = 2;
MenuInfoY = NewGameY + NewGameHeight + MenuHeightPadding;
ContinueY = MenuInfoY + MenuInfoHeight;
ExitGameY = (ScreenH - ExitBannerHeight) div 2 - MenuHeightPadding;
ExitYesY = ExitGameY + ExitHeight - 1 + MenuHeightPadding;
ExitHamsterY = ExitYesY;
GameNameX = ScreenW * WidthCoefficient div 3 + 4;
MenuPaddingX = 4;
MenuHamsterX = GameNameX - HamsterWidth - MenuPaddingX;
ExitYesX = MenuHamsterX;
ExitNoX = ScreenW * WidthCoefficient - ExitYesX - NoWidth;
GameOverX = (ScreenW * WidthCoefficient - GameOverBannerWidth) div 2;
GameOverY = (ScreenH - GameOverBannerHeight) div 2;
HamsterNoX = ExitNoX - HamsterWidth - MenuPaddingX;
HamsterYesX = ExitYesX - HamsterWidth - MenuPaddingX;
KeyInfoX = (ScreenW * WidthCoefficient - KeysInfoBannerWidth) div 2;
KeyInfoY = (ScreenH - KeysInfoBannerHeight) div 2;
LetterWidth = 5;
LevelNumberMargin = 3;
GameCompleteX = (ScreenW * WidthCoefficient - GameCompleteBannerWidth)
div 2;
GameCompleteY = (ScreenH - GameCompleteBannerHeight) div 2;
GameCompleteScoreX = GameCompleteX + GameCompleteScoreWidth + 3;
GameCompleteScoreY = GameCompleteY + 9;
MaxStringLen = 255;
var
firstMenuDraw: boolean = true;
function CountLeadSpaces(var s: string): integer;
var
i, res: integer;
begin
res := 0;
for i := 1 to Length(s) do
if s[i] <> ' ' then
break
else
res := res + 1;
CountLeadSpaces := res
end;
procedure PrintStringScreen(x, y, dy: integer; var s: string);
var
cutLen, leadSpaces: integer;
sCopy: string;
begin
if y + dy - 1 > ScreenH then
exit;
if x < 0 then
begin
cutLen := x * -1 + 1;
GotoXY(1, y + dy - 1);
sCopy := copy(s, cutLen, MaxStringLen);
write(sCopy)
end
else
begin
leadSpaces := CountLeadSpaces(s);
GotoXY(x + leadSpaces, y + dy - 1);
sCopy := copy(s, leadSpaces + 1, MaxStringLen);
write(sCopy)
end
end;
procedure PrintDigitS(x, y, dy: integer; var s: string);
begin
GotoXY(x, y + dy - 1);
write(s)
end;
procedure DrawCreatureImage(x, y, h: integer; var a: CreatureImage);
var
i: integer;
begin
for i := 1 to h do
PrintStringScreen(x, y, i, a[i])
end;
procedure DrawBannerImage(x, y, h: integer; var a: BannerImage);
var
i: integer;
begin
for i := 1 to h do
PrintStringScreen(x, y, i, a[i])
end;
procedure DrawDigitImage(x, y, h: integer; var a: DigitImage);
var
i: integer;
begin
for i := 1 to h do
PrintDigitS(x, y, i, a[i])
end;
procedure DrawDigit(x, y, digit: integer);
begin
DrawDigitImage(x, y, DigitHeight, DigitsAscii[digit])
end;
procedure DrawExitState(b: boolean);
begin
if b then
DrawCreatureImage(HamsterYesX, ExitHamsterY,
HamsterHeight, HamsterGGAscii)
else
DrawCreatureImage(HamsterNoX, ExitHamsterY,
HamsterHeight, HamsterStayAscii)
end;
procedure DrawExit(var g: gameState);
var
realX: integer = ScreenW * WidthCoefficient;
begin
DrawBannerImage((realX - ExitBannerWidth) div 2, ExitGameY,
ExitBannerHeight, ExitBanner);
DrawExitState(g.curExit);
GotoXY(1, 1)
end;
procedure DrawGameOver;
begin
DrawBannerImage(GameOverX, GameOverY,
GameOverBannerHeight, GameOverBanner);
GotoXY(1, 1)
end;
procedure DrawKeyInfo;
begin
DrawBannerImage(KeyInfoX, KeyInfoY, KeysInfoBannerHeight, KeysInfoBanner);
GotoXY(1, 1)
end;
procedure DrawLineX(x, y, len: integer; ch: char);
var
i: integer;
begin
GotoXY(x, y);
for i := 1 to len do
write(ch)
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
end;
procedure DrawMenuState(s: menuState);
begin
case s of
menuNewGame:
DrawCreatureImage(MenuHamsterX, NewGameY + 1,
HamsterHeight, HamsterStayAscii);
menuKeyInfo:
DrawCreatureImage(MenuHamsterX, MenuInfoY + 1,
HamsterHeight, HamsterStayAscii);
menuContinue:
DrawCreatureImage(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)
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;
DrawBannerImage(GameNameX, y, MenuBannerHeight, MenuBanner);
if not g.levelInited then
DrawLineX(GameNameX, ContinueY + ContinueHeight div 2,
ContinueWidth, '-');
DrawMenuState(g.curMenu)
end;
procedure FillRectangle(x, y, w, h: integer; ch: char);
var
i: integer;
s: string;
begin
s := StringOfChar(ch, w);
for i := 0 to h - 1 do
begin
GotoXY(x, y + i);
write(s)
end
end;
procedure EraseRectangle(x, y, w, h: integer);
begin
FillRectangle(x, y, w, h, ' ')
end;
procedure EraseExit;
begin
EraseRectangle(HamsterYesX, ExitGameY,
ExitBannerWidth + HamsterWidth + MenuPaddingX,
ExitBannerHeight + MenuHeightPadding + YesHeight)
end;
procedure EraseExitState(b: boolean);
var
x: integer;
begin
if b then
x := HamsterYesX
else
x := HamsterNoX;
EraseRectangle(x, ExitHamsterY, HamsterWidth, HamsterHeight)
end;
procedure EraseGameOver;
begin
EraseRectangle(GameOverX, GameOverY,
GameOverBannerWidth, GameOverBannerHeight)
end;
procedure EraseKeyInfo;
begin
EraseRectangle(KeyInfoX, KeyInfoY,
KeysInfoBannerWidth, KeysInfoBannerHeight)
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,
MenuBannerWidth + HamsterWidth + MenuPaddingX,
ScreenH - GameNameY * 2)
end;
procedure EraseMenuState(s: menuState);
begin
case s of
menuNewGame:
EraseRectangle(MenuHamsterX, NewGameY + 1,
HamsterWidth, HamsterHeight);
menuKeyInfo:
EraseRectangle(MenuHamsterX, MenuInfoY + 1,
HamsterWidth, HamsterHeight);
menuContinue:
EraseRectangle(MenuHamsterX, ContinueY + 1,
HamsterWidth, HamsterHeight)
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 DrawNumber(x, y: integer; n: longint);
var
i: integer = 0;
st: StackInt;
begin
StackIntInit(st);
if n = 0 then
StackPush(st, 0);
while n <> 0 do
begin
StackPush(st, n mod DecimalDelimiter);
n := n div DecimalDelimiter
end;
while st.top <> nil do
begin
DrawDigit(x + (DigitWidth + DigitSpaceWidth) * i, y, st.top^.val);
StackPop(st);
i := i + 1
end
end;
function CountDigits(l: integer): integer;
var
lvl: integer;
res: integer = 0;
begin
lvl := l;
while lvl <> 0 do
begin
res := res + 1;
lvl := lvl div DecimalDelimiter
end;
CountDigits := res
end;
procedure DrawAnnounce(lvl: integer);
var
w, x: integer;
digitCnt: integer = 0;
begin
digitCnt := CountDigits(lvl);
w := LevelAnnounceBannerWidth + LevelNumberMargin +
DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1);
x := (ScreenW * WidthCoefficient - w) div 2;
DrawBannerImage(x, AnnounceY,
LevelAnnounceBannerHeight, LevelAnnounceBanner);
DrawNumber(x + LevelAnnounceBannerWidth + LevelNumberMargin,
AnnounceY + 1, lvl)
end;
procedure EraseAnnounce(lvl: integer);
var
w, x, digitCnt: integer;
begin
digitCnt := CountDigits(lvl);
w := LevelAnnounceBannerWidth + LevelNumberMargin +
DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1);
x := (ScreenW * WidthCoefficient - w) div 2;
EraseRectangle(x, AnnounceY, w, LevelAnnounceBannerHeight)
end;
procedure DrawGameComplete(score: integer);
begin
DrawBannerImage(GameCompleteX, GameCompleteY,
GameCompleteBannerHeight, GameCompleteBanner);
DrawNumber(GameCompleteScoreX, GameCompleteScoreY, score)
end;
end.

49
src/hamster_m.pas Normal file
View File

@ -0,0 +1,49 @@
unit hamster_m;
interface
uses arena_m, creature_m, trace_m;
const
HamsterStartX = 5;
HamsterStartY = 1;
HamsterStartDX = 0;
HamsterStartDY = 0;
HamsterMovespeed = 2;
HamsterSymbol = 'h';
procedure InitHamster(var cr: creature);
procedure KillHamster(var h: creature; var t: tracePtr; var a: arena);
implementation
uses arena_graphics_m, graphics_m;
procedure InitHamster(var cr: creature);
begin
cr.t := creatureHamster;
cr.curX := HamsterStartX;
cr.curY := HamsterStartY;
cr.dX := HamsterStartDX;
cr.dY := HamsterStartDY;
cr.moveSpeed := HamsterMovespeed;
cr.alive := true;
end;
procedure KillHamster(var h: creature; var t: tracePtr; var a: arena);
var
traceStart: tracePtr;
begin
RedrawArea(a, h.curX, h.curY, h.t);
EraseTrace(t, a);
DrawArenaCell(h.curX, h.curY, a);
GetStart(traceStart, t);
h.curX := traceStart^.x;
h.curY := traceStart^.y;
h.dX := HamsterStartDX;
h.dY := HamsterStartDY;
DeleteTrace(t);
DrawCreature(h)
end;
end.

43
src/keys.txt Normal file
View File

@ -0,0 +1,43 @@
== BANNER START ==
' _',
' | |',
' _ __ ___ _____ _____ | | _____ _ _ ___ _',
' | ''_ ` _ \ / _ \ \ / / _ \ | |/ / _ \ | | / __| (_)',
' | | | | | | (_) \ V / __/ | < __/ |_| \__ \ _',
' |_| |_| |_|\___/ \_/ \___| |_|\_\___|\__, |___/ (_)',
' __/ |',
' _ |___/',
' / \',
' / . \',
' / / \ \',
' /_/| |\_\',
' | |',
' |_|',
' __ ========= __',
' / / (\_/) \ \',
' / /_____ ( 0_0 ) ______\ \ ',
' { ______| /-----\ |_______ }',
' \ \ |___| / /',
' \_\ / \ /_/',
' ========== _ ===========',
' | |',
' _ | | _ ',
' \ \| |/ /',
' \ \ / / ',
' \ ` / ',
' \_/',
' =========',
' _ _ _',
' | | | | | |',
' ___ _ __ __ _ ___ ___ ___| |_ ___ _ __ | |__ __ _ _ __ ___ ___| |_ ___ _ __',
' / __| ''_ \ / _` |/ __/ _ \ ______ / __| __/ _ \| ''_ \ | ''_ \ / _` | ''_ ` _ \/ __| __/ _ \ ''__|',
' \__ \ |_) | (_| | (_| __/ |______| \__ \ || (_) | |_) | | | | | (_| | | | | | \__ \ || __/ |',
' |___/ .__/ \__,_|\___\___| |___/\__\___/| .__/ |_| |_|\__,_|_| |_| |_|___/\__\___|_|',
' ====| |=================== | |',
' |_| |_|',
' ___ ___ ___ _ __ __ _ _ _ ___ ___',
' / _ \/ __|/ __| ______ | ''_ \ / _` | | | / __|/ _ \',
'| __/\__ \ (__ |______| | |_) | (_| | |_| \__ \ __/',
' \___||___/\___| | .__/ \__,_|\__,_|___/\___|',
'================ | |',
' |_|'

284
src/keys_m.pas Normal file
View File

@ -0,0 +1,284 @@
unit keys_m;
interface
uses game_m, level_m;
const
ArrowDownOrd = -80;
ArrowLeftOrd = -75;
ArrowRightOrd = -77;
ArrowUpOrd = -72;
CtrlCOrd = 3;
CtrlZOrd = 26;
EscOrd = 27;
EnterOrd = 13;
LowerNOrd = 110;
LowerYOrd = 121;
SpaceOrd = 32;
UpperNOrd = 78;
UpperYOrd = 89;
OneOrd = 49;
TwoOrd = 50;
ThreeOrd = 51;
UpperQOrd = 81;
LowerQOrd = 113;
{ Debug }
BOrd = 98;
COrd = 99;
LOrd = 108;
{ Debug }
procedure HandleKey(var g: gameState; var level: levelState);
implementation
uses crt, graphics_m, trace_m, creature_m, debug_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(var h: creature; k: integer);
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 g: gameState; var level: levelState; k: integer);
begin
{DEBUG}
if k = BOrd then
Print(level.a.borders);
if k = COrd then
Print(level.a.captured);
if k = LOrd then
begin
GotoXY(2, 60);
write(' ');
GotoXY(2, 60);
writeln(GetLength(level.t))
end;
{DEBUG}
if (k = ArrowLeftOrd) or (k = ArrowRightOrd) or (k = ArrowUpOrd) or
(k = ArrowDownOrd) or (k = SpaceOrd) then
begin
ChangeHamsterDelta(level.h, k)
end;
if k = EscOrd then
g.curState := gamePause
end;
procedure PreviousMenuState(var g: gameState);
begin
if (g.curMenu = menuNewGame) and not g.levelInited 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.levelInited or
(g.curMenu = menuContinue) then
begin
g.curMenu := menuNewGame
end
else
begin
g.curMenu := succ(g.curMenu)
end
end;
procedure ChangeMenuState(var g: gameState; k: integer);
begin
case k of
ArrowUpOrd:
PreviousMenuState(g);
ArrowDownOrd:
NextMenuState(g)
end
end;
procedure ChooseMenuNum(var g: gameState; k: integer);
begin
if (k = ThreeOrd) and not g.levelInited then
exit;
case k of
OneOrd: begin
g.newGame := true;
g.level := 1;
g.curState := gameLevelAnnounce
end;
TwoOrd:
g.curState := gameKeyInfo;
ThreeOrd:
g.curState := gameContinueLevel
end
end;
procedure ChooseMenuMarked(var g: gameState);
begin
case g.curMenu of
menuNewGame:
begin
g.newGame := true;
g.level := 1;
g.curState := gameLevelAnnounce
end;
menuKeyInfo:
g.curState := gameKeyInfo;
menuContinue:
g.curState := gameContinueLevel
end
end;
procedure HandleMenuKey(var g: gameState; k: integer);
begin
if (k = ArrowUpOrd) or (k = ArrowDownOrd) then
begin
EraseMenuState(g.curMenu);
ChangeMenuState(g, k);
DrawMenuState(g.curMenu)
end;
if (k = OneOrd) or (k = TwoOrd) or (k = ThreeOrd) then
ChooseMenuNum(g, k);
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; k: integer);
begin
case k of
UpperYOrd, LowerYOrd:
g.curState := gameLevelAnnounce;
UpperNOrd, LowerNOrd:
g.curState := gameMenu;
end
end;
procedure ChangeExitState(k: integer; var g: gameState);
begin
case k of
ArrowRightOrd, ArrowLeftOrd:
ChangeOtherExitState(g)
end
end;
procedure HandleExitKey(var g: gameState; k: integer);
begin
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 then
g.shutdown := true
else
g.curExit := true;
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 := true;
g.curState := gameMenu
end;
procedure HandlePauseKey(var g: gameState; k: integer);
begin
if (k = EscOrd) or (k = SpaceOrd) then
g.curState := gameUnpauseLevel;
if (k = UpperQOrd) or (k = LowerQOrd) then
g.curState := gameMenu
end;
procedure HandleInfoKey(var g: gameState; k: integer);
begin
if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) or
(k = UpperQOrd) or (k = LowerQOrd) then
begin
g.curState := gameMenu
end
end;
procedure HandleSceneKey(var g: gameState; k: integer);
begin
if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) then
g.skipScene := true
end;
procedure HandleGameCompleteKey(var g: gameState; k: integer);
begin
if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) then
g.curState := gameMenu
end;
procedure HandleKey(var g: gameState; var level: levelState);
var
k: integer;
begin
GetKey(k);
if (k = CtrlCOrd) or (k = CtrlZOrd) then
begin
g.shutdown := true;
exit
end;
case g.curState of
gameLevelComplete, gameLevelAnnounce:
HandleSceneKey(g, k);
gameLevelLoop:
HandleLevelKey(g, level, k);
gameExit:
HandleExitKey(g, k);
gameMenu:
HandleMenuKey(g, k);
gameKeyInfo:
HandleInfoKey(g, k);
gamePause:
HandlePauseKey(g, k);
gameOver:
HandleGameOverKey(g, k);
gameComplete:
HandleGameCompleteKey(g, k)
end;
GotoXY(1, 1)
end;
end.

7
src/level.txt Normal file
View File

@ -0,0 +1,7 @@
== BANNER START ==
' _ _ ',
'| | | |',
'| | _____ _____| |',
'| | / _ \ \ / / _ \ |',
'| |___| __/\ V / __/ |',
'|______\___| \_/ \___|_|'

74
src/level_m.pas Normal file
View File

@ -0,0 +1,74 @@
unit level_m;
interface
uses arena_m, trace_m, creature_m, enemy_packs_m;
const
LevelCompleteThreshold = 85;
type
levelState = record
a: arena;
t: tracePtr;
levelStarted, hamsterAlive, unpause: boolean;
h: creature;
cut, bonusShow, speedUp, speedDown: integer;
enemyList: creatureList;
end;
function IsLevelComplete(var level: levelState): boolean;
procedure InitLevel(var level: levelState; t: enemyPackType);
procedure SpeedDownEnemies(var level: levelState);
procedure SpeedUpHamster(var level: levelState);
implementation
uses hamster_m, ghost_m, debug_m;
const
BonusShowTick = 10;
BonusDurationTick = 40;
TotalProcent = 100;
function IsLevelComplete(var level: levelState): boolean;
var
completeProcent: integer;
begin
completeProcent := round(level.cut / (TotalCells / TotalProcent));
IsLevelComplete := completeProcent >= LevelCompleteThreshold
end;
procedure InitLevel(var level: levelState; t: enemyPackType);
begin
InitArena(level.a);
InitHamster(level.h);
InitCreatureList(level.enemyList);
AppendEnemies(level.enemyList, t);
{PrintEnemies(level.enemyList);}
level.levelStarted := true;
level.hamsterAlive := true;
level.t := nil;
level.cut := 0;
level.speedUp := 0;
level.unpause := false
end;
procedure SpeedUpHamster(var level: levelState);
begin
level.speedUp := BonusDurationTick;
level.h.movespeed := HamsterMovespeed * 2;
level.h.dX := level.h.dX * 2;
level.h.dY := level.h.dY * 2
end;
procedure SpeedDownEnemies(var level: levelState);
begin
level.speedDown := BonusDurationTick;
{
SpeedDownCreatures(level.enemyList);
}
end;
end.

7
src/lifeup.txt Normal file
View File

@ -0,0 +1,7 @@
== BANNER START ==
' _ _____ ______ ______ _ _ _____',
'| | |_ _| ____| ____| | | | | __ \',
'| | | | | |__ | |__ | | | | |__) |',
'| | | | | __| | __| | | | | ___/',
'| |____ _| |_| | | |____ | |__| | |',
'|______|_____|_| |______| \____/|_|'

36
src/math_m.pas Normal file
View File

@ -0,0 +1,36 @@
unit math_m;
interface
function Clamp(val, min, max: integer): integer;
function RandomBool: boolean;
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 RandomBool: boolean;
begin
RandomBool := Random(2) = 1
end;
end.

44
src/menu.txt Normal file
View File

@ -0,0 +1,44 @@
GameNameHeight 6
NewGameHeight 6
MenuInfoHeight 8
HighScoreHeight 8
ContinueHeight 6
ContinueWidth 41
== BANNER START ==
' _____ _ _ _ _',
' / ____| | | | | | | | |',
'| | __ ___ | | | |__| | __ _ _ __ ___ ___| |_ ___ _ __',
'| | |_ |/ _ \| | | __ |/ _` | ''_ ` _ \/ __| __/ _ \ ''__|',
'| |__| | (_) |_| | | | | (_| | | | | | \__ \ || __/ |',
' \_____|\___/(_) |_| |_|\__,_|_| |_| |_|___/\__\___|_|',
'',
'',
'',
'',
'',
'',
'',
'',
' _ _ _____',
'| \ | | / ____|',
'| \| | _____ __ | | __ __ _ _ __ ___ ___',
'| . ` |/ _ \ \ /\ / / | | |_ |/ _` | ''_ ` _ \ / _ \',
'| |\ | __/\ V V / | |__| | (_| | | | | | | __/',
'|_| \_|\___| \_/\_/ \_____|\__,_|_| |_| |_|\___|',
'',
'',
' _ __ _____ __',
'| |/ / |_ _| / _|',
'| '' / ___ _ _ | | _ __ | |_ ___',
'| < / _ \ | | | | | | ''_ \| _/ _ \',
'| . \ __/ |_| | _| |_| | | | || (_) |',
'|_|\_\___|\__, | |_____|_| |_|_| \___/',
' __/ |',
' |___/',
' _____ _ _ ',
' / ____| | | (_) ',
'| | ___ _ __ | |_ _ _ __ _ _ ___ ',
'| | / _ \| ''_ \| __| | ''_ \| | | |/ _ \',
'| |___| (_) | | | | |_| | | | | |_| | __/',
' \_____\___/|_| |_|\__|_|_| |_|\__,_|\___|'

23
src/paused.txt Normal file
View File

@ -0,0 +1,23 @@
== BANNER START ==
' _',
' | |',
' _ __ __ _ _ _ ___ ___ __| |',
' | ''_ \ / _` | | | / __|/ _ \/ _` |',
' | |_) | (_| | |_| \__ \ __/ (_| |',
' | .__/ \__,_|\__,_|___/\___|\__,_| ',
' | | ',
' |_| _ _',
' | | (_)',
' ___ _ __ __ _ __ ___ ___ ___ _ __ | |_ _ _ __ _ _ ___',
'/ __| ''_ \ / _` |/ __/ _ \ ______ / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \',
'\__ \ |_) | (_| | (_| __/ |______| | (_| (_) | | | | |_| | | | | |_| | __/',
'|___/ .__/ \__,_|\___\___| \___\___/|_| |_|\__|_|_| |_|\__,_|\___|',
'====| |===================',
' |_| _ _ _',
' (_) | | |',
' __ _ __ _ _ _ _| |_ | |_ ___ _ __ ___ ___ _ __ _ _',
' / _` | ______ / _` | | | | | __| | __/ _ \ | ''_ ` _ \ / _ \ ''_ \| | | |',
'| (_| | |______| | (_| | |_| | | |_ | || (_) | | | | | | | __/ | | | |_| |',
' \__, | \__, |\__,_|_|\__| \__\___/ |_| |_| |_|\___|_| |_|\__,_|',
'====| |= | |',
' |_| |_|'

56
src/snake_m.pas Normal file
View File

@ -0,0 +1,56 @@
unit snake_m;
interface
uses creature_m;
procedure UpdateSnakeState(var s: creature);
procedure InitRandomSnake(var s: creature);
const
SnakeMovespeed = 2;
implementation
uses arena_m, Math, math_m;
const
MinToReverse = 2;
MaxToReverse = 75;
procedure InitSnake(var s: creature; x, y, sigdx, sigdy: integer);
begin
s.t := creatureSnake;
s.curX := x;
s.curY := y;
s.dX := SnakeMovespeed * sigdx;
s.dY := SnakeMovespeed * sigdy;
s.alive := true;
s.moveSpeed := SnakeMovespeed;
s.beforeReverse := RandomLR(MinToReverse, MaxToReverse);
s.diagonalMove := false
end;
procedure InitRandomSnake(var s: creature);
var
x, y, sigdx, sigdy: integer;
begin
sigdx := IfThen(RandomBool, 1, -1);
sigdy := IfThen(RandomBool, 1, -1);
x := RandomLR(2, ArenaW - 1);
y := RandomLR(2, ArenaH - 1);
InitSnake(s, x, y, sigdx, sigdy)
end;
procedure UpdateSnakeState(var s: creature);
begin
s.beforeReverse := s.beforeReverse - 1;
if s.beforeReverse = 0 then
begin
s.beforeReverse := RandomLR(MinToReverse, MaxToReverse);
s.dX := s.dX * -1;
s.dY := s.dY * -1
end
end;
end.

7
src/speeddown.txt Normal file
View File

@ -0,0 +1,7 @@
== BANNER START ==
' _____ _____ ______ ______ _____ _____ ______ ___ _',
' / ____| __ \| ____| ____| __ \ | __ \ / __ \ \ / / \ | |',
'| (___ | |__) | |__ | |__ | | | | | | | | | | \ \ /\ / /| \| |',
' \___ \| ___/| __| | __| | | | | | | | | | | |\ \/ \/ / | . ` |',
' ____) | | | |____| |____| |__| | | |__| | |__| | \ /\ / | |\ |',
'|_____/|_| |______|______|_____/ |_____/ \____/ \/ \/ |_| \_|'

7
src/speedup.txt Normal file
View File

@ -0,0 +1,7 @@
== BANNER START ==
' _____ _____ ______ ______ _____ _ _ _____',
' / ____| __ \| ____| ____| __ \ | | | | __ \',
'| (___ | |__) | |__ | |__ | | | | | | | | |__) |',
' \___ \| ___/| __| | __| | | | | | | | | ___/',
' ____) | | | |____| |____| |__| | | |__| | |',
'|_____/|_| |______|______|_____/ \____/|_|'

94
src/sun_m.pas Normal file
View File

@ -0,0 +1,94 @@
unit sun_m;
interface
uses creature_m;
procedure InitRandomSun(var s: creature);
procedure UpdateSunState(var s: creature);
implementation
uses arena_m, Math, math_m;
const
SunSlowMovespeed = 1;
SunFastMovespeed = 2;
SunGoidaMovespeed = 3;
SunStartDX = SunSlowMovespeed;
SunStartDY = SunSlowMovespeed;
SunSymbol = 's';
MinToGoidaSwitch = 25;
MaxToGoidaSwitch = 35;
MinToNormSwitch = 5;
MaxToNormSwitch = 30;
procedure InitSun(var s: creature; x, y, sigdx, sigdy: integer);
begin
s.t := creatureSun;
s.curX := x;
s.curY := y;
s.dX := SunStartDX * sigdx;
s.dY := SunStartDY * sigdy;
s.alive := true;
s.moveSpeed := SunFastMovespeed;
s.bigStep:= true;
s.rageMode := false;
s.beforeTransform := RandomLR(MinToGoidaSwitch, MaxToGoidaSwitch)
end;
procedure InitRandomSun(var s: creature);
var
x, y, sigdx, sigdy: integer;
begin
sigdx := IfThen(RandomBool, 1, -1);
sigdy := IfThen(RandomBool, 1, -1);
x := RandomLR(2, ArenaW - 1);
y := RandomLR(2, ArenaH - 1);
InitSun(s, x, y, sigdx, sigdy)
end;
procedure SwitchGoidaMode(var cr: creature);
begin
cr.rageMode := not cr.rageMode;
if cr.rageMode then
cr.beforeTransform := RandomLR(MinToNormSwitch, MaxToNormSwitch)
else
cr.beforeTransform := RandomLR(MinToGoidaSwitch, MaxToGoidaSwitch);
if cr.rageMode then
begin
cr.dX := Signum(cr.dX, 0) * SunGoidaMovespeed;
cr.dY := Signum(cr.dY, 0) * SunGoidaMovespeed
end
else
begin
cr.dX := Signum(cr.dX, 0) * SunSlowMovespeed;
cr.dY := Signum(cr.dY, 0) * SunSlowMovespeed;
cr.bigStep := false
end;
end;
procedure UpdateSunState(var s: creature);
begin
if s.beforeTransform = 0 then
begin
SwitchGoidaMode(s);
exit
end;
s.beforeTransform := s.beforeTransform - 1;
if s.rageMode then
exit;
s.bigStep := not s.bigStep;
if s.bigStep then
begin
s.dX := Signum(s.dX, 0) * SunFastMovespeed;
s.dY := Signum(s.dY, 0) * SunFastMovespeed
end
else
begin
s.dX := Signum(s.dX, 0) * SunSlowMovespeed;
s.dY := Signum(s.dY, 0) * SunSlowMovespeed
end
end;
end.

188
src/trace_m.pas Normal file
View File

@ -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 TraceCrossed(pX, pY: integer; var cr: creature; t: tracePtr): boolean;
procedure ChangeHamsterTrace(var h: creature; var t: tracePtr);
procedure DeleteTrace(var t: tracePtr);
procedure GetStart(var traceStart: tracePtr; a: 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; a: tracePtr);
var
t: tracePtr;
begin
if a = nil then
exit;
t := a;
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(pX, pY: integer; var cr: creature; t: tracePtr): boolean;
var
dX, dY, prevX, prevY: integer;
begin
prevX := pX;
prevY := pY;
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 := IsOnTrace(prevX, prevY, t)
end;
end.