unit graphics_m; interface uses arena_m, creature_m, trace_m, game_m, level_m, _banners_m, ascii_arts_m; const BorderSize = 1; InterfaceH = 6; WidthCoefficient = 2; CellSize = 2; BorderSymbol = '|'; DigitSpaceWidth = 1; ScreenH = (ArenaH + InterfaceH) * CellSize + BorderSize; ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 82 } procedure DrawAnnounce(lvl: integer); procedure DrawBannerImage(x, y, h: integer; var a: BannerImage); procedure DrawCreatureImage(x, y, h: integer; var a: CreatureImage); procedure DrawExitState(b: boolean); procedure DrawExit(var g: gameState); procedure DrawGameOver; procedure DrawGameComplete(score: integer); procedure DrawKeyInfo; procedure DrawLineX(x, y, len: integer; ch: char); procedure DrawLineY(x, y, len: integer; ch: char); procedure DrawNumber(x, y: integer; n: longint); procedure DrawRectangle(x0, y0, h, w: integer; ch: char); procedure DrawMenuState(s: menuState); procedure DrawMenu(var g: gameState); procedure EraseAll; procedure EraseAnnounce(lvl: integer); procedure EraseExit; procedure EraseExitState(b: boolean); procedure EraseGameOver; procedure EraseKeyInfo; procedure EraseLevel; procedure EraseMenu; procedure EraseMenuState(s: menuState); procedure EraseRectangle(x, y, w, h: integer); procedure FillRectangle(x, y, w, h: integer; ch: char); implementation uses crt, math_m; const AnnounceY = (ScreenH - LevelAnnounceHeight) div 2; BigLetterWidth = 8; BorderN = 2; DecimalDelimiter = 10; GameNameY = 16; NameHeightPadding = 8; NewGameY = GameNameY + GameNameHeight + NameHeightPadding; MenuHeightPadding = 2; MenuInfoY = NewGameY + NewGameHeight + MenuHeightPadding; ContinueY = MenuInfoY + MenuInfoHeight; ExitGameY = (ScreenH - ExitScreenHeight) div 2 - MenuHeightPadding; ExitYesY = ExitGameY + ExitHeight - 1 + MenuHeightPadding; ExitHamsterY = ExitYesY; GameNameX = ScreenW * WidthCoefficient div 3 + 4; MenuWidthPadding = 4; MenuHamsterX = GameNameX - HamsterWidth - MenuWidthPadding; ExitYesX = MenuHamsterX; ExitNoX = ScreenW * WidthCoefficient - ExitYesX - NoWidth; GameOverX = (ScreenW * WidthCoefficient - GameNameWidth) div 2; GameOverY = (ScreenH - GameOverHeight) div 2; HamsterNoX = ExitNoX - HamsterWidth - MenuWidthPadding; HamsterYesX = ExitYesX - HamsterWidth - MenuWidthPadding; KeyInfoX = (ScreenW * WidthCoefficient - KeyInfoWidth) div 2; KeyInfoY = (ScreenH - KeyInfoHeight) div 2; LetterWidth = 5; LevelNumberMargin = 3; GameCompleteX = (ScreenW * WidthCoefficient - GameCompleteWidth) div 2; GameCompleteY = (ScreenH - GameCompleteHeight) div 2; GameCompleteScoreX = GameCompleteX + GameCompleteScoreWidth + 3; GameCompleteScoreY = GameCompleteY + 9; EndOfLine = 256; var firstMenuDraw: boolean = true; procedure PrintStringScreen(x, y, dy: integer; var s: string); var cutLen: integer; sCopy: string; begin if y + dy - 1 > ScreenH then exit; if x < 0 then begin cutLen := x * -1 + 1; GotoXY(1, y + dy - 1); sCopy := copy(s, cutLen, EndOfLine); write(sCopy) end else begin GotoXY(x, y + dy - 1); write(s) end; GotoXY(1, 1) end; procedure DrawCreatureImage(x, y, h: integer; var a: CreatureImage); var i: integer; begin for i := 1 to h do PrintStringScreen(x, y, i, a[i]) end; procedure DrawBannerImage(x, y, h: integer; var a: BannerImage); var i: integer; begin for i := 1 to h do PrintStringScreen(x, y, i, a[i]) end; procedure DrawDigitImage(x, y, h: integer; var a: DigitImage); var i: integer; begin for i := 1 to h do PrintStringScreen(x, y, i, a[i]) end; procedure DrawDigit(x, y, digit: integer); begin DrawDigitImage(x, y, DigitHeight, DigitsAscii[digit]) end; procedure DrawExitState(b: boolean); begin if b then DrawCreatureImage(HamsterYesX, ExitHamsterY, HamsterHeight, HamsterGGAscii) else DrawCreatureImage(HamsterNoX, ExitHamsterY, HamsterHeight, HamsterStayAscii) end; procedure DrawExit(var g: gameState); var realX: integer = ScreenW * WidthCoefficient; begin DrawBannerImage((realX - ExitWidth) div 2, ExitGameY, ExitScreenHeight, ExitScreen); DrawExitState(g.curExit) end; procedure DrawGameOver; begin DrawBannerImage(GameOverX, GameOverY, GameOverHeight, GameOverScreen) end; procedure DrawKeyInfo; begin DrawBannerImage(KeyInfoX, KeyInfoY, KeyInfoHeight, KeyInfoScreen) end; 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; ch: char); var i: integer; begin for i := 1 to len do begin GotoXY(x, y + i - 1); write(ch) end; GotoXY(1, 1) end; procedure DrawMenuState(s: menuState); begin case s of menuNewGame: DrawCreatureImage(MenuHamsterX, NewGameY + 1, HamsterHeight, HamsterStayAscii); menuKeyInfo: DrawCreatureImage(MenuHamsterX, MenuInfoY + 1, HamsterHeight, HamsterStayAscii); menuContinue: DrawCreatureImage(MenuHamsterX, ContinueY + 1, HamsterHeight, HamsterStayAscii) end end; procedure DrawRectangle(x0, y0, h, w: integer; ch: char); var i: integer; begin DrawLineX(x0, y0, w, ch); for i := 1 to h - 2 do begin GotoXY(x0, y0 + i); write(ch); GotoXY(x0 + w - 1, y0 + i); write(ch) end; DrawLineX(x0, y0 + h - 1, w, ch); GotoXY(1, 1) end; procedure DrawMenu(var g: gameState); var y: integer = GameNameY; begin if firstMenuDraw then { REFACTOR LATER } begin DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient, BorderSymbol); firstMenuDraw := not firstMenuDraw end; DrawBannerImage(GameNameX, y, GameMenuHeight, GameMenuScreen); if not g.levelInited then DrawLineX(GameNameX, ContinueY + ContinueHeight div 2, ContinueWidth, '-'); DrawMenuState(g.curMenu) 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 - 1 do write(ch) end; GotoXY(1, 1) end; procedure EraseRectangle(x, y, w, h: integer); begin FillRectangle(x, y, w, h, ' ') end; procedure EraseAll; begin EraseRectangle(1, 1, ScreenW * WidthCoefficient, ScreenH) end; procedure EraseExit; begin EraseRectangle(HamsterYesX, ExitGameY, ExitWidth + HamsterWidth + MenuWidthPadding, ExitScreenHeight + MenuHeightPadding + YesHeight) end; procedure EraseExitState(b: boolean); begin if b then EraseRectangle(HamsterYesX, ExitHamsterY, HamsterWidth, HamsterHeight) else EraseRectangle(HamsterNoX, ExitHamsterY, HamsterWidth, HamsterHeight) end; procedure EraseGameOver; begin EraseRectangle(GameOverX, GameOverY, GameOverWidth, GameOverHeight) end; procedure EraseKeyInfo; begin EraseRectangle(KeyInfoX, KeyInfoY, KeyInfoWidth, KeyInfoHeight) end; procedure EraseLevel; begin EraseRectangle(2, 2, ScreenW * WidthCoefficient - BorderSize * BorderN, ScreenH - BorderSize * BorderN); DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient, BorderSymbol) end; procedure EraseMenu; begin EraseRectangle(MenuHamsterX, GameNameY, GameNameWidth + HamsterWidth + MenuWidthPadding, ScreenH - GameNameY * 2) end; procedure EraseMenuState(s: menuState); begin case s of menuNewGame: EraseRectangle(MenuHamsterX, NewGameY + 1, HamsterWidth, HamsterHeight); menuKeyInfo: EraseRectangle(MenuHamsterX, MenuInfoY + 1, HamsterWidth, HamsterHeight); menuContinue: EraseRectangle(MenuHamsterX, ContinueY + 1, HamsterWidth, HamsterHeight) end 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 DrawNumber(x, y: integer; n: longint); var i: integer = 0; st: StackInt; begin StackIntInit(st); if n = 0 then StackPush(st, 0); while n <> 0 do begin StackPush(st, n mod DecimalDelimiter); n := n div DecimalDelimiter end; while st.top <> nil do begin DrawDigit(x + (DigitWidth + DigitSpaceWidth) * i, y, st.top^.val); StackPop(st); i := i + 1 end end; function CountDigits(l: integer): integer; var lvl: integer; res: integer = 0; begin lvl := l; while lvl <> 0 do begin res := res + 1; lvl := lvl div DecimalDelimiter end; CountDigits := res end; procedure DrawAnnounce(lvl: integer); var w, x: integer; digitCnt: integer = 0; begin digitCnt := CountDigits(lvl); w := LevelAnnounceWidth + LevelNumberMargin + DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1); x := (ScreenW * WidthCoefficient - w) div 2; DrawBannerImage(x, AnnounceY, LevelAnnounceHeight, LevelAnnounce); DrawNumber(x + LevelAnnounceWidth + LevelNumberMargin, AnnounceY + 1, lvl) end; procedure EraseAnnounce(lvl: integer); var w, x, digitCnt: integer; begin digitCnt := CountDigits(lvl); w := LevelAnnounceWidth + LevelNumberMargin + DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1); x := (ScreenW * WidthCoefficient - w) div 2; EraseRectangle(x, AnnounceY, w, LevelAnnounceHeight) end; procedure DrawGameComplete(score: integer); begin DrawBannerImage(GameCompleteX, GameCompleteY, GameCompleteHeight, GameComplete); DrawNumber(GameCompleteScoreX, GameCompleteScoreY, score) end; end.