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

feat/TD-013-gameover-banner

Browse Source
This commit is contained in:
gre-ilya 2026-02-28 16:30:38 +05:00
parent 29131f49ae
commit 7b8b7adb01
12 changed files with 657 additions and 306 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
src/arena_graphics_m.pas
View File

@ -5,21 +5,27 @@ interface
uses arena_m, creature_m;
const
ArenaSymbol = ' ';
BorderSize = 1;
BorderSymbol = '|';
BorderSymbolX = '|';
MidCellDelimiter = '_';
BorderSymbolY = '|';
CaptureSymbol = '.';
CellSize = 2;
LifeBarX = 33;
ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 82 }
InterfaceBarH = ScreenW - ArenaH * CellSize - BorderSize * 2; { 14 }
InterfaceCellW = ScreenW div 3;
InterfaceH = 6;
ScreenH = (ArenaH + InterfaceH) * CellSize + BorderSize;
ScreenH = (ArenaW + InterfaceH) * CellSize + BorderSize;
ScreenW = (ArenaH - 1) * CellSize + BorderSize * 2; { 82 }
InterfaceBarH = ScreenW - ArenaW * CellSize - BorderSize * 2; { 14 }
InterfaceCellW = ScreenW div 3;
LifeBarX = 33;
WidthCoefficient = 2;
procedure DrawArenaBorders(var a: arena);
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
procedure DrawArenaEdges;
procedure DrawEdge(x, y: integer; var a: arena);
procedure DrawLevel;
procedure DrawLevelInterface;
procedure DrawRectangle(x0, y0, h, w: integer);
procedure DrawInterface;
@ -27,13 +33,13 @@ implementation
uses crt, math_m;
procedure DrawLineX(x, y, len: integer);
procedure DrawLineX(x, y, len: integer; ch: char);
var
i: integer;
begin
GotoXY(x, y);
for i := 1 to len do
write(BorderSymbolX);
write(ch);
GotoXY(1, 1)
end;
@ -53,7 +59,7 @@ procedure DrawRectangle(x0, y0, h, w: integer);
var
i: integer;
begin
DrawLineX(x0, y0, w);
DrawLineX(x0, y0, w, BorderSymbolX);
for i := 1 to h - 2 do
begin
GotoXY(x0, y0 + i);
@ -61,13 +67,17 @@ begin
GotoXY(x0 + w - 1, y0 + i);
write(BorderSymbolY)
end;
DrawLineX(x0, y0 + h - 1, w);
DrawLineX(x0, y0 + h - 1, w, BorderSymbolX);
GotoXY(1, 1)
end;
procedure DrawInterface;
begin
DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient);
DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient, BorderSymbolX);
DrawLineX(InterfaceCellW * WidthCoefficient,
InterfaceBarH div 2,
InterfaceCellW * WidthCoefficient + 1, MidCellDelimiter);
DrawLineY(InterfaceCellW * WidthCoefficient, 1, InterfaceBarH);
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1, InterfaceBarH)
end;
@ -97,7 +107,7 @@ procedure DrawLeftEdge(y: integer);
var
terminalY: integer;
begin
y := Clamp(y, 1, ArenaH);
y := Clamp(y, 1, ArenaW);
terminalY := InterfaceBarH + (y - 1) * CellSize;
DrawLineY(1, terminalY, CellSize)
end;
@ -106,7 +116,7 @@ procedure DrawRightEdge(y: integer);
var
terminalY: integer;
begin
y := Clamp(y, 1, ArenaH);
y := Clamp(y, 1, ArenaW);
terminalY := InterfaceBarH + (y - 1) * CellSize;
DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize)
end;
@ -115,28 +125,29 @@ procedure DrawUpperEdge(x: integer);
var
terminalX, sizeX: integer;
begin
x := Clamp(x, 1, ArenaW);
x := Clamp(x, 1, ArenaH);
terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH, sizeX)
DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbolX)
end;
procedure DrawLowerEdge(x: integer);
var
terminalX, sizeX: integer;
begin
x := Clamp(x, 1, ArenaW);
x := Clamp(x, 1, ArenaH);
terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH + ArenaH * CellSize - 1, sizeX)
DrawLineX(terminalX, InterfaceBarH + ArenaW * CellSize - 1,
sizeX, BorderSymbolX)
end;
procedure DrawArenaBorders(var a: arena);
var
i, j: integer;
begin
for i := 1 to ArenaH do
for j := 1 to ArenaW do
for i := 1 to ArenaW do
for j := 1 to ArenaH do
if a.borders[j][i] then
DrawArenaCell(j, i, BorderSymbol)
end;
@ -149,15 +160,15 @@ begin
DrawArenaCell(x, y, ArenaSymbol);
if x = 1 then
DrawLeftEdge(y);
if x = ArenaW then
if x = ArenaH then
DrawRightEdge(y);
if y = 1 then
DrawUpperEdge(x);
if y = ArenaH then
if y = ArenaW then
DrawLowerEdge(x)
end;
procedure DrawLevel;
procedure DrawLevelInterface;
begin
clrscr;
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient);

126
src/arena_m.pas
View File

