program pacman;
{$R+}
{$I PACMAN0}
{$I PACMAN1}
{$I PACMAN2}

procedure activatepacman;
begin
    xkoordpacman := pacmanstartx;
    ykoordpacman := pacmanstarty;
    generatefigur (1, pacmanstartx, pacmanstarty);
    movepacman (0);
    pacmandir := 0;
end;

procedure generatedots;
begin
    dots[1] := $1800;
    dots[2] := $0003;
    dots[3] := $0060;
    dots[4] := $0C00;
    dots[5] := $8001;
    dots[6] := $0030;
    dots[7] := $0600;
    dots[8] := $C000;
    dots[9] := $0018;
    dots[10] := $0300;
    dots[11] := $6000;
    dots[12] := $000C;
    dots[13] := $0100;
    dots[14] := $3000;
    dots[15] := $0006;
    dots[16] := $00C0;
    dots[17] := $1800;
    dots[18] := $0003;
    dots[19] := $0060;
    dots[20] := $0C00;
    dots[21] := $8001;
    dots[22] := $0030;
    dots[23] := $0600;
    dots[24] := $C000;
    dots[25] := $0018;
    dots[26] := $0300;
    dots[27] := $6000;
    dots[28] := $000C;
    dots[29] := $0100;
end;

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;

    delay(5000);
    TopTen;
end.