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

Merge pull request 'feat/TD-014-add-level-complete-bar' (#13) from dev into main

Browse Source 
Reviewed-on: #13
This commit is contained in:
gre-ilya 2026-02-28 11:40:30 +00:00
commit c76470599c
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 \ 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 \ 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 all: gohamster
@ -15,3 +15,4 @@ gohamster: $(GAME_SRC)
clean: clean:
rm *.o *.ppu gohamster 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.

331
src/arena_graphics_m.pas
View File

@ -2,84 +2,305 @@ unit arena_graphics_m;
interface interface
uses arena_m, creature_m; uses arena_m, creature_m, graphics_m, trace_m, level_m;
const const
ArenaSymbol = ' '; ArenaSymbol = ' ';
BorderSize = 1;
BorderSymbol = '|';
BorderSymbolX = '|';
MidCellDelimiter = '_';
BorderSymbolY = '|';
CaptureSymbol = '.'; 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 DrawArenaBorders(var a: arena);
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char); procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
procedure DrawArenaEdges; 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 DrawEdge(x, y: integer; var a: arena);
procedure DrawLevelInterface;
procedure DrawRectangle(x0, y0, h, w: integer);
procedure DrawInterface; 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 implementation
uses crt, math_m; uses ascii_arts_m, crt, math_m;
procedure DrawLineX(x, y, len: integer; ch: char); 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
FillRectangle(CompleteBarX, CompleteBarY, CompleteBarW, CompleteBarH, '-');
FillRectangle(CompleteBarX + BarWinX, CompleteBarY,
1, CompleteBarH, '|')
end;
procedure FillCompleteBar(s: integer);
var
cutedProcent: integer = 0;
fillW: integer;
begin
if s <> 0 then
cutedProcent := round(s / (TotalCells / TotalProcent));
fillW := round(CompleteBarW / TotalProcent * cutedProcent);
FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '|')
end;
procedure 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 var
i: integer; i: integer;
begin begin
GotoXY(x, y); for i := 1 to HamsterDelta do
for i := 1 to len do begin
write(ch); t := t^.prev;
GotoXY(1, 1) DrawArenaCell(t^.x, t^.y, TraceSymbol)
end
end; end;
procedure DrawLineY(x, y, len: integer); 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 var
i: integer; i: integer;
begin begin
for i := 1 to len do for i := 1 to hamster.movespeed do
begin begin
GotoXY(x, y + i - 1); DrawArenaCell(t^.x, t^.y, ArenaSymbol);
write(BorderSymbolY) t := t^.prev
end; end;
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; end;
procedure DrawRectangle(x0, y0, h, w: integer); procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena);
var var
i: integer; prevX, prevY: integer;
begin begin
DrawLineX(x0, y0, w, BorderSymbolX); prevX := hamster.curX - hamster.dX;
for i := 1 to h - 2 do prevY := hamster.curY - hamster.dY;
begin if IsOnEdge(prevX, prevY) and a.captured[prevX][prevY] then
GotoXY(x0, y0 + i); DrawArenaCell(prevX, prevY, CaptureSymbol)
write(BorderSymbolY); else
GotoXY(x0 + w - 1, y0 + i); if IsOnBorder(prevX, prevY, a) then
write(BorderSymbolY) DrawArenaCell(prevX, prevY, BorderSymbol)
else
DrawArenaCell(prevX, prevY, ArenaSymbol);
if t <> nil then
DrawStepTrace(t, hamster.movespeed);
DrawCreature(hamster);
DrawPreviousCell(hamster, t, a)
end; end;
DrawLineX(x0, y0 + h - 1, w, BorderSymbolX);
GotoXY(1, 1) 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; end;
procedure DrawInterface; procedure DrawInterface;
begin begin
DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient, BorderSymbolX); DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient, BorderSymbol);
DrawLineX(InterfaceCellW * WidthCoefficient, {DrawLineX(InterfaceCellW * WidthCoefficient,
InterfaceBarH div 2, InterfaceBarH div 2,
InterfaceCellW * WidthCoefficient + 1, MidCellDelimiter); InterfaceCellW * WidthCoefficient + 1, MidCellDelimiter);}
DrawLineY(InterfaceCellW * WidthCoefficient, 1, InterfaceBarH); DrawLineY(InterfaceCellW * WidthCoefficient, 1,
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1, InterfaceBarH) 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; end;
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char); procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
@ -100,7 +321,8 @@ end;
procedure DrawArenaEdges; procedure DrawArenaEdges;
begin begin
DrawRectangle(1, InterfaceBarH, DrawRectangle(1, InterfaceBarH,
ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient) ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient,
BorderSymbol)
end; end;
procedure DrawLeftEdge(y: integer); procedure DrawLeftEdge(y: integer);
@ -109,7 +331,7 @@ var
begin begin
y := Clamp(y, 1, ArenaW); y := Clamp(y, 1, ArenaW);
terminalY := InterfaceBarH + (y - 1) * CellSize; terminalY := InterfaceBarH + (y - 1) * CellSize;
DrawLineY(1, terminalY, CellSize) DrawLineY(1, terminalY, CellSize, BorderSymbol)
end; end;
procedure DrawRightEdge(y: integer); procedure DrawRightEdge(y: integer);
@ -118,7 +340,7 @@ var
begin begin
y := Clamp(y, 1, ArenaW); y := Clamp(y, 1, ArenaW);
terminalY := InterfaceBarH + (y - 1) * CellSize; terminalY := InterfaceBarH + (y - 1) * CellSize;
DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize) DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize, BorderSymbol)
end; end;
procedure DrawUpperEdge(x: integer); procedure DrawUpperEdge(x: integer);
@ -128,7 +350,7 @@ begin
x := Clamp(x, 1, ArenaH); x := Clamp(x, 1, ArenaH);
terminalX := (x - 1) * CellSize * WidthCoefficient + 1; terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient; sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbolX) DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbol)
end; end;
procedure DrawLowerEdge(x: integer); procedure DrawLowerEdge(x: integer);
@ -139,7 +361,7 @@ begin
terminalX := (x - 1) * CellSize * WidthCoefficient + 1; terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient; sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH + ArenaW * CellSize - 1, DrawLineX(terminalX, InterfaceBarH + ArenaW * CellSize - 1,
sizeX, BorderSymbolX) sizeX, BorderSymbol)
end; end;
procedure DrawArenaBorders(var a: arena); procedure DrawArenaBorders(var a: arena);
@ -168,11 +390,16 @@ begin
DrawLowerEdge(x) DrawLowerEdge(x)
end; end;
procedure DrawLevelInterface; procedure EraseTrace(t: tracePtr; var a: arena);
begin begin
clrscr; while t <> nil do
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient); begin
DrawInterface if t^.prev = nil then
DrawEdge(t^.x, t^.y, a)
else
DrawArenaCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
end
end; end;
end. end.

