PACK-MANN (1989) by Gerd Brinkmann; translated, fixed, extended. Initial commit: Original version.
(************************************************** | |
*** P A C K - M A N N *** | |
*** (W) 1989 by G. Brinkmann *** | |
*** MS-DOS, Turbo Pascal 4.0/5.0, 06.04.1989 *** | |
**************************************************) | |
{ Revised & extended version 2.0 in April/May 2020 by tomaes | |
NEW in this edition: | |
- source & game translation (German->English), | |
- code clean-up, structual improvements & fixes | |
- more sound effects, dual-colored levels | |
- settings menu, incl. about section & audio toggle | |
- new play arena ('Type B') | |
- (a bit) smarter monsters | |
- best score will be saved | |
- support for monochrome displays | |
- an easter egg :) | |
...among many other more or less subtle changes | |
} | |
{ If you want to compile this with FPC on Windows* | |
- set $DEFINE BORLAND_DOS to FPC | |
- fpc.exe PACKMANN.PAS | |
- console -> set legacy mode -> restart console | |
- use OEM 850/OEM-US encoding and a raster font | |
- Done :) | |
* Not tested on Linux or cross-compilers, but it should work :P | |
} | |
PROGRAM PackMann; | |
{$DEFINE BORLAND_DOS} | |
{$DEFINE release } | |
{$IFNDEF debug} | |
{$X-}{$S-}{$R-}{$Q-}{$D-}{$B-} | |
{$ENDIF} | |
USES Crt; | |
TYPE | |
TLevel = ARRAY[1..10] OF STRING[80]; | |
CONST | |
MAXLEVEL = 9; | |
{$IFNDEF debug} | |
DOTCOUNT_A = 292; {all collectable dots per arena type} | |
DOTCOUNT_B = 16; | |
{$ELSE} | |
DOTCOUNT_A = 2; | |
DOTCOUNT_B = 2; | |
{$ENDIF} | |
CHAR_DOT = #254; {level objects: dot, full/half-left/half-right wall} | |
CHAR_FWALL = #219; | |
CHAR_LWALL = #221; | |
CHAR_RWALL = #222; | |
CHAR_MENUP = #175; | |
MAP_BLANK = 0; | |
MAP_DOT = 1; | |
MAP_WALLS = 2; | |
MAP_HMIN = 2; | |
MAP_HMAX = 37; | |
{ player & monsters: 3x1 char "sprites"} | |
STRING_RUNNER = #174#64#175; { org.: 174,240,175 } | |
STRING_MONSTER = #204#79#185; { org.: 204,205,185 } | |
STRING_MONSTERA= #201#64#187; { for minimal death animation} | |
STRING_TITLE = 'P A C K - M A N N'; | |
STRING_CREDIT = 'brinkmann + tomaes'; | |
LEVEL_COLORS : ARRAY[1..MAXLEVEL] OF BYTE = | |
(Red, Brown, Magenta, Blue, | |
Green, DarkGray, Blue+Blink, Cyan, Yellow); | |
LEVEL_COLORSA: ARRAY[1..MAXLEVEL] OF BYTE = | |
(Red, Magenta, Cyan, DarkGray, | |
Brown, Blue, Blue+Blink, LightBlue, LightGreen ); | |
KEY_UP = #72; KEY_LEFT = #75; | |
KEY_DOWN = #80; KEY_RIGHT = #77; | |
KEY_ESC = #27; KEY_RETURN = #13; | |
MAXGAMEDELAY = 60; MINGAMEDELAY = 30; | |
DEFHISCORE = 100; | |
HISCORE_FILE = 'PACKMANN.DAT'; | |
VAR | |
leveldata : TLevel; | |
map : ARRAY[1..38, 1..19] OF BYTE; | |
hiscore : WORD; | |
startLevel: WORD; | |
level : WORD; | |
gameDelay : WORD; | |
newArena : BOOLEAN; | |
playSFX : BOOLEAN; | |
fkey : BOOLEAN; | |
scrt : BOOLEAN; | |
backToOS : BOOLEAN; | |
wasPlaying: BOOLEAN; | |
i, j : WORD; | |
ch : CHAR; | |
(*****************************************************************************************) | |
PROCEDURE showCursor( _on: BOOLEAN ); | |
{ switch blinking text cursor on/off } | |
BEGIN | |
{$IFDEF BORLAND_DOS} | |
IF _on THEN BEGIN | |
asm | |
mov ah,1 | |
mov cx, 0607h | |
int 10h | |
end; | |
END ELSE BEGIN | |
asm | |
mov ah,1 | |
mov cx, 2007h | |
int 10h | |
end; | |
END; | |
{$ENDIF} | |
{$IFDEF FPC} | |
IF _on THEN CursorOn | |
ELSE CursorOff; | |
{$ENDIF} | |
END; | |
FUNCTION IntToStr(i: LONGINT): STRING; | |
{ more convenient than str() } | |
VAR | |
s: STRING[11]; | |
BEGIN | |
Str(i, s); | |
IntToStr := s; | |
END; | |
PROCEDURE ReadChar( VAR c : CHAR ); | |
{ read from keyb.; flag "special" keys } | |
BEGIN | |
c := ReadKey; | |
IF KeyPressed AND (c=#0) THEN BEGIN | |
c := ReadKey; | |
fkey := TRUE; | |
END | |
ELSE fkey := FALSE; | |
END; | |
PROCEDURE WriteXYc( _x, _y, _color : BYTE; _text: STRING); | |
BEGIN | |
GotoXY(_x,_y); | |
TextColor(_color); | |
Write(_text); | |
END; | |
FUNCTION loadScore( VAR hiscore: WORD ): BOOLEAN; | |
VAR F: FILE OF WORD; | |
BEGIN | |
{$I-} | |
Assign(F, HISCORE_FILE); | |
Reset(F); | |
Read(F, hiscore); | |
Close(F); | |
{$I+} | |
IF IOResult <> 0 THEN | |
loadScore := FALSE ELSE loadScore := TRUE; | |
END; | |
PROCEDURE saveScore( _score: WORD ); | |
VAR F: FILE OF WORD; | |
BEGIN | |
{$I-} | |
Assign(F, HISCORE_FILE); | |
Rewrite(F); | |
Write(F, _score); | |
Close(F); | |
{$I+} | |
END; | |
(*****************************************************************************************) | |
PROCEDURE buildLevel( _new: BOOLEAN ); | |
{ level init; level data based on ASCII chars 219,221,222 and 254 } | |
VAR | |
c : CHAR; | |
leveldata7b : TLevel; | |
BEGIN | |
{ clear data first } | |
FOR i:= 1 TO 10 DO BEGIN | |
leveldata[i] := ''; | |
leveldata7b[i] := ''; | |
END; | |
{ first quarter of level data (7bit ASCII version) } | |
IF _new THEN BEGIN | |
{ stage B } | |
leveldata7b[ 1] := ' lfffffffffffffffffffffffffffffffflll '; | |
leveldata7b[ 2] := ' rf d '; | |
leveldata7b[ 3] := ' rf ffffffffffr '; | |
leveldata7b[ 4] := ' rf f d '; | |
leveldata7b[ 5] := ' rf f '; | |
leveldata7b[ 6] := ' rf lfffffffffffr '; | |
leveldata7b[ 7] := ' rf f '; | |
leveldata7b[ 8] := ' rf f d d f '; | |
leveldata7b[ 9] := ' rf fffffffffff '; | |
leveldata7b[10] := ' '; | |
END ELSE BEGIN | |
{ stage A } | |
leveldata7b[ 1] := 'rfffffffffffffffffffffffffffffffffffff'; | |
leveldata7b[ 2] := 'rff d d d d d d d d d d d d d d d d rf'; | |
leveldata7b[ 3] := 'rff d rfffffffffffffffffffl d rfl d rf'; | |
leveldata7b[ 4] := 'rff d d d d d d d d d d d d d rfl d rf'; | |
leveldata7b[ 5] := 'rff d rfl d rfl d rfffffrfl d rfl d rf'; | |
leveldata7b[ 6] := 'rff d rfl d rfl d rfl d rfl d rfl d d '; | |
leveldata7b[ 7] := 'rff d rfl d rfl d rfl d rfl d rfl d rf'; | |
leveldata7b[ 8] := 'rff d rfl d d d d rfl d rfl d d d d rf'; | |
leveldata7b[ 9] := 'rff d rfl d rfl d rfl d rfl d rfl d rf'; | |
leveldata7b[10] := ' d d rfl d rfl d d d d d d d rfl d d '; | |
END; | |
{ ...y-mirror the rest } | |
FOR i:=1 TO 10 DO | |
FOR j:=37 DOWNTO 1 DO | |
BEGIN | |
c := leveldata7b[i][j]; | |
CASE c OF | |
'r': c := 'l'; | |
'l': c := 'r'; | |
END; | |
leveldata7b[i] := leveldata7b[i] + c; | |
END; | |
{ 7bit ASCII -> ext. ASCII (OEM 850/OEM-US) } | |
FOR i :=1 TO 10 DO | |
FOR j :=1 TO 37*2 DO | |
BEGIN | |
c := leveldata7b[i][j]; | |
CASE c OF | |
'l': c := CHAR_LWALL; (* l -> wall: left *) | |
'r': c := CHAR_RWALL; (* r -> wall: right *) | |
'f': c := CHAR_FWALL; (* f -> full wall *) | |
'd': c := CHAR_DOT; (* d -> dot *) | |
END; | |
leveldata[i] := leveldata[i] + c; | |
END; | |
END; | |
PROCEDURE renderTitle( doFlash: BOOLEAN ); | |
VAR s: STRING; | |
BEGIN | |
s := STRING_TITLE; | |
IF scrt THEN s[4] := #85; | |
IF doFlash THEN BEGIN | |
FOR i := Black TO White DO BEGIN | |
WriteXYc(26,1, i, s); | |
IF playSFX THEN sound(500+(i*20) MOD 160); | |
delay(20); | |
END; | |
IF playSFX THEN nosound; | |
END ELSE | |
WriteXYc(26,1, White, s); | |
END; | |
PROCEDURE renderCredits; | |
{ render the vertical name credit } | |
VAR s: STRING; | |
BEGIN | |
s := STRING_CREDIT; | |
FOR i:=1 TO Length(s) DO BEGIN | |
WriteXYc( 77, i+3, LEVEL_COLORS[level], s[i] ); | |
END; | |
END; | |
PROCEDURE renderPlayMap( color, color2: BYTE ); | |
BEGIN | |
Gotoxy(1, 4); | |
FOR i:=1 TO 10 DO BEGIN | |
FOR j:=1 TO Length(leveldata[i]) DO BEGIN | |
IF leveldata[i][j] = CHAR_DOT THEN | |
TextColor( Yellow ) | |
ELSE | |
IF ((j div 20) MOD 2) = 0 THEN TextColor(color) | |
ELSE TextColor(color2); | |
Write( leveldata[i][j] ); | |
END; | |
Writeln; | |
END; | |
{x-mirrored level data} | |
FOR i:=9 DOWNTO 1 DO BEGIN | |
FOR j:=1 TO Length(leveldata[i]) DO BEGIN | |
IF leveldata[i][j] = CHAR_DOT THEN | |
TextColor( Yellow ) | |
ELSE | |
IF ((j div 20) MOD 2) = 0 THEN TextColor(color) | |
ELSE TextColor(color2); | |
Write( leveldata[i][j] ); | |
END; | |
Writeln; | |
END; | |
END; | |
PROCEDURE buildLookupMap; | |
{ prepare x-shrinked game map/collision map for easy leveldata look-up } | |
VAR | |
tmp : WORD; | |
BEGIN | |
FOR i:=1 TO 10 DO | |
FOR j:=1 TO 38 DO BEGIN | |
tmp := MAP_BLANK; | |
IF leveldata[i][2*j-1] | |
IN [CHAR_FWALL, | |
CHAR_LWALL, | |
CHAR_RWALL] THEN tmp := MAP_WALLS; | |
IF leveldata[i][2*j-1] = CHAR_DOT THEN tmp := MAP_DOT; | |
map[j,i] := tmp; | |
map[j,20-i] := tmp; | |
END; | |
END; | |
PROCEDURE renderRunner ( x, y: BYTE; _on : BOOLEAN ); | |
BEGIN | |
Gotoxy(2*x-2, y+3); | |
TextColor(White); | |
CASE _on OF | |
TRUE : Write( STRING_RUNNER ); | |
FALSE : Write(' '); | |
END; | |
END; | |
PROCEDURE renderMonster ( x, y: BYTE; _on, _deflook : BOOLEAN ); | |
BEGIN | |
GotoXY(2*x-2, y+3); | |
CASE _on OF | |
TRUE : IF _deflook THEN Write( STRING_MONSTER ) | |
ELSE Write( STRING_MONSTERA ); | |
FALSE : IF map[x,y] = MAP_DOT THEN BEGIN | |
TextColor(DarkGray); Write(':'); (* trails *) | |
TextColor(Yellow); Write( CHAR_DOT ); | |
TextColor(DarkGray); Write(':'); | |
Textcolor(White); (* should not be here, but I like the artefact it produces *) | |
END | |
ELSE BEGIN | |
TextColor(DarkGray); Write(':::'); | |
TextColor(White); | |
END; | |
END; | |
END; | |
PROCEDURE monster_newpos ( VAR mx, my : BYTE; x, y : BYTE ); | |
{ calc new monster position} | |
VAR ox, oy, r : BYTE; | |
leap : BOOLEAN; | |
BEGIN | |
ox := mx; | |
oy := my; | |
leap := FALSE; {went around the edge?} | |
renderMonster(mx, my, FALSE, FALSE); | |
IF (x > mx) AND (map[SUCC(mx),my] <> MAP_WALLS) THEN mx := SUCC(mx); | |
IF (x < mx) AND (map[PRED(mx),my] <> MAP_WALLS) THEN mx := PRED(mx); | |
IF (y > my) AND (map[mx,SUCC(my)] <> MAP_WALLS) THEN my := SUCC(my); | |
IF (y < my) AND (map[mx,PRED(my)] <> MAP_WALLS) THEN my := PRED(my); | |
{no move yet? try getting around edges; vertical only} | |
IF (ox = mx) AND (oy = my) THEN BEGIN | |
{around left edge (m. down)} | |
IF (mx=x) AND (PRED(PRED(my))=y) AND | |
(map[PRED(mx), my ] <> MAP_WALLS) AND | |
(map[PRED(mx), PRED(my)] <> MAP_WALLS) AND | |
(map[PRED(mx), PRED(PRED(my))] <> MAP_WALLS) AND | |
(map[mx, PRED(my)] = MAP_WALLS ) THEN | |
BEGIN mx := PRED(mx); my := PRED(my); leap := TRUE; END; | |
{around right edge (m. down)} | |
IF (mx=x) AND (PRED(PRED(my))=y) AND NOT leap AND | |
(map[SUCC(mx), my] <> MAP_WALLS) AND | |
(map[SUCC(mx), PRED(my)] <> MAP_WALLS) AND | |
(map[SUCC(mx), PRED(PRED(my))] <> MAP_WALLS) AND | |
(map[mx, PRED(my)] = MAP_WALLS ) THEN | |
BEGIN mx := SUCC(mx); my := PRED(my); leap := TRUE; END; | |
{around left edge (m. up)} | |
IF (mx=x) AND (SUCC(SUCC(my))=y) AND NOT leap AND | |
(map[PRED(mx), my] <> MAP_WALLS) AND | |
(map[PRED(mx), SUCC(my)] <> MAP_WALLS) AND | |
(map[PRED(mx), SUCC(SUCC(my))] <> MAP_WALLS) AND | |
(map[mx, SUCC(my)] = MAP_WALLS ) THEN | |
BEGIN mx := PRED(mx); my := SUCC(my); leap := TRUE; END; | |
{around right edge (m. up)} | |
IF (mx=x) AND (SUCC(SUCC(my))=y) AND NOT leap AND | |
(map[SUCC(mx), my] <> MAP_WALLS) AND | |
(map[SUCC(mx), SUCC(my)] <> MAP_WALLS) AND | |
(map[SUCC(mx), SUCC(SUCC(my))] <> MAP_WALLS) AND | |
(map[mx, SUCC(my)] = MAP_WALLS ) THEN | |
BEGIN mx := SUCC(mx); my := SUCC(my); END; | |
END; | |
renderMonster(mx, my, TRUE, TRUE); | |
END; | |
PROCEDURE ConfigScreen; | |
{ Game Settings Menu } | |
PROCEDURE cleanInfoText; | |
VAR k: WORD; | |
BEGIN | |
FOR k := 10 TO 16 DO BEGIN | |
GotoXY(1,k); | |
ClrEol; | |
END; | |
END; | |
PROCEDURE writeInfo; | |
VAR s: STRING; | |
BEGIN | |
s := '"Regarding the program, it can be said that it cannot quite keep up'; | |
s := s + ' with commercial games of this kind, but it shows that '; | |
s := s + 'one can program an interesting game with relatively little effort" '; | |
WriteXYc(20,10, Cyan, 'Gerd Brinkmann, PACKMANN.DOC, translated'); | |
WriteXYc( 8,11, LightCyan, copy(s, 1, 67) ); | |
WriteXYc( 8,12, LightCyan, copy(s, 68, 67) ); | |
WriteXYc( 8,13, LightCyan, copy(s, 134, 67) ); | |
WriteXYc(35,14, LightBlue, 'April 1989'); | |
WriteXYc(25,16, LightMagenta, 'revised v2.0 by tomaes in 2020') | |
END; | |
PROCEDURE writeArena; BEGIN | |
IF newArena THEN WriteXYc(47,11, LightRed, 'B') | |
ELSE WriteXYc(47,11, LightRed, 'A'); | |
END; | |
PROCEDURE writeStart; BEGIN | |
WriteXYc(45,12, LightRed, IntToStr(startLevel) ); | |
END; | |
PROCEDURE writeDelay; BEGIN | |
WriteXYc(42,13, LightRed, IntToStr(gameDelay) + 'ms' ); | |
END; | |
PROCEDURE writeSFX; BEGIN | |
IF playSFX THEN WriteXYc(42,15, LightRed, 'ON ') | |
ELSE WriteXYc(42,15, Red, 'OFF'); | |
END; | |
PROCEDURE writeSettings( reVals: BOOLEAN ); | |
BEGIN | |
WriteXYc(35,10, White, 'Game Settings'); | |
ClrEol; WriteXYc(35,11, LightRed, 'Arena: Type'); | |
ClrEol; WriteXYc(35,12, LightRed, 'Start: Lv ' ); | |
ClrEol; WriteXYc(35,13, LightRed, 'Delay: '); | |
ClrEol; WriteXYc(35,14, LightRed, 'Info Screen'); | |
ClrEol; WriteXYc(35,15, LightRed, 'Sound: '); | |
ClrEoL; WriteXYc(35,16, Yellow, 'Play' ); | |
ClrEol; | |
IF reVals THEN BEGIN | |
writeArena; writeSFX; | |
writeStart; writeDelay; | |
END; | |
END; | |
VAR | |
opt : WORD; | |
DocText : STRING; | |
cd : STRING; | |
PROCEDURE renderPointer; | |
BEGIN | |
FOR i:=1 TO 6 DO WriteXYc(33, 10+i, 0, ' '); | |
WriteXYc(33, 10+opt, White, CHAR_MENUP); | |
END; | |
BEGIN | |
scrt := FALSE; | |
opt := 1; | |
cd := ''; | |
{ draw horizontal ornaments } | |
FOR i:= 1 TO 9 DO BEGIN | |
WriteXYc(30 + i*2, 8, 4 + i MOD 2, #220#223 ); | |
WriteXYc(30 + i*2,18, 4 + i MOD 2, #223#220 ); | |
delay(40); | |
END; | |
writeSettings(TRUE); | |
renderPointer; | |
REPEAT | |
REPEAT UNTIL KeyPressed; | |
ReadChar(ch); | |
ch := UpCase(ch); | |
{ mmmhh } | |
IF ch IN ['A'..'Z'] THEN BEGIN | |
IF Length(cd) < 13 THEN cd := cd + ch; | |
IF cd = #68#69#82#75#76#69#73#78#69#77#85#67#75 THEN | |
BEGIN | |
scrt := NOT scrt; | |
renderTitle( TRUE ); | |
END; | |
END; | |
CASE ch OF | |
KEY_RETURN: BEGIN | |
cd := ''; | |
CASE opt OF | |
1: BEGIN newArena := NOT newArena; writeArena; END; | |
2: BEGIN | |
IF startLevel < MAXLEVEL THEN inc(startLevel) | |
ELSE startLevel := 1; | |
writeStart; | |
END; | |
3: BEGIN | |
IF gameDelay < MAXGAMEDELAY THEN inc(gameDelay) | |
ELSE gameDelay := MINGAMEDELAY; | |
writeDelay; | |
END; | |
4: BEGIN | |
cleanInfoText; | |
writeInfo; | |
ch := readKey; ch := #32; | |
cleanInfoText; | |
writeSettings(TRUE); | |
renderPointer; | |
END; | |
5: BEGIN | |
playSFX := NOT playSFX; | |
IF playSFX THEN BEGIN | |
sound(500); delay(20); nosound; | |
END; | |
writeSFX; | |
END; | |
END; | |
END; | |
KEY_UP : IF opt > 1 THEN BEGIN dec(opt); renderPointer; END; | |
KEY_DOWN : IF opt < 6 THEN BEGIN inc(opt); renderPointer; END; | |
KEY_RIGHT: BEGIN | |
IF (opt = 1) AND (NOT newArena) THEN BEGIN newArena := TRUE; writeArena; END; | |
IF (opt = 2) AND (startLevel < MAXLEVEL) THEN BEGIN inc(startLevel); writeStart; END; | |
IF (opt = 3) AND (gameDelay < MAXGAMEDELAY) THEN BEGIN inc(gameDelay); writeDelay; END; | |
IF (opt = 5) AND (NOT playSFX) THEN BEGIN | |
playSFX := TRUE; | |
Sound(500); Delay(20); nosound; | |
writeSFX; | |
END; | |
END; | |
KEY_LEFT : BEGIN | |
IF (opt = 1) AND newArena THEN BEGIN newArena := FALSE; writeArena; END; | |
IF (opt = 2) AND (startLevel > 1) THEN BEGIN dec(startLevel); writeStart; END; | |
IF (opt = 3) AND (gameDelay > MINGAMEDELAY) THEN BEGIN dec(gameDelay); writeDelay; END; | |
IF (opt = 5) AND playSFX THEN BEGIN playSFX := FALSE; writeSFX; END; | |
END; | |
END; | |
UNTIL ( (ch = KEY_RETURN) AND (opt = 6) ) or (ch = KEY_ESC); | |
level := startLevel; | |
IF ch = KEY_ESC THEN backToOS := TRUE ELSE backToOS := FALSE; | |
END; | |
PROCEDURE runGame; | |
{ main game loop } | |
PROCEDURE renderScores(_color: BYTE; _points, _level, _hiscore, _dotcount: WORD); | |
BEGIN | |
WriteXYc( 2,23, _color, 'Points:'); | |
WriteXYc(33,23, _color, 'Level:'); | |
WriteXYc(61,23, _color, 'Hiscore:'); | |
WriteXYc(10,23, Yellow, IntToStr(_points) + ' / ' + | |
IntToStr(_dotcount*_level - _dotcount*(startLevel-1)) ); | |
WriteXYc(40,23, Yellow, IntToStr(_level) ); | |
WriteXYc(70,23, Yellow, IntToStr(_hiscore) ); | |
END; | |
PROCEDURE renderArenaType; | |
BEGIN | |
IF newArena THEN ch := 'B' | |
ELSE ch := 'A'; | |
WriteXYc( 36, 2, DarkGray, 'Arena ' + ch ); | |
END; | |
CONST | |
monster_count = 4; | |
VAR | |
points : WORD; | |
px, py : BYTE; | |
mx, my, mdelay : ARRAY[1..monster_count] OF BYTE; | |
collision : BOOLEAN; | |
dotcount : WORD; | |
LABEL | |
RE; | |
BEGIN | |
RE: | |
ClrScr; | |
ConfigScreen; | |
IF backToOS THEN EXIT; | |
points := 0; | |
collision := FALSE; | |
wasPlaying := TRUE; | |
IF newArena THEN dotcount := DOTCOUNT_B | |
ELSE dotcount := DOTCOUNT_A; | |
REPEAT | |
buildLevel(newArena); | |
buildLookupMap; | |
renderTitle( level <> startLevel ); | |
renderPlayMap( LEVEL_COLORS[ level ], LEVEL_COLORSA[ level ] ); | |
renderCredits; | |
renderArenaType; | |
px := 3; py := 2; { position: player } | |
mx[1] := 36; my[1] := 18; { position: monsters } | |
mx[2] := 36; my[2] := 2; | |
mx[3] := 3; my[3] := 18; | |
mx[4] := 20; my[4] := 10; | |
{ monster speed init } | |
FOR i:=1 TO monster_count DO BEGIN | |
mdelay[i] := i*10 - i*level + 1; | |
renderMonster(mx[i], my[i], TRUE, TRUE); | |
END; | |
renderRunner(px, py, TRUE); | |
map[px, py] := MAP_BLANK; | |
{ forget the initial dot the runner is already standing on | |
and the player can't finish a level; and the dotcount modulo breaks } | |
inc(points); | |
renderScores( Red+level+1, points, level, hiscore, dotcount); | |
REPEAT | |
IF KeyPressed THEN BEGIN | |
ReadChar(ch); | |
IF fkey AND (ch IN [KEY_UP, KEY_LEFT, KEY_RIGHT, KEY_DOWN]) THEN BEGIN | |
renderRunner(px, py, FALSE); | |
CASE ch OF | |
KEY_UP : IF map[px, py-1] <> MAP_WALLS THEN dec(py); | |
KEY_LEFT : IF map[px-1, py] <> MAP_WALLS THEN BEGIN | |
dec(px); | |
IF px < MAP_HMIN THEN px := MAP_HMAX; {warp left->right} | |
END; | |
KEY_RIGHT: IF map[px+1,py] <> MAP_WALLS THEN BEGIN | |
inc(px); | |
IF px > MAP_HMAX THEN px := MAP_HMIN; {warp right->left} | |
END; | |
KEY_DOWN : IF map[px, py+1] <> MAP_WALLS THEN inc(py); | |
END; | |
{ collect dot } | |
renderRunner(px, py, TRUE); | |
IF map[px, py] = MAP_DOT THEN BEGIN | |
inc(points); { no overflow check: 3k points is the defacto maximum} | |
map[px, py] := MAP_BLANK; | |
{ score milestone! } | |
IF (points MOD 100 = 0) THEN | |
FOR j := 1 TO 2 DO BEGIN | |
renderScores( White, points, level, hiscore, dotcount); | |
IF playSFX THEN sound(1250 + points div 5); | |
delay(125); | |
renderScores( Black, points, level, hiscore, dotcount); | |
IF playSFX THEN nosound; | |
delay(125); | |
END | |
ELSE | |
IF playSFX THEN sound(1000); | |
renderScores( Red+level+1, points, level, hiscore, dotcount); | |
END ELSE | |
IF playSFX THEN sound(100); | |
END; | |
END; | |
DELAY( gameDelay ); | |
IF playSFX THEN nosound; | |
{ move monsters around } | |
FOR i:=1 TO monster_count DO BEGIN | |
mdelay[i] := PRED(mdelay[i]); | |
IF mdelay[i] = 0 THEN BEGIN | |
mdelay[i] := i*10 - i*level + 1; | |
monster_newpos(mx[i], my[i], px, py); | |
END; | |
{ caught by monster! } | |
IF ( px IN [mx[i],mx[i]-1,mx[i]+1] ) AND (py = my[i]) THEN BEGIN | |
{ the new collision detection is less forgiving } | |
collision := TRUE; | |
renderMonster(mx[i], my[i], FALSE, FALSE); | |
mx[i] := px; my[i] := py; | |
IF playSFX THEN sound(50); | |
{ victory animation } | |
FOR j:=1 TO 10 DO BEGIN | |
renderMonster(mx[i],my[i], TRUE, TRUE); | |
delay(50); | |
renderMonster(mx[i],my[i], TRUE, FALSE); | |
delay(50); | |
END; | |
IF playSFX THEN nosound; | |
END; | |
END; | |
UNTIL (ch = KEY_ESC) OR collision OR (points MOD dotcount = 0); | |
{ level done or game ends } | |
IF (level < MAXLEVEL) AND NOT collision THEN | |
inc(level); { NEW "no end": loop the final stage } | |
UNTIL (ch = KEY_ESC) OR collision; | |
{ update hiscore when a game ends } | |
IF hiscore < points THEN BEGIN | |
hiscore := points; | |
saveScore(hiscore); | |
renderScores( Red+level+1, points, level, hiscore, dotcount); | |
END; | |
IF collision THEN BEGIN | |
WriteXYc(20,25,White,'Press <space> to start a new game!'); | |
IF playSFX THEN Write(#7); {ring my belllll...} | |
REPEAT | |
ReadChar(ch); | |
UNTIL ch = #32; | |
END; | |
GOTO RE; | |
END; | |
PROCEDURE initGlobalVars; | |
BEGIN | |
startLevel := 1; | |
playSFX := TRUE; | |
newArena := FALSE; | |
gameDelay := MINGAMEDELAY; | |
backToOS := FALSE; | |
wasPlaying := FALSE; | |
END; | |
{$IFDEF BORLAND_DOS} | |
FUNCTION wantsMonoMode: BOOLEAN; | |
{ check for 'm'/'M' command line parameter } | |
VAR s: STRING; | |
BEGIN | |
wantsMonoMode := FALSE; | |
IF (ParamCount > 0) THEN BEGIN | |
s := ParamStr(1); | |
IF UpCase(s[1]) = 'M' THEN | |
wantsMonoMode := TRUE; | |
END | |
END; | |
{$ENDIF} | |
(*****************************************************************************************) | |
VAR LastVideoMode: WORD; | |
BEGIN | |
LastVideoMode := LastMode; | |
{$IFDEF BORLAND_DOS} | |
IF wantsMonoMode THEN TextMode(Mono) | |
ELSE TextMode(CO80); | |
{$ENDIF} | |
showCursor(FALSE); | |
initGlobalVars; | |
IF NOT loadScore(hiscore) THEN BEGIN | |
hiscore := DEFHISCORE; | |
saveScore(hiscore); | |
END; | |
runGame; | |
showCursor(TRUE); | |
TextMode(LastVideoMode); | |
IF wasPlaying THEN | |
WriteXYc(1,1, LightGray, 'Thanks for Playing!'#10#13); | |
END. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment