gre-ilya/gh
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

init

Browse Source
This commit is contained in:
gre-ilya 2026-01-10 12:09:22 +05:00
commit 9c392a4782
31 changed files with 4072 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
Makefile Normal file
View File

@ -0,0 +1,28 @@
FPC = fpc
CONVBANNERS_SRC = convbanners.pas
BANNERS_SRC = completed.txt exit.txt keys.txt paused.txt menu.txt \
level.txt gameover.txt
GAME_SRC = _banners_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 sun_fields_m.pas \
trace_m.pas snake_m.pas snake_fields_m.pas drop_m.pas drop_fields_m.pas
all: gohamster
play: gohamster
./gohamster
gohamster: $(GAME_SRC)
$(FPC) $@.pas
_banners_m.pas: convbanners $(BANNERS_SRC)
./convbanners
convbanners: $(CONVBANNERS_SRC)
$(FPC) $@.pas
clean:
rm *.o *.ppu convbanners _banners_m.pas gohamster

607
arena_graphics_m.pas Normal file
View File

@ -0,0 +1,607 @@
unit arena_graphics_m;
interface
uses arena_m, creature_m, trace_m, level_m, _banners_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);
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 - PauseWidth) div 2;
PauseYPadding = 1;
PauseY = (ScreenH - PauseHeight) 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: 0; lY: 0; rX: 0; rY: 0
),
(
lX: 0; lY: 0; rX: 0; rY: 0
),
(
lX: 0; lY: 0; rX: 0; rY: 0
)
);
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 RedrawInterfaceArea(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 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
if (t = creatureHamster) and (arenaY + i = 1) then
RedrawInterfaceArea(arenaX + j);
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;
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,
PauseWidth + PauseXPadding * 2,
PauseHeight + PauseYPadding * 2 + 1);
DrawRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseHeight + PauseYPadding * 2 + 1,
PauseWidth + PauseXPadding * 2,
BorderSymbol);
DrawBannerImage(PauseX, PauseY, PauseHeight, PauseAscii)
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,
PauseWidth + PauseXPadding * 2,
PauseHeight + 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;
GotoXY(1, 1)
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)
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: integer;
begin
asciiIdx := g.curX div g.moveSpeed mod SunRunN + 1;
DrawFieldAscii(g.curX - SunWidth div WidthCoefficient div 2,
g.curY - SunHeight div 2 + 1,
SunHeight, SunWidth, SunAscii[asciiIdx])
end;
{
procedure DrawEnemy(var e: creature);
var
asciiIdx: integer;
begin
asciiIdx := e.curX div e.moveSpeed mod;
end;
}
procedure DrawCreature(var cr: creature);
begin
case cr.t of
creatureHamster:
DrawHamster(cr);
creatureGhost:
DrawGhost(cr);
creatureSun:
DrawSun(cr)
end
end;
end.

578
arena_m.pas Normal file
View File

@ -0,0 +1,578 @@
unit arena_m;
interface
uses creature_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 cr: creature);
implementation
uses arena_graphics_m, cell_m, crt, graphics_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 GhostShouldTurn(var g: creature; var a: arena): boolean;
var
nextX, nextY: integer;
begin
nextX := g.curX + g.dX;
nextY := g.curY + g.dY;
GhostShouldTurn := StepBeyondEdge(g) or
a.borders[g.curY][g.curX] and a.captured[nextY][nextX]
end;
function SunShouldTurn(var g: creature; var a: arena): boolean;
begin
SunShouldTurn := true
end;
function VerticalBorder(nextX, nextY: integer; var a: arena): boolean;
begin
VerticalBorder :=
a.borders[nextY][nextX] and
(a.borders[nextY - 1][nextX] or a.borders[nextY + 1][nextX])
end;
function HorizontalBorder(nextX, nextY: integer; var a: arena): 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(x, y, a) and VerticalBorder(x, y, a)
end;
procedure TurnGhost(var g: creature; var a: arena);
begin
if (OnEdgeX(g.curX) or VerticalBorder(g.curX, g.curY, a)) then
g.dX := g.dX * -1;
if (OnEdgeY(g.curY) or HorizontalBorder(g.curX, g.curY, a)) then
g.dY := g.dY * -1
end;
procedure TurnSun(var g: creature; var a: arena);
begin
end;
procedure MakeEnemyStep(var a: arena; var e, h: creature; t: tracePtr);
var
prevX, prevY: integer;
begin
prevX := e.curX;
prevY := e.curY;
MakeStep(a, e);
if TraceCrossed(prevX, prevY, e, t) then
h.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 TurnEnemy(var cr: creature; var a: arena);
begin
case cr.t of
creatureGhost:
TurnGhost(cr, a);
creatureSun:
TurnGhost(cr, a)
end
end;
function EnemyShouldTurn(var cr: creature; var a: arena): boolean;
begin
case cr.t of
creatureGhost:
EnemyShouldTurn := GhostShouldTurn(cr, a);
creatureSun:
EnemyShouldTurn := GhostShouldTurn(cr, a)
end
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^.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 cr: creature);
var
absDx, absDy, maxD, stepX, stepY, i, nX, nY: integer;
begin
absDx := Abs(cr.dX);
absDy := Abs(cr.dY);
maxD := Max(absDx, absDy);
stepX := Signum(cr.dX, 0);
stepY := Signum(cr.dY, 0);
for i := 1 to maxD do
begin
nX := cr.curX + stepX;
nY := cr.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
cr.curX := nX;
cr.curY := nY
end
end
end;
end.

280
ascii_arts_m.pas Normal file
View File

@ -0,0 +1,280 @@
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 = 5;
SunWidth = 7;
SunRunN = 2;
SunAscii: array[1..SunRunN] of CreatureImage = (
(
' _A_',
' / \',
'<|o o|>',
' \_^_/',
' V'
),
(
' _A_',
' / \',
'{|o o|}',
' \_^_/',
' v'
)
);
RageSunHeight = 4;
RageSunRunN = 1;
RageSunAscii: array[1..RageSunRunN] of CreatureImage = (
(
' ___',
' / Z \',
'||> <||',
' \___/',
''
)
);
implementation
end.

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

42
completed.txt Normal file
View File

@ -0,0 +1,42 @@
' _____ _ _ _ ',
' / ____| | | | | | |',
'| | __ __ _ _ __ ___ ___ ___ ___ _ __ ___ _ __ | | ___| |_ ___| |',
'| | |_ |/ _` | ''_ ` _ \ / _ \ / __/ _ \| ''_ ` _ \| ''_ \| |/ _ \ __/ _ \ |',
'| |__| | (_| | | | | | | __/ | (_| (_) | | | | | | |_) | | __/ || __/_|',
' \_____|\__,_|_| |_| |_|\___| \___\___/|_| |_| |_| .__/|_|\___|\__\___(_)',
' | |',
' |_|',
'__ __',
'\ \ / / _ ',
' \ \_/ /__ _ _ _ __ ___ ___ ___ _ __ ___(_)',
' \ / _ \| | | | ''__| / __|/ __/ _ \| ''__/ _ \',
' | | (_) | |_| | | \__ \ (_| (_) | | | __/_ ',
' |_|\___/ \__,_|_| |___/\___\___/|_| \___(_)',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
''

195
convbanners.pas Normal file
View File

