Turbo Toolbox/Turbo_Toolbox.iso/spezial/14/spiel/packmann.pas

Pascal/Delphi Source File | 1989-07-12 | 7.2 KB | 273 lines

(*********************************************************
 ***                                                   ***
 ***                P A C K - M A N N                  ***
 ***                                                   ***
 ***      analog dem bekannten Arcade-Game Pac-Man     ***
 ***                                                   ***
 ***       (C) 1989 by G. Brinkmann & TOOLBOX          ***
 ***                                                   ***
 ***  System : Ms-Dos   Sprache : Turbo Pascal 4.0/5.0 ***
 ***                    Stand   : 06.04.1989           ***
 *********************************************************)

PROGRAM PackMann;

USES Crt, Dos;

TYPE
  BildTyp     = ARRAY[1..10] OF STRING[80];
  RegisterTyp = RECORD
                  al,ah,bl,bh,cl,ch : BYTE;
                END;

VAR
  bild : BildTyp;
  rekord,
  maxpkt : INTEGER;
  fkey   : BOOLEAN;
  feld   : ARRAY[1..38,1..19] OF BYTE;
  ch     : CHAR;

PROCEDURE Cursor (Anfangszeile,Endzeile:byte);
{  setzt die Größe des Cursors  }
VAR
  register : Registers;
BEGIN
  WITH register DO BEGIN
    ch := Anfangszeile;
    cl := Endzeile;
    ah := 1;
    intr($10,register);
  END;
END;  (*  Cursor  *)


PROCEDURE ReadChar ( VAR c : CHAR );
{  liest ein Zeichen von Tastatur ein und setzt
   bei einer Funktionstaste fkey auf TRUE       }