26
src/arena_m.pas
View File

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

10
src/ascii_arts_m.pas
View File

@ -153,7 +153,6 @@ const
' \__, |\___||___/ |_| |_|\___/', ' \__, |\___||___/ |_| |_|\___/',
' __/ |', ' __/ |',
' |___/' ' |___/'
); );
PauseHeight = 22; PauseHeight = 22;
@ -191,6 +190,7 @@ const
NoWidth = 13; NoWidth = 13;
HamsterHeight = 5; HamsterHeight = 5;
HamsterWidth = 7; HamsterWidth = 7;
HamsterLifesWidth = 13;
HamsterStayAscii: array[1..HamsterHeight] of string = ( HamsterStayAscii: array[1..HamsterHeight] of string = (
' (\_/)', ' (\_/)',
'( 0_0 )', '( 0_0 )',
@ -205,6 +205,14 @@ const
' |___|', ' |___|',
' / \' ' / \'
); );
HamsterLifesAscii: array[1..HamsterHeight] of string = (
' (\_/) ',
'( 0_0 ) \ /',
'/-----\ X ',
' |___| / \',
' / \ '
);
GameOverHeight = 40; GameOverHeight = 40;
GameOverWidth = 62; GameOverWidth = 62;

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; curMenu: menuState;
curState: state; curState: state;
level: integer; level: integer;
shutdown, continueAllowed: boolean; shutdown, continueAllowed: boolean
end; end;
procedure DecreaseLife(var level: levelState); procedure DecreaseLife(var level: levelState);
@ -37,8 +37,9 @@ const
procedure DecreaseLife(var level: levelState); procedure DecreaseLife(var level: levelState);
begin begin
EraseLifesNumber(level.life);
level.life := level.life - 1; level.life := level.life - 1;
DrawLifes(level.life) DrawLifesNumber(level.life)
end; end;
procedure InitGame(var g: gameState); procedure InitGame(var g: gameState);
@ -127,12 +128,16 @@ begin
begin begin
SetArenaBorder(level.t, level.a); SetArenaBorder(level.t, level.a);
CutPart(level.h, level.t, level.score, level.a); CutPart(level.h, level.t, level.score, level.a);
FillCompleteBar(level.score);
DrawScore(level.score) DrawScore(level.score)
end; end;
if level.g.alive and level.a.captured[level.g.curX][level.g.curY] then
KillCreature(level.g);
if level.g.alive then if level.g.alive then
MakeEnemyStep(level.g, level.h, level.t, level.a); MakeEnemyStep(level.g, level.h, level.t, level.a);
while level.g.alive and GhostShouldTurn(level.g, level.a) do while level.g.alive and GhostShouldTurn(level.g, level.a) do
TurnGhost(level.g, level.a); TurnGhost(level.g, level.a);
if not level.h.alive then if not level.h.alive then
begin begin
if level.life <= 0 then if level.life <= 0 then
@ -151,11 +156,6 @@ begin
StopCreature(level.h); StopCreature(level.h);
if not ((level.h.dX = 0) and (level.h.dY = 0)) then if not ((level.h.dX = 0) and (level.h.dY = 0)) then
MakeHamsterStep(level.h, level.t, level.a); 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 if g.curState = gamePause then
break break
end; 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; 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, debug_m;
{uses crt, keys_m, arena_graphics_m, graphics_m, game_m,
ascii_digits_m, debug_m;}
function IsTerminalValid: boolean; function IsTerminalValid: boolean;
begin begin
IsTerminalValid := (ScreenWidth >= ScreenW) and (ScreenHeight >= ScreenH) IsTerminalValid := (
(ScreenWidth >= ScreenW * WidthCoefficient)
and (ScreenHeight >= ScreenH)
)
end; end;
procedure PrintTerminalHelp; procedure PrintTerminalHelp;
begin begin
writeln('Increase your terminal size and try again.'); writeln('Increase your terminal size and try again.');
if ScreenWidth < ScreenW then if ScreenWidth < ScreenW * WidthCoefficient then
begin begin
writeln('Your terminal width: ', ScreenWidth, writeln('Your terminal width: ', ScreenWidth,
'. Required: ', ScreenW, '.') '. Required: ', ScreenW * WidthCoefficient, '.')
end; end;
if ScreenHeight < ScreenH then if ScreenHeight < ScreenH then
begin begin

