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

feat/TD-010-add-enemy-kill

Browse Source
This commit is contained in:
gre-ilya 2026-02-28 16:14:58 +05:00
parent 78d5897a47
commit 01c58d5a74
11 changed files with 413 additions and 234 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

164
src/arena_graphics_m.pas Normal file
View File

@ -0,0 +1,164 @@
unit arena_graphics_m;
interface
uses arena_m, creature_m;
const
BorderSize = 1;
CellSize = 2;
LifeBarX = 33;
ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 79 }
InterfaceBarH = ScreenW - ArenaH * CellSize - BorderSize * 2; { 14 }
InterfaceCellW = ScreenW div 3;
InterfaceH = 6;
ScreenH = (ArenaH + InterfaceH) * CellSize + BorderSize;
WidthCoefficient = 2;
procedure DrawArenaBorders(var a: arena);
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
procedure DrawArenaEdges;
procedure DrawEdge(x, y: integer; var a: arena);
procedure DrawLevel;
implementation
uses crt, math_m;
procedure DrawLineX(x, y, len: integer);
var
i: integer;
begin
GotoXY(x, y);
for i := 1 to len do
write(BorderSymbolX);
GotoXY(1, 1)
end;
procedure DrawLineY(x, y, len: integer);
var
i: integer;
begin
for i := 1 to len do
begin
GotoXY(x, y + i - 1);
write(BorderSymbolY)
end;
GotoXY(1, 1)
end;
procedure DrawRectangle(x0, y0, h, w: integer);
var
i: integer;
begin
DrawLineX(x0, y0, w);
for i := 1 to h - 2 do
begin
GotoXY(x0, y0 + i);
write(BorderSymbolY);
GotoXY(x0 + w - 1, y0 + i);
write(BorderSymbolY)
end;
DrawLineX(x0, y0 + h - 1, w);
GotoXY(1, 1)
end;
procedure DrawInterface;
begin
DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient);
DrawLineY(InterfaceCellW * WidthCoefficient, 1, InterfaceBarH);
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1, InterfaceBarH)
end;
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
var
i, screenX, screenY: integer;
begin
screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient;
screenY := InterfaceBarH + (arenaY - 1) * CellSize;
GotoXY(screenX, screenY);
for i := 1 to CellSize * WidthCoefficient do
write(symbol);
GotoXY(screenX, screenY + 1); { later change to nested for }
for i := 1 to CellSize * WidthCoefficient do
write(symbol);
GotoXY(1, 1)
end;
procedure DrawArenaEdges;
begin
DrawRectangle(1, InterfaceBarH,
ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient)
end;
procedure DrawLeftEdge(y: integer);
var
terminalY: integer;
begin
y := Clamp(y, 1, ArenaH);
terminalY := InterfaceBarH + (y - 1) * CellSize;
DrawLineY(1, terminalY, CellSize)
end;
procedure DrawRightEdge(y: integer);
var
terminalY: integer;
begin
y := Clamp(y, 1, ArenaH);
terminalY := InterfaceBarH + (y - 1) * CellSize;
DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize)
end;
procedure DrawUpperEdge(x: integer);
var
terminalX, sizeX: integer;
begin
x := Clamp(x, 1, ArenaW);
terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH, sizeX)
end;
procedure DrawLowerEdge(x: integer);
var
terminalX, sizeX: integer;
begin
x := Clamp(x, 1, ArenaW);
terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH + ArenaH * CellSize - 1, sizeX)
end;
procedure DrawArenaBorders(var a: arena);
var
i, j: integer;
begin
for i := 1 to ArenaH do
for j := 1 to ArenaW do
if a.borders[j][i] then
DrawArenaCell(j, i, BorderSymbol)
end;
procedure DrawEdge(x, y: integer; var a: arena);
begin
if a.captured[x][y] then
DrawArenaCell(x, y, CaptureSymbol)
else
DrawArenaCell(x, y, ArenaSymbol);
if x = 1 then
DrawLeftEdge(y);
if x = ArenaW then
DrawRightEdge(y);
if y = 1 then
DrawUpperEdge(x);
if y = ArenaH then
DrawLowerEdge(x)
end;
procedure DrawLevel;
begin
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient);
DrawInterface
end;
end.

29
src/arena_m.pas
View File

