feat/TD-016-add-hamster-animation

This commit is contained in:
gre-ilya 2026-02-28 22:20:24 +05:00
parent 591f92a235
commit 00befc8b4d
15 changed files with 692 additions and 360 deletions

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 enemy_packs_m.pas
trace_m.pas enemy_packs_m.pas sun_m.pas
all: gohamster

View File

@ -9,28 +9,34 @@ const
CaptureSymbol = '.';
procedure DrawAfterEnemyStep(var cr: creature; var a: arena);
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena);
procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena);
procedure DrawAliveEnemies(var e: creatureList);
procedure RedrawArea(var a: arena; arenaX, arenaY: integer);
procedure DrawArenaBorders(var a: arena);
procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char);
procedure DrawCapturedCell(x, y: integer);
procedure DrawArenaEdges;
procedure DrawCompleteBar;
procedure DrawPause;
procedure DrawTrace(t: tracePtr);
procedure DrawHamster(var h: creature);
procedure FillCellsCapture(var a: arena);
procedure FillCompleteBar(s: integer);
procedure DrawCreature(var cr: creature);
procedure DrawSimpleCreature(var cr: creature);
procedure DrawArenaCell(x, y: integer; var a: arena);
procedure DrawInterface;
procedure DrawLevel(var level: levelState; life, score: integer);
procedure DrawLevelUnpause(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);
procedure ErasePause;
implementation
uses ascii_arts_m, crt, math_m;
uses ascii_arts_m, crt, math_m, hamster_m;
const
ArenaPauseLowerMarginY = 14;
@ -40,7 +46,7 @@ const
InterfaceCellW = ScreenW div 3;
InterfaceMarginX = InterfaceCellW div 4;
InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1;
CompleteBarMarginY = 2;
CompleteBarMarginY = 4;
CompleteBarMarginX = 5;
CompleteBarX = (
InterfaceCellW * WidthCoefficient + BorderSize + CompleteBarMarginX
@ -51,12 +57,18 @@ const
CompleteBarW = (
InterfaceCellW * WidthCoefficient - CompleteBarMarginX * 2
);
BarWinX = CompleteBarW * 4 div 5;
BarWinX = CompleteBarW * LevelCompleteThreshold div TotalProcent;
LifeBarX = 17;
LifeNumberX = 27;
MidCellDelimiter = '_';
HamsterLifeY = 5;
DecimalBase = 10;
PauseXPadding = 3 * WidthCoefficient;
PauseX = (ScreenW * WidthCoefficient - PauseWidth) div 2;
PauseYPadding = 1;
PauseY = (ScreenH - PauseHeight) div 2;
InterfaceArenaCellX1 = 15;
InterfaceArenaCellX2 = 29;
procedure DrawCompleteBar;
begin
@ -76,7 +88,7 @@ begin
FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '+')
end;
procedure DrawCreature(var cr: creature);
procedure DrawSimpleCreature(var cr: creature);
begin
DrawFieldCell(cr.curX, cr.curY, cr.symbol)
end;
@ -89,7 +101,7 @@ begin
while tmp <> nil do
begin
if tmp^.cr^.alive then
DrawCreature(tmp^.cr^);
DrawSimpleCreature(tmp^.cr^);
tmp := tmp^.next
end
end;
@ -100,38 +112,34 @@ var
begin
prevX := cr.curX - cr.dX;
prevY := cr.curY - cr.dY;
if IsOnEdge(prevX, prevY) and a.captured[prevY][prevX] then
DrawFieldCell(prevX, prevY, CaptureSymbol)
else
if IsOnBorder(prevX, prevY, a) then
DrawFieldCell(prevX, prevY, BorderSymbol)
else
DrawFieldCell(prevX, prevY, ArenaSymbol);
DrawCreature(cr)
DrawArenaCell(prevX, prevY, a);
DrawSimpleCreature(cr)
end;
procedure DrawStepTrace(t: tracePtr; hamsterDelta: integer);
var
i: integer;
begin
for i := 1 to HamsterDelta do
for i := 1 to HamsterDelta + 2 do
begin
t := t^.prev;
if t = nil then
break;
DrawFieldCell(t^.x, t^.y, TraceSymbol)
end
end;
procedure
DrawPreviousCell(var hamster: creature; var t: tracePtr; var a: arena);
procedure DrawPreviousCell(var cr: creature; var a: arena);
var
prevX, prevY: integer;
begin
prevX := hamster.curX - hamster.dX;
prevY := hamster.curY - hamster.dY;
if t = nil then
prevX := cr.curX - cr.dX;
prevY := cr.curY - cr.dY;
DrawArenaCell(prevX, prevY, a);
if (a.borders[prevY][prevX]) and (t = nil) then
{Maybe delete later}
if a.borders[prevY][prevX] then
DrawFieldCell(prevX, prevY, BorderSymbol)
{Maybe delete later}
end;
procedure EraseStepTrace(var hamster: creature; t: tracePtr);
@ -152,31 +160,71 @@ begin
end
end;
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena);
var
prevX, prevY: integer;
procedure EraseCreatureInterface(x: integer);
begin
prevX := hamster.curX - hamster.dX;
prevY := hamster.curY - hamster.dY;
if IsOnEdge(prevX, prevY) and a.captured[prevY][prevX] then
DrawFieldCell(prevX, prevY, CaptureSymbol)
else
if IsOnBorder(prevX, prevY, a) then
DrawFieldCell(prevX, prevY, BorderSymbol)
else
DrawFieldCell(prevX, prevY, ArenaSymbol);
if t <> nil then
DrawStepTrace(t, hamster.movespeed);
DrawCreature(hamster);
DrawPreviousCell(hamster, t, a)
DrawFieldCell(x, 0, ' ');
DrawFieldCell(x, -1, ' ');
DrawFieldCell(x - 1, 0, ' ');
DrawFieldCell(x - 1, -1, ' ')
end;
procedure FillPauseCells(var a: arena);
procedure RedrawInterfaceArea(x: integer);
begin
EraseCreatureInterface(x);
if x = 1 then
DrawLineY(1, InterfaceBarH - HamsterHeight,
HamsterHeight, BorderSymbol);
if x = InterfaceArenaCellX1 then
DrawLineY(InterfaceCellW * WidthCoefficient,
InterfaceBarH - HamsterHeight,
HamsterHeight, BorderSymbol);
if x = InterfaceArenaCellX2 then
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1,
InterfaceBarH - HamsterHeight,
HamsterHeight, BorderSymbol);
if x = ArenaW then
DrawLineY(ArenaW * CellSize * WidthCoefficient,
InterfaceBarH - HamsterHeight,
HamsterHeight, BorderSymbol)
end;
procedure RedrawArea(var a: arena; arenaX, arenaY: integer);
begin
DrawArenaCell(arenaX, arenaY, a);
if arenaX - 1 > 0 then
DrawArenaCell(arenaX - 1, arenaY, a);
if arenaY - 1 > 0 then
DrawArenaCell(arenaX, arenaY - 1, a);
if arenaY - 2 > 0 then
DrawArenaCell(arenaX, arenaY - 2, a);
if (arenaX - 1 > 0) and (arenaY - 1 > 0) then
DrawArenaCell(arenaX - 1, arenaY - 1, a);
if (arenaX - 1 > 0) and (arenaY - 2 > 0) then
DrawArenaCell(arenaX - 1, arenaY - 2, a);
if arenaY = 1 then
RedrawInterfaceArea(arenaX)
end;
procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena);
var
arenaX, arenaY: integer;
begin
arenaX := h.curX - h.dX;
arenaY := h.curY - h.dY;
RedrawArea(a, arenaX, arenaY);
if t <> nil then
DrawTrace(t);
{DrawStepTrace(t, h.movespeed);}
if t = nil then
DrawPreviousCell(h, a)
end;
procedure FillCells(var a: arena; x1, y1, x2, y2: integer);
var
i, j: integer;
begin
for i := ArenaPauseUpperMarginY to (ArenaH - ArenaPauseLowerMarginY) do
for j := (1 + ArenaPauseMarginX) to (ArenaW - ArenaPauseMarginX) do
for i := y1 to y2 do
for j := x1 to x2 do
if a.borders[i][j] then
DrawFieldCell(j, i, BorderSymbol)
else
@ -184,6 +232,26 @@ begin
DrawFieldCell(j, i, CaptureSymbol)
end;
procedure FillCellsUnpause(var a: arena);
begin
FillCells(a, 1 + ArenaPauseMarginX, ArenaPauseUpperMarginY,
ArenaW - ArenaPauseMarginX, ArenaH - ArenaPauseLowerMarginY)
end;
procedure DrawPause;
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 DrawTrace(t: tracePtr);
begin
if t <> nil then
@ -250,17 +318,34 @@ end;
procedure DrawLevel(var level: levelState; life, score: integer);
begin
DrawInterface;
FillPauseCells(level.a);
FillCells(level.a, 1, 1, ArenaW, ArenaH);
DrawArenaEdges;
DrawTrace(level.t);
DrawCreature(level.h);
DrawAliveEnemies(level.enemyList);
DrawLifes(life);
DrawCompleteBar;
FillCompleteBar(level.cut);
DrawScore(score)
end;
procedure ErasePause;
begin
EraseRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseWidth + PauseXPadding * 2,
PauseHeight + PauseYPadding * 2 + 1)
end;
procedure DrawLevelUnpause(var level: levelState);
begin
ErasePause;
FillCellsUnpause(level.a);
DrawTrace(level.t);
DrawAliveEnemies(level.enemyList);
DrawCreature(level.h)
end;
procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char);
var
i, screenX, screenY: integer;
@ -276,6 +361,16 @@ begin
GotoXY(1, 1)
end;
procedure DrawFieldAscii(arenaX, arenaY, h, w: integer;
var a: array of string);
var
screenX, screenY: integer;
begin
screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient;
screenY := InterfaceBarH + (arenaY - 1) * CellSize;
DrawAscii(screenX, screenY, h, a)
end;
procedure DrawArenaEdges;
begin
DrawRectangle(1, InterfaceBarH,
@ -388,4 +483,51 @@ begin
end
end;
procedure DrawHamsterRunX(var h: creature);
var
xIdx: integer;
begin
xIdx := h.curX div HamsterMovespeed mod HamsterRunNX + 1;
if h.dX > 0 then
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth,
HamsterRightAscii[xIdx]);
if h.dX < 0 then
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth,
HamsterLeftAscii[xIdx])
end;
procedure DrawHamsterRunY(var h: creature);
var
yIdx: integer;
begin
yIdx := h.curY div HamsterMovespeed mod HamsterRunNY + 1;
if h.dY > 0 then
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth,
HamsterDownAscii[yIdx]);
if h.dY < 0 then
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth,
HamsterUpAscii[yIdx])
end;
procedure DrawHamster(var h: creature);
begin
if (h.dX = 0) and (h.dY = 0) then
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth,
HamsterStayAscii);
if h.dX <> 0 then
DrawHamsterRunX(h);
if h.dY <> 0 then
DrawHamsterRunY(h);
end;
end.

