feat/TD-015-added-multiple-enemies #14

Merged
gre-ilya merged 1 commits from dev into main 2026-02-28 16:33:52 +00:00
13 changed files with 755 additions and 327 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
trace_m.pas enemy_packs_m.pas
all: gohamster

View File

@ -10,15 +10,18 @@ const
procedure DrawAfterEnemyStep(var cr: creature; var a: arena);
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena);
procedure DrawAliveEnemies(var e: creatureList);
procedure DrawArenaBorders(var a: arena);
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char);
procedure DrawCapturedCell(x, y: integer);
procedure DrawArenaEdges;
procedure DrawCompleteBar; { TODO: IMPLEMENT LATER }
procedure DrawCompleteBar;
procedure FillCellsCapture(var a: arena);
procedure FillCompleteBar(s: integer);
procedure DrawCreature(var cr: creature);
procedure DrawEdge(x, y: integer; var a: arena);
procedure DrawArenaCell(x, y: integer; var a: arena);
procedure DrawInterface;
procedure DrawLevel(var level: levelState);
procedure DrawLevel(var level: levelState; life, score: integer);
procedure DrawLifesNumber(n: integer);
procedure DrawScore(s: integer);
procedure EraseStepTrace(var hamster: creature; t: tracePtr);
@ -33,7 +36,7 @@ const
ArenaPauseLowerMarginY = 14;
ArenaPauseMarginX = 9;
ArenaPauseUpperMarginY = 7;
InterfaceBarH = ScreenW - ArenaW * CellSize - BorderSize * 2; { 14 }
InterfaceBarH = ScreenH - ArenaH * CellSize + BorderSize; { 14 }
InterfaceCellW = ScreenW div 3;
InterfaceMarginX = InterfaceCellW div 4;
InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1;
@ -52,7 +55,8 @@ const
LifeBarX = 17;
LifeNumberX = 27;
MidCellDelimiter = '_';
Notation = 10;
HamsterLifeY = 5;
DecimalBase = 10;
procedure DrawCompleteBar;
begin
@ -69,12 +73,25 @@ begin
if s <> 0 then
cutedProcent := round(s / (TotalCells / TotalProcent));
fillW := round(CompleteBarW / TotalProcent * cutedProcent);
FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '|')
FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '+')
end;
procedure DrawCreature(var cr: creature);
begin
DrawArenaCell(cr.curX, cr.curY, cr.symbol)
DrawFieldCell(cr.curX, cr.curY, cr.symbol)
end;
procedure DrawAliveEnemies(var e: creatureList);
var
tmp: creatureItemPtr;
begin
tmp := e.first;
while tmp <> nil do
begin
if tmp^.cr^.alive then
DrawCreature(tmp^.cr^);
tmp := tmp^.next
end
end;
procedure DrawAfterEnemyStep(var cr: creature; var a: arena);
@ -83,13 +100,13 @@ var
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)
if IsOnEdge(prevX, prevY) and a.captured[prevY][prevX] then
DrawFieldCell(prevX, prevY, CaptureSymbol)
else
if IsOnBorder(prevX, prevY, a) then
DrawArenaCell(prevX, prevY, BorderSymbol)
DrawFieldCell(prevX, prevY, BorderSymbol)
else
DrawArenaCell(prevX, prevY, ArenaSymbol);
DrawFieldCell(prevX, prevY, ArenaSymbol);
DrawCreature(cr)
end;
@ -100,7 +117,7 @@ begin
for i := 1 to HamsterDelta do
begin
t := t^.prev;
DrawArenaCell(t^.x, t^.y, TraceSymbol)
DrawFieldCell(t^.x, t^.y, TraceSymbol)
end
end;
@ -112,9 +129,9 @@ 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)
DrawArenaCell(prevX, prevY, a);
if (a.borders[prevY][prevX]) and (t = nil) then
DrawFieldCell(prevX, prevY, BorderSymbol)
end;
procedure EraseStepTrace(var hamster: creature; t: tracePtr);
@ -123,15 +140,15 @@ var
begin
for i := 1 to hamster.movespeed do
begin
DrawArenaCell(t^.x, t^.y, ArenaSymbol);
DrawFieldCell(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)
DrawFieldCell(t^.x, t^.y, ArenaSymbol)
else
DrawArenaCell(t^.x, t^.y, BorderSymbol)
DrawFieldCell(t^.x, t^.y, BorderSymbol)
end
end;
@ -141,13 +158,13 @@ var
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)
if IsOnEdge(prevX, prevY) and a.captured[prevY][prevX] then
DrawFieldCell(prevX, prevY, CaptureSymbol)
else
if IsOnBorder(prevX, prevY, a) then
DrawArenaCell(prevX, prevY, BorderSymbol)
DrawFieldCell(prevX, prevY, BorderSymbol)
else
DrawArenaCell(prevX, prevY, ArenaSymbol);
DrawFieldCell(prevX, prevY, ArenaSymbol);
if t <> nil then
DrawStepTrace(t, hamster.movespeed);
DrawCreature(hamster);
@ -158,13 +175,13 @@ 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)
for i := ArenaPauseUpperMarginY to (ArenaH - ArenaPauseLowerMarginY) do
for j := (1 + ArenaPauseMarginX) to (ArenaW - ArenaPauseMarginX) do
if a.borders[i][j] then
DrawFieldCell(j, i, BorderSymbol)
else
if a.captured[j][i] then
DrawArenaCell(j, i, CaptureSymbol)
if a.captured[i][j] then
DrawFieldCell(j, i, CaptureSymbol)
end;
procedure DrawTrace(t: tracePtr);
@ -173,47 +190,11 @@ begin
t := t^.prev;
while t <> nil do
begin
DrawArenaCell(t^.x, t^.y, TraceSymbol);
DrawFieldCell(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;
@ -221,7 +202,7 @@ var
begin
while s <> 0 do
begin
s := s div 10;
s := s div DecimalBase;
cnt += 1
end;
x := interfaceX + InterfaceMarginX;
@ -229,28 +210,9 @@ begin
EraseRectangle(x, InterfaceMarginY, w, DigitHeight)
end;
procedure DrawInterfaceNumber(interfaceX: integer; s: longint);
var
x, y: integer;
i: integer = 0;
st: StackInt;
procedure DrawInterfaceNumber(interfaceX: integer; n: longint);
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
DrawNumber(interfaceX + InterfaceMarginX, InterfaceMarginY, n)
end;
procedure DrawScore(s: integer);
@ -272,38 +234,34 @@ end;
procedure DrawLifes(n: integer);
begin
DrawAscii(LifeBarX, 5, HamsterHeight, HamsterLifesAscii);
DrawAscii(LifeBarX, HamsterLifeY, HamsterHeight, HamsterLifesAscii);
DrawInterfaceNumber(LifeNumberX, n)
end;
procedure DrawInterface;
begin
DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient, BorderSymbol);
{DrawLineX(InterfaceCellW * WidthCoefficient,
InterfaceBarH div 2,
InterfaceCellW * WidthCoefficient + 1, MidCellDelimiter);}
DrawLineY(InterfaceCellW * WidthCoefficient, 1,
InterfaceBarH, BorderSymbol);
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1,
InterfaceBarH, BorderSymbol)
end;
procedure DrawLevel(var level: levelState);
procedure DrawLevel(var level: levelState; life, score: integer);
begin
DrawInterface;
FillPauseCells(level.a);
DrawTrace(level.t);
DrawCreature(level.h);
if level.g.alive then
DrawCreature(level.g);
DrawLifes(level.life);
DrawAliveEnemies(level.enemyList);
DrawLifes(life);
DrawCompleteBar;
FillCompleteBar(level.score);
DrawScore(level.score)
FillCompleteBar(level.cut);
DrawScore(score)
end;
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char);
var
i, screenX, screenY: integer;
begin
@ -329,7 +287,7 @@ procedure DrawLeftEdge(y: integer);
var
terminalY: integer;
begin
y := Clamp(y, 1, ArenaW);
y := Clamp(y, 1, ArenaH);
terminalY := InterfaceBarH + (y - 1) * CellSize;
DrawLineY(1, terminalY, CellSize, BorderSymbol)
end;
@ -338,7 +296,7 @@ procedure DrawRightEdge(y: integer);
var
terminalY: integer;
begin
y := Clamp(y, 1, ArenaW);
y := Clamp(y, 1, ArenaH);
terminalY := InterfaceBarH + (y - 1) * CellSize;
DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize, BorderSymbol)
end;
@ -347,7 +305,7 @@ procedure DrawUpperEdge(x: integer);
var
terminalX, sizeX: integer;
begin
x := Clamp(x, 1, ArenaH);
x := Clamp(x, 1, ArenaW);
terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbol)
@ -357,10 +315,10 @@ procedure DrawLowerEdge(x: integer);
var
terminalX, sizeX: integer;
begin
x := Clamp(x, 1, ArenaH);
x := Clamp(x, 1, ArenaW);
terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH + ArenaW * CellSize - 1,
DrawLineX(terminalX, InterfaceBarH + ArenaH * CellSize - 1,
sizeX, BorderSymbol)
end;
@ -368,38 +326,66 @@ procedure DrawArenaBorders(var a: arena);
var
i, j: integer;
begin
for i := 1 to ArenaW do
for j := 1 to ArenaH do
if a.borders[j][i] then
DrawArenaCell(j, i, BorderSymbol)
for i := 1 to ArenaH do
for j := 1 to ArenaW do
if a.borders[i][j] then
DrawFieldCell(j, i, BorderSymbol)
end;
procedure DrawEdge(x, y: integer; var a: arena);
procedure DrawEdge(x, y: integer);
begin
if a.captured[x][y] then
DrawArenaCell(x, y, CaptureSymbol)
else
DrawArenaCell(x, y, ArenaSymbol);
if x = 1 then
DrawLeftEdge(y);
if x = ArenaH then
if x = ArenaW then
DrawRightEdge(y);
if y = 1 then
DrawUpperEdge(x);
if y = ArenaW then
if y = ArenaH then
DrawLowerEdge(x)
end;
procedure DrawArenaCell(x, y: integer; var a: arena);
begin
if a.captured[y][x] then
DrawFieldCell(x, y, CaptureSymbol)
else
if a.borders[y][x] then
DrawFieldCell(x, y, BorderSymbol)
else
DrawFieldCell(x, y, ArenaSymbol);
if IsOnEdge(x, y) then
DrawEdge(x, y)
end;
procedure DrawCapturedCell(x, y: integer);
begin
DrawFieldCell(x, y, CaptureSymbol);
if IsOnEdge(x, y) then
DrawEdge(x, y)
end;
procedure EraseTrace(t: tracePtr; var a: arena);
begin
while t <> nil do
begin
if t^.prev = nil then
DrawEdge(t^.x, t^.y, a)
DrawArenaCell(t^.x, t^.y, a)
else
DrawArenaCell(t^.x, t^.y, ArenaSymbol);
DrawFieldCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
end
end;
procedure FillCellsCapture(var a: arena);
var
i, j: integer;
begin
for i := 1 to ArenaH do
for j := 1 to ArenaW do
begin
if not a.captured[i][j] then
DrawCapturedCell(j, i)
end
end;
end.

