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

Merge pull request 'feat/TD-012-add-pause' (#11) from dev into main

Browse Source 
Reviewed-on: #11
This commit is contained in:
gre-ilya 2026-02-28 11:28:55 +00:00
commit 2b302ab82e
6 changed files with 336 additions and 140 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/arena_graphics_m.pas
View File

@ -21,6 +21,7 @@ procedure DrawArenaEdges;
procedure DrawEdge(x, y: integer; var a: arena);
procedure DrawLevel;
procedure DrawRectangle(x0, y0, h, w: integer);
procedure DrawInterface;
implementation

44
src/ascii_arts_m.pas
View File

@ -6,7 +6,6 @@ const
DigitHeight = 5;
DigitWidth = 5;
DigitsAscii: array[0..9] of array[1..DigitHeight] of string = (
(
'@@@@@',
'@ @',
@ -78,6 +77,7 @@ const
'@@@@@'
)
);
GameNameHeight = 6;
GameNameWidth = 58;
GameNameAscii: array[1..GameNameHeight] of string = (
@ -122,6 +122,7 @@ const
);
ContinueHeight = 6;
ContinueWidth = 41;
ContinueAscii: array[1..ContinueHeight] of string = (
' _____ _ _ ',
' / ____| | | (_) ',
@ -144,6 +145,36 @@ const
' |___/'
);
PauseHeight = 22;
PauseWidth = 76;
{ Too long strings :(, lets following linux styleguide }
PauseAscii: array[1..PauseHeight] of string = (
' _',
' | |',
' _ __ __ _ _ _ ___ ___ __| |',
' | ''_ \ / _` | | | / __|/ _ \/ _` |',
' | |_) | (_| | |_| \__ \ __/ (_| |',
' | .__/ \__,_|\__,_|___/\___|\__,_| ',
' | | ',
' |_| _ _',
' | | (_)',
' ___ _ __ __ _ __ ___ ______ ___ ___ _ __ | |_ _ _ __ _ _ ___',
'/ __| ''_ \ / _` |/ __/ _ \ |______| / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \',
'\__ \ |_) | (_| | (_| __/ | (_| (_) | | | | |_| | | | | |_| | __/',
'|___/ .__/ \__,_|\___\___| \___\___/|_| |_|\__|_|_| |_|\__,_|\___|',
' | |',
' |_| _ _ _',
' (_) | | |',
' __ _ ______ __ _ _ _ _| |_ | |_ ___ _ __ ___ ___ _ __ _ _',
' / _` | |______| / _` | | | | | __| | __/ _ \ | ''_ ` _ \ / _ \ ''_ \| | | |',
'| (_| | | (_| | |_| | | |_ | || (_) | | | | | | | __/ | | | |_| |',
' \__, | \__, |\__,_|_|\__| \__\___/ |_| |_| |_|\___|_| |_|\__,_|',
' | | | |',
' |_| |_|'
);
YesHeight = 6;
YesAscii: array[1..YesHeight] of string = (
' _ _ ___ ___',
@ -163,11 +194,20 @@ const
'|_| |_|\___/'
);
HamsterHeight = 5;
HamsterWidth = 7;
HamsterStayAscii: array[1..HamsterHeight] of string = (
' (\_/)',
'( o_o )',
'( 0_0 )',
'/-----\',
' |___|',
' / \'
);
HamsterGGAscii: array[1..HamsterHeight] of string = (
' (\_/)',
'( G_G )',
'/-----\',
' |___|',
' / \'

207
src/game_m.pas
View File

@ -3,32 +3,34 @@ unit game_m;
interface
type
state = (gameExit, gameMenu, gamePause, gameLevel);
state = (gameExit, gameMenu, gameScore, gameInfo,
gamePause, gameLevel, gameOver);
menuState = (menuNewGame, menuHighScore, menuKeyInfo, menuContinue);
exitState = (exitYes, exitNo);
gameState = record
curExit: exitState;
curMenu: menuState;
curState: state;
hamsterAlive: boolean;
score, life, speedBonus, slowBonus: integer;
shutdown: boolean
score, level, life, speedBonus, slowBonus: integer;
shutdown, continueAllowed: boolean
end;
procedure DecreaseLife(var g: gameState);
procedure GameOver(var g: gameState);
procedure RunGameover(var g: gameState);
procedure InitGame(var g: gameState);
procedure NextExitState(var g: gameState);
procedure NextMenuState(var g: gameState);
procedure PreviousExitState(var g: gameState);
procedure PreviousMenuState(var g: gameState);
procedure RunLevel(var g: gameState);
procedure RunExit(var g: gameState);
procedure RunMenu(var g: gameState);
procedure RunState(var g: gameState);
implementation
uses crt, arena_graphics_m, graphics_m, keys_m;
uses arena_m, arena_graphics_m, crt, creature_m, ghost_m, graphics_m,
hamster_m, keys_m, trace_m;
const
StartScore = 0;
@ -37,18 +39,7 @@ const
StartSpeedBonus = 0;
StartSlowBonus = 0;
KeyDelayMs = 25;
procedure InitGame(var g: gameState);
begin
g.score := StartScore;
g.life := StartLifes;
g.speedBonus := StartSpeedBonus;
g.slowBonus := StartSlowBonus;
g.hamsterAlive := true;
g.curState := gameMenu;
g.curMenu := menuNewGame;
g.shutdown := false
end;
LevelDelayMs = 100;
procedure DecreaseLife(var g: gameState);
begin
@ -56,30 +47,24 @@ begin
DrawLifes(g)
end;
procedure RunMenu(var g: gameState);
procedure InitGame(var g: gameState);
begin
g.continueAllowed := false;
g.curMenu := menuNewGame;
g.curState := gameMenu;
DrawMenu(g);
while g.curState = gameMenu do
begin
delay(KeyDelayMs);
if keypressed then
HandleMenuKey(g);
if g.shutdown then
break;
if g.curState = gameExit then
begin
g.curState := gameMenu;
DrawMenu(g)
end
end
g.hamsterAlive := true;
g.level := 1;
g.life := StartLifes;
g.score := StartScore;
g.shutdown := false;
g.slowBonus := StartSlowBonus;
g.speedBonus := StartSpeedBonus
end;
procedure RunExit(var g: gameState);
var
keep: boolean = true;
begin
g.curState := gameExit;
DrawExit(g);
while keep do
begin
@ -90,8 +75,149 @@ begin
EraseExit
end;
procedure RunScore(var g: gameState);
begin
end;
procedure RunInfo(var g: gameState);
var
keep: boolean = true;
begin
DrawInfo;
while keep do
begin
delay(KeyDelayMs);
if keypressed then
HandleInfoKey(keep, g)
end
end;
procedure RunPause(var g: gameState);
var
keep: boolean = true;
begin
DrawPause(g);
while keep do
begin
delay(KeyDelayMs);
if keypressed then
HandlePauseKey(keep, g)
end
{ErasePause(g)}
end;
procedure RunGameover(var g: gameState);
begin
end;
procedure RunLevel(var g: gameState);
var
h, ghost: creature;
a: arena;
t: tracePtr = nil;
continueLevel: boolean = true;
begin
InitArena(a);
InitHamster(h);
InitGhost(ghost);
DrawInterface;
DrawCreature(h);
DrawCreature(ghost);
DrawScore(g);
DrawLifes(g);
while continueLevel do
begin
delay(LevelDelayMs);
if ArenaSplited(h, t, a) then
begin
SetArenaBorder(t, a);
CutSmallerPart(h, t, a)
end;
if ghost.alive then
MakeEnemyStep(ghost, h, t, a);
while ghost.alive and GhostShouldTurn(ghost, a) do
TurnGhost(ghost, a);
if not h.alive then
begin
if g.life >= 0 then
begin
DecreaseLife(g);
KillHamster(h, t, a);
h.alive := true
end
else
begin
RunGameover(g)
end
end;
if keypressed then
HandleLevelKey(h, a, t, g);
if not HamsterStepPossible(h, t, a) then
StopCreature(h);
if not ((h.dX = 0) and (h.dY = 0)) then
MakeHamsterStep(h, t, a);
if ghost.alive and a.captured[ghost.curX][ghost.curY] then
KillCreature(ghost);
if g.curState = gamePause then
break
end;
end;
procedure RunMenu(var g: gameState);
var
prevMenu: boolean = false;
begin
g.curState := gameMenu;
while g.curState = gameMenu do
begin
if (g.curState = gameMenu) and not prevMenu then
begin
DrawMenu(g);
prevMenu := true
end;
delay(KeyDelayMs);
if keypressed then
HandleMenuKey(g);
if (g.curState <> gameMenu) and prevMenu then
begin
EraseMenu;
prevMenu := false
end;
if (g.curState <> gameMenu) then
if g.shutdown then
break
end
end;
procedure RunState(var g: gameState);
begin
while not g.shutdown do
begin
case g.curState of
gameExit:
RunExit(g);
gameScore:
RunScore(g);
gameInfo:
RunInfo(g);
gamePause:
RunPause(g);
gameLevel:
RunLevel(g);
gameOver:
RunGameover(g);
gameMenu:
RunMenu(g)
end
end;
EraseAll
end;
procedure PreviousMenuState(var g: gameState);
begin
if (g.curMenu = menuNewGame) and not g.continueAllowed then
g.curMenu := menuKeyInfo
else
if g.curMenu = menuNewGame then
g.curMenu := menuContinue
else
@ -100,10 +226,15 @@ end;
procedure NextMenuState(var g: gameState);
begin
if g.curMenu = menuContinue then
if (g.curMenu = menuKeyInfo) and not g.continueAllowed or
(g.curMenu = menuContinue) then
begin
g.curMenu := menuNewGame
end
else
begin
g.curMenu := succ(g.curMenu)
end
end;
procedure NextExitState(var g: gameState);
@ -122,8 +253,4 @@ begin
g.curExit := pred(g.curExit)
end;
procedure GameOver(var g: gameState);
begin
end;
end.

71
src/gohamster.pas
View File

@ -1,58 +1,23 @@
program go_hamster;
uses crt, arena_m, arena_graphics_m, trace_m, creature_m, graphics_m,
hamster_m, keys_m, ghost_m, game_m, debug_m;
uses crt, keys_m, arena_graphics_m, graphics_m, game_m, debug_m;
const
DelaySizeMs = 100;
procedure RunLevel(var game: gameState);
var
h, g: creature;
a: arena;
t: tracePtr = nil;
continueLevel: boolean = true;
function IsTerminalValid: boolean;
begin
InitArena(a);
InitHamster(h);
InitGhost(g);
DrawCreature(h);
DrawCreature(g);
DrawScore(game);
DrawLifes(game);
IsTerminalValid := (ScreenWidth >= ScreenW) and (ScreenHeight >= ScreenH)
end;
while continueLevel do
procedure PrintTerminalHelp;
begin
writeln('Increase your terminal size and try again.');
if ScreenWidth < ScreenW then
begin
delay(DelaySizeMs);
if ArenaSplited(h, t, a) then
begin
SetArenaBorder(t, a);
CutSmallerPart(h, t, a)
end;
if g.alive then
MakeEnemyStep(g, h, t, a);
while g.alive and GhostShouldTurn(g, a) do
TurnGhost(g, a);
if not h.alive then
begin
if game.life >= 0 then
begin
DecreaseLife(game);
KillHamster(h, t, a);
h.alive := true
end
else
begin
GameOver(game)
end
end;
if keypressed then
HandleKey(h, continueLevel, a, t);
if not HamsterStepPossible(h, t, a) then
StopCreature(h);
if not ((h.dX = 0) and (h.dY = 0)) then
MakeHamsterStep(h, t, a);
if g.alive and a.captured[g.curX][g.curY] then
KillCreature(g)
writeln('Your terminal width: ', ScreenWidth,
'. Required: ', ScreenW, '.')
end;
if ScreenHeight < ScreenH then
begin
writeln('Your terminal height: ', ScreenHeight,
'. Required: ', ScreenH, '.')
end
end;
@ -65,9 +30,7 @@ begin
exit
end;
InitGame(g);
{RunLevel(g);}
clrscr;
RunMenu(g);
clrscr
EraseAll;
RunState(g)
end.

66
src/graphics_m.pas
View File

@ -4,23 +4,24 @@ interface
uses arena_graphics_m, arena_m, creature_m, hamster_m, trace_m, game_m;
function IsTerminalValid: boolean;
procedure DrawAfterStep(var cr: creature; var a: arena);
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena);
procedure DrawCreature(var cr: creature);
procedure DrawExitState(s: exitState);
procedure DrawExit(var g: gameState);
procedure DrawPause(var g: gameState);
procedure DrawInfo;
procedure DrawLifes(var g: GameState);
procedure DrawMenuState(s: menuState);
procedure DrawMenu(var g: gameState);
procedure DrawScore(var g: GameState);
procedure EraseAll;
procedure EraseExit;
procedure EraseExitState(s: exitState);
procedure EraseMenu;
procedure EraseMenuState(s: menuState);
procedure EraseStepTrace(var hamster: creature; t: tracePtr);
procedure EraseTrace(t: tracePtr; var a: arena);
procedure PrintTerminalHelp;
implementation
@ -52,29 +53,11 @@ const
ExitHamsterY = ExitYesY;
HamsterYesX = ExitYesX - HamsterWidth - MenuWidthPadding;
HamsterNoX = ExitNoX - HamsterWidth - MenuWidthPadding;
PauseXMargin = 3 * WidthCoefficient;
PauseYMargin = 1;
var
firstMenuDraw: boolean = true;
function IsTerminalValid: boolean;
begin
IsTerminalValid := (ScreenWidth >= ScreenW) and (ScreenHeight >= ScreenH)
end;
procedure PrintTerminalHelp;
begin
writeln('Increase your terminal size and try again.');
if ScreenWidth < ScreenW then
begin
writeln('Your terminal width: ', ScreenWidth,
'. Required: ', ScreenW, '.')
end;
if ScreenHeight < ScreenH then
begin
writeln('Your terminal height: ', ScreenHeight,
'. Required: ', ScreenH, '.')
end
end;
procedure EraseTrace(t: tracePtr; var a: arena);
begin
while t <> nil do
@ -276,11 +259,6 @@ begin
DrawNumber(killBarX, g.score)
end;
procedure EraseAll;
begin
FillRectangle(2, 2, (ScreenW - 2) * WidthCoefficient, ScreenH - 2, ' ')
end;
procedure DrawMenuState(s: menuState);
begin
case s of
@ -313,6 +291,9 @@ begin
DrawAscii(GameNameX, HighScoreY, HighScoreHeight, HighScoreAscii);
DrawAscii(GameNameX, KeyInfoY, KeyInfoHeight, KeyInfoAscii);
DrawAscii(GameNameX, ContinueY, ContinueHeight, ContinueAscii);
if not g.continueAllowed then
FillRectangle(GameNameX, ContinueY + ContinueHeight div 2,
ContinueWidth, 1, '-');
DrawMenuState(g.curMenu)
end;
@ -334,6 +315,11 @@ begin
end
end;
procedure EraseAll;
begin
EraseRectangle(1, 1, ScreenW * WidthCoefficient, ScreenH)
end;
procedure EraseMenu;
begin
EraseRectangle(MenuHamsterX, GameNameY,
@ -346,13 +332,33 @@ begin
case s of
exitYes:
DrawAscii(HamsterYesX, ExitHamsterY,
HamsterHeight, HamsterStayAscii);
HamsterHeight, HamsterGGAscii);
exitNo:
DrawAscii(HamsterNoX, ExitHamsterY,
HamsterHeight, HamsterStayAscii)
end
end;
procedure DrawPause(var g: gameState);
var
pauseX: integer = (ScreenW * WidthCoefficient - PauseWidth) div 2;
pauseY: integer = (ScreenH - PauseHeight) div 2;
begin
EraseRectangle(pauseX - PauseXMargin,
pauseY - PauseYMargin,
PauseWidth + PauseXMargin * 2 - 1,
PauseHeight + PauseYMargin * 2 + 1);
DrawRectangle(pauseX - PauseXMargin,
pauseY - PauseYMargin,
PauseHeight + PauseYMargin * 2 + 1,
PauseWidth + PauseXMargin * 2);
DrawAscii(pauseX, pauseY, PauseHeight, PauseAscii)
end;
procedure ErasePause(var g: gameState);
begin
end;
procedure DrawExit(var g: gameState);
var
realX: integer = ScreenW * WidthCoefficient;
@ -363,6 +369,10 @@ begin
DrawExitState(g.curExit)
end;
procedure DrawInfo;
begin
end;
procedure EraseExitState(s: exitState);
begin
case s of

87
src/keys_m.pas
View File

@ -17,6 +17,14 @@ const
SpaceOrd = 32;
UpperNOrd = 78;
UpperYOrd = 89;
OneOrd = 49;
TwoOrd = 50;
ThreeOrd = 51;
FourOrd = 52;
UpperQOrd = 81;
LowerQOrd = 113;
{ Debug }
BOrd = 98;
COrd = 99;
@ -25,9 +33,11 @@ const
procedure GetKey(var keyCode: integer);
procedure HandleExitKey(var keep: boolean; var g: gameState);
procedure HandleKey(var h: creature; var continueLevel: boolean;
var a: arena; var t: tracePtr);
procedure HandleLevelKey(var h: creature; var a: arena;
var t: tracePtr; var g: gameState);
procedure HandleMenuKey(var g: gameState);
procedure HandleInfoKey(var keep: boolean; var g: gameState);
procedure HandlePauseKey(var keep: boolean; var g: gameState);
implementation
@ -67,8 +77,8 @@ begin
end
end;
procedure HandleKey(var h: creature; var continueLevel: boolean;
var a: arena; var t: tracePtr);
procedure HandleLevelKey(var h: creature; var a: arena;
var t: tracePtr; var g: gameState);
var
k: integer;
begin
@ -92,8 +102,12 @@ begin
begin
ChangeHamsterDelta(k, h)
end;
if (k = EscOrd) or (k = CtrlCOrd) then
if k = EscOrd then
g.curState := gamePause
{
if k = CtrlCOrd then
continueLevel := false
}
end;
procedure ChangeMenuState(k: integer; var g: gameState);
@ -106,6 +120,22 @@ begin
end
end;
procedure ChooseMenuOption(k: integer; var g: gameState);
begin
if (k = FourOrd) and not g.continueAllowed then
exit;
case k of
OneOrd:
g.curState := gameLevel;
TwoOrd:
g.curState := gameScore;
ThreeOrd:
g.curState := gameInfo;
FourOrd:
g.curState := gameLevel
end
end;
procedure HandleMenuKey(var g: gameState);
var
k: integer;
@ -116,14 +146,11 @@ begin
EraseMenuState(g.curMenu);
ChangeMenuState(k, g);
DrawMenuState(g.curMenu)
end
else
end;
if (k = OneOrd) or (k = TwoOrd) or (k = ThreeOrd) or (k = FourOrd) then
ChooseMenuOption(k, g);
if k = EscOrd then
begin
g.curState := gameExit;
EraseMenu;
RunExit(g)
end
g.curState := gameExit
end;
procedure ChangeExitState(k: integer; var g: gameState);
@ -148,18 +175,46 @@ begin
DrawExitState(g.curExit);
exit
end;
if k = EnterOrd then
if (k = EnterOrd) or (k = SpaceOrd) then
begin
if g.curExit = exitYes then
g.shutdown := true
else
g.curExit := exitYes;
keep := false
end;
if (k = UpperYOrd) or (k = LowerYOrd) then
if (k = UpperYOrd) or (k = LowerYOrd) or (k = OneOrd) then
begin
g.shutdown := true;
if (k = UpperNOrd) or (k = LowerNOrd) or (k = EscOrd) then
keep := false
end;
if (k = UpperNOrd) or (k = LowerNOrd) or (k = EscOrd) or (k = TwoOrd) then
begin
g.curExit := exitYes;
keep := false
keep := false
end;
g.curState := gameMenu
end;
procedure HandlePauseKey(var keep: boolean; var g: gameState);
var
k: integer;
begin
GetKey(k);
if (k = EscOrd) or (k = SpaceOrd) then
begin
g.curState := gameLevel;
keep := false
end;
if (k = UpperQOrd) or (k = LowerQOrd) then
begin
g.curState := gameMenu;
keep := false
end
end;
procedure HandleInfoKey(var keep: boolean; var g: gameState);
begin
end;
end.