@ -2,24 +2,22 @@ unit arena_m;
interface
uses creature_m, game_m, trace_m;
uses creature_m, trace_m;
const
ArenaH = 33;
ArenaW = 41;
CaptureSymbol = '.';
BorderSymbolX = '|'; {Later can change on '-'}
BorderSymbolY = '|';
BorderSymbol = '|';
ArenaSymbol = ' ';
ArenaW = 33;
ArenaH = 41;
RandomCutThreshold = 20;
RandomOneToOne = 2;
type
arenaMatrix = array [1..ArenaW, 1..ArenaH] of boolean;
arenaMatrix = array [1..ArenaH, 1..ArenaW] of boolean;
arena = record
captured, borders: arenaMatrix;
end;
function ArenaCellCaptured(x, y: integer; var a: arena): boolean;
function ArenaSplited(var h: creature; var t: tracePtr; var a: arena): boolean;
function GhostShouldTurn(var g: creature; var a: arena): boolean;
function
@ -27,7 +25,8 @@ HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean;
function IsOnBorder(var x, y: integer; var a: arena): boolean;
function IsOnEdge(var cr: creature): boolean;
function IsOnEdge(x, y: integer): boolean;
procedure CutSmallerPart(var hamster: creature; var t: tracePtr; var a: arena);
procedure CutPart(var hamster: creature; var t: tracePtr;
var cutOff: integer; var a: arena);
procedure InitArena(var a: arena);
procedure MakeEnemyStep(var e, h: creature; t: tracePtr; var a: arena);
procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
@ -42,8 +41,8 @@ procedure Fill(var m: arenaMatrix; val: boolean);
var
i, j: integer;
begin
for i := 1 to ArenaW do
for j := 1 to ArenaH do
for i := 1 to ArenaH do
for j := 1 to ArenaW do
m[i][j] := val
end;
@ -56,8 +55,8 @@ 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
(x <> 0) and (x <> ArenaH + 1) and
(y <> 0) and (y <> ArenaW + 1) and
not a.captured[x][y] and not a.borders[x][y]
end;
@ -125,7 +124,8 @@ begin
GetFigureArea := result
end;
procedure CutPart(var partCell: cellItem; var a: arena);
procedure
CutChosenPart(var partCell: cellItem; var a: arena; var cutOff: integer);
var
cellPtr: cellItemPtr;
cell: cellItem;
@ -140,6 +140,7 @@ begin
QCellPop(captureQ);
if a.captured[cell.x][cell.y] then
continue;
cutOff := cutOff + 1;
a.captured[cell.x][cell.y] := true;
DrawArenaCell(cell.x, cell.y, CaptureSymbol);
AddAvailableNeighbours(captureQ, cell, a)
@ -148,12 +149,12 @@ end;
function OnEdgeX(x: integer): boolean;
begin
OnEdgeX := (x = 1) or (x = ArenaW)
OnEdgeX := (x = 1) or (x = ArenaH)
end;
function OnEdgeY(y: integer): boolean;
begin
OnEdgeY := (y = 1) or (y = ArenaH)
OnEdgeY := (y = 1) or (y = ArenaW)
end;
function IsOnEdge(x, y: integer): boolean;
@ -195,14 +196,17 @@ begin
DrawArenaCell(x, y, CaptureSymbol)
end;
procedure CaptureCutBorders(var a: arena); { rename, slow }
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
for i := 1 to ArenaW do
for j := 1 to ArenaH do
if a.borders[j][i] and ArenaCellCaptured(j, i, a) then
begin
cutOff := cutOff + 1;
CaptureArenaBorder(j, i, a)
end;
end;
procedure SetArenaBorder(var t: tracePtr; var a: arena);
@ -217,8 +221,8 @@ end;
function IsOnEdge(var cr: creature): boolean;
begin
IsOnEdge :=
(cr.curX = 1) or (cr.curX = ArenaW) or (cr.curY = 1) or
(cr.curY = ArenaH)
(cr.curX = 1) or (cr.curX = ArenaH) or (cr.curY = 1) or
(cr.curY = ArenaW)
end;
function IsOnBorder(var x, y: integer; var a: arena): boolean;
@ -267,12 +271,29 @@ begin
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; {Should be 100 or OneHundred? It's A.V.Stolyarov to decide!!!}
biggerProcent := v2 / 100;
LowerToBiggerRatio := Round(100 - v1 / biggerProcent)
end;
function StepOnTrace(var hamster: creature; var t: tracePtr): boolean;
var
nextX, nextY, idx: integer;
begin
nextX := Clamp(hamster.curX + hamster.dX, 1, ArenaW);
nextY := Clamp(hamster.curY + hamster.dY, 1, ArenaH);
nextX := Clamp(hamster.curX + hamster.dX, 1, ArenaH);
nextY := Clamp(hamster.curY + hamster.dY, 1, ArenaW);
idx := FindIndex(t, nextX, nextY, 1);
StepOnTrace := idx > PreviousTraceIdx
end;
@ -280,26 +301,53 @@ end;
function StepBeyondEdge(var cr: creature): boolean;
begin
StepBeyondEdge :=
(cr.dX > 0) and (cr.curX = ArenaW) or
(cr.dX > 0) and (cr.curX = ArenaH) or
(cr.dX < 0) and (cr.curX = 1) or
(cr.dY > 0) and (cr.curY = ArenaH) or
(cr.dY > 0) and (cr.curY = ArenaW) or
(cr.dY < 0) and (cr.curY = 1)
end;
procedure CutSmallerPart(var hamster: creature; var t: tracePtr; var a: arena);
var {refactor?}
area1, area2: integer;
part1, part2, smallerFigure: cellItem;
function RandomBool: boolean;
begin
if Random(RandomOneToOne) = 1 then
RandomBool := true
else
RandomBool := false
end;
function ChooseRandomCell(p1, p2: cellItem): cellItem;
var
rb: boolean;
begin
rb := RandomBool;
if rb then
ChooseRandomCell := p1
else
ChooseRandomCell := p2
end;
{refactor? pass just level later}
procedure CutPart(var hamster: creature; var t: tracePtr;
var cutOff: integer; var a: arena);
var
area1, area2, diffProcent: integer;
part1, part2, cutFigure: cellItem;
begin
GetPartsCells(t, part1, part2, a);
area1 := GetFigureArea(part1, a);
area2 := GetFigureArea(part2, a);
if area1 <= area2 then
smallerFigure := part1
diffProcent := LowerToBiggerRatio(area1, area2);
if diffProcent <= RandomCutThreshold then
cutFigure := ChooseRandomCell(part1, part2)
else
smallerFigure := part2;
CutPart(smallerFigure, a);
CaptureCutBorders(a);
if area1 <= area2 then
cutFigure := part1
else
cutFigure := part2;
CutChosenPart(cutFigure, a, cutOff);
CaptureCutBorders(a, cutOff);
DrawArenaBorders(a);
DrawArenaEdges;
DrawCreature(hamster);
@ -311,10 +359,10 @@ 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);
nextX := Clamp(h.curX + h.dX, 1, ArenaH);
nextY := Clamp(h.curY + h.dY, 1, ArenaW);
midX := Clamp(h.curX + (h.dX div 2), 1, ArenaH);
midY := Clamp(h.curY + (h.dY div 2), 1, ArenaW);
HamsterStepPossible :=
not StepOnTrace(h, t)
and (not a.captured[midX][midY] or IsOnEdge(nextX, nextY))

