procedure clearinputbuffer;
var
   regs : Registers;
begin
   with regs do
   begin
       ah := $0C;
       al := $00;
       msdos (regs);
   end;
end;

procedure ReadKbd (var Keys : KeyType);
var
   regs : Registers;
begin  { ReadKbd }
   regs.di := $06;                        { set up to read keyboard          }
   intr ($18,regs);                       { lets read it                     }
   if regs.al <= $65
   then Keys.Fun_Key := F_Keys[regs.al];  { assign function key type name    }
end; { ReadKbd }

procedure GetEnvParam (EnvName : string80; var param : string80);
var
   I        : integer;
   EnvSeg,                       { segment address of environment from PSP }
   EnvIndex : integer;           { index into environment                  }
   TempName : string80;          { current environment string name         }
   ch       : char;              { current character from environment      }
   found    : boolean;           { if true then environment name was found }
begin { GetEnvParam }
   for I := 1 to length(EnvName) do
        EnvName[I] := upcase(EnvName[I]);
   EnvIndex := 0;
   EnvSeg := MemW[CSeg:$2C];       { get address of environment from PSP }
   found := false;
   ch := chr(Mem[EnvSeg:EnvIndex]);         { get first char from environment }
   while (ch <> chr(0)) and (not found) do
     begin
       TempName := '';
       while (ch <> '=') and (length(TempName) < 255) do
         begin                                  { get environment string name }
           TempName := TempName + ch;
           EnvIndex := EnvIndex + 1;
           ch := chr(Mem[EnvSeg:EnvIndex])
         end;
       EnvIndex := EnvIndex + 1;                       { skip over the EQUALS }
       param := '';
       ch := chr(Mem[EnvSeg:EnvIndex]);
       while ch <> chr(0) do               { get environment string parameter }
         begin
           param := param + ch;
           EnvIndex := EnvIndex + 1;
           ch := chr(Mem[EnvSeg:EnvIndex])
         end;
       found := EnvName = TempName;
       EnvIndex := EnvIndex + 1;
       ch := chr(Mem[EnvSeg:EnvIndex])
   end;
   if not found then param := ''
end; { GetEnvParam }

procedure CreateNewTopTenFile;
begin
   rewrite (TopTenFile);
   fillchar (TopTenRecord, 384, 0);
   blockwrite (TopTenFile, TopTenRecord, 3);
   seek (TopTenFile, 0);
end;

procedure GetSystemDate;
var
   regs  : registers;
   day   : string[2];
   month : string[2];
   year  : string[4];
begin
   with regs do
   begin
       ah := $2A;
       msdos (regs);
       str (dl:2, day);
       str (dh:2, month);
       str (cx:4, year);
       ScoreDate := day+'.'+month+'.'+year[3]+year[4];
   end;
end;