View File

@ -306,15 +306,25 @@ begin
StepOnTrace := idx > PreviousTraceIdx
end;
function StepBeyondEdge(var cr: creature): boolean;
function StepBeyondEdgeX(var cr: creature): boolean;
begin
StepBeyondEdge :=
StepBeyondEdgeX :=
(cr.dX > 0) and (cr.curX = ArenaW) or
(cr.dX < 0) and (cr.curX = 1) or
(cr.dX < 0) and (cr.curX = 1)
end;
function StepBeyondEdgeY(var cr: creature): boolean;
begin
StepBeyondEdgeY :=
(cr.dY > 0) and (cr.curY = ArenaH) or
(cr.dY < 0) and (cr.curY = 1)
end;
function StepBeyondEdge(var cr: creature): boolean;
begin
StepBeyondEdge := StepBeyondEdgeX(cr) or StepBeyondEdgeY(cr)
end;
function RandomBool: boolean;
begin
if Random(RandomOneToOne) = 1 then
@ -410,7 +420,7 @@ begin
MakeStep(h);
if FieldToEdge(h, t, a) or IsOnField(h, t, a) then
ChangeHamsterTrace(h, t);
DrawAfterStep(h, t, a)
DrawAfterHamsterStep(h, t, a)
end;
function GhostShouldTurn(var g: creature; var a: arena): boolean;
@ -419,88 +429,35 @@ var
begin
nextX := g.curX + g.dX;
nextY := g.curY + g.dY;
GhostShouldTurn := IsOnEdge(nextX, nextY) or a.borders[nextY][nextX]
GhostShouldTurn := StepBeyondEdge(g) or
a.borders[g.curY][g.curX] and a.captured[nextY][nextX]
end;
function BorderY(nextX, nextY: integer; var a: arena): boolean;
function VerticalBorder(nextX, nextY: integer; var a: arena): boolean;
begin
BorderY :=
VerticalBorder :=
a.borders[nextY][nextX] and
(a.borders[nextY - 1][nextX] or a.borders[nextY + 1][nextX])
end;
function BorderX(nextX, nextY: integer; var a: arena): boolean;
function HorizontalBorder(nextX, nextY: integer; var a: arena): boolean;
begin
BorderX :=
HorizontalBorder :=
a.borders[nextY][nextX] and
(a.borders[nextY][nextX - 1] or a.borders[nextY][nextX + 1])
end;
function IsCorner(x, y: integer; var a: arena): boolean;
begin
IsCorner := BorderX(x, y, a) and BorderY(x, y, a)
end;
function IsConcaveCorner(x, y: integer; var a: arena): boolean;
begin
IsConcaveCorner :=
a.borders[y][x - 1] and a.borders[y + 1][x] or
a.borders[y][x - 1] and a.borders[y - 1][x] or
a.borders[y][x + 1] and a.borders[y + 1][x] or
a.borders[y][x + 1] and a.borders[y - 1][x]
end;
function IsConvexCorner(var cr: creature; var a: arena): boolean;
var
x, y, nextX, nextY: integer;
begin
x := cr.curX;
y := cr.curY;
nextX := x + cr.dX;
nextY := y + cr.dY;
IsConvexCorner :=
IsCorner(nextX, nextY, a) and
not IsOnEdge(nextX, nextY) and
not IsConcaveCorner(x, y, a)
end;
procedure CornerTurn(var cr: creature; var a: arena);
var
x, y, nextX, nextY: integer;
begin
x := cr.curX;
y := cr.curY;
nextX := x + cr.dX;
nextY := y + cr.dY;
if not a.borders[y][nextX] and not a.borders[nextY][x] then
begin
cr.dX := cr.dX * -1;
cr.dY := cr.dY * -1
end
else
if a.borders[y][nextX] then
cr.dX := cr.dX * -1
else
cr.dY := cr.dY * -1
IsCorner := HorizontalBorder(x, y, a) and VerticalBorder(x, y, a)
end;
procedure TurnGhost(var g: creature; var a: arena);
var
nextX, nextY: integer;
begin
nextX := g.curX + g.dX;
nextY := g.curY + g.dY;
if IsConvexCorner(g, a) then
begin
CornerTurn(g, a)
end
else
begin
if OnEdgeX(nextX) or BorderY(nextX, nextY, a) then
if (OnEdgeX(g.curX) or VerticalBorder(g.curX, g.curY, a)) then
g.dX := g.dX * -1;
if OnEdgeY(nextY) or BorderX(nextX, nextY, a) then
if (OnEdgeY(g.curY) or HorizontalBorder(g.curX, g.curY, a)) then
g.dY := g.dY * -1
end
end;
procedure MakeEnemyStep(var e, h: creature; t: tracePtr; var a: arena);
@ -528,6 +485,26 @@ begin
end
end;
procedure TurnEnemy(var cr: creature; var a: arena);
begin
case cr.t of
creatureGhost:
TurnGhost(cr, a);
creatureSun:
TurnGhost(cr, a)
end
end;
function EnemyShouldTurn(var cr: creature; var a: arena): boolean;
begin
case cr.t of
creatureGhost:
EnemyShouldTurn := GhostShouldTurn(cr, a);
creatureSun:
EnemyShouldTurn := GhostShouldTurn(cr, a)
end
end;
procedure TurnStubbornEnemies(var a: arena; var e: creatureList);
var
turnCnt: integer = 0;
@ -536,10 +513,10 @@ begin
tmp := e.first;
while tmp <> nil do
begin
while tmp^.cr^.alive and GhostShouldTurn(tmp^.cr^, a) and
while tmp^.cr^.alive and EnemyShouldTurn(tmp^.cr^, a) and
(turnCnt < MaxTurnAttempts) do
begin
TurnGhost(tmp^.cr^, a);
TurnEnemy(tmp^.cr^, a);
turnCnt := turnCnt + 1
end;
turnCnt := 0;
@ -555,7 +532,7 @@ begin
tmp := e.first;
while tmp <> nil do
begin
if tmp^.cr^.alive and not GhostShouldTurn(tmp^.cr^, a) then
if tmp^.cr^.alive and not EnemyShouldTurn(tmp^.cr^, a) then
MakeEnemyStep(tmp^.cr^, h, t, a);
tmp := tmp^.next
end