208
src/ascii_arts_m.pas
View File

@ -78,27 +78,30 @@ const
)
);
GameNameHeight = 6;
GameNameWidth = 58;
GameNameAscii: array[1..GameNameHeight] of string = (
GameMenuHeight = 44;
GameMenuScreen: array[1..GameMenuHeight] of string = (
' _____ _ _ _ _',
' / ____| | | | | | | | |',
'| | __ ___ | | | |__| | __ _ _ __ ___ ___| |_ ___ _ __',
'| | |_ |/ _ \| | | __ |/ _` | ''_ ` _ \/ __| __/ _ \ ''__|',
'| |__| | (_) |_| | | | | (_| | | | | | \__ \ || __/ |',
' \_____|\___/(_) |_| |_|\__,_|_| |_| |_|___/\__\___|_|'
);
NewGameHeight = 6;
NewGameAscii: array[1..NewGameHeight] of string = (
' \_____|\___/(_) |_| |_|\__,_|_| |_| |_|___/\__\___|_|',
'',
'',
'',
'',
'',
'',
'',
'',
' _ _ _____',
'| \ | | / ____|',
'| \| | _____ __ | | __ __ _ _ __ ___ ___',
'| . ` |/ _ \ \ /\ / / | | |_ |/ _` | ''_ ` _ \ / _ \',
'| |\ | __/\ V V / | |__| | (_| | | | | | | __/',
'|_| \_|\___| \_/\_/ \_____|\__,_|_| |_| |_|\___|'
);
HighScoreHeight = 8;
HighScoreAscii: array[1..HighScoreHeight] of string = (
'|_| \_|\___| \_/\_/ \_____|\__,_|_| |_| |_|\___|',
'',
'',
' _ _ _ _ _____',
'| | | (_) | | / ____|',
'| |__| |_ __ _| |__ | (___ ___ ___ _ __ ___',
@ -106,11 +109,7 @@ const
'| | | | | (_| | | | | ____) | (_| (_) | | | __/',
'|_| |_|_|\__, |_| |_| |_____/ \___\___/|_| \___|',
' __/ |',
' |___/'
);
KeyInfoHeight = 8;
KeyInfoAscii: array[1..KeyInfoHeight] of string = (
' |___/',
' _ __ _____ __',
'| |/ / |_ _| / _|',
'| '' / ___ _ _ | | _ __ | |_ ___',
@ -118,12 +117,7 @@ const
'| . \ __/ |_| | _| |_| | | | || (_) |',
'|_|\_\___|\__, | |_____|_| |_|_| \___/',
' __/ |',
' |___/'
);
ContinueHeight = 6;
ContinueWidth = 41;
ContinueAscii: array[1..ContinueHeight] of string = (
' |___/',
' _____ _ _ ',
' / ____| | | (_) ',
'| | ___ _ __ | |_ _ _ __ _ _ ___ ',
@ -131,18 +125,35 @@ const
'| |___| (_) | | | | |_| | | | | |_| | __/',
' \_____\___/|_| |_|\__|_|_| |_|\__,_|\___|'
);
GameNameHeight = 6;
GameNameWidth = 58;
NewGameHeight = 6;
HighScoreHeight = 8;
MenuInfoHeight = 8;
ContinueHeight = 6;
ContinueWidth = 41;
ExitHeight = 8;
ExitScreenHeight = 16;
ExitWidth = 70;
ExitAscii: array[1..ExitHeight] of string = (
' ______ _ _ _ _ ___',
'| ____| (_) | | | | | |__ \',
'| |__ __ ___| |_ | |_| |__ ___ __ _ __ _ _ __ ___ ___ ) |',
'| __| \ \/ / | __| | __| ''_ \ / _ \ / _` |/ _` | ''_ ` _ \ / _ \/ /',
'| |____ > <| | |_ | |_| | | | __/ | (_| | (_| | | | | | | __/_|',
'|______/_/\_\_|\__| \__|_| |_|\___| \__, |\__,_|_| |_| |_|\___(_)',
' __/ |',
' |___/'
ExitHeight = 8;
ExitScreen: array[1..ExitScreenHeight] of string = (
' ______ _ _ _ _ ___',
'| ____| (_) | | | | | |__ \',
'| |__ __ ___| |_ | |_| |__ ___ __ _ __ _ _ __ ___ ___ ) |',
'| __| \ \/ / | __| | __| ''_ \ / _ \ / _` |/ _` | ''_ ` _ \ / _ \/ /',
'| |____ > <| | |_ | |_| | | | __/ | (_| | (_| | | | | | | __/_|',
'|______/_/\_\_|\__| \__|_| |_|\___| \__, |\__,_|_| |_| |_|\___(_)',
' __/ |',
' |___/',
'',
'',
' _ _ ___ ___ _ __ ___',
'| | | |/ _ \/ __| | ''_ \ / _ \',
'| |_| | __/\__ \ | | | | (_) |',
' \__, |\___||___/ |_| |_|\___/',
' __/ |',
' |___/'
);
PauseHeight = 22;
@ -157,45 +168,27 @@ const
' | |_) | (_| | |_| \__ \ __/ (_| |',
' | .__/ \__,_|\__,_|___/\___|\__,_| ',
' | | ',
' |_| _ _',
' | | (_)',
' ___ _ __ __ _ __ ___ ______ ___ ___ _ __ | |_ _ _ __ _ _ ___',
'/ __| ''_ \ / _` |/ __/ _ \ |______| / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \',
'\__ \ |_) | (_| | (_| __/ | (_| (_) | | | | |_| | | | | |_| | __/',
'|___/ .__/ \__,_|\___\___| \___\___/|_| |_|\__|_|_| |_|\__,_|\___|',
' | |',
' |_| _ _',
' | | (_)',
' ___ _ __ __ _ __ ___ ___ ___ _ __ | |_ _ _ __ _ _ ___',
'/ __| ''_ \ / _` |/ __/ _ \ ______ / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \',
'\__ \ |_) | (_| | (_| __/ |______| | (_| (_) | | | | |_| | | | | |_| | __/',
'|___/ .__/ \__,_|\___\___| \___\___/|_| |_|\__|_|_| |_|\__,_|\___|',
'====| |===================',
' |_| _ _ _',
' (_) | | |',
' __ _ ______ __ _ _ _ _| |_ | |_ ___ _ __ ___ ___ _ __ _ _',
' / _` | |______| / _` | | | | | __| | __/ _ \ | ''_ ` _ \ / _ \ ''_ \| | | |',
'| (_| | | (_| | |_| | | |_ | || (_) | | | | | | | __/ | | | |_| |',
' __ _ __ _ _ _ _| |_ | |_ ___ _ __ ___ ___ _ __ _ _',
' / _` | ______ / _` | | | | | __| | __/ _ \ | ''_ ` _ \ / _ \ ''_ \| | | |',
'| (_| | |______| | (_| | |_| | | |_ | || (_) | | | | | | | __/ | | | |_| |',
' \__, | \__, |\__,_|_|\__| \__\___/ |_| |_| |_|\___|_| |_|\__,_|',
' | | | |',
'====| |= | |',
' |_| |_|'
);
YesHeight = 6;
YesAscii: array[1..YesHeight] of string = (
' _ _ ___ ___',
'| | | |/ _ \/ __|',
'| |_| | __/\__ \',
' \__, |\___||___/',
' __/ |',
' |___/'
);
NoHeight = 4;
NoWidth = 13;
NoAscii: array[1..NoHeight] of string = (
' _ __ ___',
'| ''_ \ / _ \',
'| | | | (_) |',
'|_| |_|\___/'
);
HamsterHeight = 5;
HamsterWidth = 7;
HamsterStayAscii: array[1..HamsterHeight] of string = (
@ -213,6 +206,99 @@ const
' / \'
);
GameOverHeight = 40;
GameOverWidth = 62;
GameOverScreen: array[1..GameOverHeight] of string = (
' _____ __ __ ______ ',
' / ____| /\ | \/ | ____| ',
' | | __ / \ | \ / | |__ ',
' | | |_ | / /\ \ | |\/| | __| ',
' | |__| |/ ____ \| | | | |____ ',
' \_____/_/ \_\_| |_|______| ',
' ______ ________ _____ ',
' / __ \ \ / / ____| __ \ ',
' | | | \ \ / /| |__ | |__) | ',
' | | | |\ \/ / | __| | _ / ',
' | |__| | \ / | |____| | \ \ ',
' \____/ \/ |______|_| \_\ ',
' ',
' ____ ____ ',
' / o@@\ /@@o \ ',
' / /``\@\ __,-==-,__ /@/``\ \ ',
' / /` `||//\______/ \||` `\ \ ',
' | |` // __ __ \\ `| | ',
' \ \` (/ /;g\ /g;\ \) `/ | ',
' \_\__(( " .. " )____/_/ ',
' \ " __ " / ',
' @@@@@@(||)@@@@`@@`@@@@(||)@@@@@@@ ',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ',
' ',
' _ _ ___ ',
' | | (_) |__ \ ',
' ___ ___ _ __ | |_ _ _ __ _ _ ___ ) | ',
' / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \ / / ',
' | (_| (_) | | | | |_| | | | | |_| | __/ |_| ',
' \___\___/|_| |_|\__|_|_| |_|\__,_|\___| (_) ',
' ___ ___ __ ___ ___',
'| _| |_ | \ \ | _| |_ |',
'| | _ _ | | ___ ___ \ \ | | _ __ | | ___',
'| | | | | | | |/ _ \/ __| \ \ | | | ''_ \ | |/ _ \',
'| | | |_| | | | __/\__ \ \ \ | | | | | | | | (_) |',
'| |_ \__, | _| |\___||___/ \ \ | |_ |_| |_| _| |\___/',
'|___|=====/ |=|___| \_\ |___|=========|___|',
' |___/'
);
KeyInfoHeight = 42;
KeyInfoWidth = 98;
KeyInfoScreen: array[1..KeyInfoHeight] of string = (
' _',
' | |',
' _ __ ___ _____ _____ | | _____ _ _ ___ _',
' | ''_ ` _ \ / _ \ \ / / _ \ | |/ / _ \ | | / __| (_)',
' | | | | | | (_) \ V / __/ | < __/ |_| \__ \ _',
' |_| |_| |_|\___/ \_/ \___| |_|\_\___|\__, |___/ (_)',
' __/ |',
' _ |___/',
' / \',
' / . \',
' / / \ \',
' /_/| |\_\',
' | |',
' |_|',
' __ ========= __',
' / / (\_/) \ \',
' / /_____ ( 0_0 ) ______\ \ ',
' { ______| /-----\ |_______ }',
' \ \ |___| / /',
' \_\ / \ /_/',
' ========== _ ===========',
' | |',
' _ | | _ ',
' \ \| |/ /',
' \ \ / / ',
' \ ` / ',
' \_/',
' =========',
' _ _ _ ',
' | | | | | |',
' ___ _ __ __ _ ___ ___ ___| |_ ___ _ __ | |__ __ _ _ __ ___ ___| |_ ___ _ __',
' / __| ''_ \ / _` |/ __/ _ \ ______ / __| __/ _ \| ''_ \ | ''_ \ / _` | ''_ ` _ \/ __| __/ _ \ ''__|',
' \__ \ |_) | (_| | (_| __/ |______| \__ \ || (_) | |_) | | | | | (_| | | | | | \__ \ || __/ |',
' |___/ .__/ \__,_|\___\___| |___/\__\___/| .__/ |_| |_|\__,_|_| |_| |_|___/\__\___|_|',
' ====| |=================== | |',
' |_| |_|',
' ___ ___ ___ _ __ __ _ _ _ ___ ___',
' / _ \/ __|/ __| ______ | ''_ \ / _` | | | / __|/ _ \',
'| __/\__ \ (__ |______| | |_) | (_| | |_| \__ \ __/',
' \___||___/\___| | .__/ \__,_|\__,_|___/\___|',
'================ | |',
' |_|'
);
implementation
end.

4
src/creature_m.pas
View File

@ -39,8 +39,8 @@ 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)
cr.curX := Clamp(cr.curX + cr.dX, 1, ArenaH);
cr.curY := Clamp(cr.curY + cr.dY, 1, ArenaW)
end;
procedure KillCreature(var cr: creature);