View File

@ -5,8 +5,8 @@ interface
uses creature_m, trace_m;
const
ArenaW = 33;
ArenaH = 41;
ArenaH = 33;
ArenaW = 41;
TotalCells = ArenaW * ArenaH;
RandomCutThreshold = 25;
RandomOneToOne = 2;
@ -26,12 +26,16 @@ HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean;
function IsOnBorder(var x, y: integer; var a: arena): boolean;
function IsOnEdge(var cr: creature): boolean;
function IsOnEdge(x, y: integer): boolean;
procedure CutPart(var hamster: creature; var t: tracePtr;
var cutOff: integer; var a: arena);
function RandomBool: boolean;
procedure ArenaCutPart(var hamster: creature; var t: tracePtr;
var cutOff: integer; var a: arena);
procedure InitArena(var a: arena);
procedure MakeEnemyStep(var e, h: creature; t: tracePtr; var a: arena);
procedure KillCapturedEnemies(var a: arena; var e: creatureList);
procedure MakeEnemySteps(var a: arena; var h: creature;
t: tracePtr; var e: creatureList);
procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
procedure SetArenaBorder(var t: tracePtr; var a: arena);
procedure TurnStubbornEnemies(var a: arena; var e: creatureList);
procedure TurnGhost(var g: creature; var a: arena);
implementation
@ -39,6 +43,7 @@ implementation
uses arena_graphics_m, cell_m, crt, graphics_m, math_m;
const
MaxTurnAttempts = 3;
TotalProcent = 100;
procedure Fill(var m: arenaMatrix; val: boolean);
@ -59,9 +64,9 @@ end;
function IsCellFree(x, y: integer; var a: arena): boolean;
begin
IsCellFree :=
(x <> 0) and (x <> ArenaH + 1) and
(y <> 0) and (y <> ArenaW + 1) and
not a.captured[x][y] and not a.borders[x][y]
(x <> 0) and (x <> ArenaW + 1) and
(y <> 0) and (y <> ArenaH + 1) and
not a.captured[y][x] and not a.borders[y][x]
end;
procedure ReleaseArenaCells(var q: QCell; var a: arena);
@ -71,7 +76,7 @@ begin
while not QCellIsEmpty(q) do
begin
cell := QCellGet(q);
a.captured[cell^.x][cell^.y] := false;
a.captured[cell^.y][cell^.x] := false;
QCellPop(q)
end
end;
@ -117,10 +122,10 @@ begin
cellPtr := QCellGet(captureQ);
InitCell(cell, cellPtr^.x, cellPtr^.y);
QCellPop(captureQ);
if a.captured[cell.x][cell.y] then
if a.captured[cell.y][cell.x] then
continue;
result := result + 1;
a.captured[cell.x][cell.y] := true;
a.captured[cell.y][cell.x] := true;
AddAvailableNeighbours(captureQ, cell, a);
QCellPush(releaseQ, cell)
end;
@ -142,23 +147,23 @@ begin
cellPtr := QCellGet(captureQ);
InitCell(cell, cellPtr^.x, cellPtr^.y);
QCellPop(captureQ);
if a.captured[cell.x][cell.y] then
if a.captured[cell.y][cell.x] then
continue;
cutOff := cutOff + 1;
a.captured[cell.x][cell.y] := true;
DrawArenaCell(cell.x, cell.y, CaptureSymbol);
a.captured[cell.y][cell.x] := true;
DrawFieldCell(cell.x, cell.y, CaptureSymbol);
AddAvailableNeighbours(captureQ, cell, a)
end
end;
function OnEdgeX(x: integer): boolean;
begin
OnEdgeX := (x = 1) or (x = ArenaH)
OnEdgeX := (x = 1) or (x = ArenaW)
end;
function OnEdgeY(y: integer): boolean;
begin
OnEdgeY := (y = 1) or (y = ArenaW)
OnEdgeY := (y = 1) or (y = ArenaH)
end;
function IsOnEdge(x, y: integer): boolean;
@ -169,21 +174,21 @@ end;
function YNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
YNeighboursCaptured :=
not OnEdgeY(y) and a.captured[x][y - 1] and a.captured[x][y + 1]
not OnEdgeY(y) and a.captured[y + 1][x] and a.captured[y - 1][x]
end;
function XNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
XNeighboursCaptured :=
not OnEdgeX(x) and a.captured[x + 1][y] and a.captured[x - 1][y]
not OnEdgeX(x) and a.captured[y][x + 1] and a.captured[y][x - 1]
end;
function DiagonalNeighboursCaptured(x, y: integer; var a: arena): boolean;
begin
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]
a.captured[y - 1][x - 1] and a.captured[y + 1][x - 1] and
a.captured[y - 1][x + 1] and a.captured[y + 1][x + 1]
end;
function ArenaCellCaptured(x, y: integer; var a: arena): boolean;
@ -195,29 +200,29 @@ end;
procedure CaptureArenaBorder(x, y: integer; var a: arena);
begin
a.borders[x][y] := false;
a.captured[x][y] := true;
DrawArenaCell(x, y, CaptureSymbol)
a.borders[y][x] := false;
a.captured[y][x] := true;
DrawFieldCell(x, y, CaptureSymbol)
end;
procedure CaptureCutBorders(var a: arena; var cutOff: integer); {rename, slow}
var
i, j: integer;
begin
for i := 1 to ArenaW do
for j := 1 to ArenaH do
if a.borders[j][i] and ArenaCellCaptured(j, i, a) then
for i := 1 to ArenaH do
for j := 1 to ArenaW do
if a.borders[i][j] and ArenaCellCaptured(j, i, a) then
begin
cutOff := cutOff + 1;
CaptureArenaBorder(j, i, a)
end;
end
end;
procedure SetArenaBorder(var t: tracePtr; var a: arena);
begin
if t <> nil then
begin
a.borders[t^.x][t^.y] := true;
a.borders[t^.y][t^.x] := true;
SetArenaBorder(t^.prev, a)
end
end;
@ -225,29 +230,29 @@ end;
function IsOnEdge(var cr: creature): boolean;
begin
IsOnEdge :=
(cr.curX = 1) or (cr.curX = ArenaH) or (cr.curY = 1) or
(cr.curY = ArenaW)
(cr.curX = 1) or (cr.curX = ArenaW) or (cr.curY = 1) or
(cr.curY = ArenaH)
end;
function IsOnBorder(var x, y: integer; var a: arena): boolean;
begin
IsOnBorder :=
a.borders[x][y] and (
a.captured[x - 1][y + 1] or
a.captured[x - 1][y - 1] or
a.captured[x + 1][y + 1] or
a.captured[x + 1][y - 1]
a.borders[y][x] and (
a.captured[y + 1][x - 1] or
a.captured[y - 1][x - 1] or
a.captured[y + 1][x + 1] or
a.captured[y - 1][x + 1]
)
end;
function IsOnBorder(var cr: creature; var a: arena): boolean;
begin
IsOnBorder :=
a.borders[cr.curX][cr.curY] and (
a.captured[cr.curX - 1][cr.curY + 1] or
a.captured[cr.curX - 1][cr.curY - 1] or
a.captured[cr.curX + 1][cr.curY + 1] or
a.captured[cr.curX + 1][cr.curY - 1]
a.borders[cr.curY][cr.curX] and (
a.captured[cr.curY + 1][cr.curX - 1] or
a.captured[cr.curY - 1][cr.curX - 1] or
a.captured[cr.curY + 1][cr.curX + 1] or
a.captured[cr.curY - 1][cr.curX + 1]
)
end;
@ -281,23 +286,22 @@ var
begin
v1 := val1;
v2 := val2;
if v1 > v2 then
begin
tmp := v1;
v1 := v2;
v2 := tmp
end; {Should be 100 or OneHundred? It's A.V.Stolyarov to decide!!!}
end;
biggerProcent := v2 / TotalProcent;
LowerToBiggerRatio := Round(100 - v1 / biggerProcent)
LowerToBiggerRatio := Round(TotalProcent - v1 / biggerProcent)
end;
function StepOnTrace(var hamster: creature; var t: tracePtr): boolean;
var
nextX, nextY, idx: integer;
begin
nextX := Clamp(hamster.curX + hamster.dX, 1, ArenaH);
nextY := Clamp(hamster.curY + hamster.dY, 1, ArenaW);
nextX := Clamp(hamster.curX + hamster.dX, 1, ArenaW);
nextY := Clamp(hamster.curY + hamster.dY, 1, ArenaH);
idx := FindIndex(t, nextX, nextY, 1);
StepOnTrace := idx > PreviousTraceIdx
end;
@ -305,9 +309,9 @@ end;
function StepBeyondEdge(var cr: creature): boolean;
begin
StepBeyondEdge :=
(cr.dX > 0) and (cr.curX = ArenaH) or
(cr.dX > 0) and (cr.curX = ArenaW) or
(cr.dX < 0) and (cr.curX = 1) or
(cr.dY > 0) and (cr.curY = ArenaW) or
(cr.dY > 0) and (cr.curY = ArenaH) or
(cr.dY < 0) and (cr.curY = 1)
end;
@ -331,17 +335,15 @@ begin
end;
{refactor? pass just level later}
procedure CutPart(var hamster: creature; var t: tracePtr;
var cutOff: integer; var a: arena);
procedure ArenaCutPart(var hamster: creature; var t: tracePtr;
var cutOff: integer; var a: arena);
var
area1, area2, diffProcent: integer;
part1, part2, cutFigure: cellItem;
begin
GetPartsCells(t, part1, part2, a);
area1 := GetFigureArea(part1, a);
area2 := GetFigureArea(part2, a);
diffProcent := LowerToBiggerRatio(area1, area2);
if diffProcent <= RandomCutThreshold then
cutFigure := ChooseRandomCell(part1, part2)
@ -363,18 +365,18 @@ HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean;
var
nextX, nextY, midX, midY: integer;
begin
nextX := Clamp(h.curX + h.dX, 1, ArenaH);
nextY := Clamp(h.curY + h.dY, 1, ArenaW);
midX := Clamp(h.curX + (h.dX div 2), 1, ArenaH);
midY := Clamp(h.curY + (h.dY div 2), 1, ArenaW);
nextX := Clamp(h.curX + h.dX, 1, ArenaW);
nextY := Clamp(h.curY + h.dY, 1, ArenaH);
midX := Clamp(h.curX + (h.dX div 2), 1, ArenaW);
midY := Clamp(h.curY + (h.dY div 2), 1, ArenaH);
HamsterStepPossible :=
not StepOnTrace(h, t)
and (not a.captured[midX][midY] or IsOnEdge(nextX, nextY))
and (not a.captured[midY][midX] or IsOnEdge(nextX, nextY))
and not StepBeyondEdge(h)
and not (
not IsOnEdge(h) and a.borders[h.curX][h.curY] and
a.captured[midX][midY]
)
not IsOnEdge(h) and a.borders[h.curY][h.curX] and
a.captured[midY][midX]
);
end;
function
@ -385,8 +387,8 @@ begin
midX := hamster.curX - (hamster.dX div 2);
midY := hamster.curY - (hamster.dY div 2);
FieldToEdge :=
IsOnEdge(hamster) and (t = nil) and not a.captured[midX][midY] and
not a.borders[hamster.curX][hamster.curY] and
IsOnEdge(hamster) and (t = nil) and not a.captured[midY][midX] and
not a.borders[hamster.curY][hamster.curX] and
not (IsOnEdge(midX, midY))
end;
@ -399,8 +401,8 @@ begin
midY := hamster.curY - (hamster.dY div 2);
IsOnField :=
not (IsOnEdge(hamster) and (t = nil)) and
not a.captured[hamster.curX][hamster.curY] and
not a.borders[midX][midY]
not a.captured[hamster.curY][hamster.curX] and
not a.borders[midY][midX]
end;
procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
@ -417,21 +419,21 @@ var
begin
nextX := g.curX + g.dX;
nextY := g.curY + g.dY;
GhostShouldTurn := IsOnEdge(nextX, nextY) or a.borders[nextX][nextY]
GhostShouldTurn := IsOnEdge(nextX, nextY) or a.borders[nextY][nextX]
end;
function BorderY(nextX, nextY: integer; var a: arena): boolean;
begin
BorderY :=
a.borders[nextX][nextY] and
(a.borders[nextX][nextY - 1] or a.borders[nextX][nextY + 1])
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;
begin
BorderX :=
a.borders[nextX][nextY] and
(a.borders[nextX - 1][nextY] or a.borders[nextX + 1][nextY])
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;
@ -442,10 +444,10 @@ end;
function IsConcaveCorner(x, y: integer; var a: arena): boolean;
begin
IsConcaveCorner :=
a.borders[x - 1][y] and a.borders[x][y + 1] or
a.borders[x - 1][y] and a.borders[x][y - 1] or
a.borders[x + 1][y] and a.borders[x][y + 1] or
a.borders[x + 1][y] and a.borders[x][y - 1]
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;
@ -470,13 +472,13 @@ begin
y := cr.curY;
nextX := x + cr.dX;
nextY := y + cr.dY;
if not a.borders[nextX][y] and not a.borders[x][nextY] then
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[nextX][y] then
if a.borders[y][nextX] then
cr.dX := cr.dX * -1
else
cr.dY := cr.dY * -1
@ -513,4 +515,50 @@ begin
h.alive := false
end;
procedure KillCapturedEnemies(var a: arena; var e: creatureList);
var
tmp: creatureItemPtr;
begin
tmp := e.first;
while tmp <> nil do
begin
if tmp^.cr^.alive and a.captured[tmp^.cr^.curY][tmp^.cr^.curX] then
KillCreature(tmp^.cr^);
tmp := tmp^.next
end
end;
procedure TurnStubbornEnemies(var a: arena; var e: creatureList);
var
turnCnt: integer = 0;
tmp: creatureItemPtr;
begin
tmp := e.first;
while tmp <> nil do
begin
while tmp^.cr^.alive and GhostShouldTurn(tmp^.cr^, a) and
(turnCnt < MaxTurnAttempts) do
begin
TurnGhost(tmp^.cr^, a);
turnCnt := turnCnt + 1
end;
turnCnt := 0;
tmp := tmp^.next
end
end;
procedure MakeEnemySteps(var a: arena; var h: creature;
t: tracePtr; var e: creatureList);
var
tmp: creatureItemPtr;
begin
tmp := e.first;
while tmp <> nil do
begin
if tmp^.cr^.alive and not GhostShouldTurn(tmp^.cr^, a) then
MakeEnemyStep(tmp^.cr^, h, t, a);
tmp := tmp^.next
end
end;
end.

View File

@ -307,6 +307,18 @@ const
' |_|'
);
LevelAnnounceHeight = 6;
LevelAnnounceWidth = 24;
LevelAnnounce: array[1..LevelAnnounceHeight] of string = (
' _ _ ',
'| | | |',
'| | _____ _____| |',
'| | / _ \ \ / / _ \ |',
'| |___| __/\ V / __/ |',
'|______\___| \_/ \___|_|'
);
implementation
end.

View File

@ -3,32 +3,94 @@ unit creature_m;
interface
type
creatureType = (creatureHamster, creatureGhost, creatureSun,
creatureSnake, creatureDrop);
creaturePtr = ^creature;
creature = record
curX, curY, dX, dY, moveSpeed: integer;
symbol: char;
alive: boolean
alive: boolean;
t: creatureType;
end;
procedure
InitCreature(var cr: creature; curX, curY, movespeed: integer; symbol: char);
creatureItemPtr = ^creatureItem;
creatureItem = record
cr: creaturePtr;
next: creatureItemPtr
end;
creatureList = record
len: integer;
first, last: creatureItemPtr;
end;
function RandomLR(l, r: integer): integer;
procedure AppendCreature(var lst: creatureList; c: creaturePtr);
procedure DisposeCreatureList(var lst: creatureList);
procedure KillCreature(var cr: creature);
procedure StopCreature(var cr: creature);
procedure MakeStep(var cr: creature);
procedure InitCreatureList(var lst: creatureList);
procedure StopCreature(var cr: creature);
implementation
uses arena_graphics_m, arena_m, math_m;
procedure
InitCreature(var cr: creature; curX, curY, movespeed: integer; symbol: char);
function RandomLR(l, r: integer): integer;
begin
cr.curX := curX;
cr.curY := curY;
cr.dX := 0;
cr.dY := 0;
cr.movespeed := moveSpeed;
cr.alive := true;
cr.symbol := symbol
RandomLR := l + Random(r - l + 1)
end;
procedure AppendCreature(var lst: creatureList; c: creaturePtr);
var
item: creatureItemPtr;
begin
new(item);
item^.cr := c;
item^.next := nil;
if lst.first = nil then
lst.first := item
else
lst.last^.next := item;
lst.last := item
end;
procedure DisposeCreatureList(var lst: creatureList);
var
tmp: creatureItemPtr;
begin
while lst.first <> nil do
begin
tmp := lst.first;
lst.first := lst.first^.next;
if lst.first = nil then
lst.last := nil;
dispose(tmp^.cr);
dispose(tmp);
lst.len := lst.len - 1
end
end;
procedure KillCreature(var cr: creature);
begin
cr.alive := false;
DrawFieldCell(cr.curX, cr.curY, CaptureSymbol)
end;
procedure MakeStep(var cr: creature);
begin
cr.curX := Clamp(cr.curX + cr.dX, 1, ArenaW);
cr.curY := Clamp(cr.curY + cr.dY, 1, ArenaH)
end;
procedure InitCreatureList(var lst: creatureList);
begin
lst.len := 0;
lst.first := nil;
lst.last := nil
end;
procedure StopCreature(var cr: creature);
@ -37,16 +99,4 @@ begin
cr.dY := 0
end;
procedure MakeStep(var cr: creature);
begin
cr.curX := Clamp(cr.curX + cr.dX, 1, ArenaH);
cr.curY := Clamp(cr.curY + cr.dY, 1, ArenaW)
end;
procedure KillCreature(var cr: creature);
begin
cr.alive := false;
DrawArenaCell(cr.curX, cr.curY, CaptureSymbol)
end;
end.

View File

@ -7,8 +7,8 @@ uses arena_m, cell_m, creature_m;
procedure Debug;
procedure DebugCell(cell: cellItemPtr);
procedure Print(var m: arenaMatrix);
procedure PrintCreatureDebug(var cr: creature);
procedure PrintEnemies(var lst: creatureList);
implementation
@ -16,6 +16,8 @@ uses crt;
const
DebugMsg = '===============DEBUG===============';
DebugPrintY = 10;
DebugPrintX = 10;
var
DebugTmp: integer = 2;
@ -38,10 +40,10 @@ procedure Print(var m: arenaMatrix);
var
i, j: integer;
begin
for i := 1 to ArenaW do
for i := 1 to ArenaH do
begin
for j := 1 to ArenaH do
if m[j][i] then
for j := 1 to ArenaW do
if m[i][j] then
write(1, ' ')
else
write(0, ' ');
@ -61,4 +63,37 @@ begin
writeln(cr.curX, ' ', cr.curY, ' ', cr.dX, ' ', cr.dY)
end;
function EnemyToString(cr: creaturePtr): string;
begin
case cr^.t of
creatureHamster:
EnemyToString := 'Hamster';
creatureGhost:
EnemyToString := 'Ghost';
creatureSun:
EnemyToString := 'Sun';
creatureSnake:
EnemyToString := 'Snake';
creatureDrop:
EnemyToString := 'Drop'
end
end;
procedure PrintEnemies(var lst: creatureList);
var
y: integer = DebugPrintY;
tmp: creatureItemPtr;
s: string;
begin
tmp := lst.first;
while tmp <> nil do
begin
GotoXY(DebugPrintX, y);
s := EnemyToString(tmp^.cr);
write(s, ', Y: ', tmp^.cr^.curY, ', X: ', tmp^.cr^.curX);
tmp := tmp^.next;
y := y + 1
end
end;
end.

68
src/enemy_packs_m.pas Normal file
View File

@ -0,0 +1,68 @@
unit enemy_packs_m;
interface
uses creature_m;
type
enemyPackType = (enemyPack1, enemyPack2, enemyPack3, enemyPack4,
enemyPack5, enemyPack6, enemyPack7, enemyPack8,
enemyPack9, enemyPack10);
procedure AppendEnemies(var lst: creatureList; t: enemyPackType);
implementation
uses ghost_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
);
LevelDropN: array[enemyPackType] of integer = (
0, 0, 0, 0, 2, 2, 1, 1, 2, 4
);
}
procedure AppendRandomGhosts(var lst: creatureList; t: enemyPackType);
var
i: integer;
c: creaturePtr;
begin
for i := 1 to LevelGhostN[t] do
begin
new(c);
InitRandomGhost(c^);
AppendCreature(lst, c)
end
end;
procedure AppendRandomSuns(var lst: creatureList; t: enemyPackType);
begin
end;
procedure AppendRandomSnakes(var lst: creatureList; t: enemyPackType);
begin
end;
procedure AppendRandomDrops(var lst: creatureList; t: enemyPackType);
begin
end;
procedure AppendEnemies(var lst: creatureList; t: enemyPackType);
begin
AppendRandomGhosts(lst, t);
AppendRandomSuns(lst, t);
AppendRandomSnakes(lst, t);
AppendRandomDrops(lst, t)
end;
end.

