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

feat/TD-014-add-level-complete-bar

Browse Source
This commit is contained in:
gre-ilya 2026-02-28 16:39:44 +05:00
parent 7b8b7adb01
commit c83e5b551c
12 changed files with 640 additions and 848 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Makefile
View File

@ -2,7 +2,7 @@ FPC = fpc
GAME_SRC = gohamster.pas arena_m.pas cell_m.pas creature_m.pas debug_m.pas \
ghost_m.pas graphics_m.pas hamster_m.pas keys_m.pas math_m.pas \
trace_m.pas _banners_m.pas
trace_m.pas
all: gohamster
@ -15,3 +15,4 @@ gohamster: $(GAME_SRC)
clean:
rm *.o *.ppu gohamster

358
src/_banners_m.pas
View File

@ -1,358 +0,0 @@
{ ************************************************** }
{ ************************************************** }
{ *** *** }
{ *** *** }
{ *** AUTOMATICALLY GENERATED FILE. DO NOT EDIT. *** }
{ *** *** }
{ *** *** }
{ ************************************************** }
{ ************************************************** }
unit _banners_m;
interface
const
KeyInfoHeight = 42;
KeyInfoWidth = 98;
MaxBannerHeight = KeyInfoHeight;
MaxBannerWidth = KeyInfoWidth;
type
BannerImage = array[1..MaxBannerHeight] of string[MaxBannerWidth];
const
KeyInfoScreen: BannerImage = (
' _',
' | |',
' _ __ ___ _____ _____ | | _____ _ _ ___ _',
' | ''_ ` _ \ / _ \ \ / / _ \ | |/ / _ \ | | / __| (_)',
' | | | | | | (_) \ V / __/ | < __/ |_| \__ \ _',
' |_| |_| |_|\___/ \_/ \___| |_|\_\___|\__, |___/ (_)',
' __/ |',
' _ |___/',
' / \',
' / . \',
' / / \ \',
' /_/| |\_\',
' | |',
' |_|',
' __ ========= __',
' / / (\_/) \ \',
' / /_____ ( 0_0 ) ______\ \ ',
' { ______| /-----\ |_______ }',
' \ \ |___| / /',
' \_\ / \ /_/',
' ========== _ ===========',
' | |',
' _ | | _ ',
' \ \| |/ /',
' \ \ / / ',
' \ ` / ',
' \_/',
' =========',
' _ _ _',
' | | | | | |',
' ___ _ __ __ _ ___ ___ ___| |_ ___ _ __ | |__ __ _ _ __ ___ ___| |_ ___ _ __',
' / __| ''_ \ / _` |/ __/ _ \ ______ / __| __/ _ \| ''_ \ | ''_ \ / _` | ''_ ` _ \/ __| __/ _ \ ''__|',
' \__ \ |_) | (_| | (_| __/ |______| \__ \ || (_) | |_) | | | | | (_| | | | | | \__ \ || __/ |',
' |___/ .__/ \__,_|\___\___| |___/\__\___/| .__/ |_| |_|\__,_|_| |_| |_|___/\__\___|_|',
' ====| |=================== | |',
' |_| |_|',
' ___ ___ ___ _ __ __ _ _ _ ___ ___',
' / _ \/ __|/ __| ______ | ''_ \ / _` | | | / __|/ _ \',
'| __/\__ \ (__ |______| | |_) | (_| | |_| \__ \ __/',
' \___||___/\___| | .__/ \__,_|\__,_|___/\___|',
'================ | |',
' |_|'
);
ExitScreenHeight = 16;
ExitWidth = 70;
ExitHeight = 8;
ExitScreen: BannerImage = (
' ______ _ _ _ _ ___',
'| ____| (_) | | | | | |__ \',
'| |__ __ ___| |_ | |_| |__ ___ __ _ __ _ _ __ ___ ___ ) |',
'| __| \ \/ / | __| | __| ''_ \ / _ \ / _` |/ _` | ''_ ` _ \ / _ \/ /',
'| |____ > <| | |_ | |_| | | | __/ | (_| | (_| | | | | | | __/_|',
'|______/_/\_\_|\__| \__|_| |_|\___| \__, |\__,_|_| |_| |_|\___(_)',
' __/ |',
' |___/',
'',
'',
' _ _ ___ ___ _ __ ___',
'| | | |/ _ \/ __| | ''_ \ / _ \',
'| |_| | __/\__ \ | | | | (_) |',
' \__, |\___||___/ |_| |_|\___/',
' __/ |',
' |___/',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
''
);
PauseHeight = 22;
PauseWidth = 76;
PauseAscii: BannerImage = (
' _',
' | |',
' _ __ __ _ _ _ ___ ___ __| |',
' | ''_ \ / _` | | | / __|/ _ \/ _` |',
' | |_) | (_| | |_| \__ \ __/ (_| |',
' | .__/ \__,_|\__,_|___/\___|\__,_| ',
' | | ',
' |_| _ _',
' | | (_)',
' ___ _ __ __ _ __ ___ ___ ___ _ __ | |_ _ _ __ _ _ ___',
'/ __| ''_ \ / _` |/ __/ _ \ ______ / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \',
'\__ \ |_) | (_| | (_| __/ |______| | (_| (_) | | | | |_| | | | | |_| | __/',
'|___/ .__/ \__,_|\___\___| \___\___/|_| |_|\__|_|_| |_|\__,_|\___|',
'====| |===================',
' |_| _ _ _',
' (_) | | |',
' __ _ __ _ _ _ _| |_ | |_ ___ _ __ ___ ___ _ __ _ _',
' / _` | ______ / _` | | | | | __| | __/ _ \ | ''_ ` _ \ / _ \ ''_ \| | | |',
'| (_| | |______| | (_| | |_| | | |_ | || (_) | | | | | | | __/ | | | |_| |',
' \__, | \__, |\__,_|_|\__| \__\___/ |_| |_| |_|\___|_| '' |_|\__,_|',
'====| |= | |',
' |_| |_|',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
''
);
GameCompleteHeight = 14;
GameCompleteWidth = 74;
GameCompleteScoreWidth = 50;
GameComplete: BannerImage = (
' _____ _ _ _ ',
' / ____| | | | | | |',
'| | __ __ _ _ __ ___ ___ ___ ___ _ __ ___ _ __ | | ___| |_ ___| |',
'| | |_ |/ _` | ''_ ` _ \ / _ \ / __/ _ \| ''_ ` _ \| ''_ \| |/ _ \ __/ _ \ |',
'| |__| | (_| | | | | | | __/ | (_| (_) | | | | | | |_) | | __/ || __/_|',
' \_____|\__,_|_| |_| |_|\___| \___\___/|_| |_| |_| .__/|_|\___|\__\___(_)',
' | |',
' |_|',
'__ __',
'\ \ / / _ ',
' \ \_/ /__ _ _ _ __ ___ ___ ___ _ __ ___(_)',
' \ / _ \| | | | ''__| / __|/ __/ _ \| ''__/ _ \',
' | | (_) | |_| | | \__ \ (_| (_) | | | __/_ ',
' |_|\___/ \__,_|_| |___/\___\___/|_| \___(_)',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
''
);
GameMenuHeight = 36;
GameNameHeight = 6;
GameNameWidth = 58;
NewGameHeight = 6;
HighScoreHeight = 8;
MenuInfoHeight = 8;
ContinueHeight = 6;
ContinueWidth = 41;
GameMenuScreen: BannerImage = (
' _____ _ _ _ _',
' / ____| | | | | | | | |',
'| | __ ___ | | | |__| | __ _ _ __ ___ ___| |_ ___ _ __',
'| | |_ |/ _ \| | | __ |/ _` | ''_ ` _ \/ __| __/ _ \ ''__|',
'| |__| | (_) |_| | | | | (_| | | | | | \__ \ || __/ |',
' \_____|\___/(_) |_| |_|\__,_|_| |_| |_|___/\__\___|_|',
'',
'',
'',
'',
'',
'',
'',
'',
' _ _ _____',
'| \ | | / ____|',
'| \| | _____ __ | | __ __ _ _ __ ___ ___',
'| . ` |/ _ \ \ /\ / / | | |_ |/ _` | ''_ ` _ \ / _ \',
'| |\ | __/\ V V / | |__| | (_| | | | | | | __/',
'|_| \_|\___| \_/\_/ \_____|\__,_|_| |_| |_|\___|',
'',
'',
' _ __ _____ __',
'| |/ / |_ _| / _|',
'| '' / ___ _ _ | | _ __ | |_ ___',
'| < / _ \ | | | | | | ''_ \| _/ _ \',
'| . \ __/ |_| | _| |_| | | | || (_) |',
'|_|\_\___|\__, | |_____|_| |_|_| \___/',
' __/ |',
' |___/',
' _____ _ _ ',
' / ____| | | (_) ',
'| | ___ _ __ | |_ _ _ __ _ _ ___ ',
'| | / _ \| ''_ \| __| | ''_ \| | | |/ _ \',
'| |___| (_) | | | | |_| | | | | |_| | __/',
' \_____\___/|_| |_|\__|_|_| |_|\__,_|\___|',
'',
'',
'',
'',
'',
''
);
GameOverHeight = 40;
GameOverWidth = 63;
GameOverScreen: BannerImage = (
' _____ __ __ ______ ',
' / ____| /\ | \/ | ____|',
' | | __ / \ | \ / | |__ ',
' | | |_ | / /\ \ | |\/| | __|',
' | |__| |/ ____ \| | | | |____',
' \_____/_/ \_\_| |_|______|',
' ______ ________ _____',
' / __ \ \ / / ____| __ \',
' | | | \ \ / /| |__ | |__) |',
' | | | |\ \/ / | __| | _ /',
' | |__| | \ / | |____| | \ \',
' \____/ \/ |______|_| \_\',
'',
' ____ ____',
' / o@@\ /@@o \',
' / /``\@\ __,-==-,__ /@/``\ \',
' / /` `||//\______/ \||` `\ \',
' | |` // __ __ \\ `| |',
' \ \` (/ /;g\ /g;\ \) `/ |',
' \_\__(( " .. " )____/_/',
' \ " __ " / ',
' @@@@@@(||)@@@@`@@`@@@@(||)@@@@@@@',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',
' ',
' _ _ ___',
' | | (_) |__ \',
' ___ ___ _ __ | |_ _ _ __ _ _ ___ ) |',
' / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \ / /',
' | (_| (_) | | | | |_| | | | | |_| | __/ |_|',
' \___\___/|_| |_|\__|_|_| |_|\__,_|\___| (_)',
' ___ ___ __ ___ ___',
'| _| |_ | \ \ | _| |_ |',
'| | _ _ | | ___ ___ \ \ | | _ __ | | ___',
'| | | | | | | |/ _ \/ __| \ \ | | | ''_ \ | |/ _ \',
'| | | |_| | | | __/\__ \ \ \ | | | | | | | | (_) |',
'| |_ \__, | _| |\___||___/ \ \ | |_ |_| |_| _| |\___/',
'|___|=====/ |=|___| \_\ |___|=========|___|',
' |___/',
'',
''
);
LevelAnnounceHeight = 6;
LevelAnnounceWidth = 24;
LevelAnnounce: BannerImage = (
' _ _ ',
'| | | |',
'| | _____ _____| |',
'| | / _ \ \ / / _ \ |',
'| |___| __/\ V / __/ |',
'|______\___| \_/ \___|_|',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
'',
''
);
implementation
end.