4
src/debug_m.pas
View File

@ -38,9 +38,9 @@ procedure Print(var m: arenaMatrix);
var
i, j: integer;
begin
for i := 1 to ArenaH do
for i := 1 to ArenaW do
begin
for j := 1 to ArenaW do
for j := 1 to ArenaH do
if m[j][i] then
write(1, ' ')
else

215
src/game_m.pas
View File

@ -1,31 +1,30 @@
{ MainLoop -- main loop }
unit game_m;
interface
uses level_m;
type
state = (gameExit, gameMenu, gameScore, gameInfo,
gamePause, gameLevel, gameOver);
state = (gameExit, gameMenu, gameStartLevel, gameScore, gameKeyInfo,
gamePause, gameContinueLevel, gameOver);
menuState = (menuNewGame, menuHighScore, menuKeyInfo, menuContinue);
exitState = (exitYes, exitNo);
gameState = record
curExit: exitState;
curMenu: menuState;
curState: state;
hamsterAlive: boolean;
score, level, life, speedBonus, slowBonus: integer;
shutdown, continueAllowed: boolean
level: integer;
shutdown, continueAllowed: boolean;
end;
procedure DecreaseLife(var g: gameState);
procedure RunGameover(var g: gameState);
procedure DecreaseLife(var level: levelState);
procedure RunGameOver(var g: gameState; var level: levelState);
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 RunState(var g: gameState);
procedure MainLoop(var g: gameState);
implementation
@ -33,18 +32,13 @@ uses arena_m, arena_graphics_m, crt, creature_m, ghost_m, graphics_m,
hamster_m, keys_m, trace_m;
const
StartScore = 0;
StartLifes = 3;
BonusTurns = 45;
StartSpeedBonus = 0;
StartSlowBonus = 0;
KeyDelayMs = 25;
LevelDelayMs = 100;
procedure DecreaseLife(var g: gameState);
procedure DecreaseLife(var level: levelState);
begin
g.life := g.life - 1;
DrawLifes(g)
level.life := level.life - 1;
DrawLifes(level.life)
end;
procedure InitGame(var g: gameState);
@ -52,117 +46,134 @@ begin
g.continueAllowed := false;
g.curMenu := menuNewGame;
g.curState := gameMenu;
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
DrawExit(g);
while keep do
while g.curState = gameExit do
begin
delay(KeyDelayMs);
if keypressed then
HandleExitKey(keep, g)
HandleExitKey(g)
end;
EraseExit
end;
procedure RunScore(var g: gameState);
begin
end;
procedure RunInfo(var g: gameState);
var
keep: boolean = true;
begin
DrawInfo;
while keep do
{DrawHighScore;}
while g.curState = gameScore do
begin
delay(KeyDelayMs);
if keypressed then
HandleInfoKey(keep, g)
end
HandleScoreKey(g)
end;
end;
procedure RunKeyInfo(var g: gameState);
begin
DrawKeyInfo;
while g.curState = gameKeyInfo do
begin
delay(KeyDelayMs);
if keypressed then
HandleInfoKey(g)
end;
EraseKeyInfo
end;
procedure RunPause(var g: gameState);
var
keep: boolean = true;
begin
DrawPause(g);
while keep do
while g.curState = gamePause do
begin
delay(KeyDelayMs);
if keypressed then
HandlePauseKey(keep, g)
end
{ErasePause(g)}
HandlePauseKey(g)
end;
if g.curState = gameMenu then
EraseLevel;
if g.curState = gameContinueLevel then
ErasePause(g)
end;
procedure RunGameover(var g: gameState);
procedure RunGameOver(var g: gameState; var level: levelState);
begin
DrawGameOver;
while g.curState = gameOver do
begin
delay(KeyDelayMs);
if keypressed then
HandleGameOverKey(g)
end;
EraseGameOver;
if g.curState = gameContinueLevel then
InitLevel(level)
end;
procedure RunLevel(var g: gameState);
var
h, ghost: creature;
a: arena;
t: tracePtr = nil;
continueLevel: boolean = true;
procedure LevelLoop(var g: gameState; var level: levelState);
begin
InitArena(a);
InitHamster(h);
InitGhost(ghost);
DrawInterface;
DrawCreature(h);
DrawCreature(ghost);
DrawScore(g);
DrawLifes(g);
while continueLevel do
while level.continueLevel do
begin
delay(LevelDelayMs);
if ArenaSplited(h, t, a) then
if ArenaSplited(level.h, level.t, level.a) then
begin
SetArenaBorder(t, a);
CutSmallerPart(h, t, a)
SetArenaBorder(level.t, level.a);
CutPart(level.h, level.t, level.score, level.a);
DrawScore(level.score)
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
if level.g.alive then
MakeEnemyStep(level.g, level.h, level.t, level.a);
while level.g.alive and GhostShouldTurn(level.g, level.a) do
TurnGhost(level.g, level.a);
if not level.h.alive then
begin
if g.life >= 0 then
if level.life <= 0 then
begin
DecreaseLife(g);
KillHamster(h, t, a);
h.alive := true
end
else
begin
RunGameover(g)
end
g.curState := gameOver;
EraseLevel;
break
end;
DecreaseLife(level);
KillHamster(level.h, level.t, level.a);
level.h.alive := true
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);
HandleLevelKey(level.h, level.a, level.t, g);
if not HamsterStepPossible(level.h, level.t, level.a) then
StopCreature(level.h);
if not ((level.h.dX = 0) and (level.h.dY = 0)) then
MakeHamsterStep(level.h, level.t, level.a);
if level.g.alive and
level.a.captured[level.g.curX][level.g.curY] then
begin
KillCreature(level.g)
end;
if g.curState = gamePause then
break
end;
end;
procedure StartLevel(var g: gameState; var level: levelState);
begin
InitLevel(level);
DrawLevel(level);
LevelLoop(g, level)
end;
procedure ContinueLevel(var g: gameState; var level: levelState);
begin
DrawLevel(level);
LevelLoop(g, level)
end;
procedure RunMenu(var g: gameState);
var
prevMenu: boolean = false;
@ -189,7 +200,9 @@ begin
end
end;
procedure RunState(var g: gameState);
procedure MainLoop(var g: gameState);
var
level: levelState;
begin
while not g.shutdown do
begin
@ -198,14 +211,16 @@ begin
RunExit(g);
gameScore:
RunScore(g);
gameInfo:
RunInfo(g);
gameKeyInfo:
RunKeyInfo(g);
gamePause:
RunPause(g);
gameLevel:
RunLevel(g);
gameStartLevel:
StartLevel(g, level);
gameContinueLevel: {Maybe here should be gameStartLevel}
ContinueLevel(g, level);
gameOver:
RunGameover(g);
RunGameOver(g, level);
gameMenu:
RunMenu(g)
end
@ -213,30 +228,6 @@ begin
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
g.curMenu := pred(g.curMenu)
end;
procedure NextMenuState(var g: gameState);
begin
if (g.curMenu = menuKeyInfo) and not g.continueAllowed or
(g.curMenu = menuContinue) then
begin
g.curMenu := menuNewGame
end
else
begin
g.curMenu := succ(g.curMenu)
end
end;
procedure NextExitState(var g: gameState);
begin
if g.curExit = exitNo then