procedure printtopten;
begin
   writeln (^[, '[H', ^[, '[J');
   writeln;
   writeln (^[, '#3     Pacman TopTen Liste');
   writeln (^[, '#4     Pacman TopTen Liste');
   writeln;
   writeln;
   writeln ('          Name                    Punkte  Datum');
   writeln;
   for i := 0 to 9 do
   begin
       move (TopTenRecord[32*i+1], name, 20);
       move (TopTenRecord[32*i+21], Pointshi, 2);
       move (TopTenRecord[32*i+23], Pointslo, 2);
       move (TopTenRecord[32*i+25], ScoreDate, 8);
       if TopTenRecord[32*i+1] > 0
       then begin
           if i = lines-1
           then write (^[, '[5m');
           write ('          ',name, ' ');
           if Pointshi = 0
           then write ('     ')
           else write (Pointshi:5);
           if Pointshi > 0
           then begin
               if Pointslo = 0
               then writeln ('0000  ', ScoreDate)
               else if Pointslo < 10
                   then writeln ('00', Pointslo*10:2, '  ', ScoreDate)
                   else if Pointslo < 100
                       then writeln ('0', Pointslo*10:3, '  ', ScoreDate)
                       else writeln (Pointslo*10:4, '  ', ScoreDate);
           end
           else writeln (Pointslo*10:4, '  ', ScoreDate);
           if i = lines-1
           then write (^[, '[0m');
       end
       else writeln;
   end;
   writeln;
   writeln;
end;

procedure TopTen;
begin
   writeln (^[, '[H', ^[, '[J', ^[, '[0m');
   GraphicsOff;
   GetEnvParam ('PACMAN', parameter);
   if parameter = ''
   then parameter := 'pacman.tmp';
   assign (TopTenFile, parameter);
{$I-}
   reset (TopTenFile);
{$I+}
   if IOResult <> 0
   then CreateNewTopTenFile;
   blockread (TopTenFile, TopTenRecord, 3);
   lines := 0;
   scoreaddon := scoreaddon+100*scorecarry;
   inserted := false;
   repeat
       move (TopTenRecord[32*lines+21], Pointshi, 2);
       move (TopTenRecord[32*lines+23], Pointslo, 2);
       if (Pointshi < scoreaddon) or
          ((Pointshi = scoreaddon) and (Pointslo < score))
       then begin
           write ('Ihr werter Name : ');
           readln (name);
           GetSystemDate;
           move (TopTenRecord[32*lines+1], TopTenRecord[32*lines+33], 352-32*lines);
           move (name, TopTenRecord[32*lines+1], 20);
           move (scoreaddon, TopTenRecord[32*lines+21], 2);
           move (score, TopTenRecord[32*lines+23], 2);
           move (ScoreDate, TopTenRecord[32*lines+25], 8);
           inserted := true;
       end;
       lines := lines+1;
   until (lines = 10) or inserted;
   if inserted
   then begin
       seek (TopTenFile, 0);
       blockwrite (TopTenFile, TopTenRecord, 3);
   end
   else lines := 11;
   close (TopTenFile);
   printtopten;
end;

procedure InitGraphics;
var
   p : integer;
begin   { required initialization }
   {        red --+                  green --+                       }
   {              |+-- mono                  |+-- blue               }
   {              ||                         ||                      }
   ColorMap[00]:=$00;         ColorMap[16]:=$00;    {  0  black      }
   ColorMap[01]:=$0E;         ColorMap[17]:=$F0;    {  1  green      }
   ColorMap[02]:=$FD;         ColorMap[18]:=$06;    {  2  red        }
   ColorMap[03]:=$FC;         ColorMap[19]:=$0F;    {  3  red-violet }
   ColorMap[04]:=$8B;         ColorMap[20]:=$0B;    {  4  purple     }
   ColorMap[05]:=$BA;         ColorMap[21]:=$75;    {  5  brown      }
   ColorMap[06]:=$F8;         ColorMap[22]:=$F0;    {  6  yellow     }
   ColorMap[07]:=$FF;         ColorMap[23]:=$FF;    {  7  white      }
   ColorMap[08]:=$00;         ColorMap[24]:=$00;    {  8  switched1  }
   ColorMap[09]:=$00;         ColorMap[25]:=$00;    {  9  switched2  }
   ColorMap[10]:=$97;         ColorMap[26]:=$02;    { 10  dark red   }
   ColorMap[11]:=$F6;         ColorMap[27]:=$70;    { 11  orange     }
   ColorMap[12]:=$05;         ColorMap[28]:=$0F;    { 12  blue       }
   ColorMap[13]:=$04;         ColorMap[29]:=$FD;    { 13  turquoise  }
   ColorMap[14]:=$B3;         ColorMap[30]:=$16;    { 14  burgandy   }
   ColorMap[15]:=$F2;         ColorMap[31]:=$BB;    { 15  pink       }
   { Note.  The colors of the table above have been selected so that:
         *  plane 0 turns on the green gun
         *  plane 1 turns on the red gun
         *  plane 2 turns on the blue gun
         *  plane 3 causes a darkening and reddening of the other colors
       But any other criteria is allowed.}

   for p := 0 to 255 do ScrollMap[p] := p;

   HighResolution:=false;    { Change to 'true' for high resolution demo }
   Ginitialize;              { Initialize                                }
   DualMonitor:=false;       { Dual CRTs                                 }
   { end of required initialization }

   LoadScrollMap(ScrollMap);
   LoadColorMap(ColorMap);   { Load color map                            }
   Operation(0,15);          { REPLACE write to all planes               }
   Pattern(255,4);           { Draw all lines as solid lines             }

   fillchar(plane0,11520,0);
   fillchar(plane1,11520,0);
   fillchar(plane2,11520,0);
   fillchar(plane3,11520,0);

   WriteRectangle(0,maxx,0,maxy,plane0);
   GraphicsOn;               { Switch from VT102 to graphics drive       }

end;

procedure initializedigits;
var
   j : integer;
   i : integer;
begin
   for j := 0 to 9 do
       for i := 0 to 10 do
       begin
           digit[i+2*11*j+11] :=
                   (digitarray[i+11*j] shl 11) or (digitarray[i+11*j] shr 5);
           digit[i+2*11*j] := digitarray[i+11*j] shl 3;
       end;
end;

procedure writescoredigit (scoredigit, xkoord, digitcount : integer);
var
   r : integer;
   i : integer;
   p : integer;
const
   ystart : integer = 20;
   yend   : integer = 30;
begin
   r := (scoredigit shl 4)+(scoredigit shl 2)+(scoredigit shl 1);
   p := ((xkoord and $FFF0) shl 4) - (xkoord and $FFF0);
   if not odd(digitcount)
   then begin
       r := r+11;
       for i := ystart to yend do
       begin
           plane0[p+i] := digit[r]; (* digit[r] Fehler ??? *)
           r := r+1;
       end;
       color (white);
       WriteRectangleOneByte (xkoord, ystart, yend, plane0, $F80F, p);
   end
   else begin
       for i := ystart to yend do
       begin
           plane0[p+i] := digit[r];   (* digit[r] Fehler ??? *)
           plane0[p+i+240] := plane0[p+i];
           r := r+1;
       end;
       color (white);
       WriteRectangleTwoBytes (xkoord, ystart, yend, plane0, $FFF8, $07FF, p);
   end;
end;

procedure writescore (scorevalue, digitplace, digitstart : integer);
var
   scoredigit  : integer;
   scorexkoord : integer;
   digitcount  : integer;
begin
   scorexkoord := digitplace+(digitwidth shl 2);
   digitcount := digitstart;
   repeat
       digitcount := digitcount+1;
       scoredigit := scorevalue mod 10;
       scorevalue := scorevalue div 10;
       writescoredigit (scoredigit, scorexkoord, digitcount);
       scorexkoord := scorexkoord-digitwidth;
   until scorevalue = 0;
end;

procedure producebullets;
var
   i    : integer;
   j    : integer;
   i4   : integer;
   vert : integer;
   hori : integer;
begin
   for i := 0 to 16 do
   begin
       if odd(i)
       then begin
           bulletsplane[2*i+1] := $AAAA;
           bulletsplane[2*i+2] := $AAA8;
       end
       else begin
           bulletsplane[2*i+1] := $FFFF;
           bulletsplane[2*i+2] := $FFF8;
       end;
   end;
   for i := 0 to 8 do
   begin
       i4 := 4*i+1;
       vert := verticallines[i];
       for j := 0 to 7 do
       begin
           vert := vert shl 1;
           if (vert and $8000) <> 0
           then bulletsplane[i4] :=
                                bulletsplane[i4] and not($8000 shr (2*j+1));
       end;
       for j := 0 to 7 do
       begin
           vert := vert shl 1;
           if (vert and $8000) <> 0
           then bulletsplane[i4+1] :=
                                bulletsplane[i4+1] and not($8000 shr (2*j+1));
       end;
   end;
   for i := 0 to 7 do
   begin
       i4 := 4*i+3;
       hori := horizontallines[i+1];
       for j := 0 to 7 do
       begin
           if (hori and $8000) <> 0
           then bulletsplane[i4] :=
                                bulletsplane[i4] and not($8000 shr (2*j));
           hori := hori shl 1;
       end;
       for j := 0 to 7 do
       begin
           if (hori and $8000) <> 0
           then bulletsplane[i4+1] :=
                                bulletsplane[i4+1] and not($8000 shr (2*j));
           hori := hori shl 1;
       end;
   end;
   for i := 1 to 9 do
       for j := 1 to 15 do
       begin
           if gethomefast[(i-1)*15+j] = 0
           then begin
               if j = 1
               then begin
                   if i > 1
                   then bulletsplane[4*i-5] := bulletsplane[4*i-5] and $3FFF;
                   bulletsplane[4*i-3] := bulletsplane[4*i-3] and $3FFF;
                   if i < 9
                   then bulletsplane[4*i-1] := bulletsplane[4*i-1] and $3FFF;
               end
               else if j < 9
                   then begin
                       if i > 1
                       then bulletsplane[4*i-5] :=
                              bulletsplane[4*i-5] and not($E000 shr (2*j-3));
                       bulletsplane[4*i-3] :=
                              bulletsplane[4*i-3] and not($E000 shr (2*j-3));
                       if i < 9
                       then bulletsplane[4*i-1] :=
                              bulletsplane[4*i-1] and not($E000 shr (2*j-3));
                   end
                   else if j = 9
                       then begin
                           if i > 1
                           then begin
                               bulletsplane[4*i-4] :=
                                    bulletsplane[4*i-4] and $3FF8;
                               bulletsplane[4*i-5] :=
                                    bulletsplane[4*i-5] and $FFFE;
                           end;
                           bulletsplane[4*i-2] :=
                                    bulletsplane[4*i-2] and $3FF8;
                           bulletsplane[4*i-3] :=
                                    bulletsplane[4*i-3] and $FFFE;
                           if i < 9
                           then begin
                               bulletsplane[4*i] :=
                                    bulletsplane[4*i] and $3FF8;
                               bulletsplane[4*i-1] :=
                                    bulletsplane[4*i-1] and $FFFE;
                           end;
                       end
                       else begin
                           if i > 1
                           then bulletsplane[4*i-4] :=
                              bulletsplane[4*i-4] and not($E000 shr (2*j-19));
                           bulletsplane[4*i-2] :=
                              bulletsplane[4*i-2] and not($E000 shr (2*j-19));
                           if i < 9
                           then bulletsplane[4*i] :=
                              bulletsplane[4*i] and not($E000 shr (2*j-19));
                       end;
           end;
       end;
   bulletsplane[17] := bulletsplane[17] and $FFE3;
   bulletsplane[18] := bulletsplane[18] and $8FF8;
end;

procedure producegamelayout;
var
   i     : integer;
   j     : integer;
   count : integer;
begin
   fillchar (layoutpacman,1350,0);
   for j := 0 to 8 do
       for i := 1 to 15 do
       begin
           count := 0;
           if ((verticallines[j] shl (i-1)) and $8000) = 0
           then begin
               count := count+1;
               layoutpacman[75*j+5*i-4+count] := 2;
           end;
           if ((verticallines[j] shl i) and $8000) = 0
           then begin
               count := count+1;
               layoutpacman[75*j+5*i-4+count] := -2;
           end;
           if ((horizontallines[j] shl (i-1)) and $8000) = 0
           then begin
               count := count+1;
               layoutpacman[75*j+5*i-4+count] := 1;
           end;
           if ((horizontallines[j+1] shl (i-1)) and $8000) = 0
           then begin
               count := count+1;
               layoutpacman[75*j+5*i-4+count] := -1;
           end;
           layoutpacman[75*j+5*i-4] := count;
       end;
   layoutpacman[326] := layoutpacman[326]-1;
   for i := 327 to 330 do
       if layoutpacman[i] = -2
       then begin
           for j := i to 329 do
               layoutpacman[j] := layoutpacman[j+1];
           layoutpacman[330] := 0;
       end;
   move (layoutpacman,layoutenemy,1350);
end;

procedure producegethomefast;
var
   i           : integer;
   j           : integer;
   k           : integer;
   index       : integer;
   gethometemp : array [1..135] of integer;
   changed     : boolean;
begin
   producegamelayout;
   fillchar (gethometemp,270,0);
   gethometemp[66] := -2;
   repeat
       move (gethometemp,gethomefast,270);
       changed := false;
       for i := 1 to 9 do
       begin
           for j := 1 to 15 do
           begin
               if gethomefast[(i-1)*15+j] <> 0
               then begin
                   for k := 1 to layoutpacman[((i-1)*15+j-1)*5+1] do
                   begin
                       case layoutpacman[((i-1)*15+j-1)*5+1+k] of
                           1 : begin
                                   index := ((i-2)*15+j) mod 135;
                                   if index <= 0
                                   then index := index+135;
                                   if gethomefast[index] = 0
                                   then begin
                                       gethometemp[index] := -1;
                                       changed := true;
                                   end;
                               end;
                          -1 : begin
                                   index := (i*15+j) mod 135;
                                   if index <= 0
                                   then index := index+135;
                                   if gethomefast[index] = 0
                                   then begin
                                       gethometemp[index] := 1;
                                       changed := true;
                                   end;
                               end;
                           2 : begin
                                   if gethomefast[(i-1)*15+j-1] = 0
                                   then begin
                                       gethometemp[(i-1)*15+j-1] := -2;
                                       changed := true;
                                   end;
                               end;
                          -2 : begin
                                   if gethomefast[(i-1)*15+j+1] = 0
                                   then begin
                                       gethometemp[(i-1)*15+j+1] := 2;
                                       changed := true;
                                   end;
                               end;
                       end;
                   end;
               end;
           end;
       end;
   until not changed;
end;

procedure produceverticalline (vert, mask, posit, lineval, line : integer);
var
   j : integer;
begin
   if (vert and mask) <> 0
   then begin
       plane0[240*posit+23*line] := plane0[240*posit+23*line] or lineval;
       for j := 1 to 22 do
           plane0[240*posit+23*line+j] := lineval;
       plane0[240*posit+23*(line+1)] := plane0[240*posit+23*(line+1)] or
                                                                      lineval;
   end;
end;

procedure producehorizontalline (horiz, mask, posit,
                                lineval1, lineval2, lineval3, line : integer);
begin
   if (horiz and mask) <> 0
   then begin
       plane0[240*posit+23*line] := plane0[240*posit+23*line] or lineval1;
       plane0[240*(posit+1)+23*line] := lineval2;
       if lineval3 <> $0000
       then plane0[240*(posit+2)+23*line] := lineval3;
   end;
end;

procedure CheckForEnclosedPowerPill;
begin
   if gethomefast[17] = 0
   then begin
       if gethomefast[2] <> 0
       then horizontallines[1] := horizontallines[1] and $BFFF
       else if gethomefast[32] <> 0
           then horizontallines[2] := horizontallines[2] and $BFFF
           else if gethomefast[16] <> 0
               then verticallines[1] := verticallines[1] and $BFFF
               else if gethomefast[18] <> 0
                   then verticallines[1] := verticallines[1] and $DFFF;
   end;
   if gethomefast[29] = 0
   then begin
       if gethomefast[14] <> 0
       then horizontallines[1] := horizontallines[1] and $FFFA
       else if gethomefast[44] <> 0
           then horizontallines[2] := horizontallines[2] and $FFFA
           else if gethomefast[13] <> 0
               then verticallines[1] := verticallines[1] and $FFFB
               else if gethomefast[15] <> 0
                   then verticallines[1] := verticallines[1] and $FFFD;
   end;
   if gethomefast[121] = 0
   then begin
       if gethomefast[106] <> 0
       then horizontallines[8] := horizontallines[8] and $7FFF
       else if (gethomefast[106] = 0) and (gethomefast[91] <> 0)
           then begin
               horizontallines[8] := horizontallines[8] and $7FFF;
               horizontallines[7] := horizontallines[7] and $7FFF;
           end
           else if gethomefast[122] <> 0
               then verticallines[8] := verticallines[8] and $BFFF
               else if (gethomefast[122] = 0) and (gethomefast[123] <> 0)
                   then verticallines[8] := verticallines[8] and $9FFF;
   end;
   if gethomefast[134] = 0
   then begin
       if gethomefast[119] <> 0
       then horizontallines[8] := horizontallines[8] and $FFFA
       else if gethomefast[133] <> 0
           then verticallines[8] := verticallines[8] and $FFFB
           else if gethomefast[135] <> 0
               then verticallines[8] := verticallines[8] and $FFFD;
   end;
end;

function NullNeighbours : integer;
var
   i        : integer;
   j        : integer;
   countmax : integer;
   nulls    : array [1..135] of integer;
begin
   countmax := 0;
   fillchar (nulls,270,0);
   for i := 1 to 135 do
       if gethomefast[i] = 0
       then nulls[i] := 1;
   for i := 1 to 120 do
       if (nulls[i] > 0) and (nulls[i+15] > 0)
       then nulls[i+15] := nulls[i+15]+nulls[i];
   for i := 135 downto 16 do
       if (nulls[i] > 0) and (nulls[i-15] > 0)
       then nulls[i-15] := nulls[i];
   for i := 1 to 135 do
       if (i mod 15) > 0
       then begin
           if (nulls[i] > 0) and (nulls[i+1] > 0)
           then nulls[i+1] := nulls[i+1]+nulls[i];
           if nulls[i] > countmax
           then countmax := nulls[i];
       end;
   NullNeighbours := countmax;
end;

procedure generatepicturelayout;
var
   i          : integer;
   j          : integer;
   linecount  : integer;
   probab     : integer;
   trycount   : integer;
const
   probab1    : integer = 30;
   probab2    : integer = 15;
   probab3    : integer = 5;
   probab4    : integer = 2;
begin
   j := random(15);
   if j < 7
   then begin
       for i := 0 to 9 do
           horizontallines[i] := horizontallinesconst[i+j*10];
       for i := 0 to 8 do
           verticallines[i] := verticallinesconst[i+j*9];
   end
   else begin
       repeat
           fillchar (horizontallines,20,0);
           for i := 0 to 8 do
               verticallines[i] := $8001;
           horizontallines[0] := $FEFE;
           horizontallines[4] := $0200;
           horizontallines[5] := $0200;
           horizontallines[9] := $FEFE;
           verticallines[4] := $8161;
           for i := 0 to 15 do
               for j := 0 to 9 do
               begin
                   probab := random(probab1+probab2+probab3+probab4);
                   if probab < probab1
                   then probab := 1
                   else if probab < probab1+probab2
                       then probab := 2
                       else if probab < probab1+probab2+probab3
                           then probab := 3
                           else probab := 4;
                   linecount := 0;
                   if i > 0
                   then begin
                       if (horizontallines[j] and ($8000 shr (i-1))) <> 0
                       then linecount := linecount+1;
                   end;
                   if i < 15
                   then begin
                       if (horizontallines[j] and ($8000 shr i)) <> 0
                       then linecount := linecount+1;
                   end;
                   if j > 0
                   then begin
                       if (verticallines[j-1] and ($8000 shr i)) <> 0
                       then linecount := linecount+1;
                   end;
                   if j < 9
                   then begin
                       if (verticallines[j] and ($8000 shr i)) <> 0
                       then linecount := linecount+1;
                   end;
                   trycount := 0;
                   while (linecount < probab) and
                         ((linecount = 0) or (trycount < 20)) do
                   begin
                       case random(2) of
                           0 : if (i < 14) or ((i < 15) and (random(2) < 1))
                               then begin
                                   horizontallines[j] :=
                                           horizontallines[j] or ($8000 shr i);
                                   linecount := linecount+1;
                               end;
                           1 : if (j < 8) or ((j < 9) and (random(2) < 1))
                               then begin
                                   verticallines[j] :=
                                             verticallines[j] or ($8000 shr i);
                                   linecount := linecount+1;
                               end;
                       end;
                       trycount := trycount+1;
                   end;
               end;
           horizontallines[0] := $FEFE;
           horizontallines[4] := horizontallines[4] or $0040;
           horizontallines[5] := horizontallines[5] or $0040;
           horizontallines[9] := $FEFE;
           verticallines[4] := verticallines[4] and $FDFF;
           producegethomefast;
       until (NullNeighbours < 4) and (gethomefast[55] <> 0)
                                                  and (gethomefast[85] <> 0);
       CheckForEnclosedPowerPill;
   end;
   horizontallines[4] := horizontallines[4] or $0040;
   horizontallines[5] := horizontallines[5] or $0040;
   producegethomefast;
   move (gethomefast,gethome,270);
   horizontallines[4] := horizontallines[4] and $FFBE;
   horizontallines[5] := horizontallines[5] and $FFBE;
   producegethomefast;
end;

procedure initgamelayout;
var
   i          : integer;
   j          : integer;
   horizontal : integer;
   vertical   : integer;
begin
   generatepicturelayout;
   for i := 0 to 20 do
       for j := 0 to 207 do
           plane0[240*i+j] := $0000;
   for i := 0 to 9 do
   begin
       horizontal := horizontallines[i];
       producehorizontalline (horizontal,$8000,0,$FFFF,$00FE,$0000,i);
       producehorizontalline (horizontal,$4000,1,$FF03,$F8FF,$0000,i);
       producehorizontalline (horizontal,$2000,2,$0F00,$FFFF,$00E0,i);
       producehorizontalline (horizontal,$1000,4,$FF3F,$80FF,$0000,i);
       producehorizontalline (horizontal,$0800,5,$FF00,$FEFF,$0000,i);
       producehorizontalline (horizontal,$0400,6,$0300,$FFFF,$00F8,i);
       producehorizontalline (horizontal,$0200,8,$FF0F,$E0FF,$0000,i);
       producehorizontalline (horizontal,$0100,9,$3F00,$FFFF,$0080,i);
       producehorizontalline (horizontal,$0080,11,$FFFF,$00FE,$0000,i);
       producehorizontalline (horizontal,$0040,12,$FF03,$F8FF,$0000,i);
       producehorizontalline (horizontal,$0020,13,$0F00,$FFFF,$00E0,i);
       producehorizontalline (horizontal,$0010,15,$FF3F,$80FF,$0000,i);
       producehorizontalline (horizontal,$0008,16,$FF00,$FEFF,$0000,i);
       producehorizontalline (horizontal,$0004,17,$0300,$FFFF,$00F8,i);
       producehorizontalline (horizontal,$0002,19,$FF0F,$E0FF,$0000,i);
   end;
   for i := 0 to 8 do
   begin
       vertical := verticallines[i];
       produceverticalline (vertical,$8000,0,$0080,i);
       produceverticalline (vertical,$4000,1,$0002,i);
       produceverticalline (vertical,$2000,2,$0800,i);
       produceverticalline (vertical,$1000,4,$0020,i);
       produceverticalline (vertical,$0800,5,$8000,i);
       produceverticalline (vertical,$0400,6,$0200,i);
       produceverticalline (vertical,$0200,8,$0008,i);
       produceverticalline (vertical,$0100,9,$2000,i);
       produceverticalline (vertical,$0080,11,$0080,i);
       produceverticalline (vertical,$0040,12,$0002,i);
       produceverticalline (vertical,$0020,13,$0800,i);
       produceverticalline (vertical,$0010,15,$0020,i);
       produceverticalline (vertical,$0008,16,$8000,i);
       produceverticalline (vertical,$0004,17,$0200,i);
       produceverticalline (vertical,$0002,19,$0008,i);
       produceverticalline (vertical,$0001,20,$2000,i);
   end;
   plane0[240*20+0] := plane0[240*20+0] or $1F00;
   plane0[240*20+207] := plane0[240*20+207] or $1F00;
   producebullets;
   ColorMap[10] := $00;
   ColorMap[26] := $00;
   LoadColorMap(ColorMap);
   color(switch3);
   for i := 47 to 57 do
       plane0[240*8+2*i] := $0008;  (* Enemy-Gatter *)
   WriteRectangle(1,maxx-54,1,206,plane0);
   ColorMap[10] := $FF;
   ColorMap[26] := $FF;
   LoadColorMap(ColorMap);
   closed := false;
end;

procedure produceframe;
begin
   for i := 0 to 23 do
   begin
       plane0[240*i+0] := $FFFF;
       plane0[240*i+207] := $FFFF;
   end;
   plane0[240*9+0] := $E0FF;
   plane0[240*9+207] := $E0FF;
   plane0[240*10+0] := $0000;
   plane0[240*10+207] := $0000;
   for i := 1 to 206 do
   begin
       plane0[240*0+i] := $0080;
       plane0[240*20+i] := $2000;
       plane0[240*23+i] := $0100;
   end;
   ColorMap[09] := $00;
   ColorMap[25] := $00;
   LoadColorMap(ColorMap);
   color(switch2);
   WriteRectangle(0,maxx,0,0,plane0);
   WriteRectangle(0,maxx,207,207,plane0);
   WriteRectangle(0,0,0,207,plane0);
   WriteRectangle(maxx-53,maxx,1,maxy-1,plane0);
   ColorMap[09] := $FF;
   ColorMap[25] := $FF;
end;

procedure generatefigur (figurtype, xkoord, ykoord : integer);
begin
   case figurtype of
   1 : begin
           r := 240*(xkoord shr 4);
           s := 20*(xkoord and $F);
           move(pacman[s],plane1[r+ykoord],20);
           move(pacman[s+10],plane1[r+240+ykoord],20);
       end;
   2 : begin
           r := 240*(xkoord shr 4)+ykoord;
           s := 20*(xkoord and $F);
           move(enemy[s],plane1[r],20);
           move(enemy[s+10],plane1[r+240],20);
       end;
   end;
end;

procedure erasefruit;
var
   i : integer;
begin
   fruitdisplay := false;
   fruitend := fruitend+1;
   if closed
   then begin
       layoutenemy[271] := layoutenemy[271]+1;
       layoutenemy[271+layoutenemy[271]] := -1;
       layoutenemy[421] := layoutenemy[421]+1;
       layoutenemy[421+layoutenemy[421]] := 1;
   end;
   closed := false;
   for i := 94 to 114 do
   begin
       plane0[240*13+i] := $0000;
       plane0[240*12+i] := $0000;
   end;
   writerectangle (199,219,94,114,plane0);
end;

procedure initfruit;
var
   i        : integer;
   j        : integer;
   fruitpos : integer;
begin
   fruitpos := ((fruitnr-1) mod 10)+1;
   j := 94;
   i := (fruitpos-1)*42;
   repeat
       plane0[240*12+j] := fruitarray[i];
       plane0[240*13+j] := fruitarray[i+1];
       plane0[240*2*(fruitpos-1)+j+121] := fruitarray[i];
       plane0[240*(2*(fruitpos-1)+1)+j+121] := fruitarray[i+1];
       i := i+2;
       j := j+1;
   until i = fruitpos*42;
end;

procedure displayfruit (where : integer);
var
   i        : integer;
   j        : integer;
   fruitpos : integer;
   xlo      : integer;
   xhi      : integer;
   ylo      : integer;
   yhi      : integer;
begin
   fruitpos := ((fruitnr-1) mod 10)+1;
   if where = 0
   then begin
       xlo := 199;
       xhi := 219;
       ylo := 94;
       yhi := 114;
   end
   else begin
       xlo := 7+((fruitpos-1) shl 5);
       xhi := xlo+20;
       ylo := 215;
       yhi := 235;
       if fruitpos = 1
       then writerectangle (0,maxx,215,235,plane1);
   end;
   case fruitpos of
   1 : (* Birne *)
       begin
           Color (green);
           writerectangle (xlo,xhi,ylo+6,yhi,plane0);
           Color (brown);
           writerectangle (xlo,xhi,ylo,ylo+5,plane0);
           writerectangle (xlo+9,xlo+9,ylo+6,ylo+6,plane0);
       end;
   2 : (* Ananas *)
       begin
           Color (green);
           writerectangle (xlo,xhi,ylo,ylo+5,plane0);
           Color (brown);
           writerectangle (xlo,xhi,ylo+6,yhi,plane0);
       end;
   3 : (* Zitrone *)
       begin
           color (yellow);
           writerectangle (xlo,xhi,ylo,yhi,plane0);
       end;
   4 : (* Kokosnu� *)
       begin
           color (brown);
           writerectangle (xlo,xhi,ylo+9,yhi,plane0);
           color (white);
           writerectangle (xlo,xhi,ylo,ylo+8,plane0);
           writerectangle (xlo+3,xlo+16,ylo+9,ylo+9,plane0);
           writerectangle (xlo+5,xlo+14,ylo+10,ylo+10,plane0);
           writerectangle (xlo+8,xlo+11,ylo+11,ylo+11,plane0);
       end;
   5 : (* Pflaume *)
       begin
           color (brown);
           writerectangle (xlo,xhi,ylo,ylo+7,plane0);
           color (purple);
           writerectangle (xlo,xhi,ylo+8,yhi,plane0);
       end;
   6 : (* Erdbeere *)
       begin
           color (red);
           writerectangle (xlo,xhi,ylo,yhi,plane0);
           color (green);
           writerectangle (xlo+9,xlo+11,ylo,ylo+6,plane0);
           Color (white);
           writerectangle (xlo+13,xlo+13,ylo+7,ylo+7,plane0);
           writerectangle (xlo+8,xlo+8,ylo+8,ylo+8,plane0);
           writerectangle (xlo+11,xlo+11,ylo+8,ylo+8,plane0);
           writerectangle (xlo+9,xlo+9,ylo+10,ylo+10,plane0);
           writerectangle (xlo+13,xlo+13,ylo+10,ylo+10,plane0);
           writerectangle (xlo+11,xlo+11,ylo+12,ylo+12,plane0);
           writerectangle (xlo+9,xlo+9,ylo+13,ylo+13,plane0);
           writerectangle (xlo+10,xlo+10,ylo+15,ylo+15,plane0);
       end;
   7 : (* Weintraube *)
       begin
           color (brown);
           writerectangle (xlo,xhi,ylo,ylo+4,plane0);
           Color (green);
           writerectangle (xlo,xhi,ylo+5,yhi,plane0);
       end;
   8 : (* Banane *)
       begin
           color (yellow);
           writerectangle (xlo,xhi,ylo,yhi,plane0);
       end;
   9 : (* Apfelsine *)
       begin
           color (orange);
           writerectangle (xlo,xhi,ylo+2,yhi,plane0);
           Color (green);
           writerectangle (xlo,xhi,ylo,ylo+1,plane0);
           writerectangle (xlo+9,xlo+10,ylo+2,ylo+2,plane0);
       end;
  10 : (* Kirsche *)
       begin
           color (red);
           writerectangle (xlo,xhi,ylo+8,yhi,plane0);
           Color (green);
           writerectangle (xlo,xhi,ylo,ylo+7,plane0);
           writerectangle (xlo+9,xlo+10,ylo+8,ylo+8,plane0);
       end;
   end;
end;

procedure movepacman (direction : integer);
var
   i     : integer;
   p     : integer;
   q     : integer;
   s     : integer;
   s1    : integer;
   r240  : integer;
   r248  : integer;
   r239  : integer;
   r241  : integer;
   eater : integer;
begin
   if fruitdisplay
   then begin
   fruitend := fruitend+1;
   end;
   if PowerPill > 0
   then begin
       movecount := movecount+1;
       eater := 320;
       color (green);
   end
   else begin
       eater := 0;
       color (yellow);
   end;
   case direction of
       0 : (* no movement *)
           begin
               r240 := ((xkoordpacman and $FFF0) shl 4)-
                                                     (xkoordpacman and $FFF0);
               r241 := r240+240;
               s := xkoordpacman and $F;
               q := (s shl 4)+(s shl 2)+eater;
               move(pacman[q],plane1[r240+ykoordpacman],20);
               if s > 8 then begin
                   move(pacman[q+10],plane1[r241+ykoordpacman],20);
                   WriteRectangleTwoBytes (xkoordpacman,
                                           ykoordpacman,
                                             ykoordpacman+9,
                                               plane1,
                                                 mask5[s],
                                                   mask6[s],
                                                     r240);
               end
               else WriteRectangleOneByte (xkoordpacman,
                                            ykoordpacman,
                                              ykoordpacman+9,
                                                plane1,
                                                  mask4[s],
                                                    r240);
           end;
       1 : (* up *)
           begin
               r240 := ((xkoordpacman and $FFF0) shl 4)-
                                                     (xkoordpacman and $FFF0);
               r241 := r240+240;
               s := xkoordpacman and $F;
               q := (s shl 4)+(s shl 2)+eater;
               if (ykoordpacman-1 >= 0) and (ykoordpacman-1 < 198)
               then begin
                   move(pacman[q],plane1[r240+ykoordpacman-1],20);
                   ykoordpacman := ykoordpacman-1;
                   if s > 8
                   then begin
                       move(pacman[q+10],plane1[r241+ykoordpacman],20);
                       WriteRectangleTwoBytes (xkoordpacman,
                                               ykoordpacman,
                                                 ykoordpacman+9,
                                                   plane1,
                                                     mask5[s],
                                                       mask6[s],
                                                         r240);
                       Color(white);
                       WriteRectangleTwoBytes (xkoordpacman,
                                               ykoordpacman+10,
                                                 ykoordpacman+10,
                                                   plane3,
                                                     mask5[s],
                                                       mask6[s],
                                                         r240);
                   end
                   else begin
                       WriteRectangleOneByte (xkoordpacman,
                                               ykoordpacman,
                                                 ykoordpacman+9,
                                                   plane1,
                                                     mask4[s],
                                                       r240);
                       Color(white);
                       WriteRectangleOneByte (xkoordpacman,
                                               ykoordpacman+10,
                                                 ykoordpacman+10,
                                                   plane3,
                                                     mask4[s],
                                                       r240);
                   end;
               end
               else begin
                   if ykoordpacman >= 198
                   then ykoordpacman := ykoordpacman-208;
                   for p := ykoordpacman-1 to -2 do
                   begin
                       plane1[r240+p+208] := pacman[q];
                       q := q+1;
                   end;
                   plane1[r240+207] := pacman[q];
                   q := q+1;
                   for p := 0 to ykoordpacman+8 do
                   begin
                       plane1[r240+p] := pacman[q];
                       q := q+1;
                   end;
                   WriteRectangle(xkoordpacman,
                                    xkoordpacman+6,
                                      ykoordpacman+207,
                                        207,
                                          plane1);
                   WriteRectangle(xkoordpacman,
                                    xkoordpacman+6,
                                      0,
                                        ykoordpacman+8,
                                          plane1);
                   Color(white);
                   WriteRectangle(xkoordpacman,
                                    xkoordpacman+6,
                                      ykoordpacman+9,
                                        ykoordpacman+9,
                                          plane3);
                   ykoordpacman := ykoordpacman-1;
                   if ykoordpacman = -10
                   then ykoordpacman := 198; (* 207-10+1 *)
               end;
           end;
      -1 : (* down *)
           begin
               r240 := ((xkoordpacman and $FFF0) shl 4)-
                                                     (xkoordpacman and $FFF0);
               r241 := r240+240;
               s := xkoordpacman and $F;
               q := (s shl 4)+(s shl 2)+eater;
               if (ykoordpacman+10 < 208) and (ykoordpacman >= 0)
               then begin
                   move(pacman[q],plane1[r240+ykoordpacman+1],20);
                   ykoordpacman := ykoordpacman+1;
                   if s > 8
                   then begin
                       move(pacman[q+10],plane1[r241+ykoordpacman],20);
                       WriteRectangleTwoBytes (xkoordpacman,
                                               ykoordpacman-1,
                                                 ykoordpacman+9,
                                                   plane1,
                                                     mask5[s],
                                                       mask6[s],
                                                         r240);
                       Color(white);
                       WriteRectangleTwoBytes (xkoordpacman,
                                               ykoordpacman-1,
                                                 ykoordpacman-1,
                                                   plane3,
                                                     mask5[s],
                                                       mask6[s],
                                                         r240);
                   end
                   else begin
                       WriteRectangleOneByte (xkoordpacman,
                                               ykoordpacman-1,
                                                 ykoordpacman+9,
                                                   plane1,
                                                     mask4[s],
                                                       r240);
                       Color(white);
                       WriteRectangleOneByte (xkoordpacman,
                                               ykoordpacman-1,
                                                 ykoordpacman-1,
                                                   plane3,
                                                     mask4[s],
                                                       r240);
                   end;
               end
               else begin
                   if ykoordpacman <= 0
                   then ykoordpacman := ykoordpacman+208;
                   q := q+9;
                   for p := ykoordpacman+10 downto 209 do
                   begin
                       plane1[r240+p-208] := pacman[q];
                       q := q-1;
                   end;
                   plane1[r240] := pacman[q];
                   q := q-1;
                   for p := 207 downto ykoordpacman+1 do
                   begin
                       plane1[r240+p] := pacman[q];
                       q := q-1;
                   end;
                   WriteRectangle(xkoordpacman,
                                    xkoordpacman+6,
                                      0,
                                        ykoordpacman-198,
                                          plane1);
                   WriteRectangle(xkoordpacman,
                                    xkoordpacman+6,
                                      ykoordpacman+1,
                                        207,
                                          plane1);
                   Color(white);
                   WriteRectangle(xkoordpacman,
                                    xkoordpacman+6,
                                      ykoordpacman,
                                        ykoordpacman,
                                          plane3);
                   ykoordpacman := ykoordpacman+1;
                   if ykoordpacman = 208
                   then ykoordpacman := 0;
               end;
           end;
       2 : (* left *)
           begin
               xkoordpacman := xkoordpacman-1;
               r240 := ((xkoordpacman and $FFF0) shl 4)-
                                                     (xkoordpacman and $FFF0);
               r241 := r240+240;
               r248 := (((xkoordpacman+7) and $FFF0) shl 4)-
                                                ((xkoordpacman+7) and $FFF0);
               s := xkoordpacman and $F;
               q := (s shl 4)+(s shl 2)+eater;
               move(pacman[q],plane1[r240+ykoordpacman],20);
               s1 := (xkoordpacman+7) and $F;
               if s > 8
               then begin
                   move(pacman[q+10],plane1[r241+ykoordpacman],20);
                   WriteRectangleTwoBytes (xkoordpacman,
                                           ykoordpacman,
                                             ykoordpacman+9,
                                               plane1,
                                                 mask5[s],
                                                   mask6[s],
                                                     r240);
               end
               else WriteRectangleOneByte (xkoordpacman,
                                            ykoordpacman,
                                              ykoordpacman+9,
                                                plane1,
                                                  mask4[s],
                                                    r240);
               Color(white);
               WriteRectangleOneByte (xkoordpacman+7,
                                       ykoordpacman,
                                         ykoordpacman+9,
                                           plane3,
                                             maskleft[s1],
                                               r248);
           end;
      -2 : (* right *)
           begin
               xkoordpacman := xkoordpacman+1;
               r240 := ((xkoordpacman and $FFF0) shl 4)-
                                                     (xkoordpacman and $FFF0);
               r241 := r240+240;
               r239 := r240-240;
               s := xkoordpacman and $F;
               q := (s shl 4)+(s shl 2)+eater;
               if s = 0
               then begin
                   move(pacman[q],plane1[r240+ykoordpacman],20);
                   WriteRectangleOneByte (xkoordpacman,
                                           ykoordpacman,
                                             ykoordpacman+9,
                                               plane1,
                                                 $01FF,
                                                   r240);
                   Color(white);
                   WriteRectangleOneByte (xkoordpacman-1,
                                           ykoordpacman,
                                             ykoordpacman+9,
                                               plane3,
                                                 maskright[15],
                                                   r239);
               end
               else begin
                   move(pacman[q],plane1[r240+ykoordpacman],20);
                   if s > 8
                   then begin
                       move(pacman[q+10],plane1[r241+ykoordpacman],20);
                       WriteRectangleTwoBytes (xkoordpacman,
                                               ykoordpacman,
                                                 ykoordpacman+9,
                                                   plane1,
                                                     mask5[s],
                                                       mask6[s],
                                                         r240);
                   end
                   else WriteRectangleOneByte (xkoordpacman,
                                                ykoordpacman,
                                                  ykoordpacman+9,
                                                    plane1,
                                                      mask4[s],
                                                        r240);
                   s := (s-1) and $F;
                   Color(white);
                   WriteRectangleOneByte (xkoordpacman-1,
                                           ykoordpacman,
                                             ykoordpacman+9,
                                               plane3,
                                                 maskright[s],
                                                   r240);
               end;
           end;
   end;
   if (direction <> 0) and (ykoordpacman > 0)
   then begin
       s := ykoordpacman mod 23;
       if s = 7
       then s := ykoordpacman+4
       else if s = 18
           then s := ykoordpacman+5
           else s := -1;
       if s > 0
       then begin
           r240 := (((xkoordpacman+3) and $FFF0) shl 4)-
                                                 ((xkoordpacman+3) and $FFF0);
           r241 := r240+240;
           q := (xkoordpacman+3) div 11;
           if ((plane3[r240+s] and dots[q]) <> 0) and
              ((xkoordpacman mod 11) = 8)
           then begin
               bullets := bullets+1;
               plane3[r240+s] := plane3[r240+s] and not dots[q];
               plane3[r240+s+1] := plane3[r240+s];
               if dots[q] = $0100
               then begin
                   plane3[r241+s] := plane3[r241+s] and not $0080;
                   plane3[r241+s+1] := plane3[r241+s];
               end;
               addscore (1);
           end;
       end;
   end;
   if (xkoordpacman = 8) and
      (ykoordpacman = 191) and
      (plane3[193] <> 0)
   then begin
       PowerPill := kraftmax-25*aggression;
       for i := 193 to 198 do
           plane3[i] := $0000;
       addscore (4);
   end
   else begin
       if (xkoordpacman = 30) and
          (ykoordpacman = 30) and
          (plane3[512] <> 0)
       then begin
           PowerPill := kraftmax-25*aggression;;
           for i := 32 to 37 do
           begin
               plane3[240+i] := plane3[240+i] and $00FF;
               plane3[480+i] := plane3[480+i] and $FF00;
               plane3[512] := 0;
           end;
           addscore (4);
       end
       else begin
           if xkoordpacman = 294
           then begin
               if (ykoordpacman = 30) and (plane3[4352] <> 0)
               then begin
                   PowerPill := kraftmax-25*aggression;;
                   for i := 32 to 37 do
                       plane3[4320+i] := $0000;
                   addscore (4);
               end
               else begin
                   if (ykoordpacman = 191) and (plane3[4513] <> 0)
                   then begin
                       PowerPill := kraftmax-25*aggression;;
                       for i := 193 to 198 do
                           plane3[4320+i] := $0000;
                       addscore (4);
                   end;
               end;
           end;
       end;
   end;
   if xkoordpacman = pacmanstartx
   then begin
       if (ykoordpacman < 114) and (ykoordpacman > 84) and fruitdisplay
       then begin
           addscore(100*fruitnr);
           fruitend := fruitlength
       end;
   end;
   if (fruitstart = bullets+20) and not closed
   then begin
       for i := 2 to 5 do
           if (xkoord[i] = 206) and (ykoord[i] > 76) and (ykoord[i] < 122)
           then begin
               if ykoord[i] < 99
               then enemydir[i] := 1
               else enemydir[i] := -1;
           end;
       layoutenemy[271] := layoutenemy[271]-1;
       for i := 272 to 274 do
           if layoutenemy[i] = -1
           then begin
               for j := i to 274 do
                   layoutenemy[j] := layoutenemy[j+1];
               layoutenemy[275] := 0;
           end;
       layoutenemy[421] := layoutenemy[421]-1;
       for i := 422 to 424 do
           if layoutenemy[i] = 1
           then begin
               for j := i to 424 do
                   layoutenemy[j] := layoutenemy[j+1];
               layoutenemy[425] := 0;
           end;
       closed := true;
   end;
   if (fruitstart = bullets) and (fruitend = 0) and not fruitdisplay
   then begin
       displayfruit (0);
       fruitdisplay := true;
   end;
   if fruitend = fruitlength
   then erasefruit;
end;

procedure putpacmeninplace (nr : integer);
var
   oldx : integer;
   oldy : integer;
   oldk : integer;
begin
   generatefigur (1, pacmenplacex, 208-18*nr);
   oldx := xkoordpacman;
   oldy := ykoordpacman;
   oldk := PowerPill;
   xkoordpacman := pacmenplacex;
   ykoordpacman := 208-18*nr;
   PowerPill := 0;
   movepacman (0);
   xkoordpacman := oldx;
   ykoordpacman := oldy;
   PowerPill := oldk;
end;

procedure addscore;
begin
   score := score+scorevalue;
   while score >= 1000 do
   begin
       score := score-1000;
       scoreaddon := scoreaddon+1;
       if scoreaddon >= 100
       then begin
           scorecarry := (scoreaddon div 100)+scorecarry;
           scoreaddon := scoreaddon mod 100;
           writescoredigit (0, 333, 1);
       end;
       if score < 1000
       then begin
           writescore (scoreaddon, 333-(digitwidth shl 1)-digitwidth, 1);
           writescoredigit (0, 349, 1);
           writescoredigit (0, 357, 0);
       end;
   end;
   while scoreaddon >= nextpacman do
   begin
       nextpacman := nextpacman shl 1;
       putpacmeninplace (Lives);
       Lives := Lives+1;
   end;
   writescore (score, 333, 0);
end;

procedure erasefigur (xkoord, ykoord : integer);
var
   r : integer;
   p : integer;
begin
   r := xkoord shr 4;
   for p := ykoord to ykoord+9 do
   begin
       plane1[240*r+p] := $0000;
       plane1[240*(r+1)+p] := $0000;
   end;
   Color(switch3);
   WriteRectangle(xkoord,xkoord+6,ykoord,ykoord+9,plane3);
end;

procedure erasetunnel;
begin
   erasefigur (162, 0);
   erasefigur (162, 198);
end;



You are viewing proxied material from sdf.org. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.