Skip to content

Instantly share code, notes, and snippets.

@tomaes

tomaes/packmann.pas

Last active May 5, 2020 07:19
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save tomaes/7867713a7c700994209a3ba4619515f3 to your computer and use it in GitHub Desktop.
Save tomaes/7867713a7c700994209a3ba4619515f3 to your computer and use it in GitHub Desktop.
Download ZIP
PACK-MANN (1989) by Gerd Brinkmann; translated, fixed, extended. Initial commit: Original version.
Raw
packmann.pas
(**************************************************
*** 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