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

Merge pull request 'feat/TD-018-add-autogenerate-banners' (#17) from dev into main

Browse Source 
Reviewed-on: #17
This commit is contained in:
gre-ilya 2026-02-28 17:33:21 +00:00
commit 0b19e3e166
28 changed files with 1118 additions and 483 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/Makefile
View File

@ -1,8 +1,14 @@
FPC = fpc FPC = fpc
CONVBANNERS_SRC = convbanners.pas
GAME_SRC = gohamster.pas arena_m.pas cell_m.pas creature_m.pas debug_m.pas \ BANNERS_SRC = completed.txt exit.txt keys.txt paused.txt menu.txt \
ghost_m.pas graphics_m.pas hamster_m.pas keys_m.pas math_m.pas \ level.txt gameover.txt
trace_m.pas enemy_packs_m.pas sun_m.pas
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 all: gohamster
@ -12,7 +18,11 @@ play: gohamster
gohamster: $(GAME_SRC) gohamster: $(GAME_SRC)
$(FPC) $@.pas $(FPC) $@.pas
_banners_m.pas: convbanners $(BANNERS_SRC)
./convbanners
convbanners: $(CONVBANNERS_SRC)
$(FPC) $@.pas
clean: clean:
rm *.o *.ppu gohamster rm *.o *.ppu convbanners _banners_m.pas gohamster

255
src/arena_graphics_m.pas
View File

@ -2,22 +2,21 @@ unit arena_graphics_m;
interface interface
uses arena_m, creature_m, trace_m, level_m; uses arena_m, creature_m, trace_m, level_m, _banners_m;
const const
ArenaSymbol = ' '; ArenaSymbol = ' ';
CaptureSymbol = '.'; CaptureSymbol = '.';
procedure DrawAfterEnemyStep(var e: creature);
procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena); procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena);
procedure DrawAliveEnemies(var e: creatureList); procedure DrawAliveEnemies(var e: creatureList);
procedure RedrawArea(var a: arena; arenaX, arenaY: integer); procedure RedrawArea(var a: arena; arenaX, arenaY: integer; t: creatureType);
procedure DrawArenaBorders(var a: arena); procedure DrawArenaBorders(var a: arena);
procedure DrawCreature(var cr: creature); procedure DrawCreature(var cr: creature);
procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char); procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char);
procedure DrawArenaEdges; procedure DrawArenaEdges;
procedure DrawPause; procedure DrawPause;
procedure DrawTrace(t: tracePtr); procedure DrawTrace(a: tracePtr);
procedure DrawHamster(var h: creature); procedure DrawHamster(var h: creature);
procedure FillCellsCapture(var a: arena); procedure FillCellsCapture(var a: arena);
procedure FillCompleteBar(s: integer); procedure FillCompleteBar(s: integer);
@ -26,14 +25,13 @@ procedure DrawLevel(var level: levelState; life, score: integer);
procedure DrawLevelUnpause(var level: levelState); procedure DrawLevelUnpause(var level: levelState);
procedure DrawLifesNumber(n: integer); procedure DrawLifesNumber(n: integer);
procedure DrawScore(s: integer); procedure DrawScore(s: integer);
procedure EraseStepTrace(var hamster: creature; t: tracePtr); procedure EraseStepTrace(var hamster: creature; a: tracePtr);
procedure EraseLifesNumber(n: integer); procedure EraseLifesNumber(n: integer);
procedure EraseTrace(t: tracePtr; var a: arena); procedure EraseTrace(tp: tracePtr; var a: arena);
implementation implementation
uses ascii_arts_m, crt, math_m, hamster_m, graphics_m; uses ascii_arts_m, crt, math_m, hamster_m, graphics_m;
const const
ArenaPauseLowerMarginY = 14; ArenaPauseLowerMarginY = 14;
ArenaPauseMarginX = 9; ArenaPauseMarginX = 9;
@ -66,6 +64,32 @@ const
InterfaceArenaCellX1 = 15; InterfaceArenaCellX1 = 15;
InterfaceArenaCellX2 = 29; 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; procedure DrawCompleteBar;
begin begin
FillRectangle(CompleteBarX, CompleteBarY, CompleteBarW, CompleteBarH, '-'); FillRectangle(CompleteBarX, CompleteBarY, CompleteBarW, CompleteBarH, '-');
@ -84,16 +108,6 @@ begin
FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '+') FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '+')
end; end;
procedure DrawSimpleCreature(var cr: creature);
begin
DrawFieldCell(cr.curX, cr.curY, cr.symbol)
end;
procedure DrawAfterEnemyStep(var e: creature);
begin
DrawCreature(e)
end;
procedure DrawAliveEnemies(var e: creatureList); procedure DrawAliveEnemies(var e: creatureList);
var var
tmp: creatureItemPtr; tmp: creatureItemPtr;
@ -102,25 +116,26 @@ begin
while tmp <> nil do while tmp <> nil do
begin begin
if tmp^.cr^.alive then if tmp^.cr^.alive then
DrawAfterEnemyStep(tmp^.cr^); DrawCreature(tmp^.cr^);
tmp := tmp^.next tmp := tmp^.next
end end
end; end;
procedure DrawFieldAscii(arenaX, arenaY, h, w: integer; procedure DrawFieldAscii(arenaX, arenaY, h, w: integer; var a: CreatureImage);
var a: array of string);
var var
screenX, screenY: integer; screenX, screenY: integer;
begin begin
screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient; screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient;
screenY := InterfaceBarH + (arenaY - 1) * CellSize; screenY := InterfaceBarH + (arenaY - 1) * CellSize;
DrawAscii(screenX, screenY, h, a) DrawCreatureImage(screenX, screenY, h, a)
end; end;
procedure DrawStepTrace(t: tracePtr; hamsterDelta: integer); procedure DrawStepTrace(a: tracePtr; hamsterDelta: integer);
var var
i: integer; i: integer;
t: tracePtr;
begin begin
t := a;
for i := 1 to HamsterDelta + 2 do for i := 1 to HamsterDelta + 2 do
begin begin
t := t^.prev; t := t^.prev;
@ -136,17 +151,15 @@ var
begin begin
prevX := cr.curX - cr.dX; prevX := cr.curX - cr.dX;
prevY := cr.curY - cr.dY; prevY := cr.curY - cr.dY;
DrawArenaCell(prevX, prevY, a); DrawArenaCell(prevX, prevY, a)
{Maybe delete later}
if a.borders[prevY][prevX] then
DrawFieldCell(prevX, prevY, BorderSymbol)
{Maybe delete later}
end; end;
procedure EraseStepTrace(var hamster: creature; t: tracePtr); procedure EraseStepTrace(var hamster: creature; a: tracePtr);
var var
i: integer; i: integer;
t: tracePtr;
begin begin
t := a;
for i := 1 to hamster.movespeed do for i := 1 to hamster.movespeed do
begin begin
DrawFieldCell(t^.x, t^.y, ArenaSymbol); DrawFieldCell(t^.x, t^.y, ArenaSymbol);
@ -161,8 +174,10 @@ begin
end end
end; end;
procedure EraseCreatureInterface(x: integer); procedure EraseHamsterInterface(x: integer);
begin begin
if x <= 0 then
exit;
DrawFieldCell(x, 0, ' '); DrawFieldCell(x, 0, ' ');
DrawFieldCell(x, -1, ' '); DrawFieldCell(x, -1, ' ');
DrawFieldCell(x - 1, 0, ' '); DrawFieldCell(x - 1, 0, ' ');
@ -171,35 +186,40 @@ end;
procedure RedrawInterfaceArea(x: integer); procedure RedrawInterfaceArea(x: integer);
begin begin
EraseCreatureInterface(x); EraseHamsterInterface(x);
if x = 1 then if (x = 1) or (x = 2) then
DrawLineY(1, InterfaceBarH - HamsterHeight, DrawLineY(1, InterfaceBarH - HamsterHeight,
HamsterHeight, BorderSymbol); HamsterHeight, BorderSymbol)
else
if x = InterfaceArenaCellX1 then if x = InterfaceArenaCellX1 then
DrawLineY(InterfaceCellW * WidthCoefficient, DrawLineY(InterfaceCellW * WidthCoefficient,
InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol); InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol)
else
if x = InterfaceArenaCellX2 then if x = InterfaceArenaCellX2 then
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1,
InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol); InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol)
else
if x = ArenaW then if x = ArenaW then
DrawLineY(ArenaW * CellSize * WidthCoefficient, DrawLineY(ArenaW * CellSize * WidthCoefficient,
InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol) InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol)
end; end;
procedure RedrawArea(var a: arena; arenaX, arenaY: integer); procedure RedrawArea(var a: arena; arenaX, arenaY: integer; t: creatureType);
var var
i, j: integer; i, j: integer;
r: redrawAreaBox;
begin begin
for i := -1 to 1 do r := RedrawAreas[t];
for i := r.lY to r.rY do
begin begin
for j := -1 to 1 do for j := r.lX to r.rX do
begin begin
if (arenaX + j > 0) and (arenaX + j < ArenaW + 1) and if (arenaX + j > 0) and (arenaX + j < ArenaW + 1) and
(arenaY + i > 0) and (arenaY + i < ArenaH + 1) then (arenaY + i > 0) and (arenaY + i < ArenaH + 1) then
begin begin
if arenaY + i = 1 then if (t = creatureHamster) and (arenaY + i = 1) then
RedrawInterfaceArea(arenaX + j); RedrawInterfaceArea(arenaX + j);
DrawArenaCell(arenaX + j, arenaY + i, a); DrawArenaCell(arenaX + j, arenaY + i, a)
end end
end end
end end
@ -209,12 +229,12 @@ procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena);
var var
arenaX, arenaY: integer; arenaX, arenaY: integer;
begin begin
{Later move to erase hamster}
arenaX := h.curX - h.dX; arenaX := h.curX - h.dX;
arenaY := h.curY - h.dY; arenaY := h.curY - h.dY;
RedrawArea(a, arenaX, arenaY); RedrawArea(a, arenaX, arenaY, h.t);
if t <> nil then if t <> nil then
DrawTrace(t); DrawTrace(t);
{DrawStepTrace(t, h.movespeed);}
if t = nil then if t = nil then
DrawPreviousCell(h, a) DrawPreviousCell(h, a)
end; end;
@ -249,13 +269,16 @@ begin
PauseHeight + PauseYPadding * 2 + 1, PauseHeight + PauseYPadding * 2 + 1,
PauseWidth + PauseXPadding * 2, PauseWidth + PauseXPadding * 2,
BorderSymbol); BorderSymbol);
DrawAscii(PauseX, PauseY, PauseHeight, PauseAscii) DrawBannerImage(PauseX, PauseY, PauseHeight, PauseAscii)
end; end;
procedure DrawTrace(t: tracePtr); procedure DrawTrace(a: tracePtr);
var
t: tracePtr;
begin begin
if t <> nil then if a = nil then
t := t^.prev; exit;
t := a^.prev;
while t <> nil do while t <> nil do
begin begin
DrawFieldCell(t^.x, t^.y, TraceSymbol); DrawFieldCell(t^.x, t^.y, TraceSymbol);
@ -263,11 +286,12 @@ begin
end end
end; end;
procedure EraseInterfaceNumber(interfaceX: integer; s: longint); procedure EraseInterfaceNumber(interfaceX: integer; num: longint);
var var
cnt: integer = 0; cnt: integer = 0;
x, w: integer; x, w, s: integer;
begin begin
s := num;
while s <> 0 do while s <> 0 do
begin begin
s := s div DecimalBase; s := s div DecimalBase;
@ -302,7 +326,8 @@ end;
procedure DrawLifes(n: integer); procedure DrawLifes(n: integer);
begin begin
DrawAscii(LifeBarX, HamsterLifeY, HamsterHeight, HamsterLifesAscii); DrawCreatureImage(LifeBarX, HamsterLifeY,
HamsterHeight, HamsterLifesAscii);
DrawInterfaceNumber(LifeNumberX, n) DrawInterfaceNumber(LifeNumberX, n)
end; end;
@ -348,16 +373,22 @@ end;
procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char); procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char);
var var
i, screenX, screenY: integer; i, j, screenX, screenY: integer;
begin begin
screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient; screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient;
screenY := InterfaceBarH + (arenaY - 1) * CellSize; screenY := InterfaceBarH + (arenaY - 1) * CellSize;
GotoXY(screenX, screenY); for i := 1 to CellSize do
for i := 1 to CellSize * WidthCoefficient do begin
write(symbol); GotoXY(screenX, screenY + i - 1);
GotoXY(screenX, screenY + 1); { later change to nested for } for j := 1 to CellSize * WidthCoefficient do
for i := 1 to CellSize * WidthCoefficient do begin
write(symbol); if (screenX + j - 1 >= 1) and
(screenX + j - 1 <= ScreenW * WidthCoefficient) then
begin
write(symbol)
end
end
end;
GotoXY(1, 1) GotoXY(1, 1)
end; end;
@ -370,38 +401,38 @@ end;
procedure DrawLeftEdge(y: integer); procedure DrawLeftEdge(y: integer);
var var
terminalY: integer; terminalY, clampedY: integer;
begin begin
y := Clamp(y, 1, ArenaH); clampedY := Clamp(y, 1, ArenaH);
terminalY := InterfaceBarH + (y - 1) * CellSize; terminalY := InterfaceBarH + (clampedY - 1) * CellSize;
DrawLineY(1, terminalY, CellSize, BorderSymbol) DrawLineY(1, terminalY, CellSize, BorderSymbol)
end; end;
procedure DrawRightEdge(y: integer); procedure DrawRightEdge(y: integer);
var var
terminalY: integer; terminalY, clampedY: integer;
begin begin
y := Clamp(y, 1, ArenaH); clampedY := Clamp(y, 1, ArenaH);
terminalY := InterfaceBarH + (y - 1) * CellSize; terminalY := InterfaceBarH + (clampedY - 1) * CellSize;
DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize, BorderSymbol) DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize, BorderSymbol)
end; end;
procedure DrawUpperEdge(x: integer); procedure DrawUpperEdge(x: integer);
var var
terminalX, sizeX: integer; terminalX, sizeX, clampedX: integer;
begin begin
x := Clamp(x, 1, ArenaW); clampedX := Clamp(x, 1, ArenaW);
terminalX := (x - 1) * CellSize * WidthCoefficient + 1; terminalX := (clampedX - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient; sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbol) DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbol)
end; end;
procedure DrawLowerEdge(x: integer); procedure DrawLowerEdge(x: integer);
var var
terminalX, sizeX: integer; terminalX, sizeX, clampedX: integer;
begin begin
x := Clamp(x, 1, ArenaW); clampedX := Clamp(x, 1, ArenaW);
terminalX := (x - 1) * CellSize * WidthCoefficient + 1; terminalX := (clampedX - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient; sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH + ArenaH * CellSize - 1, DrawLineX(terminalX, InterfaceBarH + ArenaH * CellSize - 1,
sizeX, BorderSymbol) sizeX, BorderSymbol)
@ -420,11 +451,14 @@ end;
procedure DrawEdge(x, y: integer); procedure DrawEdge(x, y: integer);
begin begin
if x = 1 then if x = 1 then
DrawLeftEdge(y); DrawLeftEdge(y)
else
if x = ArenaW then if x = ArenaW then
DrawRightEdge(y); DrawRightEdge(y);
if y = 1 then if y = 1 then
DrawUpperEdge(x); DrawUpperEdge(x)
else
if y = ArenaH then if y = ArenaH then
DrawLowerEdge(x) DrawLowerEdge(x)
end; end;
@ -449,8 +483,13 @@ begin
DrawEdge(x, y) DrawEdge(x, y)
end; end;
procedure EraseTrace(t: tracePtr; var a: arena); procedure EraseTrace(tp: tracePtr; var a: arena);
var
t: tracePtr;
begin begin
if tp = nil then
exit;
t := tp;
while t <> nil do while t <> nil do
begin begin
if t^.prev = nil then if t^.prev = nil then
@ -476,35 +515,35 @@ end;
procedure DrawHamsterRunX(var h: creature); procedure DrawHamsterRunX(var h: creature);
var var
xIdx: integer; xIdx: integer;
img: ^CreatureImage;
begin begin
if h.dX = 0 then
exit;
xIdx := h.curX div h.moveSpeed mod HamsterRunNX + 1; xIdx := h.curX div h.moveSpeed mod HamsterRunNX + 1;
if h.dX > 0 then if h.dX > 0 then
img := @(HamsterRightAscii[xIdx])
else
img := @(HamsterLeftAscii[xIdx]);
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2, DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2, h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth, HamsterHeight, HamsterWidth, img^);
HamsterRightAscii[xIdx]);
if h.dX < 0 then
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth,
HamsterLeftAscii[xIdx])
end; end;
procedure DrawHamsterRunY(var h: creature); procedure DrawHamsterRunY(var h: creature);
var var
yIdx: integer; yIdx: integer;
img: ^CreatureImage;
begin begin
if h.dY = 0 then
exit;
yIdx := h.curY div h.moveSpeed mod HamsterRunNY + 1; yIdx := h.curY div h.moveSpeed mod HamsterRunNY + 1;
if h.dY > 0 then if h.dY > 0 then
img := @(HamsterDownAscii[yIdx])
else
img := @(HamsterUpAscii[yIdx]);
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2, DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2, h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth, HamsterHeight, HamsterWidth, img^)
HamsterDownAscii[yIdx]);
if h.dY < 0 then
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth,
HamsterUpAscii[yIdx])
end; end;
procedure DrawHamster(var h: creature); procedure DrawHamster(var h: creature);
@ -513,27 +552,55 @@ begin
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2, DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2, h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth, HamsterHeight, HamsterWidth,
HamsterStayAscii); HamsterStayAscii)
else
if h.dX <> 0 then if h.dX <> 0 then
DrawHamsterRunX(h); DrawHamsterRunX(h)
else
if h.dY <> 0 then if h.dY <> 0 then
DrawHamsterRunY(h); DrawHamsterRunY(h)
end; end;
procedure DrawCreature(var cr: creature); procedure DrawGhost(var g: creature);
var var
asciiIdx: integer; 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 begin
case cr.t of case cr.t of
creatureHamster: creatureHamster:
DrawHamster(cr); DrawHamster(cr);
creatureGhost: creatureGhost:
begin DrawGhost(cr);
asciiIdx := cr.curX div cr.moveSpeed mod GhostRunN + 1; creatureSun:
DrawFieldAscii(cr.curX - GhostWidth div WidthCoefficient div 2, DrawSun(cr)
cr.curY - GhostHeight div 2 + 1,
GhostHeight, GhostWidth, GhostAscii[asciiIdx])
end
end end
end; end;

58
src/arena_m.pas
View File

@ -32,10 +32,13 @@ procedure MakeEnemySteps(var a: arena; var h: creature;
procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena); procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
procedure SetArenaBorder(var t: tracePtr; var a: arena); procedure SetArenaBorder(var t: tracePtr; var a: arena);
procedure TurnStubbornEnemies(var a: arena; var e: creatureList); procedure TurnStubbornEnemies(var a: arena; var e: creatureList);
procedure MakeStep(var a: arena; var cr: creature);
implementation implementation
uses arena_graphics_m, cell_m, crt, graphics_m, math_m; uses arena_graphics_m, cell_m, crt, graphics_m, math_m, Math;
const const
MaxTurnAttempts = 3; MaxTurnAttempts = 3;
@ -146,7 +149,7 @@ begin
continue; continue;
cutOff := cutOff + 1; cutOff := cutOff + 1;
a.captured[cell.y][cell.x] := true; a.captured[cell.y][cell.x] := true;
DrawFieldCell(cell.x, cell.y, CaptureSymbol); DrawArenaCell(cell.x, cell.y, a);
AddAvailableNeighbours(captureQ, cell, a) AddAvailableNeighbours(captureQ, cell, a)
end end
end; end;
@ -215,11 +218,10 @@ end;
procedure SetArenaBorder(var t: tracePtr; var a: arena); procedure SetArenaBorder(var t: tracePtr; var a: arena);
begin begin
if t <> nil then if t = nil then
begin exit;
a.borders[t^.y][t^.x] := true; a.borders[t^.y][t^.x] := true;
SetArenaBorder(t^.prev, a) SetArenaBorder(t^.prev, a)
end
end; end;
function IsOnEdge(var cr: creature): boolean; function IsOnEdge(var cr: creature): boolean;
@ -404,7 +406,8 @@ end;
procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena); procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
begin begin
MakeStep(h); 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 if FieldToEdge(h, t, a) or IsOnField(h, t, a) then
ChangeHamsterTrace(h, t); ChangeHamsterTrace(h, t);
DrawAfterHamsterStep(h, t, a) DrawAfterHamsterStep(h, t, a)
@ -420,6 +423,11 @@ begin
a.borders[g.curY][g.curX] and a.captured[nextY][nextX] a.borders[g.curY][g.curX] and a.captured[nextY][nextX]
end; end;
function SunShouldTurn(var g: creature; var a: arena): boolean;
begin
SunShouldTurn := true
end;
function VerticalBorder(nextX, nextY: integer; var a: arena): boolean; function VerticalBorder(nextX, nextY: integer; var a: arena): boolean;
begin begin
VerticalBorder := VerticalBorder :=
@ -447,13 +455,17 @@ begin
g.dY := g.dY * -1 g.dY := g.dY * -1
end; end;
procedure MakeEnemyStep(var e, h: creature; t: tracePtr); procedure TurnSun(var g: creature; var a: arena);
begin
end;
procedure MakeEnemyStep(var a: arena; var e, h: creature; t: tracePtr);
var var
prevX, prevY: integer; prevX, prevY: integer;
begin begin
prevX := e.curX; prevX := e.curX;
prevY := e.curY; prevY := e.curY;
MakeStep(e); MakeStep(a, e);
if TraceCrossed(prevX, prevY, e, t) then if TraceCrossed(prevX, prevY, e, t) then
h.alive := false h.alive := false
end; end;
@ -518,7 +530,7 @@ begin
while tmp <> nil do while tmp <> nil do
begin begin
if tmp^.cr^.alive and not EnemyShouldTurn(tmp^.cr^, a) then if tmp^.cr^.alive and not EnemyShouldTurn(tmp^.cr^, a) then
RedrawArea(a, tmp^.cr^.curX, tmp^.cr^.curY); RedrawArea(a, tmp^.cr^.curX, tmp^.cr^.curY, tmp^.cr^.t);
tmp := tmp^.next tmp := tmp^.next
end end
end; end;
@ -532,9 +544,35 @@ begin
while tmp <> nil do while tmp <> nil do
begin begin
if tmp^.cr^.alive and not EnemyShouldTurn(tmp^.cr^, a) then if tmp^.cr^.alive and not EnemyShouldTurn(tmp^.cr^, a) then
MakeEnemyStep(tmp^.cr^, h, t); MakeEnemyStep(a, tmp^.cr^, h, t);
tmp := tmp^.next tmp := tmp^.next
end end
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. end.