520
src/graphics_m.pas
View File

@ -2,21 +2,31 @@ unit graphics_m;
interface 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); const
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena); BorderSize = 1;
procedure DrawCreature(var cr: creature); 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 DrawExitState(s: exitState);
procedure DrawExit(var g: gameState); procedure DrawExit(var g: gameState);
procedure DrawGameOver; procedure DrawGameOver;
procedure DrawKeyInfo; procedure DrawKeyInfo;
procedure DrawLevel(var level: levelState); procedure DrawLineX(x, y, len: integer; ch: char);
procedure DrawLifes(n: integer); procedure DrawLineY(x, y, len: integer; ch: char);
procedure DrawRectangle(x0, y0, h, w: integer; ch: char);
procedure DrawMenuState(s: menuState); procedure DrawMenuState(s: menuState);
procedure DrawMenu(var g: gameState); procedure DrawMenu(var g: gameState);
procedure DrawPause(var g: gameState); procedure DrawPause(var g: gameState);
procedure DrawScore(s: integer);
procedure EraseAll; procedure EraseAll;
procedure EraseExit; procedure EraseExit;
procedure EraseExitState(s: exitState); procedure EraseExitState(s: exitState);
@ -25,9 +35,9 @@ procedure EraseKeyInfo;
procedure EraseLevel; procedure EraseLevel;
procedure EraseMenu; procedure EraseMenu;
procedure EraseMenuState(s: menuState); procedure EraseMenuState(s: menuState);
procedure EraseRectangle(x, y, w, h: integer);
procedure ErasePause(var g: gameState); procedure ErasePause(var g: gameState);
procedure EraseStepTrace(var hamster: creature; t: tracePtr); procedure FillRectangle(x, y, w, h: integer; ch: char);
procedure EraseTrace(t: tracePtr; var a: arena);
implementation implementation
@ -35,191 +45,38 @@ uses crt, math_m, ascii_arts_m;
const const
BigLetterWidth = 8; BigLetterWidth = 8;
DigitWidth = 6;
BorderN = 2; BorderN = 2;
GameNameX = ScreenW * WidthCoefficient div 3 + 4;
GameNameY = 12; GameNameY = 12;
GameOverX = ScreenW * WidthCoefficient div 2 - GameNameWidth div 2;
GameOverY = ScreenH div 2 - GameOverHeight div 2;
NameHeightPadding = 8; NameHeightPadding = 8;
MenuHeightPadding = 2;
MenuWidthPadding = 4;
MenuHamsterX = GameNameX - HamsterWidth - MenuWidthPadding;
NewGameY = GameNameY + GameNameHeight + NameHeightPadding; NewGameY = GameNameY + GameNameHeight + NameHeightPadding;
MenuHeightPadding = 2;
HighScoreY = NewGameY + NewGameHeight + MenuHeightPadding; HighScoreY = NewGameY + NewGameHeight + MenuHeightPadding;
MenuInfoY = HighScoreY + HighScoreHeight; 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; KeyInfoX = ScreenW * WidthCoefficient div 2 - KeyInfoWidth div 2;
KeyInfoY = ScreenH div 2 - KeyInfoHeight div 2 - 1; KeyInfoY = ScreenH div 2 - KeyInfoHeight div 2 - 1;
ContinueY = MenuInfoY + MenuInfoHeight;
InterfaceMarginX = InterfaceCellW div 4;
InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1;
LetterWidth = 5; 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; PauseXPadding = 3 * WidthCoefficient;
PauseYPadding = 1;
PauseX = (ScreenW * WidthCoefficient - PauseWidth) div 2; PauseX = (ScreenW * WidthCoefficient - PauseWidth) div 2;
PauseYPadding = 1;
PauseY = (ScreenH - PauseHeight) div 2; PauseY = (ScreenH - PauseHeight) div 2;
PunctuationWidth = 3;
ArenaPauseUpperMarginY = 7;
ArenaPauseLowerMarginY = 14;
ArenaPauseMarginX = 9;
var var
firstMenuDraw: boolean = true; 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); procedure DrawAscii(x, y, h: integer; var a: array of string);
var var
i: integer; i: integer;
@ -232,50 +89,62 @@ begin
GotoXY(1, 1) GotoXY(1, 1)
end; end;
procedure EraseRectangle(x, y, w, h: integer);
begin
FillRectangle(x, y, w, h, ' ')
end;
procedure DrawDigit(x, y, digit: integer); procedure DrawDigit(x, y, digit: integer);
begin begin
DrawAscii(x, y, DigitHeight, DigitsAscii[digit]) DrawAscii(x, y, DigitHeight, DigitsAscii[digit])
end; end;
procedure DrawNumber(interfaceX: integer; s: longint); procedure DrawExitState(s: exitState);
var
x, y: integer;
i: integer = 0;
st: StackInt;
begin begin
StackIntInit(st); case s of
if s = 0 then exitYes:
StackPush(st, 0); DrawAscii(HamsterYesX, ExitHamsterY,
while s <> 0 do HamsterHeight, HamsterGGAscii);
begin exitNo:
StackPush(st, s mod Notation); DrawAscii(HamsterNoX, ExitHamsterY,
s := s div Notation HamsterHeight, HamsterStayAscii)
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
end end
end; end;
procedure DrawLifes(n: integer); procedure DrawExit(var g: gameState);
var
realX: integer = ScreenW * WidthCoefficient;
begin begin
DrawNumber(LifeBarX, n) DrawAscii((realX - ExitWidth) div 2, ExitGameY,
ExitScreenHeight, ExitScreen);
DrawExitState(g.curExit)
end; end;
procedure DrawScore(s: integer); procedure DrawGameOver;
var
killBarX: integer = InterfaceCellW * 2 * WidthCoefficient + BorderSize;
begin 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; end;
procedure DrawMenuState(s: menuState); procedure DrawMenuState(s: menuState);
@ -296,22 +165,119 @@ begin
end end
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); procedure DrawMenu(var g: gameState);
var var
y: integer = GameNameY; y: integer = GameNameY;
begin begin
if firstMenuDraw then { REFACTOR LATER } if firstMenuDraw then { REFACTOR LATER }
begin begin
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient); DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient, BorderSymbol);
firstMenuDraw := not firstMenuDraw firstMenuDraw := not firstMenuDraw
end; end;
DrawAscii(GameNameX, y, GameMenuHeight, GameMenuScreen); DrawAscii(GameNameX, y, GameMenuHeight, GameMenuScreen);
if not g.continueAllowed then if not g.continueAllowed then
FillRectangle(GameNameX, ContinueY + ContinueHeight div 2, DrawLineX(GameNameX, ContinueY + ContinueHeight div 2,
ContinueWidth, 1, '-'); ContinueWidth, '-');
DrawMenuState(g.curMenu) DrawMenuState(g.curMenu)
end; 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); procedure EraseMenuState(s: menuState);
begin begin
case s of case s of
@ -330,140 +296,12 @@ begin
end end
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); procedure ErasePause(var g: gameState);
begin begin
EraseRectangle(PauseX - PauseXPadding, EraseRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding, PauseY - PauseYPadding,
PauseWidth + PauseXPadding * 2 - 1, PauseWidth + PauseXPadding * 2,
PauseHeight + PauseYPadding * 2 + 1) PauseHeight + PauseYPadding * 2 + 1)
end; 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. end.

5
src/level_m.pas
View File

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

2
src/trace_m.pas
View File

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