337
src/arena_graphics_m.pas
View File

@ -2,84 +2,305 @@ unit arena_graphics_m;
interface
uses arena_m, creature_m;
uses arena_m, creature_m, graphics_m, trace_m, level_m;
const
ArenaSymbol = ' ';
BorderSize = 1;
BorderSymbol = '|';
BorderSymbolX = '|';
MidCellDelimiter = '_';
BorderSymbolY = '|';
CaptureSymbol = '.';
CellSize = 2;
InterfaceH = 6;
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 DrawAfterEnemyStep(var cr: creature; var a: arena);
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena);
procedure DrawArenaBorders(var a: arena);
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
procedure DrawArenaEdges;
procedure DrawCompleteBar; { TODO: IMPLEMENT LATER }
procedure FillCompleteBar(s: integer);
procedure DrawCreature(var cr: creature);
procedure DrawEdge(x, y: integer; var a: arena);
procedure DrawLevelInterface;
procedure DrawRectangle(x0, y0, h, w: integer);
procedure DrawInterface;
procedure DrawLevel(var level: levelState);
procedure DrawLifesNumber(n: integer);
procedure DrawScore(s: integer);
procedure EraseStepTrace(var hamster: creature; t: tracePtr);
procedure EraseLifesNumber(n: integer);
procedure EraseTrace(t: tracePtr; var a: arena);
implementation
uses crt, math_m;
uses ascii_arts_m, crt, math_m;
procedure DrawLineX(x, y, len: integer; ch: char);
var
i: integer;
const
ArenaPauseLowerMarginY = 14;
ArenaPauseMarginX = 9;
ArenaPauseUpperMarginY = 7;
InterfaceBarH = ScreenW - ArenaW * CellSize - BorderSize * 2; { 14 }
InterfaceCellW = ScreenW div 3;
InterfaceMarginX = InterfaceCellW div 4;
InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1;
CompleteBarMarginY = 2;
CompleteBarMarginX = 5;
CompleteBarX = (
InterfaceCellW * WidthCoefficient + BorderSize + CompleteBarMarginX
);
CompleteBarY = BorderSize + CompleteBarMarginY + 1;
TotalProcent = 100;
CompleteBarH = InterfaceBarH - BorderSize * 2 - CompleteBarMarginY * 2;
CompleteBarW = (
InterfaceCellW * WidthCoefficient - CompleteBarMarginX * 2
);
BarWinX = CompleteBarW * 4 div 5;
LifeBarX = 17;
LifeNumberX = 27;
MidCellDelimiter = '_';
Notation = 10;
procedure DrawCompleteBar;
begin
GotoXY(x, y);
for i := 1 to len do
write(ch);
GotoXY(1, 1)
FillRectangle(CompleteBarX, CompleteBarY, CompleteBarW, CompleteBarH, '-');
FillRectangle(CompleteBarX + BarWinX, CompleteBarY,
1, CompleteBarH, '|')
end;
procedure DrawLineY(x, y, len: integer);
procedure FillCompleteBar(s: integer);
var
i: integer;
cutedProcent: integer = 0;
fillW: integer;
begin
for i := 1 to len do
begin
GotoXY(x, y + i - 1);
write(BorderSymbolY)
end;
GotoXY(1, 1)
if s <> 0 then
cutedProcent := round(s / (TotalCells / TotalProcent));
fillW := round(CompleteBarW / TotalProcent * cutedProcent);
FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '|')
end;
procedure DrawRectangle(x0, y0, h, w: integer);
procedure DrawCreature(var cr: creature);
begin
DrawArenaCell(cr.curX, cr.curY, cr.symbol)
end;
procedure DrawAfterEnemyStep(var cr: creature; var a: arena);
var
prevX, prevY: integer;
begin
prevX := cr.curX - cr.dX;
prevY := cr.curY - cr.dY;
if IsOnEdge(prevX, prevY) and a.captured[prevX][prevY] then
DrawArenaCell(prevX, prevY, CaptureSymbol)
else
if IsOnBorder(prevX, prevY, a) then
DrawArenaCell(prevX, prevY, BorderSymbol)
else
DrawArenaCell(prevX, prevY, ArenaSymbol);
DrawCreature(cr)
end;
procedure DrawStepTrace(t: tracePtr; hamsterDelta: integer);
var
i: integer;
begin
DrawLineX(x0, y0, w, BorderSymbolX);
for i := 1 to h - 2 do
for i := 1 to HamsterDelta do
begin
GotoXY(x0, y0 + i);
write(BorderSymbolY);
GotoXY(x0 + w - 1, y0 + i);
write(BorderSymbolY)
t := t^.prev;
DrawArenaCell(t^.x, t^.y, TraceSymbol)
end
end;
procedure
DrawPreviousCell(var hamster: creature; var t: tracePtr; var a: arena);
var
prevX, prevY: integer;
begin
prevX := hamster.curX - hamster.dX;
prevY := hamster.curY - hamster.dY;
if t = nil then
DrawEdge(prevX, prevY, a);
if (a.borders[prevX][prevY]) and (t = nil) then
DrawArenaCell(prevX, prevY, BorderSymbol)
end;
procedure EraseStepTrace(var hamster: creature; t: tracePtr);
var
i: integer;
begin
for i := 1 to hamster.movespeed do
begin
DrawArenaCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
end;
DrawLineX(x0, y0 + h - 1, w, BorderSymbolX);
GotoXY(1, 1)
if GetLength(t) = 1 then
begin
if IsOnEdge(hamster) then
DrawArenaCell(t^.x, t^.y, ArenaSymbol)
else
DrawArenaCell(t^.x, t^.y, BorderSymbol)
end
end;
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena);
var
prevX, prevY: integer;
begin
prevX := hamster.curX - hamster.dX;
prevY := hamster.curY - hamster.dY;
if IsOnEdge(prevX, prevY) and a.captured[prevX][prevY] then
DrawArenaCell(prevX, prevY, CaptureSymbol)
else
if IsOnBorder(prevX, prevY, a) then
DrawArenaCell(prevX, prevY, BorderSymbol)
else
DrawArenaCell(prevX, prevY, ArenaSymbol);
if t <> nil then
DrawStepTrace(t, hamster.movespeed);
DrawCreature(hamster);
DrawPreviousCell(hamster, t, a)
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 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;
type
stackIntPtr = ^stackIntItem;
stackIntItem = record
val: integer;
next: stackIntPtr
end;
StackInt = record
top: stackIntPtr
end;
procedure StackIntInit(var s: StackInt);
begin
s.top := nil
end;
procedure StackPush(var st: StackInt; val: integer);
var
tmp: stackIntPtr;
begin
new(tmp);
tmp^.val := val;
tmp^.next := st.top;
st.top := tmp
end;
procedure StackPop(var st: StackInt);
var
tmp: stackIntPtr;
begin
tmp := st.top;
st.top := st.top^.next;
dispose(tmp)
end;
procedure EraseInterfaceNumber(interfaceX: integer; s: longint);
var
cnt: integer = 0;
x, w: integer;
begin
while s <> 0 do
begin
s := s div 10;
cnt += 1
end;
x := interfaceX + InterfaceMarginX;
w := (DigitWidth + DigitSpaceWidth) * cnt;
EraseRectangle(x, InterfaceMarginY, w, DigitHeight)
end;
procedure DrawInterfaceNumber(interfaceX: integer; s: longint);
var
x, y: integer;
i: integer = 0;
st: StackInt;
begin
StackIntInit(st);
if s = 0 then
StackPush(st, 0);
while s <> 0 do
begin
StackPush(st, s mod Notation);
s := s div Notation
end;
x := interfaceX + InterfaceMarginX;
y := InterfaceMarginY;
while st.top <> nil do
begin
DrawDigit(x + (DigitWidth + DigitSpaceWidth) * i, y, st.top^.val);
StackPop(st);
i := i + 1
end
end;
procedure DrawScore(s: integer);
var
scoreX: integer = InterfaceCellW * 2 * WidthCoefficient + BorderSize;
begin
DrawInterfaceNumber(scoreX, s)
end;
procedure EraseLifesNumber(n: integer);
begin
EraseInterfaceNumber(LifeNumberX, n)
end;
procedure DrawLifesNumber(n: integer);
begin
DrawInterfaceNumber(LifeNumberX, n)
end;
procedure DrawLifes(n: integer);
begin
DrawAscii(LifeBarX, 5, HamsterHeight, HamsterLifesAscii);
DrawInterfaceNumber(LifeNumberX, n)
end;
procedure DrawInterface;
begin
DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient, BorderSymbolX);
DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient, BorderSymbol);
DrawLineX(InterfaceCellW * WidthCoefficient,
{DrawLineX(InterfaceCellW * WidthCoefficient,
InterfaceBarH div 2,
InterfaceCellW * WidthCoefficient + 1, MidCellDelimiter);
DrawLineY(InterfaceCellW * WidthCoefficient, 1, InterfaceBarH);
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1, InterfaceBarH)
InterfaceCellW * WidthCoefficient + 1, MidCellDelimiter);}
DrawLineY(InterfaceCellW * WidthCoefficient, 1,
InterfaceBarH, BorderSymbol);
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1,
InterfaceBarH, BorderSymbol)
end;
procedure DrawLevel(var level: levelState);
begin
DrawInterface;
FillPauseCells(level.a);
DrawTrace(level.t);
DrawCreature(level.h);
if level.g.alive then
DrawCreature(level.g);
DrawLifes(level.life);
DrawCompleteBar;
FillCompleteBar(level.score);
DrawScore(level.score)
end;
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
@ -100,7 +321,8 @@ end;
procedure DrawArenaEdges;
begin
DrawRectangle(1, InterfaceBarH,
ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient)
ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient,
BorderSymbol)
end;
procedure DrawLeftEdge(y: integer);
@ -109,7 +331,7 @@ var
begin
y := Clamp(y, 1, ArenaW);
terminalY := InterfaceBarH + (y - 1) * CellSize;
DrawLineY(1, terminalY, CellSize)
DrawLineY(1, terminalY, CellSize, BorderSymbol)
end;
procedure DrawRightEdge(y: integer);
@ -118,7 +340,7 @@ var
begin
y := Clamp(y, 1, ArenaW);
terminalY := InterfaceBarH + (y - 1) * CellSize;
DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize)
DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize, BorderSymbol)
end;
procedure DrawUpperEdge(x: integer);
@ -128,7 +350,7 @@ begin
x := Clamp(x, 1, ArenaH);
terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbolX)
DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbol)
end;
procedure DrawLowerEdge(x: integer);
@ -139,7 +361,7 @@ begin
terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH + ArenaW * CellSize - 1,
sizeX, BorderSymbolX)
sizeX, BorderSymbol)
end;
procedure DrawArenaBorders(var a: arena);
@ -168,11 +390,16 @@ begin
DrawLowerEdge(x)
end;
procedure DrawLevelInterface;
procedure EraseTrace(t: tracePtr; var a: arena);
begin
clrscr;
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient);
DrawInterface
while t <> nil do
begin
if t^.prev = nil then
DrawEdge(t^.x, t^.y, a)
else
DrawArenaCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
end
end;
end.