303
src/ascii_arts_m.pas
View File

@ -1,11 +1,19 @@
unit ascii_arts_m; unit ascii_arts_m;
interface interface
const const
HamsterHeight = 5;
HamsterLifesWidth = 13;
MaxBannerWidth = 98;
MaxBannerHeight = 42;
DigitHeight = 5; DigitHeight = 5;
DigitWidth = 5; DigitWidth = 5;
DigitsAscii: array[0..9] of array[1..DigitHeight] of string = ( 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 = (
( (
'@@@@@', '@@@@@',
'@ @', '@ @',
@ -78,112 +86,13 @@ const
) )
); );
GameMenuHeight = 36; const
GameMenuScreen: array[1..GameMenuHeight] of string = (
' _____ _ _ _ _',
' / ____| | | | | | | | |',
'| | __ ___ | | | |__| | __ _ _ __ ___ ___| |_ ___ _ __',
'| | |_ |/ _ \| | | __ |/ _` | ''_ ` _ \/ __| __/ _ \ ''__|',
'| |__| | (_) |_| | | | | (_| | | | | | \__ \ || __/ |',
' \_____|\___/(_) |_| |_|\__,_|_| |_| |_|___/\__\___|_|',
'',
'',
'',
'',
'',
'',
'',
'',
' _ _ _____',
'| \ | | / ____|',
'| \| | _____ __ | | __ __ _ _ __ ___ ___',
'| . ` |/ _ \ \ /\ / / | | |_ |/ _` | ''_ ` _ \ / _ \',
'| |\ | __/\ V V / | |__| | (_| | | | | | | __/',
'|_| \_|\___| \_/\_/ \_____|\__,_|_| |_| |_|\___|',
'',
'',
' _ __ _____ __',
'| |/ / |_ _| / _|',
'| '' / ___ _ _ | | _ __ | |_ ___',
'| < / _ \ | | | | | | ''_ \| _/ _ \',
'| . \ __/ |_| | _| |_| | | | || (_) |',
'|_|\_\___|\__, | |_____|_| |_|_| \___/',
' __/ |',
' |___/',
' _____ _ _ ',
' / ____| | | (_) ',
'| | ___ _ __ | |_ _ _ __ _ _ ___ ',
'| | / _ \| ''_ \| __| | ''_ \| | | |/ _ \',
'| |___| (_) | | | | |_| | | | | |_| | __/',
' \_____\___/|_| |_|\__|_|_| |_|\__,_|\___|'
);
GameNameHeight = 6;
GameNameWidth = 58;
NewGameHeight = 6;
HighScoreHeight = 8;
MenuInfoHeight = 8;
ContinueHeight = 6;
ContinueWidth = 41;
ExitScreenHeight = 16;
ExitWidth = 70;
ExitHeight = 8;
ExitScreen: array[1..ExitScreenHeight] of string = (
' ______ _ _ _ _ ___',
'| ____| (_) | | | | | |__ \',
'| |__ __ ___| |_ | |_| |__ ___ __ _ __ _ _ __ ___ ___ ) |',
'| __| \ \/ / | __| | __| ''_ \ / _ \ / _` |/ _` | ''_ ` _ \ / _ \/ /',
'| |____ > <| | |_ | |_| | | | __/ | (_| | (_| | | | | | | __/_|',
'|______/_/\_\_|\__| \__|_| |_|\___| \__, |\__,_|_| |_| |_|\___(_)',
' __/ |',
' |___/',
'',
'',
' _ _ ___ ___ _ __ ___',
'| | | |/ _ \/ __| | ''_ \ / _ \',
'| |_| | __/\__ \ | | | | (_) |',
' \__, |\___||___/ |_| |_|\___/',
' __/ |',
' |___/'
);
PauseHeight = 22;
PauseWidth = 76;
{ Too long strings :(, lets follow linux styleguide }
PauseAscii: array[1..PauseHeight] of string = (
' _',
' | |',
' _ __ __ _ _ _ ___ ___ __| |',
' | ''_ \ / _` | | | / __|/ _ \/ _` |',
' | |_) | (_| | |_| \__ \ __/ (_| |',
' | .__/ \__,_|\__,_|___/\___|\__,_| ',
' | | ',
' |_| _ _',
' | | (_)',
' ___ _ __ __ _ __ ___ ___ ___ _ __ | |_ _ _ __ _ _ ___',
'/ __| ''_ \ / _` |/ __/ _ \ ______ / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \',
'\__ \ |_) | (_| | (_| __/ |______| | (_| (_) | | | | |_| | | | | |_| | __/',
'|___/ .__/ \__,_|\___\___| \___\___/|_| |_|\__|_|_| |_|\__,_|\___|',
'====| |===================',
' |_| _ _ _',
' (_) | | |',
' __ _ __ _ _ _ _| |_ | |_ ___ _ __ ___ ___ _ __ _ _',
' / _` | ______ / _` | | | | | __| | __/ _ \ | ''_ ` _ \ / _ \ ''_ \| | | |',
'| (_| | |______| | (_| | |_| | | |_ | || (_) | | | | | | | __/ | | | |_| |',
' \__, | \__, |\__,_|_|\__| \__\___/ |_| |_| |_|\___|_| |_|\__,_|',
'====| |= | |',
' |_| |_|'
);
YesHeight = 6; YesHeight = 6;
NoHeight = 4; NoHeight = 4;
NoWidth = 13; NoWidth = 13;
HamsterHeight = 5;
HamsterWidth = 7; HamsterWidth = 7;
HamsterLifesWidth = 13;
HamsterStayAscii: array[1..HamsterHeight] of string = ( HamsterStayAscii: CreatureImage = (
' (\_/)', ' (\_/)',
'( 0_0 )', '( 0_0 )',
'/-----\', '/-----\',
@ -191,9 +100,18 @@ const
' / \' ' / \'
); );
{
HamsterStayAscii: CreatureImage = (
' (\_/)',
'( 0_0 )',
'/-----\',
' |___|',
' / \'
);
}
HamsterRunNX = 4; HamsterRunNX = 4;
HamsterRightAscii: array[1..HamsterRunNX] HamsterRightAscii: array[1..HamsterRunNX] of CreatureImage = (
of array[1..HamsterHeight] of string = (
( (
' _/)', ' _/)',
' ( 0)', ' ( 0)',
@ -224,8 +142,7 @@ const
) )
); );
HamsterLeftAscii: array[1..HamsterRunNX] HamsterLeftAscii: array[1..HamsterRunNX] of CreatureImage = (
of array[1..HamsterHeight] of string = (
( (
' (\_ ', ' (\_ ',
' (0 )', ' (0 )',
@ -257,8 +174,7 @@ const
); );
HamsterRunNY = 2; HamsterRunNY = 2;
HamsterDownAscii: array[1..HamsterRunNY] HamsterDownAscii: array[1..HamsterRunNY] of CreatureImage = (
of array[1..HamsterHeight] of string = (
( (
' (\_/)', ' (\_/)',
'( 0_o )', '( 0_o )',
@ -275,8 +191,7 @@ const
) )
); );
HamsterUpAscii: array[1..HamsterRunNY] HamsterUpAscii: array[1..HamsterRunNY] of CreatureImage = (
of array[1..HamsterHeight] of string = (
( (
' (\_/)', ' (\_/)',
'( )', '( )',
@ -293,7 +208,7 @@ const
) )
); );
HamsterGGAscii: array[1..HamsterHeight] of string = ( HamsterGGAscii: CreatureImage = (
' (\_/)', ' (\_/)',
'( G_G )', '( G_G )',
'/-----\', '/-----\',
@ -301,7 +216,7 @@ const
' / \' ' / \'
); );
HamsterLifesAscii: array[1..HamsterHeight] of string = ( HamsterLifesAscii: CreatureImage = (
' (\_/) ', ' (\_/) ',
'( 0_0 ) \ /', '( 0_0 ) \ /',
'/-----\ X ', '/-----\ X ',
@ -312,144 +227,54 @@ const
GhostHeight = 3; GhostHeight = 3;
GhostWidth = 7; GhostWidth = 7;
GhostRunN = 2; GhostRunN = 2;
GhostAscii: array[1..GhostRunN] GhostAscii: array[1..GhostRunN] of CreatureImage = (
of array[1..GhostHeight] of string = (
( (
' ___', ' ___',
' /0 0\', ' /0 0\',
'\/VvV\/' '\/VvV\/',
'',
''
), ),
( (
' ___', ' ___',
' /0 0\', ' /0 0\',
'\_____/' '\_____/',
'',
''
) )
); );
GameOverHeight = 40; SunHeight = 5;
GameOverWidth = 63; SunWidth = 7;
GameOverScreen: array[1..GameOverHeight] of string = ( SunRunN = 2;
' _____ __ __ ______ ', SunAscii: array[1..SunRunN] of CreatureImage = (
' / ____| /\ | \/ | ____|', (
' | | __ / \ | \ / | |__ ', ' _A_',
' | | |_ | / /\ \ | |\/| | __|',
' | |__| |/ ____ \| | | | |____',
' \_____/_/ \_\_| |_|______|',
' ______ ________ _____',
' / __ \ \ / / ____| __ \',
' | | | \ \ / /| |__ | |__) |',
' | | | |\ \/ / | __| | _ /',
' | |__| | \ / | |____| | \ \',
' \____/ \/ |______|_| \_\',
'',
' ____ ____',
' / o@@\ /@@o \',
' / /``\@\ __,-==-,__ /@/``\ \',
' / /` `||//\______/ \||` `\ \',
' | |` // __ __ \\ `| |',
' \ \` (/ /;g\ /g;\ \) `/ |',
' \_\__(( " .. " )____/_/',
' \ " __ " / ',
' @@@@@@(||)@@@@`@@`@@@@(||)@@@@@@@',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',
' ',
' _ _ ___',
' | | (_) |__ \',
' ___ ___ _ __ | |_ _ _ __ _ _ ___ ) |',
' / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \ / /',
' | (_| (_) | | | | |_| | | | | |_| | __/ |_|',
' \___\___/|_| |_|\__|_|_| |_|\__,_|\___| (_)',
' ___ ___ __ ___ ___',
'| _| |_ | \ \ | _| |_ |',
'| | _ _ | | ___ ___ \ \ | | _ __ | | ___',
'| | | | | | | |/ _ \/ __| \ \ | | | ''_ \ | |/ _ \',
'| | | |_| | | | __/\__ \ \ \ | | | | | | | | (_) |',
'| |_ \__, | _| |\___||___/ \ \ | |_ |_| |_| _| |\___/',
'|___|=====/ |=|___| \_\ |___|=========|___|',
' |___/'
);
KeyInfoHeight = 42;
KeyInfoWidth = 98;
KeyInfoScreen: array[1..KeyInfoHeight] of string = (
' _',
' | |',
' _ __ ___ _____ _____ | | _____ _ _ ___ _',
' | ''_ ` _ \ / _ \ \ / / _ \ | |/ / _ \ | | / __| (_)',
' | | | | | | (_) \ V / __/ | < __/ |_| \__ \ _',
' |_| |_| |_|\___/ \_/ \___| |_|\_\___|\__, |___/ (_)',
' __/ |',
' _ |___/',
' / \', ' / \',
' / . \', '<|o o|>',
' / / \ \', ' \_^_/',
' /_/| |\_\', ' V'
' | |', ),
' |_|', (
' __ ========= __', ' _A_',
' / / (\_/) \ \', ' / \',
' / /_____ ( 0_0 ) ______\ \ ', '{|o o|}',
' { ______| /-----\ |_______ }', ' \_^_/',
' \ \ |___| / /', ' v'
' \_\ / \ /_/', )
' ========== _ ===========', );
' | |',
' _ | | _ ', RageSunHeight = 4;
' \ \| |/ /', RageSunRunN = 1;
' \ \ / / ', RageSunAscii: array[1..RageSunRunN] of CreatureImage = (
' \ ` / ', (
' \_/',
' =========',
' ___', ' ___',
' | | | | | |', ' / Z \',
' ___ _ __ __ _ ___ ___ ___| |_ ___ _ __ | |__ __ _ _ __ ___ ___| |_ ___ _ __', '||> <||',
' / __| ''_ \ / _` |/ __/ _ \ ______ / __| __/ _ \| ''_ \ | ''_ \ / _` | ''_ ` _ \/ __| __/ _ \ ''__|', ' \___/',
' \__ \ |_) | (_| | (_| __/ |______| \__ \ || (_) | |_) | | | | | (_| | | | | | \__ \ || __/ |', ''
' |___/ .__/ \__,_|\___\___| |___/\__\___/| .__/ |_| |_|\__,_|_| |_| |_|___/\__\___|_|', )
' ====| |=================== | |',
' |_| |_|',
' ___ ___ ___ _ __ __ _ _ _ ___ ___',
' / _ \/ __|/ __| ______ | ''_ \ / _` | | | / __|/ _ \',
'| __/\__ \ (__ |______| | |_) | (_| | |_| \__ \ __/',
' \___||___/\___| | .__/ \__,_|\__,_|___/\___|',
'================ | |',
' |_|'
); );
LevelAnnounceHeight = 6;
LevelAnnounceWidth = 24;
LevelAnnounce: array[1..LevelAnnounceHeight] of string = (
' _ _ ',
'| | | |',
'| | _____ _____| |',
'| | / _ \ \ / / _ \ |',
'| |___| __/\ V / __/ |',
'|______\___| \_/ \___|_|'
);
GameCompleteHeight = 14;
GameCompleteWidth = 74;
GameCompleteScoreWidth = 50;
GameComplete: array[1..GameCompleteHeight] of string = (
' _____ _ _ _ ',
' / ____| | | | | | |',
'| | __ __ _ _ __ ___ ___ ___ ___ _ __ ___ _ __ | | ___| |_ ___| |',
'| | |_ |/ _` | ''_ ` _ \ / _ \ / __/ _ \| ''_ ` _ \| ''_ \| |/ _ \ __/ _ \ |',
'| |__| | (_| | | | | | | __/ | (_| (_) | | | | | | |_) | | __/ || __/_|',
' \_____|\__,_|_| |_| |_|\___| \___\___/|_| |_| |_| .__/|_|\___|\__\___(_)',
' | |',
' |_|',
'__ __',
'\ \ / / _ ',
' \ \_/ /__ _ _ _ __ ___ ___ ___ _ __ ___(_)',
' \ / _ \| | | | ''__| / __|/ __/ _ \| ''__/ _ \',
' | | (_) | |_| | | \__ \ (_| (_) | | | __/_ ',
' |_|\___/ \__,_|_| |___/\___\___/|_| \___(_)'
);
implementation implementation
end. end.

42
src/completed.txt Normal file
View File

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

195
src/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.

53
src/creature_m.pas
View File

@ -2,6 +2,8 @@ unit creature_m;
interface interface
uses sun_fields_m, snake_fields_m, drop_fields_m;
type type
creatureType = (creatureHamster, creatureGhost, creatureSun, creatureType = (creatureHamster, creatureGhost, creatureSun,
creatureSnake, creatureDrop); creatureSnake, creatureDrop);
@ -10,9 +12,11 @@ type
creature = record creature = record
curX, curY, dX, dY, moveSpeed, animation: integer; curX, curY, dX, dY, moveSpeed, animation: integer;
symbol: char;
alive: boolean; alive: boolean;
t: creatureType; t: creatureType;
sunf: sunStatePtr;
snakef: snakeStatePtr;
dropf: dropStatePtr;
end; end;
creatureItemPtr = ^creatureItem; creatureItemPtr = ^creatureItem;
@ -31,13 +35,13 @@ function RandomLR(l, r: integer): integer;
procedure AppendCreature(var lst: creatureList; c: creaturePtr); procedure AppendCreature(var lst: creatureList; c: creaturePtr);
procedure DisposeCreatureList(var lst: creatureList); procedure DisposeCreatureList(var lst: creatureList);
procedure KillCreature(var cr: creature); procedure KillCreature(var cr: creature);
procedure MakeStep(var cr: creature);
procedure InitCreatureList(var lst: creatureList); procedure InitCreatureList(var lst: creatureList);
procedure StopCreature(var cr: creature); procedure StopCreature(var cr: creature);
procedure UpdateEnemyStates(var lst: creatureList);
implementation implementation
uses arena_graphics_m, arena_m, math_m, ascii_arts_m; uses arena_graphics_m, arena_m, math_m, ascii_arts_m, sun_m, snake_m, drop_m;
function RandomLR(l, r: integer): integer; function RandomLR(l, r: integer): integer;
begin begin
@ -68,6 +72,15 @@ begin
lst.first := lst.first^.next; lst.first := lst.first^.next;
if lst.first = nil then if lst.first = nil then
lst.last := nil; 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^.cr);
dispose(tmp); dispose(tmp);
lst.len := lst.len - 1 lst.len := lst.len - 1
@ -76,14 +89,7 @@ end;
procedure KillCreature(var cr: creature); procedure KillCreature(var cr: creature);
begin begin
cr.alive := false; cr.alive := false
DrawFieldCell(cr.curX, cr.curY, CaptureSymbol)
end;
procedure MakeStep(var cr: creature);
begin
cr.curX := Clamp(cr.curX + cr.dX, 1, ArenaW);
cr.curY := Clamp(cr.curY + cr.dY, 1, ArenaH)
end; end;
procedure InitCreatureList(var lst: creatureList); procedure InitCreatureList(var lst: creatureList);
@ -99,4 +105,29 @@ begin
cr.dY := 0 cr.dY := 0
end; 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. end.

16
src/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
src/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.

8
src/enemy_packs_m.pas
View File

@ -16,12 +16,20 @@ implementation
uses ghost_m, sun_m; uses ghost_m, sun_m;
const const
{
LevelGhostN: array[enemyPackType] of integer = (
4, 4, 2, 4, 4, 2, 4, 2, 4, 4
);
}
LevelGhostN: array[enemyPackType] of integer = ( LevelGhostN: array[enemyPackType] of integer = (
4, 4, 2, 4, 4, 2, 4, 2, 4, 4 4, 4, 2, 4, 4, 2, 4, 2, 4, 4
); );
LevelSunN: array[enemyPackType] of integer = ( LevelSunN: array[enemyPackType] of integer = (
0, 1, 4, 2, 0, 2, 2, 2, 2, 0 0, 1, 4, 2, 0, 2, 2, 2, 2, 0
); );
{ {
LevelSnakeN: array[enemyPackType] of integer = ( LevelSnakeN: array[enemyPackType] of integer = (
0, 0, 0, 1, 2, 2, 2, 4, 2, 2 0, 0, 0, 1, 2, 2, 2, 4, 2, 2

42
src/exit.txt Normal file
View File

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

58
src/game_m.pas
View File

@ -12,9 +12,8 @@ type
gameLevelComplete, gameLevelLoop, gameContinueLevel gameLevelComplete, gameLevelLoop, gameContinueLevel
); );
menuState = (menuNewGame, menuKeyInfo, menuContinue); menuState = (menuNewGame, menuKeyInfo, menuContinue);
exitState = (exitYes, exitNo);
gameState = record gameState = record
curExit: exitState; curExit: boolean;
curMenu: menuState; curMenu: menuState;
curState: state; curState: state;
level, score, life: integer; level, score, life: integer;
@ -136,8 +135,7 @@ begin
ArenaCutPart(level.h, level.t, level.cut, level.a); ArenaCutPart(level.h, level.t, level.cut, level.a);
FillCompleteBar(level.cut); FillCompleteBar(level.cut);
g.score := g.score + (level.cut - beforeCut); g.score := g.score + (level.cut - beforeCut);
DrawScore(g.score); DrawScore(g.score)
KillCapturedEnemies(level.a, level.enemyList)
end; end;
procedure GameNextLevel(var g: gameState; var level: levelState); procedure GameNextLevel(var g: gameState; var level: levelState);
@ -182,6 +180,31 @@ begin
end end
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); procedure LevelLoop(var g: gameState; var level: levelState);
begin begin
while (g.curState = gameLevelLoop) and not g.shutdown do while (g.curState = gameLevelLoop) and not g.shutdown do
@ -198,22 +221,13 @@ begin
EraseLevel; EraseLevel;
break break
end; end;
TurnStubbornEnemies(level.a, level.enemyList); MakeEnemyTurnStages(level);
EraseEnemies(level.a, level.enemyList); MakeHamsterTurnStages(g, level);
MakeEnemySteps(level.a, level.h, level.t, level.enemyList);
DrawAliveEnemies(level.enemyList);
if not level.h.alive then
GameKillHamster(g, level);
if g.curState = gameOver then if g.curState = gameOver then
begin begin
EraseLevel; EraseLevel;
break break
end; end
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 end
end; end;
@ -362,18 +376,18 @@ end;
procedure NextExitState(var g: gameState); procedure NextExitState(var g: gameState);
begin begin
if g.curExit = exitNo then if not g.curExit then
g.curExit := exitYes g.curExit := true
else else
g.curExit := succ(g.curExit) g.curExit := false
end; end;
procedure PreviousExitState(var g: gameState); procedure PreviousExitState(var g: gameState);
begin begin
if g.curExit = exitYes then if g.curExit then
g.curExit := exitNo g.curExit := false
else else
g.curExit := pred(g.curExit) g.curExit := true
end; end;
end. end.

42
src/gameover.txt Normal file
View File

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

1
src/ghost_m.pas
View File

@ -26,7 +26,6 @@ begin
g.moveSpeed := GhostMovespeed; g.moveSpeed := GhostMovespeed;
g.alive := true; g.alive := true;
g.animation := 1; g.animation := 1;
g.symbol := GhostSymbol
end; end;
procedure InitRandomGhost(var g: creature); procedure InitRandomGhost(var g: creature);

5
src/gohamster.pas
View File

@ -1,8 +1,6 @@
program go_hamster; program go_hamster;
uses crt, graphics_m, game_m, debug_m;
{uses crt, keys_m, arena_graphics_m, graphics_m, game_m, uses crt, graphics_m, game_m;
ascii_digits_m, debug_m;}
function IsTerminalValid: boolean; function IsTerminalValid: boolean;
begin begin
@ -35,6 +33,7 @@ begin
PrintTerminalHelp; PrintTerminalHelp;
exit exit
end; end;
clrscr;
InitGame(g); InitGame(g);
EraseAll; EraseAll;
MainLoop(g) MainLoop(g)

111
src/graphics_m.pas
View File

@ -2,7 +2,7 @@ unit graphics_m;
interface interface
uses arena_m, creature_m, trace_m, game_m, level_m; uses arena_m, creature_m, trace_m, game_m, level_m, _banners_m, ascii_arts_m;
const const
BorderSize = 1; BorderSize = 1;
@ -15,8 +15,9 @@ const
ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 82 } ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 82 }
procedure DrawAnnounce(lvl: integer); procedure DrawAnnounce(lvl: integer);
procedure DrawAscii(x, y, h: integer; var a: array of string); procedure DrawBannerImage(x, y, h: integer; var a: BannerImage);
procedure DrawExitState(s: exitState); procedure DrawCreatureImage(x, y, h: integer; var a: CreatureImage);
procedure DrawExitState(b: boolean);
procedure DrawExit(var g: gameState); procedure DrawExit(var g: gameState);
procedure DrawGameOver; procedure DrawGameOver;
procedure DrawGameComplete(score: integer); procedure DrawGameComplete(score: integer);
@ -30,7 +31,7 @@ procedure DrawMenu(var g: gameState);
procedure EraseAll; procedure EraseAll;
procedure EraseAnnounce(lvl: integer); procedure EraseAnnounce(lvl: integer);
procedure EraseExit; procedure EraseExit;
procedure EraseExitState(s: exitState); procedure EraseExitState(b: boolean);
procedure EraseGameOver; procedure EraseGameOver;
procedure EraseKeyInfo; procedure EraseKeyInfo;
procedure EraseLevel; procedure EraseLevel;
@ -41,7 +42,7 @@ procedure FillRectangle(x, y, w, h: integer; ch: char);
implementation implementation
uses crt, math_m, ascii_arts_m; uses crt, math_m;
const const
AnnounceY = (ScreenH - LevelAnnounceHeight) div 2; AnnounceY = (ScreenH - LevelAnnounceHeight) div 2;
@ -74,61 +75,89 @@ const
GameCompleteY = (ScreenH - GameCompleteHeight) div 2; GameCompleteY = (ScreenH - GameCompleteHeight) div 2;
GameCompleteScoreX = GameCompleteX + GameCompleteScoreWidth + 3; GameCompleteScoreX = GameCompleteX + GameCompleteScoreWidth + 3;
GameCompleteScoreY = GameCompleteY + 9; GameCompleteScoreY = GameCompleteY + 9;
EndOfLine = 256;
var var
firstMenuDraw: boolean = true; firstMenuDraw: boolean = true;
procedure DrawAscii(x, y, h: integer; var a: array of string); procedure PrintStringScreen(x, y, dy: integer; var s: string);
var var
i, j: integer; cutLen: integer;
sCopy: string;
begin begin
for i := 1 to h do if y + dy - 1 > ScreenH then
exit;
if x < 0 then
begin begin
for j := 1 to Length(a[i - 1]) do cutLen := x * -1 + 1;
begin GotoXY(1, y + dy - 1);
if x + j - 1 < 0 then sCopy := copy(s, cutLen, EndOfLine);
continue; write(sCopy)
GotoXY(x + j - 1, y + i - 1);
write(a[i - 1][j])
end end
else
begin
GotoXY(x, y + dy - 1);
write(s)
end; end;
GotoXY(1, 1) GotoXY(1, 1)
end; end;
procedure DrawDigit(x, y, digit: integer); procedure DrawCreatureImage(x, y, h: integer; var a: CreatureImage);
var
i: integer;
begin begin
DrawAscii(x, y, DigitHeight, DigitsAscii[digit]) for i := 1 to h do
PrintStringScreen(x, y, i, a[i])
end; end;
procedure DrawExitState(s: exitState); procedure DrawBannerImage(x, y, h: integer; var a: BannerImage);
var
i: integer;
begin begin
case s of for i := 1 to h do
exitYes: PrintStringScreen(x, y, i, a[i])
DrawAscii(HamsterYesX, ExitHamsterY, end;
HamsterHeight, HamsterGGAscii);
exitNo: procedure DrawDigitImage(x, y, h: integer; var a: DigitImage);
DrawAscii(HamsterNoX, ExitHamsterY, 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) HamsterHeight, HamsterStayAscii)
end
end; end;
procedure DrawExit(var g: gameState); procedure DrawExit(var g: gameState);
var var
realX: integer = ScreenW * WidthCoefficient; realX: integer = ScreenW * WidthCoefficient;
begin begin
DrawAscii((realX - ExitWidth) div 2, ExitGameY, DrawBannerImage((realX - ExitWidth) div 2, ExitGameY,
ExitScreenHeight, ExitScreen); ExitScreenHeight, ExitScreen);
DrawExitState(g.curExit) DrawExitState(g.curExit)
end; end;
procedure DrawGameOver; procedure DrawGameOver;
begin begin
DrawAscii(GameOverX, GameOverY, GameOverHeight, GameOverScreen) DrawBannerImage(GameOverX, GameOverY, GameOverHeight, GameOverScreen)
end; end;
procedure DrawKeyInfo; procedure DrawKeyInfo;
begin begin
DrawAscii(KeyInfoX, KeyInfoY, KeyInfoHeight, KeyInfoScreen) DrawBannerImage(KeyInfoX, KeyInfoY, KeyInfoHeight, KeyInfoScreen)
end; end;
procedure DrawLineX(x, y, len: integer; ch: char); procedure DrawLineX(x, y, len: integer; ch: char);
@ -157,13 +186,13 @@ procedure DrawMenuState(s: menuState);
begin begin
case s of case s of
menuNewGame: menuNewGame:
DrawAscii(MenuHamsterX, NewGameY + 1, DrawCreatureImage(MenuHamsterX, NewGameY + 1,
HamsterHeight, HamsterStayAscii); HamsterHeight, HamsterStayAscii);
menuKeyInfo: menuKeyInfo:
DrawAscii(MenuHamsterX, MenuInfoY + 1, DrawCreatureImage(MenuHamsterX, MenuInfoY + 1,
HamsterHeight, HamsterStayAscii); HamsterHeight, HamsterStayAscii);
menuContinue: menuContinue:
DrawAscii(MenuHamsterX, ContinueY + 1, DrawCreatureImage(MenuHamsterX, ContinueY + 1,
HamsterHeight, HamsterStayAscii) HamsterHeight, HamsterStayAscii)
end end
end; end;
@ -193,7 +222,7 @@ begin
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient, BorderSymbol); DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient, BorderSymbol);
firstMenuDraw := not firstMenuDraw firstMenuDraw := not firstMenuDraw
end; end;
DrawAscii(GameNameX, y, GameMenuHeight, GameMenuScreen); DrawBannerImage(GameNameX, y, GameMenuHeight, GameMenuScreen);
if not g.levelInited then if not g.levelInited then
DrawLineX(GameNameX, ContinueY + ContinueHeight div 2, DrawLineX(GameNameX, ContinueY + ContinueHeight div 2,
ContinueWidth, '-'); ContinueWidth, '-');
@ -230,16 +259,14 @@ begin
ExitScreenHeight + MenuHeightPadding + YesHeight) ExitScreenHeight + MenuHeightPadding + YesHeight)
end; end;
procedure EraseExitState(s: exitState); procedure EraseExitState(b: boolean);
begin begin
case s of if b then
exitYes:
EraseRectangle(HamsterYesX, ExitHamsterY, EraseRectangle(HamsterYesX, ExitHamsterY,
HamsterWidth, HamsterHeight); HamsterWidth, HamsterHeight)
exitNo: else
EraseRectangle(HamsterNoX, ExitHamsterY, EraseRectangle(HamsterNoX, ExitHamsterY,
HamsterWidth, HamsterHeight) HamsterWidth, HamsterHeight)
end
end; end;
procedure EraseGameOver; procedure EraseGameOver;
@ -340,10 +367,12 @@ begin
end end
end; end;
function CountDigits(lvl: integer): integer; function CountDigits(l: integer): integer;
var var
lvl: integer;
res: integer = 0; res: integer = 0;
begin begin
lvl := l;
while lvl <> 0 do while lvl <> 0 do
begin begin
res := res + 1; res := res + 1;
@ -361,7 +390,7 @@ begin
w := LevelAnnounceWidth + LevelNumberMargin + w := LevelAnnounceWidth + LevelNumberMargin +
DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1); DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1);
x := (ScreenW * WidthCoefficient - w) div 2; x := (ScreenW * WidthCoefficient - w) div 2;
DrawAscii(x, AnnounceY, LevelAnnounceHeight, LevelAnnounce); DrawBannerImage(x, AnnounceY, LevelAnnounceHeight, LevelAnnounce);
DrawNumber(x + LevelAnnounceWidth + LevelNumberMargin, AnnounceY + 1, lvl) DrawNumber(x + LevelAnnounceWidth + LevelNumberMargin, AnnounceY + 1, lvl)
end; end;
@ -379,9 +408,9 @@ end;
procedure DrawGameComplete(score: integer); procedure DrawGameComplete(score: integer);
begin begin
DrawAscii(GameCompleteX, GameCompleteY, GameCompleteHeight, GameComplete); DrawBannerImage(GameCompleteX, GameCompleteY,
GameCompleteHeight, GameComplete);
DrawNumber(GameCompleteScoreX, GameCompleteScoreY, score) DrawNumber(GameCompleteScoreX, GameCompleteScoreY, score)
end; end;
end. end.