@ -0,0 +1,195 @@
program convbanners;
const
BannerModuleName = '_banners_m.pas';
GameCompleteFile = 'completed.txt';
ExitFile = 'exit.txt';
KeysFile = 'keys.txt';
MenuFile = 'menu.txt';
GameOverFile = 'gameover.txt';
PausedFile = 'paused.txt';
LevelFile = 'level.txt';
AfterImageLinesN = 2;
ModuleBeginH = 13;
{
const
MaxBannerWidth = KeyInfoWidth;
MaxBannerHeight = KeyInfoHeight;
type
BannerImage = array[1..MaxBannerHeight] of string[MaxBannerWidth];
}
ModuleBegin: array[1..ModuleBeginH] of string = (
'{ ************************************************** }',
'{ ************************************************** }',
'{ *** *** }',
'{ *** *** }',
'{ *** AUTOMATICALLY GENERATED FILE. DO NOT EDIT. *** }',
'{ *** *** }',
'{ *** *** }',
'{ ************************************************** }',
'{ ************************************************** }',
'unit _banners_m;',
'',
'interface',
'const'
);
KeyInfoCodeH = 10;
BannersKeyInfo: array[1..KeyInfoCodeH] of string = (
'KeyInfoHeight = 42;',
'KeyInfoWidth = 98;',
'MaxBannerHeight = KeyInfoHeight;',
'MaxBannerWidth = KeyInfoWidth;',
'type',
'BannerImage = array[1..MaxBannerHeight] of string[MaxBannerWidth];',
'const',
'KeyInfoScreen: BannerImage = (',
');',
''
);
{
KeyInfoCodeH = 5;
BannersKeyInfo: array[1..KeyInfoCodeH] of string = (
'KeyInfoHeight = 42;',
'KeyInfoWidth = 98;',
'KeyInfoScreen: BannerImage = (',
');',
''
);
}
ExitCodeH = 6;
BannersExit: array[1..ExitCodeH] of string = (
'ExitScreenHeight = 16;',
'ExitWidth = 70;',
'ExitHeight = 8;',
'ExitScreen: BannerImage = (',
');',
''
);
PauseCodeH = 5;
BannersPause: array[1..PauseCodeH] of string = (
'PauseHeight = 22;',
'PauseWidth = 76;',
'PauseAscii: BannerImage = (',
');',
''
);
CompleteCodeH = 6;
BannersGameComplete: array[1..CompleteCodeH] of string = (
'GameCompleteHeight = 14;',
'GameCompleteWidth = 74;',
'GameCompleteScoreWidth = 50;',
'GameComplete: BannerImage = (',
');',
''
);
MenuCodeH = 11;
BannersMenu: array[1..MenuCodeH] of string = (
'GameMenuHeight = 36;',
'GameNameHeight = 6;',
'GameNameWidth = 58;',
'NewGameHeight = 6;',
'HighScoreHeight = 8;',
'MenuInfoHeight = 8;',
'ContinueHeight = 6;',
'ContinueWidth = 41;',
'GameMenuScreen: BannerImage = (',
');',
''
);
GameOverCodeH = 5;
BannersGameOver: array[1..GameOverCodeH] of string = (
'GameOverHeight = 40;',
'GameOverWidth = 63;',
'GameOverScreen: BannerImage = (',
');',
''
);
LevelCodeH = 5;
BannersLevel: array[1..LevelCodeH] of string = (
'LevelAnnounceHeight = 6;',
'LevelAnnounceWidth = 24;',
'LevelAnnounce: BannerImage = (',
');',
''
);
ModuleEndH = 3;
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;
procedure ConcatenateFiles(var fTo: text; var filename: string);
var
ln: string;
fFrom: text;
begin
assign(fFrom, fileName);
reset(fFrom);
while not eof(fFrom) do
begin
readln(fFrom, ln);
writeln(fTo, ln)
end
end;
procedure AppendAsciiBanner(var f: text; var t: array of string;
h: integer; fileName: string);
var
i: integer;
begin
for i := 1 to h do
begin
writeln(f, t[i - 1]);
if i = h - AfterImageLinesN then
ConcatenateFiles(f, fileName)
end
end;
procedure CreateBannerModule;
var
newModule: text;
begin
assign(newModule, BannerModuleName);
rewrite(newModule);
AppendText(newModule, ModuleBegin, ModuleBeginH);
AppendAsciiBanner(newModule, BannersKeyInfo, KeyInfoCodeH, KeysFile);
AppendAsciiBanner(newModule, BannersExit, ExitCodeH, ExitFile);
AppendAsciiBanner(newModule, BannersPause, PauseCodeH, PausedFile);
AppendAsciiBanner(newModule, BannersGameComplete, CompleteCodeH,
GameCompleteFile);
AppendAsciiBanner(newModule, BannersMenu, MenuCodeH, MenuFile);
AppendAsciiBanner(newModule, BannersGameOver, GameOverCodeH, GameOverFile);
AppendAsciiBanner(newModule, BannersLevel, LevelCodeH, LevelFile);
AppendText(newModule, ModuleEnd, ModuleEndH);
close(newModule)
end;
begin
CreateBannerModule
end.