View File

@ -78,7 +78,7 @@ const
)
);
GameMenuHeight = 44;
GameMenuHeight = 36;
GameMenuScreen: array[1..GameMenuHeight] of string = (
' _____ _ _ _ _',
' / ____| | | | | | | | |',
@ -102,14 +102,6 @@ const
'|_| \_|\___| \_/\_/ \_____|\__,_|_| |_| |_|\___|',
'',
'',
' _ _ _ _ _____',
'| | | (_) | | / ____|',
'| |__| |_ __ _| |__ | (___ ___ ___ _ __ ___',
'| __ | |/ _` | ''_ \ \___ \ / __/ _ \| ''__/ _ \',
'| | | | | (_| | | | | ____) | (_| (_) | | | __/',
'|_| |_|_|\__, |_| |_| |_____/ \___\___/|_| \___|',
' __/ |',
' |___/',
' _ __ _____ __',
'| |/ / |_ _| / _|',
'| '' / ___ _ _ | | _ __ | |_ ___',
@ -198,6 +190,109 @@ const
' |___|',
' / \'
);
HamsterRunNX = 4;
HamsterRightAscii: array[1..HamsterRunNX]
of array[1..HamsterHeight] of string = (
(
' _/)',
' ( 0)',
' | \_',
' |___|',
'-- \'
),
(
' _/)',
' ( 0)',
' | |_|',
' |___|',
' |>'
),
(
' _/)',
' ( 0)',
' |/_ |-',
' |___|',
'-- \'
),
(
' _/) ',
' ( 0)',
' | |_|',
' |___|',
' >| '
)
);
HamsterLeftAscii: array[1..HamsterRunNX]
of array[1..HamsterHeight] of string = (
(
' (\_ ',
' (0 )',
' _/ |',
' |___|',
' / --'
),
(
' (\_ ',
' (0 )',
' |_| |',
' |___|',
' <|'
),
(
' (\_',
' (0 )',
'-| _\|',
' |___|',
' / --'
),
(
' (\_',
' (0 )',
' |_| |',
' |___|',
' |<'
)
);
HamsterRunNY = 2;
HamsterDownAscii: array[1..HamsterRunNY]
of array[1..HamsterHeight] of string = (
(
' (\_/)',
'( 0_o )',
'\----- ',
' |___|\',
' - |'
),
(
' (\_/)',
'( o_0 )',
' -----/',
'/|___|',
' | -'
)
);
HamsterUpAscii: array[1..HamsterRunNY]
of array[1..HamsterHeight] of string = (
(
' (\_/)',
'( )',
'\----- ',
' |_*_|\',
' - |'
),
(
' (\_/)',
'( )',
' -----/',
'/|_*_|',
' | -'
)
);
HamsterGGAscii: array[1..HamsterHeight] of string = (
' (\_/)',
'( G_G )',
@ -205,6 +300,7 @@ const
' |___|',
' / \'
);
HamsterLifesAscii: array[1..HamsterHeight] of string = (
' (\_/) ',
'( 0_0 ) \ /',
@ -213,9 +309,8 @@ const
' / \ '
);
GameOverHeight = 40;
GameOverWidth = 62;
GameOverWidth = 63;
GameOverScreen: array[1..GameOverHeight] of string = (
' _____ __ __ ______ ',
' / ____| /\ | \/ | ____|',
@ -259,7 +354,6 @@ const
' |___/'
);
KeyInfoHeight = 42;
KeyInfoWidth = 98;
KeyInfoScreen: array[1..KeyInfoHeight] of string = (
@ -318,6 +412,26 @@ const
'|______\___| \_/ \___|_|'
);
GameCompleteHeight = 14;
GameCompleteWidth = 74;
GameCompleteScoreWidth = 50;
GameComplete: array[1..GameCompleteHeight] of string = (
' _____ _ _ _ ',
' / ____| | | | | | |',
'| | __ __ _ _ __ ___ ___ ___ ___ _ __ ___ _ __ | | ___| |_ ___| |',
'| | |_ |/ _` | ''_ ` _ \ / _ \ / __/ _ \| ''_ ` _ \| ''_ \| |/ _ \ __/ _ \ |',
'| |__| | (_| | | | | | | __/ | (_| (_) | | | | | | |_) | | __/ || __/_|',
' \_____|\__,_|_| |_| |_|\___| \___\___/|_| |_| |_| .__/|_|\___|\__\___(_)',
' | |',
' |_|',
'__ __',
'\ \ / / _ ',
' \ \_/ /__ _ _ _ __ ___ ___ ___ _ __ ___(_)',
' \ / _ \| | | | ''__| / __|/ __/ _ \| ''__/ _ \',
' | | (_) | |_| | | \__ \ (_| (_) | | | __/_ ',
' |_|\___/ \__,_|_| |___/\___\___/|_| \___(_)'
);
implementation
end.