4
src/hamster_m.pas
View File

@ -28,15 +28,13 @@ begin
cr.dY := HamsterStartDY; cr.dY := HamsterStartDY;
cr.moveSpeed := HamsterMovespeed; cr.moveSpeed := HamsterMovespeed;
cr.alive := true; cr.alive := true;
cr.symbol := HamsterSymbol
end; end;
procedure KillHamster(var h: creature; var t: tracePtr; var a: arena); procedure KillHamster(var h: creature; var t: tracePtr; var a: arena);
var var
traceStart: tracePtr; traceStart: tracePtr;
begin begin
{DrawFieldCell(h.curX, h.curY, ArenaSymbol);} RedrawArea(a, h.curX, h.curY, h.t);
RedrawArea(a, h.curX, h.curY);
EraseTrace(t, a); EraseTrace(t, a);
DrawArenaCell(h.curX, h.curY, a); DrawArenaCell(h.curX, h.curY, a);
GetStart(traceStart, t); GetStart(traceStart, t);

42
src/keys.txt Normal file
View File

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

9
src/keys_m.pas
View File

@ -152,7 +152,8 @@ end;
procedure ChooseMenuMarked(var g: gameState); procedure ChooseMenuMarked(var g: gameState);
begin begin
case g.curMenu of case g.curMenu of
menuNewGame: begin menuNewGame:
begin
g.newGame := true; g.newGame := true;
g.level := 1; g.level := 1;
g.curState := gameLevelAnnounce g.curState := gameLevelAnnounce
@ -211,15 +212,15 @@ begin
end; end;
if (k = EnterOrd) or (k = SpaceOrd) then if (k = EnterOrd) or (k = SpaceOrd) then
begin begin
if g.curExit = exitYes then if g.curExit then
g.shutdown := true g.shutdown := true
else else
g.curExit := exitYes; g.curExit := true;
end; end;
if (k = UpperYOrd) or (k = LowerYOrd) or (k = OneOrd) then if (k = UpperYOrd) or (k = LowerYOrd) or (k = OneOrd) then
g.shutdown := true; g.shutdown := true;
if (k = UpperNOrd) or (k = LowerNOrd) or (k = EscOrd) or (k = TwoOrd) then if (k = UpperNOrd) or (k = LowerNOrd) or (k = EscOrd) or (k = TwoOrd) then
g.curExit := exitYes; g.curExit := true;
g.curState := gameMenu g.curState := gameMenu
end; end;