133
creature_m.pas Normal file
View File

@ -0,0 +1,133 @@
unit creature_m;
interface
uses sun_fields_m, snake_fields_m, drop_fields_m;
type
creatureType = (creatureHamster, creatureGhost, creatureSun,
creatureSnake, creatureDrop);
creaturePtr = ^creature;
creature = record
curX, curY, dX, dY, moveSpeed, animation: integer;
alive: boolean;
t: creatureType;
sunf: sunStatePtr;
snakef: snakeStatePtr;
dropf: dropStatePtr;
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;
if tmp^.cr^.t = creatureSun then
dispose(tmp^.cr^.sunf)
else
if tmp^.cr^.t = creatureSnake then
dispose(tmp^.cr^.snakef)
else
if tmp^.cr^.t = creatureDrop then
dispose(tmp^.cr^.dropF);
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;
end.

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

16
drop_fields_m.pas Normal file
View File

@ -0,0 +1,16 @@
unit drop_fields_m;
interface
type
dropStatePtr = ^dropState;
dropState = record
crazyField1: boolean;
crazyField2: boolean;
crazyField3: boolean;
end;
implementation
end.

15
drop_m.pas Normal file
View File

@ -0,0 +1,15 @@
unit drop_m;
interface
uses creature_m;
procedure UpdateDropState(var cr: creature);
implementation
procedure UpdateDropState(var cr: creature);
begin
end;
end.

84
enemy_packs_m.pas Normal file
View File

@ -0,0 +1,84 @@
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;
const
{
LevelGhostN: array[enemyPackType] of integer = (
4, 4, 2, 4, 4, 2, 4, 2, 4, 4
);
}
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);
begin
end;
procedure AppendRandomDrops(var lst: creatureList; t: enemyPackType);
begin
end;
procedure AppendEnemies(var lst: creatureList; t: enemyPackType);
begin
AppendRandomGhosts(lst, t);
AppendRandomSuns(lst, t);
AppendRandomSnakes(lst, t);
AppendRandomDrops(lst, t)
end;
end.

42
exit.txt Normal file
View File

@ -0,0 +1,42 @@
' ______ _ _ _ _ ___',
'| ____| (_) | | | | | |__ \',
'| |__ __ ___| |_ | |_| |__ ___ __ _ __ _ _ __ ___ ___ ) |',
'| __| \ \/ / | __| | __| ''_ \ / _ \ / _` |/ _` | ''_ ` _ \ / _ \/ /',
'| |____ > <| | |_ | |_| | | | __/ | (_| | (_| | | | | | | __/_|',
'|______/_/\_\_|\__| \__|_| |_|\___| \__, |\__,_|_| |_| |_|\___(_)',
' __/ |',
' |___/',
'',
'',
' _ _ ___ ___ _ __ ___',
'| | | |/ _ \/ __| | ''_ \ / _ \',
'| |_| | __/\__ \ | | | | (_) |',
' \__, |\___||___/ |_| |_|\___/',
' __/ |',
' |___/',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
''

393
game_m.pas Normal file
View File

