gh/src/arena_graphics_m.pas

unit arena_graphics_m;

interface

uses arena_m, creature_m;

const
    ArenaSymbol = ' ';
    BorderSize = 1;
    BorderSymbol = '|';
    BorderSymbolX = '|';
    MidCellDelimiter = '_';
    BorderSymbolY = '|';
    CaptureSymbol = '.';
    CellSize = 2;
    InterfaceH = 6;
    ScreenH = (ArenaW + InterfaceH) * CellSize + BorderSize;
    ScreenW = (ArenaH - 1) * CellSize + BorderSize * 2; { 82 }
    InterfaceBarH = ScreenW - ArenaW * CellSize - BorderSize * 2; { 14 }
    InterfaceCellW = ScreenW div 3;
    LifeBarX = 33;
    WidthCoefficient = 2;

procedure DrawArenaBorders(var a: arena);
procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
procedure DrawArenaEdges;
procedure DrawEdge(x, y: integer; var a: arena);
procedure DrawLevelInterface;
procedure DrawRectangle(x0, y0, h, w: integer);
procedure DrawInterface;

implementation

uses crt, math_m;

procedure DrawLineX(x, y, len: integer; ch: char);
var
    i: integer;
begin
    GotoXY(x, y);
    for i := 1 to len do
        write(ch);
    GotoXY(1, 1)
end;

procedure DrawLineY(x, y, len: integer);
var
    i: integer;
begin
    for i := 1 to len do
    begin
        GotoXY(x, y + i - 1);
        write(BorderSymbolY)
    end;
    GotoXY(1, 1)
end;

procedure DrawRectangle(x0, y0, h, w: integer);
var
    i: integer;
begin
    DrawLineX(x0, y0, w, BorderSymbolX);
    for i := 1 to h - 2 do
    begin
        GotoXY(x0, y0 + i);
        write(BorderSymbolY);
        GotoXY(x0 + w - 1, y0 + i);
        write(BorderSymbolY)
    end;
    DrawLineX(x0, y0 + h - 1, w, BorderSymbolX);
    GotoXY(1, 1)
end;

procedure DrawInterface;
begin
    DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient, BorderSymbolX);

    DrawLineX(InterfaceCellW * WidthCoefficient,
              InterfaceBarH div 2,
              InterfaceCellW * WidthCoefficient + 1, MidCellDelimiter);
    DrawLineY(InterfaceCellW * WidthCoefficient, 1, InterfaceBarH);
    DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1, InterfaceBarH)
end;

procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char);
var
    i, screenX, screenY: integer;
begin
    screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient;
    screenY := InterfaceBarH + (arenaY - 1) * CellSize;
    GotoXY(screenX, screenY);
    for i := 1 to CellSize * WidthCoefficient  do
        write(symbol);
    GotoXY(screenX, screenY + 1); { later change to nested for }
    for i := 1 to CellSize * WidthCoefficient  do
        write(symbol);
    GotoXY(1, 1)
end;

procedure DrawArenaEdges;
begin
    DrawRectangle(1, InterfaceBarH,
                  ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient)
end;

procedure DrawLeftEdge(y: integer);
var
    terminalY: integer;
begin
    y := Clamp(y, 1, ArenaW);
    terminalY := InterfaceBarH + (y - 1) * CellSize;
    DrawLineY(1, terminalY, CellSize)
end;

procedure DrawRightEdge(y: integer);
var
    terminalY: integer;
begin
    y := Clamp(y, 1, ArenaW);
    terminalY := InterfaceBarH + (y - 1) * CellSize;
    DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize)
end;

procedure DrawUpperEdge(x: integer);
var
    terminalX, sizeX: integer;
begin
    x := Clamp(x, 1, ArenaH);
    terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
    sizeX := CellSize * WidthCoefficient;
    DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbolX)
end;

procedure DrawLowerEdge(x: integer);
var
    terminalX, sizeX: integer;
begin
    x := Clamp(x, 1, ArenaH);
    terminalX := (x - 1) * CellSize * WidthCoefficient + 1;
    sizeX := CellSize * WidthCoefficient;
    DrawLineX(terminalX, InterfaceBarH + ArenaW * CellSize - 1,
              sizeX, BorderSymbolX)
end;

procedure DrawArenaBorders(var a: arena);
var
    i, j: integer;
begin
    for i := 1 to ArenaW do
        for j := 1 to ArenaH do
            if a.borders[j][i] then
                DrawArenaCell(j, i, BorderSymbol)
end;

procedure DrawEdge(x, y: integer; var a: arena);
begin
    if a.captured[x][y] then
        DrawArenaCell(x, y, CaptureSymbol)
    else
        DrawArenaCell(x, y, ArenaSymbol);
    if x = 1 then
        DrawLeftEdge(y);
    if x = ArenaH then
        DrawRightEdge(y);
    if y = 1 then
        DrawUpperEdge(x);
    if y = ArenaW then
        DrawLowerEdge(x)
end;

procedure DrawLevelInterface;
begin
    clrscr;
    DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient);
    DrawInterface
end;

end.