View File

@ -3,27 +3,27 @@ unit game_m;
interface
uses level_m;
uses level_m, enemy_packs_m;
type
state = (gameExit, gameMenu, gameStartLevel, gameScore, gameKeyInfo,
gamePause, gameContinueLevel, gameOver);
state = (gameLevelAnnounce, gameExit, gameMenu, gameStartLevel, gameScore,
gameKeyInfo, gamePause, gameContinueLevel, gameOver, gameComplete,
gameLevelComplete, gameSetRecord);
menuState = (menuNewGame, menuHighScore, menuKeyInfo, menuContinue);
exitState = (exitYes, exitNo);
gameState = record
curExit: exitState;
curMenu: menuState;
curState: state;
level: integer;
shutdown, continueAllowed: boolean
level, score, life: integer;
enemyPack: enemyPackType;
shutdown, continueAllowed: boolean;
end;
procedure DecreaseLife(var level: levelState);
procedure RunGameOver(var g: gameState; var level: levelState);
procedure DecreaseLife(var life: integer);
procedure InitGame(var g: gameState);
procedure NextExitState(var g: gameState);
procedure PreviousExitState(var g: gameState);
procedure RunExit(var g: gameState);
procedure MainLoop(var g: gameState);
implementation
@ -32,14 +32,20 @@ uses arena_m, arena_graphics_m, crt, creature_m, ghost_m, graphics_m,
hamster_m, keys_m, trace_m;
const
KeyDelayMs = 25;
LevelDelayMs = 100;
KeyDelayMs = 22;
MoveDelayMs = 100;
EraseLifeThreshold = 10;
AnnounceDelayMs = 1500;
LevelCompleteDelayMs = 1500;
LevelCount = 10;
StartLifeN = 3;
procedure DecreaseLife(var level: levelState);
procedure DecreaseLife(var life: integer);
begin
EraseLifesNumber(level.life);
level.life := level.life - 1;
DrawLifesNumber(level.life)
if life = EraseLifeThreshold then
EraseLifesNumber(life);
life := life - 1;
DrawLifesNumber(life)
end;
procedure InitGame(var g: gameState);
@ -48,14 +54,17 @@ begin
g.curMenu := menuNewGame;
g.curState := gameMenu;
g.level := 1;
g.enemyPack := enemyPack1;
g.score := 0;
g.shutdown := false;
g.life := StartLifeN
{
g.slowBonus := StartSlowBonus;
g.speedBonus := StartSpeedBonus
}
end;
procedure RunExit(var g: gameState);
procedure ShowExit(var g: gameState);
begin
DrawExit(g);
while g.curState = gameExit do
@ -67,7 +76,7 @@ begin
EraseExit
end;
procedure RunScore(var g: gameState);
procedure ShowScore(var g: gameState);
begin
{DrawHighScore;}
while g.curState = gameScore do
@ -78,7 +87,7 @@ begin
end;
end;
procedure RunKeyInfo(var g: gameState);
procedure ShowKeyInfo(var g: gameState);
begin
DrawKeyInfo;
while g.curState = gameKeyInfo do
@ -90,7 +99,7 @@ begin
EraseKeyInfo
end;
procedure RunPause(var g: gameState);
procedure PauseLevel(var g: gameState);
begin
DrawPause(g);
while g.curState = gamePause do
@ -105,7 +114,7 @@ begin
ErasePause(g)
end;
procedure RunGameOver(var g: gameState; var level: levelState);
procedure ShowGameOver(var g: gameState; var level: levelState);
begin
DrawGameOver;
while g.curState = gameOver do
@ -116,65 +125,105 @@ begin
end;
EraseGameOver;
if g.curState = gameContinueLevel then
InitLevel(level)
InitLevel(level, enemyPack1)
end;
procedure GameCutPart(var g: gameState; var level: levelState);
var
beforeCut: integer;
begin
beforeCut := level.cut;
SetArenaBorder(level.t, level.a);
ArenaCutPart(level.h, level.t, level.cut, level.a);
FillCompleteBar(level.cut);
g.score := g.score + (level.cut - beforeCut);
DrawScore(g.score);
KillCapturedEnemies(level.a, level.enemyList)
end;
procedure GameNextLevel(var g: gameState);
begin
g.curState := gameLevelComplete;
g.level := g.level + 1;
if g.level = LevelCount then
g.curState := gameComplete
else
g.curState := gameLevelComplete
end;
procedure
GameKillHamster(var g: gameState; var level: levelState; var breakF: boolean);
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);
level.h.alive := true
end;
procedure PollGameKeys(var g: gameState; var level: levelState);
var
i: integer;
begin
for i := 1 to (MoveDelayMs div KeyDelayMs) do
begin
delay(KeyDelayMs);
if keypressed then
HandleLevelKey(level.h, level.a, level.t, g);
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
begin
delay(LevelDelayMs);
PollGameKeys(g, level);
if g.curState = gamePause then
break;
if ArenaSplited(level.h, level.t, level.a) then
GameCutPart(g, level);
if IsLevelComplete(level) then
begin
SetArenaBorder(level.t, level.a);
CutPart(level.h, level.t, level.score, level.a);
FillCompleteBar(level.score);
DrawScore(level.score)
GameNextLevel(g);
break
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);
{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
begin
if level.life <= 0 then
begin
g.curState := gameOver;
EraseLevel;
break
end;
DecreaseLife(level);
KillHamster(level.h, level.t, level.a);
level.h.alive := true
end;
if keypressed then
HandleLevelKey(level.h, level.a, level.t, g);
GameKillHamster(g, level, breakF);
if breakF then
break;
if not HamsterStepPossible(level.h, level.t, level.a) then
StopCreature(level.h);
if not ((level.h.dX = 0) and (level.h.dY = 0)) then
MakeHamsterStep(level.h, level.t, level.a);
if g.curState = gamePause then
break
end;
MakeHamsterStep(level.h, level.t, level.a)
end
end;
procedure StartLevel(var g: gameState; var level: levelState);
begin
InitLevel(level);
DrawLevel(level);
InitLevel(level, enemyPack1);
DrawLevel(level, g.life, g.score);
LevelLoop(g, level)
end;
procedure ContinueLevel(var g: gameState; var level: levelState);
begin
DrawLevel(level);
DrawLevel(level, g.life, g.score);
LevelLoop(g, level)
end;
procedure RunMenu(var g: gameState);
procedure ShowMenu(var g: gameState);
var
prevMenu: boolean = false;
begin
@ -200,31 +249,70 @@ begin
end
end;
procedure AnnounceLevel(var g: gameState);
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
break
end;
g.curState := gameStartLevel;
EraseAnnounce(g.level)
end;
procedure ShowLevelComplete(var g: gameState; var lvl: levelState);
var
i: integer;
skip: boolean = false;
begin
FillCellsCapture(lvl.a);
DrawCreature(lvl.h);
for i := 1 to LevelCompleteDelayMs div KeyDelayMs do
begin
delay(KeyDelayMs);
if keypressed then
HandleSceneKey(skip);
if skip then
break
end;
g.curState := gameLevelAnnounce;
EraseLevel
end;
procedure MainLoop(var g: gameState);
var
level: levelState;
begin
while not g.shutdown do
begin
case g.curState of
gameLevelAnnounce:
AnnounceLevel(g);
gameExit:
RunExit(g);
ShowExit(g);
gameScore:
RunScore(g);
ShowScore(g);
gameKeyInfo:
RunKeyInfo(g);
ShowKeyInfo(g);
gamePause:
RunPause(g);
PauseLevel(g);
gameStartLevel:
StartLevel(g, level);
gameContinueLevel: {Maybe here should be gameStartLevel}
ContinueLevel(g, level);
gameOver:
RunGameOver(g, level);
ShowGameOver(g, level);
gameMenu:
RunMenu(g)
end
end;
ShowMenu(g);
gameLevelComplete:
ShowLevelComplete(g, level);
end;
EraseAll
end;

View File

@ -5,22 +5,38 @@ interface
uses creature_m;
const
GhostStartX = 5;
GhostStartY = 5;
GhostMovespeed = 1;
GhostStartDX = GhostMovespeed;
GhostStartDY = GhostMovespeed;
GhostSymbol = 'g';
procedure InitGhost(var g: creature);
procedure InitRandomGhost(var g: creature);
implementation
procedure InitGhost(var g: creature);
uses arena_m, Math;
procedure InitGhost(var g: creature; x, y, sigdx, sigdy: integer);
begin
InitCreature(g, GhostStartX, GhostStartY, GhostMovespeed, GhostSymbol);
g.dX := GhostStartDX;
g.dY := GhostStartDY
g.t := creatureGhost;
g.curX := x;
g.curY := y;
g.dX := GhostStartDX * sigdx;
g.dY := GhostStartDY * sigdy;
g.movespeed := GhostMovespeed;
g.alive := true;
g.symbol := GhostSymbol
end;
procedure InitRandomGhost(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);
InitGhost(g, x, y, sigdx, sigdy)
end;
end.

View File

@ -11,10 +11,11 @@ const
DigitSpaceWidth = 1;
DigitWidth = 6;
InterfaceH = 6;
ScreenH = (ArenaW + InterfaceH) * CellSize + BorderSize;
ScreenW = (ArenaH - 1) * CellSize + BorderSize * 2; { 82 }
ScreenH = (ArenaH + InterfaceH) * CellSize + BorderSize;
ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 82 }
WidthCoefficient = 2;
procedure DrawAnnounce(lvl: integer);
procedure DrawAscii(x, y, h: integer; var a: array of string);
procedure DrawDigit(x, y, digit: integer);
procedure DrawExitState(s: exitState);
@ -23,11 +24,13 @@ procedure DrawGameOver;
procedure DrawKeyInfo;
procedure DrawLineX(x, y, len: integer; ch: char);
procedure DrawLineY(x, y, len: integer; ch: char);
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;
procedure EraseExitState(s: exitState);
procedure EraseGameOver;
@ -44,8 +47,10 @@ implementation
uses crt, math_m, ascii_arts_m;
const
AnnounceY = (ScreenH - LevelAnnounceHeight) div 2;
BigLetterWidth = 8;
BorderN = 2;
DecimalDelimiter = 10;
GameNameY = 12;
NameHeightPadding = 8;
NewGameY = GameNameY + GameNameHeight + NameHeightPadding;
@ -72,7 +77,7 @@ const
PauseX = (ScreenW * WidthCoefficient - PauseWidth) div 2;
PauseYPadding = 1;
PauseY = (ScreenH - PauseHeight) div 2;
PunctuationWidth = 3;
LevelNumberMargin = 3;
var
firstMenuDraw: boolean = true;
@ -162,7 +167,7 @@ begin
menuContinue:
DrawAscii(MenuHamsterX, ContinueY + 1,
HamsterHeight, HamsterStayAscii)
end
end
end;
procedure DrawRectangle(x0, y0, h, w: integer; ch: char);
@ -193,7 +198,7 @@ begin
DrawAscii(GameNameX, y, GameMenuHeight, GameMenuScreen);
if not g.continueAllowed then
DrawLineX(GameNameX, ContinueY + ContinueHeight div 2,
ContinueWidth, '-');
ContinueWidth, '-');
DrawMenuState(g.curMenu)
end;
@ -304,4 +309,99 @@ begin
PauseHeight + PauseYPadding * 2 + 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 DrawNumber(x, y: integer; n: longint);
var
i: integer = 0;
st: StackInt;
begin
StackIntInit(st);
if n = 0 then
StackPush(st, 0);
while n <> 0 do
begin
StackPush(st, n mod DecimalDelimiter);
n := n div DecimalDelimiter
end;
while st.top <> nil do
begin
DrawDigit(x + (DigitWidth + DigitSpaceWidth) * i, y, st.top^.val);
StackPop(st);
i := i + 1
end
end;
function CountDigits(lvl: integer): integer;
var
res: integer = 0;
begin
while lvl <> 0 do
begin
res := res + 1;
lvl := lvl div DecimalDelimiter
end;
CountDigits := res
end;
procedure DrawAnnounce(lvl: integer);
var
w, x: integer;
digitCnt: integer = 0;
begin
digitCnt := CountDigits(lvl);
w := LevelAnnounceWidth + LevelNumberMargin +
DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1);
x := (ScreenW * WidthCoefficient - w) div 2;
DrawAscii(x, AnnounceY, LevelAnnounceHeight, LevelAnnounce);
DrawNumber(x + LevelAnnounceWidth + LevelNumberMargin, AnnounceY + 1, lvl)
end;
procedure EraseAnnounce(lvl: integer);
var
w, x, digitCnt: integer;
begin
digitCnt := CountDigits(lvl);
w := LevelAnnounceWidth + LevelNumberMargin +
DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1);
x := (ScreenW * WidthCoefficient - w) div 2;
EraseRectangle(x, AnnounceY, w, LevelAnnounceHeight)
end;
end.

