From 591f92a2355b1b9802e0c1358731a5e88170ea05 Mon Sep 17 00:00:00 2001 From: gre-ilya Date: Sat, 28 Feb 2026 21:22:15 +0500 Subject: [PATCH] feat/TD-015-added-multiple-enemies --- src/Makefile | 2 +- src/arena_graphics_m.pas | 222 ++++++++++++++++++--------------------- src/arena_m.pas | 196 +++++++++++++++++++++------------- src/ascii_arts_m.pas | 12 +++ src/creature_m.pas | 100 +++++++++++++----- src/debug_m.pas | 43 +++++++- src/enemy_packs_m.pas | 68 ++++++++++++ src/game_m.pas | 212 ++++++++++++++++++++++++++----------- src/ghost_m.pas | 30 ++++-- src/graphics_m.pas | 110 ++++++++++++++++++- src/hamster_m.pas | 24 ++--- src/keys_m.pas | 24 ++++- src/level_m.pas | 39 ++++--- 13 files changed, 755 insertions(+), 327 deletions(-) create mode 100644 src/enemy_packs_m.pas diff --git a/src/Makefile b/src/Makefile index 6349e2d..1fb0b41 100644 --- a/src/Makefile +++ b/src/Makefile @@ -2,7 +2,7 @@ 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 + trace_m.pas enemy_packs_m.pas all: gohamster diff --git a/src/arena_graphics_m.pas b/src/arena_graphics_m.pas index d343893..635001b 100644 --- a/src/arena_graphics_m.pas +++ b/src/arena_graphics_m.pas @@ -10,15 +10,18 @@ const procedure DrawAfterEnemyStep(var cr: creature; var a: arena); procedure DrawAfterStep(var hamster: creature; var t: tracePtr; var a: arena); +procedure DrawAliveEnemies(var e: creatureList); procedure DrawArenaBorders(var a: arena); -procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char); +procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char); +procedure DrawCapturedCell(x, y: integer); procedure DrawArenaEdges; -procedure DrawCompleteBar; { TODO: IMPLEMENT LATER } +procedure DrawCompleteBar; +procedure FillCellsCapture(var a: arena); procedure FillCompleteBar(s: integer); procedure DrawCreature(var cr: creature); -procedure DrawEdge(x, y: integer; var a: arena); +procedure DrawArenaCell(x, y: integer; var a: arena); procedure DrawInterface; -procedure DrawLevel(var level: levelState); +procedure DrawLevel(var level: levelState; life, score: integer); procedure DrawLifesNumber(n: integer); procedure DrawScore(s: integer); procedure EraseStepTrace(var hamster: creature; t: tracePtr); @@ -33,7 +36,7 @@ const ArenaPauseLowerMarginY = 14; ArenaPauseMarginX = 9; ArenaPauseUpperMarginY = 7; - InterfaceBarH = ScreenW - ArenaW * CellSize - BorderSize * 2; { 14 } + InterfaceBarH = ScreenH - ArenaH * CellSize + BorderSize; { 14 } InterfaceCellW = ScreenW div 3; InterfaceMarginX = InterfaceCellW div 4; InterfaceMarginY = InterfaceBarH div 4 + BorderSize + 1; @@ -52,7 +55,8 @@ const LifeBarX = 17; LifeNumberX = 27; MidCellDelimiter = '_'; - Notation = 10; + HamsterLifeY = 5; + DecimalBase = 10; procedure DrawCompleteBar; begin @@ -69,12 +73,25 @@ begin if s <> 0 then cutedProcent := round(s / (TotalCells / TotalProcent)); fillW := round(CompleteBarW / TotalProcent * cutedProcent); - FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '|') + FillRectangle(CompleteBarX, CompleteBarY, fillW, CompleteBarH, '+') end; procedure DrawCreature(var cr: creature); begin - DrawArenaCell(cr.curX, cr.curY, cr.symbol) + DrawFieldCell(cr.curX, cr.curY, cr.symbol) +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 DrawAfterEnemyStep(var cr: creature; var a: arena); @@ -83,13 +100,13 @@ var begin prevX := cr.curX - cr.dX; prevY := cr.curY - cr.dY; - if IsOnEdge(prevX, prevY) and a.captured[prevX][prevY] then - DrawArenaCell(prevX, prevY, CaptureSymbol) + if IsOnEdge(prevX, prevY) and a.captured[prevY][prevX] then + DrawFieldCell(prevX, prevY, CaptureSymbol) else if IsOnBorder(prevX, prevY, a) then - DrawArenaCell(prevX, prevY, BorderSymbol) + DrawFieldCell(prevX, prevY, BorderSymbol) else - DrawArenaCell(prevX, prevY, ArenaSymbol); + DrawFieldCell(prevX, prevY, ArenaSymbol); DrawCreature(cr) end; @@ -100,7 +117,7 @@ begin for i := 1 to HamsterDelta do begin t := t^.prev; - DrawArenaCell(t^.x, t^.y, TraceSymbol) + DrawFieldCell(t^.x, t^.y, TraceSymbol) end end; @@ -112,9 +129,9 @@ begin prevX := hamster.curX - hamster.dX; prevY := hamster.curY - hamster.dY; if t = nil then - DrawEdge(prevX, prevY, a); - if (a.borders[prevX][prevY]) and (t = nil) then - DrawArenaCell(prevX, prevY, BorderSymbol) + DrawArenaCell(prevX, prevY, a); + if (a.borders[prevY][prevX]) and (t = nil) then + DrawFieldCell(prevX, prevY, BorderSymbol) end; procedure EraseStepTrace(var hamster: creature; t: tracePtr); @@ -123,15 +140,15 @@ var begin for i := 1 to hamster.movespeed do begin - DrawArenaCell(t^.x, t^.y, ArenaSymbol); + DrawFieldCell(t^.x, t^.y, ArenaSymbol); t := t^.prev end; if GetLength(t) = 1 then begin if IsOnEdge(hamster) then - DrawArenaCell(t^.x, t^.y, ArenaSymbol) + DrawFieldCell(t^.x, t^.y, ArenaSymbol) else - DrawArenaCell(t^.x, t^.y, BorderSymbol) + DrawFieldCell(t^.x, t^.y, BorderSymbol) end end; @@ -141,13 +158,13 @@ var begin prevX := hamster.curX - hamster.dX; prevY := hamster.curY - hamster.dY; - if IsOnEdge(prevX, prevY) and a.captured[prevX][prevY] then - DrawArenaCell(prevX, prevY, CaptureSymbol) + if IsOnEdge(prevX, prevY) and a.captured[prevY][prevX] then + DrawFieldCell(prevX, prevY, CaptureSymbol) else if IsOnBorder(prevX, prevY, a) then - DrawArenaCell(prevX, prevY, BorderSymbol) + DrawFieldCell(prevX, prevY, BorderSymbol) else - DrawArenaCell(prevX, prevY, ArenaSymbol); + DrawFieldCell(prevX, prevY, ArenaSymbol); if t <> nil then DrawStepTrace(t, hamster.movespeed); DrawCreature(hamster); @@ -158,13 +175,13 @@ procedure FillPauseCells(var a: arena); var i, j: integer; begin - for i := ArenaPauseUpperMarginY to (ArenaW - ArenaPauseLowerMarginY) do - for j := (1 + ArenaPauseMarginX) to (ArenaH - ArenaPauseMarginX) do - if a.borders[j][i] then - DrawArenaCell(j, i, BorderSymbol) + for i := ArenaPauseUpperMarginY to (ArenaH - ArenaPauseLowerMarginY) do + for j := (1 + ArenaPauseMarginX) to (ArenaW - ArenaPauseMarginX) do + if a.borders[i][j] then + DrawFieldCell(j, i, BorderSymbol) else - if a.captured[j][i] then - DrawArenaCell(j, i, CaptureSymbol) + if a.captured[i][j] then + DrawFieldCell(j, i, CaptureSymbol) end; procedure DrawTrace(t: tracePtr); @@ -173,47 +190,11 @@ begin t := t^.prev; while t <> nil do begin - DrawArenaCell(t^.x, t^.y, TraceSymbol); + DrawFieldCell(t^.x, t^.y, TraceSymbol); t := t^.prev 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 EraseInterfaceNumber(interfaceX: integer; s: longint); var cnt: integer = 0; @@ -221,7 +202,7 @@ var begin while s <> 0 do begin - s := s div 10; + s := s div DecimalBase; cnt += 1 end; x := interfaceX + InterfaceMarginX; @@ -229,28 +210,9 @@ begin EraseRectangle(x, InterfaceMarginY, w, DigitHeight) end; -procedure DrawInterfaceNumber(interfaceX: integer; s: longint); -var - x, y: integer; - i: integer = 0; - st: StackInt; +procedure DrawInterfaceNumber(interfaceX: integer; n: longint); begin - StackIntInit(st); - if s = 0 then - StackPush(st, 0); - while s <> 0 do - begin - StackPush(st, s mod Notation); - s := s div Notation - end; - x := interfaceX + InterfaceMarginX; - y := InterfaceMarginY; - while st.top <> nil do - begin - DrawDigit(x + (DigitWidth + DigitSpaceWidth) * i, y, st.top^.val); - StackPop(st); - i := i + 1 - end + DrawNumber(interfaceX + InterfaceMarginX, InterfaceMarginY, n) end; procedure DrawScore(s: integer); @@ -272,38 +234,34 @@ end; procedure DrawLifes(n: integer); begin - DrawAscii(LifeBarX, 5, HamsterHeight, HamsterLifesAscii); + DrawAscii(LifeBarX, HamsterLifeY, HamsterHeight, HamsterLifesAscii); DrawInterfaceNumber(LifeNumberX, n) end; procedure DrawInterface; begin DrawLineX(1, InterfaceBarH, ScreenW * WidthCoefficient, BorderSymbol); - - {DrawLineX(InterfaceCellW * WidthCoefficient, - InterfaceBarH div 2, - InterfaceCellW * WidthCoefficient + 1, MidCellDelimiter);} DrawLineY(InterfaceCellW * WidthCoefficient, 1, InterfaceBarH, BorderSymbol); DrawLineY(InterfaceCellW * 2 * WidthCoefficient + 1, 1, InterfaceBarH, BorderSymbol) end; -procedure DrawLevel(var level: levelState); +procedure DrawLevel(var level: levelState; life, score: integer); begin DrawInterface; FillPauseCells(level.a); DrawTrace(level.t); DrawCreature(level.h); - if level.g.alive then - DrawCreature(level.g); - DrawLifes(level.life); + DrawAliveEnemies(level.enemyList); + + DrawLifes(life); DrawCompleteBar; - FillCompleteBar(level.score); - DrawScore(level.score) + FillCompleteBar(level.cut); + DrawScore(score) end; -procedure DrawArenaCell(arenaX, arenaY: integer; symbol: char); +procedure DrawFieldCell(arenaX, arenaY: integer; symbol: char); var i, screenX, screenY: integer; begin @@ -329,7 +287,7 @@ procedure DrawLeftEdge(y: integer); var terminalY: integer; begin - y := Clamp(y, 1, ArenaW); + y := Clamp(y, 1, ArenaH); terminalY := InterfaceBarH + (y - 1) * CellSize; DrawLineY(1, terminalY, CellSize, BorderSymbol) end; @@ -338,7 +296,7 @@ procedure DrawRightEdge(y: integer); var terminalY: integer; begin - y := Clamp(y, 1, ArenaW); + y := Clamp(y, 1, ArenaH); terminalY := InterfaceBarH + (y - 1) * CellSize; DrawLineY(ScreenW * WidthCoefficient, terminalY, CellSize, BorderSymbol) end; @@ -347,7 +305,7 @@ procedure DrawUpperEdge(x: integer); var terminalX, sizeX: integer; begin - x := Clamp(x, 1, ArenaH); + x := Clamp(x, 1, ArenaW); terminalX := (x - 1) * CellSize * WidthCoefficient + 1; sizeX := CellSize * WidthCoefficient; DrawLineX(terminalX, InterfaceBarH, sizeX, BorderSymbol) @@ -357,10 +315,10 @@ procedure DrawLowerEdge(x: integer); var terminalX, sizeX: integer; begin - x := Clamp(x, 1, ArenaH); + x := Clamp(x, 1, ArenaW); terminalX := (x - 1) * CellSize * WidthCoefficient + 1; sizeX := CellSize * WidthCoefficient; - DrawLineX(terminalX, InterfaceBarH + ArenaW * CellSize - 1, + DrawLineX(terminalX, InterfaceBarH + ArenaH * CellSize - 1, sizeX, BorderSymbol) end; @@ -368,38 +326,66 @@ procedure DrawArenaBorders(var a: arena); var i, j: integer; begin - for i := 1 to ArenaW do - for j := 1 to ArenaH do - if a.borders[j][i] then - DrawArenaCell(j, i, BorderSymbol) + 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; var a: arena); +procedure DrawEdge(x, y: integer); begin - if a.captured[x][y] then - DrawArenaCell(x, y, CaptureSymbol) - else - DrawArenaCell(x, y, ArenaSymbol); if x = 1 then DrawLeftEdge(y); - if x = ArenaH then + if x = ArenaW then DrawRightEdge(y); if y = 1 then DrawUpperEdge(x); - if y = ArenaW then + 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(t: tracePtr; var a: arena); begin while t <> nil do begin if t^.prev = nil then - DrawEdge(t^.x, t^.y, a) + DrawArenaCell(t^.x, t^.y, a) else - DrawArenaCell(t^.x, t^.y, ArenaSymbol); + 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; + end. diff --git a/src/arena_m.pas b/src/arena_m.pas index 59a27b6..ae420c7 100644 --- a/src/arena_m.pas +++ b/src/arena_m.pas @@ -5,8 +5,8 @@ interface uses creature_m, trace_m; const - ArenaW = 33; - ArenaH = 41; + ArenaH = 33; + ArenaW = 41; TotalCells = ArenaW * ArenaH; RandomCutThreshold = 25; RandomOneToOne = 2; @@ -26,12 +26,16 @@ HamsterStepPossible(var h: creature; var t: tracePtr; var a: arena): boolean; function IsOnBorder(var x, y: integer; var a: arena): boolean; function IsOnEdge(var cr: creature): boolean; function IsOnEdge(x, y: integer): boolean; -procedure CutPart(var hamster: creature; var t: tracePtr; - var cutOff: integer; var a: arena); +function RandomBool: boolean; +procedure ArenaCutPart(var hamster: creature; var t: tracePtr; + var cutOff: integer; var a: arena); procedure InitArena(var a: arena); -procedure MakeEnemyStep(var e, h: creature; t: tracePtr; var a: arena); +procedure KillCapturedEnemies(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 TurnGhost(var g: creature; var a: arena); implementation @@ -39,6 +43,7 @@ implementation uses arena_graphics_m, cell_m, crt, graphics_m, math_m; const + MaxTurnAttempts = 3; TotalProcent = 100; procedure Fill(var m: arenaMatrix; val: boolean); @@ -59,9 +64,9 @@ end; function IsCellFree(x, y: integer; var a: arena): boolean; begin IsCellFree := - (x <> 0) and (x <> ArenaH + 1) and - (y <> 0) and (y <> ArenaW + 1) and - not a.captured[x][y] and not a.borders[x][y] + (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); @@ -71,7 +76,7 @@ begin while not QCellIsEmpty(q) do begin cell := QCellGet(q); - a.captured[cell^.x][cell^.y] := false; + a.captured[cell^.y][cell^.x] := false; QCellPop(q) end end; @@ -117,10 +122,10 @@ begin cellPtr := QCellGet(captureQ); InitCell(cell, cellPtr^.x, cellPtr^.y); QCellPop(captureQ); - if a.captured[cell.x][cell.y] then + if a.captured[cell.y][cell.x] then continue; result := result + 1; - a.captured[cell.x][cell.y] := true; + a.captured[cell.y][cell.x] := true; AddAvailableNeighbours(captureQ, cell, a); QCellPush(releaseQ, cell) end; @@ -142,23 +147,23 @@ begin cellPtr := QCellGet(captureQ); InitCell(cell, cellPtr^.x, cellPtr^.y); QCellPop(captureQ); - if a.captured[cell.x][cell.y] then + if a.captured[cell.y][cell.x] then continue; cutOff := cutOff + 1; - a.captured[cell.x][cell.y] := true; - DrawArenaCell(cell.x, cell.y, CaptureSymbol); + a.captured[cell.y][cell.x] := true; + DrawFieldCell(cell.x, cell.y, CaptureSymbol); AddAvailableNeighbours(captureQ, cell, a) end end; function OnEdgeX(x: integer): boolean; begin - OnEdgeX := (x = 1) or (x = ArenaH) + OnEdgeX := (x = 1) or (x = ArenaW) end; function OnEdgeY(y: integer): boolean; begin - OnEdgeY := (y = 1) or (y = ArenaW) + OnEdgeY := (y = 1) or (y = ArenaH) end; function IsOnEdge(x, y: integer): boolean; @@ -169,21 +174,21 @@ end; function YNeighboursCaptured(x, y: integer; var a: arena): boolean; begin YNeighboursCaptured := - not OnEdgeY(y) and a.captured[x][y - 1] and a.captured[x][y + 1] + 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[x + 1][y] and a.captured[x - 1][y] + 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[x - 1][y - 1] and a.captured[x - 1][y + 1] and - a.captured[x + 1][y - 1] and a.captured[x + 1][y + 1] + 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; @@ -195,29 +200,29 @@ end; procedure CaptureArenaBorder(x, y: integer; var a: arena); begin - a.borders[x][y] := false; - a.captured[x][y] := true; - DrawArenaCell(x, y, CaptureSymbol) + 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 ArenaW do - for j := 1 to ArenaH do - if a.borders[j][i] and ArenaCellCaptured(j, i, a) then + 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 end; procedure SetArenaBorder(var t: tracePtr; var a: arena); begin if t <> nil then begin - a.borders[t^.x][t^.y] := true; + a.borders[t^.y][t^.x] := true; SetArenaBorder(t^.prev, a) end end; @@ -225,29 +230,29 @@ end; function IsOnEdge(var cr: creature): boolean; begin IsOnEdge := - (cr.curX = 1) or (cr.curX = ArenaH) or (cr.curY = 1) or - (cr.curY = ArenaW) + (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[x][y] and ( - a.captured[x - 1][y + 1] or - a.captured[x - 1][y - 1] or - a.captured[x + 1][y + 1] or - a.captured[x + 1][y - 1] + 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.curX][cr.curY] and ( - a.captured[cr.curX - 1][cr.curY + 1] or - a.captured[cr.curX - 1][cr.curY - 1] or - a.captured[cr.curX + 1][cr.curY + 1] or - a.captured[cr.curX + 1][cr.curY - 1] + 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; @@ -281,23 +286,22 @@ var begin v1 := val1; v2 := val2; - if v1 > v2 then begin tmp := v1; v1 := v2; v2 := tmp - end; {Should be 100 or OneHundred? It's A.V.Stolyarov to decide!!!} + end; biggerProcent := v2 / TotalProcent; - LowerToBiggerRatio := Round(100 - v1 / biggerProcent) + 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, ArenaH); - nextY := Clamp(hamster.curY + hamster.dY, 1, ArenaW); + 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; @@ -305,9 +309,9 @@ end; function StepBeyondEdge(var cr: creature): boolean; begin StepBeyondEdge := - (cr.dX > 0) and (cr.curX = ArenaH) or + (cr.dX > 0) and (cr.curX = ArenaW) or (cr.dX < 0) and (cr.curX = 1) or - (cr.dY > 0) and (cr.curY = ArenaW) or + (cr.dY > 0) and (cr.curY = ArenaH) or (cr.dY < 0) and (cr.curY = 1) end; @@ -331,17 +335,15 @@ begin end; {refactor? pass just level later} -procedure CutPart(var hamster: creature; var t: tracePtr; - var cutOff: integer; var a: arena); +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) @@ -363,18 +365,18 @@ 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, ArenaH); - nextY := Clamp(h.curY + h.dY, 1, ArenaW); - midX := Clamp(h.curX + (h.dX div 2), 1, ArenaH); - midY := Clamp(h.curY + (h.dY div 2), 1, ArenaW); + 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[midX][midY] or IsOnEdge(nextX, nextY)) + and (not a.captured[midY][midX] or IsOnEdge(nextX, nextY)) and not StepBeyondEdge(h) and not ( - not IsOnEdge(h) and a.borders[h.curX][h.curY] and - a.captured[midX][midY] - ) + not IsOnEdge(h) and a.borders[h.curY][h.curX] and + a.captured[midY][midX] + ); end; function @@ -385,8 +387,8 @@ 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[midX][midY] and - not a.borders[hamster.curX][hamster.curY] and + 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; @@ -399,8 +401,8 @@ begin midY := hamster.curY - (hamster.dY div 2); IsOnField := not (IsOnEdge(hamster) and (t = nil)) and - not a.captured[hamster.curX][hamster.curY] and - not a.borders[midX][midY] + 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); @@ -417,21 +419,21 @@ var begin nextX := g.curX + g.dX; nextY := g.curY + g.dY; - GhostShouldTurn := IsOnEdge(nextX, nextY) or a.borders[nextX][nextY] + GhostShouldTurn := IsOnEdge(nextX, nextY) or a.borders[nextY][nextX] end; function BorderY(nextX, nextY: integer; var a: arena): boolean; begin BorderY := - a.borders[nextX][nextY] and - (a.borders[nextX][nextY - 1] or a.borders[nextX][nextY + 1]) + 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; begin BorderX := - a.borders[nextX][nextY] and - (a.borders[nextX - 1][nextY] or a.borders[nextX + 1][nextY]) + 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; @@ -442,10 +444,10 @@ end; function IsConcaveCorner(x, y: integer; var a: arena): boolean; begin IsConcaveCorner := - a.borders[x - 1][y] and a.borders[x][y + 1] or - a.borders[x - 1][y] and a.borders[x][y - 1] or - a.borders[x + 1][y] and a.borders[x][y + 1] or - a.borders[x + 1][y] and a.borders[x][y - 1] + 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; @@ -470,13 +472,13 @@ begin y := cr.curY; nextX := x + cr.dX; nextY := y + cr.dY; - if not a.borders[nextX][y] and not a.borders[x][nextY] then + 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[nextX][y] then + if a.borders[y][nextX] then cr.dX := cr.dX * -1 else cr.dY := cr.dY * -1 @@ -513,4 +515,50 @@ begin 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 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 GhostShouldTurn(tmp^.cr^, a) and + (turnCnt < MaxTurnAttempts) do + begin + TurnGhost(tmp^.cr^, a); + turnCnt := turnCnt + 1 + end; + turnCnt := 0; + 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 GhostShouldTurn(tmp^.cr^, a) then + MakeEnemyStep(tmp^.cr^, h, t, a); + tmp := tmp^.next + end +end; + end. diff --git a/src/ascii_arts_m.pas b/src/ascii_arts_m.pas index 12609b9..c983f4e 100644 --- a/src/ascii_arts_m.pas +++ b/src/ascii_arts_m.pas @@ -307,6 +307,18 @@ const ' |_|' ); + LevelAnnounceHeight = 6; + LevelAnnounceWidth = 24; + LevelAnnounce: array[1..LevelAnnounceHeight] of string = ( + ' _ _ ', + '| | | |', + '| | _____ _____| |', + '| | / _ \ \ / / _ \ |', + '| |___| __/\ V / __/ |', + '|______\___| \_/ \___|_|' + ); + + implementation end. diff --git a/src/creature_m.pas b/src/creature_m.pas index 0b09f0b..083037a 100644 --- a/src/creature_m.pas +++ b/src/creature_m.pas @@ -3,32 +3,94 @@ unit creature_m; interface type + creatureType = (creatureHamster, creatureGhost, creatureSun, + creatureSnake, creatureDrop); + + creaturePtr = ^creature; + creature = record curX, curY, dX, dY, moveSpeed: integer; symbol: char; - alive: boolean + alive: boolean; + t: creatureType; end; -procedure -InitCreature(var cr: creature; curX, curY, movespeed: integer; symbol: char); + 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 StopCreature(var cr: creature); procedure MakeStep(var cr: creature); +procedure InitCreatureList(var lst: creatureList); +procedure StopCreature(var cr: creature); implementation uses arena_graphics_m, arena_m, math_m; -procedure -InitCreature(var cr: creature; curX, curY, movespeed: integer; symbol: char); +function RandomLR(l, r: integer): integer; begin - cr.curX := curX; - cr.curY := curY; - cr.dX := 0; - cr.dY := 0; - cr.movespeed := moveSpeed; - cr.alive := true; - cr.symbol := symbol + RandomLR := l + Random(r - l + 1) +end; + +procedure AppendCreature(var lst: creatureList; c: creaturePtr); +var + item: creatureItemPtr; +begin + new(item); + item^.cr := c; + item^.next := nil; + if lst.first = nil then + lst.first := item + else + lst.last^.next := item; + lst.last := item +end; + +procedure DisposeCreatureList(var lst: creatureList); +var + tmp: creatureItemPtr; +begin + while lst.first <> nil do + begin + tmp := lst.first; + lst.first := lst.first^.next; + if lst.first = nil then + lst.last := nil; + dispose(tmp^.cr); + dispose(tmp); + lst.len := lst.len - 1 + end +end; + +procedure KillCreature(var cr: creature); +begin + cr.alive := false; + DrawFieldCell(cr.curX, cr.curY, CaptureSymbol) +end; + +procedure MakeStep(var cr: creature); +begin + cr.curX := Clamp(cr.curX + cr.dX, 1, ArenaW); + cr.curY := Clamp(cr.curY + cr.dY, 1, ArenaH) +end; + +procedure InitCreatureList(var lst: creatureList); +begin + lst.len := 0; + lst.first := nil; + lst.last := nil end; procedure StopCreature(var cr: creature); @@ -37,16 +99,4 @@ begin cr.dY := 0 end; -procedure MakeStep(var cr: creature); -begin - cr.curX := Clamp(cr.curX + cr.dX, 1, ArenaH); - cr.curY := Clamp(cr.curY + cr.dY, 1, ArenaW) -end; - -procedure KillCreature(var cr: creature); -begin - cr.alive := false; - DrawArenaCell(cr.curX, cr.curY, CaptureSymbol) -end; - end. diff --git a/src/debug_m.pas b/src/debug_m.pas index de79f63..1fd9cbc 100644 --- a/src/debug_m.pas +++ b/src/debug_m.pas @@ -7,8 +7,8 @@ uses arena_m, cell_m, creature_m; procedure Debug; procedure DebugCell(cell: cellItemPtr); procedure Print(var m: arenaMatrix); - procedure PrintCreatureDebug(var cr: creature); +procedure PrintEnemies(var lst: creatureList); implementation @@ -16,6 +16,8 @@ uses crt; const DebugMsg = '===============DEBUG==============='; + DebugPrintY = 10; + DebugPrintX = 10; var DebugTmp: integer = 2; @@ -38,10 +40,10 @@ procedure Print(var m: arenaMatrix); var i, j: integer; begin - for i := 1 to ArenaW do + for i := 1 to ArenaH do begin - for j := 1 to ArenaH do - if m[j][i] then + for j := 1 to ArenaW do + if m[i][j] then write(1, ' ') else write(0, ' '); @@ -61,4 +63,37 @@ begin 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; + end. diff --git a/src/enemy_packs_m.pas b/src/enemy_packs_m.pas new file mode 100644 index 0000000..7b4a8f5 --- /dev/null +++ b/src/enemy_packs_m.pas @@ -0,0 +1,68 @@ +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; + +const + LevelGhostN: array[enemyPackType] of integer = ( + 4, 4, 2, 4, 4, 2, 4, 2, 4, 4 + ); + +{ + LevelSunN: array[enemyPackType] of integer = ( + 0, 1, 4, 2, 0, 2, 2, 2, 2, 0 + ); + LevelSnakeN: array[enemyPackType] of integer = ( + 0, 0, 0, 1, 2, 2, 2, 4, 2, 2 + ); + LevelDropN: array[enemyPackType] of integer = ( + 0, 0, 0, 0, 2, 2, 1, 1, 2, 4 + ); +} + +procedure AppendRandomGhosts(var lst: creatureList; t: enemyPackType); +var + i: integer; + c: creaturePtr; +begin + for i := 1 to LevelGhostN[t] do + begin + new(c); + InitRandomGhost(c^); + AppendCreature(lst, c) + end +end; + +procedure AppendRandomSuns(var lst: creatureList; t: enemyPackType); +begin +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/src/game_m.pas b/src/game_m.pas index 17c25cb..962112e 100644 --- a/src/game_m.pas +++ b/src/game_m.pas @@ -3,27 +3,27 @@ unit game_m; interface -uses level_m; +uses level_m, enemy_packs_m; type - state = (gameExit, gameMenu, gameStartLevel, gameScore, gameKeyInfo, - gamePause, gameContinueLevel, gameOver); + state = (gameLevelAnnounce, gameExit, gameMenu, gameStartLevel, gameScore, + gameKeyInfo, gamePause, gameContinueLevel, gameOver, gameComplete, + gameLevelComplete, gameSetRecord); menuState = (menuNewGame, menuHighScore, menuKeyInfo, menuContinue); exitState = (exitYes, exitNo); gameState = record curExit: exitState; curMenu: menuState; curState: state; - level: integer; - shutdown, continueAllowed: boolean + level, score, life: integer; + enemyPack: enemyPackType; + shutdown, continueAllowed: boolean; end; -procedure DecreaseLife(var level: levelState); -procedure RunGameOver(var g: gameState; var level: levelState); +procedure DecreaseLife(var life: integer); procedure InitGame(var g: gameState); procedure NextExitState(var g: gameState); procedure PreviousExitState(var g: gameState); -procedure RunExit(var g: gameState); procedure MainLoop(var g: gameState); implementation @@ -32,14 +32,20 @@ uses arena_m, arena_graphics_m, crt, creature_m, ghost_m, graphics_m, hamster_m, keys_m, trace_m; const - KeyDelayMs = 25; - LevelDelayMs = 100; + KeyDelayMs = 22; + MoveDelayMs = 100; + EraseLifeThreshold = 10; + AnnounceDelayMs = 1500; + LevelCompleteDelayMs = 1500; + LevelCount = 10; + StartLifeN = 3; -procedure DecreaseLife(var level: levelState); +procedure DecreaseLife(var life: integer); begin - EraseLifesNumber(level.life); - level.life := level.life - 1; - DrawLifesNumber(level.life) + if life = EraseLifeThreshold then + EraseLifesNumber(life); + life := life - 1; + DrawLifesNumber(life) end; procedure InitGame(var g: gameState); @@ -48,14 +54,17 @@ begin g.curMenu := menuNewGame; g.curState := gameMenu; g.level := 1; + g.enemyPack := enemyPack1; + g.score := 0; g.shutdown := false; + g.life := StartLifeN { g.slowBonus := StartSlowBonus; g.speedBonus := StartSpeedBonus } end; -procedure RunExit(var g: gameState); +procedure ShowExit(var g: gameState); begin DrawExit(g); while g.curState = gameExit do @@ -67,7 +76,7 @@ begin EraseExit end; -procedure RunScore(var g: gameState); +procedure ShowScore(var g: gameState); begin {DrawHighScore;} while g.curState = gameScore do @@ -78,7 +87,7 @@ begin end; end; -procedure RunKeyInfo(var g: gameState); +procedure ShowKeyInfo(var g: gameState); begin DrawKeyInfo; while g.curState = gameKeyInfo do @@ -90,7 +99,7 @@ begin EraseKeyInfo end; -procedure RunPause(var g: gameState); +procedure PauseLevel(var g: gameState); begin DrawPause(g); while g.curState = gamePause do @@ -105,7 +114,7 @@ begin ErasePause(g) end; -procedure RunGameOver(var g: gameState; var level: levelState); +procedure ShowGameOver(var g: gameState; var level: levelState); begin DrawGameOver; while g.curState = gameOver do @@ -116,65 +125,105 @@ begin end; EraseGameOver; if g.curState = gameContinueLevel then - InitLevel(level) + InitLevel(level, enemyPack1) +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); + KillCapturedEnemies(level.a, level.enemyList) +end; + +procedure GameNextLevel(var g: gameState); +begin + g.curState := gameLevelComplete; + g.level := g.level + 1; + if g.level = LevelCount then + g.curState := gameComplete + else + g.curState := gameLevelComplete +end; + +procedure +GameKillHamster(var g: gameState; var level: levelState; var breakF: boolean); +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); + 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 + HandleLevelKey(level.h, level.a, level.t, g); + 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 begin - delay(LevelDelayMs); + 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 - SetArenaBorder(level.t, level.a); - CutPart(level.h, level.t, level.score, level.a); - FillCompleteBar(level.score); - DrawScore(level.score) + GameNextLevel(g); + break end; - if level.g.alive and level.a.captured[level.g.curX][level.g.curY] then - KillCreature(level.g); - if level.g.alive then - MakeEnemyStep(level.g, level.h, level.t, level.a); - while level.g.alive and GhostShouldTurn(level.g, level.a) do - TurnGhost(level.g, level.a); - + {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 - begin - if level.life <= 0 then - begin - g.curState := gameOver; - EraseLevel; - break - end; - DecreaseLife(level); - KillHamster(level.h, level.t, level.a); - level.h.alive := true - end; - if keypressed then - HandleLevelKey(level.h, level.a, level.t, g); + GameKillHamster(g, level, breakF); + if breakF then + break; 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); - if g.curState = gamePause then - break - end; + MakeHamsterStep(level.h, level.t, level.a) + end end; procedure StartLevel(var g: gameState; var level: levelState); begin - InitLevel(level); - DrawLevel(level); + InitLevel(level, enemyPack1); + DrawLevel(level, g.life, g.score); LevelLoop(g, level) end; procedure ContinueLevel(var g: gameState; var level: levelState); begin - DrawLevel(level); + DrawLevel(level, g.life, g.score); LevelLoop(g, level) end; -procedure RunMenu(var g: gameState); +procedure ShowMenu(var g: gameState); var prevMenu: boolean = false; begin @@ -200,31 +249,70 @@ begin end end; +procedure AnnounceLevel(var g: gameState); +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 + break + end; + g.curState := gameStartLevel; + EraseAnnounce(g.level) +end; + +procedure ShowLevelComplete(var g: gameState; var lvl: levelState); +var + i: integer; + skip: boolean = false; +begin + FillCellsCapture(lvl.a); + DrawCreature(lvl.h); + for i := 1 to LevelCompleteDelayMs div KeyDelayMs do + begin + delay(KeyDelayMs); + if keypressed then + HandleSceneKey(skip); + if skip then + break + end; + g.curState := gameLevelAnnounce; + EraseLevel +end; + procedure MainLoop(var g: gameState); var level: levelState; begin while not g.shutdown do - begin case g.curState of + gameLevelAnnounce: + AnnounceLevel(g); gameExit: - RunExit(g); + ShowExit(g); gameScore: - RunScore(g); + ShowScore(g); gameKeyInfo: - RunKeyInfo(g); + ShowKeyInfo(g); gamePause: - RunPause(g); + PauseLevel(g); gameStartLevel: StartLevel(g, level); gameContinueLevel: {Maybe here should be gameStartLevel} ContinueLevel(g, level); gameOver: - RunGameOver(g, level); + ShowGameOver(g, level); gameMenu: - RunMenu(g) - end - end; + ShowMenu(g); + gameLevelComplete: + ShowLevelComplete(g, level); + end; EraseAll end; diff --git a/src/ghost_m.pas b/src/ghost_m.pas index 7395024..fe31689 100644 --- a/src/ghost_m.pas +++ b/src/ghost_m.pas @@ -5,22 +5,38 @@ interface uses creature_m; const - GhostStartX = 5; - GhostStartY = 5; GhostMovespeed = 1; GhostStartDX = GhostMovespeed; GhostStartDY = GhostMovespeed; GhostSymbol = 'g'; -procedure InitGhost(var g: creature); +procedure InitRandomGhost(var g: creature); implementation -procedure InitGhost(var g: creature); +uses arena_m, Math; + +procedure InitGhost(var g: creature; x, y, sigdx, sigdy: integer); begin - InitCreature(g, GhostStartX, GhostStartY, GhostMovespeed, GhostSymbol); - g.dX := GhostStartDX; - g.dY := GhostStartDY + g.t := creatureGhost; + g.curX := x; + g.curY := y; + g.dX := GhostStartDX * sigdx; + g.dY := GhostStartDY * sigdy; + g.movespeed := GhostMovespeed; + g.alive := true; + g.symbol := GhostSymbol +end; + +procedure InitRandomGhost(var g: creature); +var + x, y, sigdx, sigdy: integer; +begin + sigdx := IfThen(RandomBool, 1, -1); + sigdy := IfThen(RandomBool, 1, -1); + x := RandomLR(2, ArenaW - 1); + y := RandomLR(2, ArenaH - 1); + InitGhost(g, x, y, sigdx, sigdy) end; end. diff --git a/src/graphics_m.pas b/src/graphics_m.pas index 2ba6285..3d2295c 100644 --- a/src/graphics_m.pas +++ b/src/graphics_m.pas @@ -11,10 +11,11 @@ const DigitSpaceWidth = 1; DigitWidth = 6; InterfaceH = 6; - ScreenH = (ArenaW + InterfaceH) * CellSize + BorderSize; - ScreenW = (ArenaH - 1) * CellSize + BorderSize * 2; { 82 } + ScreenH = (ArenaH + InterfaceH) * CellSize + BorderSize; + ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 82 } WidthCoefficient = 2; +procedure DrawAnnounce(lvl: integer); procedure DrawAscii(x, y, h: integer; var a: array of string); procedure DrawDigit(x, y, digit: integer); procedure DrawExitState(s: exitState); @@ -23,11 +24,13 @@ procedure DrawGameOver; 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 DrawPause(var g: gameState); procedure EraseAll; +procedure EraseAnnounce(lvl: integer); procedure EraseExit; procedure EraseExitState(s: exitState); procedure EraseGameOver; @@ -44,8 +47,10 @@ implementation uses crt, math_m, ascii_arts_m; const + AnnounceY = (ScreenH - LevelAnnounceHeight) div 2; BigLetterWidth = 8; BorderN = 2; + DecimalDelimiter = 10; GameNameY = 12; NameHeightPadding = 8; NewGameY = GameNameY + GameNameHeight + NameHeightPadding; @@ -72,7 +77,7 @@ const PauseX = (ScreenW * WidthCoefficient - PauseWidth) div 2; PauseYPadding = 1; PauseY = (ScreenH - PauseHeight) div 2; - PunctuationWidth = 3; + LevelNumberMargin = 3; var firstMenuDraw: boolean = true; @@ -162,7 +167,7 @@ begin menuContinue: DrawAscii(MenuHamsterX, ContinueY + 1, HamsterHeight, HamsterStayAscii) - end + end end; procedure DrawRectangle(x0, y0, h, w: integer; ch: char); @@ -193,7 +198,7 @@ begin DrawAscii(GameNameX, y, GameMenuHeight, GameMenuScreen); if not g.continueAllowed then DrawLineX(GameNameX, ContinueY + ContinueHeight div 2, - ContinueWidth, '-'); + ContinueWidth, '-'); DrawMenuState(g.curMenu) end; @@ -304,4 +309,99 @@ begin PauseHeight + PauseYPadding * 2 + 1) end; +type + stackIntPtr = ^stackIntItem; + + stackIntItem = record + val: integer; + next: stackIntPtr + end; + + StackInt = record + top: stackIntPtr + end; + +procedure StackIntInit(var s: StackInt); +begin + s.top := nil +end; + +procedure StackPush(var st: StackInt; val: integer); +var + tmp: stackIntPtr; +begin + new(tmp); + tmp^.val := val; + tmp^.next := st.top; + st.top := tmp +end; + +procedure StackPop(var st: StackInt); +var + tmp: stackIntPtr; +begin + tmp := st.top; + st.top := st.top^.next; + dispose(tmp) +end; + +procedure 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(lvl: integer): integer; +var + res: integer = 0; +begin + 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; + DrawAscii(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; + end. diff --git a/src/hamster_m.pas b/src/hamster_m.pas index 4f80e1f..4de5857 100644 --- a/src/hamster_m.pas +++ b/src/hamster_m.pas @@ -12,32 +12,32 @@ const HamsterMovespeed = 2; HamsterSymbol = 'h'; -procedure InitHamster(var h: creature); +procedure InitHamster(var cr: creature); procedure KillHamster(var h: creature; var t: tracePtr; var a: arena); implementation uses graphics_m; -procedure InitHamster(var h: creature); +procedure InitHamster(var cr: creature); begin - InitCreature(h, HamsterStartX, HamsterStartY, - HamsterMovespeed, HamsterSymbol); - h.dX := HamsterStartDX; - h.dY := HamsterStartDY + cr.t := creatureHamster; + cr.curX := HamsterStartX; + cr.curY := HamsterStartY; + cr.dX := HamsterStartDX; + cr.dY := HamsterStartDY; + cr.movespeed := HamsterMovespeed; + cr.alive := true; + cr.symbol := HamsterSymbol end; procedure KillHamster(var h: creature; var t: tracePtr; var a: arena); var traceStart: tracePtr; begin - DrawArenaCell(h.curX, h.curY, ArenaSymbol); + DrawFieldCell(h.curX, h.curY, ArenaSymbol); EraseTrace(t, a); - if IsOnEdge(h) then - DrawEdge(h.curX, h.curY, a) - else - if a.borders[h.curX][h.curY] then - DrawArenaCell(h.curX, h.curY, BorderSymbol); + DrawArenaCell(h.curX, h.curY, a); GetStart(traceStart, t); h.curX := traceStart^.x; h.curY := traceStart^.y; diff --git a/src/keys_m.pas b/src/keys_m.pas index f5d244c..167d398 100644 --- a/src/keys_m.pas +++ b/src/keys_m.pas @@ -32,6 +32,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); @@ -151,8 +152,10 @@ begin if (k = FourOrd) and not g.continueAllowed then exit; case k of - OneOrd: - g.curState := gameStartLevel; + OneOrd: begin + g.level := 1; + g.curState := gameLevelAnnounce + end; TwoOrd: g.curState := gameScore; ThreeOrd: @@ -165,8 +168,10 @@ end; procedure ChooseMenuMarked(var g: gameState); begin case g.curMenu of - menuNewGame: - g.curState := gameStartLevel; + menuNewGame: begin + g.level := 1; + g.curState := gameLevelAnnounce + end; menuHighScore: g.curState := gameScore; menuKeyInfo: @@ -192,7 +197,7 @@ begin if (k = EscOrd) or (k = UpperQOrd) or (k = LowerQOrd) then g.curState := gameExit; if (k = EnterOrd) or (k = SpaceOrd) then - ChooseMenuMarked(g); + ChooseMenuMarked(g) end; procedure HandleGameOverKey(var g: gameState); @@ -279,4 +284,13 @@ begin 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 +end; + end. diff --git a/src/level_m.pas b/src/level_m.pas index ef5455c..b4cb81d 100644 --- a/src/level_m.pas +++ b/src/level_m.pas @@ -2,43 +2,54 @@ unit level_m; interface -uses arena_m, trace_m, creature_m; +uses arena_m, trace_m, creature_m, enemy_packs_m; type levelState = record a: arena; t: tracePtr; levelStarted, continueLevel, hamsterAlive: boolean; - h, g: creature; - life, score, enemy: integer + h: creature; + cut: integer; + enemyList: creatureList; end; -procedure InitLevel(var level: levelState); +function IsLevelComplete(var level: levelState): boolean; +procedure InitLevel(var level: levelState; t: enemyPackType); implementation -uses hamster_m, ghost_m; + +uses hamster_m, ghost_m, debug_m; const - StartScore = 0; - StartLifes = 3; - { + LevelCompleteThreshold = 80; + TotalProcent = 100; +{ BonusTurns = 45; StartSpeedBonus = 0; StartSlowBonus = 0; - } +} -procedure InitLevel(var level: levelState); +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); - InitGhost(level.g); + InitCreatureList(level.enemyList); + AppendEnemies(level.enemyList, t); + {PrintEnemies(level.enemyList);} level.levelStarted := true; level.continueLevel := true; level.hamsterAlive := true; level.t := nil; - level.life := StartLifes; - level.enemy := 1; - level.score := StartScore + level.cut := 0 end; end.