commit 9c392a47825e05fc9c2c02c3f179378743cecffc Author: gre-ilya Date: Sat Jan 10 12:09:22 2026 +0500 init diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..2728f7e --- /dev/null +++ b/Makefile @@ -0,0 +1,28 @@ +FPC = fpc +CONVBANNERS_SRC = convbanners.pas + +BANNERS_SRC = completed.txt exit.txt keys.txt paused.txt menu.txt \ + level.txt gameover.txt + +GAME_SRC = _banners_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 sun_fields_m.pas \ + trace_m.pas snake_m.pas snake_fields_m.pas drop_m.pas drop_fields_m.pas + +all: gohamster + +play: gohamster + ./gohamster + +gohamster: $(GAME_SRC) + $(FPC) $@.pas + +_banners_m.pas: convbanners $(BANNERS_SRC) + ./convbanners + +convbanners: $(CONVBANNERS_SRC) + $(FPC) $@.pas + +clean: + rm *.o *.ppu convbanners _banners_m.pas gohamster diff --git a/arena_graphics_m.pas b/arena_graphics_m.pas new file mode 100644 index 0000000..aa81090 --- /dev/null +++ b/arena_graphics_m.pas @@ -0,0 +1,607 @@ +unit arena_graphics_m; + +interface + +uses arena_m, creature_m, trace_m, level_m, _banners_m; + +const + ArenaSymbol = ' '; + CaptureSymbol = '.'; + +procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena); +procedure DrawAliveEnemies(var e: creatureList); +procedure RedrawArea(var a: arena; arenaX, arenaY: integer; t: creatureType); +procedure DrawArenaBorders(var a: arena); +procedure DrawCreature(var cr: creature); +procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char); +procedure DrawArenaEdges; +procedure DrawPause; +procedure DrawTrace(a: tracePtr); +procedure DrawHamster(var h: creature); +procedure FillCellsCapture(var a: arena); +procedure FillCompleteBar(s: integer); +procedure DrawArenaCell(x, y: integer; var a: arena); +procedure DrawLevel(var level: levelState; life, score: integer); +procedure DrawLevelUnpause(var level: levelState); +procedure DrawLifesNumber(n: integer); +procedure DrawScore(s: integer); +procedure EraseStepTrace(var hamster: creature; a: tracePtr); +procedure EraseLifesNumber(n: integer); +procedure EraseTrace(tp: tracePtr; var a: arena); + +implementation + +uses ascii_arts_m, crt, math_m, hamster_m, graphics_m; +const + ArenaPauseLowerMarginY = 14; + ArenaPauseMarginX = 9; + ArenaPauseUpperMarginY = 7; + InterfaceBarH = ScreenH - ArenaH * CellSize + BorderSize; { 14 } + InterfaceCellW = ScreenW div 3; + InterfaceMarginX = InterfaceCellW div 4; + InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1; + CompleteBarMarginY = 4; + CompleteBarMarginX = 5; + CompleteBarX = ( + InterfaceCellW * WidthCoefficient + BorderSize + CompleteBarMarginX + ); + CompleteBarY = BorderSize + CompleteBarMarginY + 1; + TotalProcent = 100; + CompleteBarH = InterfaceBarH - BorderSize * 2 - CompleteBarMarginY * 2; + CompleteBarW = ( + InterfaceCellW * WidthCoefficient - CompleteBarMarginX * 2 + ); + BarWinX = CompleteBarW * LevelCompleteThreshold div TotalProcent; + LifeBarX = 17; + LifeNumberX = 27; + MidCellDelimiter = '_'; + HamsterLifeY = 5; + DecimalBase = 10; + PauseXPadding = 3 * WidthCoefficient; + PauseX = (ScreenW * WidthCoefficient - PauseWidth) div 2; + PauseYPadding = 1; + PauseY = (ScreenH - PauseHeight) div 2; + InterfaceArenaCellX1 = 15; + InterfaceArenaCellX2 = 29; + +type + redrawAreaBox = record + lX, lY, rX, rY: integer + end; + +const + RedrawAreas: array[creatureType] of redrawAreaBox = ( + ( + lX: -HamsterWidth div CellSize div WidthCoefficient; + lY: -HamsterHeight div CellSize; rX: 0; rY: 0 + ), + ( + lX: -GhostWidth div CellSize div WidthCoefficient; + lY: 0; rX: 0; rY: GhostHeight div CellSize + ), + ( + lX: 0; lY: 0; rX: 0; rY: 0 + ), + ( + lX: 0; lY: 0; rX: 0; rY: 0 + ), + ( + lX: 0; lY: 0; rX: 0; rY: 0 + ) + ); + +procedure DrawCompleteBar; +begin + FillRectangle(CompleteBarX, CompleteBarY, CompleteBarW, CompleteBarH, '-'); + FillRectangle(CompleteBarX + BarWinX, CompleteBarY, + 1, CompleteBarH, '|') +end; + +procedure FillCompleteBar(s: integer); +var + cutedProcent: integer = 0; + fillW: integer; +begin + if s <> 0 then + cutedProcent := round(s / (TotalCells / TotalProcent)); + fillW := round(CompleteBarW / TotalProcent * cutedProcent); + FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '+') +end; + +procedure DrawAliveEnemies(var e: creatureList); +var + tmp: creatureItemPtr; +begin + tmp := e.first; + while tmp <> nil do + begin + if tmp^.cr^.alive then + DrawCreature(tmp^.cr^); + tmp := tmp^.next + end +end; + +procedure DrawFieldAscii(arenaX, arenaY, h, w: integer; var a: CreatureImage); +var + screenX, screenY: integer; +begin + screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient; + screenY := InterfaceBarH + (arenaY - 1) * CellSize; + DrawCreatureImage(screenX, screenY, h, a) +end; + +procedure DrawStepTrace(a: tracePtr; hamsterDelta: integer); +var + i: integer; + t: tracePtr; +begin + t := a; + for i := 1 to HamsterDelta + 2 do + begin + t := t^.prev; + if t = nil then + break; + DrawFieldCell(t^.x, t^.y, TraceSymbol) + end +end; + +procedure DrawPreviousCell(var cr: creature; var a: arena); +var + prevX, prevY: integer; +begin + prevX := cr.curX - cr.dX; + prevY := cr.curY - cr.dY; + DrawArenaCell(prevX, prevY, a) +end; + +procedure EraseStepTrace(var hamster: creature; a: tracePtr); +var + i: integer; + t: tracePtr; +begin + t := a; + for i := 1 to hamster.movespeed do + begin + DrawFieldCell(t^.x, t^.y, ArenaSymbol); + t := t^.prev + end; + if GetLength(t) = 1 then + begin + if IsOnEdge(hamster) then + DrawFieldCell(t^.x, t^.y, ArenaSymbol) + else + DrawFieldCell(t^.x, t^.y, BorderSymbol) + end +end; + +procedure EraseHamsterInterface(x: integer); +begin + if x <= 0 then + exit; + DrawFieldCell(x, 0, ' '); + DrawFieldCell(x, -1, ' '); + DrawFieldCell(x - 1, 0, ' '); + DrawFieldCell(x - 1, -1, ' ') +end; + +procedure RedrawInterfaceArea(x: integer); +begin + EraseHamsterInterface(x); + if (x = 1) or (x = 2) then + DrawLineY(1, InterfaceBarH - HamsterHeight, + HamsterHeight, BorderSymbol) + else + if x = InterfaceArenaCellX1 then + DrawLineY(InterfaceCellW * WidthCoefficient, + InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol) + else + if x = InterfaceArenaCellX2 then + DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, + InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol) + else + if x = ArenaW then + DrawLineY(ArenaW * CellSize * WidthCoefficient, + InterfaceBarH - HamsterHeight, HamsterHeight, BorderSymbol) +end; + +procedure RedrawArea(var a: arena; arenaX, arenaY: integer; t: creatureType); +var + i, j: integer; + r: redrawAreaBox; +begin + r := RedrawAreas[t]; + for i := r.lY to r.rY do + begin + for j := r.lX to r.rX do + begin + if (arenaX + j > 0) and (arenaX + j < ArenaW + 1) and + (arenaY + i > 0) and (arenaY + i < ArenaH + 1) then + begin + if (t = creatureHamster) and (arenaY + i = 1) then + RedrawInterfaceArea(arenaX + j); + DrawArenaCell(arenaX + j, arenaY + i, a) + end + end + end +end; + +procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena); +var + arenaX, arenaY: integer; +begin + {Later move to erase hamster} + arenaX := h.curX - h.dX; + arenaY := h.curY - h.dY; + RedrawArea(a, arenaX, arenaY, h.t); + if t <> nil then + DrawTrace(t); + if t = nil then + DrawPreviousCell(h, a) +end; + +procedure FillCells(var a: arena; x1, y1, x2, y2: integer); +var + i, j: integer; +begin + for i := y1 to y2 do + for j := x1 to x2 do + if a.borders[i][j] then + DrawFieldCell(j, i, BorderSymbol) + else + if a.captured[i][j] then + DrawFieldCell(j, i, CaptureSymbol) +end; + +procedure FillCellsUnpause(var a: arena); +begin + FillCells(a, 1 + ArenaPauseMarginX, ArenaPauseUpperMarginY, + ArenaW - ArenaPauseMarginX, ArenaH - ArenaPauseLowerMarginY) +end; + +procedure DrawPause; +begin + EraseRectangle(PauseX - PauseXPadding, + PauseY - PauseYPadding, + PauseWidth + PauseXPadding * 2, + PauseHeight + PauseYPadding * 2 + 1); + DrawRectangle(PauseX - PauseXPadding, + PauseY - PauseYPadding, + PauseHeight + PauseYPadding * 2 + 1, + PauseWidth + PauseXPadding * 2, + BorderSymbol); + DrawBannerImage(PauseX, PauseY, PauseHeight, PauseAscii) +end; + +procedure DrawTrace(a: tracePtr); +var + t: tracePtr; +begin + if a = nil then + exit; + t := a^.prev; + while t <> nil do + begin + DrawFieldCell(t^.x, t^.y, TraceSymbol); + t := t^.prev + end +end; + +procedure EraseInterfaceNumber(interfaceX: integer; num: longint); +var + cnt: integer = 0; + x, w, s: integer; +begin + s := num; + while s <> 0 do + begin + s := s div DecimalBase; + cnt += 1 + end; + x := interfaceX + InterfaceMarginX; + w := (DigitWidth + DigitSpaceWidth) * cnt; + EraseRectangle(x, InterfaceMarginY, w, DigitHeight) +end; + +procedure DrawInterfaceNumber(interfaceX: integer; n: longint); +begin + DrawNumber(interfaceX + InterfaceMarginX, InterfaceMarginY, n) +end; + +procedure DrawScore(s: integer); +var + scoreX: integer = InterfaceCellW * 2 * WidthCoefficient + BorderSize; +begin + DrawInterfaceNumber(scoreX, s) +end; + +procedure EraseLifesNumber(n: integer); +begin + EraseInterfaceNumber(LifeNumberX, n) +end; + +procedure DrawLifesNumber(n: integer); +begin + DrawInterfaceNumber(LifeNumberX, n) +end; + +procedure DrawLifes(n: integer); +begin + DrawCreatureImage(LifeBarX, HamsterLifeY, + HamsterHeight, HamsterLifesAscii); + DrawInterfaceNumber(LifeNumberX, n) +end; + +procedure DrawInterface; +begin + DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient, BorderSymbol); + DrawLineY(InterfaceCellW * WidthCoefficient, 1, + InterfaceBarH, BorderSymbol); + DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1, + InterfaceBarH, BorderSymbol) +end; + +procedure DrawLevel(var level: levelState; life, score: integer); +begin + DrawInterface; + FillCells(level.a, 1, 1, ArenaW, ArenaH); + DrawArenaEdges; + DrawTrace(level.t); + DrawCreature(level.h); + DrawAliveEnemies(level.enemyList); + DrawLifes(life); + DrawCompleteBar; + FillCompleteBar(level.cut); + DrawScore(score) +end; + +procedure ErasePause; +begin + EraseRectangle(PauseX - PauseXPadding, + PauseY - PauseYPadding, + PauseWidth + PauseXPadding * 2, + PauseHeight + PauseYPadding * 2 + 1) +end; + +procedure DrawLevelUnpause(var level: levelState); +begin + ErasePause; + FillCellsUnpause(level.a); + DrawTrace(level.t); + DrawAliveEnemies(level.enemyList); + DrawCreature(level.h) +end; + +procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char); +var + i, j, screenX, screenY: integer; +begin + screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient; + screenY := InterfaceBarH + (arenaY - 1) * CellSize; + for i := 1 to CellSize do + begin + GotoXY(screenX, screenY + i - 1); + for j := 1 to CellSize * WidthCoefficient do + begin + if (screenX + j - 1 >= 1) and + (screenX + j - 1 <= ScreenW * WidthCoefficient) then + begin + write(symbol) + end + end + end; + GotoXY(1, 1) +end; + +procedure DrawArenaEdges; +begin + DrawRectangle(1, InterfaceBarH, + ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient, + BorderSymbol) +end; + +procedure DrawLeftEdge(y: integer); +var + terminalY, clampedY: integer; +begin + clampedY := Clamp(y, 1, ArenaH); + terminalY := InterfaceBarH + (clampedY - 1) * CellSize; + DrawLineY(1, terminalY, CellSize, BorderSymbol) +end; + +procedure DrawRightEdge(y: integer); +var + terminalY, clampedY: integer; +begin + clampedY := Clamp(y, 1, ArenaH); + terminalY := InterfaceBarH + (clampedY - 1) * CellSize; + DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize, BorderSymbol) +end; + +procedure DrawUpperEdge(x: integer); +var + terminalX, sizeX, clampedX: integer; +begin + clampedX := Clamp(x, 1, ArenaW); + terminalX := (clampedX - 1) * CellSize * WidthCoefficient + 1; + sizeX := CellSize * WidthCoefficient; + DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbol) +end; + +procedure DrawLowerEdge(x: integer); +var + terminalX, sizeX, clampedX: integer; +begin + clampedX := Clamp(x, 1, ArenaW); + terminalX := (clampedX - 1) * CellSize * WidthCoefficient + 1; + sizeX := CellSize * WidthCoefficient; + DrawLineX(terminalX, InterfaceBarH + ArenaH * CellSize - 1, + sizeX, BorderSymbol) +end; + +procedure DrawArenaBorders(var a: arena); +var + i, j: integer; +begin + for i := 1 to ArenaH do + for j := 1 to ArenaW do + if a.borders[i][j] then + DrawFieldCell(j, i, BorderSymbol) +end; + +procedure DrawEdge(x, y: integer); +begin + if x = 1 then + DrawLeftEdge(y) + else + if x = ArenaW then + DrawRightEdge(y); + + if y = 1 then + DrawUpperEdge(x) + else + if y = ArenaH then + DrawLowerEdge(x) +end; + +procedure DrawArenaCell(x, y: integer; var a: arena); +begin + if a.captured[y][x] then + DrawFieldCell(x, y, CaptureSymbol) + else + if a.borders[y][x] then + DrawFieldCell(x, y, BorderSymbol) + else + DrawFieldCell(x, y, ArenaSymbol); + if IsOnEdge(x, y) then + DrawEdge(x, y) +end; + +procedure DrawCapturedCell(x, y: integer); +begin + DrawFieldCell(x, y, CaptureSymbol); + if IsOnEdge(x, y) then + DrawEdge(x, y) +end; + +procedure EraseTrace(tp: tracePtr; var a: arena); +var + t: tracePtr; +begin + if tp = nil then + exit; + t := tp; + while t <> nil do + begin + if t^.prev = nil then + DrawArenaCell(t^.x, t^.y, a) + else + DrawFieldCell(t^.x, t^.y, ArenaSymbol); + t := t^.prev + end +end; + +procedure FillCellsCapture(var a: arena); +var + i, j: integer; +begin + for i := 1 to ArenaH do + for j := 1 to ArenaW do + begin + if not a.captured[i][j] then + DrawCapturedCell(j, i) + end +end; + +procedure DrawHamsterRunX(var h: creature); +var + xIdx: integer; + img: ^CreatureImage; +begin + if h.dX = 0 then + exit; + xIdx := h.curX div h.moveSpeed mod HamsterRunNX + 1; + if h.dX > 0 then + img := @(HamsterRightAscii[xIdx]) + else + img := @(HamsterLeftAscii[xIdx]); + DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2, + h.curY - HamsterHeight div 2, + HamsterHeight, HamsterWidth, img^); +end; + +procedure DrawHamsterRunY(var h: creature); +var + yIdx: integer; + img: ^CreatureImage; +begin + if h.dY = 0 then + exit; + yIdx := h.curY div h.moveSpeed mod HamsterRunNY + 1; + if h.dY > 0 then + img := @(HamsterDownAscii[yIdx]) + else + img := @(HamsterUpAscii[yIdx]); + DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2, + h.curY - HamsterHeight div 2, + HamsterHeight, HamsterWidth, img^) +end; + +procedure DrawHamster(var h: creature); +begin + if (h.dX = 0) and (h.dY = 0) then + DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2, + h.curY - HamsterHeight div 2, + HamsterHeight, HamsterWidth, + HamsterStayAscii) + else + if h.dX <> 0 then + DrawHamsterRunX(h) + else + if h.dY <> 0 then + DrawHamsterRunY(h) +end; + +procedure DrawGhost(var g: creature); +var + asciiIdx: integer; +begin + asciiIdx := g.curX div g.moveSpeed mod GhostRunN + 1; + DrawFieldAscii(g.curX - GhostWidth div WidthCoefficient div 2, + g.curY - GhostHeight div 2 + 1, + GhostHeight, GhostWidth, GhostAscii[asciiIdx]) + +end; + +procedure DrawSun(var g: creature); +var + asciiIdx: integer; +begin + asciiIdx := g.curX div g.moveSpeed mod SunRunN + 1; + DrawFieldAscii(g.curX - SunWidth div WidthCoefficient div 2, + g.curY - SunHeight div 2 + 1, + SunHeight, SunWidth, SunAscii[asciiIdx]) + +end; + +{ +procedure DrawEnemy(var e: creature); +var + asciiIdx: integer; +begin + asciiIdx := e.curX div e.moveSpeed mod; +end; +} + +procedure DrawCreature(var cr: creature); +begin + case cr.t of + creatureHamster: + DrawHamster(cr); + creatureGhost: + DrawGhost(cr); + creatureSun: + DrawSun(cr) + end +end; + +end. diff --git a/arena_m.pas b/arena_m.pas new file mode 100644 index 0000000..b4219aa --- /dev/null +++ b/arena_m.pas @@ -0,0 +1,578 @@ +unit arena_m; + +interface + +uses creature_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 cr: creature); + + + +implementation + +uses arena_graphics_m, cell_m, crt, graphics_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 GhostShouldTurn(var g: creature; var a: arena): boolean; +var + nextX, nextY: integer; +begin + nextX := g.curX + g.dX; + nextY := g.curY + g.dY; + GhostShouldTurn := StepBeyondEdge(g) or + a.borders[g.curY][g.curX] and a.captured[nextY][nextX] +end; + +function SunShouldTurn(var g: creature; var a: arena): boolean; +begin + SunShouldTurn := true +end; + +function VerticalBorder(nextX, nextY: integer; var a: arena): boolean; +begin + VerticalBorder := + a.borders[nextY][nextX] and + (a.borders[nextY - 1][nextX] or a.borders[nextY + 1][nextX]) +end; + +function HorizontalBorder(nextX, nextY: integer; var a: arena): 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(x, y, a) and VerticalBorder(x, y, a) +end; + +procedure TurnGhost(var g: creature; var a: arena); +begin + if (OnEdgeX(g.curX) or VerticalBorder(g.curX, g.curY, a)) then + g.dX := g.dX * -1; + if (OnEdgeY(g.curY) or HorizontalBorder(g.curX, g.curY, a)) then + g.dY := g.dY * -1 +end; + +procedure TurnSun(var g: creature; var a: arena); +begin +end; + +procedure MakeEnemyStep(var a: arena; var e, h: creature; t: tracePtr); +var + prevX, prevY: integer; +begin + prevX := e.curX; + prevY := e.curY; + MakeStep(a, e); + if TraceCrossed(prevX, prevY, e, t) then + h.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 TurnEnemy(var cr: creature; var a: arena); +begin + case cr.t of + creatureGhost: + TurnGhost(cr, a); + creatureSun: + TurnGhost(cr, a) + end +end; + +function EnemyShouldTurn(var cr: creature; var a: arena): boolean; +begin + case cr.t of + creatureGhost: + EnemyShouldTurn := GhostShouldTurn(cr, a); + creatureSun: + EnemyShouldTurn := GhostShouldTurn(cr, a) + end +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^.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 cr: creature); +var + absDx, absDy, maxD, stepX, stepY, i, nX, nY: integer; +begin + absDx := Abs(cr.dX); + absDy := Abs(cr.dY); + maxD := Max(absDx, absDy); + stepX := Signum(cr.dX, 0); + stepY := Signum(cr.dY, 0); + for i := 1 to maxD do + begin + nX := cr.curX + stepX; + nY := cr.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 + cr.curX := nX; + cr.curY := nY + end + end +end; + +end. diff --git a/ascii_arts_m.pas b/ascii_arts_m.pas new file mode 100644 index 0000000..d69aca0 --- /dev/null +++ b/ascii_arts_m.pas @@ -0,0 +1,280 @@ +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 = 5; + SunWidth = 7; + SunRunN = 2; + SunAscii: array[1..SunRunN] of CreatureImage = ( + ( + ' _A_', + ' / \', + '<|o o|>', + ' \_^_/', + ' V' + ), + ( + ' _A_', + ' / \', + '{|o o|}', + ' \_^_/', + ' v' + ) + ); + + RageSunHeight = 4; + RageSunRunN = 1; + RageSunAscii: array[1..RageSunRunN] of CreatureImage = ( + ( + ' ___', + ' / Z \', + '||> <||', + ' \___/', + '' + ) + ); + +implementation +end. diff --git a/cell_m.pas b/cell_m.pas new file mode 100644 index 0000000..61a3739 --- /dev/null +++ b/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/completed.txt b/completed.txt new file mode 100644 index 0000000..797d631 --- /dev/null +++ b/completed.txt @@ -0,0 +1,42 @@ +' _____ _ _ _ ', +' / ____| | | | | | |', +'| | __ __ _ _ __ ___ ___ ___ ___ _ __ ___ _ __ | | ___| |_ ___| |', +'| | |_ |/ _` | ''_ ` _ \ / _ \ / __/ _ \| ''_ ` _ \| ''_ \| |/ _ \ __/ _ \ |', +'| |__| | (_| | | | | | | __/ | (_| (_) | | | | | | |_) | | __/ || __/_|', +' \_____|\__,_|_| |_| |_|\___| \___\___/|_| |_| |_| .__/|_|\___|\__\___(_)', +' | |', +' |_|', +'__ __', +'\ \ / / _ ', +' \ \_/ /__ _ _ _ __ ___ ___ ___ _ __ ___(_)', +' \ / _ \| | | | ''__| / __|/ __/ _ \| ''__/ _ \', +' | | (_) | |_| | | \__ \ (_| (_) | | | __/_ ', +' |_|\___/ \__,_|_| |___/\___\___/|_| \___(_)', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'' diff --git a/convbanners.pas b/convbanners.pas new file mode 100644 index 0000000..b5faf75 --- /dev/null +++ b/convbanners.pas @@ -0,0 +1,195 @@ +program convbanners; + +const + BannerModuleName = '_banners_m.pas'; + GameCompleteFile = 'completed.txt'; + ExitFile = 'exit.txt'; + KeysFile = 'keys.txt'; + MenuFile = 'menu.txt'; + GameOverFile = 'gameover.txt'; + PausedFile = 'paused.txt'; + LevelFile = 'level.txt'; + AfterImageLinesN = 2; + + + ModuleBeginH = 13; + +{ +const + MaxBannerWidth = KeyInfoWidth; + MaxBannerHeight = KeyInfoHeight; +type + BannerImage = array[1..MaxBannerHeight] of string[MaxBannerWidth]; +} + + + ModuleBegin: array[1..ModuleBeginH] of string = ( + '{ ************************************************** }', + '{ ************************************************** }', + '{ *** *** }', + '{ *** *** }', + '{ *** AUTOMATICALLY GENERATED FILE. DO NOT EDIT. *** }', + '{ *** *** }', + '{ *** *** }', + '{ ************************************************** }', + '{ ************************************************** }', + 'unit _banners_m;', + '', + 'interface', + 'const' + ); + + KeyInfoCodeH = 10; + BannersKeyInfo: array[1..KeyInfoCodeH] of string = ( + 'KeyInfoHeight = 42;', + 'KeyInfoWidth = 98;', + 'MaxBannerHeight = KeyInfoHeight;', + 'MaxBannerWidth = KeyInfoWidth;', + 'type', + 'BannerImage = array[1..MaxBannerHeight] of string[MaxBannerWidth];', + 'const', + 'KeyInfoScreen: BannerImage = (', + ');', + '' + ); + + { + KeyInfoCodeH = 5; + BannersKeyInfo: array[1..KeyInfoCodeH] of string = ( + 'KeyInfoHeight = 42;', + 'KeyInfoWidth = 98;', + 'KeyInfoScreen: BannerImage = (', + ');', + '' + ); + } + + ExitCodeH = 6; + BannersExit: array[1..ExitCodeH] of string = ( + 'ExitScreenHeight = 16;', + 'ExitWidth = 70;', + 'ExitHeight = 8;', + 'ExitScreen: BannerImage = (', + ');', + '' + ); + + PauseCodeH = 5; + BannersPause: array[1..PauseCodeH] of string = ( + 'PauseHeight = 22;', + 'PauseWidth = 76;', + 'PauseAscii: BannerImage = (', + ');', + '' + ); + + CompleteCodeH = 6; + BannersGameComplete: array[1..CompleteCodeH] of string = ( + 'GameCompleteHeight = 14;', + 'GameCompleteWidth = 74;', + 'GameCompleteScoreWidth = 50;', + 'GameComplete: BannerImage = (', + ');', + '' + ); + + MenuCodeH = 11; + BannersMenu: array[1..MenuCodeH] of string = ( + 'GameMenuHeight = 36;', + 'GameNameHeight = 6;', + 'GameNameWidth = 58;', + 'NewGameHeight = 6;', + 'HighScoreHeight = 8;', + 'MenuInfoHeight = 8;', + 'ContinueHeight = 6;', + 'ContinueWidth = 41;', + 'GameMenuScreen: BannerImage = (', + ');', + '' + ); + + GameOverCodeH = 5; + BannersGameOver: array[1..GameOverCodeH] of string = ( + 'GameOverHeight = 40;', + 'GameOverWidth = 63;', + 'GameOverScreen: BannerImage = (', + ');', + '' + ); + + LevelCodeH = 5; + BannersLevel: array[1..LevelCodeH] of string = ( + 'LevelAnnounceHeight = 6;', + 'LevelAnnounceWidth = 24;', + 'LevelAnnounce: BannerImage = (', + ');', + '' + ); + + ModuleEndH = 3; + 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; + +procedure ConcatenateFiles(var fTo: text; var filename: string); +var + ln: string; + fFrom: text; +begin + assign(fFrom, fileName); + reset(fFrom); + while not eof(fFrom) do + begin + readln(fFrom, ln); + writeln(fTo, ln) + end +end; + +procedure AppendAsciiBanner(var f: text; var t: array of string; + h: integer; fileName: string); +var + i: integer; +begin + for i := 1 to h do + begin + writeln(f, t[i - 1]); + if i = h - AfterImageLinesN then + ConcatenateFiles(f, fileName) + end +end; + +procedure CreateBannerModule; +var + newModule: text; +begin + assign(newModule, BannerModuleName); + rewrite(newModule); + AppendText(newModule, ModuleBegin, ModuleBeginH); + AppendAsciiBanner(newModule, BannersKeyInfo, KeyInfoCodeH, KeysFile); + AppendAsciiBanner(newModule, BannersExit, ExitCodeH, ExitFile); + AppendAsciiBanner(newModule, BannersPause, PauseCodeH, PausedFile); + AppendAsciiBanner(newModule, BannersGameComplete, CompleteCodeH, + GameCompleteFile); + AppendAsciiBanner(newModule, BannersMenu, MenuCodeH, MenuFile); + AppendAsciiBanner(newModule, BannersGameOver, GameOverCodeH, GameOverFile); + + AppendAsciiBanner(newModule, BannersLevel, LevelCodeH, LevelFile); + + AppendText(newModule, ModuleEnd, ModuleEndH); + close(newModule) +end; + +begin + CreateBannerModule +end. + diff --git a/creature_m.pas b/creature_m.pas new file mode 100644 index 0000000..3208c92 --- /dev/null +++ b/creature_m.pas @@ -0,0 +1,133 @@ +unit creature_m; + +interface + +uses sun_fields_m, snake_fields_m, drop_fields_m; + +type + creatureType = (creatureHamster, creatureGhost, creatureSun, + creatureSnake, creatureDrop); + + creaturePtr = ^creature; + + creature = record + curX, curY, dX, dY, moveSpeed, animation: integer; + alive: boolean; + t: creatureType; + sunf: sunStatePtr; + snakef: snakeStatePtr; + dropf: dropStatePtr; + 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; + + if tmp^.cr^.t = creatureSun then + dispose(tmp^.cr^.sunf) + else + if tmp^.cr^.t = creatureSnake then + dispose(tmp^.cr^.snakef) + else + if tmp^.cr^.t = creatureDrop then + dispose(tmp^.cr^.dropF); + 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; + +end. diff --git a/debug_m.pas b/debug_m.pas new file mode 100644 index 0000000..d1c4290 --- /dev/null +++ b/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/drop_fields_m.pas b/drop_fields_m.pas new file mode 100644 index 0000000..8100388 --- /dev/null +++ b/drop_fields_m.pas @@ -0,0 +1,16 @@ +unit drop_fields_m; + +interface + +type + dropStatePtr = ^dropState; + + dropState = record + crazyField1: boolean; + crazyField2: boolean; + crazyField3: boolean; + end; + +implementation +end. + diff --git a/drop_m.pas b/drop_m.pas new file mode 100644 index 0000000..24d180a --- /dev/null +++ b/drop_m.pas @@ -0,0 +1,15 @@ +unit drop_m; + +interface + +uses creature_m; + +procedure UpdateDropState(var cr: creature); + +implementation + +procedure UpdateDropState(var cr: creature); +begin +end; + +end. diff --git a/enemy_packs_m.pas b/enemy_packs_m.pas new file mode 100644 index 0000000..5acff49 --- /dev/null +++ b/enemy_packs_m.pas @@ -0,0 +1,84 @@ +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; + +const + { + LevelGhostN: array[enemyPackType] of integer = ( + 4, 4, 2, 4, 4, 2, 4, 2, 4, 4 + ); + } + + 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); +begin +end; + +procedure AppendRandomDrops(var lst: creatureList; t: enemyPackType); +begin +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/exit.txt b/exit.txt new file mode 100644 index 0000000..5169dc1 --- /dev/null +++ b/exit.txt @@ -0,0 +1,42 @@ +' ______ _ _ _ _ ___', +'| ____| (_) | | | | | |__ \', +'| |__ __ ___| |_ | |_| |__ ___ __ _ __ _ _ __ ___ ___ ) |', +'| __| \ \/ / | __| | __| ''_ \ / _ \ / _` |/ _` | ''_ ` _ \ / _ \/ /', +'| |____ > <| | |_ | |_| | | | __/ | (_| | (_| | | | | | | __/_|', +'|______/_/\_\_|\__| \__|_| |_|\___| \__, |\__,_|_| |_| |_|\___(_)', +' __/ |', +' |___/', +'', +'', +' _ _ ___ ___ _ __ ___', +'| | | |/ _ \/ __| | ''_ \ / _ \', +'| |_| | __/\__ \ | | | | (_) |', +' \__, |\___||___/ |_| |_|\___/', +' __/ |', +' |___/', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'' diff --git a/game_m.pas b/game_m.pas new file mode 100644 index 0000000..1bd1a25 --- /dev/null +++ b/game_m.pas @@ -0,0 +1,393 @@ +{ MainLoop -- main loop } +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 NextExitState(var g: gameState); +procedure PreviousExitState(var g: gameState); + +implementation + +uses arena_m, arena_graphics_m, crt, creature_m, graphics_m, hamster_m, + keys_m, debug_m; + +const + KeyDelayMs = 25; + MoveDelayMs = 120; + EraseLifeThreshold = 10; + AnnounceDelayMs = 1500; + LevelCompleteDelayMs = 1500; + LevelCount = 2; + StartLifeN = 3; + +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, enemyPack1) + end + else + begin + g.levelInited := false; + DisposeCreatureList(level.enemyList) + end; +end; + +procedure GameCutPart(var g: gameState; var level: levelState); +var + beforeCut: integer; +begin + beforeCut := level.cut; + SetArenaBorder(level.t, level.a); + ArenaCutPart(level.h, level.t, level.cut, level.a); + FillCompleteBar(level.cut); + g.score := g.score + (level.cut - beforeCut); + DrawScore(g.score) +end; + +procedure GameNextLevel(var g: gameState; var level: levelState); +begin + g.level := g.level + 1; + DisposeCreatureList(level.enemyList); + if g.level > LevelCount then + begin + g.levelInited := false; + g.curState := gameComplete + end + else + begin + g.curState := gameLevelComplete + end +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 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 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, enemyPack1); + 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); + 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); + 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; + EraseAll +end; + +procedure NextExitState(var g: gameState); +begin + if not g.curExit then + g.curExit := true + else + g.curExit := false +end; + +procedure PreviousExitState(var g: gameState); +begin + if g.curExit then + g.curExit := false + else + g.curExit := true +end; + +end. diff --git a/gameover.txt b/gameover.txt new file mode 100644 index 0000000..9e3d03e --- /dev/null +++ b/gameover.txt @@ -0,0 +1,42 @@ +' _____ __ __ ______ ', +' / ____| /\ | \/ | ____|', +' | | __ / \ | \ / | |__ ', +' | | |_ | / /\ \ | |\/| | __|', +' | |__| |/ ____ \| | | | |____', +' \_____/_/ \_\_| |_|______|', +' ______ ________ _____', +' / __ \ \ / / ____| __ \', +' | | | \ \ / /| |__ | |__) |', +' | | | |\ \/ / | __| | _ /', +' | |__| | \ / | |____| | \ \', +' \____/ \/ |______|_| \_\', +'', +' ____ ____', +' / o@@\ /@@o \', +' / /``\@\ __,-==-,__ /@/``\ \', +' / /` `||//\______/ \||` `\ \', +' | |` // __ __ \\ `| |', +' \ \` (/ /;g\ /g;\ \) `/ |', +' \_\__(( " .. " )____/_/', +' \ " __ " / ', +' @@@@@@(||)@@@@`@@`@@@@(||)@@@@@@@', +' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@', +' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@', +' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@', +' ', +' _ _ ___', +' | | (_) |__ \', +' ___ ___ _ __ | |_ _ _ __ _ _ ___ ) |', +' / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \ / /', +' | (_| (_) | | | | |_| | | | | |_| | __/ |_|', +' \___\___/|_| |_|\__|_|_| |_|\__,_|\___| (_)', +' ___ ___ __ ___ ___', +'| _| |_ | \ \ | _| |_ |', +'| | _ _ | | ___ ___ \ \ | | _ __ | | ___', +'| | | | | | | |/ _ \/ __| \ \ | | | ''_ \ | |/ _ \', +'| | | |_| | | | __/\__ \ \ \ | | | | | | | | (_) |', +'| |_ \__, | _| |\___||___/ \ \ | |_ |_| |_| _| |\___/', +'|___|=====/ |=|___| \_\ |___|=========|___|', +' |___/', +'', +'' diff --git a/ghost_m.pas b/ghost_m.pas new file mode 100644 index 0000000..40055d8 --- /dev/null +++ b/ghost_m.pas @@ -0,0 +1,42 @@ +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; + g.animation := 1; +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/gohamster.pas b/gohamster.pas new file mode 100644 index 0000000..93e7cfd --- /dev/null +++ b/gohamster.pas @@ -0,0 +1,41 @@ +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; + clrscr; + InitGame(g); + EraseAll; + MainLoop(g) +end. + diff --git a/graphics_m.pas b/graphics_m.pas new file mode 100644 index 0000000..b5d38a9 --- /dev/null +++ b/graphics_m.pas @@ -0,0 +1,416 @@ +unit graphics_m; + +interface + +uses arena_m, creature_m, trace_m, game_m, level_m, _banners_m, ascii_arts_m; + +const + BorderSize = 1; + InterfaceH = 6; + WidthCoefficient = 2; + CellSize = 2; + BorderSymbol = '|'; + DigitSpaceWidth = 1; + ScreenH = (ArenaH + InterfaceH) * CellSize + BorderSize; + ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 82 } + +procedure DrawAnnounce(lvl: integer); +procedure DrawBannerImage(x, y, h: integer; var a: BannerImage); +procedure DrawCreatureImage(x, y, h: integer; var a: CreatureImage); +procedure DrawExitState(b: boolean); +procedure DrawExit(var g: gameState); +procedure DrawGameOver; +procedure DrawGameComplete(score: integer); +procedure DrawKeyInfo; +procedure DrawLineX(x, y, len: integer; ch: char); +procedure DrawLineY(x, y, len: integer; ch: char); +procedure DrawNumber(x, y: integer; n: longint); +procedure DrawRectangle(x0, y0, h, w: integer; ch: char); +procedure DrawMenuState(s: menuState); +procedure DrawMenu(var g: gameState); +procedure EraseAll; +procedure EraseAnnounce(lvl: integer); +procedure EraseExit; +procedure EraseExitState(b: boolean); +procedure EraseGameOver; +procedure EraseKeyInfo; +procedure EraseLevel; +procedure EraseMenu; +procedure EraseMenuState(s: menuState); +procedure EraseRectangle(x, y, w, h: integer); +procedure FillRectangle(x, y, w, h: integer; ch: char); + +implementation + +uses crt, math_m; + +const + AnnounceY = (ScreenH - LevelAnnounceHeight) div 2; + BigLetterWidth = 8; + BorderN = 2; + DecimalDelimiter = 10; + GameNameY = 16; + NameHeightPadding = 8; + NewGameY = GameNameY + GameNameHeight + NameHeightPadding; + MenuHeightPadding = 2; + MenuInfoY = NewGameY + NewGameHeight + MenuHeightPadding; + ContinueY = MenuInfoY + MenuInfoHeight; + ExitGameY = (ScreenH - ExitScreenHeight) div 2 - MenuHeightPadding; + ExitYesY = ExitGameY + ExitHeight - 1 + MenuHeightPadding; + ExitHamsterY = ExitYesY; + GameNameX = ScreenW * WidthCoefficient div 3 + 4; + MenuWidthPadding = 4; + MenuHamsterX = GameNameX - HamsterWidth - MenuWidthPadding; + ExitYesX = MenuHamsterX; + ExitNoX = ScreenW * WidthCoefficient - ExitYesX - NoWidth; + GameOverX = (ScreenW * WidthCoefficient - GameNameWidth) div 2; + GameOverY = (ScreenH - GameOverHeight) div 2; + HamsterNoX = ExitNoX - HamsterWidth - MenuWidthPadding; + HamsterYesX = ExitYesX - HamsterWidth - MenuWidthPadding; + KeyInfoX = (ScreenW * WidthCoefficient - KeyInfoWidth) div 2; + KeyInfoY = (ScreenH - KeyInfoHeight) div 2; + LetterWidth = 5; + LevelNumberMargin = 3; + GameCompleteX = (ScreenW * WidthCoefficient - GameCompleteWidth) div 2; + GameCompleteY = (ScreenH - GameCompleteHeight) div 2; + GameCompleteScoreX = GameCompleteX + GameCompleteScoreWidth + 3; + GameCompleteScoreY = GameCompleteY + 9; + EndOfLine = 256; + +var + firstMenuDraw: boolean = true; + +procedure PrintStringScreen(x, y, dy: integer; var s: string); +var + cutLen: integer; + sCopy: string; +begin + if y + dy - 1 > ScreenH then + exit; + if x < 0 then + begin + cutLen := x * -1 + 1; + GotoXY(1, y + dy - 1); + sCopy := copy(s, cutLen, EndOfLine); + write(sCopy) + end + else + begin + GotoXY(x, y + dy - 1); + write(s) + end; + GotoXY(1, 1) +end; + +procedure DrawCreatureImage(x, y, h: integer; var a: CreatureImage); +var + i: integer; +begin + for i := 1 to h do + PrintStringScreen(x, y, i, a[i]) +end; + +procedure DrawBannerImage(x, y, h: integer; var a: BannerImage); +var + i: integer; +begin + for i := 1 to h do + PrintStringScreen(x, y, i, a[i]) +end; + +procedure DrawDigitImage(x, y, h: integer; var a: DigitImage); +var + i: integer; +begin + for i := 1 to h do + PrintStringScreen(x, y, i, a[i]) +end; + +procedure DrawDigit(x, y, digit: integer); +begin + DrawDigitImage(x, y, DigitHeight, DigitsAscii[digit]) +end; + +procedure DrawExitState(b: boolean); +begin + if b then + DrawCreatureImage(HamsterYesX, ExitHamsterY, + HamsterHeight, HamsterGGAscii) + else + DrawCreatureImage(HamsterNoX, ExitHamsterY, + HamsterHeight, HamsterStayAscii) +end; + +procedure DrawExit(var g: gameState); +var + realX: integer = ScreenW * WidthCoefficient; +begin + DrawBannerImage((realX - ExitWidth) div 2, ExitGameY, + ExitScreenHeight, ExitScreen); + DrawExitState(g.curExit) +end; + +procedure DrawGameOver; +begin + DrawBannerImage(GameOverX, GameOverY, GameOverHeight, GameOverScreen) +end; + +procedure DrawKeyInfo; +begin + DrawBannerImage(KeyInfoX, KeyInfoY, KeyInfoHeight, KeyInfoScreen) +end; + +procedure DrawLineX(x, y, len: integer; ch: char); +var + i: integer; +begin + GotoXY(x, y); + for i := 1 to len do + write(ch); + GotoXY(1, 1) +end; + +procedure DrawLineY(x, y, len: integer; ch: char); +var + i: integer; +begin + for i := 1 to len do + begin + GotoXY(x, y + i - 1); + write(ch) + end; + GotoXY(1, 1) +end; + +procedure DrawMenuState(s: menuState); +begin + case s of + menuNewGame: + DrawCreatureImage(MenuHamsterX, NewGameY + 1, + HamsterHeight, HamsterStayAscii); + menuKeyInfo: + DrawCreatureImage(MenuHamsterX, MenuInfoY + 1, + HamsterHeight, HamsterStayAscii); + menuContinue: + DrawCreatureImage(MenuHamsterX, ContinueY + 1, + HamsterHeight, HamsterStayAscii) + end +end; + +procedure DrawRectangle(x0, y0, h, w: integer; ch: char); +var + i: integer; +begin + DrawLineX(x0, y0, w, ch); + for i := 1 to h - 2 do + begin + GotoXY(x0, y0 + i); + write(ch); + GotoXY(x0 + w - 1, y0 + i); + write(ch) + end; + DrawLineX(x0, y0 + h - 1, w, ch); + GotoXY(1, 1) +end; + +procedure DrawMenu(var g: gameState); +var + y: integer = GameNameY; +begin + if firstMenuDraw then { REFACTOR LATER } + begin + DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient, BorderSymbol); + firstMenuDraw := not firstMenuDraw + end; + DrawBannerImage(GameNameX, y, GameMenuHeight, GameMenuScreen); + if not g.levelInited then + DrawLineX(GameNameX, ContinueY + ContinueHeight div 2, + ContinueWidth, '-'); + DrawMenuState(g.curMenu) +end; + +procedure FillRectangle(x, y, w, h: integer; ch: char); +var + i, j: integer; +begin + for i := 0 to h - 1 do + begin + GotoXY(x, y + i); + for j := 0 to w - 1 do + write(ch) + end; + GotoXY(1, 1) +end; + +procedure EraseRectangle(x, y, w, h: integer); +begin + FillRectangle(x, y, w, h, ' ') +end; + +procedure EraseAll; +begin + EraseRectangle(1, 1, ScreenW * WidthCoefficient, ScreenH) +end; + +procedure EraseExit; +begin + EraseRectangle(HamsterYesX, ExitGameY, + ExitWidth + HamsterWidth + MenuWidthPadding, + ExitScreenHeight + MenuHeightPadding + YesHeight) +end; + +procedure EraseExitState(b: boolean); +begin + if b then + EraseRectangle(HamsterYesX, ExitHamsterY, + HamsterWidth, HamsterHeight) + else + EraseRectangle(HamsterNoX, ExitHamsterY, + HamsterWidth, HamsterHeight) +end; + +procedure EraseGameOver; +begin + EraseRectangle(GameOverX, GameOverY, GameOverWidth, GameOverHeight) +end; + +procedure EraseKeyInfo; +begin + EraseRectangle(KeyInfoX, KeyInfoY, KeyInfoWidth, KeyInfoHeight) +end; + +procedure EraseLevel; +begin + EraseRectangle(2, 2, + ScreenW * WidthCoefficient - BorderSize * BorderN, + ScreenH - BorderSize * BorderN); + DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient, BorderSymbol) +end; + +procedure EraseMenu; +begin + EraseRectangle(MenuHamsterX, GameNameY, + GameNameWidth + HamsterWidth + MenuWidthPadding, + ScreenH - GameNameY * 2) +end; + +procedure EraseMenuState(s: menuState); +begin + case s of + menuNewGame: + EraseRectangle(MenuHamsterX, NewGameY + 1, + HamsterWidth, HamsterHeight); + menuKeyInfo: + EraseRectangle(MenuHamsterX, MenuInfoY + 1, + HamsterWidth, HamsterHeight); + menuContinue: + EraseRectangle(MenuHamsterX, ContinueY + 1, + HamsterWidth, HamsterHeight) + end +end; + +type + stackIntPtr = ^stackIntItem; + + stackIntItem = record + val: integer; + next: stackIntPtr + end; + + StackInt = record + top: stackIntPtr + end; + +procedure StackIntInit(var s: StackInt); +begin + s.top := nil +end; + +procedure StackPush(var st: StackInt; val: integer); +var + tmp: stackIntPtr; +begin + new(tmp); + tmp^.val := val; + tmp^.next := st.top; + st.top := tmp +end; + +procedure StackPop(var st: StackInt); +var + tmp: stackIntPtr; +begin + tmp := st.top; + st.top := st.top^.next; + dispose(tmp) +end; + +procedure DrawNumber(x, y: integer; n: longint); +var + i: integer = 0; + st: StackInt; +begin + StackIntInit(st); + if n = 0 then + StackPush(st, 0); + while n <> 0 do + begin + StackPush(st, n mod DecimalDelimiter); + n := n div DecimalDelimiter + end; + + while st.top <> nil do + begin + DrawDigit(x + (DigitWidth + DigitSpaceWidth) * i, y, st.top^.val); + StackPop(st); + i := i + 1 + end +end; + +function CountDigits(l: integer): integer; +var + lvl: integer; + res: integer = 0; +begin + lvl := l; + while lvl <> 0 do + begin + res := res + 1; + lvl := lvl div DecimalDelimiter + end; + CountDigits := res +end; + +procedure DrawAnnounce(lvl: integer); +var + w, x: integer; + digitCnt: integer = 0; +begin + digitCnt := CountDigits(lvl); + w := LevelAnnounceWidth + LevelNumberMargin + + DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1); + x := (ScreenW * WidthCoefficient - w) div 2; + DrawBannerImage(x, AnnounceY, LevelAnnounceHeight, LevelAnnounce); + DrawNumber(x + LevelAnnounceWidth + LevelNumberMargin, AnnounceY + 1, lvl) + +end; + +procedure EraseAnnounce(lvl: integer); +var + w, x, digitCnt: integer; +begin + digitCnt := CountDigits(lvl); + w := LevelAnnounceWidth + LevelNumberMargin + + DigitWidth * digitCnt + DigitSpaceWidth * (digitCnt - 1); + x := (ScreenW * WidthCoefficient - w) div 2; + EraseRectangle(x, AnnounceY, w, LevelAnnounceHeight) +end; + +procedure DrawGameComplete(score: integer); +begin + DrawBannerImage(GameCompleteX, GameCompleteY, + GameCompleteHeight, GameComplete); + DrawNumber(GameCompleteScoreX, GameCompleteScoreY, score) +end; + +end. diff --git a/hamster_m.pas b/hamster_m.pas new file mode 100644 index 0000000..7060c37 --- /dev/null +++ b/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/keys.txt b/keys.txt new file mode 100644 index 0000000..e580c67 --- /dev/null +++ b/keys.txt @@ -0,0 +1,42 @@ +' _', +' | |', +' _ __ ___ _____ _____ | | _____ _ _ ___ _', +' | ''_ ` _ \ / _ \ \ / / _ \ | |/ / _ \ | | / __| (_)', +' | | | | | | (_) \ V / __/ | < __/ |_| \__ \ _', +' |_| |_| |_|\___/ \_/ \___| |_|\_\___|\__, |___/ (_)', +' __/ |', +' _ |___/', +' / \', +' / . \', +' / / \ \', +' /_/| |\_\', +' | |', +' |_|', +' __ ========= __', +' / / (\_/) \ \', +' / /_____ ( 0_0 ) ______\ \ ', +' { ______| /-----\ |_______ }', +' \ \ |___| / /', +' \_\ / \ /_/', +' ========== _ ===========', +' | |', +' _ | | _ ', +' \ \| |/ /', +' \ \ / / ', +' \ ` / ', +' \_/', +' =========', +' _ _ _', +' | | | | | |', +' ___ _ __ __ _ ___ ___ ___| |_ ___ _ __ | |__ __ _ _ __ ___ ___| |_ ___ _ __', +' / __| ''_ \ / _` |/ __/ _ \ ______ / __| __/ _ \| ''_ \ | ''_ \ / _` | ''_ ` _ \/ __| __/ _ \ ''__|', +' \__ \ |_) | (_| | (_| __/ |______| \__ \ || (_) | |_) | | | | | (_| | | | | | \__ \ || __/ |', +' |___/ .__/ \__,_|\___\___| |___/\__\___/| .__/ |_| |_|\__,_|_| |_| |_|___/\__\___|_|', +' ====| |=================== | |', +' |_| |_|', +' ___ ___ ___ _ __ __ _ _ _ ___ ___', +' / _ \/ __|/ __| ______ | ''_ \ / _` | | | / __|/ _ \', +'| __/\__ \ (__ |______| | |_) | (_| | |_| \__ \ __/', +' \___||___/\___| | .__/ \__,_|\__,_|___/\___|', +'================ | |', +' |_|' diff --git a/keys_m.pas b/keys_m.pas new file mode 100644 index 0000000..9896714 --- /dev/null +++ b/keys_m.pas @@ -0,0 +1,286 @@ +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)); + GotoXY(1, 1) + 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: + NextExitState(g); + ArrowLeftOrd: + PreviousExitState(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 +end; + +end. diff --git a/level.txt b/level.txt new file mode 100644 index 0000000..93b79d2 --- /dev/null +++ b/level.txt @@ -0,0 +1,42 @@ +' _ _ ', +'| | | |', +'| | _____ _____| |', +'| | / _ \ \ / / _ \ |', +'| |___| __/\ V / __/ |', +'|______\___| \_/ \___|_|', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'' diff --git a/level_m.pas b/level_m.pas new file mode 100644 index 0000000..b6162f2 --- /dev/null +++ b/level_m.pas @@ -0,0 +1,52 @@ +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: integer; + enemyList: creatureList; + end; + +function IsLevelComplete(var level: levelState): boolean; +procedure InitLevel(var level: levelState; t: enemyPackType); + +implementation + +uses hamster_m, ghost_m, debug_m; + +const + 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.unpause := false +end; + +end. diff --git a/math_m.pas b/math_m.pas new file mode 100644 index 0000000..0d11937 --- /dev/null +++ b/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/menu.txt b/menu.txt new file mode 100644 index 0000000..36e8bf7 --- /dev/null +++ b/menu.txt @@ -0,0 +1,42 @@ +' _____ _ _ _ _', +' / ____| | | | | | | | |', +'| | __ ___ | | | |__| | __ _ _ __ ___ ___| |_ ___ _ __', +'| | |_ |/ _ \| | | __ |/ _` | ''_ ` _ \/ __| __/ _ \ ''__|', +'| |__| | (_) |_| | | | | (_| | | | | | \__ \ || __/ |', +' \_____|\___/(_) |_| |_|\__,_|_| |_| |_|___/\__\___|_|', +'', +'', +'', +'', +'', +'', +'', +'', +' _ _ _____', +'| \ | | / ____|', +'| \| | _____ __ | | __ __ _ _ __ ___ ___', +'| . ` |/ _ \ \ /\ / / | | |_ |/ _` | ''_ ` _ \ / _ \', +'| |\ | __/\ V V / | |__| | (_| | | | | | | __/', +'|_| \_|\___| \_/\_/ \_____|\__,_|_| |_| |_|\___|', +'', +'', +' _ __ _____ __', +'| |/ / |_ _| / _|', +'| '' / ___ _ _ | | _ __ | |_ ___', +'| < / _ \ | | | | | | ''_ \| _/ _ \', +'| . \ __/ |_| | _| |_| | | | || (_) |', +'|_|\_\___|\__, | |_____|_| |_|_| \___/', +' __/ |', +' |___/', +' _____ _ _ ', +' / ____| | | (_) ', +'| | ___ _ __ | |_ _ _ __ _ _ ___ ', +'| | / _ \| ''_ \| __| | ''_ \| | | |/ _ \', +'| |___| (_) | | | | |_| | | | | |_| | __/', +' \_____\___/|_| |_|\__|_|_| |_|\__,_|\___|', +'', +'', +'', +'', +'', +'' diff --git a/paused.txt b/paused.txt new file mode 100644 index 0000000..dbd1917 --- /dev/null +++ b/paused.txt @@ -0,0 +1,42 @@ +' _', +' | |', +' _ __ __ _ _ _ ___ ___ __| |', +' | ''_ \ / _` | | | / __|/ _ \/ _` |', +' | |_) | (_| | |_| \__ \ __/ (_| |', +' | .__/ \__,_|\__,_|___/\___|\__,_| ', +' | | ', +' |_| _ _', +' | | (_)', +' ___ _ __ __ _ __ ___ ___ ___ _ __ | |_ _ _ __ _ _ ___', +'/ __| ''_ \ / _` |/ __/ _ \ ______ / __/ _ \| ''_ \| __| | ''_ \| | | |/ _ \', +'\__ \ |_) | (_| | (_| __/ |______| | (_| (_) | | | | |_| | | | | |_| | __/', +'|___/ .__/ \__,_|\___\___| \___\___/|_| |_|\__|_|_| |_|\__,_|\___|', +'====| |===================', +' |_| _ _ _', +' (_) | | |', +' __ _ __ _ _ _ _| |_ | |_ ___ _ __ ___ ___ _ __ _ _', +' / _` | ______ / _` | | | | | __| | __/ _ \ | ''_ ` _ \ / _ \ ''_ \| | | |', +'| (_| | |______| | (_| | |_| | | |_ | || (_) | | | | | | | __/ | | | |_| |', +' \__, | \__, |\__,_|_|\__| \__\___/ |_| |_| |_|\___|_| '' |_|\__,_|', +'====| |= | |', +' |_| |_|', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'', +'' diff --git a/snake_fields_m.pas b/snake_fields_m.pas new file mode 100644 index 0000000..2610cfa --- /dev/null +++ b/snake_fields_m.pas @@ -0,0 +1,15 @@ +unit snake_fields_m; + +interface + +type + snakeStatePtr = ^snakeState; + + snakeState = record + crazyField1: boolean; + crazyField2: boolean; + crazyField3: boolean; + end; + +implementation +end. diff --git a/snake_m.pas b/snake_m.pas new file mode 100644 index 0000000..cc85524 --- /dev/null +++ b/snake_m.pas @@ -0,0 +1,15 @@ +unit snake_m; + +interface + +uses creature_m; + +procedure UpdateSnakeState(var cr: creature); + +implementation + +procedure UpdateSnakeState(var cr: creature); +begin +end; + +end. diff --git a/sun_fields_m.pas b/sun_fields_m.pas new file mode 100644 index 0000000..16a3b8a --- /dev/null +++ b/sun_fields_m.pas @@ -0,0 +1,14 @@ +unit sun_fields_m; + +interface + +type + sunStatePtr = ^sunState; + + sunState = record + rageMode, bigStep: boolean; + beforeRageSwitch: integer; + end; + +implementation +end. diff --git a/sun_m.pas b/sun_m.pas new file mode 100644 index 0000000..15be5d4 --- /dev/null +++ b/sun_m.pas @@ -0,0 +1,98 @@ +unit sun_m; + +interface + +uses creature_m; + +procedure InitRandomSun(var s: creature); +procedure UpdateSunState(var cr: creature); + +implementation + +uses arena_m, Math, math_m; + +const + SunSlowMovespeed = 1; + SunFastMovespeed = 2; + SunRageMovespeed = 4; + + SunStartDX = SunSlowMovespeed; + SunStartDY = SunSlowMovespeed; + SunSymbol = 's'; + MinToRageSwitch = 15; + MaxToRageSwitch = 25; + + MinToNormSwitch = 5; + MaxToNormSwitch = 15; + +procedure InitSun(var g: creature; x, y, sigdx, sigdy: integer); +begin + g.t := creatureSun; + g.curX := x; + g.curY := y; + g.dX := SunStartDX * sigdx; + g.dY := SunStartDY * sigdy; + g.movespeed := SunSlowMovespeed; + g.alive := true; + g.animation := 1; + new(g.sunf); + g.sunf^.bigStep:= true; + g.sunf^.rageMode := false; + g.sunf^.beforeRageSwitch := RandomLR(MinToRageSwitch, MaxToRageSwitch);; +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 SwitchRageMode(var cr: creature); +begin + cr.sunf^.rageMode := not cr.sunf^.rageMode; + if cr.sunf^.rageMode then + cr.sunf^.beforeRageSwitch := RandomLR(MinToNormSwitch, MaxToNormSwitch) + else + cr.sunf^.beforeRageSwitch := RandomLR(MinToRageSwitch, MaxToRageSwitch); + if cr.sunf^.rageMode then + begin + cr.dX := Signum(cr.dX, 0) * SunRageMovespeed; + cr.dY := Signum(cr.dY, 0) * SunRageMovespeed + end + else + begin + cr.dX := Signum(cr.dX, 0) * SunSlowMovespeed; + cr.dY := Signum(cr.dY, 0) * SunSlowMovespeed; + cr.sunf^.bigStep := false + end; +end; + +procedure UpdateSunState(var cr: creature); +begin + if cr.sunf^.beforeRageSwitch = 0 then + begin + SwitchRageMode(cr); + exit + end; + cr.sunf^.beforeRageSwitch := cr.sunf^.beforeRageSwitch - 1; + if cr.sunf^.rageMode then + exit; + cr.sunf^.bigStep := not cr.sunf^.bigStep; + if cr.sunf^.bigStep then + begin + cr.dX := Signum(cr.dX, 0) * SunFastMovespeed; + cr.dY := Signum(cr.dY, 0) * SunFastMovespeed + end + else + begin + cr.dX := Signum(cr.dX, 0) * SunSlowMovespeed; + cr.dY := Signum(cr.dY, 0) * SunSlowMovespeed + end +end; + +end. diff --git a/trace_m.pas b/trace_m.pas new file mode 100644 index 0000000..2c84073 --- /dev/null +++ b/trace_m.pas @@ -0,0 +1,193 @@ +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; + if IsOnTrace(prevX, prevY, t) then + TraceCrossed := true + else + TraceCrossed := false +end; + +end.