View File

@ -12,32 +12,32 @@ const
HamsterMovespeed = 2;
HamsterSymbol = 'h';
procedure InitHamster(var h: creature);
procedure InitHamster(var cr: creature);
procedure KillHamster(var h: creature; var t: tracePtr; var a: arena);
implementation
uses graphics_m;
procedure InitHamster(var h: creature);
procedure InitHamster(var cr: creature);
begin
InitCreature(h, HamsterStartX, HamsterStartY,
HamsterMovespeed, HamsterSymbol);
h.dX := HamsterStartDX;
h.dY := HamsterStartDY
cr.t := creatureHamster;
cr.curX := HamsterStartX;
cr.curY := HamsterStartY;
cr.dX := HamsterStartDX;
cr.dY := HamsterStartDY;
cr.movespeed := HamsterMovespeed;
cr.alive := true;
cr.symbol := HamsterSymbol
end;
procedure KillHamster(var h: creature; var t: tracePtr; var a: arena);
var
traceStart: tracePtr;
begin
DrawArenaCell(h.curX, h.curY, ArenaSymbol);
DrawFieldCell(h.curX, h.curY, ArenaSymbol);
EraseTrace(t, a);
if IsOnEdge(h) then
DrawEdge(h.curX, h.curY, a)
else
if a.borders[h.curX][h.curY] then
DrawArenaCell(h.curX, h.curY, BorderSymbol);
DrawArenaCell(h.curX, h.curY, a);
GetStart(traceStart, t);
h.curX := traceStart^.x;
h.curY := traceStart^.y;

