feat/TD-010-add-enemy-kill

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

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.

View File

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

View File

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

View File

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

View File

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

View File

@ -2,19 +2,16 @@ unit graphics_m;
interface 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; function IsTerminalValid: boolean;
procedure DrawAfterStep(var cr: creature; var a: arena); procedure DrawAfterStep(var cr: creature; var a: arena);
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; 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 DrawCreature(var cr: creature);
{procedure DrawKills(killCounter: integer);} procedure DrawLifes(var game: GameState);
procedure DrawScore(s: integer); procedure DrawScore(var game: GameState);
procedure DrawLevel; procedure EraseStepTrace(var hamster: creature; t: tracePtr);
procedure EraseTrace(var hamster: creature; t: tracePtr); procedure EraseTrace(t: tracePtr; var a: arena);
procedure PrintTerminalHelp; procedure PrintTerminalHelp;
implementation implementation
@ -22,15 +19,11 @@ implementation
uses crt, math_m; uses crt, math_m;
const 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; LetterWidth = 6;
Notation = 10;
DigitSpaceSize = 1;
InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1;
InterfaceMarginX = InterfaceCellW div 4;
function IsTerminalValid: boolean; function IsTerminalValid: boolean;
begin begin
@ -52,132 +45,23 @@ begin
end end
end; end;
procedure DrawLineX(x, y, len: integer); procedure EraseTrace(t: tracePtr; var a: arena);
var
i: integer;
begin begin
GotoXY(x, y); while t <> nil do
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
begin begin
GotoXY(x, y + i - 1); if t^.prev = nil then
write(BorderSymbol) DrawEdge(t^.x, t^.y, a)
end; else
GotoXY(1, 1) DrawArenaCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
end
end; end;
procedure DrawRectangle(x0, y0, h, w: integer); procedure EraseStepTrace(var hamster: creature; t: tracePtr);
var var
i: integer; i: integer;
begin begin
DrawLineX(x0, y0, w); for i := 1 to hamster.movespeed do
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
begin begin
DrawArenaCell(t^.x, t^.y, ArenaSymbol); DrawArenaCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev t := t^.prev
@ -191,27 +75,6 @@ begin
end end
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); procedure DrawCreature(var cr: creature);
begin begin
DrawArenaCell(cr.curX, cr.curY, cr.symbol) DrawArenaCell(cr.curX, cr.curY, cr.symbol)
@ -230,7 +93,7 @@ begin
DrawArenaCell(prevX, prevY, BorderSymbol) DrawArenaCell(prevX, prevY, BorderSymbol)
end; end;
procedure DrawStepTrace(t: tracePtr); procedure DrawStepTrace(t: tracePtr; hamsterDelta: integer);
var var
i: integer; i: integer;
begin begin
@ -255,7 +118,7 @@ begin
else else
DrawArenaCell(prevX, prevY, ArenaSymbol); DrawArenaCell(prevX, prevY, ArenaSymbol);
if t <> nil then if t <> nil then
DrawStepTrace(t); DrawStepTrace(t, hamster.movespeed);
DrawCreature(hamster); DrawCreature(hamster);
DrawPreviousCell(hamster, t, a) DrawPreviousCell(hamster, t, a)
end; end;
@ -276,19 +139,6 @@ begin
DrawCreature(cr) DrawCreature(cr)
end; 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); procedure DrawZero(x, y: integer);
begin begin
GotoXY(x, y); GotoXY(x, y);
@ -514,9 +364,8 @@ begin
end end
end; end;
procedure DrawScore(s: integer); procedure DrawNumber(interfaceX: integer; s: longint);
var var
killBar: integer = InterfaceCellW * 2 * WidthCoefficient + 1;
x, y: integer; x, y: integer;
i: integer = 0; i: integer = 0;
st: StackInt; st: StackInt;
@ -526,17 +375,29 @@ begin
StackPush(st, 0); StackPush(st, 0);
while s <> 0 do while s <> 0 do
begin begin
StackPush(st, s mod 10); StackPush(st, s mod Notation);
s := s div 10 s := s div Notation
end; end;
x := killBar + InterfaceCellW div 4; x := interfaceX + InterfaceMarginX;
y := InterfaceBarH div 4 + BorderSize + 1; y := InterfaceMarginY;
while st.top <> nil do while st.top <> nil do
begin begin
DrawDigit(x + (LetterWidth + 1) * i, y, st.top^.val); DrawDigit(x + (LetterWidth + DigitSpaceSize) * i, y, st.top^.val);
StackPop(st); StackPop(st);
i := i + 1 i := i + 1
end end
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. end.

View File

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

View File

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

View File

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

View File

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