procedure insertPowerPill;
begin
plane3[240*2+32] := $0060;
plane3[240*2+33] := $00F0;
plane3[240*1+34] := plane3[240*1+34] or $0100;
plane3[240*2+34] := plane3[240*2+34] or $00F8;
plane3[240*1+35] := plane3[240*1+35] or $0100;
plane3[240*2+35] := plane3[240*2+35] or $00F8;
plane3[240*2+36] := $00F0;
plane3[240*2+37] := $0060;
plane3[240*18+32] := $6000;
plane3[240*18+33] := $F000;
plane3[240*18+34] := plane3[240*18+34] or $F801;
plane3[240*18+35] := plane3[240*18+35] or $F801;
plane3[240*18+36] := $F000;
plane3[240*18+37] := $6000;
plane3[240*0+193] := $1800;
plane3[240*0+194] := $3C00;
plane3[240*0+195] := plane3[240*0+195] or $7E00;
plane3[240*0+196] := plane3[240*0+196] or $7E00;
plane3[240*0+197] := $3C00;
plane3[240*0+198] := $1800;
plane3[240*18+193] := $6000;
plane3[240*18+194] := $F000;
plane3[240*18+195] := plane3[240*18+195] or $F801;
plane3[240*18+196] := plane3[240*18+196] or $F801;
plane3[240*18+197] := $F000;
plane3[240*18+198] := $6000;
end;
procedure generatebullets;
var
i : integer;
j : integer;
z : integer;
distance : integer;
line : integer;
bullet240 : integer;
bulletshift : integer;
bulletarray : array [1..34] of integer;
const
bulletsplace : array [1..29] of integer = (
0,1,2,2,3,4,4,5,6,6,
7,8,8,9,10,11,11,12,13,13,
14,15,15,16,17,17,18,19,19);
begin
bulletsmax := 0;
for i := 1 to 34 do
begin
bulletarray[i] := bulletsplane[i];
bulletshift := bulletarray[i];
for j := 1 to 16 do
begin
if (bulletshift and $8000) <> 0
then bulletsmax := bulletsmax+1;
bulletshift := bulletshift shl 1;
end;
end;
j := 1;
z := 11;
distance := 12;
repeat
for i := 1 to 29 do
begin
if (bulletarray[j] and $8000) <> 0
then begin
bullet240 := 240*bulletsplace[i]+z;
plane3[bullet240] := plane3[bullet240] or dots[i];
if (i = 13) or (i = 29)
then begin
plane3[bullet240+240] := $0080;
plane3[bullet240+241] := $0080;
end;
plane3[bullet240+1] := plane3[bullet240];
end;
bulletarray[j] := (bulletarray[j] shl 1) or
(bulletarray[j+1] shr 15);
bulletarray[j+1] := bulletarray[j+1] shl 1;
end;
j := j+2;
z := z+distance;
if distance = 12
then distance := 11
else distance := 12;
until z > 200;
insertPowerPill;
for i := 47 to 57 do
plane3[240*8+2*i] := $0000; (* Enemy-Gatter *)
ColorMap[8] := $00;
ColorMap[24] := $00;
LoadColorMap(ColorMap);
Color (switch1);
Operation (1,8);
WriteRectangle(1,maxx-54,1,206,plane3);
Operation (0,15);
ColorMap[8] := $FF;
ColorMap[24] := $FF;
LoadColorMap(ColorMap);
for i := 47 to 57 do
plane3[240*8+2*i] := $0008; (* Enemy-Gatter *)
fruitstart := random(bulletsmax-60)+30;
fruitlength := 700-random(400);
fruitend := 0;
fruitnr := fruitnr+1;
initfruit;
end;
procedure generateenemy;
var
i : integer;
j : integer;
begin
fillchar(enemy,720,0);
enemy[0] := $38;
enemy[1] := $7C;
enemy[2] := $FE;
enemy[3] := $FE;
enemy[4] := $D6;
enemy[5] := $FE;
enemy[6] := $FE;
enemy[7] := $FE;
enemy[8] := $FE;
enemy[9] := $AA;
for i := 10 to 19 do
enemy[i] := $00;
for i := 1 to 17 do
for j := 0 to 9 do
begin
enemy[20*i+j+10] := (enemy[20*i+j-10] shr 1)
or ((enemy[20*i+j-20] shr 1) and $80);
enemy[20*i+j] := ((enemy[20*i+j-20] and $FEFF) shr 1)
or (enemy[20*i+j-20] shl 15);
end;
enemy[360] := $00;
enemy[361] := $00;
enemy[362] := $00;
enemy[363] := $6C;
enemy[364] := $6C;
enemy[365] := $6C;
enemy[366] := $00;
enemy[367] := $00;
enemy[368] := $00;
enemy[369] := $00;
for i := 370 to 379 do
enemy[i] := $00;
for i := 19 to 35 do
for j := 0 to 9 do
begin
enemy[20*i+j+10] := (enemy[20*i+j-10] shr 1)
or ((enemy[20*i+j-20] shr 1) and $80);
enemy[20*i+j] := ((enemy[20*i+j-20] and $FEFF) shr 1)
or (enemy[20*i+j-20] shl 15);
end;
end;
procedure generatepacman;
var
i : integer;
j : integer;
begin
fillchar(pacman,640,0);
pacman[0] := $FE;
pacman[1] := $82;
pacman[2] := $AA;
pacman[3] := $82;
pacman[4] := $92;
pacman[5] := $92;
pacman[6] := $82;
pacman[7] := $BA;
pacman[8] := $82;
pacman[9] := $FE;
for i := 10 to 19 do
pacman[i] := $00;
for i := 1 to 15 do
for j := 0 to 9 do
begin
pacman[20*i+j+10] := (pacman[20*i+j-10] shr 1)
or ((pacman[20*i+j-20] shr 1) and $80);
pacman[20*i+j] := ((pacman[20*i+j-20] and $FEFF) shr 1)
or (pacman[20*i+j-20] shl 15);
end;
pacman[320] := $38;
pacman[321] := $38;
pacman[322] := $92;
pacman[323] := $54;
pacman[324] := $38;
pacman[325] := $38;
pacman[326] := $38;
pacman[327] := $28;
pacman[328] := $44;
pacman[329] := $44;
for i := 330 to 339 do
pacman[i] := $00;
for i := 17 to 31 do
for j := 0 to 9 do
begin
pacman[20*i+j+10] := (pacman[20*i+j-10] shr 1)
or ((pacman[20*i+j-20] shr 1) and $80);
pacman[20*i+j] := ((pacman[20*i+j-20] and $FEFF) shr 1)
or (pacman[20*i+j-20] shl 15);
end;
end;
procedure moveenemy (figurnr : integer);
var
olddir : integer;
s1 : integer;
i : integer;
s : integer;
p : integer;
x : integer;
y : integer;
zz : integer;
r240 : integer;
r248 : integer;
r241 : integer;
r239 : integer;
ghost : integer;
dirok : boolean;
begin
movecount := movecount+1;
if movecount > 10000
then movecount := 0;
if (PowerPill > (kraftmax shr 2)) or
((PowerPill > 0) and ((movecount and $3F) < 32))
then color (blue)
else color (figurnr);
if enemyeaten[figurnr]
then ghost := 360
else ghost := 0;
case enemydir[figurnr] of
0 : (* no movement *)
begin
x := xkoord[figurnr];
y := ykoord[figurnr];
r240 := ((x and $FFF0) shl 4)-(x and $FFF0);
s := x and $F;
if s > 8
then
WriteRectangleTwoBytes (x,y,y+9,plane2,mask5[s],mask6[s],r240)
else WriteRectangleOneByte (x,y,y+9,plane2,mask4[s],r240);
end;
1 : (* up *)
begin
x := xkoord[figurnr];
y := ykoord[figurnr];
r240 := ((x and $FFF0) shl 4)-(x and $FFF0);
r241 := r240+240;
s := x and $F;
q := (s shl 4)+(s shl 2)+ghost;
if y >= 1
then begin
move(enemy[q],plane2[r240+y-1],20);
if s > 8
then begin
move(enemy[q+10],plane2[r241+y-1],20);
WriteRectangleTwoBytes (x,y-1,y+8,plane2,mask5[s],
mask6[s],r240);
Color (white);
WriteRectangleTwoBytes (x,y+9,y+9,plane3,mask5[s],
mask6[s],r240);
end
else begin
WriteRectangleOneByte (x,y-1,y+8,plane2,mask4[s],r240);
Color (white);
WriteRectangleOneByte (x,y+9,y+9,plane3,mask4[s],r240);
end;
ykoord[figurnr] := ykoord[figurnr]-1;
end
else begin
for p := y-1 to -1 do
begin
plane2[r240+p+208] := enemy[q];
q := q+1;
end;
WriteRectangle(x,x+6,y+207,207,plane2);
for p := 0 to y+8 do
begin
plane2[r240+p] := enemy[q];
q := q+1;
end;
WriteRectangle(x,x+6,0,y+8,plane2);
Color (white);
WriteRectangle(x,x+6,y+9,y+9,plane3);
ykoord[figurnr] := ykoord[figurnr]-1;
if ykoord[figurnr] = -10
then ykoord[figurnr] := 198;
end;
y := ykoord[figurnr];
end;
-1 : (* down *)
begin
x := xkoord[figurnr];
y := ykoord[figurnr];
r240 := ((x and $FFF0) shl 4)-(x and $FFF0);
r241 := r240+240;
s := x and $F;
q := (s shl 4)+(s shl 2)+ghost;
if y <= 197
then begin
move(enemy[q],plane2[r240+y+1],20);
if s > 8
then begin
move(enemy[q+10],plane2[r241+y+1],20);
WriteRectangleTwoBytes (x,y+1,y+10,plane2,mask5[s],
mask6[s],r240);
Color (white);
WriteRectangleTwoBytes (x,y,y,plane3,mask5[s],
mask6[s],r240);
end
else begin
WriteRectangleOneByte (x,y+1,y+10,plane2,mask4[s],r240);
Color (white);
WriteRectangleOneByte (x,y,y,plane3,mask4[s],r240);
end;
ykoord[figurnr] := ykoord[figurnr]+1;
end
else begin
q := q+9;
for p := y+10 downto 208 do
begin
plane2[r240+p-208] := enemy[q];
q := q-1;
end;
WriteRectangle(x,x+6,0,y-198,plane2);
for p := 207 downto y+1 do
begin
plane2[r240+p] := enemy[q];
q := q-1;
end;
WriteRectangle(x,x+6,y+1,207,plane2);
Color (white);
WriteRectangle(x+1,x+6,y,y,plane3);
ykoord[figurnr] := ykoord[figurnr]+1;
if ykoord[figurnr] = 208
then ykoord[figurnr] := 0;
end;
y := ykoord[figurnr];
end;
2 : (* left *)
begin
xkoord[figurnr]:= xkoord[figurnr]-1;
x := xkoord[figurnr];
y := ykoord[figurnr];
r240 := ((x and $FFF0) shl 4)-(x and $FFF0);
r241 := r240+240;
r248 := (((x+7) and $FFF0) shl 4)-((x+7) and $FFF0);
s := x and $F;
q := (s shl 4)+(s shl 2)+ghost;
move(enemy[q],plane2[r240+y],20);
s1 := (x+7) and 15;
if s > 8
then begin
move(enemy[q+10],plane2[r241+y],20);
WriteRectangleTwoBytes (x,y,y+9,plane2,mask5[s],
mask6[s],r240);
end
else WriteRectangleOneByte (x,y,y+9,plane2,mask4[s],r240);
Color(switch3);
WriteRectangleOneByte (x+7,y,y+9,plane3,maskleft[s1],r248);
end;
-2 : (* right *)
begin
xkoord[figurnr] := xkoord[figurnr]+1;
x := xkoord[figurnr];
y := ykoord[figurnr];
r240 := ((x and $FFF0) shl 4)-(x and $FFF0);
r241 := r240+240;
r239 := r240-240;
s := x and $F;
q := (s shl 4)+(s shl 2)+ghost;
if s = 0
then begin
move(enemy[q],plane2[r240+y],20);
WriteRectangleOneByte (x,y,y+9,plane2,$01FF,r240);
Color(switch3);
WriteRectangleOneByte (x-1,y,y+9,plane3,maskright[15],r239);
end
else begin
move(enemy[q],plane2[r240+y],20);
if s > 8
then begin
move(enemy[q+10],plane2[r241+y],20);
WriteRectangleTwoBytes (x,y,y+9,plane2,mask5[s],
mask6[s],r240);
end
else WriteRectangleOneByte (x,y,y+9,plane2,mask4[s],r240);
s := (s-1) and $F;
Color(switch3);
WriteRectangleOneByte (x-1,y,y+9,plane3,maskright[s],r240);
end;
end;
end;
olddir := enemydir[figurnr];
r := (x+14) mod 22;
s := (y+16) mod 23;
if (r = 0) and (s = 0)
then begin
r := ((x+14) div 22);
s := ((y+16) div 23);
if enemyeaten[figurnr]
then begin
if closed
then enemydir[figurnr] := gethome[((s-1) shl 4)-(s-1)+r]
else enemydir[figurnr] := gethomefast[((s-1) shl 4)-(s-1)+r];
if enemydir[figurnr] = 0
then begin
enemyeaten[figurnr] := false;
s := x and $F;
q := (s shl 4)+(s shl 2);
move(enemy[q],plane2[r240+y-1],20);
move(enemy[q+10],plane2[r241+y-1],20);
if (PowerPill > (kraftmax shr 2)) or
((PowerPill > 0) and ((movecount and $3F) < 32))
then color (blue)
else color (figurnr);
WriteRectangleTwoBytes (x,y,y+9,plane1,mask5[s],mask6[s],r240);
end;
end
else begin
zz := (s-1)*75+((r-1) shl 2)+r-1;
p := random(20);
if p < aggression
then begin
if xkoordpacman < x
then enemydir[figurnr] := 2
else enemydir[figurnr] := -2;
dirok := false;
for i := 2 to layoutenemy[zz+1]+1 do
begin
if layoutenemy[zz+i] = enemydir[figurnr]
then dirok := true;
end;
if (enemydir[figurnr] = -olddir) or (not dirok)
then begin
if ykoordpacman < y
then enemydir[figurnr] := 1
else enemydir[figurnr] := -1;
dirok := false;
for i := 2 to layoutenemy[zz+1]+1 do
if layoutenemy[zz+i] = enemydir[figurnr]
then dirok := true;
end;
end;
if (not dirok) or
(p >= aggression) or
(enemydir[figurnr] = -olddir) or
(PowerPill > 0)
then repeat
enemydir[figurnr] :=
layoutenemy[zz+random(layoutenemy[zz+1])+2];
until (enemydir[figurnr] <> -olddir) or (random(15) < 2);
end;
end;
end;
procedure activateenemies;
var
i : integer;
begin
for i := 2 to 5 do
begin
xkoord[i] := enemystartx;
ykoord[i] := enemystarty;
enemyeaten[i] := false;
generatefigur (2, xkoord[i], ykoord[i]);
enemydir[i] := 0;
moveenemy (i);
end;
end;
procedure checknewdir;
var
olddir : integer;
r : integer;
s : integer;
i : integer;
begin
olddir := pacmandir;
r := (xkoordpacman+14) mod 22;
s := (ykoordpacman+16) mod 23;
if (r = 0) and (s = 0)
then begin
r := ((xkoordpacman+14) div 22);
s := ((ykoordpacman+16) div 23);
pacmandir := 0;
for i := 2 to layoutpacman[(s-1)*75+((r-1) shl 2)+r]+1 do
begin
if olddir = layoutpacman[(s-1)*75+((r-1) shl 2)+r-1+i]
then pacmandir := olddir;
end;
for i := 2 to layoutpacman[(s-1)*75+((r-1) shl 2)+r]+1 do
begin
if nextpacmandir = layoutpacman[(s-1)*75+((r-1) shl 2)+r-1+i]
then pacmandir := nextpacmandir;
end;
end;
end;
procedure dispatchKeystroke;
begin
case Keystroke.fun_Key of
_UpArrow : nextpacmandir := 1;
_DownArrow : nextpacmandir := -1;
_LeftArrow : nextpacmandir := 2;
_RightArrow : nextpacmandir := -2;
_F20 : begin
repeat
readkbd (Keystroke);
until (Keystroke.fun_key = _UpArrow) or
(Keystroke.fun_key = _DownArrow) or
(Keystroke.fun_key = _LeftArrow) or
(Keystroke.fun_key = _RightArrow) or
(Keystroke.fun_key = _Exit);
dispatchKeystroke;
end;
_Exit : begin
if nextpacmandir <> 0
then begin
GraphicsOff;
Halt;
end;
end;
end;
end;
procedure getnextdir;
begin
readkbd (Keystroke);
dispatchKeystroke;
if abs(pacmandir) = abs(nextpacmandir)
then pacmandir := nextpacmandir;
end;
procedure definespeed;
begin
case aggression and $3 of
0 : begin
speedcounter1 := 2;
speedcounter2 := 0;
end;
1 : begin
speedcounter1 := 2;
speedcounter2 := 1;
end;
2 : begin
speedcounter1 := 1;
speedcounter2 := 1;
end;
3 : begin
speedcounter1 := 1;
speedcounter2 := 2;
end;
end;
speedloop1 := 0;
speedloop2 := speedcounter2+1;
end;
begin
score := 0;
scoreaddon := 0;
scorecarry := 0;
InitGraphics;
nextpacmandir := 0;
backgroundcolor (0);
produceframe;
initgamelayout;
fruitnr := 0;
generatedots;
generatebullets;
initializedigits;
writescoredigit (0, 333, 1);
writescoredigit (0, 341, 0);
writescoredigit (0, 349, 1);
writescoredigit (0, 357, 0);
writescoredigit (0, 365, 1);
writescoredigit (0, 373, 0);
bullets := 0;
nextpacman := 1;
movecount := 0;
generatepacman;
generateenemy;
plane2 := plane1;
fruitdisplay := false;
PowerPill := 0;
Lives := 3;
for i := 1 to Lives do
putpacmeninplace (i);
aggression := 1;
definespeed;
nextghost := 2;
erasefigur (pacmenplacex, 208-18*Lives);
activatepacman;
activateenemies;
while Lives > 0 do
begin
collision := false;
for i := 2 to 5 do
if (abs(xkoordpacman-xkoord[i]) < 5) and
((abs(ykoordpacman-ykoord[i]) mod 208) < 5) and
(not enemyeaten[i])
then begin
collision := true;
if (not enemyeaten[i]) and
(PowerPill > 0)
then begin
if hits > 512
then begin
for j := 1 to hits div 512 do
begin
score := score+600;
scoreaddon := scoreaddon+25;
end;
addscore(0);
end
else addscore(50*hits);
if hits <= 8192
then hits := hits*2;
enemyeaten[i] := true;
end;
end;
if collision and (PowerPill = 0)
then begin
write(chr(7),chr(7),chr(7),chr(7),chr(7));
clearinputbuffer;
Lives := Lives-1;
for i := 2 to 5 do
begin
enemydir[i] := 0;
moveenemy(i);
end;
delay (3000);
if Lives > 0
then begin
erasefigur (xkoordpacman, ykoordpacman);
for i := 2 to 5 do
erasefigur (xkoord[i], ykoord[i]);
erasetunnel;
erasefruit;
fruitstart := random(bulletsmax-60)+30;
fruitend := 0;
erasefigur (pacmenplacex, 208-18*Lives);
activatepacman;
activateenemies;
end;
end
else begin
if PowerPill > 0
then PowerPill := PowerPill-1
else hits := 1;
getnextdir;
checknewdir;
movepacman (pacmandir);
if bullets = bulletsmax
then begin
bullets := 0;
if aggression <= 19
then begin
aggression := aggression+1;
definespeed;
end;
PowerPill := 0;
displayfruit (1);
erasefigur (xkoordpacman, ykoordpacman);
for i := 2 to 5 do
erasefigur (xkoord[i], ykoord[i]);
erasetunnel;
initgamelayout;
generatebullets;
activatepacman;
activateenemies;
end
else if PowerPill > 0
then speed := (1+(aggression shr 2)) shr 1
else speed := 1+(aggression shr 2);
if speedloop2 >= speedcounter2
then begin
for i := 1 to speed do
begin
moveenemy (nextghost);
nextghost := nextghost+1;
if nextghost = 6
then nextghost := 2;
end;
speedloop1 := speedloop1+1;
if speedloop1 >= speedcounter1
then speedloop2 := 0;
end
else begin
for i := 1 to speed+1 do
begin
moveenemy (nextghost);
nextghost := nextghost+1;
if nextghost = 6
then nextghost := 2;
end;
speedloop2 := speedloop2+1;
if speedloop2 >= speedcounter2
then speedloop1 := 0;
end;
end;
end;