View File

@ -9,7 +9,7 @@ type
creaturePtr = ^creature;
creature = record
curX, curY, dX, dY, moveSpeed: integer;
curX, curY, dX, dY, moveSpeed, animation: integer;
symbol: char;
alive: boolean;
t: creatureType;
@ -32,6 +32,7 @@ procedure AppendCreature(var lst: creatureList; c: creaturePtr);
procedure DisposeCreatureList(var lst: creatureList);
procedure KillCreature(var cr: creature);
procedure MakeStep(var cr: creature);
procedure DrawCreature(var cr: creature);
procedure InitCreatureList(var lst: creatureList);
procedure StopCreature(var cr: creature);
@ -99,4 +100,12 @@ begin
cr.dY := 0
end;
procedure DrawCreature(var cr: creature);
begin
case cr.t of
creatureHamster:
DrawHamster(cr);
end
end;
end.

View File

@ -7,6 +7,7 @@ uses arena_m, cell_m, creature_m;
procedure Debug;
procedure DebugCell(cell: cellItemPtr);
procedure Print(var m: arenaMatrix);
procedure PrintCallTime(s: string; y: integer);
procedure PrintCreatureDebug(var cr: creature);
procedure PrintEnemies(var lst: creatureList);
@ -96,4 +97,16 @@ begin
end
end;
var
callCnt: integer = 0;
procedure PrintCallTime(s: string; y: integer);
begin
GotoXY(10, 80 + y);
writeln(callCnt, ' GameCutPart');
callCnt := callCnt + 1;
GotoXY(1, 1)
end;
end.

View File