42
src/level.txt Normal file
View File

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

13
src/math_m.pas
View File

@ -1,4 +1,5 @@
unit math_m; unit math_m;
interface interface
function Clamp(val, min, max: integer): integer; function Clamp(val, min, max: integer): integer;
@ -27,19 +28,9 @@ begin
Signum := 0 Signum := 0
end; end;
function Abs(val: integer): integer;
begin
if val < 0 then
val := val * -1;
Abs := val
end;
function RandomBool: boolean; function RandomBool: boolean;
begin begin
if Random(2) = 1 then RandomBool := Random(2) = 1
RandomBool := true
else
RandomBool := false
end; end;
end. end.

42
src/menu.txt Normal file
View File

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

42
src/paused.txt Normal file
View File

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

15
src/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
src/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
src/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.

76
src/sun_m.pas
View File

@ -4,19 +4,27 @@ interface
uses creature_m; uses creature_m;
const procedure InitRandomSun(var s: creature);
SunSlowMovespeed = 2; procedure UpdateSunState(var cr: creature);
SunFastMovespeed = 4;
SunStartDX = SunSlowMovespeed;
SunStartDY = SunSlowMovespeed;
SunSymbol = 's';
procedure InitRandomSun(var g: creature);
implementation implementation
uses arena_m, Math, math_m; 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); procedure InitSun(var g: creature; x, y, sigdx, sigdy: integer);
begin begin
g.t := creatureSun; g.t := creatureSun;
@ -27,10 +35,13 @@ begin
g.movespeed := SunSlowMovespeed; g.movespeed := SunSlowMovespeed;
g.alive := true; g.alive := true;
g.animation := 1; g.animation := 1;
g.symbol := SunSymbol new(g.sunf);
g.sunf^.bigStep:= true;
g.sunf^.rageMode := false;
g.sunf^.beforeRageSwitch := RandomLR(MinToRageSwitch, MaxToRageSwitch);;
end; end;
procedure InitRandomSun(var g: creature); procedure InitRandomSun(var s: creature);
var var
x, y, sigdx, sigdy: integer; x, y, sigdx, sigdy: integer;
begin begin
@ -38,7 +49,50 @@ begin
sigdy := IfThen(RandomBool, 1, -1); sigdy := IfThen(RandomBool, 1, -1);
x := RandomLR(2, ArenaW - 1); x := RandomLR(2, ArenaW - 1);
y := RandomLR(2, ArenaH - 1); y := RandomLR(2, ArenaH - 1);
InitSun(g, x, y, sigdx, sigdy) 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;
end. end.

