feat/TD-004-add-hamster-trace #3

Merged
gre-ilya merged 1 commits from dev into main 2026-02-28 10:23:21 +00:00

View File

@ -1,54 +1,86 @@
program go_hamster;
uses crt;
{ Implement come back }
{ Implement death on trace cross }
{ Implement }
{ Implement figure cuts (check CutField) }
{ Implement interface }
{ Implement lifes }
{ Implement bar }
{ Implement score }
{ Implement bonuses }
{ Implement hamster speed up }
{ Implement life up }
{ Implement ghost }
{ Implement creature death }
{ Implement enemy slow }
{ Implement sun }
{ Implement snake }
{ Implement bobr }
{ Implement hamster animation }
{ Implement ghost animation }
{ Implement sun animation }
{ Implement snake animation }
{ Implement bobr animation }
const
GameFieldH = 33; { 33 }
GameFieldW = 40; { 40 }
ArenaH = 33;
ArenaW = 41;
InterfaceH = 6;
CellSize = 2;
BorderSize = 1;
ScreenW = GameFieldW * CellSize + BorderSize * 2; { 82 }
FieldHeight = ScreenW - 3; {wtf? why? maybe later}
MinScreenH = FieldHeight;
ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 80 }
ScreenH = (ArenaH + InterfaceH) * CellSize + BorderSize;
WidthCoefficient = 2;
MinScreenW = ScreenW * WidthCoefficient;
InterfaceBarH = ScreenW - GameFieldH * CellSize - BorderSize * 2; { 14 }
FieldBorder = '#';
InterfaceBarH = ScreenW - ArenaH * CellSize - BorderSize * 2; { 14 }
BorderSymbol = '#';
HamsterSymbol = '*';
DelaySizeMs = 100;
EscCode = 27;
CtrlCCode = 3;
TraceSymbol = '@';
DelaySizeMs = 150;
SpaceOrd = 32;
EscOrd = 27;
CtrlCOrd = 3;
ArrowLeftOrd = -75;
ArrowRightOrd = -77;
ArrowDownOrd = -80;
ArrowUpOrd = -72;
PreviousTraceIdx = 3;
HamsterDelta = 2;
DebugMsg = '==============bObr=kUrwa=============';
type
character = record
creature = record
curX, curY, dX, dY: integer;
symbol: char
end;
tracePtr = ^trace;
trace = record
curX, curY: integer;
prev: tracePtr
end;
arena = array [1..ArenaH, 1..ArenaW] of boolean;
function IsTerminalValid: boolean;
begin
IsTerminalValid :=
(ScreenWidth >= MinScreenW) and (ScreenHeight >= MinScreenH)
(ScreenWidth >= ScreenW) and (ScreenHeight >= ScreenH)
end;
procedure PrintTerminalHelp;
begin
writeln('Increase your terminal size and try again.');
if ScreenWidth < MinScreenW then
if ScreenWidth < ScreenW then
begin
writeln('Your terminal width: ', ScreenWidth,
'. Required: ', MinScreenW, '.')
'. Required: ', ScreenW, '.')
end;
if ScreenHeight < MinScreenH then
if ScreenHeight < ScreenH then
begin
writeln('Your terminal height: ', ScreenHeight,
'. Required: ', MinScreenH, '.')
'. Required: ', ScreenH, '.')
end
end;
@ -74,7 +106,7 @@ var
begin
GotoXY(x, y);
for i := 1 to len do
write(FieldBorder);
write(BorderSymbol);
GotoXY(1, 1)
end;
@ -85,7 +117,7 @@ begin
for i := 1 to len do
begin
GotoXY(x, y + i - 1);
write(FieldBorder)
write(BorderSymbol)
end;
GotoXY(1, 1)
end;
@ -94,14 +126,13 @@ procedure DrawRectangle(x0, y0, h, w: integer);
var
i: integer;
begin
clrscr;
DrawLineX(x0, y0, w);
for i := 1 to h - 2 do
begin
GotoXY(x0, y0 + i);
write(FieldBorder);
write(BorderSymbol);
GotoXY(x0 + w - 1, y0 + i);
write(FieldBorder)
write(BorderSymbol)
end;
DrawLineX(x0, y0 + h - 1, w);
GotoXY(1, 1)
@ -116,12 +147,133 @@ begin
DrawLineY(cellW * 2 * WidthCoefficient + 1, 1, InterfaceBarH)
end;
procedure DrawArena(ScreenW, FieldHeight: integer);
procedure DrawInterface(ScreenH, ScreenW: integer);
begin
DrawRectangle(1, 1, FieldHeight, ScreenW * WidthCoefficient);
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient);
DrawInterface
end;
procedure
InitiateCreature(var cr: creature; curX, curY, dX, dY: integer; symbol: char);
begin
cr.curX := curX;
cr.curY := curY;
cr.dX := dX;
cr.dY := dY;
cr.symbol := symbol
end;
function IsOnBorder(var cr: creature): boolean;
begin
IsOnBorder :=
(cr.curX = 1) or (cr.curX = ArenaW) or (cr.curY = 1) or
(cr.curY = ArenaH)
end;
procedure FillArenaCell(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 CutField(var t: tracePtr);
var
traceTmp: tracePtr;
begin
GotoXY(2, 2);
writeln(' ');
GotoXY(2, 2);
writeln(t^.curX, ' ', t^.curY);
while t <> nil do
begin
FillArenaCell(t^.curX, t^.curY, ' ');
traceTmp := t^.prev;
dispose(t);
t := traceTmp
end
end;
function IsTraceExists(var t: tracePtr; x, y: integer): boolean;
begin
if t = nil then
IsTraceExists := false
else
if (t^.curX = x) and (t^.curY = y) then
IsTraceExists := true
else
IsTraceExists := IsTraceExists(t^.prev, x, y)
end;
function FindIdx(var t: tracePtr; x, y, curIdx: integer): integer;
begin
if t = nil then
FindIdx := -1
else
if (t^.curX = x) and (t^.curY = y) then
FindIdx := curIdx
else
FindIdx := FindIdx(t^.prev, x, y, curIdx + 1)
end;
function HamsterMovePossible(var h: creature; var t: tracePtr): boolean;
var
nextX, nextY, idx: integer;
begin
nextX := h.curX + h.dX;
nextY := h.curY + h.dY;
idx := FindIdx(t, nextX, nextY, 1);
HamsterMovePossible := (idx <= PreviousTraceIdx)
end;
procedure StopCreature(var cr: creature);
begin
cr.dX := 0;
cr.dY := 0
end;
procedure DrawArena;
begin
DrawRectangle(1, InterfaceBarH,
ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient)
end;
procedure UpdateDelta(keyCode: integer; var cr: creature); { Refactor later }
begin
case keyCode of
ArrowLeftOrd:
begin
cr.dX := -HamsterDelta;
cr.dY := 0
end;
ArrowRightOrd:
begin
cr.dX := HamsterDelta;
cr.dY := 0
end;
ArrowUpOrd:
begin
cr.dX := 0;
cr.dY := -HamsterDelta
end;
ArrowDownOrd:
begin
cr.dX := 0;
cr.dY := HamsterDelta
end;
SpaceOrd:
StopCreature(cr)
end
end;
function Clamp(val, min, max: integer): integer;
begin
Clamp := val;
@ -131,99 +283,210 @@ begin
Clamp := max
end;
procedure DrawCell(fieldX, fieldY: integer);
var
i: integer;
procedure MoveCreature(var cr: creature);
begin
GotoXY(fieldX, fieldY);
for i := 1 to CellSize * WidthCoefficient do
write(HamsterSymbol);
GotoXY(fieldX, fieldY + 1);
for i := 1 to CellSize * WidthCoefficient do
write(HamsterSymbol)
cr.curX := Clamp(cr.curX + cr.dX, 1, ArenaW);
cr.curY := Clamp(cr.curY + cr.dY, 1, ArenaH)
end;
procedure DrawHamster(var hamster: character);
procedure AddTrace(var t: tracePtr; nextX, nextY: integer);
var
fieldX, fieldY: integer;
nextTrace: tracePtr;
begin
hamster.curX := Clamp(hamster.curX, 1, GameFieldW + 1);
hamster.curY := Clamp(hamster.curY, 1, GameFieldH);
fieldX := 1 + (hamster.curX - 1) * CellSize * WidthCoefficient;
fieldY := InterfaceBarH + (hamster.curY - 1) * CellSize;
DrawCell(fieldX, fieldY)
new(nextTrace);
nextTrace^.curX := nextX;
nextTrace^.curY := nextY;
nextTrace^.prev := t;
t := nextTrace
end;
procedure UpdateDelta(keyCode: integer; var hamster: character);
procedure AddBorderTrace(var t: tracePtr; var hamster: creature; var a: arena);
begin
case keyCode of
ArrowLeftOrd:
if hamster.dX = 2 then
AddTrace(t, hamster.curX - 2, hamster.curY)
else
if hamster.dX = -2 then
AddTrace(t, hamster.curX + 2, hamster.curY)
else
if hamster.dY = 2 then
AddTrace(t, hamster.curX, hamster.curY - 2)
else
AddTrace(t, hamster.curX, hamster.curY + 2);
FillArenaCell(t^.curX, t^.curY, TraceSymbol);
a[t^.curX][t^.curY] := true
end;
function IsOnTrace(var t: tracePtr; var cr: creature): boolean;
var
tmp: tracePtr;
begin
tmp := t;
IsOnTrace := false;
while tmp <> nil do
begin
if (tmp^.curX = cr.curX) and (tmp^.curY = cr.curY) then
begin
hamster.dX := -1;
hamster.dY := 0
IsOnTrace := true;
break
end;
ArrowRightOrd:
begin
hamster.dX := 1;
hamster.dY := 0
end;
ArrowUpOrd:
begin
hamster.dX := 0;
hamster.dY := -1
end;
ArrowDownOrd:
begin
hamster.dX := 0;
hamster.dY := 1
end
tmp := tmp^.prev
end
end;
{
procedure ShowHamster(var hamster: character);
procedure PopTrace(var t: tracePtr);
var
tmpPrev: tracePtr;
begin
GotoXY()
tmpPrev := t^.prev;
dispose(t);
t := tmpPrev
end;
}
procedure PopHamsterTrace(var t: tracePtr; var a: arena);
begin
FillArenaCell(t^.curX, t^.curY, ' ');
a[t^.curY][t^.curX] := false;
PopTrace(t)
end;
procedure AddHamsterTrace(var t: tracePtr; var h: creature; var a: arena);
var
nextX, nextY: integer;
begin
if h.curX > t^.curX then
begin { to right }
nextX := t^.curX + 1;
nextY := t^.curY
end
else
if h.curX < t^.curX then
begin { to left }
nextX := t^.curX - 1;
nextY := t^.curY
end
else
if h.curY > t^.curY then
begin { to down }
nextX := t^.curX;
nextY := t^.curY + 1
end
else
if h.curY < t^.curY then
begin { to up }
nextX := t^.curX;
nextY := t^.curY - 1
end
else
begin
nextX := h.curX;
nextY := h.curY
end;
AddTrace(t, nextX, nextY);
FillArenaCell(t^.curX, t^.curY, TraceSymbol);
a[t^.curY][t^.curX] := true
end;
procedure
ChangeHamsterTrace(var t: tracePtr; var h: creature;
var a: arena; var redrawArena: boolean);
var
i: integer;
begin
if IsOnTrace(t, h) then
begin
if t^.prev = nil then { Hamster backed to border }
PopHamsterTrace(t, a)
else
for i := 1 to HamsterDelta do
PopHamsterTrace(t, a)
end
else
begin
if t = nil then
begin
AddBorderTrace(t, h, a);
redrawArena := true
end;
for i := 1 to HamsterDelta do
AddHamsterTrace(t, h, a)
end
end;
procedure HandleKey(var hamster: creature; var continueLevel: boolean);
var
keyCode: integer;
hamster: character;
begin
GetKey(keyCode);
if (keyCode = ArrowLeftOrd) or (keyCode = ArrowRightOrd) or
(keyCode = ArrowUpOrd) or (keyCode = ArrowDownOrd) or
(keyCode = SpaceOrd) then
begin
UpdateDelta(keyCode, hamster)
end;
if (keyCode = EscOrd) or (keyCode = CtrlCOrd) then
continueLevel := false
end;
procedure PrintHamsterDebug(var hamster: creature);
var
i: integer;
begin
GotoXY(2, 2);
for i := 1 to 20 do
write(' ');
GotoXY(2, 2);
writeln(hamster.curX, ' ', hamster.curY, ' ', hamster.dX, ' ', hamster.dY)
end;
procedure RunLevel;
var
hamster: creature;
arenaCells: arena;
hamsterTrace: tracePtr = nil;
continueLevel: boolean = true;
redrawArena: boolean = false;
begin
InitiateCreature(hamster, 5, 1, 0, 0, HamsterSymbol);
FillArenaCell(hamster.curX, hamster.curY, hamster.symbol);
while continueLevel do
begin
delay(DelaySizeMs);
if (hamsterTrace <> nil) and IsOnBorder(hamster) and
(hamsterTrace^.prev <> nil) then
begin
CutField(hamsterTrace)
end;
if keypressed then
HandleKey(hamster, continueLevel);
if not HamsterMovePossible(hamster, hamsterTrace) then
StopCreature(hamster);
if (hamster.dX = 0) and (hamster.dY = 0) then
continue;
if not IsOnBorder(hamster) then
FillArenaCell(hamster.curX, hamster.curY, TraceSymbol)
else
FillArenaCell(hamster.curX, hamster.curY, ' ');
MoveCreature(hamster);
if IsOnBorder(hamster) and (hamsterTrace = nil) then
redrawArena := true
else
ChangeHamsterTrace(hamsterTrace, hamster, arenaCells, redrawArena);
if redrawArena then
begin
DrawArena;
redrawArena := false
end;
FillArenaCell(hamster.curX, hamster.curY, hamster.symbol)
end
end;
begin
if not IsTerminalValid then
begin
PrintTerminalHelp;
exit
end;
hamster.curX := 1;
hamster.curY := 1;
DrawArena(ScreenW, FieldHeight);
while true do
begin
delay(DelaySizeMs);
if keypressed then
begin
GetKey(keyCode);
{ writeln(keyCode); }
if (keyCode = ArrowLeftOrd) or (keyCode = ArrowRightOrd) or
(keyCode = ArrowUpOrd) or (keyCode = ArrowDownOrd) then
begin
UpdateDelta(keyCode, hamster)
end;
if (keyCode = EscCode) or (keyCode = CtrlCCode) then
break
end;
DrawHamster(hamster);
{
if (hamster.curX <> 1) and (hamster.curY <> GameFieldW) and
(hamster.curY <> 1) and (hamster.curY <> GameFieldH) then
begin
DrawHamster(hamster)
end;
}
hamster.curX := hamster.curX + hamster.dX;
hamster.curY := hamster.curY + hamster.dY
end
clrscr;
DrawInterface(ScreenH, ScreenW);
RunLevel;
end.