View File

@ -32,6 +32,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);
@ -151,8 +152,10 @@ begin
if (k = FourOrd) and not g.continueAllowed then
exit;
case k of
OneOrd:
g.curState := gameStartLevel;
OneOrd: begin
g.level := 1;
g.curState := gameLevelAnnounce
end;
TwoOrd:
g.curState := gameScore;
ThreeOrd:
@ -165,8 +168,10 @@ end;
procedure ChooseMenuMarked(var g: gameState);
begin
case g.curMenu of
menuNewGame:
g.curState := gameStartLevel;
menuNewGame: begin
g.level := 1;
g.curState := gameLevelAnnounce
end;
menuHighScore:
g.curState := gameScore;
menuKeyInfo:
@ -192,7 +197,7 @@ begin
if (k = EscOrd) or (k = UpperQOrd) or (k = LowerQOrd) then
g.curState := gameExit;
if (k = EnterOrd) or (k = SpaceOrd) then
ChooseMenuMarked(g);
ChooseMenuMarked(g)
end;
procedure HandleGameOverKey(var g: gameState);
@ -279,4 +284,13 @@ begin
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
end;
end.

View File

@ -2,43 +2,54 @@ unit level_m;
interface
uses arena_m, trace_m, creature_m;
uses arena_m, trace_m, creature_m, enemy_packs_m;
type
levelState = record
a: arena;
t: tracePtr;
levelStarted, continueLevel, hamsterAlive: boolean;
h, g: creature;
life, score, enemy: integer
h: creature;
cut: integer;
enemyList: creatureList;
end;
procedure InitLevel(var level: levelState);
function IsLevelComplete(var level: levelState): boolean;
procedure InitLevel(var level: levelState; t: enemyPackType);
implementation
uses hamster_m, ghost_m;
uses hamster_m, ghost_m, debug_m;
const
StartScore = 0;
StartLifes = 3;
{
LevelCompleteThreshold = 80;
TotalProcent = 100;
{
BonusTurns = 45;
StartSpeedBonus = 0;
StartSlowBonus = 0;
}
}
procedure InitLevel(var level: levelState);
function IsLevelComplete(var level: levelState): boolean;
var
completeProcent: integer;
begin
completeProcent := round(level.cut / (TotalCells / TotalProcent));
IsLevelComplete := completeProcent >= LevelCompleteThreshold
end;
procedure InitLevel(var level: levelState; t: enemyPackType);
begin
InitArena(level.a);
InitHamster(level.h);
InitGhost(level.g);
InitCreatureList(level.enemyList);
AppendEnemies(level.enemyList, t);
{PrintEnemies(level.enemyList);}
level.levelStarted := true;
level.continueLevel := true;
level.hamsterAlive := true;
level.t := nil;
level.life := StartLifes;
level.enemy := 1;
level.score := StartScore
level.cut := 0
end;
end.