BEGIN
  c := ReadKey;
    IF KeyPressed AND (c=#0) THEN
      BEGIN
        c := ReadKey;
        fkey := TRUE;
      END
    ELSE fkey := FALSE;
END;  (*  ReadChar  *)


PROCEDURE FirstInit;
{  initialisiert den Aufbau des Spielfelds. Es werden
   die ASCII-Zeichen 219,221,222 und 254 verwendet   }
VAR
  i, j : INTEGER;
  c : CHAR;
BEGIN
  bild[ 1] := '▐█████████████████████████████████████';
  bild[ 2] := '▐██ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ▐█';
  bild[ 3] := '▐██ ■ ▐███████████████████▌ ■ ▐█▌ ■ ▐█';
  bild[ 4] := '▐██ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ▐█▌ ■ ▐█';
  bild[ 5] := '▐██ ■ ▐█▌ ■ ▐█▌ ■ ▐███████▌ ■ ▐█▌ ■ ▐█';
  bild[ 6] := '▐██ ■ ▐█▌ ■ ▐█▌ ■ ▐█▌ ■ ▐█▌ ■ ▐█▌ ■ ■ ';
  bild[ 7] := '▐██ ■ ▐█▌ ■ ▐█▌ ■ ▐█▌ ■ ▐█▌ ■ ▐█▌ ■ ▐█';
  bild[ 8] := '▐██ ■ ▐█▌ ■ ■ ■ ■ ▐█▌ ■ ▐█▌ ■ ■ ■ ■ ▐█';
  bild[ 9] := '▐██ ■ ▐█▌ ■ ▐█▌ ■ ▐█▌ ■ ▐█▌ ■ ▐█▌ ■ ▐█';
  bild[10] := '  ■ ■ ▐█▌ ■ ▐█▌ ■ ■ ■ ■ ■ ■ ■ ▐█▌ ■ ■ ';
 FOR i:=1 TO 10 DO
   FOR j:=37 DOWNTO 1 DO BEGIN
     c:=bild[i][j];
     CASE c OF
      '▐' : c := '▌';
      '▌' : c := '▐';
     END;
     bild [i] := bild[i] + c;
   END;
END;  (*  FirstInit  *)


PROCEDURE Bild_malen;
{  gibt das Spielfeld auf dem Bildschirm aus  }
VAR
  i, j : INTEGER;
  s    : STRING[20];
BEGIN
  ClrScr;
  Gotoxy(26,1);
  TextColor(White);
  Write('P  A  C  K  -  M  A  N  N');
  Gotoxy(1,4);
  FOR i := 1 TO 10 DO BEGIN
    FOR j:=1 TO Length(bild[i]) DO BEGIN
      IF bild[i][j] = '■' THEN TextColor(Yellow)
                          ELSE TextColor(Red);
      Write(bild[i][j]);
    END;
    WriteLn;
  END;
  FOR i := 9 DOWNTO 1 DO BEGIN
    FOR j:=1 TO Length(bild[i]) DO BEGIN
      IF bild[i][j] = '■' THEN TextColor(Yellow)
                          ELSE TextColor(Red);
      Write(bild[i][j]);
    END;
    WriteLn;
  END;
  Gotoxy( 1,23); Write('Punkte : ');
  Gotoxy(30,23); Write('Level : ');
  Gotoxy(62,23); Write('Rekord : ');
  TextColor(White);
  Write(rekord);
  s := 'von  Gerd Brinkmann';
  FOR i:=1 TO 19 DO BEGIN
    Gotoxy(77,i+3);
    Write(s[i]);
  END;
  TextColor(White);
END;  (*  Bild_malen  *)


PROCEDURE Init;
VAR
  i, j, hilf : INTEGER;
BEGIN
  maxpkt := 292;
  FOR i:=1 TO 10 DO
    FOR j:=1 TO 38 DO BEGIN
      IF bild[i][2*j-1] IN [#219,#221,#222] THEN hilf :=255
                                            ELSE hilf :=  1;
      feld[j,i]    := hilf;
      feld[j,20-i] := hilf;
    END;
END;  (*  Init  *)


PROCEDURE Male_Laeufer ( x, y, farbe : INTEGER );
BEGIN
  Gotoxy(2*x-2,y+3);
  CASE farbe OF
    0 : Write('   ');
    1 : Write('«≡»');
  END;
END;  (*  Male_Laeufer  *)


PROCEDURE Male_Monster ( x, y, farbe : INTEGER );
BEGIN
  Gotoxy(2*x-2,y+3);
  CASE farbe OF
    0 : IF feld[x,y] = 1 THEN BEGIN
          TextColor(Yellow);
          Write(' ■ ');
          TextColor(White);
        END
        ELSE Write('   ');
    1 : Write('╠═╣');
  END;
END;  (*  Male_Monster  *)


PROCEDURE Monster_neu ( VAR mx, my : INTEGER ; x, y : INTEGER );
BEGIN
  Male_Monster(mx,my,0);
  IF x > mx THEN IF feld[SUCC(mx),my] <> 255 THEN
                   mx := SUCC(mx);
  IF x < mx THEN IF feld[PRED(mx),my] <> 255 THEN
                   mx := PRED(mx);
  IF y > my THEN IF feld[mx,SUCC(my)] <> 255 THEN
                   my := SUCC(my);
  IF y < my THEN IF feld[mx,PRED(my)] <> 255 THEN
                   my := PRED(my);
  Male_Monster(mx,my,1);
END;  (*  Monster_neu  *)


PROCEDURE laufen;
{  steuert den Spielablauf  }
CONST
  monster = 4;
VAR
  ch                     : CHAR;
  punkte, x, y, i, level : INTEGER;
  mx, my, mzaehler       : ARRAY[1..monster] OF INTEGER;
BEGIN
  level := -1;
  punkte := 0;
  REPEAT
    Init;
    Bild_malen;
    level := level + 1;
    x   :=  3; y   := 2;       { Startposition   : Spieler }
    mx[1] := 36; my[1] := 18;  { Startpositionen : Monster }
    mx[2] := 36; my[2] :=  2;
    mx[3] :=  3; my[3] := 18;
    mx[4] := 20; my[4] := 10;
    FOR i:=1 TO monster DO BEGIN
      mzaehler[i] := i*10 - i*level;
      Male_monster(mx[i],my[i],1);
    END;
    punkte := punkte + 1;
    Male_Laeufer(x, y, 1);
    feld[x,y] := 0;
    Gotoxy(10,23); Write(Punkte);
    Gotoxy(39,23); Write(level);
    WHILE KeyPressed DO ReadChar(ch);
    REPEAT
      IF KeyPressed THEN BEGIN
        ReadChar(ch);
        IF fkey AND (ch IN [#72,#75,#77,#80]) THEN BEGIN
          Male_Laeufer(x,y,0);
          CASE ch OF
            #72 : IF feld[x,y-1] <> 255 THEN y := y-1;
            #75 : IF feld[x-1,y] <> 255 THEN BEGIN
                    x := x-1;
                    IF x < 2 THEN x := 37;
                  END;
            #77 : IF feld[x+1,y] <> 255 THEN BEGIN
                    x := x+1;
                    IF x > 37 THEN x := 2;
                  END;
            #80 : IF feld[x,y+1] <> 255 THEN y := y+1;
          END;
          Male_Laeufer(x,y,1);
          IF feld[x,y] = 1 THEN BEGIN
            punkte := punkte + 1;
            feld[x,y] := 0;
            sound(1000);
          END ELSE sound(100);
          Gotoxy(10,23); Write(punkte);
        END;
      END;
      DELAY(30);
      nosound;
      FOR i:=1 TO monster DO BEGIN
        mzaehler[i] := PRED (mzaehler[i]);
        IF mzaehler[i] < 0 THEN BEGIN
          mzaehler[i] := i*10 - i*level;
          Monster_neu (mx[i],my[i],x,y);
        END;
        IF x = mx[i] THEN IF y = my[i] THEN ch := #27;
      END;
    UNTIL (ch = #27) OR (punkte MOD maxpkt = 0);
    IF rekord < punkte THEN rekord := punkte;
  UNTIL ch = #27;
END;  (*  laufen  *)


BEGIN { main }
  Cursor(16,16);
  firstInit;
  rekord := 0;
  REPEAT
    laufen;
    Gotoxy(20,25);
    Write('Wollen Sie nochmal spielen ? (J/N)  < >',#7,#8,#8);
    REPEAT
      ReadChar(ch);
      ch := UpCase(ch);
    UNTIL ch IN ['J','N'];
  UNTIL ch = 'N';
  Gotoxy(20,25);
  Write('E n d e   d e s   S p i e l s');ClrEoL;
  Cursor(11,12);
END.  { main }