From 00befc8b4d9888fe640e3ab14da87398f321fd59 Mon Sep 17 00:00:00 2001 From: gre-ilya Date: Sat, 28 Feb 2026 22:20:24 +0500 Subject: [PATCH] feat/TD-016-add-hamster-animation --- src/Makefile | 8 +- src/arena_graphics_m.pas | 230 +++++++++++++++++++++++++++++++-------- src/arena_m.pas | 119 ++++++++------------ src/ascii_arts_m.pas | 142 +++++++++++++++++++++--- src/creature_m.pas | 11 +- src/debug_m.pas | 13 +++ src/enemy_packs_m.pas | 29 +++-- src/game_m.pas | 209 +++++++++++++++++++++-------------- src/ghost_m.pas | 1 + src/graphics_m.pas | 74 +++++-------- src/hamster_m.pas | 7 +- src/keys_m.pas | 150 ++++++++++++------------- src/level_m.pas | 10 +- src/sun_m.pas | 44 ++++++++ src/trace_m.pas | 5 +- 15 files changed, 692 insertions(+), 360 deletions(-) create mode 100644 src/sun_m.pas diff --git a/src/Makefile b/src/Makefile index 1fb0b41..176e6ff 100644 --- a/src/Makefile +++ b/src/Makefile @@ -2,17 +2,17 @@ FPC = fpc GAME_SRC = gohamster.pas arena_m.pas cell_m.pas creature_m.pas debug_m.pas \ ghost_m.pas graphics_m.pas hamster_m.pas keys_m.pas math_m.pas \ - trace_m.pas enemy_packs_m.pas + trace_m.pas enemy_packs_m.pas sun_m.pas all: gohamster play: gohamster - ./gohamster + ./gohamster gohamster: $(GAME_SRC) - $(FPC) $@.pas + $(FPC) $@.pas clean: - rm *.o *.ppu gohamster + rm *.o *.ppu gohamster diff --git a/src/arena_graphics_m.pas b/src/arena_graphics_m.pas index 635001b..d5c5176 100644 --- a/src/arena_graphics_m.pas +++ b/src/arena_graphics_m.pas @@ -9,28 +9,34 @@ const CaptureSymbol = '.'; procedure DrawAfterEnemyStep(var cr: creature; var a: arena); -procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena); +procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena); procedure DrawAliveEnemies(var e: creatureList); +procedure RedrawArea(var a: arena; arenaX, arenaY: integer); procedure DrawArenaBorders(var a: arena); procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char); procedure DrawCapturedCell(x, y: integer); procedure DrawArenaEdges; procedure DrawCompleteBar; +procedure DrawPause; +procedure DrawTrace(t: tracePtr); +procedure DrawHamster(var h: creature); procedure FillCellsCapture(var a: arena); procedure FillCompleteBar(s: integer); -procedure DrawCreature(var cr: creature); +procedure DrawSimpleCreature(var cr: creature); procedure DrawArenaCell(x, y: integer; var a: arena); procedure DrawInterface; 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; t: tracePtr); procedure EraseLifesNumber(n: integer); procedure EraseTrace(t: tracePtr; var a: arena); +procedure ErasePause; implementation -uses ascii_arts_m, crt, math_m; +uses ascii_arts_m, crt, math_m, hamster_m; const ArenaPauseLowerMarginY = 14; @@ -40,7 +46,7 @@ const InterfaceCellW = ScreenW div 3; InterfaceMarginX = InterfaceCellW div 4; InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1; - CompleteBarMarginY = 2; + CompleteBarMarginY = 4; CompleteBarMarginX = 5; CompleteBarX = ( InterfaceCellW * WidthCoefficient + BorderSize + CompleteBarMarginX @@ -51,12 +57,18 @@ const CompleteBarW = ( InterfaceCellW * WidthCoefficient - CompleteBarMarginX * 2 ); - BarWinX = CompleteBarW * 4 div 5; + 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; procedure DrawCompleteBar; begin @@ -76,7 +88,7 @@ begin FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '+') end; -procedure DrawCreature(var cr: creature); +procedure DrawSimpleCreature(var cr: creature); begin DrawFieldCell(cr.curX, cr.curY, cr.symbol) end; @@ -89,7 +101,7 @@ begin while tmp <> nil do begin if tmp^.cr^.alive then - DrawCreature(tmp^.cr^); + DrawSimpleCreature(tmp^.cr^); tmp := tmp^.next end end; @@ -100,38 +112,34 @@ var begin prevX := cr.curX - cr.dX; prevY := cr.curY - cr.dY; - if IsOnEdge(prevX, prevY) and a.captured[prevY][prevX] then - DrawFieldCell(prevX, prevY, CaptureSymbol) - else - if IsOnBorder(prevX, prevY, a) then - DrawFieldCell(prevX, prevY, BorderSymbol) - else - DrawFieldCell(prevX, prevY, ArenaSymbol); - DrawCreature(cr) + DrawArenaCell(prevX, prevY, a); + DrawSimpleCreature(cr) end; procedure DrawStepTrace(t: tracePtr; hamsterDelta: integer); var i: integer; begin - for i := 1 to HamsterDelta do + 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 hamster: creature; var t: tracePtr; var a: arena); +procedure DrawPreviousCell(var cr: creature; var a: arena); var prevX, prevY: integer; begin - prevX := hamster.curX - hamster.dX; - prevY := hamster.curY - hamster.dY; - if t = nil then - DrawArenaCell(prevX, prevY, a); - if (a.borders[prevY][prevX]) and (t = nil) then + prevX := cr.curX - cr.dX; + prevY := cr.curY - cr.dY; + DrawArenaCell(prevX, prevY, a); + {Maybe delete later} + if a.borders[prevY][prevX] then DrawFieldCell(prevX, prevY, BorderSymbol) + {Maybe delete later} end; procedure EraseStepTrace(var hamster: creature; t: tracePtr); @@ -152,31 +160,71 @@ begin end end; -procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena); -var - prevX, prevY: integer; +procedure EraseCreatureInterface(x: integer); begin - prevX := hamster.curX - hamster.dX; - prevY := hamster.curY - hamster.dY; - if IsOnEdge(prevX, prevY) and a.captured[prevY][prevX] then - DrawFieldCell(prevX, prevY, CaptureSymbol) - else - if IsOnBorder(prevX, prevY, a) then - DrawFieldCell(prevX, prevY, BorderSymbol) - else - DrawFieldCell(prevX, prevY, ArenaSymbol); - if t <> nil then - DrawStepTrace(t, hamster.movespeed); - DrawCreature(hamster); - DrawPreviousCell(hamster, t, a) + DrawFieldCell(x, 0, ' '); + DrawFieldCell(x, -1, ' '); + DrawFieldCell(x - 1, 0, ' '); + DrawFieldCell(x - 1, -1, ' ') end; -procedure FillPauseCells(var a: arena); +procedure RedrawInterfaceArea(x: integer); +begin + EraseCreatureInterface(x); + if x = 1 then + DrawLineY(1, InterfaceBarH - HamsterHeight, + HamsterHeight, BorderSymbol); + if x = InterfaceArenaCellX1 then + DrawLineY(InterfaceCellW * WidthCoefficient, + InterfaceBarH - HamsterHeight, + HamsterHeight, BorderSymbol); + if x = InterfaceArenaCellX2 then + DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, + InterfaceBarH - HamsterHeight, + HamsterHeight, BorderSymbol); + if x = ArenaW then + DrawLineY(ArenaW * CellSize * WidthCoefficient, + InterfaceBarH - HamsterHeight, + HamsterHeight, BorderSymbol) +end; + +procedure RedrawArea(var a: arena; arenaX, arenaY: integer); +begin + DrawArenaCell(arenaX, arenaY, a); + if arenaX - 1 > 0 then + DrawArenaCell(arenaX - 1, arenaY, a); + if arenaY - 1 > 0 then + DrawArenaCell(arenaX, arenaY - 1, a); + if arenaY - 2 > 0 then + DrawArenaCell(arenaX, arenaY - 2, a); + if (arenaX - 1 > 0) and (arenaY - 1 > 0) then + DrawArenaCell(arenaX - 1, arenaY - 1, a); + if (arenaX - 1 > 0) and (arenaY - 2 > 0) then + DrawArenaCell(arenaX - 1, arenaY - 2, a); + if arenaY = 1 then + RedrawInterfaceArea(arenaX) +end; + +procedure DrawAfterHamsterStep(var h: creature; var t: tracePtr; var a: arena); +var + arenaX, arenaY: integer; +begin + arenaX := h.curX - h.dX; + arenaY := h.curY - h.dY; + RedrawArea(a, arenaX, arenaY); + if t <> nil then + DrawTrace(t); + {DrawStepTrace(t, h.movespeed);} + 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 := ArenaPauseUpperMarginY to (ArenaH - ArenaPauseLowerMarginY) do - for j := (1 + ArenaPauseMarginX) to (ArenaW - ArenaPauseMarginX) do + for i := y1 to y2 do + for j := x1 to x2 do if a.borders[i][j] then DrawFieldCell(j, i, BorderSymbol) else @@ -184,6 +232,26 @@ begin 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); + DrawAscii(PauseX, PauseY, PauseHeight, PauseAscii) +end; + procedure DrawTrace(t: tracePtr); begin if t <> nil then @@ -250,17 +318,34 @@ end; procedure DrawLevel(var level: levelState; life, score: integer); begin DrawInterface; - FillPauseCells(level.a); + 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, screenX, screenY: integer; @@ -276,6 +361,16 @@ begin GotoXY(1, 1) end; +procedure DrawFieldAscii(arenaX, arenaY, h, w: integer; + var a: array of string); +var + screenX, screenY: integer; +begin + screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient; + screenY := InterfaceBarH + (arenaY - 1) * CellSize; + DrawAscii(screenX, screenY, h, a) +end; + procedure DrawArenaEdges; begin DrawRectangle(1, InterfaceBarH, @@ -388,4 +483,51 @@ begin end end; +procedure DrawHamsterRunX(var h: creature); +var + xIdx: integer; +begin + xIdx := h.curX div HamsterMovespeed mod HamsterRunNX + 1; + if h.dX > 0 then + DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2, + h.curY - HamsterHeight div 2, + HamsterHeight, HamsterWidth, + HamsterRightAscii[xIdx]); + if h.dX < 0 then + DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2, + h.curY - HamsterHeight div 2, + HamsterHeight, HamsterWidth, + HamsterLeftAscii[xIdx]) +end; + +procedure DrawHamsterRunY(var h: creature); +var + yIdx: integer; +begin + yIdx := h.curY div HamsterMovespeed mod HamsterRunNY + 1; + if h.dY > 0 then + DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2, + h.curY - HamsterHeight div 2, + HamsterHeight, HamsterWidth, + HamsterDownAscii[yIdx]); + if h.dY < 0 then + DrawFieldAscii(h.curX - HamsterWidth div WidthCoefficient div 2, + h.curY - HamsterHeight div 2, + HamsterHeight, HamsterWidth, + HamsterUpAscii[yIdx]) +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); + if h.dX <> 0 then + DrawHamsterRunX(h); + if h.dY <> 0 then + DrawHamsterRunY(h); +end; + end. diff --git a/src/arena_m.pas b/src/arena_m.pas index ae420c7..e5816d4 100644 --- a/src/arena_m.pas +++ b/src/arena_m.pas @@ -306,15 +306,25 @@ begin StepOnTrace := idx > PreviousTraceIdx end; -function StepBeyondEdge(var cr: creature): boolean; +function StepBeyondEdgeX(var cr: creature): boolean; begin - StepBeyondEdge := + StepBeyondEdgeX := (cr.dX > 0) and (cr.curX = ArenaW) or - (cr.dX < 0) and (cr.curX = 1) 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 RandomBool: boolean; begin if Random(RandomOneToOne) = 1 then @@ -410,7 +420,7 @@ begin MakeStep(h); if FieldToEdge(h, t, a) or IsOnField(h, t, a) then ChangeHamsterTrace(h, t); - DrawAfterStep(h, t, a) + DrawAfterHamsterStep(h, t, a) end; function GhostShouldTurn(var g: creature; var a: arena): boolean; @@ -419,88 +429,35 @@ var begin nextX := g.curX + g.dX; nextY := g.curY + g.dY; - GhostShouldTurn := IsOnEdge(nextX, nextY) or a.borders[nextY][nextX] + GhostShouldTurn := StepBeyondEdge(g) or + a.borders[g.curY][g.curX] and a.captured[nextY][nextX] end; -function BorderY(nextX, nextY: integer; var a: arena): boolean; +function VerticalBorder(nextX, nextY: integer; var a: arena): boolean; begin - BorderY := + VerticalBorder := a.borders[nextY][nextX] and (a.borders[nextY - 1][nextX] or a.borders[nextY + 1][nextX]) end; -function BorderX(nextX, nextY: integer; var a: arena): boolean; +function HorizontalBorder(nextX, nextY: integer; var a: arena): boolean; begin - BorderX := + 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 := BorderX(x, y, a) and BorderY(x, y, a) -end; - -function IsConcaveCorner(x, y: integer; var a: arena): boolean; -begin - IsConcaveCorner := - a.borders[y][x - 1] and a.borders[y + 1][x] or - a.borders[y][x - 1] and a.borders[y - 1][x] or - a.borders[y][x + 1] and a.borders[y + 1][x] or - a.borders[y][x + 1] and a.borders[y - 1][x] -end; - -function IsConvexCorner(var cr: creature; var a: arena): boolean; -var - x, y, nextX, nextY: integer; -begin - x := cr.curX; - y := cr.curY; - nextX := x + cr.dX; - nextY := y + cr.dY; - IsConvexCorner := - IsCorner(nextX, nextY, a) and - not IsOnEdge(nextX, nextY) and - not IsConcaveCorner(x, y, a) -end; - -procedure CornerTurn(var cr: creature; var a: arena); -var - x, y, nextX, nextY: integer; -begin - x := cr.curX; - y := cr.curY; - nextX := x + cr.dX; - nextY := y + cr.dY; - if not a.borders[y][nextX] and not a.borders[nextY][x] then - begin - cr.dX := cr.dX * -1; - cr.dY := cr.dY * -1 - end - else - if a.borders[y][nextX] then - cr.dX := cr.dX * -1 - else - cr.dY := cr.dY * -1 + IsCorner := HorizontalBorder(x, y, a) and VerticalBorder(x, y, a) end; procedure TurnGhost(var g: creature; var a: arena); -var - nextX, nextY: integer; begin - nextX := g.curX + g.dX; - nextY := g.curY + g.dY; - if IsConvexCorner(g, a) then - begin - CornerTurn(g, a) - end - else - begin - if OnEdgeX(nextX) or BorderY(nextX, nextY, a) then - g.dX := g.dX * -1; - if OnEdgeY(nextY) or BorderX(nextX, nextY, a) then - g.dY := g.dY * -1 - end + 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 MakeEnemyStep(var e, h: creature; t: tracePtr; var a: arena); @@ -528,6 +485,26 @@ begin 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; @@ -536,10 +513,10 @@ begin tmp := e.first; while tmp <> nil do begin - while tmp^.cr^.alive and GhostShouldTurn(tmp^.cr^, a) and + while tmp^.cr^.alive and EnemyShouldTurn(tmp^.cr^, a) and (turnCnt < MaxTurnAttempts) do begin - TurnGhost(tmp^.cr^, a); + TurnEnemy(tmp^.cr^, a); turnCnt := turnCnt + 1 end; turnCnt := 0; @@ -555,7 +532,7 @@ begin tmp := e.first; while tmp <> nil do begin - if tmp^.cr^.alive and not GhostShouldTurn(tmp^.cr^, a) then + if tmp^.cr^.alive and not EnemyShouldTurn(tmp^.cr^, a) then MakeEnemyStep(tmp^.cr^, h, t, a); tmp := tmp^.next end diff --git a/src/ascii_arts_m.pas b/src/ascii_arts_m.pas index c983f4e..de592a8 100644 --- a/src/ascii_arts_m.pas +++ b/src/ascii_arts_m.pas @@ -78,7 +78,7 @@ const ) ); - GameMenuHeight = 44; + GameMenuHeight = 36; GameMenuScreen: array[1..GameMenuHeight] of string = ( ' _____ _ _ _ _', ' / ____| | | | | | | | |', @@ -102,14 +102,6 @@ const '|_| \_|\___| \_/\_/ \_____|\__,_|_| |_| |_|\___|', '', '', - ' _ _ _ _ _____', - '| | | (_) | | / ____|', - '| |__| |_ __ _| |__ | (___ ___ ___ _ __ ___', - '| __ | |/ _` | ''_ \ \___ \ / __/ _ \| ''__/ _ \', - '| | | | | (_| | | | | ____) | (_| (_) | | | __/', - '|_| |_|_|\__, |_| |_| |_____/ \___\___/|_| \___|', - ' __/ |', - ' |___/', ' _ __ _____ __', '| |/ / |_ _| / _|', '| '' / ___ _ _ | | _ __ | |_ ___', @@ -198,6 +190,109 @@ const ' |___|', ' / \' ); + + HamsterRunNX = 4; + HamsterRightAscii: array[1..HamsterRunNX] + of array[1..HamsterHeight] of string = ( + ( + ' _/)', + ' ( 0)', + ' | \_', + ' |___|', + '-- \' + ), + ( + ' _/)', + ' ( 0)', + ' | |_|', + ' |___|', + ' |>' + ), + ( + ' _/)', + ' ( 0)', + ' |/_ |-', + ' |___|', + '-- \' + ), + ( + ' _/) ', + ' ( 0)', + ' | |_|', + ' |___|', + ' >| ' + ) + ); + + HamsterLeftAscii: array[1..HamsterRunNX] + of array[1..HamsterHeight] of string = ( + ( + ' (\_ ', + ' (0 )', + ' _/ |', + ' |___|', + ' / --' + ), + ( + ' (\_ ', + ' (0 )', + ' |_| |', + ' |___|', + ' <|' + ), + ( + ' (\_', + ' (0 )', + '-| _\|', + ' |___|', + ' / --' + ), + ( + ' (\_', + ' (0 )', + ' |_| |', + ' |___|', + ' |<' + ) + ); + + HamsterRunNY = 2; + HamsterDownAscii: array[1..HamsterRunNY] + of array[1..HamsterHeight] of string = ( + ( + ' (\_/)', + '( 0_o )', + '\----- ', + ' |___|\', + ' - |' + ), + ( + ' (\_/)', + '( o_0 )', + ' -----/', + '/|___|', + ' | -' + ) + ); + + HamsterUpAscii: array[1..HamsterRunNY] + of array[1..HamsterHeight] of string = ( + ( + ' (\_/)', + '( )', + '\----- ', + ' |_*_|\', + ' - |' + ), + ( + ' (\_/)', + '( )', + ' -----/', + '/|_*_|', + ' | -' + ) + ); + HamsterGGAscii: array[1..HamsterHeight] of string = ( ' (\_/)', '( G_G )', @@ -205,6 +300,7 @@ const ' |___|', ' / \' ); + HamsterLifesAscii: array[1..HamsterHeight] of string = ( ' (\_/) ', '( 0_0 ) \ /', @@ -213,9 +309,8 @@ const ' / \ ' ); - GameOverHeight = 40; - GameOverWidth = 62; + GameOverWidth = 63; GameOverScreen: array[1..GameOverHeight] of string = ( ' _____ __ __ ______ ', ' / ____| /\ | \/ | ____|', @@ -257,8 +352,7 @@ const '| |_ \__, | _| |\___||___/ \ \ | |_ |_| |_| _| |\___/', '|___|=====/ |=|___| \_\ |___|=========|___|', ' |___/' -); - + ); KeyInfoHeight = 42; KeyInfoWidth = 98; @@ -305,7 +399,7 @@ const ' \___||___/\___| | .__/ \__,_|\__,_|___/\___|', '================ | |', ' |_|' -); + ); LevelAnnounceHeight = 6; LevelAnnounceWidth = 24; @@ -318,6 +412,26 @@ const '|______\___| \_/ \___|_|' ); + GameCompleteHeight = 14; + GameCompleteWidth = 74; + GameCompleteScoreWidth = 50; + GameComplete: array[1..GameCompleteHeight] of string = ( +' _____ _ _ _ ', +' / ____| | | | | | |', +'| | __ __ _ _ __ ___ ___ ___ ___ _ __ ___ _ __ | | ___| |_ ___| |', +'| | |_ |/ _` | ''_ ` _ \ / _ \ / __/ _ \| ''_ ` _ \| ''_ \| |/ _ \ __/ _ \ |', +'| |__| | (_| | | | | | | __/ | (_| (_) | | | | | | |_) | | __/ || __/_|', +' \_____|\__,_|_| |_| |_|\___| \___\___/|_| |_| |_| .__/|_|\___|\__\___(_)', +' | |', +' |_|', +'__ __', +'\ \ / / _ ', +' \ \_/ /__ _ _ _ __ ___ ___ ___ _ __ ___(_)', +' \ / _ \| | | | ''__| / __|/ __/ _ \| ''__/ _ \', +' | | (_) | |_| | | \__ \ (_| (_) | | | __/_ ', +' |_|\___/ \__,_|_| |___/\___\___/|_| \___(_)' + ); + implementation end. diff --git a/src/creature_m.pas b/src/creature_m.pas index 083037a..5a53e67 100644 --- a/src/creature_m.pas +++ b/src/creature_m.pas @@ -9,7 +9,7 @@ type creaturePtr = ^creature; creature = record - curX, curY, dX, dY, moveSpeed: integer; + curX, curY, dX, dY, moveSpeed, animation: integer; symbol: char; alive: boolean; t: creatureType; @@ -32,6 +32,7 @@ procedure AppendCreature(var lst: creatureList; c: creaturePtr); procedure DisposeCreatureList(var lst: creatureList); procedure KillCreature(var cr: creature); procedure MakeStep(var cr: creature); +procedure DrawCreature(var cr: creature); procedure InitCreatureList(var lst: creatureList); procedure StopCreature(var cr: creature); @@ -99,4 +100,12 @@ begin cr.dY := 0 end; +procedure DrawCreature(var cr: creature); +begin + case cr.t of + creatureHamster: + DrawHamster(cr); + end +end; + end. diff --git a/src/debug_m.pas b/src/debug_m.pas index 1fd9cbc..d1c4290 100644 --- a/src/debug_m.pas +++ b/src/debug_m.pas @@ -7,6 +7,7 @@ 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); @@ -96,4 +97,16 @@ begin 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/enemy_packs_m.pas b/src/enemy_packs_m.pas index 7b4a8f5..b332b20 100644 --- a/src/enemy_packs_m.pas +++ b/src/enemy_packs_m.pas @@ -13,24 +13,24 @@ procedure AppendEnemies(var lst: creatureList; t: enemyPackType); implementation -uses ghost_m; +uses ghost_m, sun_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 - ); -} + + { + 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 @@ -46,7 +46,16 @@ begin 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); diff --git a/src/game_m.pas b/src/game_m.pas index 962112e..5f8e0d4 100644 --- a/src/game_m.pas +++ b/src/game_m.pas @@ -6,10 +6,12 @@ interface uses level_m, enemy_packs_m; type - state = (gameLevelAnnounce, gameExit, gameMenu, gameStartLevel, gameScore, - gameKeyInfo, gamePause, gameContinueLevel, gameOver, gameComplete, - gameLevelComplete, gameSetRecord); - menuState = (menuNewGame, menuHighScore, menuKeyInfo, menuContinue); + state = ( + gameLevelAnnounce, gameExit, gameMenu, gameStartLevel, gameKeyInfo, + gamePause, gameUnpauseLevel, gameOver, gameComplete, + gameLevelComplete, gameLevelLoop, gameContinueLevel + ); + menuState = (menuNewGame, menuKeyInfo, menuContinue); exitState = (exitYes, exitNo); gameState = record curExit: exitState; @@ -17,7 +19,7 @@ type curState: state; level, score, life: integer; enemyPack: enemyPackType; - shutdown, continueAllowed: boolean; + shutdown, newGame, unpause, levelInited, skipScene: boolean; end; procedure DecreaseLife(var life: integer); @@ -29,15 +31,15 @@ procedure MainLoop(var g: gameState); implementation uses arena_m, arena_graphics_m, crt, creature_m, ghost_m, graphics_m, - hamster_m, keys_m, trace_m; + hamster_m, keys_m, trace_m, debug_m; const - KeyDelayMs = 22; - MoveDelayMs = 100; + KeyDelayMs = 25; + MoveDelayMs = 120; EraseLifeThreshold = 10; AnnounceDelayMs = 1500; LevelCompleteDelayMs = 1500; - LevelCount = 10; + LevelCount = 20; StartLifeN = 3; procedure DecreaseLife(var life: integer); @@ -50,82 +52,80 @@ end; procedure InitGame(var g: gameState); begin - g.continueAllowed := false; g.curMenu := menuNewGame; g.curState := gameMenu; - g.level := 1; g.enemyPack := enemyPack1; g.score := 0; g.shutdown := false; + g.newGame := false; + g.skipScene := false; g.life := StartLifeN - { - g.slowBonus := StartSlowBonus; - g.speedBonus := StartSpeedBonus - } end; -procedure ShowExit(var g: gameState); +procedure RunExitState(var g: gameState; var level: levelState); begin DrawExit(g); - while g.curState = gameExit do + while (g.curState = gameExit) and not g.shutdown do begin delay(KeyDelayMs); if keypressed then - HandleExitKey(g) + HandleKey(g, level) end; EraseExit end; -procedure ShowScore(var g: gameState); -begin - {DrawHighScore;} - while g.curState = gameScore do - begin - delay(KeyDelayMs); - if keypressed then - HandleScoreKey(g) - end; -end; - -procedure ShowKeyInfo(var g: gameState); +procedure RunInfoState(var g: gameState; var level: levelState); begin DrawKeyInfo; - while g.curState = gameKeyInfo do + while (g.curState = gameKeyInfo) and not g.shutdown do begin delay(KeyDelayMs); if keypressed then - HandleInfoKey(g) + HandleKey(g, level) end; EraseKeyInfo end; -procedure PauseLevel(var g: gameState); +procedure RunPauseState(var g: gameState; var level: levelState); begin - DrawPause(g); - while g.curState = gamePause do + DrawPause; + while (g.curState = gamePause) and not g.shutdown do begin delay(KeyDelayMs); if keypressed then - HandlePauseKey(g) + HandleKey(g, level) end; if g.curState = gameMenu then EraseLevel; - if g.curState = gameContinueLevel then - ErasePause(g) + if g.curState = gameUnpauseLevel then + begin + DrawLevelUnpause(level); + level.unpause := true + end end; -procedure ShowGameOver(var g: gameState; var level: levelState); +procedure RunGameOverState(var g: gameState; var level: levelState); begin DrawGameOver; - while g.curState = gameOver do + DisposeCreatureList(level.enemyList); + g.score := 0; + g.life := StartLifeN; + while (g.curState = gameOver) and not g.shutdown do begin delay(KeyDelayMs); if keypressed then - HandleGameOverKey(g) + HandleKey(g, level) end; EraseGameOver; - if g.curState = gameContinueLevel then + 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); @@ -141,28 +141,32 @@ begin KillCapturedEnemies(level.a, level.enemyList) end; -procedure GameNextLevel(var g: gameState); +procedure GameNextLevel(var g: gameState; var level: levelState); begin - g.curState := gameLevelComplete; g.level := g.level + 1; - if g.level = LevelCount then + 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; var breakF: boolean); +GameKillHamster(var g: gameState; var level: levelState); begin if g.life <= 0 then begin g.curState := gameOver; - EraseLevel; - breakF := true; Exit end; DecreaseLife(g.life); KillHamster(level.h, level.t, level.a); + DrawAliveEnemies(level.enemyList); level.h.alive := true end; @@ -174,17 +178,15 @@ begin begin delay(KeyDelayMs); if keypressed then - HandleLevelKey(level.h, level.a, level.t, g); + HandleKey(g, level); if g.curState = gamePause then break end end; procedure LevelLoop(var g: gameState; var level: levelState); -var - breakF: boolean = false; begin - while level.continueLevel do + while (g.curState = gameLevelLoop) and not g.shutdown do begin PollGameKeys(g, level); if g.curState = gamePause then @@ -193,42 +195,67 @@ begin GameCutPart(g, level); if IsLevelComplete(level) then begin - GameNextLevel(g); + GameNextLevel(g, level); + if g.curState = gameComplete then + EraseLevel; break end; {Found bug: ghost didn't die in killed zone} TurnStubbornEnemies(level.a, level.enemyList); MakeEnemySteps(level.a, level.h, level.t, level.enemyList); if not level.h.alive then - GameKillHamster(g, level, breakF); - if breakF then - break; + GameKillHamster(g, level); + if g.curState = gameOver then + begin + EraseLevel; + break + end; 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) + MakeHamsterStep(level.h, level.t, level.a); + DrawCreature(level.h) {Draw all creatures here} end end; -procedure StartLevel(var g: gameState; var level: levelState); +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); - LevelLoop(g, level) + g.curState := gamePause end; -procedure ShowMenu(var g: gameState); +procedure RunMenuState(var g: gameState; var level: levelState); var prevMenu: boolean = false; begin g.curState := gameMenu; - while g.curState = gameMenu do + while (g.curState = gameMenu) and not g.shutdown do begin if (g.curState = gameMenu) and not prevMenu then begin @@ -237,7 +264,7 @@ begin end; delay(KeyDelayMs); if keypressed then - HandleMenuKey(g); + HandleKey(g, level); if (g.curState <> gameMenu) and prevMenu then begin EraseMenu; @@ -249,43 +276,59 @@ begin end end; -procedure AnnounceLevel(var g: gameState); +procedure RunAnnounceState(var g: gameState; var level: levelState); var i: integer; - skip: boolean = false; begin DrawAnnounce(g.level); for i := 1 to AnnounceDelayMs div KeyDelayMs do begin delay(KeyDelayMs); if keypressed then - HandleSceneKey(skip); - if skip 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 ShowLevelComplete(var g: gameState; var lvl: levelState); +procedure RunLevelCompleteState(var g: gameState; var level: levelState); var i: integer; - skip: boolean = false; begin - FillCellsCapture(lvl.a); - DrawCreature(lvl.h); + FillCellsCapture(level.a); + DrawCreature(level.h); for i := 1 to LevelCompleteDelayMs div KeyDelayMs do begin delay(KeyDelayMs); if keypressed then - HandleSceneKey(skip); - if skip 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; @@ -293,25 +336,27 @@ begin while not g.shutdown do case g.curState of gameLevelAnnounce: - AnnounceLevel(g); + RunAnnounceState(g, level); gameExit: - ShowExit(g); - gameScore: - ShowScore(g); + RunExitState(g, level); gameKeyInfo: - ShowKeyInfo(g); + RunInfoState(g, level); gamePause: - PauseLevel(g); + RunPauseState(g, level); gameStartLevel: - StartLevel(g, level); + RunLevelState(g, level); + gameUnpauseLevel: + UnpauseLevel(g, level); gameContinueLevel: {Maybe here should be gameStartLevel} ContinueLevel(g, level); gameOver: - ShowGameOver(g, level); + RunGameOverState(g, level); gameMenu: - ShowMenu(g); + RunMenuState(g, level); gameLevelComplete: - ShowLevelComplete(g, level); + RunLevelCompleteState(g, level); + gameComplete: + RunGameCompleteState(g, level) end; EraseAll end; diff --git a/src/ghost_m.pas b/src/ghost_m.pas index fe31689..e1f1b0b 100644 --- a/src/ghost_m.pas +++ b/src/ghost_m.pas @@ -25,6 +25,7 @@ begin g.dY := GhostStartDY * sigdy; g.movespeed := GhostMovespeed; g.alive := true; + g.animation := 1; g.symbol := GhostSymbol end; diff --git a/src/graphics_m.pas b/src/graphics_m.pas index 3d2295c..982fb2d 100644 --- a/src/graphics_m.pas +++ b/src/graphics_m.pas @@ -21,6 +21,7 @@ procedure DrawDigit(x, y, digit: integer); procedure DrawExitState(s: exitState); 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); @@ -28,7 +29,6 @@ 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 DrawPause(var g: gameState); procedure EraseAll; procedure EraseAnnounce(lvl: integer); procedure EraseExit; @@ -39,7 +39,6 @@ procedure EraseLevel; procedure EraseMenu; procedure EraseMenuState(s: menuState); procedure EraseRectangle(x, y, w, h: integer); -procedure ErasePause(var g: gameState); procedure FillRectangle(x, y, w, h: integer; ch: char); implementation @@ -51,13 +50,12 @@ const BigLetterWidth = 8; BorderN = 2; DecimalDelimiter = 10; - GameNameY = 12; + GameNameY = 16; NameHeightPadding = 8; NewGameY = GameNameY + GameNameHeight + NameHeightPadding; MenuHeightPadding = 2; - HighScoreY = NewGameY + NewGameHeight + MenuHeightPadding; - MenuInfoY = HighScoreY + HighScoreHeight; - ContinueY = MenuInfoY + MenuInfoHeight; + MenuInfoY = NewGameY + NewGameHeight + MenuHeightPadding; + ContinueY = MenuInfoY + MenuInfoHeight; ExitGameY = (ScreenH - ExitScreenHeight) div 2 - MenuHeightPadding; ExitYesY = ExitGameY + ExitHeight - 1 + MenuHeightPadding; ExitHamsterY = ExitYesY; @@ -66,30 +64,35 @@ const MenuHamsterX = GameNameX - HamsterWidth - MenuWidthPadding; ExitYesX = MenuHamsterX; ExitNoX = ScreenW * WidthCoefficient - ExitYesX - NoWidth; - GameOverX = ScreenW * WidthCoefficient div 2 - GameNameWidth div 2; - GameOverY = ScreenH div 2 - GameOverHeight div 2; + GameOverX = (ScreenW * WidthCoefficient - GameNameWidth) div 2; + GameOverY = (ScreenH - GameOverHeight) div 2; HamsterNoX = ExitNoX - HamsterWidth - MenuWidthPadding; HamsterYesX = ExitYesX - HamsterWidth - MenuWidthPadding; - KeyInfoX = ScreenW * WidthCoefficient div 2 - KeyInfoWidth div 2; - KeyInfoY = ScreenH div 2 - KeyInfoHeight div 2 - 1; + KeyInfoX = (ScreenW * WidthCoefficient - KeyInfoWidth) div 2; + KeyInfoY = (ScreenH - KeyInfoHeight) div 2; LetterWidth = 5; - PauseXPadding = 3 * WidthCoefficient; - PauseX = (ScreenW * WidthCoefficient - PauseWidth) div 2; - PauseYPadding = 1; - PauseY = (ScreenH - PauseHeight) div 2; LevelNumberMargin = 3; + GameCompleteX = (ScreenW * WidthCoefficient - GameCompleteWidth) div 2; + GameCompleteY = (ScreenH - GameCompleteHeight) div 2; + GameCompleteScoreX = GameCompleteX + GameCompleteScoreWidth + 3; + GameCompleteScoreY = GameCompleteY + 9; var firstMenuDraw: boolean = true; procedure DrawAscii(x, y, h: integer; var a: array of string); var - i: integer; + i, j: integer; begin for i := 1 to h do begin - GotoXY(x, y + i - 1); - write(a[i - 1]) + for j := 1 to Length(a[i - 1]) do + begin + if x + j - 1 < 0 then + continue; + GotoXY(x + j - 1, y + i - 1); + write(a[i - 1][j]) + end end; GotoXY(1, 1) end; @@ -158,9 +161,6 @@ begin menuNewGame: DrawAscii(MenuHamsterX, NewGameY + 1, HamsterHeight, HamsterStayAscii); - menuHighScore: - DrawAscii(MenuHamsterX, HighScoreY + 1, - HamsterHeight, HamsterStayAscii); menuKeyInfo: DrawAscii(MenuHamsterX, MenuInfoY + 1, HamsterHeight, HamsterStayAscii); @@ -196,7 +196,7 @@ begin firstMenuDraw := not firstMenuDraw end; DrawAscii(GameNameX, y, GameMenuHeight, GameMenuScreen); - if not g.continueAllowed then + if not g.levelInited then DrawLineX(GameNameX, ContinueY + ContinueHeight div 2, ContinueWidth, '-'); DrawMenuState(g.curMenu) @@ -220,20 +220,6 @@ begin FillRectangle(x, y, w, h, ' ') end; -procedure DrawPause(var g: gameState); -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); - DrawAscii(PauseX, PauseY, PauseHeight, PauseAscii) -end; - procedure EraseAll; begin EraseRectangle(1, 1, ScreenW * WidthCoefficient, ScreenH) @@ -289,9 +275,6 @@ begin menuNewGame: EraseRectangle(MenuHamsterX, NewGameY + 1, HamsterWidth, HamsterHeight); - menuHighScore: - EraseRectangle(MenuHamsterX, HighScoreY + 1, - HamsterWidth, HamsterHeight); menuKeyInfo: EraseRectangle(MenuHamsterX, MenuInfoY + 1, HamsterWidth, HamsterHeight); @@ -301,14 +284,6 @@ begin end end; -procedure ErasePause(var g: gameState); -begin - EraseRectangle(PauseX - PauseXPadding, - PauseY - PauseYPadding, - PauseWidth + PauseXPadding * 2, - PauseHeight + PauseYPadding * 2 + 1) -end; - type stackIntPtr = ^stackIntItem; @@ -404,4 +379,11 @@ begin EraseRectangle(x, AnnounceY, w, LevelAnnounceHeight) end; +procedure DrawGameComplete(score: integer); +begin + DrawAscii(GameCompleteX, GameCompleteY, GameCompleteHeight, GameComplete); + DrawNumber(GameCompleteScoreX, GameCompleteScoreY, score) +end; + end. + diff --git a/src/hamster_m.pas b/src/hamster_m.pas index 4de5857..31eb792 100644 --- a/src/hamster_m.pas +++ b/src/hamster_m.pas @@ -2,7 +2,7 @@ unit hamster_m; interface -uses arena_graphics_m, arena_m, creature_m, trace_m; +uses arena_m, creature_m, trace_m; const HamsterStartX = 5; @@ -17,7 +17,7 @@ procedure KillHamster(var h: creature; var t: tracePtr; var a: arena); implementation -uses graphics_m; +uses arena_graphics_m, graphics_m; procedure InitHamster(var cr: creature); begin @@ -35,7 +35,8 @@ procedure KillHamster(var h: creature; var t: tracePtr; var a: arena); var traceStart: tracePtr; begin - DrawFieldCell(h.curX, h.curY, ArenaSymbol); + {DrawFieldCell(h.curX, h.curY, ArenaSymbol);} + RedrawArea(a, h.curX, h.curY); EraseTrace(t, a); DrawArenaCell(h.curX, h.curY, a); GetStart(traceStart, t); diff --git a/src/keys_m.pas b/src/keys_m.pas index 167d398..3c2517f 100644 --- a/src/keys_m.pas +++ b/src/keys_m.pas @@ -2,16 +2,19 @@ unit keys_m; interface -uses crt, creature_m, arena_m, game_m, trace_m, hamster_m, debug_m; +uses crt, creature_m, arena_m, game_m, trace_m, hamster_m, debug_m, level_m; const ArrowDownOrd = -80; ArrowLeftOrd = -75; ArrowRightOrd = -77; ArrowUpOrd = -72; + CtrlCOrd = 3; - EnterOrd = 13; + CtrlZOrd = 26; + EscOrd = 27; + EnterOrd = 13; LowerNOrd = 110; LowerYOrd = 121; SpaceOrd = 32; @@ -21,7 +24,6 @@ const OneOrd = 49; TwoOrd = 50; ThreeOrd = 51; - FourOrd = 52; UpperQOrd = 81; LowerQOrd = 113; @@ -32,15 +34,7 @@ const { Debug } procedure GetKey(var keyCode: integer); -procedure HandleSceneKey(var f: boolean); -procedure HandleExitKey(var g: gameState); -procedure HandleLevelKey(var h: creature; var a: arena; - var t: tracePtr; var g: gameState); -procedure HandleMenuKey(var g: gameState); -procedure HandleInfoKey(var g: gameState); -procedure HandleGameOverKey(var g: gameState); -procedure HandleScoreKey(var g: gameState); -procedure HandlePauseKey(var g: gameState); +procedure HandleKey(var g: gameState; var level: levelState); implementation @@ -62,7 +56,7 @@ begin end end; -procedure ChangeHamsterDelta(k: integer; var h: creature); +procedure ChangeHamsterDelta(var h: creature; k: integer); begin h.dX := 0; h.dY := 0; @@ -80,42 +74,34 @@ begin end end; -procedure HandleLevelKey(var h: creature; var a: arena; - var t: tracePtr; var g: gameState); -var - k: integer; +procedure HandleLevelKey(var g: gameState; var level: levelState; k: integer); begin - GetKey(k); {DEBUG} if k = BOrd then - Print(a.borders); + Print(level.a.borders); if k = COrd then - Print(a.captured); + Print(level.a.captured); if k = LOrd then begin GotoXY(2, 60); write(' '); GotoXY(2, 60); - writeln(GetLength(t)); + 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(k, h) + ChangeHamsterDelta(level.h, k) end; if k = EscOrd then g.curState := gamePause - { - if k = CtrlCOrd then - continueLevel := false - } end; procedure PreviousMenuState(var g: gameState); begin - if (g.curMenu = menuNewGame) and not g.continueAllowed then + if (g.curMenu = menuNewGame) and not g.levelInited then g.curMenu := menuKeyInfo else if g.curMenu = menuNewGame then @@ -126,7 +112,7 @@ end; procedure NextMenuState(var g: gameState); begin - if (g.curMenu = menuKeyInfo) and not g.continueAllowed or + if (g.curMenu = menuKeyInfo) and not g.levelInited or (g.curMenu = menuContinue) then begin g.curMenu := menuNewGame @@ -137,7 +123,7 @@ begin end end; -procedure ChangeMenuState(k: integer; var g: gameState); +procedure ChangeMenuState(var g: gameState; k: integer); begin case k of ArrowUpOrd: @@ -147,20 +133,19 @@ begin end end; -procedure ChooseMenuNum(k: integer; var g: gameState); +procedure ChooseMenuNum(var g: gameState; k: integer); begin - if (k = FourOrd) and not g.continueAllowed then + 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 := gameScore; - ThreeOrd: g.curState := gameKeyInfo; - FourOrd: + ThreeOrd: g.curState := gameContinueLevel end end; @@ -169,11 +154,10 @@ procedure ChooseMenuMarked(var g: gameState); begin case g.curMenu of menuNewGame: begin + g.newGame := true; g.level := 1; g.curState := gameLevelAnnounce end; - menuHighScore: - g.curState := gameScore; menuKeyInfo: g.curState := gameKeyInfo; menuContinue: @@ -181,33 +165,27 @@ begin end end; -procedure HandleMenuKey(var g: gameState); -var - k: integer; +procedure HandleMenuKey(var g: gameState; k: integer); begin - GetKey(k); if (k = ArrowUpOrd) or (k = ArrowDownOrd) then begin EraseMenuState(g.curMenu); - ChangeMenuState(k, g); + ChangeMenuState(g, k); DrawMenuState(g.curMenu) end; - if (k = OneOrd) or (k = TwoOrd) or (k = ThreeOrd) or (k = FourOrd) then - ChooseMenuNum(k, g); + 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); -var - k: integer; +procedure HandleGameOverKey(var g: gameState; k: integer); begin - GetKey(k); case k of UpperYOrd, LowerYOrd: - g.curState := gameContinueLevel; + g.curState := gameLevelAnnounce; UpperNOrd, LowerNOrd: g.curState := gameMenu; end @@ -223,11 +201,8 @@ begin end end; -procedure HandleExitKey(var g: gameState); -var - k: integer; +procedure HandleExitKey(var g: gameState; k: integer); begin - GetKey(k); if (k = ArrowLeftOrd) or (k = ArrowRightOrd) then begin EraseExitState(g.curExit); @@ -249,48 +224,63 @@ begin g.curState := gameMenu end; -procedure HandlePauseKey(var g: gameState); -var - k: integer; +procedure HandlePauseKey(var g: gameState; k: integer); begin - GetKey(k); if (k = EscOrd) or (k = SpaceOrd) then - g.curState := gameContinueLevel; + g.curState := gameUnpauseLevel; if (k = UpperQOrd) or (k = LowerQOrd) then - g.curState := gameMenu; + g.curState := gameMenu end; -procedure HandleInfoKey(var g: gameState); -var - k: integer; +procedure HandleInfoKey(var g: gameState; k: integer); begin - GetKey(k); if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) or (k = UpperQOrd) or (k = LowerQOrd) then begin - g.curState := gameMenu; + g.curState := gameMenu end end; -procedure HandleScoreKey(var g: gameState); -var - k: integer; +procedure HandleSceneKey(var g: gameState; k: integer); begin - GetKey(k); - 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 f: boolean); -var - k: integer; -begin - GetKey(k); if (k = EscOrd) or (k = SpaceOrd) or (k = EnterOrd) then - f := true + 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/src/level_m.pas b/src/level_m.pas index b4cb81d..63892c0 100644 --- a/src/level_m.pas +++ b/src/level_m.pas @@ -4,11 +4,14 @@ interface uses arena_m, trace_m, creature_m, enemy_packs_m; +const + LevelCompleteThreshold = 85; + type levelState = record a: arena; t: tracePtr; - levelStarted, continueLevel, hamsterAlive: boolean; + levelStarted, hamsterAlive, unpause: boolean; h: creature; cut: integer; enemyList: creatureList; @@ -22,7 +25,6 @@ implementation uses hamster_m, ghost_m, debug_m; const - LevelCompleteThreshold = 80; TotalProcent = 100; { BonusTurns = 45; @@ -46,10 +48,10 @@ begin AppendEnemies(level.enemyList, t); {PrintEnemies(level.enemyList);} level.levelStarted := true; - level.continueLevel := true; level.hamsterAlive := true; level.t := nil; - level.cut := 0 + level.cut := 0; + level.unpause := false end; end. diff --git a/src/sun_m.pas b/src/sun_m.pas new file mode 100644 index 0000000..230463b --- /dev/null +++ b/src/sun_m.pas @@ -0,0 +1,44 @@ +unit sun_m; + +interface + +uses creature_m; + +const + SunSlowMovespeed = 2; + SunFastMovespeed = 4; + SunStartDX = SunSlowMovespeed; + SunStartDY = SunSlowMovespeed; + SunSymbol = 's'; + +procedure InitRandomSun(var g: creature); + +implementation + +uses arena_m, Math; + +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; + g.symbol := SunSymbol +end; + +procedure InitRandomSun(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); + InitSun(g, x, y, sigdx, sigdy) +end; + +end. diff --git a/src/trace_m.pas b/src/trace_m.pas index a2626a2..1082ee1 100644 --- a/src/trace_m.pas +++ b/src/trace_m.pas @@ -182,7 +182,10 @@ begin prevX := prevX + dX; prevY := prevY + dY end; - TraceCrossed := false + if IsOnTrace(prevX, prevY, t) then + TraceCrossed := true + else + TraceCrossed := false end; end.