Merge pull request 'feat/TD-008-add-enemy-ghost' (#7) from dev into main
Reviewed-on: #7
This commit is contained in:
commit
8e319d6e70
@ -1,6 +1,8 @@
|
||||
FPC = fpc
|
||||
|
||||
GAME_SRC = gohamster.pas
|
||||
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
|
||||
|
||||
all: gohamster
|
||||
|
||||
@ -11,4 +13,4 @@ gohamster: $(GAME_SRC)
|
||||
$(FPC) $@.pas
|
||||
|
||||
clean:
|
||||
rm *.o gohamster
|
||||
rm *.o *.ppu gohamster
|
||||
|
||||
457
src/arena_m.pas
Normal file
457
src/arena_m.pas
Normal file
@ -0,0 +1,457 @@
|
||||
unit arena_m;
|
||||
|
||||
interface
|
||||
|
||||
uses creature_m, trace_m, hamster_m, debug_m;
|
||||
|
||||
const
|
||||
ArenaH = 33;
|
||||
ArenaW = 41;
|
||||
CaptureSymbol = '.';
|
||||
BorderSymbol = '|';
|
||||
ArenaSymbol = ' ';
|
||||
|
||||
type
|
||||
arenaBooleanMatrix = array [1..ArenaW, 1..ArenaH] of boolean;
|
||||
|
||||
arena = record
|
||||
captured, borders: arenaBooleanMatrix;
|
||||
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 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;
|
||||
|
||||
procedure Fill(var m: arenaBooleanMatrix; val: boolean);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for i := 1 to ArenaW do
|
||||
for j := 1 to ArenaH do
|
||||
m[i][j] := val
|
||||
end;
|
||||
|
||||
procedure Init(var a: arena);
|
||||
begin
|
||||
Fill(a.captured, false);
|
||||
Fill(a.borders, false)
|
||||
end;
|
||||
|
||||
function IsCellFree(x, y: integer; var a: arena): boolean;
|
||||
begin
|
||||
IsCellFree :=
|
||||
(x <> 0) and (x <> ArenaW + 1) and
|
||||
(y <> 0) and (y <> ArenaH + 1) and
|
||||
not a.captured[x][y] and not a.borders[x][y]
|
||||
end;
|
||||
|
||||
procedure ReleaseArenaCells(var q: QCell; var a: arena);
|
||||
var
|
||||
cell: cellItemPtr;
|
||||
begin
|
||||
while not QCellIsEmpty(q) do
|
||||
begin
|
||||
cell := QCellGet(q);
|
||||
a.captured[cell^.x][cell^.y] := false;
|
||||
QCellPop(q)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TryAddCell(x, y: integer; var q: QCell; var a: arena);
|
||||
var
|
||||
cell: cellItem;
|
||||
begin
|
||||
if IsCellFree(x, y, a) then
|
||||
begin
|
||||
InitCell(cell, x, y);
|
||||
QCellPush(q, cell)
|
||||
end
|
||||
end;
|
||||
|
||||
{ bfs algo iteration }
|
||||
procedure AddAvailableNeighbours(var q: QCell; var curCell: cellItem;
|
||||
var a: arena);
|
||||
var
|
||||
x, y: integer;
|
||||
begin
|
||||
x := curCell.x;
|
||||
y := curCell.y;
|
||||
TryAddCell(x - 1, y, q, a);
|
||||
TryAddCell(x + 1, y, q, a);
|
||||
TryAddCell(x, y - 1, q, a);
|
||||
TryAddCell(x, y + 1, q, a)
|
||||
end;
|
||||
|
||||
{ Kind of bfs algorithm. }
|
||||
function GetFigureArea(var partCell: cellItem; var a: arena): integer;
|
||||
var
|
||||
cellPtr: cellItemPtr;
|
||||
cell: cellItem;
|
||||
captureQ, releaseQ: QCell;
|
||||
result: integer = 0;
|
||||
begin
|
||||
QCellInit(captureQ);
|
||||
QCellInit(releaseQ);
|
||||
QCellPush(captureQ, partCell);
|
||||
while not QCellIsEmpty(captureQ) do
|
||||
begin
|
||||
cellPtr := QCellGet(captureQ);
|
||||
InitCell(cell, cellPtr^.x, cellPtr^.y);
|
||||
QCellPop(captureQ);
|
||||
if a.captured[cell.x][cell.y] then
|
||||
continue;
|
||||
result := result + 1;
|
||||
a.captured[cell.x][cell.y] := true;
|
||||
AddAvailableNeighbours(captureQ, cell, a);
|
||||
QCellPush(releaseQ, cell)
|
||||
end;
|
||||
ReleaseArenaCells(releaseQ, a);
|
||||
GetFigureArea := result
|
||||
end;
|
||||
|
||||
procedure CutPart(var partCell: cellItem; var a: arena);
|
||||
var
|
||||
cellPtr: cellItemPtr;
|
||||
cell: cellItem;
|
||||
captureQ: QCell;
|
||||
begin
|
||||
QCellInit(captureQ);
|
||||
QCellPush(captureQ, partCell);
|
||||
while not QCellIsEmpty(captureQ) do
|
||||
begin
|
||||
cellPtr := QCellGet(captureQ);
|
||||
InitCell(cell, cellPtr^.x, cellPtr^.y);
|
||||
QCellPop(captureQ);
|
||||
if a.captured[cell.x][cell.y] then
|
||||
continue;
|
||||
a.captured[cell.x][cell.y] := true;
|
||||
DrawArenaCell(cell.x, cell.y, CaptureSymbol);
|
||||
AddAvailableNeighbours(captureQ, cell, a)
|
||||
end
|
||||
end;
|
||||
|
||||
function OnEdgeX(x: integer): boolean;
|
||||
begin
|
||||
OnEdgeX := (x = 1) or (x = ArenaW)
|
||||
end;
|
||||
|
||||
function OnEdgeY(y: integer): boolean;
|
||||
begin
|
||||
OnEdgeY := (y = 1) or (y = ArenaH)
|
||||
end;
|
||||
|
||||
function IsOnEdge(x, y: integer): boolean;
|
||||
begin
|
||||
IsOnEdge := (OnEdgeX(x) or OnEdgeY(y))
|
||||
end;
|
||||
|
||||
function YNeighborsCaptured(x, y: integer; var a: arena): boolean;
|
||||
begin
|
||||
YNeighborsCaptured :=
|
||||
not OnEdgeY(y) and a.captured[x][y - 1] and a.captured[x][y + 1]
|
||||
end;
|
||||
|
||||
function XNeighborsCaptured(x, y: integer; var a: arena): boolean;
|
||||
begin
|
||||
XNeighborsCaptured :=
|
||||
not OnEdgeX(x) and a.captured[x + 1][y] and a.captured[x - 1][y]
|
||||
end;
|
||||
|
||||
function DiagonalNeighborsCaptured(x, y: integer; var a: arena): boolean;
|
||||
begin
|
||||
DiagonalNeighborsCaptured :=
|
||||
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]
|
||||
end;
|
||||
|
||||
function ArenaCellCaptured(x, y: integer; var a: arena): boolean;
|
||||
begin
|
||||
ArenaCellCaptured :=
|
||||
XNeighborsCaptured(x, y, a) or YNeighborsCaptured(x, y, a) or
|
||||
DiagonalNeighborsCaptured(x, y, a)
|
||||
end;
|
||||
|
||||
procedure CaptureArenaBorder(x, y: integer; var a: arena);
|
||||
begin
|
||||
a.borders[x][y] := false;
|
||||
a.captured[x][y] := true;
|
||||
DrawArenaCell(x, y, CaptureSymbol)
|
||||
end;
|
||||
|
||||
procedure CaptureCutBorders(var a: arena); { rename, slow }
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for i := 1 to ArenaH do
|
||||
for j := 1 to ArenaW do
|
||||
if a.borders[j][i] and ArenaCellCaptured(j, i, a) then
|
||||
CaptureArenaBorder(j, i, a)
|
||||
end;
|
||||
|
||||
procedure SetArenaBorder(var t: tracePtr; var a: arena);
|
||||
begin
|
||||
if t = nil then
|
||||
exit;
|
||||
a.borders[t^.x][t^.y] := true;
|
||||
SetArenaBorder(t^.prev, a)
|
||||
end;
|
||||
|
||||
function IsOnEdge(var cr: creature): boolean;
|
||||
begin
|
||||
IsOnEdge :=
|
||||
(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]
|
||||
)
|
||||
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]
|
||||
)
|
||||
end;
|
||||
|
||||
function ArenaSplited(var h: creature; var t: tracePtr; var a: arena): boolean;
|
||||
begin
|
||||
ArenaSplited :=
|
||||
(t <> nil) and (IsOnBorder(h, a) or IsOnEdge(h)) and (t^.prev <> nil)
|
||||
end;
|
||||
|
||||
procedure GetPartsCells(var t: tracePtr; var part1, part2: cellItem;
|
||||
var a: arena);
|
||||
var
|
||||
prevTrace: tracePtr;
|
||||
begin
|
||||
prevTrace := t^.prev;
|
||||
if t^.y = prevTrace^.y then
|
||||
begin
|
||||
InitCell(part1, prevTrace^.x, prevTrace^.y - 1);
|
||||
InitCell(part2, prevTrace^.x, prevTrace^.y + 1)
|
||||
end
|
||||
else
|
||||
begin
|
||||
InitCell(part1, prevTrace^.x - 1, prevTrace^.y);
|
||||
InitCell(part2, prevTrace^.x + 1, prevTrace^.y)
|
||||
end
|
||||
end;
|
||||
|
||||
function StepOnTrace(var hamster: creature; var t: tracePtr): boolean;
|
||||
var
|
||||
nextX, nextY, idx: integer;
|
||||
begin
|
||||
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;
|
||||
|
||||
function StepBeyondEdge(var cr: creature): boolean;
|
||||
begin
|
||||
StepBeyondEdge :=
|
||||
(cr.dX > 0) and (cr.curX = ArenaW) or
|
||||
(cr.dX < 0) and (cr.curX = 1) or
|
||||
(cr.dY > 0) and (cr.curY = ArenaH) or
|
||||
(cr.dY < 0) and (cr.curY = 1)
|
||||
end;
|
||||
|
||||
procedure CutSmallerPart(var hamster: creature; var t: tracePtr; var a: arena);
|
||||
var {refactor?}
|
||||
area1, area2: integer;
|
||||
part1, part2, smallerFigure: cellItem;
|
||||
begin
|
||||
GetPartsCells(t, part1, part2, a);
|
||||
area1 := GetFigureArea(part1, a);
|
||||
area2 := GetFigureArea(part2, a);
|
||||
if area1 <= area2 then
|
||||
smallerFigure := part1
|
||||
else
|
||||
smallerFigure := part2;
|
||||
CutPart(smallerFigure, a);
|
||||
CaptureCutBorders(a);
|
||||
DrawArenaBorders(a);
|
||||
DrawArenaEdges;
|
||||
DrawCreature(hamster);
|
||||
Delete(t)
|
||||
end;
|
||||
|
||||
function
|
||||
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, 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 StepBeyondEdge(h)
|
||||
and not (
|
||||
not IsOnEdge(h) and a.borders[h.curX][h.curY] and
|
||||
a.captured[midX][midY]
|
||||
)
|
||||
end;
|
||||
|
||||
function
|
||||
FieldToEdge(var hamster: creature; var t: tracePtr; var a: arena): boolean;
|
||||
var
|
||||
midX, midY: integer;
|
||||
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
|
||||
not (IsOnEdge(midX, midY))
|
||||
end;
|
||||
|
||||
function
|
||||
IsOnField(var hamster: creature; var t: tracePtr; var a: arena): boolean;
|
||||
var
|
||||
midX, midY: integer;
|
||||
begin
|
||||
midX := hamster.curX - (hamster.dX div 2);
|
||||
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]
|
||||
end;
|
||||
|
||||
procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena);
|
||||
begin
|
||||
MakeStep(h);
|
||||
if FieldToEdge(h, t, a) or IsOnField(h, t, a) then
|
||||
ChangeHamsterTrace(h, t);
|
||||
DrawAfterStep(h, t, a)
|
||||
end;
|
||||
|
||||
function GhostShouldTurn(var g: creature; var a: arena): boolean;
|
||||
var
|
||||
nextX, nextY: integer;
|
||||
begin
|
||||
nextX := g.curX + g.dX;
|
||||
nextY := g.curY + g.dY;
|
||||
GhostShouldTurn := IsOnEdge(nextX, nextY) or a.borders[nextX][nextY]
|
||||
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])
|
||||
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])
|
||||
end;
|
||||
|
||||
function IsCorner(x, y: integer; var a: arena): boolean;
|
||||
begin
|
||||
IsCorner := BorderX(x, y, a) and BorderY(x, y, a)
|
||||
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]
|
||||
end;
|
||||
|
||||
|
||||
function IsConvexCorner(var cr: creature; var a: arena): boolean;
|
||||
var
|
||||
x, y, nextX, nextY: integer;
|
||||
begin
|
||||
x := cr.curX;
|
||||
y := cr.curY;
|
||||
nextX := x + cr.dX;
|
||||
nextY := y + cr.dY;
|
||||
IsConvexCorner :=
|
||||
IsCorner(nextX, nextY, a) and
|
||||
not IsOnEdge(nextX, nextY) and
|
||||
not IsConcaveCorner(x, y, a)
|
||||
end;
|
||||
|
||||
procedure CornerTurn(var cr: creature; var a: arena);
|
||||
var
|
||||
x, y, nextX, nextY: integer;
|
||||
begin
|
||||
x := cr.curX;
|
||||
y := cr.curY;
|
||||
nextX := x + cr.dX;
|
||||
nextY := y + cr.dY;
|
||||
if not a.borders[nextX][y] and not a.borders[x][nextY] then
|
||||
begin
|
||||
cr.dX := cr.dX * -1;
|
||||
cr.dY := cr.dY * -1
|
||||
end
|
||||
else
|
||||
if a.borders[nextX][y] then
|
||||
cr.dX := cr.dX * -1
|
||||
else
|
||||
cr.dY := cr.dY * -1
|
||||
end;
|
||||
|
||||
procedure TurnGhost(var g: creature; var a: arena);
|
||||
var
|
||||
nextX, nextY: integer;
|
||||
begin
|
||||
nextX := g.curX + g.dX;
|
||||
nextY := g.curY + g.dY;
|
||||
if IsConvexCorner(g, a) then
|
||||
begin
|
||||
CornerTurn(g, a)
|
||||
end
|
||||
else
|
||||
begin
|
||||
if OnEdgeX(nextX) or BorderY(nextX, nextY, a) then
|
||||
g.dX := g.dX * -1;
|
||||
if OnEdgeY(nextY) or BorderX(nextX, nextY, a) then
|
||||
g.dY := g.dY * -1
|
||||
end
|
||||
end;
|
||||
|
||||
procedure MakeEnemyStep(var e: creature; var a: arena);
|
||||
begin
|
||||
MakeStep(e);
|
||||
DrawAfterStep(e, a)
|
||||
end;
|
||||
|
||||
end.
|
||||
80
src/cell_m.pas
Normal file
80
src/cell_m.pas
Normal file
@ -0,0 +1,80 @@
|
||||
unit cell_m;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
cellItemPtr = ^cellItem;
|
||||
|
||||
cellItem = record
|
||||
x, y: integer;
|
||||
next: cellItemPtr
|
||||
end;
|
||||
|
||||
QCell = record
|
||||
first, last: cellItemPtr
|
||||
end;
|
||||
|
||||
procedure InitCell(var c: cellItem; x, y: integer);
|
||||
procedure QCellInit(var q: QCell);
|
||||
procedure QCellPush(var q: QCell; var c: cellItem);
|
||||
function QCellIsEmpty(var q: QCell): boolean;
|
||||
function QCellGet(var q: QCell): cellItemPtr;
|
||||
procedure QCellPop(var q: QCell);
|
||||
|
||||
implementation
|
||||
|
||||
procedure InitCell(var c: cellItem; x, y: integer);
|
||||
begin
|
||||
c.x := x;
|
||||
c.y := y;
|
||||
c.next := nil
|
||||
end;
|
||||
|
||||
procedure QCellInit(var q: QCell);
|
||||
begin
|
||||
q.first := nil;
|
||||
q.last := nil
|
||||
end;
|
||||
|
||||
procedure QCellPush(var q: QCell; var c: cellItem);
|
||||
var
|
||||
tmp: cellItemPtr;
|
||||
begin
|
||||
new(tmp);
|
||||
tmp^.x := c.x;
|
||||
tmp^.y := c.y;
|
||||
tmp^.next := nil;
|
||||
if q.last = nil then
|
||||
begin
|
||||
q.first := tmp;
|
||||
q.last := q.first
|
||||
end
|
||||
else
|
||||
begin
|
||||
q.last^.next := tmp;
|
||||
q.last := q.last^.next
|
||||
end
|
||||
end;
|
||||
|
||||
function QCellIsEmpty(var q: QCell): boolean;
|
||||
begin
|
||||
QCellIsEmpty := (q.last = nil)
|
||||
end;
|
||||
|
||||
function QCellGet(var q: QCell): cellItemPtr;
|
||||
begin
|
||||
QCellGet := q.first
|
||||
end;
|
||||
|
||||
procedure QCellPop(var q: QCell);
|
||||
var
|
||||
removeItem: cellItemPtr;
|
||||
begin
|
||||
removeItem := QCellGet(q);
|
||||
q.first := removeItem^.next;
|
||||
if q.first = nil then
|
||||
q.last := q.first;
|
||||
dispose(removeItem)
|
||||
end;
|
||||
|
||||
end.
|
||||
42
src/creature_m.pas
Normal file
42
src/creature_m.pas
Normal file
@ -0,0 +1,42 @@
|
||||
unit creature_m;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
creature = record
|
||||
curX, curY, dX, dY: integer;
|
||||
symbol: char
|
||||
end;
|
||||
|
||||
procedure
|
||||
InitCreature(var cr: creature; curX, curY, dX, dY: integer; symbol: char);
|
||||
procedure StopCreature(var cr: creature);
|
||||
procedure MakeStep(var cr: creature);
|
||||
|
||||
implementation
|
||||
|
||||
uses arena_m, math_m;
|
||||
|
||||
procedure
|
||||
InitCreature(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;
|
||||
|
||||
procedure StopCreature(var cr: creature);
|
||||
begin
|
||||
cr.dX := 0;
|
||||
cr.dY := 0
|
||||
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;
|
||||
|
||||
end.
|
||||
66
src/debug_m.pas
Normal file
66
src/debug_m.pas
Normal file
@ -0,0 +1,66 @@
|
||||
unit debug_m;
|
||||
|
||||
interface
|
||||
|
||||
uses {arena_m,} cell_m, creature_m;
|
||||
|
||||
procedure Debug;
|
||||
procedure DebugCell(cell: cellItemPtr);
|
||||
{procedure Print(var m: arenaBooleanMatrix);}
|
||||
|
||||
procedure PrintCreatureDebug(var cr: creature);
|
||||
|
||||
implementation
|
||||
|
||||
uses crt;
|
||||
|
||||
const
|
||||
DebugMsg = '===============DEBUG===============';
|
||||
|
||||
var
|
||||
DebugTmp: integer = 2;
|
||||
|
||||
procedure Debug;
|
||||
begin
|
||||
GotoXY(2, DebugTmp);
|
||||
writeln(DebugMsg);
|
||||
DebugTmp := DebugTmp + 1
|
||||
end;
|
||||
|
||||
procedure DebugCell(cell: cellItemPtr);
|
||||
begin
|
||||
GotoXY(2, DebugTmp);
|
||||
writeln('Cur X: ', cell^.x, ' Cur Y: ', cell^.y);
|
||||
DebugTmp := DebugTmp + 1
|
||||
end;
|
||||
|
||||
{
|
||||
procedure Print(var m: arenaBooleanMatrix);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for i := 1 to ArenaH do
|
||||
begin
|
||||
for j := 1 to ArenaW do
|
||||
if m[j][i] then
|
||||
write(1, ' ')
|
||||
else
|
||||
write(0, ' ');
|
||||
writeln
|
||||
end;
|
||||
GotoXY(1, 1)
|
||||
end;
|
||||
}
|
||||
|
||||
procedure PrintCreatureDebug(var cr: creature);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
GotoXY(2, 2);
|
||||
for i := 1 to 20 do
|
||||
write(' ');
|
||||
GotoXY(2, 2);
|
||||
writeln(cr.curX, ' ', cr.curY, ' ', cr.dX, ' ', cr.dY)
|
||||
end;
|
||||
|
||||
end.
|
||||
25
src/ghost_m.pas
Normal file
25
src/ghost_m.pas
Normal file
@ -0,0 +1,25 @@
|
||||
unit ghost_m;
|
||||
|
||||
interface
|
||||
|
||||
uses creature_m;
|
||||
|
||||
const
|
||||
GhostStartX = 5;
|
||||
GhostStartY = 5;
|
||||
GhostDelta = 1;
|
||||
GhostStartDX = GhostDelta;
|
||||
GhostStartDY = GhostDelta;
|
||||
GhostSymbol = 'g';
|
||||
|
||||
procedure InitGhost(var g: creature);
|
||||
|
||||
implementation
|
||||
|
||||
procedure InitGhost(var g: creature);
|
||||
begin
|
||||
InitCreature(g, GhostStartX, GhostStartY,
|
||||
GhostStartDX, GhostStartDY, GhostSymbol)
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -1,867 +1,39 @@
|
||||
program go_hamster;
|
||||
uses crt;
|
||||
|
||||
{ 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 }
|
||||
|
||||
var
|
||||
DebugTmp: integer = 2;
|
||||
uses crt, arena_m, trace_m, creature_m, graphics_m, hamster_m, keys_m, ghost_m,
|
||||
debug_m;
|
||||
|
||||
const
|
||||
ArenaH = 33;
|
||||
ArenaW = 41;
|
||||
InterfaceH = 6;
|
||||
CellSize = 2;
|
||||
BorderSize = 1;
|
||||
ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 80 }
|
||||
ScreenH = (ArenaH + InterfaceH) * CellSize + BorderSize;
|
||||
WidthCoefficient = 2;
|
||||
MinScreenW = ScreenW * WidthCoefficient;
|
||||
InterfaceBarH = ScreenW - ArenaH * CellSize - BorderSize * 2; { 14 }
|
||||
BorderSymbol = '#';
|
||||
HamsterSymbol = '*';
|
||||
TraceSymbol = '@';
|
||||
VoidSymbol = '.';
|
||||
DelaySizeMs = 150;
|
||||
SpaceOrd = 32;
|
||||
EscOrd = 27;
|
||||
CtrlCOrd = 3;
|
||||
ArrowLeftOrd = -75;
|
||||
ArrowRightOrd = -77;
|
||||
ArrowDownOrd = -80;
|
||||
ArrowUpOrd = -72;
|
||||
PreviousTraceIdx = 3;
|
||||
HamsterDelta = 2;
|
||||
DebugMsg = '==============bObr=kUrwa=============';
|
||||
|
||||
type
|
||||
creature = record
|
||||
curX, curY, dX, dY: integer;
|
||||
symbol: char
|
||||
end;
|
||||
|
||||
tracePtr = ^trace;
|
||||
|
||||
trace = record
|
||||
x, y: integer;
|
||||
prev: tracePtr
|
||||
end;
|
||||
|
||||
arena = array [1..ArenaW, 1..ArenaH] of boolean;
|
||||
|
||||
cellItemPtr = ^cellItem;
|
||||
|
||||
cellItem = record
|
||||
x, y: integer;
|
||||
next: cellItemPtr
|
||||
end;
|
||||
|
||||
QCell = record
|
||||
first, last: cellItemPtr
|
||||
end;
|
||||
|
||||
procedure DebugCell(curCell: cellItemPtr);
|
||||
begin
|
||||
GotoXY(2, DebugTmp);
|
||||
writeln('Cur X: ', curCell^.x, ' Cur Y: ', curCell^.y);
|
||||
DebugTmp := DebugTmp + 1
|
||||
end;
|
||||
|
||||
procedure DebugOrArenas(var a, b: arena);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for i := 1 to ArenaH do
|
||||
begin
|
||||
for j := 1 to ArenaW do
|
||||
if a[j][i] or b[j][i] then
|
||||
write(1, ' ')
|
||||
else
|
||||
write(0, ' ');
|
||||
writeln
|
||||
end
|
||||
end;
|
||||
|
||||
procedure DebugPrintArena(var a: arena);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for i := 1 to ArenaH do
|
||||
begin
|
||||
for j := 1 to ArenaW do
|
||||
if a[j][i] then
|
||||
write(1, ' ')
|
||||
else
|
||||
write(0, ' ');
|
||||
writeln
|
||||
end
|
||||
end;
|
||||
|
||||
function IsTerminalValid: boolean;
|
||||
begin
|
||||
IsTerminalValid := (ScreenWidth >= ScreenW) and (ScreenHeight >= ScreenH)
|
||||
end;
|
||||
|
||||
procedure PrintTerminalHelp;
|
||||
begin
|
||||
writeln('Increase your terminal size and try again.');
|
||||
if ScreenWidth < ScreenW then
|
||||
begin
|
||||
writeln('Your terminal width: ', ScreenWidth,
|
||||
'. Required: ', ScreenW, '.')
|
||||
end;
|
||||
if ScreenHeight < ScreenH then
|
||||
begin
|
||||
writeln('Your terminal height: ', ScreenHeight,
|
||||
'. Required: ', ScreenH, '.')
|
||||
end
|
||||
end;
|
||||
|
||||
procedure GetKey(var keyCode: integer);
|
||||
var
|
||||
c: char;
|
||||
begin
|
||||
c := ReadKey;
|
||||
if c = #0 then
|
||||
begin
|
||||
c := ReadKey;
|
||||
keyCode := -ord(c)
|
||||
end
|
||||
else
|
||||
begin
|
||||
keyCode := ord(c)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure DrawLineX(x, y, len: integer);
|
||||
var
|
||||
i: integer;
|
||||
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
|
||||
begin
|
||||
GotoXY(x, y + i - 1);
|
||||
write(BorderSymbol)
|
||||
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(BorderSymbol);
|
||||
GotoXY(x0 + w - 1, y0 + i);
|
||||
write(BorderSymbol)
|
||||
end;
|
||||
DrawLineX(x0, y0 + h - 1, w);
|
||||
GotoXY(1, 1)
|
||||
end;
|
||||
|
||||
procedure DrawInterface;
|
||||
var
|
||||
cellW: integer = ScreenW div 3;
|
||||
begin
|
||||
DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient);
|
||||
DrawLineY(cellW * WidthCoefficient, 1, InterfaceBarH);
|
||||
DrawLineY(cellW * 2 * WidthCoefficient + 1, 1, InterfaceBarH)
|
||||
end;
|
||||
|
||||
procedure DrawInterface(ScreenH, ScreenW: integer);
|
||||
begin
|
||||
DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient);
|
||||
DrawInterface
|
||||
end;
|
||||
|
||||
procedure FillArena(var a: arena; val: boolean);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for i := 1 to ArenaW do
|
||||
for j := 1 to ArenaH do
|
||||
a[i][j] := val
|
||||
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 IsOnEdge(var cr: creature): boolean;
|
||||
begin
|
||||
IsOnEdge :=
|
||||
(cr.curX = 1) or (cr.curX = ArenaW) or (cr.curY = 1) or
|
||||
(cr.curY = ArenaH)
|
||||
end;
|
||||
|
||||
function IsOnBorder(var cr: creature; var borders, captured: arena): boolean;
|
||||
begin
|
||||
IsOnBorder :=
|
||||
borders[cr.curX][cr.curY] and (
|
||||
captured[cr.curX - 1][cr.curY + 1] or
|
||||
captured[cr.curX - 1][cr.curY - 1] or
|
||||
captured[cr.curX + 1][cr.curY + 1] or
|
||||
captured[cr.curX + 1][cr.curY - 1]
|
||||
)
|
||||
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;
|
||||
|
||||
function GetTraceLength(var t: tracePtr): integer;
|
||||
begin
|
||||
if t = nil then
|
||||
GetTraceLength := 0
|
||||
else
|
||||
GetTraceLength := 1 + GetTraceLength(t^.prev)
|
||||
end;
|
||||
|
||||
function NewCellItem(x, y: integer): cellItemPtr;
|
||||
var
|
||||
newCell: cellItemPtr;
|
||||
begin
|
||||
new(newCell);
|
||||
newCell^.x := x;
|
||||
newCell^.y := y;
|
||||
newCell^.next := nil;
|
||||
NewCellItem := newCell
|
||||
end;
|
||||
|
||||
procedure InitCell(var c: cellItem; x, y: integer);
|
||||
begin
|
||||
c.x := x;
|
||||
c.y := y;
|
||||
c.next := nil
|
||||
end;
|
||||
|
||||
procedure GetFiguresCells(var t: tracePtr; var figure1, figure2: cellItem;
|
||||
var captured: arena);
|
||||
var
|
||||
prevTrace: tracePtr;
|
||||
begin
|
||||
prevTrace := t^.prev;
|
||||
{if (t^.x = 1) or (t^.x = ArenaW) or
|
||||
(t^.y <> 1) and captured[prevTrace^.x][prevTrace^.y - 1] or
|
||||
(t^.y <> ArenaH) and captured[prevTrace^.x][prevTrace^.y + 1] then}
|
||||
if t^.y = prevTrace^.y then
|
||||
begin
|
||||
InitCell(figure1, prevTrace^.x, prevTrace^.y - 1);
|
||||
InitCell(figure2, prevTrace^.x, prevTrace^.y + 1)
|
||||
end
|
||||
else
|
||||
begin
|
||||
InitCell(figure1, prevTrace^.x - 1, prevTrace^.y);
|
||||
InitCell(figure2, prevTrace^.x + 1, prevTrace^.y)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure QCellInit(var q: QCell);
|
||||
begin
|
||||
q.first := nil;
|
||||
q.last := nil
|
||||
end;
|
||||
|
||||
procedure QCellPush(var q: QCell; var c: cellItem);
|
||||
begin
|
||||
if q.last = nil then
|
||||
begin
|
||||
new(q.first);
|
||||
q.first^.x := c.x;
|
||||
q.first^.y := c.y;
|
||||
q.first^.next := nil;
|
||||
q.last := q.first
|
||||
end
|
||||
else
|
||||
begin
|
||||
new(q.last^.next);
|
||||
q.last := q.last^.next;
|
||||
q.last^.x := c.x;
|
||||
q.last^.y := c.y;
|
||||
q.last^.next := nil
|
||||
end
|
||||
end;
|
||||
|
||||
function QCellIsEmpty(var q: QCell): boolean;
|
||||
begin
|
||||
QCellIsEmpty := (q.last = nil)
|
||||
end;
|
||||
|
||||
function QCellGet(var q: QCell): cellItemPtr;
|
||||
begin
|
||||
QCellGet := q.first
|
||||
end;
|
||||
|
||||
function IsCellFree(x, y: integer; var borders, captured: arena): boolean;
|
||||
begin
|
||||
IsCellFree :=
|
||||
(x <> 0) and (x <> ArenaW + 1) and
|
||||
(y <> 0) and (y <> ArenaH + 1) and
|
||||
not captured[x][y] and not borders[x][y]
|
||||
end;
|
||||
|
||||
procedure QCellPop(var q: QCell);
|
||||
var
|
||||
removeItem: cellItemPtr;
|
||||
begin
|
||||
removeItem := QCellGet(q);
|
||||
q.first := removeItem^.next;
|
||||
if q.first = nil then
|
||||
q.last := q.first;
|
||||
dispose(removeItem)
|
||||
end;
|
||||
|
||||
procedure AddAvailableNeighbours(var q: QCell; var curCell: cellItemPtr;
|
||||
var borders, captured: arena);
|
||||
var
|
||||
addCell: cellItem;
|
||||
begin
|
||||
if IsCellFree(curCell^.x - 1, curCell^.y, borders, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x - 1, curCell^.y);
|
||||
captured[addCell.x][addCell.y] := true;
|
||||
QCellPush(q, addCell)
|
||||
end;
|
||||
if IsCellFree(curCell^.x + 1, curCell^.y, borders, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x + 1, curCell^.y);
|
||||
captured[addCell.x][addCell.y] := true;
|
||||
QCellPush(q, addCell)
|
||||
end;
|
||||
if IsCellFree(curCell^.x, curCell^.y - 1, borders, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x, curCell^.y - 1);
|
||||
captured[addCell.x][addCell.y] := true;
|
||||
QCellPush(q, addCell)
|
||||
end;
|
||||
if IsCellFree(curCell^.x, curCell^.y + 1, borders, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x, curCell^.y + 1);
|
||||
captured[addCell.x][addCell.y] := true;
|
||||
QCellPush(q, addCell)
|
||||
end
|
||||
end;
|
||||
|
||||
{ Kind of bfs algorithm. }
|
||||
procedure CaptureFigure(var startCell: cellItem; var capturedN: integer;
|
||||
var borders, captured: arena);
|
||||
var
|
||||
curCell: cellItemPtr;
|
||||
q: QCell;
|
||||
begin
|
||||
capturedN := 0;
|
||||
QCellInit(q);
|
||||
QCellPush(q, startCell);
|
||||
captured[startCell.x][startCell.y] := true;
|
||||
while not QCellIsEmpty(q) do
|
||||
begin
|
||||
capturedN := capturedN + 1;
|
||||
curCell := QCellGet(q);
|
||||
AddAvailableNeighbours(q, curCell, borders, captured);
|
||||
{
|
||||
clrscr;
|
||||
writeln('x: ', curCell^.x, ' y: ', curCell^.y);
|
||||
DebugOrArenas(borders, captured);
|
||||
}
|
||||
QCellPop(q)
|
||||
end
|
||||
end;
|
||||
|
||||
function IsCellCaptured(x, y: integer; var captured: arena): boolean;
|
||||
begin
|
||||
IsCellCaptured :=
|
||||
(x <> 0) and (x <> ArenaW + 1) and
|
||||
(y <> 0) and (y <> ArenaH + 1) and
|
||||
captured[x][y]
|
||||
end;
|
||||
|
||||
procedure BfsReleaseCell(x, y: integer; var q: QCell; var captured: arena);
|
||||
var
|
||||
addCell: cellItem;
|
||||
begin
|
||||
InitCell(addCell, x, y);
|
||||
QCellPush(q, addCell);
|
||||
captured[x][y] := false
|
||||
end;
|
||||
|
||||
procedure AddCapturedNeighbours(var q: QCell; var curCell: cellItemPtr;
|
||||
var captured: arena);
|
||||
var
|
||||
addCell: cellItem;
|
||||
begin
|
||||
if IsCellCaptured(curCell^.x - 1, curCell^.y, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x - 1, curCell^.y);
|
||||
captured[addCell.x][addCell.y] := false;
|
||||
QCellPush(q, addCell)
|
||||
end;
|
||||
if IsCellCaptured(curCell^.x + 1, curCell^.y, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x + 1, curCell^.y);
|
||||
captured[addCell.x][addCell.y] := false;
|
||||
QCellPush(q, addCell)
|
||||
end;
|
||||
if IsCellCaptured(curCell^.x, curCell^.y - 1, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x, curCell^.y - 1);
|
||||
captured[addCell.x][addCell.y] := false;
|
||||
QCellPush(q, addCell)
|
||||
end;
|
||||
if IsCellCaptured(curCell^.x, curCell^.y + 1, captured) then
|
||||
begin
|
||||
InitCell(addCell, curCell^.x, curCell^.y + 1);
|
||||
captured[addCell.x][addCell.y] := false;
|
||||
QCellPush(q, addCell)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure ReleaseFigure(var startCell: cellItem; var captured: arena);
|
||||
var
|
||||
curCell: cellItemPtr;
|
||||
q: QCell;
|
||||
begin
|
||||
QCellInit(q);
|
||||
QCellPush(q, startCell);
|
||||
while not QCellIsEmpty(q) do
|
||||
begin
|
||||
curCell := QCellGet(q);
|
||||
AddCapturedNeighbours(q, curCell, captured);
|
||||
QCellPop(q)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure FillCaptured(var borders, captured: arena);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for i := 1 to ArenaH do
|
||||
for j := 1 to ArenaW do
|
||||
if captured[j][i] then
|
||||
FillArenaCell(j, i, VoidSymbol)
|
||||
else
|
||||
if borders[j][i] then
|
||||
FillArenaCell(j, i, BorderSymbol)
|
||||
end;
|
||||
|
||||
procedure CutField(var t: tracePtr; var borders, captured: arena);
|
||||
var
|
||||
captured1, captured2: integer;
|
||||
figure1, figure2: cellItem;
|
||||
begin
|
||||
GetFiguresCells(t, figure1, figure2, captured);
|
||||
if captured[figure1.x][figure1.y] then
|
||||
begin
|
||||
CaptureFigure(figure2, captured2, borders, captured)
|
||||
end
|
||||
else
|
||||
if captured[figure2.x][figure2.y] then
|
||||
begin
|
||||
CaptureFigure(figure1, captured1, borders, captured)
|
||||
end
|
||||
else
|
||||
begin
|
||||
CaptureFigure(figure1, captured1, borders, captured);
|
||||
CaptureFigure(figure2, captured2, borders, captured);
|
||||
if captured1 <= captured2 then
|
||||
ReleaseFigure(figure2, captured)
|
||||
else
|
||||
ReleaseFigure(figure1, captured)
|
||||
end;
|
||||
|
||||
{ Later move to another subroutine }
|
||||
FillCaptured(borders, captured)
|
||||
end;
|
||||
|
||||
procedure RemoveCutedBorders(var borders, captured: arena);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for i := 1 to ArenaH do
|
||||
for j := 1 to ArenaW do
|
||||
if borders[j][i] and
|
||||
(((j = 1) or (i = 1) or captured[j - 1][i - 1] or borders[j - 1][i - 1]) and
|
||||
((i = 1) or captured[j + 1][i - 1] or borders[j + 1][i - 1]) and
|
||||
((j = 1) or captured[j - 1][i + 1] or borders[j - 1][i + 1]) and
|
||||
(captured[j + 1][i + 1] or borders[j + 1][i + 1])) then
|
||||
begin
|
||||
borders[j][i] := false;
|
||||
captured[j][i] := true;
|
||||
FillArenaCell(j, i, VoidSymbol)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure DisposeTraces(var t: tracePtr);
|
||||
var
|
||||
tmpT: tracePtr;
|
||||
begin
|
||||
while t <> nil do
|
||||
begin
|
||||
tmpT := t^.prev;
|
||||
dispose(t);
|
||||
t := tmpT
|
||||
end
|
||||
end;
|
||||
|
||||
function IsTraceExists(var t: tracePtr; x, y: integer): boolean;
|
||||
begin
|
||||
if t = nil then
|
||||
IsTraceExists := false
|
||||
else
|
||||
if (t^.x = x) and (t^.y = y) then
|
||||
IsTraceExists := true
|
||||
else
|
||||
IsTraceExists := IsTraceExists(t^.prev, x, y)
|
||||
end;
|
||||
|
||||
function FindTraceIdx(var t: tracePtr; x, y, curIdx: integer): integer;
|
||||
begin
|
||||
if t = nil then
|
||||
FindTraceIdx := -1
|
||||
else
|
||||
if (t^.x = x) and (t^.y = y) then
|
||||
FindTraceIdx := curIdx
|
||||
else
|
||||
FindTraceIdx := FindTraceIdx(t^.prev, x, y, curIdx + 1)
|
||||
end;
|
||||
|
||||
function Clamp(val, min, max: integer): integer;
|
||||
begin
|
||||
Clamp := val;
|
||||
if val < min then
|
||||
Clamp := min;
|
||||
if val > max then
|
||||
Clamp := max
|
||||
end;
|
||||
|
||||
function { continue here }
|
||||
HamsterMovePossible(var h: creature; var t: tracePtr; var captured: arena):
|
||||
boolean;
|
||||
var
|
||||
nextX, nextY, idx: integer;
|
||||
begin
|
||||
nextX := Clamp(h.curX + h.dX, 1, ArenaW);
|
||||
nextY := Clamp(h.curY + h.dY, 1, ArenaH);
|
||||
idx := FindTraceIdx(t, nextX, nextY, 1);
|
||||
HamsterMovePossible :=
|
||||
(idx <= PreviousTraceIdx) and not captured[nextX][nextY]
|
||||
end;
|
||||
|
||||
procedure StopCreature(var cr: creature);
|
||||
begin
|
||||
cr.dX := 0;
|
||||
cr.dY := 0
|
||||
end;
|
||||
|
||||
procedure DrawArenaEdge;
|
||||
begin
|
||||
DrawRectangle(1, InterfaceBarH,
|
||||
ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient)
|
||||
end;
|
||||
|
||||
procedure DrawArenaBorders(var borders: arena);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for i := 1 to ArenaH do
|
||||
for j := 1 to ArenaW do
|
||||
if borders[j][i] then
|
||||
FillArenaCell(j, i, BorderSymbol)
|
||||
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;
|
||||
|
||||
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^.x := nextX;
|
||||
nextTrace^.y := nextY;
|
||||
nextTrace^.prev := t;
|
||||
t := nextTrace
|
||||
end;
|
||||
|
||||
procedure
|
||||
AddBorderTrace(var t: tracePtr; var hamster: creature; var borders: 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^.x, t^.y, TraceSymbol);
|
||||
borders[t^.x][t^.y] := true
|
||||
end;
|
||||
|
||||
function IsOnTrace(var t: tracePtr; var cr: creature): 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(t^.prev, cr)
|
||||
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^.x, t^.y, ' ');
|
||||
a[t^.x][t^.y] := false;
|
||||
PopTrace(t)
|
||||
end;
|
||||
|
||||
procedure
|
||||
AddHamsterTrace(var t: tracePtr; var h: creature; var borders: arena);
|
||||
var
|
||||
nextX, nextY: integer;
|
||||
begin
|
||||
if h.curX > t^.x then
|
||||
begin { to right }
|
||||
nextX := t^.x + 1;
|
||||
nextY := t^.y
|
||||
end
|
||||
else
|
||||
if h.curX < t^.x then
|
||||
begin { to left }
|
||||
nextX := t^.x - 1;
|
||||
nextY := t^.y
|
||||
end
|
||||
else
|
||||
if h.curY > t^.y then
|
||||
begin { to down }
|
||||
nextX := t^.x;
|
||||
nextY := t^.y + 1
|
||||
end
|
||||
else
|
||||
if h.curY < t^.y then
|
||||
begin { to up }
|
||||
nextX := t^.x;
|
||||
nextY := t^.y - 1
|
||||
end
|
||||
else
|
||||
begin
|
||||
nextX := h.curX;
|
||||
nextY := h.curY
|
||||
end;
|
||||
AddTrace(t, nextX, nextY);
|
||||
FillArenaCell(t^.x, t^.y, TraceSymbol);
|
||||
borders[t^.x][t^.y] := true
|
||||
end;
|
||||
|
||||
procedure
|
||||
ChangeHamsterTrace(var t: tracePtr; var h: creature;
|
||||
var borders: arena; var redrawEdge: boolean);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if IsOnTrace(t, h) then
|
||||
begin
|
||||
for i := 1 to HamsterDelta do
|
||||
PopHamsterTrace(t, borders);
|
||||
if GetTraceLength(t) = 1 then
|
||||
begin
|
||||
PopHamsterTrace(t, borders);
|
||||
redrawEdge := true
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
if t = nil then
|
||||
begin
|
||||
AddBorderTrace(t, h, borders);
|
||||
redrawEdge := true
|
||||
end;
|
||||
for i := 1 to HamsterDelta do
|
||||
AddHamsterTrace(t, h, borders)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure HandleKey(var hamster: creature; var continueLevel: boolean);
|
||||
var
|
||||
keyCode: integer;
|
||||
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;
|
||||
DelaySizeMs = 75;
|
||||
|
||||
procedure RunLevel;
|
||||
var
|
||||
hamster: creature;
|
||||
captured, borders: arena;
|
||||
hamsterTrace: tracePtr = nil;
|
||||
h, g: creature;
|
||||
a: arena;
|
||||
t: tracePtr = nil;
|
||||
continueLevel: boolean = true;
|
||||
redrawEdge: boolean = false;
|
||||
redrawBorders: boolean = false;
|
||||
begin
|
||||
FillArena(captured, false);
|
||||
FillArena(borders, false);
|
||||
InitiateCreature(hamster, 5, 1, 0, 0, HamsterSymbol);
|
||||
FillArenaCell(hamster.curX, hamster.curY, hamster.symbol);
|
||||
Init(a);
|
||||
InitHamster(h);
|
||||
InitGhost(g);
|
||||
DrawCreature(h);
|
||||
DrawCreature(g);
|
||||
while continueLevel do
|
||||
begin
|
||||
delay(DelaySizeMs);
|
||||
if (hamsterTrace <> nil) and
|
||||
(IsOnBorder(hamster, borders, captured) or IsOnEdge(hamster)) and
|
||||
(hamsterTrace^.prev <> nil) then
|
||||
if ArenaSplited(h, t, a) then
|
||||
begin
|
||||
CutField(hamsterTrace, borders, captured);
|
||||
RemoveCutedBorders(borders, captured);
|
||||
DisposeTraces(hamsterTrace);
|
||||
DrawArenaBorders(borders);
|
||||
DrawArenaEdge;
|
||||
FillArenaCell(hamster.curX, hamster.curY, hamster.symbol);
|
||||
{debug}
|
||||
{
|
||||
clrscr;
|
||||
DebugOrArenas(borders, captured)
|
||||
}
|
||||
SetArenaBorder(t, a);
|
||||
CutSmallerPart(h, t, a)
|
||||
end;
|
||||
if keypressed then
|
||||
HandleKey(hamster, continueLevel);
|
||||
if not HamsterMovePossible(hamster, hamsterTrace, captured) then
|
||||
StopCreature(hamster);
|
||||
if (hamster.dX = 0) and (hamster.dY = 0) then
|
||||
continue;
|
||||
if not IsOnEdge(hamster) and
|
||||
not IsOnBorder(hamster, borders, captured) then
|
||||
begin
|
||||
FillArenaCell(hamster.curX, hamster.curY, TraceSymbol)
|
||||
end
|
||||
else
|
||||
begin
|
||||
FillArenaCell(hamster.curX, hamster.curY, ' ')
|
||||
end;
|
||||
MoveCreature(hamster);
|
||||
if IsOnEdge(hamster) and (hamsterTrace = nil) then
|
||||
redrawEdge := true
|
||||
else
|
||||
if IsOnBorder(hamster, borders, captured) and (hamsterTrace = nil) then
|
||||
redrawBorders := true
|
||||
else
|
||||
ChangeHamsterTrace(hamsterTrace, hamster, borders, redrawEdge);
|
||||
if redrawEdge then
|
||||
begin
|
||||
DrawArenaEdge;
|
||||
redrawEdge := false
|
||||
end;
|
||||
if redrawBorders then
|
||||
begin
|
||||
DrawArenaBorders(borders);
|
||||
redrawBorders := false
|
||||
end;
|
||||
FillArenaCell(hamster.curX, hamster.curY, hamster.symbol)
|
||||
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)
|
||||
end
|
||||
end;
|
||||
|
||||
@ -872,6 +44,7 @@ begin
|
||||
exit
|
||||
end;
|
||||
clrscr;
|
||||
DrawInterface(ScreenH, ScreenW);
|
||||
DrawLevel;
|
||||
RunLevel;
|
||||
clrscr
|
||||
end.
|
||||
|
||||
277
src/graphics_m.pas
Normal file
277
src/graphics_m.pas
Normal file
@ -0,0 +1,277 @@
|
||||
unit graphics_m;
|
||||
|
||||
interface
|
||||
|
||||
uses arena_m, creature_m, hamster_m, trace_m;
|
||||
|
||||
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena);
|
||||
procedure DrawAfterStep(var cr: creature; var a: arena);
|
||||
procedure DrawArenaBorders(var a: arena);
|
||||
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
|
||||
procedure DrawArenaEdges;
|
||||
procedure DrawCreature(var cr: creature);
|
||||
procedure DrawLevel;
|
||||
procedure EraseTrace(var hamster: creature; t: tracePtr);
|
||||
function IsTerminalValid: boolean;
|
||||
procedure PrintTerminalHelp;
|
||||
|
||||
implementation
|
||||
|
||||
uses crt, math_m;
|
||||
|
||||
const
|
||||
InterfaceH = 6;
|
||||
CellSize = 2;
|
||||
BorderSize = 1;
|
||||
ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 79 }
|
||||
ScreenH = (ArenaH + InterfaceH) * CellSize + BorderSize;
|
||||
WidthCoefficient = 2;
|
||||
InterfaceBarH = ScreenW - ArenaH * CellSize - BorderSize * 2; { 14 }
|
||||
|
||||
function IsTerminalValid: boolean;
|
||||
begin
|
||||
IsTerminalValid := (ScreenWidth >= ScreenW) and (ScreenHeight >= ScreenH)
|
||||
end;
|
||||
|
||||
procedure PrintTerminalHelp;
|
||||
begin
|
||||
writeln('Increase your terminal size and try again.');
|
||||
if ScreenWidth < ScreenW then
|
||||
begin
|
||||
writeln('Your terminal width: ', ScreenWidth,
|
||||
'. Required: ', ScreenW, '.')
|
||||
end;
|
||||
if ScreenHeight < ScreenH then
|
||||
begin
|
||||
writeln('Your terminal height: ', ScreenHeight,
|
||||
'. Required: ', ScreenH, '.')
|
||||
end
|
||||
end;
|
||||
|
||||
procedure DrawLineX(x, y, len: integer);
|
||||
var
|
||||
i: integer;
|
||||
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
|
||||
begin
|
||||
GotoXY(x, y + i - 1);
|
||||
write(BorderSymbol)
|
||||
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(BorderSymbol);
|
||||
GotoXY(x0 + w - 1, y0 + i);
|
||||
write(BorderSymbol)
|
||||
end;
|
||||
DrawLineX(x0, y0 + h - 1, w);
|
||||
GotoXY(1, 1)
|
||||
end;
|
||||
|
||||
|
||||
procedure DrawInterface;
|
||||
var
|
||||
cellW: integer = ScreenW div 3;
|
||||
begin
|
||||
DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient);
|
||||
DrawLineY(cellW * WidthCoefficient, 1, InterfaceBarH);
|
||||
DrawLineY(cellW * 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
|
||||
DrawArenaCell(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)
|
||||
else
|
||||
DrawArenaCell(t^.x, t^.y, BorderSymbol)
|
||||
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)
|
||||
end;
|
||||
|
||||
procedure
|
||||
DrawPreviousCell(var hamster: creature; var t: tracePtr; var a: arena);
|
||||
var
|
||||
prevX, prevY: integer;
|
||||
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)
|
||||
end;
|
||||
|
||||
procedure DrawStepTrace(t: tracePtr);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i := 1 to HamsterDelta do
|
||||
begin
|
||||
t := t^.prev;
|
||||
DrawArenaCell(t^.x, t^.y, TraceSymbol)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena);
|
||||
var
|
||||
prevX, prevY: integer;
|
||||
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)
|
||||
else
|
||||
if IsOnBorder(prevX, prevY, a) then
|
||||
DrawArenaCell(prevX, prevY, BorderSymbol)
|
||||
else
|
||||
DrawArenaCell(prevX, prevY, ArenaSymbol);
|
||||
if t <> nil then
|
||||
DrawStepTrace(t);
|
||||
DrawCreature(hamster);
|
||||
DrawPreviousCell(hamster, t, a)
|
||||
end;
|
||||
|
||||
procedure DrawAfterStep(var cr: creature; var a: arena);
|
||||
var
|
||||
prevX, prevY: integer;
|
||||
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)
|
||||
else
|
||||
if IsOnBorder(prevX, prevY, a) then
|
||||
DrawArenaCell(prevX, prevY, BorderSymbol)
|
||||
else
|
||||
DrawArenaCell(prevX, prevY, ArenaSymbol);
|
||||
DrawCreature(cr)
|
||||
end;
|
||||
|
||||
end.
|
||||
25
src/hamster_m.pas
Normal file
25
src/hamster_m.pas
Normal file
@ -0,0 +1,25 @@
|
||||
unit hamster_m;
|
||||
|
||||
interface
|
||||
|
||||
uses creature_m;
|
||||
|
||||
const
|
||||
HamsterStartX = 5;
|
||||
HamsterStartY = 1;
|
||||
HamsterStartDX = 0;
|
||||
HamsterStartDY = 0;
|
||||
HamsterDelta = 2;
|
||||
HamsterSymbol = 'h';
|
||||
|
||||
procedure InitHamster(var h: creature);
|
||||
|
||||
implementation
|
||||
|
||||
procedure InitHamster(var h: creature);
|
||||
begin
|
||||
InitCreature(h, HamsterStartX, HamsterStartY,
|
||||
HamsterStartDX, HamsterStartDY, HamsterSymbol)
|
||||
end;
|
||||
|
||||
end.
|
||||
91
src/keys_m.pas
Normal file
91
src/keys_m.pas
Normal file
@ -0,0 +1,91 @@
|
||||
unit keys_m;
|
||||
|
||||
interface
|
||||
|
||||
uses crt, creature_m, arena_m, trace_m, hamster_m, debug_m;
|
||||
|
||||
const
|
||||
SpaceOrd = 32;
|
||||
EscOrd = 27;
|
||||
CtrlCOrd = 3;
|
||||
ArrowLeftOrd = -75;
|
||||
ArrowRightOrd = -77;
|
||||
ArrowDownOrd = -80;
|
||||
ArrowUpOrd = -72;
|
||||
{ Debug }
|
||||
BOrd = 98;
|
||||
COrd = 99;
|
||||
LOrd = 108;
|
||||
{ Debug }
|
||||
|
||||
procedure GetKey(var keyCode: integer);
|
||||
procedure HandleKey(var h: creature; var continueLevel: boolean;
|
||||
var a: arena; var t: tracePtr);
|
||||
|
||||
implementation
|
||||
|
||||
procedure GetKey(var keyCode: integer);
|
||||
var
|
||||
c: char;
|
||||
begin
|
||||
c := ReadKey;
|
||||
if c = #0 then
|
||||
begin
|
||||
c := ReadKey;
|
||||
keyCode := -ord(c)
|
||||
end
|
||||
else
|
||||
begin
|
||||
keyCode := ord(c)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure ChangeHamsterDelta(keyCode: integer; var h: creature);
|
||||
begin
|
||||
h.dX := 0;
|
||||
h.dY := 0;
|
||||
case keyCode of
|
||||
ArrowLeftOrd:
|
||||
h.dX := -HamsterDelta;
|
||||
ArrowRightOrd:
|
||||
h.dX := HamsterDelta;
|
||||
ArrowUpOrd:
|
||||
h.dY := -HamsterDelta;
|
||||
ArrowDownOrd:
|
||||
h.dY := HamsterDelta;
|
||||
SpaceOrd:
|
||||
StopCreature(h)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure HandleKey(var h: creature; var continueLevel: boolean;
|
||||
var a: arena; var t: tracePtr);
|
||||
var
|
||||
keyCode: integer;
|
||||
begin
|
||||
GetKey(keyCode);
|
||||
{
|
||||
if keyCode = BOrd then
|
||||
Print(a.borders);
|
||||
if keyCode = COrd then
|
||||
Print(a.captured);
|
||||
if keyCode = LOrd then
|
||||
begin
|
||||
GotoXY(2, 60);
|
||||
write(' ');
|
||||
GotoXY(2, 60);
|
||||
writeln(GetLength(t));
|
||||
GotoXY(1, 1)
|
||||
end;
|
||||
}
|
||||
if (keyCode = ArrowLeftOrd) or (keyCode = ArrowRightOrd) or
|
||||
(keyCode = ArrowUpOrd) or (keyCode = ArrowDownOrd) or
|
||||
(keyCode = SpaceOrd) then
|
||||
begin
|
||||
ChangeHamsterDelta(keyCode, h)
|
||||
end;
|
||||
if (keyCode = EscOrd) or (keyCode = CtrlCOrd) then
|
||||
continueLevel := false
|
||||
end;
|
||||
|
||||
end.
|
||||
29
src/math_m.pas
Normal file
29
src/math_m.pas
Normal file
@ -0,0 +1,29 @@
|
||||
unit math_m;
|
||||
interface
|
||||
|
||||
function Clamp(val, min, max: integer): integer;
|
||||
function Signum(a, b: integer): integer;
|
||||
|
||||
implementation
|
||||
|
||||
function Clamp(val, min, max: integer): integer;
|
||||
begin
|
||||
Clamp := val;
|
||||
if val < min then
|
||||
Clamp := min;
|
||||
if val > max then
|
||||
Clamp := max
|
||||
end;
|
||||
|
||||
function Signum(a, b: integer): integer;
|
||||
begin
|
||||
if a < b then
|
||||
Signum := -1
|
||||
else
|
||||
if a > b then
|
||||
Signum := 1
|
||||
else
|
||||
Signum := 0
|
||||
end;
|
||||
|
||||
end.
|
||||
149
src/trace_m.pas
Normal file
149
src/trace_m.pas
Normal file
@ -0,0 +1,149 @@
|
||||
unit trace_m;
|
||||
|
||||
interface
|
||||
|
||||
uses creature_m, math_m, hamster_m;
|
||||
|
||||
const
|
||||
PreviousTraceIdx = 3;
|
||||
TraceSymbol = '+';
|
||||
|
||||
type
|
||||
tracePtr = ^trace;
|
||||
|
||||
trace = record
|
||||
x, y: integer;
|
||||
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;
|
||||
procedure IncreaseTrace(var hamster: creature; var t: tracePtr);
|
||||
function IsOnTrace(var cr: creature; var t: tracePtr): boolean;
|
||||
procedure Pop(var t: tracePtr);
|
||||
|
||||
implementation
|
||||
|
||||
uses graphics_m;
|
||||
|
||||
function GetLength(var t: tracePtr): integer;
|
||||
begin
|
||||
if t = nil then
|
||||
GetLength := 0
|
||||
else
|
||||
GetLength := 1 + GetLength(t^.prev)
|
||||
end;
|
||||
|
||||
procedure Delete(var t: tracePtr);
|
||||
var
|
||||
tmpT: tracePtr;
|
||||
begin
|
||||
while t <> nil do
|
||||
begin
|
||||
tmpT := t^.prev;
|
||||
dispose(t);
|
||||
t := tmpT
|
||||
end
|
||||
end;
|
||||
|
||||
function FindIndex(var t: tracePtr; x, y, curIdx: integer): integer;
|
||||
begin
|
||||
if t = nil then
|
||||
FindIndex := -1
|
||||
else
|
||||
if (t^.x = x) and (t^.y = y) then
|
||||
FindIndex := curIdx
|
||||
else
|
||||
FindIndex := FindIndex(t^.prev, x, y, curIdx + 1)
|
||||
end;
|
||||
|
||||
procedure Add(var t: tracePtr; x, y: integer);
|
||||
var
|
||||
nextTrace: tracePtr;
|
||||
begin
|
||||
new(nextTrace);
|
||||
nextTrace^.x := x;
|
||||
nextTrace^.y := y;
|
||||
nextTrace^.prev := t;
|
||||
t := nextTrace
|
||||
end;
|
||||
|
||||
procedure Pop(var t: tracePtr);
|
||||
var
|
||||
tmpPrev: tracePtr;
|
||||
begin
|
||||
tmpPrev := t^.prev;
|
||||
dispose(t);
|
||||
t := tmpPrev
|
||||
end;
|
||||
|
||||
function IsOnTrace(var cr: creature; var 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)
|
||||
end;
|
||||
|
||||
procedure AddStepTrace(var h: creature; var t: tracePtr);
|
||||
var
|
||||
nextX, nextY, dX, dY: integer;
|
||||
begin
|
||||
dX := Signum(h.curX, t^.x);
|
||||
dY := Signum(h.curY, t^.y);
|
||||
nextX := t^.x + dX;
|
||||
nextY := t^.y + dY;
|
||||
Add(t, nextX, nextY)
|
||||
end;
|
||||
|
||||
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;
|
||||
traceX := hamster.curX + dX;
|
||||
traceY := hamster.curY + dY;
|
||||
Add(t, traceX, traceY)
|
||||
end;
|
||||
|
||||
procedure IncreaseTrace(var hamster: creature; var t: tracePtr);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if t = nil then
|
||||
AddFirstTrace(hamster, t);
|
||||
for i := 1 to HamsterDelta do
|
||||
AddStepTrace(hamster, t)
|
||||
end;
|
||||
|
||||
procedure DecreaseTrace(var hamster: creature; var t: tracePtr);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i := 1 to HamsterDelta do
|
||||
Pop(t);
|
||||
if GetLength(t) = 1 then
|
||||
Pop(t)
|
||||
end;
|
||||
|
||||
procedure ChangeHamsterTrace(var h: creature; var t: tracePtr);
|
||||
begin
|
||||
if IsOnTrace(h, t) then
|
||||
begin
|
||||
EraseTrace(h, t);
|
||||
DecreaseTrace(h, t)
|
||||
end
|
||||
else
|
||||
begin
|
||||
IncreaseTrace(h, t)
|
||||
end
|
||||
end;
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user