feat/TD-004-add-hamster-trace

This commit is contained in:
gre-ilya 2026-02-28 15:22:41 +05:00
parent b8b4e6801c
commit 8e6137af9d

View File

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