gh-scrum/src/graphics_m.pas

unit graphics_m;

interface

uses arena_graphics_m, arena_m, creature_m, hamster_m, trace_m, game_m;

procedure DrawAfterStep(var cr: creature; var a: arena);
procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena);
procedure DrawCreature(var cr: creature);
procedure DrawExitState(s: exitState);
procedure DrawExit(var g: gameState);
procedure DrawPause(var g: gameState);
procedure DrawInfo;
procedure DrawLifes(var g: GameState);
procedure DrawMenuState(s: menuState);
procedure DrawMenu(var g: gameState);
procedure DrawScore(var g: GameState);
procedure EraseAll;
procedure EraseExit;
procedure EraseExitState(s: exitState);
procedure EraseMenu;
procedure EraseMenuState(s: menuState);
procedure EraseStepTrace(var hamster: creature; t: tracePtr);
procedure EraseTrace(t: tracePtr; var a: arena);

implementation

uses crt, math_m, ascii_arts_m;

const
    BigLetterWidth = 8;
    DigitWidth = 6;
    GameNameX = ScreenW * WidthCoefficient div 3 + 4;
    GameNameY = 12;
    NameHeightPadding = 8;
    MenuHeightPadding = 2;
    MenuWidthPadding = 4;
    MenuHamsterX = GameNameX - HamsterWidth - MenuWidthPadding;
    NewGameY = GameNameY + GameNameHeight + NameHeightPadding;
    HighScoreY = NewGameY + NewGameHeight + MenuHeightPadding;
    KeyInfoY = HighScoreY + HighScoreHeight;
    ContinueY = KeyInfoY + KeyInfoHeight;
    InterfaceMarginX = InterfaceCellW div 4;
    InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1;
    LetterWidth = 5;
    Notation = 10;
    PunctuationWidth = 3;
    SpaceWidth = 3;
    ExitGameY = ScreenH div 2 - ExitHeight - MenuHeightPadding;
    ExitYesX = MenuHamsterX;
    ExitYesY = ExitGameY + ExitHeight + MenuHeightPadding;
    ExitNoX = ScreenW  * WidthCoefficient - ExitYesX - NoWidth;
    ExitHamsterY = ExitYesY;
    HamsterYesX = ExitYesX - HamsterWidth - MenuWidthPadding;
    HamsterNoX = ExitNoX - HamsterWidth - MenuWidthPadding;
    PauseXMargin = 3 * WidthCoefficient;
    PauseYMargin = 1;
var
    firstMenuDraw: boolean = true;

procedure EraseTrace(t: tracePtr; var a: arena);
begin
    while t <> nil do
    begin
        if t^.prev = nil then
            DrawEdge(t^.x, t^.y, a)
        else
            DrawArenaCell(t^.x, t^.y, ArenaSymbol);
        t := t^.prev
    end
end;

procedure EraseStepTrace(var hamster: creature; t: tracePtr);
var
    i: integer;
begin
    for i := 1 to hamster.movespeed 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 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; hamsterDelta: integer);
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, hamster.movespeed);
    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;

procedure FillRectangle(x, y, w, h: integer; ch: char);
var
    i, j: integer;
begin
    for i := 0 to h - 1 do
    begin
        GotoXY(x, y + i);
        for j := 0 to w do
            write(ch)
    end;
    GotoXY(1, 1)
end;

type
    stackIntPtr = ^stackIntItem;

    stackIntItem = record
        val: integer;
        next: stackIntPtr
    end;

    StackInt = record
        top: stackIntPtr
    end;

procedure StackIntInit(var s: StackInt);
begin
    s.top := nil
end;

procedure StackPush(var st: StackInt; val: integer);
var
    tmp: stackIntPtr;
begin
    new(tmp);
    tmp^.val := val;
    tmp^.next := st.top;
    st.top := tmp
end;

procedure StackPop(var st: StackInt);
var
    tmp: stackIntPtr;
begin
    tmp := st.top;
    st.top := st.top^.next;
    dispose(tmp)
end;

procedure DrawAscii(x, y, h: integer; var a: array of string);
var
    i: integer;
begin
    for i := 1 to h do
    begin
        GotoXY(x, y + i - 1);
        write(a[i - 1])
    end;
    GotoXY(1, 1)
end;

procedure EraseRectangle(x, y, w, h: integer);
begin
    FillRectangle(x, y, w, h, ' ')
end;

procedure DrawDigit(x, y, digit: integer);
begin
    DrawAscii(x, y, DigitHeight, DigitsAscii[digit])
end;

procedure DrawNumber(interfaceX: integer; s: longint);
var
    x, y: integer;
    i: integer = 0;
    st: StackInt;
begin
    StackIntInit(st);
    if s = 0 then
        StackPush(st, 0);
    while s <> 0 do
    begin
        StackPush(st, s mod Notation);
        s := s div Notation
    end;
    x := interfaceX + InterfaceMarginX;
    y := InterfaceMarginY;
    while st.top <> nil do
    begin
        DrawDigit(x + (DigitWidth + SpaceWidth) * i, y, st.top^.val);
        StackPop(st);
        i := i + 1
    end