@ -2,12 +2,14 @@ unit arena_m;
interface
uses creature_m, trace_m, hamster_m;
uses creature_m, game_m, trace_m;
const
ArenaH = 33;
ArenaW = 41;
CaptureSymbol = '.';
BorderSymbolX = '|'; {Later can change on '-'}
BorderSymbolY = '|';
BorderSymbol = '|';
ArenaSymbol = ' ';
@ -19,22 +21,22 @@ type
end;
function ArenaSplited(var h: creature; var t: tracePtr; var a: arena): boolean;
procedure CutSmallerPart(var hamster: creature; var t: tracePtr; var a: arena);
function GhostShouldTurn(var g: creature; var a: arena): boolean;
function
HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean;
procedure Init(var a: arena);
function IsOnBorder(var x, y: integer; var a: arena): boolean;
function IsOnEdge(var cr: creature): boolean;
function IsOnEdge(x, y: integer): boolean;
procedure MakeEnemyStep(var e: creature; var a: arena);
procedure CutSmallerPart(var hamster: creature; var t: tracePtr; var a: arena);
procedure InitArena(var a: arena);
procedure MakeEnemyStep(var e, h: creature; t: tracePtr; var a: arena);
procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
procedure SetArenaBorder(var t: tracePtr; var a: arena);
procedure TurnGhost(var g: creature; var a: arena);
implementation
uses cell_m, graphics_m, math_m;
uses arena_graphics_m, cell_m, crt, graphics_m, math_m;
procedure Fill(var m: arenaMatrix; val: boolean);
var
@ -45,7 +47,7 @@ begin
m[i][j] := val
end;
procedure Init(var a: arena);
procedure InitArena(var a: arena);
begin
Fill(a.captured, false);
Fill(a.borders, false)
@ -300,12 +302,11 @@ begin
DrawArenaBorders(a);
DrawArenaEdges;
DrawCreature(hamster);
Delete(t)
DeleteTrace(t)
end;
function
HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena):
boolean;
HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean;
var
nextX, nextY, midX, midY: integer;
begin
@ -448,10 +449,16 @@ begin
end
end;
procedure MakeEnemyStep(var e: creature; var a: arena);
procedure MakeEnemyStep(var e, h: creature; t: tracePtr; var a: arena);
var
prevX, prevY: integer;
begin
prevX := e.curX;
prevY := e.curY;
MakeStep(e);
DrawAfterStep(e, a)
DrawAfterStep(e, a);
if TraceCrossed(prevX, prevY, e, t) then
h.alive := false
end;
end.

24
src/creature_m.pas
View File

@ -4,26 +4,30 @@ interface
type
creature = record
curX, curY, dX, dY: integer;
symbol: char
curX, curY, dX, dY, moveSpeed: integer;
symbol: char;
alive: boolean
end;
procedure
InitCreature(var cr: creature; curX, curY, dX, dY: integer; symbol: char);
InitCreature(var cr: creature; curX, curY, movespeed: integer; symbol: char);
procedure KillCreature(var cr: creature);
procedure StopCreature(var cr: creature);
procedure MakeStep(var cr: creature);
implementation
uses arena_m, math_m;
uses arena_graphics_m, arena_m, math_m;
procedure
InitCreature(var cr: creature; curX, curY, dX, dY: integer; symbol: char);
InitCreature(var cr: creature; curX, curY, movespeed: integer; symbol: char);
begin
cr.curX := curX;
cr.curY := curY;
cr.dX := dX;
cr.dY := dY;
cr.dX := 0;
cr.dY := 0;
cr.movespeed := moveSpeed;
cr.alive := true;
cr.symbol := symbol
end;
@ -39,4 +43,10 @@ begin
cr.curY := Clamp(cr.curY + cr.dY, 1, ArenaH)
end;
procedure KillCreature(var cr: creature);
begin
cr.alive := false;
DrawArenaCell(cr.curX, cr.curY, CaptureSymbol)
end;
end.

45
src/game_m.pas Normal file
View File

@ -0,0 +1,45 @@
unit game_m;
interface
type
gameState = record
score, life, speedBonus, slowBonus: integer;
paused, level, hamsterAlive: boolean;
end;
procedure DecreaseLife(var g: gameState);
procedure GameOver(var g: gameState);
procedure InitGame(var g: gameState);
implementation
uses graphics_m;
const
StartScore = 0;
StartLifes = 3;
BonusTurns = 45;
StartSpeedBonus = 0;
StartSlowBonus = 0;
procedure InitGame(var g: gameState);
begin
g.score := StartScore;
g.life := StartLifes;
g.speedBonus := StartSpeedBonus;
g.slowBonus := StartSlowBonus;
g.hamsterAlive := true
end;
procedure DecreaseLife(var g: gameState);
begin
g.life := g.life - 1;
DrawLifes(g)
end;
procedure GameOver(var g: gameState);
begin
end;
end.