36
src/go.pas Normal file
View File

@ -0,0 +1,36 @@
program go_hamster;
uses crt, keys_m, arena_graphics_m, graphics_m, game_m, debug_m;
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;
var
g: gameState;
begin
if not IsTerminalValid then
begin
PrintTerminalHelp;
exit
end;
InitGame(g);
EraseAll;
MainLoop(g)
end.

2
src/gohamster.pas
View File

@ -31,6 +31,6 @@ begin
end;
InitGame(g);
EraseAll;
RunState(g)
MainLoop(g)
end.

156
src/graphics_m.pas
View File

@ -2,24 +2,30 @@ unit graphics_m;
interface
uses arena_graphics_m, arena_m, creature_m, hamster_m, trace_m, game_m;
uses arena_graphics_m, arena_m, creature_m, hamster_m, trace_m, game_m, level_m;
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 DrawGameOver;
procedure DrawKeyInfo;
procedure DrawLevel(var level: levelState);
procedure DrawLifes(n: integer);
procedure DrawMenuState(s: menuState);
procedure DrawMenu(var g: gameState);
procedure DrawScore(var g: GameState);
procedure DrawPause(var g: gameState);
procedure DrawScore(s: integer);
procedure EraseAll;
procedure EraseExit;
procedure EraseExitState(s: exitState);
procedure EraseGameOver;
procedure EraseKeyInfo;
procedure EraseLevel;
procedure EraseMenu;
procedure EraseMenuState(s: menuState);
procedure ErasePause(var g: gameState);
procedure EraseStepTrace(var hamster: creature; t: tracePtr);
procedure EraseTrace(t: tracePtr; var a: arena);
@ -30,31 +36,44 @@ uses crt, math_m, ascii_arts_m;
const
BigLetterWidth = 8;
DigitWidth = 6;
BorderN = 2;
GameNameX = ScreenW * WidthCoefficient div 3 + 4;
GameNameY = 12;
GameOverX = ScreenW * WidthCoefficient div 2 - GameNameWidth div 2;
GameOverY = ScreenH div 2 - GameOverHeight div 2;
NameHeightPadding = 8;
MenuHeightPadding = 2;
MenuWidthPadding = 4;
MenuHamsterX = GameNameX - HamsterWidth - MenuWidthPadding;
NewGameY = GameNameY + GameNameHeight + NameHeightPadding;
HighScoreY = NewGameY + NewGameHeight + MenuHeightPadding;
KeyInfoY = HighScoreY + HighScoreHeight;
ContinueY = KeyInfoY + KeyInfoHeight;
MenuInfoY = HighScoreY + HighScoreHeight;
KeyInfoX = ScreenW * WidthCoefficient div 2 - KeyInfoWidth div 2;
KeyInfoY = ScreenH div 2 - KeyInfoHeight div 2 - 1;
ContinueY = MenuInfoY + MenuInfoHeight;
InterfaceMarginX = InterfaceCellW div 4;
InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1;
LetterWidth = 5;
Notation = 10;
PunctuationWidth = 3;
SpaceWidth = 3;
ExitGameY = ScreenH div 2 - ExitHeight - MenuHeightPadding;
SpaceWidth = 1;
ExitGameY = (ScreenH - ExitScreenHeight) div 2 - MenuHeightPadding;
ExitYesX = MenuHamsterX;
ExitYesY = ExitGameY + ExitHeight + MenuHeightPadding;
ExitYesY = ExitGameY + ExitHeight - 1 + MenuHeightPadding;
ExitNoX = ScreenW * WidthCoefficient - ExitYesX - NoWidth;
ExitHamsterY = ExitYesY;
HamsterYesX = ExitYesX - HamsterWidth - MenuWidthPadding;
HamsterNoX = ExitNoX - HamsterWidth - MenuWidthPadding;
PauseXMargin = 3 * WidthCoefficient;
PauseYMargin = 1;
PauseXPadding = 3 * WidthCoefficient;
PauseYPadding = 1;
PauseX = (ScreenW * WidthCoefficient - PauseWidth) div 2;
PauseY = (ScreenH - PauseHeight) div 2;
ArenaPauseUpperMarginY = 7;
ArenaPauseLowerMarginY = 14;
ArenaPauseMarginX = 9;
var
firstMenuDraw: boolean = true;
@ -247,16 +266,16 @@ begin
end
end;
procedure DrawLifes(var g: GameState);
procedure DrawLifes(n: integer);
begin
DrawNumber(LifeBarX, g.life)
DrawNumber(LifeBarX, n)
end;
procedure DrawScore(var g: GameState);
procedure DrawScore(s: integer);
var
killBarX: integer = InterfaceCellW * 2 * WidthCoefficient + BorderSize;
begin
DrawNumber(killBarX, g.score)
DrawNumber(killBarX, s)
end;
procedure DrawMenuState(s: menuState);
@ -269,7 +288,7 @@ begin
DrawAscii(MenuHamsterX, HighScoreY + 1,
HamsterHeight, HamsterStayAscii);
menuKeyInfo:
DrawAscii(MenuHamsterX, KeyInfoY + 1,
DrawAscii(MenuHamsterX, MenuInfoY + 1,
HamsterHeight, HamsterStayAscii);
menuContinue:
DrawAscii(MenuHamsterX, ContinueY + 1,
@ -281,16 +300,12 @@ procedure DrawMenu(var g: gameState);
var
y: integer = GameNameY;
begin
if firstMenuDraw then
if firstMenuDraw then { REFACTOR LATER }
begin
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient);
firstMenuDraw := not firstMenuDraw
end;
DrawAscii(GameNameX, y, GameNameHeight, GameNameAscii);
DrawAscii(GameNameX, NewGameY, NewGameHeight, NewGameAscii);
DrawAscii(GameNameX, HighScoreY, HighScoreHeight, HighScoreAscii);
DrawAscii(GameNameX, KeyInfoY, KeyInfoHeight, KeyInfoAscii);
DrawAscii(GameNameX, ContinueY, ContinueHeight, ContinueAscii);
DrawAscii(GameNameX, y, GameMenuHeight, GameMenuScreen);
if not g.continueAllowed then
FillRectangle(GameNameX, ContinueY + ContinueHeight div 2,
ContinueWidth, 1, '-');
@ -307,7 +322,7 @@ begin
EraseRectangle(MenuHamsterX, HighScoreY + 1,
HamsterWidth, HamsterHeight);
menuKeyInfo:
EraseRectangle(MenuHamsterX, KeyInfoY + 1,
EraseRectangle(MenuHamsterX, MenuInfoY + 1,
HamsterWidth, HamsterHeight);
menuContinue:
EraseRectangle(MenuHamsterX, ContinueY + 1,
@ -340,37 +355,43 @@ begin
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)
EraseRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseWidth + PauseXPadding * 2 - 1,
PauseHeight + PauseYPadding * 2 + 1);
DrawRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseHeight + PauseYPadding * 2 + 1,
PauseWidth + PauseXPadding * 2);
DrawAscii(PauseX, PauseY, PauseHeight, PauseAscii)
end;
procedure ErasePause(var g: gameState);
begin
EraseRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseWidth + PauseXPadding * 2 - 1,
PauseHeight + PauseYPadding * 2 + 1)
end;
procedure DrawExit(var g: gameState);
var
realX: integer = ScreenW * WidthCoefficient;
begin
DrawAscii((realX - ExitWidth) div 2, ExitGameY, ExitHeight, ExitAscii);
DrawAscii(ExitYesX, ExitYesY, YesHeight, YesAscii);
DrawAscii(ExitNoX, ExitYesY, NoHeight, NoAscii);
DrawAscii((realX - ExitWidth) div 2, ExitGameY,
ExitScreenHeight, ExitScreen);
DrawExitState(g.curExit)
end;
procedure DrawInfo;
procedure EraseKeyInfo;
begin
EraseRectangle(KeyInfoX, KeyInfoY, KeyInfoWidth, KeyInfoHeight)
end;
procedure DrawKeyInfo;
begin
DrawAscii(KeyInfoX, KeyInfoY, KeyInfoHeight, KeyInfoScreen)
end;
procedure EraseExitState(s: exitState);
@ -389,7 +410,60 @@ procedure EraseExit;
begin
EraseRectangle(HamsterYesX, ExitGameY,
ExitWidth + HamsterWidth + MenuWidthPadding,
ExitHeight + MenuHeightPadding + YesHeight)
ExitScreenHeight + MenuHeightPadding + YesHeight)
end;
procedure DrawTrace(t: tracePtr);
begin
if t <> nil then
t := t^.prev;
while t <> nil do
begin
DrawArenaCell(t^.x, t^.y, TraceSymbol);
t := t^.prev
end
end;
procedure FillPauseCells(var a: arena);
var
i, j: integer;
begin
for i := ArenaPauseUpperMarginY to (ArenaW - ArenaPauseLowerMarginY) do
for j := (1 + ArenaPauseMarginX) to (ArenaH - ArenaPauseMarginX) do
if a.borders[j][i] then
DrawArenaCell(j, i, BorderSymbol)
else
if a.captured[j][i] then
DrawArenaCell(j, i, CaptureSymbol)
end;
procedure DrawLevel(var level: levelState);
begin
DrawInterface;
FillPauseCells(level.a);
DrawTrace(level.t);
DrawCreature(level.h);
DrawCreature(level.g);
DrawScore(level.score);
DrawLifes(level.life)
end;
procedure EraseLevel;
begin
EraseRectangle(2, 2,
ScreenW * WidthCoefficient - BorderSize * BorderN,
ScreenH - BorderSize * BorderN);
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient)
end;
procedure EraseGameOver;
begin
EraseRectangle(GameOverX, GameOverY, GameOverWidth, GameOverHeight)
end;
procedure DrawGameOver;
begin
DrawAscii(GameOverX, GameOverY, GameOverHeight, GameOverScreen)
end;
end.