end;

procedure DrawLifes(var g: GameState);
begin
    DrawNumber(LifeBarX, g.life)
end;

procedure DrawScore(var g: GameState);
var
    killBarX: integer = InterfaceCellW * 2 * WidthCoefficient + BorderSize;
begin
    DrawNumber(killBarX, g.score)
end;

procedure DrawMenuState(s: menuState);
begin
    case s of
        menuNewGame:
            DrawAscii(MenuHamsterX, NewGameY + 1,
                      HamsterHeight, HamsterStayAscii);
        menuHighScore:
            DrawAscii(MenuHamsterX, HighScoreY + 1,
                      HamsterHeight, HamsterStayAscii);
        menuKeyInfo:
            DrawAscii(MenuHamsterX, KeyInfoY + 1,
                      HamsterHeight, HamsterStayAscii);
        menuContinue:
            DrawAscii(MenuHamsterX, ContinueY + 1,
                      HamsterHeight, HamsterStayAscii)
        end
end;

procedure DrawMenu(var g: gameState);
var
    y: integer = GameNameY;
begin
    if firstMenuDraw then
    begin
        DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient);
        firstMenuDraw := not firstMenuDraw
    end;
    DrawAscii(GameNameX, y, GameNameHeight, GameNameAscii);
    DrawAscii(GameNameX, NewGameY, NewGameHeight, NewGameAscii);
    DrawAscii(GameNameX, HighScoreY, HighScoreHeight, HighScoreAscii);
    DrawAscii(GameNameX, KeyInfoY, KeyInfoHeight, KeyInfoAscii);
    DrawAscii(GameNameX, ContinueY, ContinueHeight, ContinueAscii);
    if not g.continueAllowed then
        FillRectangle(GameNameX, ContinueY + ContinueHeight div 2,
                      ContinueWidth, 1, '-');
    DrawMenuState(g.curMenu)
end;

procedure EraseMenuState(s: menuState);
begin
    case s of
        menuNewGame:
            EraseRectangle(MenuHamsterX, NewGameY + 1,
                           HamsterWidth, HamsterHeight);
        menuHighScore:
            EraseRectangle(MenuHamsterX, HighScoreY + 1,
                           HamsterWidth, HamsterHeight);
        menuKeyInfo:
            EraseRectangle(MenuHamsterX, KeyInfoY + 1,
                           HamsterWidth, HamsterHeight);
        menuContinue:
            EraseRectangle(MenuHamsterX, ContinueY + 1,
                           HamsterWidth, HamsterHeight)
        end
end;

procedure EraseAll;
begin
    EraseRectangle(1, 1, ScreenW * WidthCoefficient, ScreenH)
end;

procedure EraseMenu;
begin
    EraseRectangle(MenuHamsterX, GameNameY,
                  GameNameWidth + HamsterWidth + MenuWidthPadding,
                  ScreenH - GameNameY * 2)
end;

procedure DrawExitState(s: exitState);
begin
    case s of
        exitYes:
            DrawAscii(HamsterYesX, ExitHamsterY,
                      HamsterHeight, HamsterGGAscii);
        exitNo:
            DrawAscii(HamsterNoX, ExitHamsterY,
                      HamsterHeight, HamsterStayAscii)
    end
end;

procedure DrawPause(var g: gameState);
var
    pauseX: integer = (ScreenW * WidthCoefficient - PauseWidth) div 2;
    pauseY: integer = (ScreenH - PauseHeight) div 2;
begin
    EraseRectangle(pauseX - PauseXMargin,
                   pauseY - PauseYMargin,
                   PauseWidth + PauseXMargin * 2 - 1,
                   PauseHeight + PauseYMargin * 2 + 1);
    DrawRectangle(pauseX - PauseXMargin,
                  pauseY - PauseYMargin,
                  PauseHeight + PauseYMargin * 2 + 1,
                  PauseWidth + PauseXMargin * 2);
    DrawAscii(pauseX, pauseY, PauseHeight, PauseAscii)
end;

procedure ErasePause(var g: gameState);
begin
end;

procedure DrawExit(var g: gameState);
var
    realX: integer = ScreenW  * WidthCoefficient;
begin
    DrawAscii((realX - ExitWidth) div 2, ExitGameY, ExitHeight, ExitAscii);
    DrawAscii(ExitYesX, ExitYesY, YesHeight, YesAscii);
    DrawAscii(ExitNoX, ExitYesY, NoHeight, NoAscii);
    DrawExitState(g.curExit)
end;

procedure DrawInfo;
begin
end;

procedure EraseExitState(s: exitState);
begin
    case s of
        exitYes:
            EraseRectangle(HamsterYesX, ExitHamsterY,
                           HamsterWidth, HamsterHeight);
        exitNo:
            EraseRectangle(HamsterNoX, ExitHamsterY,
                           HamsterWidth, HamsterHeight)
    end
end;

procedure EraseExit;
begin
    EraseRectangle(HamsterYesX, ExitGameY,
                   ExitWidth + HamsterWidth + MenuWidthPadding,
                   ExitHeight + MenuHeightPadding + YesHeight)
end;

end.