11
src/ghost_m.pas
View File

@ -7,9 +7,9 @@ uses creature_m;
const
GhostStartX = 5;
GhostStartY = 5;
GhostDelta = 1;
GhostStartDX = GhostDelta;
GhostStartDY = GhostDelta;
GhostMovespeed = 1;
GhostStartDX = GhostMovespeed;
GhostStartDY = GhostMovespeed;
GhostSymbol = 'g';
procedure InitGhost(var g: creature);
@ -18,8 +18,9 @@ implementation
procedure InitGhost(var g: creature);
begin
InitCreature(g, GhostStartX, GhostStartY,
GhostStartDX, GhostStartDY, GhostSymbol)
InitCreature(g, GhostStartX, GhostStartY, GhostMovespeed, GhostSymbol);
g.dX := GhostStartDX;
g.dY := GhostStartDY
end;
end.

34
src/gohamster.pas
View File

@ -1,6 +1,6 @@
program go_hamster;
uses crt, arena_m, trace_m, creature_m, graphics_m, hamster_m, keys_m,
ghost_m, debug_m;
uses crt, arena_m, arena_graphics_m, trace_m, creature_m, graphics_m,
hamster_m, keys_m, ghost_m, game_m, debug_m;
const
DelaySizeMs = 100;
@ -11,13 +11,17 @@ var
a: arena;
t: tracePtr = nil;
continueLevel: boolean = true;
game: gameState;
begin
Init(a);
InitArena(a);
InitHamster(h);
InitGhost(g);
InitGame(game);
DrawCreature(h);
DrawCreature(g);
DrawScore(12345);
DrawScore(game);
DrawLifes(game);
while continueLevel do
begin
delay(DelaySizeMs);
@ -26,15 +30,31 @@ begin
SetArenaBorder(t, a);
CutSmallerPart(h, t, a)
end;
if g.alive then
MakeEnemyStep(g, h, t, a);
while g.alive and GhostShouldTurn(g, a) do
TurnGhost(g, a);
if not h.alive then
begin
if game.life >= 0 then
begin
DecreaseLife(game);
KillHamster(h, t, a);
h.alive := true
end
else
begin
GameOver(game)
end
end;
if keypressed then
HandleKey(h, continueLevel, a, t);
if not HamsterStepPossible(h, t, a) then
StopCreature(h);
if not ((h.dX = 0) and (h.dY = 0)) then
MakeHamsterStep(h, t, a);
MakeEnemyStep(g, a);
if GhostShouldTurn(g, a) then
TurnGhost(g, a)
if g.alive and a.captured[g.curX][g.curY] then
KillCreature(g)
end
end;

217
src/graphics_m.pas
View File