@ -0,0 +1,393 @@
{ MainLoop -- main loop }
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 NextExitState(var g: gameState);
procedure PreviousExitState(var g: gameState);
implementation
uses arena_m, arena_graphics_m, crt, creature_m, graphics_m, hamster_m,
keys_m, debug_m;
const
KeyDelayMs = 25;
MoveDelayMs = 120;
EraseLifeThreshold = 10;
AnnounceDelayMs = 1500;
LevelCompleteDelayMs = 1500;
LevelCount = 2;
StartLifeN = 3;
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, enemyPack1)
end
else
begin
g.levelInited := false;
DisposeCreatureList(level.enemyList)
end;
end;
procedure GameCutPart(var g: gameState; var level: levelState);
var
beforeCut: integer;
begin
beforeCut := level.cut;
SetArenaBorder(level.t, level.a);
ArenaCutPart(level.h, level.t, level.cut, level.a);
FillCompleteBar(level.cut);
g.score := g.score + (level.cut - beforeCut);
DrawScore(g.score)
end;
procedure GameNextLevel(var g: gameState; var level: levelState);
begin
g.level := g.level + 1;
DisposeCreatureList(level.enemyList);
if g.level > LevelCount then
begin
g.levelInited := false;
g.curState := gameComplete
end
else
begin
g.curState := gameLevelComplete
end
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 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 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, enemyPack1);
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);
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);
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;
EraseAll
end;
procedure NextExitState(var g: gameState);
begin
if not g.curExit then
g.curExit := true
else
g.curExit := false
end;
procedure PreviousExitState(var g: gameState);
begin
if g.curExit then
g.curExit := false
else
g.curExit := true
end;
end.

42
gameover.txt Normal file
View File

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

42
ghost_m.pas Normal file
View File

@ -0,0 +1,42 @@
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;
g.animation := 1;
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.

41
gohamster.pas Normal file
View File

@ -0,0 +1,41 @@
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;
clrscr;
InitGame(g);
EraseAll;
MainLoop(g)
end.

416
graphics_m.pas Normal file
View File

@ -0,0 +1,416 @@
unit graphics_m;
interface
uses arena_m, creature_m, trace_m, game_m, level_m, _banners_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 EraseAll;
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 - LevelAnnounceHeight) 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 - 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 - GameNameWidth) div 2;
GameOverY = (ScreenH - GameOverHeight) div 2;
HamsterNoX = ExitNoX - HamsterWidth - MenuWidthPadding;
HamsterYesX = ExitYesX - HamsterWidth - MenuWidthPadding;
KeyInfoX = (ScreenW * WidthCoefficient - KeyInfoWidth) div 2;
KeyInfoY = (ScreenH - KeyInfoHeight) div 2;
LetterWidth = 5;
LevelNumberMargin = 3;
GameCompleteX = (ScreenW * WidthCoefficient - GameCompleteWidth) div 2;
GameCompleteY = (ScreenH - GameCompleteHeight) div 2;
GameCompleteScoreX = GameCompleteX + GameCompleteScoreWidth + 3;
GameCompleteScoreY = GameCompleteY + 9;
EndOfLine = 256;
var
firstMenuDraw: boolean = true;
procedure PrintStringScreen(x, y, dy: integer; var s: string);
var
cutLen: 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, EndOfLine);
write(sCopy)
end
else
begin
GotoXY(x, y + dy - 1);
write(s)
end;
GotoXY(1, 1)
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
PrintStringScreen(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 - ExitWidth) div 2, ExitGameY,
ExitScreenHeight, ExitScreen);
DrawExitState(g.curExit)
end;
procedure DrawGameOver;
begin
DrawBannerImage(GameOverX, GameOverY, GameOverHeight, GameOverScreen)
end;
procedure DrawKeyInfo;
begin
DrawBannerImage(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:
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);
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;
DrawBannerImage(GameNameX, y, GameMenuHeight, GameMenuScreen);
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, j: integer;
begin
for i := 0 to h - 1 do
begin
GotoXY(x, y + i);
for j := 0 to w - 1 do
write(ch)
end;
GotoXY(1, 1)
end;
procedure EraseRectangle(x, y, w, h: integer);
begin
FillRectangle(x, y, w, h, ' ')
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(b: boolean);
begin
if b then
EraseRectangle(HamsterYesX, ExitHamsterY,
HamsterWidth, HamsterHeight)
else
EraseRectangle(HamsterNoX, ExitHamsterY,
HamsterWidth, HamsterHeight)
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);
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 := LevelAnnounceWidth + LevelNumberMargin +
DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1);
x := (ScreenW * WidthCoefficient - w) div 2;
DrawBannerImage(x, AnnounceY, LevelAnnounceHeight, LevelAnnounce);
DrawNumber(x + LevelAnnounceWidth + LevelNumberMargin, AnnounceY + 1, lvl)
end;
procedure EraseAnnounce(lvl: integer);
var
w, x, digitCnt: integer;
begin
digitCnt := CountDigits(lvl);
w := LevelAnnounceWidth + LevelNumberMargin +
DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1);
x := (ScreenW * WidthCoefficient - w) div 2;
EraseRectangle(x, AnnounceY, w, LevelAnnounceHeight)
end;
procedure DrawGameComplete(score: integer);
begin
DrawBannerImage(GameCompleteX, GameCompleteY,
GameCompleteHeight, GameComplete);
DrawNumber(GameCompleteScoreX, GameCompleteScoreY, score)
end;
end.

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

