commit fe94208b7f1a924ed026fb57c3de8f501d483f33 Author: gre-ilya Date: Wed Jan 14 20:45:40 2026 +0500 init diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..fab4472 --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ +*.o +*.ppu +*.swp +convbanners +gohamster +_autobanners_m.pas + diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..d1807d3 --- /dev/null +++ b/Makefile @@ -0,0 +1,8 @@ +default: + cd src && $(MAKE) + +clean: + cd src && $(MAKE) clean + +play: + cd src && $(MAKE) play diff --git a/README.md b/README.md new file mode 100644 index 0000000..b0e5f7d --- /dev/null +++ b/README.md @@ -0,0 +1,14 @@ +# Go Hamster +Это калька на одноимённую игру с телефона Samsung SGH-C100, играл неё в +далёком детстве :), решил реализовать в качестве упражнения. В качестве +инструмента для реализации этюда выбрал Object Pascal. + +## Сборка +```bash +make +``` + +## Запуск: +```bash +make play +``` diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 0000000..6d021fa --- /dev/null +++ b/src/Makefile @@ -0,0 +1,29 @@ +FPC = fpc + +CONVBANNERS_SRC = convbanners.pas + +BANNERS_SRC = completed.txt exit.txt keys.txt paused.txt menu.txt \ + level.txt gameover.txt + +GAME_SRC = _autobanners_m.pas arena_graphics_m.pas arena_m.pas \ + ascii_arts_m.pas cell_m.pas creature_m.pas enemy_packs_m.pas \ + game_m.pas ghost_m.pas gohamster.pas graphics_m.pas hamster_m.pas \ + keys_m.pas level_m.pas math_m.pas sun_m.pas trace_m.pas snake_m.pas \ + drop_m.pas + +all: gohamster + +play: gohamster + ./gohamster + +gohamster: $(GAME_SRC) + $(FPC) $@.pas + +_autobanners_m.pas: convbanners $(BANNERS_SRC) + ./convbanners + +convbanners: $(CONVBANNERS_SRC) + $(FPC) $@.pas + +clean: + rm *.o *.ppu convbanners _autobanners_m.pas gohamster diff --git a/src/arena_graphics_m.pas b/src/arena_graphics_m.pas new file mode 100644 index 0000000..add5bf2 --- /dev/null +++ b/src/arena_graphics_m.pas @@ -0,0 +1,700 @@ +unit arena_graphics_m; + +interface + +uses arena_m, creature_m, trace_m, level_m, _autobanners_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); +procedure RedrawInterfaceArea(x: integer; t: creatureType); +procedure ShowLifeUp; +procedure ShowSpeedUp; +procedure ShowSpeedDown; + +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 - PauseBannerWidth) div 2; + PauseYPadding = 1; + PauseY = (ScreenH - PauseBannerHeight) 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: -SunWidth div CellSize div WidthCoefficient; + lY: -SunHeight div CellSize; rX: 0; rY: 0 + ), + ( + lX: -SnakeWidth div CellSize div WidthCoefficient; + lY: -SnakeHeight div CellSize; rX: 0; rY: 1 + ), + ( + lX: -DropWidth div CellSize div WidthCoefficient; + lY: -DropHeight div CellSize; rX: 0; rY: 1 + ) + ); + +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 EraseSunInterface(x: integer); +begin + if x <= 0 then + exit; + DrawFieldCell(x, 0, ' '); + DrawFieldCell(x - 1, 0, ' ') +end; + +procedure RedrawEnemyInterfaceArea(x: integer); +var + h: integer = SunHeight div 2; +begin + EraseSunInterface(x); + if (x = 1) or (x = 2) then + DrawLineY(1, InterfaceBarH - h, h, BorderSymbol) + else + if (x = InterfaceArenaCellX1) or (x = InterfaceArenaCellX1 + -1) then + DrawLineY(InterfaceCellW * WidthCoefficient, + InterfaceBarH - h, h, BorderSymbol) + else + if (x = InterfaceArenaCellX2) or (x = InterfaceArenaCellX2 - 1) then + DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, + InterfaceBarH - h, h, BorderSymbol) + else + if x = ArenaW then + DrawLineY(ArenaW * CellSize * WidthCoefficient, + InterfaceBarH - h, h, BorderSymbol) +end; + +procedure RedrawHamsterInterfaceArea(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 RedrawInterfaceArea(x: integer; t: creatureType); +begin + case t of + creatureHamster: + RedrawHamsterInterfaceArea(x); + creatureSun, creatureSnake, creatureDrop: + RedrawEnemyInterfaceArea(x) + end +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 + 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; + if arenaY = 1 then + RedrawInterfaceArea(arenaX, h.t); + 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, + PauseBannerWidth + PauseXPadding * 2, + PauseBannerHeight + PauseYPadding * 2 + 1); + DrawRectangle(PauseX - PauseXPadding, + PauseY - PauseYPadding, + PauseBannerHeight + PauseYPadding * 2 + 1, + PauseBannerWidth + PauseXPadding * 2, + BorderSymbol); + DrawBannerImage(PauseX, PauseY, PauseBannerHeight, PauseBanner); + GotoXY(1, 1) +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, + PauseBannerWidth + PauseXPadding * 2, + PauseBannerHeight + 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 +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); + GotoXY(1, 1) +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, h: integer; + img: ^creatureImage; +begin + if g.rageMode then + begin + img := @(GoidaSunAscii); + h := GoidaSunHeight + end + else + begin + asciiIdx := g.curX div g.moveSpeed mod SunRunN + 1; + img := @(SunAscii[asciiIdx]); + h := SunHeight + end; + DrawFieldAscii(g.curX - SunWidth div WidthCoefficient div 2, + g.curY - h div 2 + 1, h, SunWidth, img^) +end; + +procedure DrawSnake(var g: creature); +var + asciiIdx: integer; +begin + asciiIdx := g.curX div g.moveSpeed mod SnakeRunN + 1; + DrawFieldAscii(g.curX - SnakeWidth div WidthCoefficient div 2, + g.curY - SnakeHeight div 2 + 1, + SnakeHeight, SnakeWidth, SnakeAscii[asciiIdx]) + +end; + +procedure DrawDrop(var g: creature); +begin + DrawFieldAscii(g.curX - DropWidth div WidthCoefficient div 2, + g.curY - DropHeight div 2 + 1, DropHeight, + DropWidth, DropAscii) +end; + +procedure DrawCreature(var cr: creature); +begin + case cr.t of + creatureHamster: + DrawHamster(cr); + creatureGhost: + DrawGhost(cr); + creatureSun: + DrawSun(cr); + creatureSnake: + DrawSnake(cr); + creatureDrop: + DrawDrop(cr) + end +end; + +procedure ShowLifeUp; +begin + DrawBannerImage((ScreenW * WidthCoefficient - LifeupBannerWidth) div 2, + (ScreenH - LifeupBannerHeight) div 2, + LifeupBannerHeight, + LifeupBanner) +end; + +procedure ShowSpeedUp; +begin + DrawBannerImage((ScreenW * WidthCoefficient - SpeedupBannerWidth) div 2, + (ScreenH - SpeedupBannerHeight) div 2, + SpeedupBannerHeight, + SpeedupBanner) +end; + +procedure ShowSpeedDown; +begin + DrawBannerImage((ScreenW * WidthCoefficient - SpeeddownBannerWidth) div 2, + (ScreenH - SpeeddownBannerHeight) div 2, + SpeeddownBannerHeight, + SpeeddownBanner) +end; + +end. diff --git a/src/arena_m.pas b/src/arena_m.pas new file mode 100644 index 0000000..451affd --- /dev/null +++ b/src/arena_m.pas @@ -0,0 +1,643 @@ +unit arena_m; + +interface + +uses creature_m, cell_m, trace_m; + +const + ArenaH = 33; + ArenaW = 41; + TotalCells = ArenaW * ArenaH; + RandomCutThreshold = 25; + +type + arenaMatrix = array [1..ArenaH, 1..ArenaW] of boolean; + + arena = record + captured, borders: arenaMatrix; + end; + +function ArenaSplited(var h: creature; var t: tracePtr; var a: arena): boolean; +function +HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean; +function IsOnEdge(var cr: creature): boolean; +function IsOnEdge(x, y: integer): boolean; +procedure ArenaCutPart(var hamster: creature; var t: tracePtr; + var cutOff: integer; var a: arena); +procedure InitArena(var a: arena); +procedure KillCapturedEnemies(var a: arena; var e: creatureList); +procedure EraseEnemies(var a: arena; var e: creatureList); +procedure MakeEnemySteps(var a: arena; var h: creature; + t: tracePtr; var e: creatureList); +procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena); +procedure SetArenaBorder(var t: tracePtr; var a: arena); +procedure TurnStubbornEnemies(var a: arena; var e: creatureList); +procedure MakeStep(var a: arena; var enemy: creature); + +implementation + +uses arena_graphics_m, crt, graphics_m, snake_m, drop_m, math_m, Math; + +const + MaxTurnAttempts = 3; + TotalProcent = 100; + +procedure Fill(var m: arenaMatrix; val: boolean); +var + i, j: integer; +begin + for i := 1 to ArenaH do + for j := 1 to ArenaW do + m[i][j] := val +end; + +procedure InitArena(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[y][x] and not a.borders[y][x] +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^.y][cell^.x] := 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.y][cell.x] then + continue; + result := result + 1; + a.captured[cell.y][cell.x] := true; + AddAvailableNeighbours(captureQ, cell, a); + QCellPush(releaseQ, cell) + end; + ReleaseArenaCells(releaseQ, a); + GetFigureArea := result +end; + +procedure +CutChosenPart(var partCell: cellItem; var a: arena; var cutOff: integer); +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.y][cell.x] then + continue; + cutOff := cutOff + 1; + a.captured[cell.y][cell.x] := true; + DrawArenaCell(cell.x, cell.y, a); + 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 YNeighboursCaptured(x, y: integer; var a: arena): boolean; +begin + YNeighboursCaptured := + not OnEdgeY(y) and a.captured[y + 1][x] and a.captured[y - 1][x] +end; + +function XNeighboursCaptured(x, y: integer; var a: arena): boolean; +begin + XNeighboursCaptured := + not OnEdgeX(x) and a.captured[y][x + 1] and a.captured[y][x - 1] +end; + +function DiagonalNeighboursCaptured(x, y: integer; var a: arena): boolean; +begin + DiagonalNeighboursCaptured := + not IsOnEdge(x, y) and + a.captured[y - 1][x - 1] and a.captured[y + 1][x - 1] and + a.captured[y - 1][x + 1] and a.captured[y + 1][x + 1] +end; + +function ArenaCellCaptured(x, y: integer; var a: arena): boolean; +begin + ArenaCellCaptured := + XNeighboursCaptured(x, y, a) or YNeighboursCaptured(x, y, a) or + DiagonalNeighboursCaptured(x, y, a) +end; + +procedure CaptureArenaBorder(x, y: integer; var a: arena); +begin + a.borders[y][x] := false; + a.captured[y][x] := true; + DrawFieldCell(x, y, CaptureSymbol) +end; + +procedure CaptureCutBorders(var a: arena; var cutOff: integer); {rename, slow} +var + i, j: integer; +begin + for i := 1 to ArenaH do + for j := 1 to ArenaW do + if a.borders[i][j] and ArenaCellCaptured(j, i, a) then + begin + cutOff := cutOff + 1; + CaptureArenaBorder(j, i, a) + end +end; + +procedure SetArenaBorder(var t: tracePtr; var a: arena); +begin + if t = nil then + exit; + a.borders[t^.y][t^.x] := 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[y][x] and ( + a.captured[y + 1][x - 1] or + a.captured[y - 1][x - 1] or + a.captured[y + 1][x + 1] or + a.captured[y - 1][x + 1] + ) +end; + +function IsOnBorder(var cr: creature; var a: arena): boolean; +begin + IsOnBorder := + a.borders[cr.curY][cr.curX] and ( + a.captured[cr.curY + 1][cr.curX - 1] or + a.captured[cr.curY - 1][cr.curX - 1] or + a.captured[cr.curY + 1][cr.curX + 1] or + a.captured[cr.curY - 1][cr.curX + 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 LowerToBiggerRatio(val1, val2: integer): integer; +var + v1, v2, tmp, biggerProcent: real; +begin + v1 := val1; + v2 := val2; + if v1 > v2 then + begin + tmp := v1; + v1 := v2; + v2 := tmp + end; + biggerProcent := v2 / TotalProcent; + LowerToBiggerRatio := Round(TotalProcent - v1 / biggerProcent) +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 StepBeyondEdgeX(var cr: creature): boolean; +begin + StepBeyondEdgeX := + (cr.dX > 0) and (cr.curX = ArenaW) or + (cr.dX < 0) and (cr.curX = 1) +end; + +function StepBeyondEdgeY(var cr: creature): boolean; +begin + StepBeyondEdgeY := + (cr.dY > 0) and (cr.curY = ArenaH) or + (cr.dY < 0) and (cr.curY = 1) +end; + +function StepBeyondEdge(var cr: creature): boolean; +begin + StepBeyondEdge := StepBeyondEdgeX(cr) or StepBeyondEdgeY(cr) +end; + +function ChooseRandomCell(p1, p2: cellItem): cellItem; +var + rb: boolean; +begin + rb := RandomBool; + if rb then + ChooseRandomCell := p1 + else + ChooseRandomCell := p2 +end; + +{refactor? pass just level later} +procedure ArenaCutPart(var hamster: creature; var t: tracePtr; + var cutOff: integer; var a: arena); +var + area1, area2, diffProcent: integer; + part1, part2, cutFigure: cellItem; +begin + GetPartsCells(t, part1, part2, a); + area1 := GetFigureArea(part1, a); + area2 := GetFigureArea(part2, a); + diffProcent := LowerToBiggerRatio(area1, area2); + if diffProcent <= RandomCutThreshold then + cutFigure := ChooseRandomCell(part1, part2) + else + if area1 <= area2 then + cutFigure := part1 + else + cutFigure := part2; + CutChosenPart(cutFigure, a, cutOff); + CaptureCutBorders(a, cutOff); + DrawArenaBorders(a); + DrawArenaEdges; + DrawCreature(hamster); + DeleteTrace(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[midY][midX] or IsOnEdge(nextX, nextY)) + and not StepBeyondEdge(h) + and not ( + not IsOnEdge(h) and a.borders[h.curY][h.curX] and + a.captured[midY][midX] + ); +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[midY][midX] and + not a.borders[hamster.curY][hamster.curX] 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.curY][hamster.curX] and + not a.borders[midY][midX] +end; + +procedure MakeHamsterStep(var h: creature; var t: tracePtr; var a: arena); +begin + h.curX := Clamp(h.curX + h.dX, 1, ArenaW); + h.curY := Clamp(h.curY + h.dY, 1, ArenaH); + if FieldToEdge(h, t, a) or IsOnField(h, t, a) then + ChangeHamsterTrace(h, t); + DrawAfterHamsterStep(h, t, a) +end; + +function VerticalBorder(var a: arena; nextX, nextY: integer): boolean; +begin + VerticalBorder := + a.borders[nextY][nextX] and + (a.borders[nextY - 1][nextX] or a.borders[nextY + 1][nextX]) +end; + +function HorizontalBorder(var a: arena; nextX, nextY: integer): boolean; +begin + HorizontalBorder := + a.borders[nextY][nextX] and + (a.borders[nextY][nextX - 1] or a.borders[nextY][nextX + 1]) +end; + +function IsCorner(x, y: integer; var a: arena): boolean; +begin + IsCorner := HorizontalBorder(a, x, y) and VerticalBorder(a, x, y) +end; + +procedure TpDrop(var a: arena; var e: creature); +var + nx, ny: integer; +begin + while true do + begin + nx := RandomLR(1, ArenaW); + ny := RandomLR(1, ArenaH); + if not a.captured[ny][nx] then + break + end; + e.curX := nx; + e.curY := ny +end; + +procedure MakeEnemyStep(var a: arena; var e, hamster: creature; t: tracePtr); +var + prevX, prevY: integer; +begin + if (e.t = creatureDrop) and (e.beforeTransform = 0) then + begin + TpDrop(a, e); + exit + end; + + prevX := e.curX; + prevY := e.curY; + MakeStep(a, e); + if TraceCrossed(prevX, prevY, e, t) then + hamster.alive := false +end; + +procedure KillCapturedEnemies(var a: arena; var e: creatureList); +var + tmp: creatureItemPtr; +begin + tmp := e.first; + while tmp <> nil do + begin + if tmp^.cr^.alive and a.captured[tmp^.cr^.curY][tmp^.cr^.curX] then + KillCreature(tmp^.cr^); + tmp := tmp^.next + end +end; + +procedure TurnOtherwise(var a: arena; var g: creature); +begin + if (OnEdgeX(g.curX) or VerticalBorder(a, g.curX, g.curY)) then + g.dX := g.dX * -1; + if (OnEdgeY(g.curY) or HorizontalBorder(a, g.curX, g.curY)) then + g.dY := g.dY * -1 +end; + +procedure SetVerticalMove(var g: creature; ms: integer); +begin + g.dX := 0; + g.dY := ms; + if RandomBool then + g.dY := -g.dY +end; + +procedure SetHorizontalMove(var g: creature; ms: integer); +begin + g.dX := ms; + g.dY := 0; + if RandomBool then + g.dX := -g.dX +end; + +procedure TurnToDiagonal(var g: creature; ms: integer); +begin + if (g.dX <> 0) and (g.dY <> 0) then + begin + g.dX := -g.dX; + g.dY := -g.dY + end + else + begin + g.dX := ms; + if RandomBool then + g.dX := -g.dX; + g.dY := ms; + if RandomBool then + g.dY := -g.dY + end +end; + +procedure EightDimensionTurn(var a: arena; var g: creature; + var diagonalMove: boolean; ms: integer); +begin + if RandomBool then + diagonalMove := not diagonalMove; + if diagonalMove then + begin + TurnToDiagonal(g, ms) + end + else + begin + if OnEdgeX(g.curX) or VerticalBorder(a, g.curX, g.curY) then + SetVerticalMove(g, ms) + else + SetHorizontalMove(g, ms) + end +end; + +procedure TurnEnemy(var cr: creature; var a: arena); +begin + case cr.t of + creatureGhost: + TurnOtherwise(a, cr); + creatureSun: + TurnOtherwise(a, cr); + creatureSnake, creatureDrop: + begin + if cr.t = creatureSnake then + EightDimensionTurn(a, cr, cr.diagonalMove, SnakeMovespeed) + else + EightDimensionTurn(a, cr, cr.diagonalMove, DropMovespeed) + end; + end +end; + +function EnemyShouldTurn(var e: creature; var a: arena): boolean; +var + oldX, oldY, newX, newY: integer; +begin + oldX := e.curX; + oldY := e.curY; + MakeStep(a, e); + newX := e.curX; + newY := e.curY; + e.curX := oldX; + e.curY := oldY; + EnemyShouldTurn := (oldX = newX) and (oldY = newY) +end; + +procedure TurnStubbornEnemies(var a: arena; var e: creatureList); +var + turnCnt: integer = 0; + tmp: creatureItemPtr; +begin + tmp := e.first; + while tmp <> nil do + begin + while tmp^.cr^.alive and EnemyShouldTurn(tmp^.cr^, a) and + (turnCnt < MaxTurnAttempts) do + begin + TurnEnemy(tmp^.cr^, a); + turnCnt := turnCnt + 1 + end; + turnCnt := 0; + tmp := tmp^.next + end +end; + +procedure EraseEnemies(var a: arena; var e: creatureList); +var + tmp: creatureItemPtr; +begin + tmp := e.first; + while tmp <> nil do + begin + if tmp^.cr^.curY = 1 then + RedrawInterfaceArea(tmp^.cr^.curX, tmp^.cr^.t); + if tmp^.cr^.alive and not EnemyShouldTurn(tmp^.cr^, a) then + RedrawArea(a, tmp^.cr^.curX, tmp^.cr^.curY, tmp^.cr^.t); + tmp := tmp^.next + end +end; + +procedure MakeEnemySteps(var a: arena; var h: creature; + t: tracePtr; var e: creatureList); +var + tmp: creatureItemPtr; +begin + tmp := e.first; + while tmp <> nil do + begin + if tmp^.cr^.alive and not EnemyShouldTurn(tmp^.cr^, a) then + MakeEnemyStep(a, tmp^.cr^, h, t); + tmp := tmp^.next + end +end; + +procedure MakeStep(var a: arena; var enemy: creature); +var + absDx, absDy, maxD, stepX, stepY, i, nX, nY: integer; +begin + absDx := Abs(enemy.dX); + absDy := Abs(enemy.dY); + maxD := Max(absDx, absDy); + stepX := Signum(enemy.dX, 0); + stepY := Signum(enemy.dY, 0); + for i := 1 to maxD do + begin + nX := enemy.curX + stepX; + nY := enemy.curY + stepY; + if a.captured[nY][nX] or (nX < 1) or (nX > ArenaW) or + (nY < 1) or (nY > ArenaH) then + begin + break + end + else + begin + enemy.curX := nX; + enemy.curY := nY + end + end +end; + +end. diff --git a/src/ascii_arts_m.pas b/src/ascii_arts_m.pas new file mode 100644 index 0000000..4339388 --- /dev/null +++ b/src/ascii_arts_m.pas @@ -0,0 +1,307 @@ +unit ascii_arts_m; + +interface +const + HamsterHeight = 5; + HamsterLifesWidth = 13; + MaxBannerWidth = 98; + MaxBannerHeight = 42; + DigitHeight = 5; + DigitWidth = 5; +type + CreatureImage = array[1..HamsterHeight] of string[HamsterLifesWidth]; + BannerImage = array[1..MaxBannerHeight] of string[MaxBannerWidth]; + DigitImage = array[1..DigitHeight] of string[DigitWidth]; +const + DigitsAscii: array[0..9] of DigitImage = ( + ( + '@@@@@', + '@ @', + '@ @', + '@ @', + '@@@@@' + ), + ( + ' @ ', + ' @@ ', + '@ @ ', + ' @ ', + '@@@@@' + ), + ( + '@@@@@', + ' @', + '@@@@@', + '@ ', + '@@@@@' + ), + ( + '@@@@@', + ' @', + '@@@@@', + ' @', + '@@@@@' + ), + ( + '@ @', + '@ @', + '@@@@@', + ' @', + ' @' + ), + ( + '@@@@@', + '@ ', + '@@@@@', + ' @', + '@@@@@' + ), + ( + '@@@@@', + '@ ', + '@@@@@', + '@ @', + '@@@@@' + ), + ( + '@@@@@', + ' @', + ' @', + ' @', + ' @' + ), + ( + '@@@@@', + '@ @', + '@@@@@', + '@ @', + '@@@@@' + ), + ( + '@@@@@', + '@ @', + '@@@@@', + ' @', + '@@@@@' + ) + ); + +const + YesHeight = 6; + NoHeight = 4; + NoWidth = 13; + HamsterWidth = 7; + + HamsterStayAscii: CreatureImage = ( + ' (\_/)', + '( 0_0 )', + '/-----\', + ' |___|', + ' / \' + ); + + { + HamsterStayAscii: CreatureImage = ( + ' (\_/)', + '( 0_0 )', + '/-----\', + ' |___|', + ' / \' + ); + } + + HamsterRunNX = 4; + HamsterRightAscii: array[1..HamsterRunNX] of CreatureImage = ( + ( + ' _/)', + ' ( 0)', + ' | \_', + ' |___|', + '-- \' + ), + ( + ' _/)', + ' ( 0)', + ' | |_|', + ' |___|', + ' |>' + ), + ( + ' _/)', + ' ( 0)', + ' |/_ |-', + ' |___|', + '-- \' + ), + ( + ' _/) ', + ' ( 0)', + ' | |_|', + ' |___|', + ' >| ' + ) + ); + + HamsterLeftAscii: array[1..HamsterRunNX] of CreatureImage = ( + ( + ' (\_ ', + ' (0 )', + ' _/ |', + ' |___|', + ' / --' + ), + ( + ' (\_ ', + ' (0 )', + ' |_| |', + ' |___|', + ' <|' + ), + ( + ' (\_', + ' (0 )', + '-| _\|', + ' |___|', + ' / --' + ), + ( + ' (\_', + ' (0 )', + ' |_| |', + ' |___|', + ' |<' + ) + ); + + HamsterRunNY = 2; + HamsterDownAscii: array[1..HamsterRunNY] of CreatureImage = ( + ( + ' (\_/)', + '( 0_o )', + '\----- ', + ' |___|\', + ' - |' + ), + ( + ' (\_/)', + '( o_0 )', + ' -----/', + '/|___|', + ' | -' + ) + ); + + HamsterUpAscii: array[1..HamsterRunNY] of CreatureImage = ( + ( + ' (\_/)', + '( )', + '\----- ', + ' |_*_|\', + ' - |' + ), + ( + ' (\_/)', + '( )', + ' -----/', + '/|_*_|', + ' | -' + ) + ); + + HamsterGGAscii: CreatureImage = ( + ' (\_/)', + '( G_G )', + '/-----\', + ' |___|', + ' / \' + ); + + HamsterLifesAscii: CreatureImage = ( + ' (\_/) ', + '( 0_0 ) \ /', + '/-----\ X ', + ' |___| / \', + ' / \ ' + ); + + GhostHeight = 3; + GhostWidth = 7; + GhostRunN = 2; + GhostAscii: array[1..GhostRunN] of CreatureImage = ( + ( + ' ___', + ' /0 0\', + '\/VvV\/', + '', + '' + ), + ( + ' ___', + ' /0 0\', + '\_____/', + '', + '' + ) + ); + + SunHeight = 4; + SunWidth = 7; + SunRunN = 2; + SunAscii: array[1..SunRunN] of CreatureImage = ( + ( + ' _A_', + ' / \', + '<|o o|>', + ' \_^_/', + '' + ), + ( + ' _A_', + ' / \', + '{-o o-}', + ' \_^_/', + '' + ) + ); + + GoidaSunHeight = 4; + GoidaSunAscii: CreatureImage = ( + ' ___', + ' / Z \', + '||> <||', + ' \___/', + '' + ); + + SnakeHeight = 5; + SnakeWidth = 7; + SnakeRunN = 2; + SnakeAscii: array[1..SnakeRunN] of CreatureImage = ( + ( + ' /v\ ', + '3 |o |', + '\\ \ / ', + ' \\_\\ ', + ' \_// ' + ), + ( + ' /v\ ', + ' o ', + '\\ \ / ', + ' ', + ' \_// ' + ) + ); + + DropHeight = 5; + DropWidth = 7; + DropAscii: CreatureImage = ( + ' _', + ' / \', + ' / \', + '/ 0_0 \', + '\_____/' + ); + +implementation +end. diff --git a/src/cell_m.pas b/src/cell_m.pas new file mode 100644 index 0000000..61a3739 --- /dev/null +++ b/src/cell_m.pas @@ -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. diff --git a/src/completed.txt b/src/completed.txt new file mode 100644 index 0000000..440f3cb --- /dev/null +++ b/src/completed.txt @@ -0,0 +1,16 @@ +GameCompleteScoreWidth 50 +== BANNER START == +' _____ _ _ _ ', +' / ____| | | | | | |', +'| | __ __ _ _ __ ___ ___ ___ ___ _ __ ___ _ __ | | ___| |_ ___| |', +'| | |_ |/ _` | ''_ ` _ \ / _ \ / __/ _ \| ''_ ` _ \| ''_ \| |/ _ \ __/ _ \ |', +'| |__| | (_| | | | | | | __/ | (_| (_) | | | | | | |_) | | __/ || __/_|', +' \_____|\__,_|_| |_| |_|\___| \___\___/|_| |_| |_| .__/|_|\___|\__\___(_)', +' | |', +' |_|', +'__ __', +'\ \ / / _ ', +' \ \_/ /__ _ _ _ __ ___ ___ ___ _ __ ___(_)', +' \ / _ \| | | | ''__| / __|/ __/ _ \| ''__/ _ \', +' | | (_) | |_| | | \__ \ (_| (_) | | | __/_ ', +' |_|\___/ \__,_|_| |___/\___\___/|_| \___(_)' diff --git a/src/convbanners.pas b/src/convbanners.pas new file mode 100644 index 0000000..393830a --- /dev/null +++ b/src/convbanners.pas @@ -0,0 +1,276 @@ +program convbanners; + +uses Math; + +const + AutobannerModuleName = '_autobanners_m.pas'; + BannerStartS = '== BANNER START =='; + BannersN = 10; + MenuFile = 'menu.txt'; + LevelFile = 'level.txt'; + PauseFile = 'paused.txt'; + GameOverFile = 'gameover.txt'; + GameCompleteFile = 'completed.txt'; + KeyInfoFile = 'keys.txt'; + ExitFile = 'exit.txt'; + LifeupFile = 'lifeup.txt'; + SpeedupFile = 'speedup.txt'; + SpeeddownFile = 'speeddown.txt'; + + BannerFiles: array[1..BannersN] of string = ( + MenuFile, LevelFile, PauseFile, GameOverFile, GameCompleteFile, + KeyInfoFile, ExitFile, LifeupFile, SpeedupFile, SpeeddownFile + ); + + MenuVarsPrefix = 'MenuBanner'; + LevelVarsPrefix = 'LevelAnnounceBanner'; + PauseVarsPrefix = 'PauseBanner'; + GameOverVarsPrefix = 'GameOverBanner'; + GameCompleteVarsPrefix = 'GameCompleteBanner'; + KeysVarsPrefix = 'KeysInfoBanner'; + ExitVarsPrefix = 'ExitBanner'; + + SpeedupVarsPrefix = 'SpeedupBanner'; + SpeeddownVarsPrefix = 'SpeeddownBanner'; + LifeupVarsPrefix = 'LifeupBanner'; + + VarsPrefixes: array[1..BannersN] of string = ( + MenuVarsPrefix, LevelVarsPrefix, PauseVarsPrefix, GameOverVarsPrefix, + GameCompleteVarsPrefix, KeysVarsPrefix, ExitVarsPrefix, + LifeupVarsPrefix, SpeedupVarsPrefix, SpeeddownVarsPrefix + ); + + DecimalBase = 10; + AfterImageLinesN = 2; + ModuleBeginH = 13; + ModuleBegin: array[1..ModuleBeginH] of string = ( + '{ ************************************************** }', + '{ ************************************************** }', + '{ *** *** }', + '{ *** *** }', + '{ *** AUTOMATICALLY GENERATED FILE. DO NOT EDIT. *** }', + '{ *** *** }', + '{ *** *** }', + '{ ************************************************** }', + '{ ************************************************** }', + 'unit _autobanners_m;', + '', + 'interface', + '' + ); + + BannerImageTypeStr = + 'BannerImage = array[1..MaxBannerHeight] of string[MaxBannerWidth];'; + + ModuleEndH = 2; + ModuleEnd: array[1..ModuleEndH] of string = ( + 'implementation', + 'end.' + ); + +procedure AppendText(var f: text; var t: array of string; h: integer); +var + i: integer; +begin + for i := 1 to h do + writeln(f, t[i - 1]) +end; + +function ParsedStrLength(var s: string): integer; +var + res: integer = 0; + backtickCnt: integer = 0; + i, sLen: integer; +begin + sLen := Length(s); + res := sLen; + for i := 1 to Length(s) do + if s[i] = '''' then + backtickCnt := backtickCnt + 1; + if s[sLen] = ',' then + res := res - 1; + res := res - 2; {Subtract first and last '} + backtickCnt := backtickCnt - 2; {Subtract first and last '} + ParsedStrLength := res - (backtickCnt div 2) +end; + +procedure GetMaxBannersDimensions(var h, w: integer); +var + i, len: integer; + curH: integer = 0; + t: text; + ln: string; + isBanner: boolean = false; +begin + h := 0; + w := 0; + for i := 1 to BannersN do + begin + curH := 0; + isBanner := false; + assign(t, BannerFiles[i]); + reset(t); + while not eof(t) do + begin + readln(t, ln); + if not isBanner then + begin + isBanner := (ln = BannerStartS); + continue + end; + curH := curH + 1; + len := ParsedStrLength(ln); + w := Max(w, len); + if len > 0 then + h := max(h, curH) + end + end +end; + +procedure AppendMaxBannersDimensions(var t: text; maxH, maxW: integer); +begin + writeln(t, 'MaxBannerHeight = ', maxH, ';'); + writeln(t, 'MaxBannerWidth = ', maxW, ';'); + writeln(t, '') +end; + +procedure AppendBannersType(var t: text); +begin + writeln(t, 'type'); + writeln(t, BannerImageTypeStr); + writeln(t, '') +end; + +procedure GetBannerDimensions(var fileName: string; var h, w: integer); +var + sLen: integer; + hNow: integer = 0; + fileFrom: text; + ln: string; + isBanner: boolean = false; +begin + w := 0; + h := 0; + assign(fileFrom, fileName); + reset(fileFrom); + while not eof(fileFrom) do + begin + readln(fileFrom, ln); + if not isBanner then + begin + isBanner := (ln = BannerStartS); + continue + end; + sLen := ParsedStrLength(ln); + w := Max(w, sLen); + hNow := hNow + 1; + if sLen > 0 then + h := hNow + end +end; + +procedure ParseNum(var ln, res: string; idx: integer); +var + i, n: integer; +begin + n := Length(ln); + for i := idx to n do + begin + if (ln[i] <= '0') or (ln[i] >= '9') then + begin + res := copy(ln, idx, i - 1); + break + end; + if i = n then + res := copy(ln, idx, i) + end +end; + +procedure AppendConst(var fileTo: text; var ln: string); +var + idx: integer = 1; + lenS: integer; + num: string; + constName: string = ''; +begin + lenS := Length(ln); + while (idx <= lenS) do + begin + if ln[idx] = ' ' then + break; + idx := idx + 1 + end; + if (idx >= lenS) or (idx = 1) then + exit; + constName := copy(ln, 1, idx - 1); + ParseNum(ln, num, idx + 1); + writeln(fileTo, constName, ' = ', num, ';') +end; + +procedure AppendConsts(var fileFrom, fileTo: text); +var + isBanner: boolean = false; + ln: string; +begin + while not isBanner do + begin + readln(fileFrom, ln); + isBanner := (ln = BannerStartS); + if not isBanner and (Length(ln) > 0) then + AppendConst(fileTo, ln) + end; +end; + +procedure AppendBanner(var fileTo: text; bannerImageH: integer; + var fileName, varPrefix: string); +var + w, h, i: integer; + fileFrom: text; + ln: string; +begin + GetBannerDimensions(fileName, h, w); + writeln(fileTo, varPrefix, 'Height = ', h, ';'); + writeln(fileTo, varPrefix, 'Width = ', w, ';'); + assign(fileFrom, fileName); + reset(fileFrom); + AppendConsts(fileFrom, fileTo); + + writeln(fileTo, varPrefix, ': BannerImage = ('); + while not eof(fileFrom) do + begin + readln(fileFrom, ln); + if (ln[Length(ln)] = ',') or (h = bannerImageH) then + writeln(fileTo, ln) + else + writeln(fileTo, ln, ',') + end; + for i := 1 to (bannerImageH - h - 1) do + writeln(fileTo, ''''','); + if bannerImageH <> h then + writeln(fileTo, ''''''); + writeln(fileTo, ');'); + writeln(fileTo, '') +end; + +procedure CreateAutobannerModule; +var + i, maxH, maxW: integer; + newModule: text; +begin + assign(newModule, AutobannerModuleName); + rewrite(newModule); + AppendText(newModule, ModuleBegin, ModuleBeginH); + writeln(newModule, 'const'); + GetMaxBannersDimensions(maxH, maxW); + AppendMaxBannersDimensions(newModule, maxH, maxW); + AppendBannersType(newModule); + writeln(newModule, 'const'); + for i := 1 to BannersN do + AppendBanner(newModule, maxH, BannerFiles[i], VarsPrefixes[i]); + AppendText(newModule, ModuleEnd, ModuleEndH); + close(newModule) +end; + +begin + CreateAutobannerModule +end. diff --git a/src/creature_m.pas b/src/creature_m.pas new file mode 100644 index 0000000..839dd25 --- /dev/null +++ b/src/creature_m.pas @@ -0,0 +1,171 @@ +unit creature_m; + +interface + +type + creatureType = (creatureHamster, creatureGhost, creatureSun, + creatureSnake, creatureDrop); + + creaturePtr = ^creature; + + creature = record + curX, curY, dX, dY, moveSpeed, animation: integer; + alive: boolean; + t: creatureType; + + rageMode: boolean; {for sun } + bigStep: boolean; {for sun } + beforeTransform: integer; {for sun and drop } + diagonalMove: boolean; {for snake and drop} + beforeReverse: integer; {for snake and drop} + + end; + + creatureItemPtr = ^creatureItem; + + creatureItem = record + cr: creaturePtr; + next: creatureItemPtr + end; + + creatureList = record + len: integer; + first, last: creatureItemPtr; + end; + +function RandomLR(l, r: integer): integer; +procedure AppendCreature(var lst: creatureList; c: creaturePtr); +procedure DisposeCreatureList(var lst: creatureList); +procedure KillCreature(var cr: creature); +procedure InitCreatureList(var lst: creatureList); +procedure StopCreature(var cr: creature); +procedure UpdateEnemyStates(var lst: creatureList); + +implementation + +uses arena_graphics_m, arena_m, math_m, ascii_arts_m, sun_m, snake_m, drop_m; + +function RandomLR(l, r: integer): integer; +begin + RandomLR := l + Random(r - l + 1) +end; + +procedure AppendCreature(var lst: creatureList; c: creaturePtr); +var + item: creatureItemPtr; +begin + new(item); + item^.cr := c; + item^.next := nil; + if lst.first = nil then + lst.first := item + else + lst.last^.next := item; + lst.last := item +end; + +procedure DisposeCreatureList(var lst: creatureList); +var + tmp: creatureItemPtr; +begin + while lst.first <> nil do + begin + tmp := lst.first; + lst.first := lst.first^.next; + if lst.first = nil then + lst.last := nil; + dispose(tmp^.cr); + dispose(tmp); + lst.len := lst.len - 1 + end +end; + +procedure KillCreature(var cr: creature); +begin + cr.alive := false +end; + +procedure InitCreatureList(var lst: creatureList); +begin + lst.len := 0; + lst.first := nil; + lst.last := nil +end; + +procedure StopCreature(var cr: creature); +begin + cr.dX := 0; + cr.dY := 0 +end; + +procedure UpdateEnemyCreatureState(var cr: creature); +begin + case cr.t of + creatureSun: + UpdateSunState(cr); + creatureSnake: + UpdateSnakeState(cr); + creatureDrop: + UpdateDropState(cr) + end +end; + +procedure UpdateEnemyStates(var lst: creatureList); +var + tmp: creatureItemPtr; +begin + tmp := lst.first; + while tmp <> nil do + begin + if tmp^.cr^.t <> creatureGhost then + UpdateEnemyCreatureState(tmp^.cr^); + tmp := tmp^.next + end +end; + +procedure SpeedDownCreatures(var lst: creatureList); +var + tmp: creatureItemPtr; +begin + tmp := lst.first; + while tmp <> nil do + begin + tmp^.cr^.moveSpeed := tmp^.cr^.moveSpeed - 1; + if tmp^.cr^.dX > 0 then + tmp^.cr^.dX := tmp^.cr^.dX - 1; + if tmp^.cr^.dX < 0 then + tmp^.cr^.dX := tmp^.cr^.dX + 1; + + if tmp^.cr^.dY > 0 then + tmp^.cr^.dY := tmp^.cr^.dY - 1; + if tmp^.cr^.dY < 0 then + tmp^.cr^.dY := tmp^.cr^.dY + 1; + + tmp := tmp^.next + end +end; + +procedure RestoreCreaturesMovespeed(var lst: creatureList); +var + tmp: creatureItemPtr; +begin + tmp := lst.first; + while tmp <> nil do + begin + tmp^.cr^.moveSpeed := tmp^.cr^.moveSpeed + 1; + + if tmp^.cr^.dX > 0 then + tmp^.cr^.dX := tmp^.cr^.dX + 1; + if tmp^.cr^.dX < 0 then + tmp^.cr^.dX := tmp^.cr^.dX - 1; + + if tmp^.cr^.dY > 0 then + tmp^.cr^.dY := tmp^.cr^.dY + 1; + if tmp^.cr^.dY < 0 then + tmp^.cr^.dY := tmp^.cr^.dY - 1; + + tmp := tmp^.next + end +end; + +end. diff --git a/src/debug_m.pas b/src/debug_m.pas new file mode 100644 index 0000000..d1c4290 --- /dev/null +++ b/src/debug_m.pas @@ -0,0 +1,112 @@ +unit debug_m; + +interface + +uses arena_m, cell_m, creature_m; + +procedure Debug; +procedure DebugCell(cell: cellItemPtr); +procedure Print(var m: arenaMatrix); +procedure PrintCallTime(s: string; y: integer); +procedure PrintCreatureDebug(var cr: creature); +procedure PrintEnemies(var lst: creatureList); + +implementation + +uses crt; + +const + DebugMsg = '===============DEBUG==============='; + DebugPrintY = 10; + DebugPrintX = 10; + +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: arenaMatrix); +var + i, j: integer; +begin + for i := 1 to ArenaH do + begin + for j := 1 to ArenaW do + if m[i][j] 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; + +function EnemyToString(cr: creaturePtr): string; +begin + case cr^.t of + creatureHamster: + EnemyToString := 'Hamster'; + creatureGhost: + EnemyToString := 'Ghost'; + creatureSun: + EnemyToString := 'Sun'; + creatureSnake: + EnemyToString := 'Snake'; + creatureDrop: + EnemyToString := 'Drop' + end +end; + +procedure PrintEnemies(var lst: creatureList); +var + y: integer = DebugPrintY; + tmp: creatureItemPtr; + s: string; +begin + tmp := lst.first; + while tmp <> nil do + begin + GotoXY(DebugPrintX, y); + s := EnemyToString(tmp^.cr); + write(s, ', Y: ', tmp^.cr^.curY, ', X: ', tmp^.cr^.curX); + tmp := tmp^.next; + y := y + 1 + end +end; + + +var + callCnt: integer = 0; + +procedure PrintCallTime(s: string; y: integer); +begin + GotoXY(10, 80 + y); + writeln(callCnt, ' GameCutPart'); + callCnt := callCnt + 1; + GotoXY(1, 1) +end; + +end. diff --git a/src/drop_m.pas b/src/drop_m.pas new file mode 100644 index 0000000..f81ca1c --- /dev/null +++ b/src/drop_m.pas @@ -0,0 +1,52 @@ +unit drop_m; + +interface + +uses creature_m; + +procedure UpdateDropState(var d: creature); +procedure InitRandomDrop(var s: creature); + +const + DropMovespeed = 2; + +implementation + +uses arena_m, Math, math_m; + +const + MinToTp = 10; + MaxToTp = 75; + +procedure InitDrop(var s: creature; x, y, sigdx, sigdy: integer); +begin + s.t := creatureDrop; + s.curX := x; + s.curY := y; + s.dX := DropMovespeed * sigdx; + s.dY := DropMovespeed * sigdy; + s.alive := true; + s.moveSpeed := DropMovespeed; + s.beforeTransform := RandomLR(MinToTp, MaxToTp); + s.diagonalMove := false +end; + +procedure InitRandomDrop(var s: creature); +var + x, y, sigdx, sigdy: integer; +begin + sigdx := IfThen(RandomBool, 1, -1); + sigdy := IfThen(RandomBool, 1, -1); + x := RandomLR(2, ArenaW - 1); + y := RandomLR(2, ArenaH - 1); + InitDrop(s, x, y, sigdx, sigdy) +end; + +procedure UpdateDropState(var d: creature); +begin + if d.beforeTransform = 0 then + d.beforeTransform := RandomLR(MinToTp, MaxToTp); + d.beforeTransform := d.beforeTransform - 1 +end; + +end. diff --git a/src/enemy_packs_m.pas b/src/enemy_packs_m.pas new file mode 100644 index 0000000..873ee7f --- /dev/null +++ b/src/enemy_packs_m.pas @@ -0,0 +1,92 @@ +unit enemy_packs_m; + +interface + +uses creature_m; + +type + enemyPackType = (enemyPack1, enemyPack2, enemyPack3, enemyPack4, + enemyPack5, enemyPack6, enemyPack7, enemyPack8, + enemyPack9, enemyPack10); + +procedure AppendEnemies(var lst: creatureList; t: enemyPackType); + +implementation + +uses ghost_m, sun_m, snake_m, drop_m; + +const + LevelGhostN: array[enemyPackType] of integer = ( + 4, 4, 2, 4, 4, 2, 4, 2, 4, 4 + ); + LevelSunN: array[enemyPackType] of integer = ( + 0, 1, 4, 2, 0, 2, 2, 2, 2, 0 + ); + LevelSnakeN: array[enemyPackType] of integer = ( + 0, 0, 0, 1, 2, 2, 2, 4, 2, 2 + ); + LevelDropN: array[enemyPackType] of integer = ( + 0, 0, 0, 0, 2, 2, 1, 1, 2, 4 + ); + +procedure AppendRandomGhosts(var lst: creatureList; t: enemyPackType); +var + i: integer; + c: creaturePtr; +begin + for i := 1 to LevelGhostN[t] do + begin + new(c); + InitRandomGhost(c^); + AppendCreature(lst, c) + end +end; + +procedure AppendRandomSuns(var lst: creatureList; t: enemyPackType); +var + i: integer; + c: creaturePtr; +begin + for i := 1 to LevelSunN[t] do + begin + new(c); + InitRandomSun(c^); + AppendCreature(lst, c) + end +end; + +procedure AppendRandomSnakes(var lst: creatureList; t: enemyPackType); +var + i: integer; + c: creaturePtr; +begin + for i := 1 to LevelSnakeN[t] do + begin + new(c); + InitRandomSnake(c^); + AppendCreature(lst, c) + end +end; + +procedure AppendRandomDrops(var lst: creatureList; t: enemyPackType); +var + i: integer; + c: creaturePtr; +begin + for i := 1 to LevelDropN[t] do + begin + new(c); + InitRandomDrop(c^); + AppendCreature(lst, c) + end +end; + +procedure AppendEnemies(var lst: creatureList; t: enemyPackType); +begin + AppendRandomGhosts(lst, t); + AppendRandomSuns(lst, t); + AppendRandomSnakes(lst, t); + AppendRandomDrops(lst, t) +end; + +end. diff --git a/src/exit.txt b/src/exit.txt new file mode 100644 index 0000000..b947dea --- /dev/null +++ b/src/exit.txt @@ -0,0 +1,19 @@ +ExitHeight 8 + +== BANNER START == +' ______ _ _ _ _ ___', +'| ____| (_) | | | | | |__ \', +'| |__ __ ___| |_ | |_| |__ ___ __ _ __ _ _ __ ___ ___ ) |', +'| __| \ \/ / | __| | __| ''_ \ / _ \ / _` |/ _` | ''_ ` _ \ / _ \/ /', +'| |____ > <| | |_ | |_| | | | __/ | (_| | (_| | | | | | | __/_|', +'|______/_/\_\_|\__| \__|_| |_|\___| \__, |\__,_|_| |_| |_|\___(_)', +' __/ |', +' |___/', +'', +'', +' _ _ ___ ___ _ __ ___', +'| | | |/ _ \/ __| | ''_ \ / _ \', +'| |_| | __/\__ \ | | | | (_) |', +' \__, |\___||___/ |_| |_|\___/', +' __/ |', +' |___/' diff --git a/src/game_m.pas b/src/game_m.pas new file mode 100644 index 0000000..7f83932 --- /dev/null +++ b/src/game_m.pas @@ -0,0 +1,440 @@ +unit game_m; + +interface + +uses level_m, enemy_packs_m; + +type + state = ( + gameLevelAnnounce, gameExit, gameMenu, gameStartLevel, gameKeyInfo, + gamePause, gameUnpauseLevel, gameOver, gameComplete, + gameLevelComplete, gameLevelLoop, gameContinueLevel + ); + menuState = (menuNewGame, menuKeyInfo, menuContinue); + gameState = record + curExit: boolean; + curMenu: menuState; + curState: state; + level, score, life: integer; + enemyPack: enemyPackType; + shutdown, newGame, unpause, levelInited, skipScene: boolean; + end; + +procedure InitGame(var g: gameState); +procedure MainLoop(var g: gameState); +procedure ChangeOtherExitState(var g: gameState); + +implementation + +uses arena_m, arena_graphics_m, crt, creature_m, graphics_m, hamster_m, + keys_m, debug_m; + +const + KeyDelayMs = 125; + MoveDelayMs = 125; + EraseLifeThreshold = 10; + AnnounceDelayMs = 1500; + LevelCompleteDelayMs = 1500; + LevelCount = 20; + StartLifeN = 3; + ScoreAddDivisor = 3; + {BonusThreshold = 750;} + BonusThreshold = 375; + BonusN = 3; + LifeUpBonus = 0; + SpeedUpBonus = 1; + SpeedDownBonus = 2; + +procedure DecreaseLife(var life: integer); +begin + if life = EraseLifeThreshold then + EraseLifesNumber(life); + life := life - 1; + DrawLifesNumber(life) +end; + +procedure InitGame(var g: gameState); +begin + g.curMenu := menuNewGame; + g.curState := gameMenu; + g.enemyPack := enemyPack1; + g.score := 0; + g.shutdown := false; + g.newGame := false; + g.skipScene := false; + g.life := StartLifeN +end; + +procedure RunExitState(var g: gameState; var level: levelState); +begin + DrawExit(g); + while (g.curState = gameExit) and not g.shutdown do + begin + delay(KeyDelayMs); + if keypressed then + HandleKey(g, level) + end; + EraseExit +end; + +procedure RunInfoState(var g: gameState; var level: levelState); +begin + DrawKeyInfo; + while (g.curState = gameKeyInfo) and not g.shutdown do + begin + delay(KeyDelayMs); + if keypressed then + HandleKey(g, level) + end; + EraseKeyInfo +end; + +procedure RunPauseState(var g: gameState; var level: levelState); +begin + DrawPause; + while (g.curState = gamePause) and not g.shutdown do + begin + delay(KeyDelayMs); + if keypressed then + HandleKey(g, level) + end; + if g.curState = gameMenu then + EraseLevel; + if g.curState = gameUnpauseLevel then + begin + DrawLevelUnpause(level); + level.unpause := true + end +end; + +procedure RunGameOverState(var g: gameState; var level: levelState); +begin + DrawGameOver; + DisposeCreatureList(level.enemyList); + g.score := 0; + g.life := StartLifeN; + while (g.curState = gameOver) and not g.shutdown do + begin + delay(KeyDelayMs); + if keypressed then + HandleKey(g, level) + end; + EraseGameOver; + if g.curState = gameLevelAnnounce then + begin + InitLevel(level, g.enemyPack) + end + else + begin + g.levelInited := false; + DisposeCreatureList(level.enemyList) + end +end; + +procedure GiveBonus(var g: gameState; var level: levelState); +var + bonus: integer; +begin + bonus := random(BonusN); + if bonus = LifeUpBonus then + begin + g.life := g.life + 1; + DrawLifesNumber(g.life); + ShowLifeUp + end + else + if bonus = SpeedUpBonus then + begin + SpeedUpHamster(level); + ShowSpeedUp + end + else + if bonus = SpeedDownBonus then + begin + SpeedDownEnemies(level); + ShowSpeedDown + end +end; + +procedure GameCutPart(var g: gameState; var level: levelState); +var + scoreAdd: integer = 0; + beforeCut, tmp: integer; +begin + beforeCut := level.cut; + SetArenaBorder(level.t, level.a); + ArenaCutPart(level.h, level.t, level.cut, level.a); + FillCompleteBar(level.cut); + tmp := level.cut - beforeCut; + while tmp <> 0 do + begin + scoreAdd := scoreAdd + tmp; + tmp := tmp div ScoreAddDivisor + end; + g.score := g.score + scoreAdd; + DrawScore(g.score) + { + if scoreAdd > BonusThreshold then + GiveBonus(g, level) + } +end; + +procedure GameNextLevel(var g: gameState; var level: levelState); +begin + DisposeCreatureList(level.enemyList); + if g.level = LevelCount then + begin + g.levelInited := false; + g.curState := gameComplete; + exit + end; + g.level := g.level + 1; + g.curState := gameLevelComplete; + if g.level mod 2 = 1 then + g.enemyPack := succ(g.enemyPack) +end; + +procedure GameKillHamster(var g: gameState; var level: levelState); +begin + if g.life <= 0 then + begin + g.curState := gameOver; + Exit + end; + DecreaseLife(g.life); + KillHamster(level.h, level.t, level.a); + DrawAliveEnemies(level.enemyList); + level.h.alive := true +end; + +procedure PollGameKeys(var g: gameState; var level: levelState); +var + i: integer; +begin + for i := 1 to (MoveDelayMs div KeyDelayMs) do + begin + delay(KeyDelayMs); + if keypressed then + HandleKey(g, level); + if g.curState = gamePause then + break + end +end; + +procedure MakeEnemyTurnStages(var level: levelState); +begin + KillCapturedEnemies(level.a, level.enemyList); + TurnStubbornEnemies(level.a, level.enemyList); + EraseEnemies(level.a, level.enemyList); + MakeEnemySteps(level.a, level.h, level.t, level.enemyList); + UpdateEnemyStates(level.enemyList); + DrawAliveEnemies(level.enemyList) +end; + +procedure MakeHamsterTurnStages(var g: gameState; var level: levelState); +begin + if not level.h.alive then + GameKillHamster(g, level); + if g.curState = gameOver then + exit; + if not HamsterStepPossible(level.h, level.t, level.a) then + StopCreature(level.h); + if not ((level.h.dX = 0) and (level.h.dY = 0)) then + MakeHamsterStep(level.h, level.t, level.a); + DrawCreature(level.h) +end; + + +procedure UpdateLevelBonuses(var level: levelState); +begin + if level.speedUp = 1 then + begin + level.h.movespeed := HamsterMovespeed; + level.h.dX := level.h.dX div 2; + level.h.dY := level.h.dY div 2; + end; + if level.speedUp > 0 then + level.speedUp := level.speedUp - 1; + if level.speedDown > 0 then + level.speedDown := level.speedDown - 1 +end; + +procedure LevelLoop(var g: gameState; var level: levelState); +begin + while (g.curState = gameLevelLoop) and not g.shutdown do + begin + PollGameKeys(g, level); + if g.curState = gamePause then + break; + if ArenaSplited(level.h, level.t, level.a) then + GameCutPart(g, level); + if IsLevelComplete(level) then + begin + GameNextLevel(g, level); + if g.curState = gameComplete then + EraseLevel; + break + end; + MakeEnemyTurnStages(level); + MakeHamsterTurnStages(g, level); + if (level.speedUp > 0) or (level.speedDown > 0) then + UpdateLevelBonuses(level); + if g.curState = gameOver then + begin + EraseLevel; + break + end + end +end; + +procedure RunLevelState(var g: gameState; var level: levelState); +begin + if g.newGame then + begin + g.levelInited := true; + g.level := 1; + g.life := StartLifeN; + g.newGame := false; + g.score := 0 + end; + g.curState := gameLevelLoop; + InitLevel(level, g.enemyPack); + DrawLevel(level, g.life, g.score); + LevelLoop(g, level) +end; + +procedure UnpauseLevel(var g: gameState; var level: levelState); +begin + if level.unpause then + level.unpause := false + else + DrawLevel(level, g.life, g.score); + g.curState := gameLevelLoop; + LevelLoop(g, level) +end; + +procedure ContinueLevel(var g: gameState; var level: levelState); +begin + DrawLevel(level, g.life, g.score); + g.curState := gamePause +end; + +procedure RunMenuState(var g: gameState; var level: levelState); +var + prevMenu: boolean = false; +begin + g.curState := gameMenu; + while (g.curState = gameMenu) and not g.shutdown do + begin + if (g.curState = gameMenu) and not prevMenu then + begin + DrawMenu(g); + GotoXY(1, 1); + prevMenu := true + end; + delay(KeyDelayMs); + if keypressed then + HandleKey(g, level); + if (g.curState <> gameMenu) and prevMenu then + begin + EraseMenu; + prevMenu := false + end; + if (g.curState <> gameMenu) then + if g.shutdown then + break + end +end; + +procedure RunAnnounceState(var g: gameState; var level: levelState); +var + i: integer; +begin + DrawAnnounce(g.level); + GotoXY(1, 1); + for i := 1 to AnnounceDelayMs div KeyDelayMs do + begin + delay(KeyDelayMs); + if keypressed then + HandleKey(g, level); + if g.shutdown then + exit; + if g.skipScene then + break + end; + g.skipScene := false; + g.curState := gameStartLevel; + EraseAnnounce(g.level) +end; + +procedure RunLevelCompleteState(var g: gameState; var level: levelState); +var + i: integer; +begin + FillCellsCapture(level.a); + DrawCreature(level.h); + for i := 1 to LevelCompleteDelayMs div KeyDelayMs do + begin + delay(KeyDelayMs); + if keypressed then + HandleKey(g, level); + if g.shutdown then + exit; + if g.skipScene then + break + end; + g.skipScene := false; + g.curState := gameLevelAnnounce; + EraseLevel +end; + +procedure RunGameCompleteState(var g: gameState; var level: levelState); +begin + DrawGameComplete(g.score); + while (g.curState = gameComplete) and not g.shutdown do + begin + delay(KeyDelayMs); + if keypressed then + HandleKey(g, level) + end; + EraseLevel +end; + +procedure MainLoop(var g: gameState); +var + level: levelState; +begin + while not g.shutdown do + case g.curState of + gameLevelAnnounce: + RunAnnounceState(g, level); + gameExit: + RunExitState(g, level); + gameKeyInfo: + RunInfoState(g, level); + gamePause: + RunPauseState(g, level); + gameStartLevel: + RunLevelState(g, level); + gameUnpauseLevel: + UnpauseLevel(g, level); + gameContinueLevel: + ContinueLevel(g, level); + gameOver: + RunGameOverState(g, level); + gameMenu: + RunMenuState(g, level); + gameLevelComplete: + RunLevelCompleteState(g, level); + gameComplete: + RunGameCompleteState(g, level) + end; + clrscr +end; + +procedure ChangeOtherExitState(var g: gameState); +begin + g.curExit := not g.curExit +end; + +end. diff --git a/src/gameover.txt b/src/gameover.txt new file mode 100644 index 0000000..e27f395 --- /dev/null +++ b/src/gameover.txt @@ -0,0 +1,41 @@ +== BANNER START == +' _____ __ __ ______ ', +' / ____| /\ | \/ | ____|', +' | | __ / \ | \ / | |__ ', +' | | |_ | / /\ \ | |\/| | __|', +' | |__| |/ ____ \| | | | |____', +' \_____/_/ \_\_| |_|______|', +' ______ ________ _____', +' / __ \ \ / / ____| __ \', +' | | | \ \ / /| |__ | |__) |', +' | | | |\ \/ / | __| | _ /', +' | |__| | \ / | |____| | \ \', +' \____/ \/ |______|_| \_\', +'', +' ____ ____', +' / o@@\ /@@o \', +' / /``\@\ __,-==-,__ /@/``\ \', +' / /` `||//\______/ \||` `\ \', +' | |` // __ __ \\ `| |', +' \ \` (/ /;g\ /g;\ \) `/ |', +' \_\__(( " .. " )____/_/', +' \ " __ " / ', +' @@@@@@(||)@@@@`@@`@@@@(||)@@@@@@@', +' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@', +' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@', +' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@', +' ', +' _ _ ___', +' | | (_) |__ \', +' ___ ___ _ __ | |_ _ _ __ _ _ ___ ) |', +' / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \ / /', +' | (_| (_) | | | | |_| | | | | |_| | __/ |_|', +' \___\___/|_| |_|\__|_|_| |_|\__,_|\___| (_)', +' ___ ___ __ ___ ___', +'| _| |_ | \ \ | _| |_ |', +'| | _ _ | | ___ ___ \ \ | | _ __ | | ___', +'| | | | | | | |/ _ \/ __| \ \ | | | ''_ \ | |/ _ \', +'| | | |_| | | | __/\__ \ \ \ | | | | | | | | (_) |', +'| |_ \__, | _| |\___||___/ \ \ | |_ |_| |_| _| |\___/', +'|___|=====/ |=|___| \_\ |___|=========|___|', +' |___/' diff --git a/src/ghost_m.pas b/src/ghost_m.pas new file mode 100644 index 0000000..8f16b78 --- /dev/null +++ b/src/ghost_m.pas @@ -0,0 +1,41 @@ +unit ghost_m; + +interface + +uses creature_m; + +const + GhostMovespeed = 1; + GhostStartDX = GhostMovespeed; + GhostStartDY = GhostMovespeed; + GhostSymbol = 'g'; + +procedure InitRandomGhost(var g: creature); + +implementation + +uses arena_m, Math, math_m; + +procedure InitGhost(var g: creature; x, y, sigdx, sigdy: integer); +begin + g.t := creatureGhost; + g.curX := x; + g.curY := y; + g.dX := GhostStartDX * sigdx; + g.dY := GhostStartDY * sigdy; + g.moveSpeed := GhostMovespeed; + g.alive := true +end; + +procedure InitRandomGhost(var g: creature); +var + x, y, sigdx, sigdy: integer; +begin + sigdx := IfThen(RandomBool, 1, -1); + sigdy := IfThen(RandomBool, 1, -1); + x := RandomLR(2, ArenaW - 1); + y := RandomLR(2, ArenaH - 1); + InitGhost(g, x, y, sigdx, sigdy) +end; + +end. diff --git a/src/gohamster.pas b/src/gohamster.pas new file mode 100644 index 0000000..f978224 --- /dev/null +++ b/src/gohamster.pas @@ -0,0 +1,40 @@ +program go_hamster; + +uses crt, graphics_m, game_m; + +function IsTerminalValid: boolean; +begin + IsTerminalValid := ( + (ScreenWidth >= ScreenW * WidthCoefficient) + and (ScreenHeight >= ScreenH) + ) +end; + +procedure PrintTerminalHelp; +begin + writeln('Increase your terminal size and try again.'); + if ScreenWidth < ScreenW * WidthCoefficient then + begin + writeln('Your terminal width: ', ScreenWidth, + '. Required: ', ScreenW * WidthCoefficient, '.') + end; + if ScreenHeight < ScreenH then + begin + writeln('Your terminal height: ', ScreenHeight, + '. Required: ', ScreenH, '.') + end +end; + +var + g: gameState; +begin + if not IsTerminalValid then + begin + PrintTerminalHelp; + exit + end; + InitGame(g); + clrscr; + MainLoop(g) +end. + diff --git a/src/graphics_m.pas b/src/graphics_m.pas new file mode 100644 index 0000000..098dbf9 --- /dev/null +++ b/src/graphics_m.pas @@ -0,0 +1,437 @@ +unit graphics_m; + +interface + +uses arena_m, creature_m, trace_m, game_m, level_m, _autobanners_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 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 - LevelAnnounceBannerHeight) 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 - ExitBannerHeight) div 2 - MenuHeightPadding; + ExitYesY = ExitGameY + ExitHeight - 1 + MenuHeightPadding; + ExitHamsterY = ExitYesY; + GameNameX = ScreenW * WidthCoefficient div 3 + 4; + MenuPaddingX = 4; + MenuHamsterX = GameNameX - HamsterWidth - MenuPaddingX; + ExitYesX = MenuHamsterX; + ExitNoX = ScreenW * WidthCoefficient - ExitYesX - NoWidth; + GameOverX = (ScreenW * WidthCoefficient - GameOverBannerWidth) div 2; + GameOverY = (ScreenH - GameOverBannerHeight) div 2; + HamsterNoX = ExitNoX - HamsterWidth - MenuPaddingX; + HamsterYesX = ExitYesX - HamsterWidth - MenuPaddingX; + KeyInfoX = (ScreenW * WidthCoefficient - KeysInfoBannerWidth) div 2; + KeyInfoY = (ScreenH - KeysInfoBannerHeight) div 2; + LetterWidth = 5; + LevelNumberMargin = 3; + GameCompleteX = (ScreenW * WidthCoefficient - GameCompleteBannerWidth) + div 2; + GameCompleteY = (ScreenH - GameCompleteBannerHeight) div 2; + GameCompleteScoreX = GameCompleteX + GameCompleteScoreWidth + 3; + GameCompleteScoreY = GameCompleteY + 9; + MaxStringLen = 255; + +var + firstMenuDraw: boolean = true; + +function CountLeadSpaces(var s: string): integer; +var + i, res: integer; +begin + res := 0; + for i := 1 to Length(s) do + if s[i] <> ' ' then + break + else + res := res + 1; + CountLeadSpaces := res +end; + +procedure PrintStringScreen(x, y, dy: integer; var s: string); +var + cutLen, leadSpaces: 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, MaxStringLen); + write(sCopy) + end + else + begin + leadSpaces := CountLeadSpaces(s); + GotoXY(x + leadSpaces, y + dy - 1); + sCopy := copy(s, leadSpaces + 1, MaxStringLen); + write(sCopy) + end +end; + +procedure PrintDigitS(x, y, dy: integer; var s: string); +begin + GotoXY(x, y + dy - 1); + write(s) +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 + PrintDigitS(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 - ExitBannerWidth) div 2, ExitGameY, + ExitBannerHeight, ExitBanner); + DrawExitState(g.curExit); + GotoXY(1, 1) +end; + +procedure DrawGameOver; +begin + DrawBannerImage(GameOverX, GameOverY, + GameOverBannerHeight, GameOverBanner); + GotoXY(1, 1) +end; + +procedure DrawKeyInfo; +begin + DrawBannerImage(KeyInfoX, KeyInfoY, KeysInfoBannerHeight, KeysInfoBanner); + GotoXY(1, 1) +end; + +procedure DrawLineX(x, y, len: integer; ch: char); +var + i: integer; +begin + GotoXY(x, y); + for i := 1 to len do + write(ch) +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 +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) +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, MenuBannerHeight, MenuBanner); + 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: integer; + s: string; +begin + s := StringOfChar(ch, w); + for i := 0 to h - 1 do + begin + GotoXY(x, y + i); + write(s) + end +end; + +procedure EraseRectangle(x, y, w, h: integer); +begin + FillRectangle(x, y, w, h, ' ') +end; + +procedure EraseExit; +begin + EraseRectangle(HamsterYesX, ExitGameY, + ExitBannerWidth + HamsterWidth + MenuPaddingX, + ExitBannerHeight + MenuHeightPadding + YesHeight) +end; + +procedure EraseExitState(b: boolean); +var + x: integer; +begin + if b then + x := HamsterYesX + else + x := HamsterNoX; + EraseRectangle(x, ExitHamsterY, HamsterWidth, HamsterHeight) +end; + +procedure EraseGameOver; +begin + EraseRectangle(GameOverX, GameOverY, + GameOverBannerWidth, GameOverBannerHeight) +end; + +procedure EraseKeyInfo; +begin + EraseRectangle(KeyInfoX, KeyInfoY, + KeysInfoBannerWidth, KeysInfoBannerHeight) +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, + MenuBannerWidth + HamsterWidth + MenuPaddingX, + 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 := LevelAnnounceBannerWidth + LevelNumberMargin + + DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1); + x := (ScreenW * WidthCoefficient - w) div 2; + DrawBannerImage(x, AnnounceY, + LevelAnnounceBannerHeight, LevelAnnounceBanner); + DrawNumber(x + LevelAnnounceBannerWidth + LevelNumberMargin, + AnnounceY + 1, lvl) +end; + +procedure EraseAnnounce(lvl: integer); +var + w, x, digitCnt: integer; +begin + digitCnt := CountDigits(lvl); + w := LevelAnnounceBannerWidth + LevelNumberMargin + + DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1); + x := (ScreenW * WidthCoefficient - w) div 2; + EraseRectangle(x, AnnounceY, w, LevelAnnounceBannerHeight) +end; + +procedure DrawGameComplete(score: integer); +begin + DrawBannerImage(GameCompleteX, GameCompleteY, + GameCompleteBannerHeight, GameCompleteBanner); + DrawNumber(GameCompleteScoreX, GameCompleteScoreY, score) +end; + +end. diff --git a/src/hamster_m.pas b/src/hamster_m.pas new file mode 100644 index 0000000..7060c37 --- /dev/null +++ b/src/hamster_m.pas @@ -0,0 +1,49 @@ +unit hamster_m; + +interface + +uses arena_m, creature_m, trace_m; + +const + HamsterStartX = 5; + HamsterStartY = 1; + HamsterStartDX = 0; + HamsterStartDY = 0; + HamsterMovespeed = 2; + HamsterSymbol = 'h'; + +procedure InitHamster(var cr: creature); +procedure KillHamster(var h: creature; var t: tracePtr; var a: arena); + +implementation + +uses arena_graphics_m, graphics_m; + +procedure InitHamster(var cr: creature); +begin + cr.t := creatureHamster; + cr.curX := HamsterStartX; + cr.curY := HamsterStartY; + cr.dX := HamsterStartDX; + cr.dY := HamsterStartDY; + cr.moveSpeed := HamsterMovespeed; + cr.alive := true; +end; + +procedure KillHamster(var h: creature; var t: tracePtr; var a: arena); +var + traceStart: tracePtr; +begin + RedrawArea(a, h.curX, h.curY, h.t); + EraseTrace(t, a); + DrawArenaCell(h.curX, h.curY, a); + GetStart(traceStart, t); + h.curX := traceStart^.x; + h.curY := traceStart^.y; + h.dX := HamsterStartDX; + h.dY := HamsterStartDY; + DeleteTrace(t); + DrawCreature(h) +end; + +end. diff --git a/src/keys.txt b/src/keys.txt new file mode 100644 index 0000000..f839a89 --- /dev/null +++ b/src/keys.txt @@ -0,0 +1,43 @@ +== BANNER START == +' _', +' | |', +' _ __ ___ _____ _____ | | _____ _ _ ___ _', +' | ''_ ` _ \ / _ \ \ / / _ \ | |/ / _ \ | | / __| (_)', +' | | | | | | (_) \ V / __/ | < __/ |_| \__ \ _', +' |_| |_| |_|\___/ \_/ \___| |_|\_\___|\__, |___/ (_)', +' __/ |', +' _ |___/', +' / \', +' / . \', +' / / \ \', +' /_/| |\_\', +' | |', +' |_|', +' __ ========= __', +' / / (\_/) \ \', +' / /_____ ( 0_0 ) ______\ \ ', +' { ______| /-----\ |_______ }', +' \ \ |___| / /', +' \_\ / \ /_/', +' ========== _ ===========', +' | |', +' _ | | _ ', +' \ \| |/ /', +' \ \ / / ', +' \ ` / ', +' \_/', +' =========', +' _ _ _', +' | | | | | |', +' ___ _ __ __ _ ___ ___ ___| |_ ___ _ __ | |__ __ _ _ __ ___ ___| |_ ___ _ __', +' / __| ''_ \ / _` |/ __/ _ \ ______ / __| __/ _ \| ''_ \ | ''_ \ / _` | ''_ ` _ \/ __| __/ _ \ ''__|', +' \__ \ |_) | (_| | (_| __/ |______| \__ \ || (_) | |_) | | | | | (_| | | | | | \__ \ || __/ |', +' |___/ .__/ \__,_|\___\___| |___/\__\___/| .__/ |_| |_|\__,_|_| |_| |_|___/\__\___|_|', +' ====| |=================== | |', +' |_| |_|', +' ___ ___ ___ _ __ __ _ _ _ ___ ___', +' / _ \/ __|/ __| ______ | ''_ \ / _` | | | / __|/ _ \', +'| __/\__ \ (__ |______| | |_) | (_| | |_| \__ \ __/', +' \___||___/\___| | .__/ \__,_|\__,_|___/\___|', +'================ | |', +' |_|' diff --git a/src/keys_m.pas b/src/keys_m.pas new file mode 100644 index 0000000..5e90d09 --- /dev/null +++ b/src/keys_m.pas @@ -0,0 +1,284 @@ +unit keys_m; + +interface + +uses game_m, level_m; + +const + ArrowDownOrd = -80; + ArrowLeftOrd = -75; + ArrowRightOrd = -77; + ArrowUpOrd = -72; + + CtrlCOrd = 3; + CtrlZOrd = 26; + + EscOrd = 27; + EnterOrd = 13; + LowerNOrd = 110; + LowerYOrd = 121; + SpaceOrd = 32; + UpperNOrd = 78; + UpperYOrd = 89; + + OneOrd = 49; + TwoOrd = 50; + ThreeOrd = 51; + UpperQOrd = 81; + LowerQOrd = 113; + + { Debug } + BOrd = 98; + COrd = 99; + LOrd = 108; + { Debug } + +procedure HandleKey(var g: gameState; var level: levelState); + +implementation + +uses crt, graphics_m, trace_m, creature_m, debug_m; + +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(var h: creature; k: integer); +begin + h.dX := 0; + h.dY := 0; + case k of + ArrowLeftOrd: + h.dX := -h.movespeed; + ArrowRightOrd: + h.dX := h.movespeed; + ArrowUpOrd: + h.dY := -h.movespeed; + ArrowDownOrd: + h.dY := h.movespeed; + SpaceOrd: + StopCreature(h) + end +end; + +procedure HandleLevelKey(var g: gameState; var level: levelState; k: integer); +begin + {DEBUG} + if k = BOrd then + Print(level.a.borders); + if k = COrd then + Print(level.a.captured); + if k = LOrd then + begin + GotoXY(2, 60); + write(' '); + GotoXY(2, 60); + writeln(GetLength(level.t)) + end; + {DEBUG} + if (k = ArrowLeftOrd) or (k = ArrowRightOrd) or (k = ArrowUpOrd) or + (k = ArrowDownOrd) or (k = SpaceOrd) then + begin + ChangeHamsterDelta(level.h, k) + end; + if k = EscOrd then + g.curState := gamePause +end; + +procedure PreviousMenuState(var g: gameState); +begin + if (g.curMenu = menuNewGame) and not g.levelInited then + g.curMenu := menuKeyInfo + else + if g.curMenu = menuNewGame then + g.curMenu := menuContinue + else + g.curMenu := pred(g.curMenu) +end; + +procedure NextMenuState(var g: gameState); +begin + if (g.curMenu = menuKeyInfo) and not g.levelInited or + (g.curMenu = menuContinue) then + begin + g.curMenu := menuNewGame + end + else + begin + g.curMenu := succ(g.curMenu) + end +end; + +procedure ChangeMenuState(var g: gameState; k: integer); +begin + case k of + ArrowUpOrd: + PreviousMenuState(g); + ArrowDownOrd: + NextMenuState(g) + end +end; + +procedure ChooseMenuNum(var g: gameState; k: integer); +begin + if (k = ThreeOrd) and not g.levelInited then + exit; + case k of + OneOrd: begin + g.newGame := true; + g.level := 1; + g.curState := gameLevelAnnounce + end; + TwoOrd: + g.curState := gameKeyInfo; + ThreeOrd: + g.curState := gameContinueLevel + end +end; + +procedure ChooseMenuMarked(var g: gameState); +begin + case g.curMenu of + menuNewGame: + begin + g.newGame := true; + g.level := 1; + g.curState := gameLevelAnnounce + end; + menuKeyInfo: + g.curState := gameKeyInfo; + menuContinue: + g.curState := gameContinueLevel + end +end; + +procedure HandleMenuKey(var g: gameState; k: integer); +begin + if (k = ArrowUpOrd) or (k = ArrowDownOrd) then + begin + EraseMenuState(g.curMenu); + ChangeMenuState(g, k); + DrawMenuState(g.curMenu) + end; + if (k = OneOrd) or (k = TwoOrd) or (k = ThreeOrd) then + ChooseMenuNum(g, k); + if (k = EscOrd) or (k = UpperQOrd) or (k = LowerQOrd) then + g.curState := gameExit; + if (k = EnterOrd) or (k = SpaceOrd) then + ChooseMenuMarked(g) +end; + +procedure HandleGameOverKey(var g: gameState; k: integer); +begin + case k of + UpperYOrd, LowerYOrd: + g.curState := gameLevelAnnounce; + UpperNOrd, LowerNOrd: + g.curState := gameMenu; + end +end; + +procedure ChangeExitState(k: integer; var g: gameState); +begin + case k of + ArrowRightOrd, ArrowLeftOrd: + ChangeOtherExitState(g) + end +end; + +procedure HandleExitKey(var g: gameState; k: integer); +begin + if (k = ArrowLeftOrd) or (k = ArrowRightOrd) then + begin + EraseExitState(g.curExit); + ChangeExitState(k, g); + DrawExitState(g.curExit); + exit + end; + if (k = EnterOrd) or (k = SpaceOrd) then + begin + if g.curExit then + g.shutdown := true + else + g.curExit := true; + end; + if (k = UpperYOrd) or (k = LowerYOrd) or (k = OneOrd) then + g.shutdown := true; + if (k = UpperNOrd) or (k = LowerNOrd) or (k = EscOrd) or (k = TwoOrd) then + g.curExit := true; + g.curState := gameMenu +end; + +procedure HandlePauseKey(var g: gameState; k: integer); +begin + if (k = EscOrd) or (k = SpaceOrd) then + g.curState := gameUnpauseLevel; + if (k = UpperQOrd) or (k = LowerQOrd) then + g.curState := gameMenu +end; + +procedure HandleInfoKey(var g: gameState; k: integer); +begin + if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) or + (k = UpperQOrd) or (k = LowerQOrd) then + begin + g.curState := gameMenu + end +end; + +procedure HandleSceneKey(var g: gameState; k: integer); +begin + if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) then + g.skipScene := true +end; + +procedure HandleGameCompleteKey(var g: gameState; k: integer); +begin + if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) then + g.curState := gameMenu +end; + +procedure HandleKey(var g: gameState; var level: levelState); +var + k: integer; +begin + GetKey(k); + if (k = CtrlCOrd) or (k = CtrlZOrd) then + begin + g.shutdown := true; + exit + end; + case g.curState of + gameLevelComplete, gameLevelAnnounce: + HandleSceneKey(g, k); + gameLevelLoop: + HandleLevelKey(g, level, k); + gameExit: + HandleExitKey(g, k); + gameMenu: + HandleMenuKey(g, k); + gameKeyInfo: + HandleInfoKey(g, k); + gamePause: + HandlePauseKey(g, k); + gameOver: + HandleGameOverKey(g, k); + gameComplete: + HandleGameCompleteKey(g, k) + end; + GotoXY(1, 1) +end; + +end. diff --git a/src/level.txt b/src/level.txt new file mode 100644 index 0000000..7eebf0b --- /dev/null +++ b/src/level.txt @@ -0,0 +1,7 @@ +== BANNER START == +' _ _ ', +'| | | |', +'| | _____ _____| |', +'| | / _ \ \ / / _ \ |', +'| |___| __/\ V / __/ |', +'|______\___| \_/ \___|_|' diff --git a/src/level_m.pas b/src/level_m.pas new file mode 100644 index 0000000..0215f6b --- /dev/null +++ b/src/level_m.pas @@ -0,0 +1,74 @@ +unit level_m; + +interface + +uses arena_m, trace_m, creature_m, enemy_packs_m; + +const + LevelCompleteThreshold = 85; + +type + levelState = record + a: arena; + t: tracePtr; + levelStarted, hamsterAlive, unpause: boolean; + h: creature; + cut, bonusShow, speedUp, speedDown: integer; + enemyList: creatureList; + end; + +function IsLevelComplete(var level: levelState): boolean; +procedure InitLevel(var level: levelState; t: enemyPackType); +procedure SpeedDownEnemies(var level: levelState); +procedure SpeedUpHamster(var level: levelState); + +implementation + +uses hamster_m, ghost_m, debug_m; + +const + BonusShowTick = 10; + BonusDurationTick = 40; + TotalProcent = 100; + +function IsLevelComplete(var level: levelState): boolean; +var + completeProcent: integer; +begin + completeProcent := round(level.cut / (TotalCells / TotalProcent)); + IsLevelComplete := completeProcent >= LevelCompleteThreshold +end; + +procedure InitLevel(var level: levelState; t: enemyPackType); +begin + InitArena(level.a); + InitHamster(level.h); + InitCreatureList(level.enemyList); + AppendEnemies(level.enemyList, t); + {PrintEnemies(level.enemyList);} + level.levelStarted := true; + level.hamsterAlive := true; + level.t := nil; + level.cut := 0; + level.speedUp := 0; + level.unpause := false +end; + +procedure SpeedUpHamster(var level: levelState); +begin + level.speedUp := BonusDurationTick; + level.h.movespeed := HamsterMovespeed * 2; + level.h.dX := level.h.dX * 2; + level.h.dY := level.h.dY * 2 +end; + + +procedure SpeedDownEnemies(var level: levelState); +begin + level.speedDown := BonusDurationTick; + { + SpeedDownCreatures(level.enemyList); + } +end; + +end. diff --git a/src/lifeup.txt b/src/lifeup.txt new file mode 100644 index 0000000..07b097a --- /dev/null +++ b/src/lifeup.txt @@ -0,0 +1,7 @@ +== BANNER START == +' _ _____ ______ ______ _ _ _____', +'| | |_ _| ____| ____| | | | | __ \', +'| | | | | |__ | |__ | | | | |__) |', +'| | | | | __| | __| | | | | ___/', +'| |____ _| |_| | | |____ | |__| | |', +'|______|_____|_| |______| \____/|_|' diff --git a/src/math_m.pas b/src/math_m.pas new file mode 100644 index 0000000..0d11937 --- /dev/null +++ b/src/math_m.pas @@ -0,0 +1,36 @@ +unit math_m; + +interface + +function Clamp(val, min, max: integer): integer; +function RandomBool: boolean; +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; + +function RandomBool: boolean; +begin + RandomBool := Random(2) = 1 +end; + +end. diff --git a/src/menu.txt b/src/menu.txt new file mode 100644 index 0000000..94aba8d --- /dev/null +++ b/src/menu.txt @@ -0,0 +1,44 @@ +GameNameHeight 6 +NewGameHeight 6 +MenuInfoHeight 8 +HighScoreHeight 8 +ContinueHeight 6 +ContinueWidth 41 + +== BANNER START == +' _____ _ _ _ _', +' / ____| | | | | | | | |', +'| | __ ___ | | | |__| | __ _ _ __ ___ ___| |_ ___ _ __', +'| | |_ |/ _ \| | | __ |/ _` | ''_ ` _ \/ __| __/ _ \ ''__|', +'| |__| | (_) |_| | | | | (_| | | | | | \__ \ || __/ |', +' \_____|\___/(_) |_| |_|\__,_|_| |_| |_|___/\__\___|_|', +'', +'', +'', +'', +'', +'', +'', +'', +' _ _ _____', +'| \ | | / ____|', +'| \| | _____ __ | | __ __ _ _ __ ___ ___', +'| . ` |/ _ \ \ /\ / / | | |_ |/ _` | ''_ ` _ \ / _ \', +'| |\ | __/\ V V / | |__| | (_| | | | | | | __/', +'|_| \_|\___| \_/\_/ \_____|\__,_|_| |_| |_|\___|', +'', +'', +' _ __ _____ __', +'| |/ / |_ _| / _|', +'| '' / ___ _ _ | | _ __ | |_ ___', +'| < / _ \ | | | | | | ''_ \| _/ _ \', +'| . \ __/ |_| | _| |_| | | | || (_) |', +'|_|\_\___|\__, | |_____|_| |_|_| \___/', +' __/ |', +' |___/', +' _____ _ _ ', +' / ____| | | (_) ', +'| | ___ _ __ | |_ _ _ __ _ _ ___ ', +'| | / _ \| ''_ \| __| | ''_ \| | | |/ _ \', +'| |___| (_) | | | | |_| | | | | |_| | __/', +' \_____\___/|_| |_|\__|_|_| |_|\__,_|\___|' diff --git a/src/paused.txt b/src/paused.txt new file mode 100644 index 0000000..c79608d --- /dev/null +++ b/src/paused.txt @@ -0,0 +1,23 @@ +== BANNER START == +' _', +' | |', +' _ __ __ _ _ _ ___ ___ __| |', +' | ''_ \ / _` | | | / __|/ _ \/ _` |', +' | |_) | (_| | |_| \__ \ __/ (_| |', +' | .__/ \__,_|\__,_|___/\___|\__,_| ', +' | | ', +' |_| _ _', +' | | (_)', +' ___ _ __ __ _ __ ___ ___ ___ _ __ | |_ _ _ __ _ _ ___', +'/ __| ''_ \ / _` |/ __/ _ \ ______ / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \', +'\__ \ |_) | (_| | (_| __/ |______| | (_| (_) | | | | |_| | | | | |_| | __/', +'|___/ .__/ \__,_|\___\___| \___\___/|_| |_|\__|_|_| |_|\__,_|\___|', +'====| |===================', +' |_| _ _ _', +' (_) | | |', +' __ _ __ _ _ _ _| |_ | |_ ___ _ __ ___ ___ _ __ _ _', +' / _` | ______ / _` | | | | | __| | __/ _ \ | ''_ ` _ \ / _ \ ''_ \| | | |', +'| (_| | |______| | (_| | |_| | | |_ | || (_) | | | | | | | __/ | | | |_| |', +' \__, | \__, |\__,_|_|\__| \__\___/ |_| |_| |_|\___|_| |_|\__,_|', +'====| |= | |', +' |_| |_|' diff --git a/src/snake_m.pas b/src/snake_m.pas new file mode 100644 index 0000000..1e8046c --- /dev/null +++ b/src/snake_m.pas @@ -0,0 +1,56 @@ +unit snake_m; + +interface + +uses creature_m; + +procedure UpdateSnakeState(var s: creature); +procedure InitRandomSnake(var s: creature); + +const + SnakeMovespeed = 2; + +implementation + +uses arena_m, Math, math_m; + +const + MinToReverse = 2; + MaxToReverse = 75; + +procedure InitSnake(var s: creature; x, y, sigdx, sigdy: integer); +begin + s.t := creatureSnake; + s.curX := x; + s.curY := y; + s.dX := SnakeMovespeed * sigdx; + s.dY := SnakeMovespeed * sigdy; + s.alive := true; + s.moveSpeed := SnakeMovespeed; + s.beforeReverse := RandomLR(MinToReverse, MaxToReverse); + s.diagonalMove := false +end; + +procedure InitRandomSnake(var s: creature); +var + x, y, sigdx, sigdy: integer; +begin + sigdx := IfThen(RandomBool, 1, -1); + sigdy := IfThen(RandomBool, 1, -1); + x := RandomLR(2, ArenaW - 1); + y := RandomLR(2, ArenaH - 1); + InitSnake(s, x, y, sigdx, sigdy) +end; + +procedure UpdateSnakeState(var s: creature); +begin + s.beforeReverse := s.beforeReverse - 1; + if s.beforeReverse = 0 then + begin + s.beforeReverse := RandomLR(MinToReverse, MaxToReverse); + s.dX := s.dX * -1; + s.dY := s.dY * -1 + end +end; + +end. diff --git a/src/speeddown.txt b/src/speeddown.txt new file mode 100644 index 0000000..ba82db3 --- /dev/null +++ b/src/speeddown.txt @@ -0,0 +1,7 @@ +== BANNER START == +' _____ _____ ______ ______ _____ _____ ______ ___ _', +' / ____| __ \| ____| ____| __ \ | __ \ / __ \ \ / / \ | |', +'| (___ | |__) | |__ | |__ | | | | | | | | | | \ \ /\ / /| \| |', +' \___ \| ___/| __| | __| | | | | | | | | | | |\ \/ \/ / | . ` |', +' ____) | | | |____| |____| |__| | | |__| | |__| | \ /\ / | |\ |', +'|_____/|_| |______|______|_____/ |_____/ \____/ \/ \/ |_| \_|' diff --git a/src/speedup.txt b/src/speedup.txt new file mode 100644 index 0000000..3fb7f15 --- /dev/null +++ b/src/speedup.txt @@ -0,0 +1,7 @@ +== BANNER START == +' _____ _____ ______ ______ _____ _ _ _____', +' / ____| __ \| ____| ____| __ \ | | | | __ \', +'| (___ | |__) | |__ | |__ | | | | | | | | |__) |', +' \___ \| ___/| __| | __| | | | | | | | | ___/', +' ____) | | | |____| |____| |__| | | |__| | |', +'|_____/|_| |______|______|_____/ \____/|_|' diff --git a/src/sun_m.pas b/src/sun_m.pas new file mode 100644 index 0000000..d5ff7d9 --- /dev/null +++ b/src/sun_m.pas @@ -0,0 +1,94 @@ +unit sun_m; + +interface + +uses creature_m; + +procedure InitRandomSun(var s: creature); +procedure UpdateSunState(var s: creature); + +implementation + +uses arena_m, Math, math_m; + +const + SunSlowMovespeed = 1; + SunFastMovespeed = 2; + SunGoidaMovespeed = 3; + SunStartDX = SunSlowMovespeed; + SunStartDY = SunSlowMovespeed; + SunSymbol = 's'; + MinToGoidaSwitch = 25; + MaxToGoidaSwitch = 35; + MinToNormSwitch = 5; + MaxToNormSwitch = 30; + +procedure InitSun(var s: creature; x, y, sigdx, sigdy: integer); +begin + s.t := creatureSun; + s.curX := x; + s.curY := y; + s.dX := SunStartDX * sigdx; + s.dY := SunStartDY * sigdy; + s.alive := true; + s.moveSpeed := SunFastMovespeed; + s.bigStep:= true; + s.rageMode := false; + s.beforeTransform := RandomLR(MinToGoidaSwitch, MaxToGoidaSwitch) +end; + +procedure InitRandomSun(var s: creature); +var + x, y, sigdx, sigdy: integer; +begin + sigdx := IfThen(RandomBool, 1, -1); + sigdy := IfThen(RandomBool, 1, -1); + x := RandomLR(2, ArenaW - 1); + y := RandomLR(2, ArenaH - 1); + InitSun(s, x, y, sigdx, sigdy) +end; + +procedure SwitchGoidaMode(var cr: creature); +begin + cr.rageMode := not cr.rageMode; + if cr.rageMode then + cr.beforeTransform := RandomLR(MinToNormSwitch, MaxToNormSwitch) + else + cr.beforeTransform := RandomLR(MinToGoidaSwitch, MaxToGoidaSwitch); + if cr.rageMode then + begin + cr.dX := Signum(cr.dX, 0) * SunGoidaMovespeed; + cr.dY := Signum(cr.dY, 0) * SunGoidaMovespeed + end + else + begin + cr.dX := Signum(cr.dX, 0) * SunSlowMovespeed; + cr.dY := Signum(cr.dY, 0) * SunSlowMovespeed; + cr.bigStep := false + end; +end; + +procedure UpdateSunState(var s: creature); +begin + if s.beforeTransform = 0 then + begin + SwitchGoidaMode(s); + exit + end; + s.beforeTransform := s.beforeTransform - 1; + if s.rageMode then + exit; + s.bigStep := not s.bigStep; + if s.bigStep then + begin + s.dX := Signum(s.dX, 0) * SunFastMovespeed; + s.dY := Signum(s.dY, 0) * SunFastMovespeed + end + else + begin + s.dX := Signum(s.dX, 0) * SunSlowMovespeed; + s.dY := Signum(s.dY, 0) * SunSlowMovespeed + end +end; + +end. diff --git a/src/trace_m.pas b/src/trace_m.pas new file mode 100644 index 0000000..711ff8b --- /dev/null +++ b/src/trace_m.pas @@ -0,0 +1,188 @@ +unit trace_m; + +interface + +uses creature_m, math_m; + +const + PreviousTraceIdx = 3; + TraceSymbol = '+'; + +type + tracePtr = ^trace; + + trace = record + x, y: integer; + prev: tracePtr + end; + +function FindIndex(var t: tracePtr; x, y, curIdx: integer): integer; +function GetLength(var t: tracePtr): integer; +function TraceCrossed(pX, pY: integer; var cr: creature; t: tracePtr): boolean; +procedure ChangeHamsterTrace(var h: creature; var t: tracePtr); +procedure DeleteTrace(var t: tracePtr); +procedure GetStart(var traceStart: tracePtr; a: tracePtr); + +implementation + +uses arena_graphics_m; + +function GetLength(var t: tracePtr): integer; +begin + if t = nil then + GetLength := 0 + else + GetLength := 1 + GetLength(t^.prev) +end; + +procedure GetStart(var traceStart: tracePtr; a: tracePtr); +var + t: tracePtr; +begin + if a = nil then + exit; + t := a; + while t <> nil do + begin + if t^.prev = nil then + traceStart := t; + t := t^.prev + end +end; + +procedure DeleteTrace(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; + +function IsOnTrace(x, y: integer; t: tracePtr): boolean; +begin + if t = nil then + IsOnTrace := false + else + if (t^.x = x) and (t^.y = y) then + IsOnTrace := true + else + IsOnTrace := IsOnTrace(x, y, t^.prev) +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; t: tracePtr): boolean; +begin + IsOnTrace := IsOnTrace(cr.curX, cr.curY, t) +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) * hamster.movespeed; + dY := Signum(hamster.curY - hamster.dY, hamster.curY) * hamster.movespeed; + 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 hamster.movespeed do + AddStepTrace(hamster, t) +end; + +procedure DecreaseTrace(var hamster: creature; var t: tracePtr); +var + i: integer; +begin + for i := 1 to hamster.movespeed 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 + EraseStepTrace(h, t); + DecreaseTrace(h, t) + end + else + begin + IncreaseTrace(h, t) + end +end; + +function TraceCrossed(pX, pY: integer; var cr: creature; t: tracePtr): boolean; +var + dX, dY, prevX, prevY: integer; +begin + prevX := pX; + prevY := pY; + dX := Signum(cr.curX, prevX); + dY := Signum(cr.curY, prevY); + while (prevX <> cr.curX) and (prevY <> cr.curY) do + begin + if IsOnTrace(prevX, prevY, t) then + begin + TraceCrossed := true; + exit + end; + prevX := prevX + dX; + prevY := prevY + dY + end; + TraceCrossed := IsOnTrace(prevX, prevY, t) +end; + +end.