@ -2,19 +2,16 @@ unit graphics_m;
interface
uses arena_m, creature_m, hamster_m, trace_m;
uses arena_graphics_m, arena_m, creature_m, hamster_m, trace_m, game_m;
function IsTerminalValid: boolean;
procedure DrawAfterStep(var cr: creature; var a: arena);
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena);
procedure DrawArenaBorders(var a: arena);
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
procedure DrawArenaEdges;
procedure DrawCreature(var cr: creature);
{procedure DrawKills(killCounter: integer);}
procedure DrawScore(s: integer);
procedure DrawLevel;
procedure EraseTrace(var hamster: creature; t: tracePtr);
procedure DrawLifes(var game: GameState);
procedure DrawScore(var game: GameState);
procedure EraseStepTrace(var hamster: creature; t: tracePtr);
procedure EraseTrace(t: tracePtr; var a: arena);
procedure PrintTerminalHelp;
implementation
@ -22,15 +19,11 @@ implementation
uses crt, math_m;
const
InterfaceH = 6;
CellSize = 2;
BorderSize = 1;
ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 79 }
ScreenH = (ArenaH + InterfaceH) * CellSize + BorderSize;
InterfaceCellW = ScreenW div 3;
WidthCoefficient = 2;
InterfaceBarH = ScreenW - ArenaH * CellSize - BorderSize * 2; { 14 }
LetterWidth = 6;
Notation = 10;
DigitSpaceSize = 1;
InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1;
InterfaceMarginX = InterfaceCellW div 4;
function IsTerminalValid: boolean;
begin
@ -52,132 +45,23 @@ begin
end
end;
procedure DrawLineX(x, y, len: integer);
var
i: integer;
procedure EraseTrace(t: tracePtr; var a: arena);
begin
GotoXY(x, y);
for i := 1 to len do
write(BorderSymbol);
GotoXY(1, 1)
end;
procedure DrawLineY(x, y, len: integer);
var
i: integer;
begin
for i := 1 to len do
while t <> nil do
begin
GotoXY(x, y + i - 1);
write(BorderSymbol)
end;
GotoXY(1, 1)
if t^.prev = nil then
DrawEdge(t^.x, t^.y, a)
else
DrawArenaCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
end
end;
procedure DrawRectangle(x0, y0, h, w: integer);
procedure EraseStepTrace(var hamster: creature; t: tracePtr);
var
i: integer;
begin
DrawLineX(x0, y0, w);
for i := 1 to h - 2 do
begin
GotoXY(x0, y0 + i);
write(BorderSymbol);
GotoXY(x0 + w - 1, y0 + i);
write(BorderSymbol)
end;
DrawLineX(x0, y0 + h - 1, w);
GotoXY(1, 1)
end;
procedure DrawInterface;
begin
DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient);
DrawLineY(InterfaceCellW * WidthCoefficient, 1, InterfaceBarH);
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1, InterfaceBarH)
end;
procedure DrawLevel;
begin
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient);
DrawInterface
end;
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
var
i, screenX, screenY: integer;
begin
screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient;
screenY := InterfaceBarH + (arenaY - 1) * CellSize;
GotoXY(screenX, screenY);
for i := 1 to CellSize * WidthCoefficient do
write(symbol);
GotoXY(screenX, screenY + 1); { later change to nested for }
for i := 1 to CellSize * WidthCoefficient do
write(symbol);
GotoXY(1, 1)
end;
procedure DrawArenaEdges;
begin
DrawRectangle(1, InterfaceBarH,
ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient)
end;
procedure DrawLeftEdge(y: integer);
var
terminalY: integer;
begin
y := Clamp(y, 1, ArenaH);
terminalY := InterfaceBarH + (y - 1) * CellSize;
DrawLineY(1, terminalY, CellSize)
end;
procedure DrawRightEdge(y: integer);
var
terminalY: integer;
begin
y := Clamp(y, 1, ArenaH);
terminalY := InterfaceBarH + (y - 1) * CellSize;
DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize)
end;
procedure DrawUpperEdge(x: integer);
var
terminalX, sizeX: integer;
begin
x := Clamp(x, 1, ArenaW);
terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH, sizeX)
end;
procedure DrawLowerEdge(x: integer);
var
terminalX, sizeX: integer;
begin
x := Clamp(x, 1, ArenaW);
terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH + ArenaH * CellSize - 1, sizeX)
end;
procedure DrawArenaBorders(var a: arena);
var
i, j: integer;
begin
for i := 1 to ArenaH do
for j := 1 to ArenaW do
if a.borders[j][i] then
DrawArenaCell(j, i, BorderSymbol)
end;
procedure EraseTrace(var hamster: creature; t: tracePtr);
var
i: integer;
begin
for i := 1 to HamsterDelta do
for i := 1 to hamster.movespeed do
begin
DrawArenaCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
@ -191,27 +75,6 @@ begin
end
end;
procedure EraseCell(x, y: integer);
begin
DrawArenaCell(x, y, ArenaSymbol)
end;
procedure DrawEdge(x, y: integer; var a: arena);
begin
if a.captured[x][y] then
DrawArenaCell(x, y, CaptureSymbol)
else
DrawArenaCell(x, y, ArenaSymbol);
if x = 1 then
DrawLeftEdge(y);
if x = ArenaW then
DrawRightEdge(y);
if y = 1 then
DrawUpperEdge(x);
if y = ArenaH then
DrawLowerEdge(x)
end;
procedure DrawCreature(var cr: creature);
begin
DrawArenaCell(cr.curX, cr.curY, cr.symbol)
@ -230,7 +93,7 @@ begin
DrawArenaCell(prevX, prevY, BorderSymbol)
end;
procedure DrawStepTrace(t: tracePtr);
procedure DrawStepTrace(t: tracePtr; hamsterDelta: integer);
var
i: integer;
begin
@ -255,7 +118,7 @@ begin
else
DrawArenaCell(prevX, prevY, ArenaSymbol);
if t <> nil then
DrawStepTrace(t);
DrawStepTrace(t, hamster.movespeed);
DrawCreature(hamster);
DrawPreviousCell(hamster, t, a)
end;
@ -276,19 +139,6 @@ begin
DrawCreature(cr)
end;
{
procedure DrawKills(killCounter: integer);
begin
GotoXY(1, 81);
while killCounter <> 0 do
begin
write(killCounter mod 10);
killCounter := killCounter div 10
end;
GotoXY(1, 1)
end;
}
procedure DrawZero(x, y: integer);
begin
GotoXY(x, y);
@ -514,9 +364,8 @@ begin
end
end;
procedure DrawScore(s: integer);
procedure DrawNumber(interfaceX: integer; s: longint);
var
killBar: integer = InterfaceCellW * 2 * WidthCoefficient + 1;
x, y: integer;
i: integer = 0;
st: StackInt;
@ -526,17 +375,29 @@ begin
StackPush(st, 0);
while s <> 0 do
begin
StackPush(st, s mod 10);
s := s div 10
StackPush(st, s mod Notation);
s := s div Notation
end;
x := killBar + InterfaceCellW div 4;
y := InterfaceBarH div 4 + BorderSize + 1;
x := interfaceX + InterfaceMarginX;
y := InterfaceMarginY;
while st.top <> nil do
begin
DrawDigit(x + (LetterWidth + 1) * i, y, st.top^.val);
DrawDigit(x + (LetterWidth + DigitSpaceSize) * i, y, st.top^.val);
StackPop(st);
i := i + 1
end
end;
procedure DrawLifes(var game: GameState);
begin
DrawNumber(LifeBarX, game.life)
end;
procedure DrawScore(var game: GameState);
var
killBarX: integer = InterfaceCellW * 2 * WidthCoefficient + BorderSize;
begin
DrawNumber(killBarX, game.score)
end;
end.

