gh/arena_graphics_m.pas
2026-01-10 12:09:22 +05:00

608 lines
16 KiB
ObjectPascal

unit arena_graphics_m;
interface
uses arena_m, creature_m, trace_m, level_m, _banners_m;
const
ArenaSymbol = ' ';
CaptureSymbol = '.';
procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena);
procedure DrawAliveEnemies(var e: creatureList);
procedure RedrawArea(var a: arena; arenaX, arenaY: integer; t: creatureType);
procedure DrawArenaBorders(var a: arena);
procedure DrawCreature(var cr: creature);
procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char);
procedure DrawArenaEdges;
procedure DrawPause;
procedure DrawTrace(a: tracePtr);
procedure DrawHamster(var h: creature);
procedure FillCellsCapture(var a: arena);
procedure FillCompleteBar(s: integer);
procedure DrawArenaCell(x, y: integer; var a: arena);
procedure DrawLevel(var level: levelState; life, score: integer);
procedure DrawLevelUnpause(var level: levelState);
procedure DrawLifesNumber(n: integer);
procedure DrawScore(s: integer);
procedure EraseStepTrace(var hamster: creature; a: tracePtr);
procedure EraseLifesNumber(n: integer);
procedure EraseTrace(tp: tracePtr; var a: arena);
implementation
uses ascii_arts_m, crt, math_m, hamster_m, graphics_m;
const
ArenaPauseLowerMarginY = 14;
ArenaPauseMarginX = 9;
ArenaPauseUpperMarginY = 7;
InterfaceBarH = ScreenH - ArenaH * CellSize + BorderSize; { 14 }
InterfaceCellW = ScreenW div 3;
InterfaceMarginX = InterfaceCellW div 4;
InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1;
CompleteBarMarginY = 4;
CompleteBarMarginX = 5;
CompleteBarX = (
InterfaceCellW * WidthCoefficient + BorderSize + CompleteBarMarginX
);
CompleteBarY = BorderSize + CompleteBarMarginY + 1;
TotalProcent = 100;
CompleteBarH = InterfaceBarH - BorderSize * 2 - CompleteBarMarginY * 2;
CompleteBarW = (
InterfaceCellW * WidthCoefficient - CompleteBarMarginX * 2
);
BarWinX = CompleteBarW * LevelCompleteThreshold div TotalProcent;
LifeBarX = 17;
LifeNumberX = 27;
MidCellDelimiter = '_';
HamsterLifeY = 5;
DecimalBase = 10;
PauseXPadding = 3 * WidthCoefficient;
PauseX = (ScreenW * WidthCoefficient - PauseWidth) div 2;
PauseYPadding = 1;
PauseY = (ScreenH - PauseHeight) div 2;
InterfaceArenaCellX1 = 15;
InterfaceArenaCellX2 = 29;
type
redrawAreaBox = record
lX, lY, rX, rY: integer
end;
const
RedrawAreas: array[creatureType] of redrawAreaBox = (
(
lX: -HamsterWidth div CellSize div WidthCoefficient;
lY: -HamsterHeight div CellSize; rX: 0; rY: 0
),
(
lX: -GhostWidth div CellSize div WidthCoefficient;
lY: 0; rX: 0; rY: GhostHeight div CellSize
),
(
lX: 0; lY: 0; rX: 0; rY: 0
),
(
lX: 0; lY: 0; rX: 0; rY: 0
),
(
lX: 0; lY: 0; rX: 0; rY: 0
)
);
procedure DrawCompleteBar;
begin
FillRectangle(CompleteBarX, CompleteBarY, CompleteBarW, CompleteBarH, '-');
FillRectangle(CompleteBarX + BarWinX, CompleteBarY,
1, CompleteBarH, '|')
end;
procedure FillCompleteBar(s: integer);
var
cutedProcent: integer = 0;
fillW: integer;
begin
if s <> 0 then
cutedProcent := round(s / (TotalCells / TotalProcent));
fillW := round(CompleteBarW / TotalProcent * cutedProcent);
FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '+')
end;
procedure DrawAliveEnemies(var e: creatureList);
var
tmp: creatureItemPtr;
begin
tmp := e.first;
while tmp <> nil do
begin
if tmp^.cr^.alive then
DrawCreature(tmp^.cr^);
tmp := tmp^.next
end
end;
procedure DrawFieldAscii(arenaX, arenaY, h, w: integer; var a: CreatureImage);
var
screenX, screenY: integer;
begin
screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient;
screenY := InterfaceBarH + (arenaY - 1) * CellSize;
DrawCreatureImage(screenX, screenY, h, a)
end;
procedure DrawStepTrace(a: tracePtr; hamsterDelta: integer);
var
i: integer;
t: tracePtr;
begin
t := a;
for i := 1 to HamsterDelta + 2 do
begin
t := t^.prev;
if t = nil then
break;
DrawFieldCell(t^.x, t^.y, TraceSymbol)
end
end;
procedure DrawPreviousCell(var cr: creature; var a: arena);
var
prevX, prevY: integer;
begin
prevX := cr.curX - cr.dX;
prevY := cr.curY - cr.dY;
DrawArenaCell(prevX, prevY, a)
end;
procedure EraseStepTrace(var hamster: creature; a: tracePtr);
var
i: integer;
t: tracePtr;
begin
t := a;
for i := 1 to hamster.movespeed do
begin
DrawFieldCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
end;
if GetLength(t) = 1 then
begin
if IsOnEdge(hamster) then
DrawFieldCell(t^.x, t^.y, ArenaSymbol)
else
DrawFieldCell(t^.x, t^.y, BorderSymbol)
end
end;
procedure EraseHamsterInterface(x: integer);
begin
if x <= 0 then
exit;
DrawFieldCell(x, 0, ' ');
DrawFieldCell(x, -1, ' ');
DrawFieldCell(x - 1, 0, ' ');
DrawFieldCell(x - 1, -1, ' ')
end;
procedure RedrawInterfaceArea(x: integer);
begin
EraseHamsterInterface(x);
if (x = 1) or (x = 2) then
DrawLineY(1, InterfaceBarH - HamsterHeight,
HamsterHeight, BorderSymbol)
else
if x = InterfaceArenaCellX1 then
DrawLineY(InterfaceCellW * WidthCoefficient,
InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol)
else
if x = InterfaceArenaCellX2 then
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1,
InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol)
else
if x = ArenaW then
DrawLineY(ArenaW * CellSize * WidthCoefficient,
InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol)
end;
procedure RedrawArea(var a: arena; arenaX, arenaY: integer; t: creatureType);
var
i, j: integer;
r: redrawAreaBox;
begin
r := RedrawAreas[t];
for i := r.lY to r.rY do
begin
for j := r.lX to r.rX do
begin
if (arenaX + j > 0) and (arenaX + j < ArenaW + 1) and
(arenaY + i > 0) and (arenaY + i < ArenaH + 1) then
begin
if (t = creatureHamster) and (arenaY + i = 1) then
RedrawInterfaceArea(arenaX + j);
DrawArenaCell(arenaX + j, arenaY + i, a)
end
end
end
end;
procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena);
var
arenaX, arenaY: integer;
begin
{Later move to erase hamster}
arenaX := h.curX - h.dX;
arenaY := h.curY - h.dY;
RedrawArea(a, arenaX, arenaY, h.t);
if t <> nil then
DrawTrace(t);
if t = nil then
DrawPreviousCell(h, a)
end;
procedure FillCells(var a: arena; x1, y1, x2, y2: integer);
var
i, j: integer;
begin
for i := y1 to y2 do
for j := x1 to x2 do
if a.borders[i][j] then
DrawFieldCell(j, i, BorderSymbol)
else
if a.captured[i][j] then
DrawFieldCell(j, i, CaptureSymbol)
end;
procedure FillCellsUnpause(var a: arena);
begin
FillCells(a, 1 + ArenaPauseMarginX, ArenaPauseUpperMarginY,
ArenaW - ArenaPauseMarginX, ArenaH - ArenaPauseLowerMarginY)
end;
procedure DrawPause;
begin
EraseRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseWidth + PauseXPadding * 2,
PauseHeight + PauseYPadding * 2 + 1);
DrawRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseHeight + PauseYPadding * 2 + 1,
PauseWidth + PauseXPadding * 2,
BorderSymbol);
DrawBannerImage(PauseX, PauseY, PauseHeight, PauseAscii)
end;
procedure DrawTrace(a: tracePtr);
var
t: tracePtr;
begin
if a = nil then
exit;
t := a^.prev;
while t <> nil do
begin
DrawFieldCell(t^.x, t^.y, TraceSymbol);
t := t^.prev
end
end;
procedure EraseInterfaceNumber(interfaceX: integer; num: longint);
var
cnt: integer = 0;
x, w, s: integer;
begin
s := num;
while s <> 0 do
begin
s := s div DecimalBase;
cnt += 1
end;
x := interfaceX + InterfaceMarginX;
w := (DigitWidth + DigitSpaceWidth) * cnt;
EraseRectangle(x, InterfaceMarginY, w, DigitHeight)
end;
procedure DrawInterfaceNumber(interfaceX: integer; n: longint);
begin
DrawNumber(interfaceX + InterfaceMarginX, InterfaceMarginY, n)
end;
procedure DrawScore(s: integer);
var
scoreX: integer = InterfaceCellW * 2 * WidthCoefficient + BorderSize;
begin
DrawInterfaceNumber(scoreX, s)
end;
procedure EraseLifesNumber(n: integer);
begin
EraseInterfaceNumber(LifeNumberX, n)
end;
procedure DrawLifesNumber(n: integer);
begin
DrawInterfaceNumber(LifeNumberX, n)
end;
procedure DrawLifes(n: integer);
begin
DrawCreatureImage(LifeBarX, HamsterLifeY,
HamsterHeight, HamsterLifesAscii);
DrawInterfaceNumber(LifeNumberX, n)
end;
procedure DrawInterface;
begin
DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient, BorderSymbol);
DrawLineY(InterfaceCellW * WidthCoefficient, 1,
InterfaceBarH, BorderSymbol);
DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1,
InterfaceBarH, BorderSymbol)
end;
procedure DrawLevel(var level: levelState; life, score: integer);
begin
DrawInterface;
FillCells(level.a, 1, 1, ArenaW, ArenaH);
DrawArenaEdges;
DrawTrace(level.t);
DrawCreature(level.h);
DrawAliveEnemies(level.enemyList);
DrawLifes(life);
DrawCompleteBar;
FillCompleteBar(level.cut);
DrawScore(score)
end;
procedure ErasePause;
begin
EraseRectangle(PauseX - PauseXPadding,
PauseY - PauseYPadding,
PauseWidth + PauseXPadding * 2,
PauseHeight + PauseYPadding * 2 + 1)
end;
procedure DrawLevelUnpause(var level: levelState);
begin
ErasePause;
FillCellsUnpause(level.a);
DrawTrace(level.t);
DrawAliveEnemies(level.enemyList);
DrawCreature(level.h)
end;
procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char);
var
i, j, screenX, screenY: integer;
begin
screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient;
screenY := InterfaceBarH + (arenaY - 1) * CellSize;
for i := 1 to CellSize do
begin
GotoXY(screenX, screenY + i - 1);
for j := 1 to CellSize * WidthCoefficient do
begin
if (screenX + j - 1 >= 1) and
(screenX + j - 1 <= ScreenW * WidthCoefficient) then
begin
write(symbol)
end
end
end;
GotoXY(1, 1)
end;
procedure DrawArenaEdges;
begin
DrawRectangle(1, InterfaceBarH,
ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient,
BorderSymbol)
end;
procedure DrawLeftEdge(y: integer);
var
terminalY, clampedY: integer;
begin
clampedY := Clamp(y, 1, ArenaH);
terminalY := InterfaceBarH + (clampedY - 1) * CellSize;
DrawLineY(1, terminalY, CellSize, BorderSymbol)
end;
procedure DrawRightEdge(y: integer);
var
terminalY, clampedY: integer;
begin
clampedY := Clamp(y, 1, ArenaH);
terminalY := InterfaceBarH + (clampedY - 1) * CellSize;
DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize, BorderSymbol)
end;
procedure DrawUpperEdge(x: integer);
var
terminalX, sizeX, clampedX: integer;
begin
clampedX := Clamp(x, 1, ArenaW);
terminalX := (clampedX - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbol)
end;
procedure DrawLowerEdge(x: integer);
var
terminalX, sizeX, clampedX: integer;
begin
clampedX := Clamp(x, 1, ArenaW);
terminalX := (clampedX - 1) * CellSize * WidthCoefficient + 1;
sizeX := CellSize * WidthCoefficient;
DrawLineX(terminalX, InterfaceBarH + ArenaH * CellSize - 1,
sizeX, BorderSymbol)
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[i][j] then
DrawFieldCell(j, i, BorderSymbol)
end;
procedure DrawEdge(x, y: integer);
begin
if x = 1 then
DrawLeftEdge(y)
else
if x = ArenaW then
DrawRightEdge(y);
if y = 1 then
DrawUpperEdge(x)
else
if y = ArenaH then
DrawLowerEdge(x)
end;
procedure DrawArenaCell(x, y: integer; var a: arena);
begin
if a.captured[y][x] then
DrawFieldCell(x, y, CaptureSymbol)
else
if a.borders[y][x] then
DrawFieldCell(x, y, BorderSymbol)
else
DrawFieldCell(x, y, ArenaSymbol);
if IsOnEdge(x, y) then
DrawEdge(x, y)
end;
procedure DrawCapturedCell(x, y: integer);
begin
DrawFieldCell(x, y, CaptureSymbol);
if IsOnEdge(x, y) then
DrawEdge(x, y)
end;
procedure EraseTrace(tp: tracePtr; var a: arena);
var
t: tracePtr;
begin
if tp = nil then
exit;
t := tp;
while t <> nil do
begin
if t^.prev = nil then
DrawArenaCell(t^.x, t^.y, a)
else
DrawFieldCell(t^.x, t^.y, ArenaSymbol);
t := t^.prev
end
end;
procedure FillCellsCapture(var a: arena);
var
i, j: integer;
begin
for i := 1 to ArenaH do
for j := 1 to ArenaW do
begin
if not a.captured[i][j] then
DrawCapturedCell(j, i)
end
end;
procedure DrawHamsterRunX(var h: creature);
var
xIdx: integer;
img: ^CreatureImage;
begin
if h.dX = 0 then
exit;
xIdx := h.curX div h.moveSpeed mod HamsterRunNX + 1;
if h.dX > 0 then
img := @(HamsterRightAscii[xIdx])
else
img := @(HamsterLeftAscii[xIdx]);
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth, img^);
end;
procedure DrawHamsterRunY(var h: creature);
var
yIdx: integer;
img: ^CreatureImage;
begin
if h.dY = 0 then
exit;
yIdx := h.curY div h.moveSpeed mod HamsterRunNY + 1;
if h.dY > 0 then
img := @(HamsterDownAscii[yIdx])
else
img := @(HamsterUpAscii[yIdx]);
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth, img^)
end;
procedure DrawHamster(var h: creature);
begin
if (h.dX = 0) and (h.dY = 0) then
DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2,
h.curY - HamsterHeight div 2,
HamsterHeight, HamsterWidth,
HamsterStayAscii)
else
if h.dX <> 0 then
DrawHamsterRunX(h)
else
if h.dY <> 0 then
DrawHamsterRunY(h)
end;
procedure DrawGhost(var g: creature);
var
asciiIdx: integer;
begin
asciiIdx := g.curX div g.moveSpeed mod GhostRunN + 1;
DrawFieldAscii(g.curX - GhostWidth div WidthCoefficient div 2,
g.curY - GhostHeight div 2 + 1,
GhostHeight, GhostWidth, GhostAscii[asciiIdx])
end;
procedure DrawSun(var g: creature);
var
asciiIdx: integer;
begin
asciiIdx := g.curX div g.moveSpeed mod SunRunN + 1;
DrawFieldAscii(g.curX - SunWidth div WidthCoefficient div 2,
g.curY - SunHeight div 2 + 1,
SunHeight, SunWidth, SunAscii[asciiIdx])
end;
{
procedure DrawEnemy(var e: creature);
var
asciiIdx: integer;
begin
asciiIdx := e.curX div e.moveSpeed mod;
end;
}
procedure DrawCreature(var cr: creature);
begin
case cr.t of
creatureHamster:
DrawHamster(cr);
creatureGhost:
DrawGhost(cr);
creatureSun:
DrawSun(cr)
end
end;
end.