26
src/arena_m.pas
View File

@ -7,7 +7,8 @@ uses creature_m, trace_m;
const
ArenaW = 33;
ArenaH = 41;
RandomCutThreshold = 20;
TotalCells = ArenaW * ArenaH;
RandomCutThreshold = 25;
RandomOneToOne = 2;
type
@ -37,6 +38,9 @@ implementation
uses arena_graphics_m, cell_m, crt, graphics_m, math_m;
const
TotalProcent = 100;
procedure Fill(var m: arenaMatrix; val: boolean);
var
i, j: integer;
@ -162,21 +166,21 @@ begin
IsOnEdge := (OnEdgeX(x) or OnEdgeY(y))
end;
function YNeighborsCaptured(x, y: integer; var a: arena): boolean;
function YNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
YNeighborsCaptured :=
YNeighboursCaptured :=
not OnEdgeY(y) and a.captured[x][y - 1] and a.captured[x][y + 1]
end;
function XNeighborsCaptured(x, y: integer; var a: arena): boolean;
function XNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
XNeighborsCaptured :=
XNeighboursCaptured :=
not OnEdgeX(x) and a.captured[x + 1][y] and a.captured[x - 1][y]
end;
function DiagonalNeighborsCaptured(x, y: integer; var a: arena): boolean;
function DiagonalNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
DiagonalNeighborsCaptured :=
DiagonalNeighboursCaptured :=
not IsOnEdge(x, y) and
a.captured[x - 1][y - 1] and a.captured[x - 1][y + 1] and
a.captured[x + 1][y - 1] and a.captured[x + 1][y + 1]
@ -185,8 +189,8 @@ end;
function ArenaCellCaptured(x, y: integer; var a: arena): boolean;
begin
ArenaCellCaptured :=
XNeighborsCaptured(x, y, a) or YNeighborsCaptured(x, y, a) or
DiagonalNeighborsCaptured(x, y, a)
XNeighboursCaptured(x, y, a) or YNeighboursCaptured(x, y, a) or
DiagonalNeighboursCaptured(x, y, a)
end;
procedure CaptureArenaBorder(x, y: integer; var a: arena);
@ -284,7 +288,7 @@ begin
v1 := v2;
v2 := tmp
end; {Should be 100 or OneHundred? It's A.V.Stolyarov to decide!!!}
biggerProcent := v2 / 100;
biggerProcent := v2 / TotalProcent;
LowerToBiggerRatio := Round(100 - v1 / biggerProcent)
end;
@ -504,7 +508,7 @@ begin
prevX := e.curX;
prevY := e.curY;
MakeStep(e);
DrawAfterStep(e, a);
DrawAfterEnemyStep(e, a);
if TraceCrossed(prevX, prevY, e, t) then
h.alive := false
end;

66
src/ascii_arts_m.pas
View File

@ -153,7 +153,6 @@ const
' \__, |\___||___/ |_| |_|\___/',
' __/ |',
' |___/'
);
PauseHeight = 22;
@ -191,6 +190,7 @@ const
NoWidth = 13;
HamsterHeight = 5;
HamsterWidth = 7;
HamsterLifesWidth = 13;
HamsterStayAscii: array[1..HamsterHeight] of string = (
' (\_/)',
'( 0_0 )',
@ -205,42 +205,50 @@ const
' |___|',
' / \'
);
HamsterLifesAscii: array[1..HamsterHeight] of string = (
' (\_/) ',
'( 0_0 ) \ /',
'/-----\ X ',
' |___| / \',
' / \ '
);
GameOverHeight = 40;
GameOverWidth = 62;
GameOverScreen: array[1..GameOverHeight] of string = (
' _____ __ __ ______ ',
' / ____| /\ | \/ | ____| ',
' / ____| /\ | \/ | ____|',
' | | __ / \ | \ / | |__ ',
' | | |_ | / /\ \ | |\/| | __| ',
' | |__| |/ ____ \| | | | |____ ',
' \_____/_/ \_\_| |_|______| ',
' ______ ________ _____ ',
' / __ \ \ / / ____| __ \ ',
' | | | \ \ / /| |__ | |__) | ',
' | | | |\ \/ / | __| | _ / ',
' | |__| | \ / | |____| | \ \ ',
' \____/ \/ |______|_| \_\ ',
' ',
' ____ ____ ',
' / o@@\ /@@o \ ',
' / /``\@\ __,-==-,__ /@/``\ \ ',
' / /` `||//\______/ \||` `\ \ ',
' | |` // __ __ \\ `| | ',
' \ \` (/ /;g\ /g;\ \) `/ | ',
' \_\__(( " .. " )____/_/ ',
' | | |_ | / /\ \ | |\/| | __|',
' | |__| |/ ____ \| | | | |____',
' \_____/_/ \_\_| |_|______|',
' ______ ________ _____',
' / __ \ \ / / ____| __ \',
' | | | \ \ / /| |__ | |__) |',
' | | | |\ \/ / | __| | _ /',
' | |__| | \ / | |____| | \ \',
' \____/ \/ |______|_| \_\',
'',
' ____ ____',
' / o@@\ /@@o \',
' / /``\@\ __,-==-,__ /@/``\ \',
' / /` `||//\______/ \||` `\ \',
' | |` // __ __ \\ `| |',
' \ \` (/ /;g\ /g;\ \) `/ |',
' \_\__(( " .. " )____/_/',
' \ " __ " / ',
' @@@@@@(||)@@@@`@@`@@@@(||)@@@@@@@ ',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ',
' @@@@@@(||)@@@@`@@`@@@@(||)@@@@@@@',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',
' ',
' _ _ ___ ',
' | | (_) |__ \ ',
' ___ ___ _ __ | |_ _ _ __ _ _ ___ ) | ',
' / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \ / / ',
' | (_| (_) | | | | |_| | | | | |_| | __/ |_| ',
' \___\___/|_| |_|\__|_|_| |_|\__,_|\___| (_) ',
' _ _ ___',
' | | (_) |__ \',
' ___ ___ _ __ | |_ _ _ __ _ _ ___ ) |',
' / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \ / /',
' | (_| (_) | | | | |_| | | | | |_| | __/ |_|',
' \___\___/|_| |_|\__|_|_| |_|\__,_|\___| (_)',
' ___ ___ __ ___ ___',
'| _| |_ | \ \ | _| |_ |',
'| | _ _ | | ___ ___ \ \ | | _ __ | | ___',

101
src/ascii_digits_m.pas Normal file
View File

@ -0,0 +1,101 @@
unit ascii_digits_m;
interface
const
NDigitHeight = 6;
NDigitWidth = 7;
type
asciiDigit = record
width: integer;
digit: array[1..NDigitHeight] of string;
end;
implementation
NDigitsAsciiW = array[0..1] of integer = (1,1);
NDigitsAscii: array[0..9] of array[1..NDigitHeight] of string = (
(
' ___',
' / _ \',
'| | | |',
'| | | |',
'| |_| |',
' \___/'
),
(
' __ ',
'/_ |',
' | |',
' | |',
' | |',
' |_|'
),
(
' ___ ',
'|__ \ ',
' ) |',
' / / ',
' / /_ ',
'|____|'
),
(
' ____ ',
'|___ \ ',
' __) |',
' |__ < ',
' ___) |',
'|____/'
),
(
' _ _ ',
'| || |',
'| || |',
'|__ _|',
' | |',
' |_|'
),
(
' _____',
'| ____|',
'| |__',
'|___ \',
' ___) |',
'|____/'
),
(
' __',
' / /',
' / /_',
'| '_ \',
'| (_) |',
' \___/'
),
(
' ______',
'|____ |',
' / /',
' / /',
' / /',
' /_/'
),
(
' ___',
' / _ \',
'| (_) |',
' > _ < ',
'| (_) |',
' \___/'
),
(
' ___',
' / _ \',
'| (_) |',
' \__, |',
' / /',
' /_/'
)
);
end.

14
src/game_m.pas
View File

@ -15,7 +15,7 @@ type
curMenu: menuState;
curState: state;
level: integer;
shutdown, continueAllowed: boolean;
shutdown, continueAllowed: boolean
end;
procedure DecreaseLife(var level: levelState);
@ -37,8 +37,9 @@ const
procedure DecreaseLife(var level: levelState);
begin
EraseLifesNumber(level.life);
level.life := level.life - 1;
DrawLifes(level.life)
DrawLifesNumber(level.life)
end;
procedure InitGame(var g: gameState);
@ -127,12 +128,16 @@ begin
begin
SetArenaBorder(level.t, level.a);
CutPart(level.h, level.t, level.score, level.a);
FillCompleteBar(level.score);
DrawScore(level.score)
end;
if level.g.alive and level.a.captured[level.g.curX][level.g.curY] then
KillCreature(level.g);
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 level.life <= 0 then
@ -151,11 +156,6 @@ begin
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;

36
src/go.pas
View File

@ -1,36 +0,0 @@
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.

12
src/gohamster.pas
View File

@ -1,18 +1,24 @@
program go_hamster;
uses crt, keys_m, arena_graphics_m, graphics_m, game_m, debug_m;
{uses crt, keys_m, arena_graphics_m, graphics_m, game_m,
ascii_digits_m, debug_m;}
function IsTerminalValid: boolean;
begin
IsTerminalValid := (ScreenWidth >= ScreenW) and (ScreenHeight >= ScreenH)
IsTerminalValid := (
(ScreenWidth >= ScreenW * WidthCoefficient)
and (ScreenHeight >= ScreenH)
)
end;
procedure PrintTerminalHelp;
begin
writeln('Increase your terminal size and try again.');
if ScreenWidth < ScreenW then
if ScreenWidth < ScreenW * WidthCoefficient then
begin
writeln('Your terminal width: ', ScreenWidth,
'. Required: ', ScreenW, '.')
'. Required: ', ScreenW * WidthCoefficient, '.')
end;
if ScreenHeight < ScreenH then
begin