31
src/hamster_m.pas
View File

@ -2,24 +2,49 @@ unit hamster_m;
interface
uses creature_m;
uses arena_graphics_m, arena_m, creature_m, trace_m;
const
HamsterStartX = 5;
HamsterStartY = 1;
HamsterStartDX = 0;
HamsterStartDY = 0;
HamsterDelta = 2;
HamsterMovespeed = 2;
HamsterSymbol = 'h';
procedure InitHamster(var h: creature);
procedure KillHamster(var h: creature; var t: tracePtr; var a: arena);
implementation
uses graphics_m;
procedure InitHamster(var h: creature);
begin
InitCreature(h, HamsterStartX, HamsterStartY,
HamsterStartDX, HamsterStartDY, HamsterSymbol)
HamsterMovespeed, HamsterSymbol);
h.dX := HamsterStartDX;
h.dY := HamsterStartDY
end;
procedure KillHamster(var h: creature; var t: tracePtr; var a: arena);
var
traceStart: tracePtr;
begin
DrawArenaCell(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);
GetStart(traceStart, t);
h.curX := traceStart^.x;
h.curY := traceStart^.y;
h.dX := HamsterStartDX;
h.dY := HamsterStartDY;
DeleteTrace(t);
DrawCreature(h)
end;
end.

8
src/keys_m.pas
View File

@ -46,13 +46,13 @@ begin
h.dY := 0;
case keyCode of
ArrowLeftOrd:
h.dX := -HamsterDelta;
h.dX := -h.movespeed;
ArrowRightOrd:
h.dX := HamsterDelta;
h.dX := h.movespeed;
ArrowUpOrd:
h.dY := -HamsterDelta;
h.dY := -h.movespeed;
ArrowDownOrd:
h.dY := HamsterDelta;
h.dY := h.movespeed;
SpaceOrd:
StopCreature(h)
end

7
src/math_m.pas
View File

@ -26,4 +26,11 @@ begin
Signum := 0
end;
function Abs(val: integer): integer;
begin
if val < 0 then
val := val * -1;
Abs := val
end;
end.

77
src/trace_m.pas
View File