17
src/trace_m.pas
View File

@ -19,10 +19,10 @@ type
function FindIndex(var t: tracePtr; x, y, curIdx: integer): integer; function FindIndex(var t: tracePtr; x, y, curIdx: integer): integer;
function GetLength(var t: tracePtr): integer; function GetLength(var t: tracePtr): integer;
function function
TraceCrossed(prevX, prevY: integer; var cr: creature; t: tracePtr): boolean; TraceCrossed(pX, pY: integer; var cr: creature; t: tracePtr): boolean;
procedure ChangeHamsterTrace(var h: creature; var t: tracePtr); procedure ChangeHamsterTrace(var h: creature; var t: tracePtr);
procedure DeleteTrace(var t: tracePtr); procedure DeleteTrace(var t: tracePtr);
procedure GetStart(var traceStart: tracePtr; t: tracePtr); procedure GetStart(var traceStart: tracePtr; a: tracePtr);
implementation implementation
@ -36,8 +36,13 @@ begin
GetLength := 1 + GetLength(t^.prev) GetLength := 1 + GetLength(t^.prev)
end; end;
procedure GetStart(var traceStart: tracePtr; t: tracePtr); procedure GetStart(var traceStart: tracePtr; a: tracePtr);
var
t: tracePtr;
begin begin
if a = nil then
exit;
t := a;
while t <> nil do while t <> nil do
begin begin
if t^.prev = nil then if t^.prev = nil then
@ -161,10 +166,12 @@ begin
end; end;
function function
TraceCrossed(prevX, prevY: integer; var cr: creature; t: tracePtr): boolean; TraceCrossed(pX, pY: integer; var cr: creature; t: tracePtr): boolean;
var var
dX, dY: integer; dX, dY, prevX, prevY: integer;
begin begin
prevX := pX;
prevY := pY;
dX := Signum(cr.curX, prevX); dX := Signum(cr.curX, prevX);
dY := Signum(cr.curY, prevY); dY := Signum(cr.curY, prevY);
while (prevX <> cr.curX) and (prevY <> cr.curY) do while (prevX <> cr.curX) and (prevY <> cr.curY) do