520
src/graphics_m.pas
View File

@ -2,21 +2,31 @@ unit graphics_m;
interface
uses arena_graphics_m, arena_m, creature_m, hamster_m, trace_m, game_m, level_m;
uses arena_m, creature_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);
const
BorderSize = 1;
BorderSymbol = '|';
CellSize = 2;
DigitSpaceWidth = 1;
DigitWidth = 6;
InterfaceH = 6;
ScreenH = (ArenaW + InterfaceH) * CellSize + BorderSize;
ScreenW = (ArenaH - 1) * CellSize + BorderSize * 2; { 82 }
WidthCoefficient = 2;
procedure DrawAscii(x, y, h: integer; var a: array of string);
procedure DrawDigit(x, y, digit: integer);
procedure DrawExitState(s: exitState);
procedure DrawExit(var g: gameState);
procedure DrawGameOver;
procedure DrawKeyInfo;
procedure DrawLevel(var level: levelState);
procedure DrawLifes(n: integer);
procedure DrawLineX(x, y, len: integer; ch: char);
procedure DrawLineY(x, y, len: integer; ch: char);
procedure DrawRectangle(x0, y0, h, w: integer; ch: char);
procedure DrawMenuState(s: menuState);
procedure DrawMenu(var g: gameState);
procedure DrawPause(var g: gameState);
procedure DrawScore(s: integer);
procedure EraseAll;
procedure EraseExit;
procedure EraseExitState(s: exitState);
@ -25,9 +35,9 @@ procedure EraseKeyInfo;
procedure EraseLevel;
procedure EraseMenu;
procedure EraseMenuState(s: menuState);
procedure EraseRectangle(x, y, w, h: integer);
procedure ErasePause(var g: gameState);
procedure EraseStepTrace(var hamster: creature; t: tracePtr);
procedure EraseTrace(t: tracePtr; var a: arena);
procedure FillRectangle(x, y, w, h: integer; ch: char);
implementation
@ -35,191 +45,38 @@ 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;
MenuHeightPadding = 2;
HighScoreY = NewGameY + NewGameHeight + MenuHeightPadding;
MenuInfoY = HighScoreY + HighScoreHeight;
ContinueY = MenuInfoY + MenuInfoHeight;
ExitGameY = (ScreenH - ExitScreenHeight) div 2 - MenuHeightPadding;
ExitYesY = ExitGameY + ExitHeight - 1 + MenuHeightPadding;
ExitHamsterY = ExitYesY;
GameNameX = ScreenW * WidthCoefficient div 3 + 4;
MenuWidthPadding = 4;
MenuHamsterX = GameNameX - HamsterWidth - MenuWidthPadding;
ExitYesX = MenuHamsterX;
ExitNoX = ScreenW * WidthCoefficient - ExitYesX - NoWidth;
GameOverX = ScreenW * WidthCoefficient div 2 - GameNameWidth div 2;
GameOverY = ScreenH div 2 - GameOverHeight div 2;
HamsterNoX = ExitNoX - HamsterWidth - MenuWidthPadding;
HamsterYesX = ExitYesX - HamsterWidth - MenuWidthPadding;
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 = 1;
ExitGameY = (ScreenH - ExitScreenHeight) div 2 - MenuHeightPadding;
ExitYesX = MenuHamsterX;
ExitYesY = ExitGameY + ExitHeight - 1 + MenuHeightPadding;
ExitNoX = ScreenW * WidthCoefficient - ExitYesX - NoWidth;
ExitHamsterY = ExitYesY;
HamsterYesX = ExitYesX - HamsterWidth - MenuWidthPadding;
HamsterNoX = ExitNoX - HamsterWidth - MenuWidthPadding;
PauseXPadding = 3 * WidthCoefficient;
PauseYPadding = 1;
PauseX = (ScreenW * WidthCoefficient - PauseWidth) div 2;
PauseYPadding = 1;
PauseY = (ScreenH - PauseHeight) div 2;
PunctuationWidth = 3;
ArenaPauseUpperMarginY = 7;
ArenaPauseLowerMarginY = 14;
ArenaPauseMarginX = 9;
var
firstMenuDraw: boolean = true;
procedure EraseTrace(t: tracePtr; var a: arena);
begin
while t <> nil do
begin
if t^.prev = nil then
DrawEdge(t^.x, t^.y, a)
else
DrawArenaCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
end
end;
procedure EraseStepTrace(var hamster: creature; t: tracePtr);
var
i: integer;
begin
for i := 1 to hamster.movespeed do
begin
DrawArenaCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
end;
if GetLength(t) = 1 then
begin
if IsOnEdge(hamster) then
DrawArenaCell(t^.x, t^.y, ArenaSymbol)
else
DrawArenaCell(t^.x, t^.y, BorderSymbol)
end
end;
procedure DrawCreature(var cr: creature);
begin
DrawArenaCell(cr.curX, cr.curY, cr.symbol)
end;
procedure
DrawPreviousCell(var hamster: creature; var t: tracePtr; var a: arena);
var
prevX, prevY: integer;
begin
prevX := hamster.curX - hamster.dX;
prevY := hamster.curY - hamster.dY;
if t = nil then
DrawEdge(prevX, prevY, a);
if (a.borders[prevX][prevY]) and (t = nil) then
DrawArenaCell(prevX, prevY, BorderSymbol)
end;
procedure DrawStepTrace(t: tracePtr; hamsterDelta: integer);
var
i: integer;
begin
for i := 1 to HamsterDelta do
begin
t := t^.prev;
DrawArenaCell(t^.x, t^.y, TraceSymbol)
end
end;
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena);
var
prevX, prevY: integer;
begin
prevX := hamster.curX - hamster.dX;
prevY := hamster.curY - hamster.dY;
if IsOnEdge(prevX, prevY) and a.captured[prevX][prevY] then
DrawArenaCell(prevX, prevY, CaptureSymbol)
else
if IsOnBorder(prevX, prevY, a) then
DrawArenaCell(prevX, prevY, BorderSymbol)
else
DrawArenaCell(prevX, prevY, ArenaSymbol);
if t <> nil then
DrawStepTrace(t, hamster.movespeed);
DrawCreature(hamster);
DrawPreviousCell(hamster, t, a)
end;
procedure DrawAfterStep(var cr: creature; var a: arena);
var
prevX, prevY: integer;
begin
prevX := cr.curX - cr.dX;
prevY := cr.curY - cr.dY;
if IsOnEdge(prevX, prevY) and a.captured[prevX][prevY] then
DrawArenaCell(prevX, prevY, CaptureSymbol)
else
if IsOnBorder(prevX, prevY, a) then
DrawArenaCell(prevX, prevY, BorderSymbol)
else
DrawArenaCell(prevX, prevY, ArenaSymbol);
DrawCreature(cr)
end;
procedure FillRectangle(x, y, w, h: integer; ch: char);
var
i, j: integer;
begin
for i := 0 to h - 1 do
begin
GotoXY(x, y + i);
for j := 0 to w do
write(ch)
end;
GotoXY(1, 1)
end;
type
stackIntPtr = ^stackIntItem;
stackIntItem = record
val: integer;
next: stackIntPtr
end;
StackInt = record
top: stackIntPtr
end;
procedure StackIntInit(var s: StackInt);
begin
s.top := nil
end;
procedure StackPush(var st: StackInt; val: integer);
var
tmp: stackIntPtr;
begin
new(tmp);
tmp^.val := val;
tmp^.next := st.top;
st.top := tmp
end;
procedure StackPop(var st: StackInt);
var
tmp: stackIntPtr;
begin
tmp := st.top;
st.top := st.top^.next;
dispose(tmp)
end;
procedure DrawAscii(x, y, h: integer; var a: array of string);
var
i: integer;
@ -232,50 +89,62 @@ begin
GotoXY(1, 1)
end;
procedure EraseRectangle(x, y, w, h: integer);
begin
FillRectangle(x, y, w, h, ' ')
end;
procedure DrawDigit(x, y, digit: integer);
begin
DrawAscii(x, y, DigitHeight, DigitsAscii[digit])
end;
procedure DrawNumber(interfaceX: integer; s: longint);
var
x, y: integer;
i: integer = 0;
st: StackInt;
procedure DrawExitState(s: exitState);
begin
StackIntInit(st);
if s = 0 then
StackPush(st, 0);
while s <> 0 do
begin
StackPush(st, s mod Notation);
s := s div Notation
end;
x := interfaceX + InterfaceMarginX;
y := InterfaceMarginY;
while st.top <> nil do
begin
DrawDigit(x + (DigitWidth + SpaceWidth) * i, y, st.top^.val);
StackPop(st);
i := i + 1
case s of
exitYes:
DrawAscii(HamsterYesX, ExitHamsterY,
HamsterHeight, HamsterGGAscii);
exitNo:
DrawAscii(HamsterNoX, ExitHamsterY,
HamsterHeight, HamsterStayAscii)
end
end;
procedure DrawLifes(n: integer);
procedure DrawExit(var g: gameState);
var
realX: integer = ScreenW * WidthCoefficient;
begin
DrawNumber(LifeBarX, n)
DrawAscii((realX - ExitWidth) div 2, ExitGameY,
ExitScreenHeight, ExitScreen);
DrawExitState(g.curExit)
end;
procedure DrawScore(s: integer);
var
killBarX: integer = InterfaceCellW * 2 * WidthCoefficient + BorderSize;
procedure DrawGameOver;
begin
DrawNumber(killBarX, s)
DrawAscii(GameOverX, GameOverY, GameOverHeight, GameOverScreen)
end;
procedure DrawKeyInfo;
begin
DrawAscii(KeyInfoX, KeyInfoY, KeyInfoHeight, KeyInfoScreen)
end;
procedure DrawLineX(x, y, len: integer; ch: char);
var
i: integer;
begin
GotoXY(x, y);
for i := 1 to len do
write(ch);
GotoXY(1, 1)
end;
procedure DrawLineY(x, y, len: integer; ch: char);
var
i: integer;
begin
for i := 1 to len do
begin
GotoXY(x, y + i - 1);
write(ch)
end;
GotoXY(1, 1)
end;
procedure DrawMenuState(s: menuState);
@ -296,22 +165,119 @@ begin
end
end;
procedure DrawRectangle(x0, y0, h, w: integer; ch: char);
var
i: integer;
begin
DrawLineX(x0, y0, w, ch);
for i := 1 to h - 2 do
begin
GotoXY(x0, y0 + i);
write(ch);
GotoXY(x0 + w - 1, y0 + i);
write(ch)
end;
DrawLineX(x0, y0 + h - 1, w, ch);
GotoXY(1, 1)
end;
procedure DrawMenu(var g: gameState);
var
y: integer = GameNameY;
begin
if firstMenuDraw then { REFACTOR LATER }
begin
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient);
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient, BorderSymbol);
firstMenuDraw := not firstMenuDraw
end;
DrawAscii(GameNameX, y, GameMenuHeight, GameMenuScreen);
if not g.continueAllowed then
FillRectangle(GameNameX, ContinueY + ContinueHeight div 2,
ContinueWidth, 1, '-');
DrawLineX(GameNameX, ContinueY + ContinueHeight div 2,
ContinueWidth, '-');
DrawMenuState(g.curMenu)
end;
procedure FillRectangle(x, y, w, h: integer; ch: char);
var
i, j: integer;
begin
for i := 0 to h - 1 do
begin
GotoXY(x, y + i);
for j := 0 to w - 1 do
write(ch)
end;
GotoXY(1, 1)
end;
procedure EraseRectangle(x, y, w, h: integer);
begin
FillRectangle(x, y, w, h, ' ')
end;
procedure DrawPause(var g: gameState);
begin
EraseRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseWidth + PauseXPadding * 2,
PauseHeight + PauseYPadding * 2 + 1);
DrawRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseHeight + PauseYPadding * 2 + 1,
PauseWidth + PauseXPadding * 2,
BorderSymbol);
DrawAscii(PauseX, PauseY, PauseHeight, PauseAscii)
end;
procedure EraseAll;
begin
EraseRectangle(1, 1, ScreenW * WidthCoefficient, ScreenH)
end;
procedure EraseExit;
begin
EraseRectangle(HamsterYesX, ExitGameY,
ExitWidth + HamsterWidth + MenuWidthPadding,
ExitScreenHeight + MenuHeightPadding + YesHeight)
end;
procedure EraseExitState(s: exitState);
begin
case s of
exitYes:
EraseRectangle(HamsterYesX, ExitHamsterY,
HamsterWidth, HamsterHeight);
exitNo:
EraseRectangle(HamsterNoX, ExitHamsterY,
HamsterWidth, HamsterHeight)
end
end;
procedure EraseGameOver;
begin
EraseRectangle(GameOverX, GameOverY, GameOverWidth, GameOverHeight)
end;
procedure EraseKeyInfo;
begin
EraseRectangle(KeyInfoX, KeyInfoY, KeyInfoWidth, KeyInfoHeight)
end;
procedure EraseLevel;
begin
EraseRectangle(2, 2,
ScreenW * WidthCoefficient - BorderSize * BorderN,
ScreenH - BorderSize * BorderN);
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient, BorderSymbol)
end;
procedure EraseMenu;
begin
EraseRectangle(MenuHamsterX, GameNameY,
GameNameWidth + HamsterWidth + MenuWidthPadding,
ScreenH - GameNameY * 2)
end;
procedure EraseMenuState(s: menuState);
begin
case s of
@ -330,140 +296,12 @@ begin
end
end;
procedure EraseAll;
begin
EraseRectangle(1, 1, ScreenW * WidthCoefficient, ScreenH)
end;
procedure EraseMenu;
begin
EraseRectangle(MenuHamsterX, GameNameY,
GameNameWidth + HamsterWidth + MenuWidthPadding,
ScreenH - GameNameY * 2)
end;
procedure DrawExitState(s: exitState);
begin
case s of
exitYes:
DrawAscii(HamsterYesX, ExitHamsterY,
HamsterHeight, HamsterGGAscii);
exitNo:
DrawAscii(HamsterNoX, ExitHamsterY,
HamsterHeight, HamsterStayAscii)
end
end;
procedure DrawPause(var g: gameState);
begin
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,
PauseWidth + PauseXPadding * 2,
PauseHeight + PauseYPadding * 2 + 1)
end;
procedure DrawExit(var g: gameState);
var
realX: integer = ScreenW * WidthCoefficient;
begin
DrawAscii((realX - ExitWidth) div 2, ExitGameY,
ExitScreenHeight, ExitScreen);
DrawExitState(g.curExit)
end;
procedure EraseKeyInfo;
begin
EraseRectangle(KeyInfoX, KeyInfoY, KeyInfoWidth, KeyInfoHeight)
end;
procedure DrawKeyInfo;
begin
DrawAscii(KeyInfoX, KeyInfoY, KeyInfoHeight, KeyInfoScreen)
end;
procedure EraseExitState(s: exitState);
begin
case s of
exitYes:
EraseRectangle(HamsterYesX, ExitHamsterY,
HamsterWidth, HamsterHeight);
exitNo:
EraseRectangle(HamsterNoX, ExitHamsterY,
HamsterWidth, HamsterHeight)
end
end;
procedure EraseExit;
begin
EraseRectangle(HamsterYesX, ExitGameY,
ExitWidth + HamsterWidth + MenuWidthPadding,
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.

5
src/level_m.pas
View File

@ -10,7 +10,7 @@ type
t: tracePtr;
levelStarted, continueLevel, hamsterAlive: boolean;
h, g: creature;
life, score: integer
life, score, enemy: integer
end;
procedure InitLevel(var level: levelState);
@ -20,7 +20,7 @@ uses hamster_m, ghost_m;
const
StartScore = 0;
StartLifes = 0;
StartLifes = 3;
{
BonusTurns = 45;
StartSpeedBonus = 0;
@ -37,6 +37,7 @@ begin
level.hamsterAlive := true;
level.t := nil;
level.life := StartLifes;
level.enemy := 1;
level.score := StartScore
end;

2
src/trace_m.pas
View File

@ -31,7 +31,7 @@ procedure Pop(var t: tracePtr);
implementation
uses graphics_m;
uses arena_graphics_m;
function GetLength(var t: tracePtr): integer;
begin