@ -2,7 +2,7 @@ unit trace_m;
interface
uses creature_m, math_m, hamster_m;
uses creature_m, math_m, game_m;
const
PreviousTraceIdx = 3;
@ -16,13 +16,17 @@ type
prev: tracePtr
end;
procedure ChangeHamsterTrace(var h: creature; var t: tracePtr);
procedure DecreaseTrace(var hamster: creature; var t: tracePtr);
procedure Delete(var t: tracePtr);
function FindIndex(var t: tracePtr; x, y, curIdx: integer): integer;
function GetLength(var t: tracePtr): integer;
function IsOnTrace(var cr: creature; t: tracePtr): boolean;
function IsOnTrace(x, y: integer; t: tracePtr): boolean;
function
TraceCrossed(prevX, prevY: integer; var cr: creature; t: tracePtr): boolean;
procedure ChangeHamsterTrace(var h: creature; var t: tracePtr);
procedure DecreaseTrace(var hamster: creature; var t: tracePtr);
procedure DeleteTrace(var t: tracePtr);
procedure GetStart(var traceStart: tracePtr; t: tracePtr);
procedure IncreaseTrace(var hamster: creature; var t: tracePtr);
function IsOnTrace(var cr: creature; var t: tracePtr): boolean;
procedure Pop(var t: tracePtr);
implementation
@ -37,7 +41,17 @@ begin
GetLength := 1 + GetLength(t^.prev)
end;
procedure Delete(var t: tracePtr);
procedure GetStart(var traceStart: tracePtr; t: tracePtr);
begin
while t <> nil do
begin
if t^.prev = nil then
traceStart := t;
t := t^.prev
end
end;
procedure DeleteTrace(var t: tracePtr);
var
tmpT: tracePtr;
begin
@ -60,6 +74,17 @@ begin
FindIndex := FindIndex(t^.prev, x, y, curIdx + 1)
end;
function IsOnTrace(x, y: integer; t: tracePtr): boolean;
begin
if t = nil then
IsOnTrace := false
else
if (t^.x = x) and (t^.y = y) then
IsOnTrace := true
else
IsOnTrace := IsOnTrace(x, y, t^.prev)
end;
procedure Add(var t: tracePtr; x, y: integer);
var
nextTrace: tracePtr;
@ -80,15 +105,9 @@ begin
t := tmpPrev
end;
function IsOnTrace(var cr: creature; var t: tracePtr): boolean;
function IsOnTrace(var cr: creature; t: tracePtr): boolean;
begin
if t = nil then
IsOnTrace := false
else
if (t^.x = cr.curX) and (t^.y = cr.curY) then
IsOnTrace := true
else
IsOnTrace := IsOnTrace(cr, t^.prev)
IsOnTrace := IsOnTrace(cr.curX, cr.curY, t)
end;
procedure AddStepTrace(var h: creature; var t: tracePtr);
@ -106,8 +125,8 @@ procedure AddFirstTrace(var hamster: creature; var t: tracePtr);
var
traceX, traceY, dX, dY: integer;
begin
dX := Signum(hamster.curX - hamster.dX, hamster.curX) * HamsterDelta;
dY := Signum(hamster.curY - hamster.dY, hamster.curY) * HamsterDelta;
dX := Signum(hamster.curX - hamster.dX, hamster.curX) * hamster.movespeed;
dY := Signum(hamster.curY - hamster.dY, hamster.curY) * hamster.movespeed;
traceX := hamster.curX + dX;
traceY := hamster.curY + dY;
Add(t, traceX, traceY)
@ -119,7 +138,7 @@ var
begin
if t = nil then
AddFirstTrace(hamster, t);
for i := 1 to HamsterDelta do
for i := 1 to hamster.movespeed do
AddStepTrace(hamster, t)
end;
@ -127,7 +146,7 @@ procedure DecreaseTrace(var hamster: creature; var t: tracePtr);
var
i: integer;
begin
for i := 1 to HamsterDelta do
for i := 1 to hamster.movespeed do
Pop(t);
if GetLength(t) = 1 then
Pop(t)
@ -137,7 +156,7 @@ procedure ChangeHamsterTrace(var h: creature; var t: tracePtr);
begin
if IsOnTrace(h, t) then
begin
EraseTrace(h, t);
EraseStepTrace(h, t);
DecreaseTrace(h, t)
end
else
@ -146,4 +165,24 @@ begin
end
end;
function
TraceCrossed(prevX, prevY: integer; var cr: creature; t: tracePtr): boolean;
var
dX, dY: integer;
begin
dX := Signum(cr.curX, prevX);
dY := Signum(cr.curY, prevY);
while (prevX <> cr.curX) and (prevY <> cr.curY) do
begin
if IsOnTrace(prevX, prevY, t) then
begin
TraceCrossed := true;
exit
end;
prevX := prevX + dX;
prevY := prevY + dY
end;
TraceCrossed := false
end;
end.