@ -13,17 +13,17 @@ procedure AppendEnemies(var lst: creatureList; t: enemyPackType);
implementation
uses ghost_m;
uses ghost_m, sun_m;
const
LevelGhostN: array[enemyPackType] of integer = (
4, 4, 2, 4, 4, 2, 4, 2, 4, 4
);
{
LevelSunN: array[enemyPackType] of integer = (
0, 1, 4, 2, 0, 2, 2, 2, 2, 0
);
{
LevelSnakeN: array[enemyPackType] of integer = (
0, 0, 0, 1, 2, 2, 2, 4, 2, 2
);
@ -46,7 +46,16 @@ begin
end;
procedure AppendRandomSuns(var lst: creatureList; t: enemyPackType);
var
i: integer;
c: creaturePtr;
begin
for i := 1 to LevelSunN[t] do
begin
new(c);
InitRandomSun(c^);
AppendCreature(lst, c)
end
end;
procedure AppendRandomSnakes(var lst: creatureList; t: enemyPackType);

View File

@ -6,10 +6,12 @@ interface
uses level_m, enemy_packs_m;
type
state = (gameLevelAnnounce, gameExit, gameMenu, gameStartLevel, gameScore,
gameKeyInfo, gamePause, gameContinueLevel, gameOver, gameComplete,
gameLevelComplete, gameSetRecord);
menuState = (menuNewGame, menuHighScore, menuKeyInfo, menuContinue);
state = (
gameLevelAnnounce, gameExit, gameMenu, gameStartLevel, gameKeyInfo,
gamePause, gameUnpauseLevel, gameOver, gameComplete,
gameLevelComplete, gameLevelLoop, gameContinueLevel
);
menuState = (menuNewGame, menuKeyInfo, menuContinue);
exitState = (exitYes, exitNo);
gameState = record
curExit: exitState;
@ -17,7 +19,7 @@ type
curState: state;
level, score, life: integer;
enemyPack: enemyPackType;
shutdown, continueAllowed: boolean;
shutdown, newGame, unpause, levelInited, skipScene: boolean;
end;
procedure DecreaseLife(var life: integer);
@ -29,15 +31,15 @@ procedure MainLoop(var g: gameState);
implementation
uses arena_m, arena_graphics_m, crt, creature_m, ghost_m, graphics_m,
hamster_m, keys_m, trace_m;
hamster_m, keys_m, trace_m, debug_m;
const
KeyDelayMs = 22;
MoveDelayMs = 100;
KeyDelayMs = 25;
MoveDelayMs = 120;
EraseLifeThreshold = 10;
AnnounceDelayMs = 1500;
LevelCompleteDelayMs = 1500;
LevelCount = 10;
LevelCount = 20;
StartLifeN = 3;
procedure DecreaseLife(var life: integer);
@ -50,82 +52,80 @@ end;
procedure InitGame(var g: gameState);
begin
g.continueAllowed := false;
g.curMenu := menuNewGame;
g.curState := gameMenu;
g.level := 1;
g.enemyPack := enemyPack1;
g.score := 0;
g.shutdown := false;
g.newGame := false;
g.skipScene := false;
g.life := StartLifeN
{
g.slowBonus := StartSlowBonus;
g.speedBonus := StartSpeedBonus
}
end;
procedure ShowExit(var g: gameState);
procedure RunExitState(var g: gameState; var level: levelState);
begin
DrawExit(g);
while g.curState = gameExit do
while (g.curState = gameExit) and not g.shutdown do
begin
delay(KeyDelayMs);
if keypressed then
HandleExitKey(g)
HandleKey(g, level)
end;
EraseExit
end;
procedure ShowScore(var g: gameState);
begin
{DrawHighScore;}
while g.curState = gameScore do
begin
delay(KeyDelayMs);
if keypressed then
HandleScoreKey(g)
end;
end;
procedure ShowKeyInfo(var g: gameState);
procedure RunInfoState(var g: gameState; var level: levelState);
begin
DrawKeyInfo;
while g.curState = gameKeyInfo do
while (g.curState = gameKeyInfo) and not g.shutdown do
begin
delay(KeyDelayMs);
if keypressed then
HandleInfoKey(g)
HandleKey(g, level)
end;
EraseKeyInfo
end;
procedure PauseLevel(var g: gameState);
procedure RunPauseState(var g: gameState; var level: levelState);
begin
DrawPause(g);
while g.curState = gamePause do
DrawPause;
while (g.curState = gamePause) and not g.shutdown do
begin
delay(KeyDelayMs);
if keypressed then
HandlePauseKey(g)
HandleKey(g, level)
end;
if g.curState = gameMenu then
EraseLevel;
if g.curState = gameContinueLevel then
ErasePause(g)
if g.curState = gameUnpauseLevel then
begin
DrawLevelUnpause(level);
level.unpause := true
end
end;
procedure ShowGameOver(var g: gameState; var level: levelState);
procedure RunGameOverState(var g: gameState; var level: levelState);
begin
DrawGameOver;
while g.curState = gameOver do
DisposeCreatureList(level.enemyList);
g.score := 0;
g.life := StartLifeN;
while (g.curState = gameOver) and not g.shutdown do
begin
delay(KeyDelayMs);
if keypressed then
HandleGameOverKey(g)
HandleKey(g, level)
end;
EraseGameOver;
if g.curState = gameContinueLevel then
if g.curState = gameLevelAnnounce then
begin
InitLevel(level, enemyPack1)
end
else
begin
g.levelInited := false;
DisposeCreatureList(level.enemyList)
end;
end;
procedure GameCutPart(var g: gameState; var level: levelState);
@ -141,28 +141,32 @@ begin
KillCapturedEnemies(level.a, level.enemyList)
end;
procedure GameNextLevel(var g: gameState);
procedure GameNextLevel(var g: gameState; var level: levelState);
begin
g.curState := gameLevelComplete;
g.level := g.level + 1;
if g.level = LevelCount then
DisposeCreatureList(level.enemyList);
if g.level > LevelCount then
begin
g.levelInited := false;
g.curState := gameComplete
end
else
begin
g.curState := gameLevelComplete
end
end;
procedure
GameKillHamster(var g: gameState; var level: levelState; var breakF: boolean);
GameKillHamster(var g: gameState; var level: levelState);
begin
if g.life <= 0 then
begin
g.curState := gameOver;
EraseLevel;
breakF := true;
Exit
end;
DecreaseLife(g.life);
KillHamster(level.h, level.t, level.a);
DrawAliveEnemies(level.enemyList);
level.h.alive := true
end;
@ -174,17 +178,15 @@ begin
begin
delay(KeyDelayMs);
if keypressed then
HandleLevelKey(level.h, level.a, level.t, g);
HandleKey(g, level);
if g.curState = gamePause then
break
end
end;
procedure LevelLoop(var g: gameState; var level: levelState);
var
breakF: boolean = false;
begin
while level.continueLevel do
while (g.curState = gameLevelLoop) and not g.shutdown do
begin
PollGameKeys(g, level);
if g.curState = gamePause then
@ -193,42 +195,67 @@ begin
GameCutPart(g, level);
if IsLevelComplete(level) then
begin
GameNextLevel(g);
GameNextLevel(g, level);
if g.curState = gameComplete then
EraseLevel;
break
end;
{Found bug: ghost didn't die in killed zone}
TurnStubbornEnemies(level.a, level.enemyList);
MakeEnemySteps(level.a, level.h, level.t, level.enemyList);
if not level.h.alive then
GameKillHamster(g, level, breakF);
if breakF then
break;
GameKillHamster(g, level);
if g.curState = gameOver then
begin
EraseLevel;
break
end;
if not HamsterStepPossible(level.h, level.t, level.a) then
StopCreature(level.h);
if not ((level.h.dX = 0) and (level.h.dY = 0)) then
MakeHamsterStep(level.h, level.t, level.a)
MakeHamsterStep(level.h, level.t, level.a);
DrawCreature(level.h) {Draw all creatures here}
end
end;
procedure StartLevel(var g: gameState; var level: levelState);
procedure RunLevelState(var g: gameState; var level: levelState);
begin
if g.newGame then
begin
g.levelInited := true;
g.level := 1;
g.life := StartLifeN;
g.newGame := false;
g.score := 0
end;
g.curState := gameLevelLoop;
InitLevel(level, enemyPack1);
DrawLevel(level, g.life, g.score);
LevelLoop(g, level)
end;
procedure UnpauseLevel(var g: gameState; var level: levelState);
begin
if level.unpause then
level.unpause := false
else
DrawLevel(level, g.life, g.score);
g.curState := gameLevelLoop;
LevelLoop(g, level)
end;
procedure ContinueLevel(var g: gameState; var level: levelState);
begin
DrawLevel(level, g.life, g.score);
LevelLoop(g, level)
g.curState := gamePause
end;
procedure ShowMenu(var g: gameState);
procedure RunMenuState(var g: gameState; var level: levelState);
var
prevMenu: boolean = false;
begin
g.curState := gameMenu;
while g.curState = gameMenu do
while (g.curState = gameMenu) and not g.shutdown do
begin
if (g.curState = gameMenu) and not prevMenu then
begin
@ -237,7 +264,7 @@ begin
end;
delay(KeyDelayMs);
if keypressed then
HandleMenuKey(g);
HandleKey(g, level);
if (g.curState <> gameMenu) and prevMenu then
begin
EraseMenu;
@ -249,43 +276,59 @@ begin
end
end;
procedure AnnounceLevel(var g: gameState);
procedure RunAnnounceState(var g: gameState; var level: levelState);
var
i: integer;
skip: boolean = false;
begin
DrawAnnounce(g.level);
for i := 1 to AnnounceDelayMs div KeyDelayMs do
begin
delay(KeyDelayMs);
if keypressed then
HandleSceneKey(skip);
if skip then
HandleKey(g, level);
if g.shutdown then
exit;
if g.skipScene then
break
end;
g.skipScene := false;
g.curState := gameStartLevel;
EraseAnnounce(g.level)
end;
procedure ShowLevelComplete(var g: gameState; var lvl: levelState);
procedure RunLevelCompleteState(var g: gameState; var level: levelState);
var
i: integer;
skip: boolean = false;
begin
FillCellsCapture(lvl.a);
DrawCreature(lvl.h);
FillCellsCapture(level.a);
DrawCreature(level.h);
for i := 1 to LevelCompleteDelayMs div KeyDelayMs do
begin
delay(KeyDelayMs);
if keypressed then
HandleSceneKey(skip);
if skip then
HandleKey(g, level);
if g.shutdown then
exit;
if g.skipScene then
break
end;
g.skipScene := false;
g.curState := gameLevelAnnounce;
EraseLevel
end;
procedure RunGameCompleteState(var g: gameState; var level: levelState);
begin
DrawGameComplete(g.score);
while (g.curState = gameComplete) and not g.shutdown do
begin
delay(KeyDelayMs);
if keypressed then
HandleKey(g, level)
end;
EraseLevel
end;
procedure MainLoop(var g: gameState);
var
level: levelState;
@ -293,25 +336,27 @@ begin
while not g.shutdown do
case g.curState of
gameLevelAnnounce:
AnnounceLevel(g);
RunAnnounceState(g, level);
gameExit:
ShowExit(g);
gameScore:
ShowScore(g);
RunExitState(g, level);
gameKeyInfo:
ShowKeyInfo(g);
RunInfoState(g, level);
gamePause:
PauseLevel(g);
RunPauseState(g, level);
gameStartLevel:
StartLevel(g, level);
RunLevelState(g, level);
gameUnpauseLevel:
UnpauseLevel(g, level);
gameContinueLevel: {Maybe here should be gameStartLevel}
ContinueLevel(g, level);
gameOver:
ShowGameOver(g, level);
RunGameOverState(g, level);
gameMenu:
ShowMenu(g);
RunMenuState(g, level);
gameLevelComplete:
ShowLevelComplete(g, level);
RunLevelCompleteState(g, level);
gameComplete:
RunGameCompleteState(g, level)
end;
EraseAll
end;

View File

@ -25,6 +25,7 @@ begin
g.dY := GhostStartDY * sigdy;
g.movespeed := GhostMovespeed;
g.alive := true;
g.animation := 1;
g.symbol := GhostSymbol
end;

View File

@ -21,6 +21,7 @@ procedure DrawDigit(x, y, digit: integer);
procedure DrawExitState(s: exitState);
procedure DrawExit(var g: gameState);
procedure DrawGameOver;
procedure DrawGameComplete(score: integer);
procedure DrawKeyInfo;
procedure DrawLineX(x, y, len: integer; ch: char);
procedure DrawLineY(x, y, len: integer; ch: char);
@ -28,7 +29,6 @@ procedure DrawNumber(x, y: integer; n: longint);
procedure DrawRectangle(x0, y0, h, w: integer; ch: char);
procedure DrawMenuState(s: menuState);
procedure DrawMenu(var g: gameState);
procedure DrawPause(var g: gameState);
procedure EraseAll;
procedure EraseAnnounce(lvl: integer);
procedure EraseExit;
@ -39,7 +39,6 @@ procedure EraseLevel;
procedure EraseMenu;
procedure EraseMenuState(s: menuState);
procedure EraseRectangle(x, y, w, h: integer);
procedure ErasePause(var g: gameState);
procedure FillRectangle(x, y, w, h: integer; ch: char);
implementation
@ -51,12 +50,11 @@ const
BigLetterWidth = 8;
BorderN = 2;
DecimalDelimiter = 10;
GameNameY = 12;
GameNameY = 16;
NameHeightPadding = 8;
NewGameY = GameNameY + GameNameHeight + NameHeightPadding;
MenuHeightPadding = 2;
HighScoreY = NewGameY + NewGameHeight + MenuHeightPadding;
MenuInfoY = HighScoreY + HighScoreHeight;
MenuInfoY = NewGameY + NewGameHeight + MenuHeightPadding;
ContinueY = MenuInfoY + MenuInfoHeight;
ExitGameY = (ScreenH - ExitScreenHeight) div 2 - MenuHeightPadding;
ExitYesY = ExitGameY + ExitHeight - 1 + MenuHeightPadding;
@ -66,30 +64,35 @@ const
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;
GameOverX = (ScreenW * WidthCoefficient - GameNameWidth) div 2;
GameOverY = (ScreenH - 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;
KeyInfoX = (ScreenW * WidthCoefficient - KeyInfoWidth) div 2;
KeyInfoY = (ScreenH - KeyInfoHeight) div 2;
LetterWidth = 5;
PauseXPadding = 3 * WidthCoefficient;
PauseX = (ScreenW * WidthCoefficient - PauseWidth) div 2;
PauseYPadding = 1;
PauseY = (ScreenH - PauseHeight) div 2;
LevelNumberMargin = 3;
GameCompleteX = (ScreenW * WidthCoefficient - GameCompleteWidth) div 2;
GameCompleteY = (ScreenH - GameCompleteHeight) div 2;
GameCompleteScoreX = GameCompleteX + GameCompleteScoreWidth + 3;
GameCompleteScoreY = GameCompleteY + 9;
var
firstMenuDraw: boolean = true;
procedure DrawAscii(x, y, h: integer; var a: array of string);
var
i: integer;
i, j: integer;
begin
for i := 1 to h do
begin
GotoXY(x, y + i - 1);
write(a[i - 1])
for j := 1 to Length(a[i - 1]) do
begin
if x + j - 1 < 0 then
continue;
GotoXY(x + j - 1, y + i - 1);
write(a[i - 1][j])
end
end;
GotoXY(1, 1)
end;
@ -158,9 +161,6 @@ begin
menuNewGame:
DrawAscii(MenuHamsterX, NewGameY + 1,
HamsterHeight, HamsterStayAscii);
menuHighScore:
DrawAscii(MenuHamsterX, HighScoreY + 1,
HamsterHeight, HamsterStayAscii);
menuKeyInfo:
DrawAscii(MenuHamsterX, MenuInfoY + 1,
HamsterHeight, HamsterStayAscii);
@ -196,7 +196,7 @@ begin
firstMenuDraw := not firstMenuDraw
end;
DrawAscii(GameNameX, y, GameMenuHeight, GameMenuScreen);
if not g.continueAllowed then
if not g.levelInited then
DrawLineX(GameNameX, ContinueY + ContinueHeight div 2,
ContinueWidth, '-');
DrawMenuState(g.curMenu)
@ -220,20 +220,6 @@ 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)
@ -289,9 +275,6 @@ begin
menuNewGame:
EraseRectangle(MenuHamsterX, NewGameY + 1,
HamsterWidth, HamsterHeight);
menuHighScore:
EraseRectangle(MenuHamsterX, HighScoreY + 1,
HamsterWidth, HamsterHeight);
menuKeyInfo:
EraseRectangle(MenuHamsterX, MenuInfoY + 1,
HamsterWidth, HamsterHeight);
@ -301,14 +284,6 @@ begin
end
end;
procedure ErasePause(var g: gameState);
begin
EraseRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseWidth + PauseXPadding * 2,
PauseHeight + PauseYPadding * 2 + 1)
end;
type
stackIntPtr = ^stackIntItem;
@ -404,4 +379,11 @@ begin
EraseRectangle(x, AnnounceY, w, LevelAnnounceHeight)
end;
procedure DrawGameComplete(score: integer);
begin
DrawAscii(GameCompleteX, GameCompleteY, GameCompleteHeight, GameComplete);
DrawNumber(GameCompleteScoreX, GameCompleteScoreY, score)
end;
end.

View File

@ -2,7 +2,7 @@ unit hamster_m;
interface
uses arena_graphics_m, arena_m, creature_m, trace_m;
uses arena_m, creature_m, trace_m;
const
HamsterStartX = 5;
@ -17,7 +17,7 @@ procedure KillHamster(var h: creature; var t: tracePtr; var a: arena);
implementation
uses graphics_m;
uses arena_graphics_m, graphics_m;
procedure InitHamster(var cr: creature);
begin
@ -35,7 +35,8 @@ procedure KillHamster(var h: creature; var t: tracePtr; var a: arena);
var
traceStart: tracePtr;
begin
DrawFieldCell(h.curX, h.curY, ArenaSymbol);
{DrawFieldCell(h.curX, h.curY, ArenaSymbol);}
RedrawArea(a, h.curX, h.curY);
EraseTrace(t, a);
DrawArenaCell(h.curX, h.curY, a);
GetStart(traceStart, t);

View File

@ -2,16 +2,19 @@ unit keys_m;
interface
uses crt, creature_m, arena_m, game_m, trace_m, hamster_m, debug_m;
uses crt, creature_m, arena_m, game_m, trace_m, hamster_m, debug_m, level_m;
const
ArrowDownOrd = -80;
ArrowLeftOrd = -75;
ArrowRightOrd = -77;
ArrowUpOrd = -72;
CtrlCOrd = 3;
EnterOrd = 13;
CtrlZOrd = 26;
EscOrd = 27;
EnterOrd = 13;
LowerNOrd = 110;
LowerYOrd = 121;
SpaceOrd = 32;
@ -21,7 +24,6 @@ const
OneOrd = 49;
TwoOrd = 50;
ThreeOrd = 51;
FourOrd = 52;
UpperQOrd = 81;
LowerQOrd = 113;
@ -32,15 +34,7 @@ const
{ Debug }
procedure GetKey(var keyCode: integer);
procedure HandleSceneKey(var f: boolean);
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 g: gameState);
procedure HandleGameOverKey(var g: gameState);
procedure HandleScoreKey(var g: gameState);
procedure HandlePauseKey(var g: gameState);
procedure HandleKey(var g: gameState; var level: levelState);
implementation
@ -62,7 +56,7 @@ begin
end
end;
procedure ChangeHamsterDelta(k: integer; var h: creature);
procedure ChangeHamsterDelta(var h: creature; k: integer);
begin
h.dX := 0;
h.dY := 0;
@ -80,42 +74,34 @@ begin
end
end;
procedure HandleLevelKey(var h: creature; var a: arena;
var t: tracePtr; var g: gameState);
var
k: integer;
procedure HandleLevelKey(var g: gameState; var level: levelState; k: integer);
begin
GetKey(k);
{DEBUG}
if k = BOrd then
Print(a.borders);
Print(level.a.borders);
if k = COrd then
Print(a.captured);
Print(level.a.captured);
if k = LOrd then
begin
GotoXY(2, 60);
write(' ');
GotoXY(2, 60);
writeln(GetLength(t));
writeln(GetLength(level.t));
GotoXY(1, 1)
end;
{DEBUG}
if (k = ArrowLeftOrd) or (k = ArrowRightOrd) or (k = ArrowUpOrd) or
(k = ArrowDownOrd) or (k = SpaceOrd) then
begin
ChangeHamsterDelta(k, h)
ChangeHamsterDelta(level.h, k)
end;
if k = EscOrd then
g.curState := gamePause
{
if k = CtrlCOrd then
continueLevel := false
}
end;
procedure PreviousMenuState(var g: gameState);
begin
if (g.curMenu = menuNewGame) and not g.continueAllowed then
if (g.curMenu = menuNewGame) and not g.levelInited then
g.curMenu := menuKeyInfo
else
if g.curMenu = menuNewGame then
@ -126,7 +112,7 @@ end;
procedure NextMenuState(var g: gameState);
begin
if (g.curMenu = menuKeyInfo) and not g.continueAllowed or
if (g.curMenu = menuKeyInfo) and not g.levelInited or
(g.curMenu = menuContinue) then
begin
g.curMenu := menuNewGame
@ -137,7 +123,7 @@ begin
end
end;
procedure ChangeMenuState(k: integer; var g: gameState);
procedure ChangeMenuState(var g: gameState; k: integer);
begin
case k of
ArrowUpOrd:
@ -147,20 +133,19 @@ begin
end
end;
procedure ChooseMenuNum(k: integer; var g: gameState);
procedure ChooseMenuNum(var g: gameState; k: integer);
begin
if (k = FourOrd) and not g.continueAllowed then
if (k = ThreeOrd) and not g.levelInited then
exit;
case k of
OneOrd: begin
g.newGame := true;
g.level := 1;
g.curState := gameLevelAnnounce
end;
TwoOrd:
g.curState := gameScore;
ThreeOrd:
g.curState := gameKeyInfo;
FourOrd:
ThreeOrd:
g.curState := gameContinueLevel
end
end;
@ -169,11 +154,10 @@ procedure ChooseMenuMarked(var g: gameState);
begin
case g.curMenu of
menuNewGame: begin
g.newGame := true;
g.level := 1;
g.curState := gameLevelAnnounce
end;
menuHighScore:
g.curState := gameScore;
menuKeyInfo:
g.curState := gameKeyInfo;
menuContinue:
@ -181,33 +165,27 @@ begin
end
end;
procedure HandleMenuKey(var g: gameState);
var
k: integer;
procedure HandleMenuKey(var g: gameState; k: integer);
begin
GetKey(k);
if (k = ArrowUpOrd) or (k = ArrowDownOrd) then
begin
EraseMenuState(g.curMenu);
ChangeMenuState(k, g);
ChangeMenuState(g, k);
DrawMenuState(g.curMenu)
end;
if (k = OneOrd) or (k = TwoOrd) or (k = ThreeOrd) or (k = FourOrd) then
ChooseMenuNum(k, g);
if (k = OneOrd) or (k = TwoOrd) or (k = ThreeOrd) then
ChooseMenuNum(g, k);
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;
procedure HandleGameOverKey(var g: gameState; k: integer);
begin
GetKey(k);
case k of
UpperYOrd, LowerYOrd:
g.curState := gameContinueLevel;
g.curState := gameLevelAnnounce;
UpperNOrd, LowerNOrd:
g.curState := gameMenu;
end
@ -223,11 +201,8 @@ begin
end
end;
procedure HandleExitKey(var g: gameState);
var
k: integer;
procedure HandleExitKey(var g: gameState; k: integer);
begin
GetKey(k);
if (k = ArrowLeftOrd) or (k = ArrowRightOrd) then
begin
EraseExitState(g.curExit);
@ -249,48 +224,63 @@ begin
g.curState := gameMenu
end;
procedure HandlePauseKey(var g: gameState);
var
k: integer;
procedure HandlePauseKey(var g: gameState; k: integer);
begin
GetKey(k);
if (k = EscOrd) or (k = SpaceOrd) then
g.curState := gameContinueLevel;
g.curState := gameUnpauseLevel;
if (k = UpperQOrd) or (k = LowerQOrd) then
g.curState := gameMenu;
g.curState := gameMenu
end;
procedure HandleInfoKey(var g: gameState);
var
k: integer;
procedure HandleInfoKey(var g: gameState; 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;
g.curState := gameMenu
end
end;
procedure HandleScoreKey(var g: gameState);
var
k: integer;
procedure HandleSceneKey(var g: gameState; 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;
procedure HandleSceneKey(var f: boolean);
var
k: integer;
begin
GetKey(k);
if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) then
f := true
g.skipScene := true
end;
procedure HandleGameCompleteKey(var g: gameState; k: integer);
begin
if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) then
g.curState := gameMenu
end;
procedure HandleKey(var g: gameState; var level: levelState);
var
k: integer;
begin
GetKey(k);
if (k = CtrlCOrd) or (k = CtrlZOrd) then
begin
g.shutdown := true;
exit
end;
case g.curState of
gameLevelComplete, gameLevelAnnounce:
HandleSceneKey(g, k);
gameLevelLoop:
HandleLevelKey(g, level, k);
gameExit:
HandleExitKey(g, k);
gameMenu:
HandleMenuKey(g, k);
gameKeyInfo:
HandleInfoKey(g, k);
gamePause:
HandlePauseKey(g, k);
gameOver:
HandleGameOverKey(g, k);
gameComplete:
HandleGameCompleteKey(g, k)
end
end;
end.

View File

@ -4,11 +4,14 @@ interface
uses arena_m, trace_m, creature_m, enemy_packs_m;
const
LevelCompleteThreshold = 85;
type
levelState = record
a: arena;
t: tracePtr;
levelStarted, continueLevel, hamsterAlive: boolean;
levelStarted, hamsterAlive, unpause: boolean;
h: creature;
cut: integer;
enemyList: creatureList;
@ -22,7 +25,6 @@ implementation
uses hamster_m, ghost_m, debug_m;
const
LevelCompleteThreshold = 80;
TotalProcent = 100;
{
BonusTurns = 45;
@ -46,10 +48,10 @@ begin
AppendEnemies(level.enemyList, t);
{PrintEnemies(level.enemyList);}
level.levelStarted := true;
level.continueLevel := true;
level.hamsterAlive := true;
level.t := nil;
level.cut := 0
level.cut := 0;
level.unpause := false
end;
end.

44
src/sun_m.pas Normal file
View File

@ -0,0 +1,44 @@
unit sun_m;
interface
uses creature_m;
const
SunSlowMovespeed = 2;
SunFastMovespeed = 4;
SunStartDX = SunSlowMovespeed;
SunStartDY = SunSlowMovespeed;
SunSymbol = 's';
procedure InitRandomSun(var g: creature);
implementation
uses arena_m, Math;
procedure InitSun(var g: creature; x, y, sigdx, sigdy: integer);
begin
g.t := creatureSun;
g.curX := x;
g.curY := y;
g.dX := SunStartDX * sigdx;
g.dY := SunStartDY * sigdy;
g.movespeed := SunSlowMovespeed;
g.alive := true;
g.animation := 1;
g.symbol := SunSymbol
end;
procedure InitRandomSun(var g: creature);
var
x, y, sigdx, sigdy: integer;
begin
sigdx := IfThen(RandomBool, 1, -1);
sigdy := IfThen(RandomBool, 1, -1);
x := RandomLR(2, ArenaW - 1);
y := RandomLR(2, ArenaH - 1);
InitSun(g, x, y, sigdx, sigdy)
end;
end.

View File

@ -182,6 +182,9 @@ begin
prevX := prevX + dX;
prevY := prevY + dY
end;
if IsOnTrace(prevX, prevY, t) then
TraceCrossed := true
else
TraceCrossed := false
end;