42
keys.txt Normal file
View File

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

286
keys_m.pas Normal file
View File

@ -0,0 +1,286 @@
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));
GotoXY(1, 1)
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:
NextExitState(g);
ArrowLeftOrd:
PreviousExitState(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
end;
end.

42
level.txt Normal file
View File

@ -0,0 +1,42 @@
' _ _ ',
'| | | |',
'| | _____ _____| |',
'| | / _ \ \ / / _ \ |',
'| |___| __/\ V / __/ |',
'|______\___| \_/ \___|_|',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
''

52
level_m.pas Normal file
View File

@ -0,0 +1,52 @@
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: integer;
enemyList: creatureList;
end;
function IsLevelComplete(var level: levelState): boolean;
procedure InitLevel(var level: levelState; t: enemyPackType);
implementation
uses hamster_m, ghost_m, debug_m;
const
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.unpause := false
end;
end.

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

42
menu.txt Normal file
View File

@ -0,0 +1,42 @@
' _____ _ _ _ _',
' / ____| | | | | | | | |',
'| | __ ___ | | | |__| | __ _ _ __ ___ ___| |_ ___ _ __',
'| | |_ |/ _ \| | | __ |/ _` | ''_ ` _ \/ __| __/ _ \ ''__|',
'| |__| | (_) |_| | | | | (_| | | | | | \__ \ || __/ |',
' \_____|\___/(_) |_| |_|\__,_|_| |_| |_|___/\__\___|_|',
'',
'',
'',
'',
'',
'',
'',
'',
' _ _ _____',
'| \ | | / ____|',
'| \| | _____ __ | | __ __ _ _ __ ___ ___',
'| . ` |/ _ \ \ /\ / / | | |_ |/ _` | ''_ ` _ \ / _ \',
'| |\ | __/\ V V / | |__| | (_| | | | | | | __/',
'|_| \_|\___| \_/\_/ \_____|\__,_|_| |_| |_|\___|',
'',
'',
' _ __ _____ __',
'| |/ / |_ _| / _|',
'| '' / ___ _ _ | | _ __ | |_ ___',
'| < / _ \ | | | | | | ''_ \| _/ _ \',
'| . \ __/ |_| | _| |_| | | | || (_) |',
'|_|\_\___|\__, | |_____|_| |_|_| \___/',
' __/ |',
' |___/',
' _____ _ _ ',
' / ____| | | (_) ',
'| | ___ _ __ | |_ _ _ __ _ _ ___ ',
'| | / _ \| ''_ \| __| | ''_ \| | | |/ _ \',
'| |___| (_) | | | | |_| | | | | |_| | __/',
' \_____\___/|_| |_|\__|_|_| |_|\__,_|\___|',
'',
'',
'',
'',
'',
''

42
paused.txt Normal file
View File

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

15
snake_fields_m.pas Normal file
View File

@ -0,0 +1,15 @@
unit snake_fields_m;
interface
type
snakeStatePtr = ^snakeState;
snakeState = record
crazyField1: boolean;
crazyField2: boolean;
crazyField3: boolean;
end;
implementation
end.

15
snake_m.pas Normal file
View File

@ -0,0 +1,15 @@
unit snake_m;
interface
uses creature_m;
procedure UpdateSnakeState(var cr: creature);
implementation
procedure UpdateSnakeState(var cr: creature);
begin
end;
end.

14
sun_fields_m.pas Normal file
View File

@ -0,0 +1,14 @@
unit sun_fields_m;
interface
type
sunStatePtr = ^sunState;
sunState = record
rageMode, bigStep: boolean;
beforeRageSwitch: integer;
end;
implementation
end.

98
sun_m.pas Normal file
View File

@ -0,0 +1,98 @@
unit sun_m;
interface
uses creature_m;
procedure InitRandomSun(var s: creature);
procedure UpdateSunState(var cr: creature);
implementation
uses arena_m, Math, math_m;
const
SunSlowMovespeed = 1;
SunFastMovespeed = 2;
SunRageMovespeed = 4;
SunStartDX = SunSlowMovespeed;
SunStartDY = SunSlowMovespeed;
SunSymbol = 's';
MinToRageSwitch = 15;
MaxToRageSwitch = 25;
MinToNormSwitch = 5;
MaxToNormSwitch = 15;
procedure InitSun(var g: creature; x, y, sigdx, sigdy: integer);
begin
g.t := creatureSun;
g.curX := x;
g.curY := y;
g.dX := SunStartDX * sigdx;
g.dY := SunStartDY * sigdy;
g.movespeed := SunSlowMovespeed;
g.alive := true;
g.animation := 1;
new(g.sunf);
g.sunf^.bigStep:= true;
g.sunf^.rageMode := false;
g.sunf^.beforeRageSwitch := RandomLR(MinToRageSwitch, MaxToRageSwitch);;
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 SwitchRageMode(var cr: creature);
begin
cr.sunf^.rageMode := not cr.sunf^.rageMode;
if cr.sunf^.rageMode then
cr.sunf^.beforeRageSwitch := RandomLR(MinToNormSwitch, MaxToNormSwitch)
else
cr.sunf^.beforeRageSwitch := RandomLR(MinToRageSwitch, MaxToRageSwitch);
if cr.sunf^.rageMode then
begin
cr.dX := Signum(cr.dX, 0) * SunRageMovespeed;
cr.dY := Signum(cr.dY, 0) * SunRageMovespeed
end
else
begin
cr.dX := Signum(cr.dX, 0) * SunSlowMovespeed;
cr.dY := Signum(cr.dY, 0) * SunSlowMovespeed;
cr.sunf^.bigStep := false
end;
end;
procedure UpdateSunState(var cr: creature);
begin
if cr.sunf^.beforeRageSwitch = 0 then
begin
SwitchRageMode(cr);
exit
end;
cr.sunf^.beforeRageSwitch := cr.sunf^.beforeRageSwitch - 1;
if cr.sunf^.rageMode then
exit;
cr.sunf^.bigStep := not cr.sunf^.bigStep;
if cr.sunf^.bigStep then
begin
cr.dX := Signum(cr.dX, 0) * SunFastMovespeed;
cr.dY := Signum(cr.dY, 0) * SunFastMovespeed
end
else
begin
cr.dX := Signum(cr.dX, 0) * SunSlowMovespeed;
cr.dY := Signum(cr.dY, 0) * SunSlowMovespeed
end
end;
end.

193
trace_m.pas Normal file
View File

@ -0,0 +1,193 @@
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;
if IsOnTrace(prevX, prevY, t) then
TraceCrossed := true
else
TraceCrossed := false
end;
end.