112
src/keys_m.pas
View File

@ -32,12 +32,14 @@ const
{ Debug }
procedure GetKey(var keyCode: integer);
procedure HandleExitKey(var keep: boolean; var g: gameState);
procedure HandleExitKey(var g: gameState);
procedure HandleLevelKey(var h: creature; var a: arena;
var t: tracePtr; var g: gameState);
procedure HandleMenuKey(var g: gameState);
procedure HandleInfoKey(var keep: boolean; var g: gameState);
procedure HandlePauseKey(var keep: boolean; var g: gameState);
procedure HandleInfoKey(var g: gameState);
procedure HandleGameOverKey(var g: gameState);
procedure HandleScoreKey(var g: gameState);
procedure HandlePauseKey(var g: gameState);
implementation
@ -110,6 +112,30 @@ begin
}
end;
procedure PreviousMenuState(var g: gameState);
begin
if (g.curMenu = menuNewGame) and not g.continueAllowed then
g.curMenu := menuKeyInfo
else
if g.curMenu = menuNewGame then
g.curMenu := menuContinue
else
g.curMenu := pred(g.curMenu)
end;
procedure NextMenuState(var g: gameState);
begin
if (g.curMenu = menuKeyInfo) and not g.continueAllowed or
(g.curMenu = menuContinue) then
begin
g.curMenu := menuNewGame
end
else
begin
g.curMenu := succ(g.curMenu)
end
end;
procedure ChangeMenuState(k: integer; var g: gameState);
begin
case k of
@ -120,19 +146,33 @@ begin
end
end;
procedure ChooseMenuOption(k: integer; var g: gameState);
procedure ChooseMenuNum(k: integer; var g: gameState);
begin
if (k = FourOrd) and not g.continueAllowed then
exit;
case k of
OneOrd:
g.curState := gameLevel;
g.curState := gameStartLevel;
TwoOrd:
g.curState := gameScore;
ThreeOrd:
g.curState := gameInfo;
g.curState := gameKeyInfo;
FourOrd:
g.curState := gameLevel
g.curState := gameContinueLevel
end
end;
procedure ChooseMenuMarked(var g: gameState);
begin
case g.curMenu of
menuNewGame:
g.curState := gameStartLevel;
menuHighScore:
g.curState := gameScore;
menuKeyInfo:
g.curState := gameKeyInfo;
menuContinue:
g.curState := gameContinueLevel
end
end;
@ -148,9 +188,24 @@ begin
DrawMenuState(g.curMenu)
end;
if (k = OneOrd) or (k = TwoOrd) or (k = ThreeOrd) or (k = FourOrd) then
ChooseMenuOption(k, g);
if k = EscOrd then
g.curState := gameExit
ChooseMenuNum(k, g);
if (k = EscOrd) or (k = UpperQOrd) or (k = LowerQOrd) then
g.curState := gameExit;
if (k = EnterOrd) or (k = SpaceOrd) then
ChooseMenuMarked(g);
end;
procedure HandleGameOverKey(var g: gameState);
var
k: integer;
begin
GetKey(k);
case k of
UpperYOrd, LowerYOrd:
g.curState := gameContinueLevel;
UpperNOrd, LowerNOrd:
g.curState := gameMenu;
end
end;
procedure ChangeExitState(k: integer; var g: gameState);
@ -163,7 +218,7 @@ begin
end
end;
procedure HandleExitKey(var keep: boolean; var g: gameState);
procedure HandleExitKey(var g: gameState);
var
k: integer;
begin
@ -181,40 +236,47 @@ begin
g.shutdown := true
else
g.curExit := exitYes;
keep := false
end;
if (k = UpperYOrd) or (k = LowerYOrd) or (k = OneOrd) then
begin
g.shutdown := true;
keep := false
end;
if (k = UpperNOrd) or (k = LowerNOrd) or (k = EscOrd) or (k = TwoOrd) then
begin
g.curExit := exitYes;
keep := false
end;
g.curState := gameMenu
end;
procedure HandlePauseKey(var keep: boolean; var g: gameState);
procedure HandlePauseKey(var g: gameState);
var
k: integer;
begin
GetKey(k);
if (k = EscOrd) or (k = SpaceOrd) then
begin
g.curState := gameLevel;
keep := false
end;
g.curState := gameContinueLevel;
if (k = UpperQOrd) or (k = LowerQOrd) then
g.curState := gameMenu;
end;
procedure HandleInfoKey(var g: gameState);
var
k: integer;
begin
GetKey(k);
if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) or
(k = UpperQOrd) or (k = LowerQOrd) then
begin
g.curState := gameMenu;
keep := false
end
end;
procedure HandleInfoKey(var keep: boolean; var g: gameState);
procedure HandleScoreKey(var g: gameState);
var
k: integer;
begin
GetKey(k);
if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) or
(k = UpperQOrd) or (k = LowerQOrd) then
begin
g.curState := gameMenu;
end
end;
end.

43
src/level_m.pas Normal file
View File

@ -0,0 +1,43 @@
unit level_m;
interface
uses arena_m, trace_m, creature_m;
type
levelState = record
a: arena;
t: tracePtr;
levelStarted, continueLevel, hamsterAlive: boolean;
h, g: creature;
life, score: integer
end;
procedure InitLevel(var level: levelState);
implementation
uses hamster_m, ghost_m;
const
StartScore = 0;
StartLifes = 0;
{
BonusTurns = 45;
StartSpeedBonus = 0;
StartSlowBonus = 0;
}
procedure InitLevel(var level: levelState);
begin
InitArena(level.a);
InitHamster(level.h);
InitGhost(level.g);
level.levelStarted := true;
level.continueLevel := true;
level.hamsterAlive := true;
level.t := nil;
level.life := StartLifes;
level.score := StartScore
end;
end.

2
src/trace_m.pas
View File

@ -2,7 +2,7 @@ unit trace_m;
interface
uses creature_m, math_m, game_m;
uses creature_m, math_m;
const
PreviousTraceIdx = 3;