home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 02 / pong.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-07  |  9.7 KB  |  412 lines
  1. PROGRAM Pong;
  2.  
  3. {$R+}
  4.  
  5. CONST
  6.    Rahmenfarbe = Yellow;                            { Farben }
  7.    Ballfarbe   = White;
  8.    Textfarbe   = LightGray;
  9.    Titel       = Magenta;
  10.    Daneben     = 300;                               { Frequenzen }
  11.    Mauer       = 500;
  12.    Getroffen   = 800;
  13.    Surprise    = 1000;
  14.    Ball        = 111;                               { ASCII Codes }
  15.    Space       = 32;
  16.    CR          = 13;
  17.    RahmenZeich = 196;
  18.    Stueck      = 222;
  19.    Normal      = 21;                                { Punktemaximum }
  20.    Switch      = 80;                                { Häufigkeit der }
  21.                                                     { Überraschungen }
  22. VAR
  23.    Laenge      : ARRAY [1..2] OF 1..12;
  24.    Punkte      : ARRAY [1..2] OF 0..100;
  25.    Farbe       : ARRAY [1..2] OF 0..15;
  26.    Name        : ARRAY [1..2] OF STRING [15];
  27.    Position    : ARRAY [1..2] OF 2..24;
  28.    Video       : ARRAY [1..25,1..40,1..2] OF
  29.                    CHAR ABSOLUTE $B800:0;   { Monochrom $B000:0 }
  30.    Punktemax   : 0..100;
  31.    Zeile,
  32.    Spalte      : -1..1;
  33.    X           : 1..40;
  34.    Y           : 2..24;
  35.    Tempo       : -1..25;
  36.    Geraeusch   : BOOLEAN;
  37.    i,j,k       : INTEGER;
  38.    c           : CHAR;
  39.  
  40.  
  41.  
  42. FUNCTION GetKey : CHAR;  { Zeichen ohne Echo von Tastatur lesen }
  43. BEGIN
  44.    Read(Kbd,c);
  45.    GetKey := c;
  46. END;
  47.  
  48.  
  49. PROCEDURE CapsLockAus;   { Großschriftfeststellung aus }
  50. BEGIN
  51.    Mem[0:1047] := Mem[0:1047] AND 191;
  52. END;
  53.  
  54.  
  55. PROCEDURE CapsUndNumLockEin; { Großschrift und Zifferntastatur ein }
  56. BEGIN
  57.    Mem[0:1047] := Mem[0:1047] OR 96;
  58. END;
  59.  
  60. PROCEDURE CapsUndNumLockAus; { Großschrift und Zifferntastatur aus }
  61. BEGIN
  62.    Mem[0:1047] := Mem[0:1047] AND 159;
  63. END;
  64.  
  65.  
  66. FUNCTION Gewonnen : BOOLEAN;
  67. BEGIN
  68.    Gewonnen := (Punkte [1] = Punktemax) OR (Punkte [2] = Punktemax);
  69. END;
  70.  
  71.  
  72. PROCEDURE PrintAt (X,Y,Asc,Farbe:INTEGER);   { Direktes Addressieren }
  73. BEGIN                                        { des Bildschirm -      }
  74.    Video [Y,X,1] := Chr(Asc);                { speichers             }
  75.    Video [Y,X,2] := Chr(Farbe);
  76. END;
  77.  
  78.  
  79. PROCEDURE Cursor;                            { Verstecken des }
  80. BEGIN                                        { Cursors        }
  81.    PrintAt (1,1,Space,Black);
  82.    GotoXY (1,1);
  83. END;
  84.  
  85.  
  86. PROCEDURE Ton (Frequenz,Laenge:INTEGER);
  87. BEGIN
  88.    IF Geraeusch THEN BEGIN
  89.       Sound (Frequenz);
  90.       Delay (Laenge);
  91.       NoSound;
  92.    END;
  93. END;
  94.  
  95.  
  96. PROCEDURE Cls;
  97. BEGIN
  98.    TextBackground (Black);
  99.    ClrScr;
  100.    TextColor (Titel);
  101.    GotoXY (16,1);
  102.    WriteLn ('P O N G !');
  103.    TextColor (Textfarbe);
  104. END;
  105.  
  106.  
  107. PROCEDURE Start;
  108. VAR s : STRING [3];
  109.  
  110.    FUNCTION Return : BOOLEAN;
  111.    BEGIN
  112.       Return := c = Chr(CR);
  113.    END;
  114.  
  115.    FUNCTION Left : BOOLEAN;
  116.    BEGIN
  117.       Left := c = '4';
  118.    END;
  119.  
  120.    FUNCTION Right : BOOLEAN;
  121.    BEGIN
  122.       Right := c = '6';
  123.    END;
  124.  
  125.    PROCEDURE ChangeSpeed;
  126.    BEGIN
  127.       c := GetKey;
  128.       IF Right AND (Tempo > -1) THEN Tempo := Pred (Tempo);
  129.       IF Left AND (Tempo < 25) THEN Tempo := Succ (Tempo);
  130.    END;
  131.  
  132.    PROCEDURE SpielerName;
  133.    VAR p : INTEGER;
  134.    BEGIN
  135.       REPEAT
  136.          Cls;
  137.          FOR i := 1 TO 2 DO BEGIN
  138.             GotoXY (7,7 * i);
  139.             TextColor (Farbe [i]);
  140.             WriteLn ('Spieler ',i,', wie heissen Sie?');
  141.             GotoXY (7,7 * i + 2);
  142.             ReadLn (Name [i]);
  143.             p := Pos (' ',Name [i]);
  144.             IF p <> 0 THEN Name [i] := Copy (Name [i],1,p - 1);
  145.          END;
  146.       UNTIL Name [1] <> Name [2];
  147.    END;
  148.  
  149.    PROCEDURE Ein_Aus;
  150.    BEGIN
  151.       Cls;
  152.       GotoXY (13,12);
  153.       TextColor (Textfarbe);
  154.       Write ('Ton ein / aus');
  155.       Cursor;
  156.       c := ' ';
  157.       WHILE (c <> 'E') AND (c <> 'A') DO c := GetKey;
  158.       Geraeusch := c = 'E';
  159.    END;
  160.  
  161.    PROCEDURE Maximum;
  162.    BEGIN
  163.       i := Normal;
  164.       Cls;
  165.       GotoXY (13,12);
  166.       Write ('Punktemaximum');
  167.       REPEAT
  168.          GotoXY (18,14);
  169.          Write (i,' ');
  170.          Cursor;
  171.          c := GetKey;
  172.          IF Left AND (i > 1) THEN i := Pred (i);
  173.          IF Right AND (i < 100) THEN i := Succ (i);
  174.       UNTIL Return;
  175.       Punktemax := i;
  176.    END;
  177.  
  178.    PROCEDURE Length;
  179.    BEGIN
  180.       Cls;
  181.       FOR i := 1 TO 2 DO BEGIN
  182.          j := 6;
  183.          GotoXY (6,i * 5);
  184.          TextColor (Textfarbe);
  185.          Write ('Schlägerlänge für ',Name [i]);
  186.          TextColor (Farbe [i]);
  187.          REPEAT
  188.             GotoXY (6,i * 5 + 2);
  189.             FOR k := 1 TO j DO Write (Chr(220));
  190.             Write (' ');
  191.             Cursor;
  192.             c := ' ';
  193.             WHILE NOT (Left OR Right OR Return) DO c := GetKey;
  194.             IF Left AND (j > 1) THEN j := Pred (j);
  195.             IF Right AND (j < 12) THEN j := Succ (j);
  196.          UNTIL Return;
  197.          Laenge [i] := j;
  198.       END;
  199.    END;
  200.  
  201.    PROCEDURE Speed;
  202.    BEGIN
  203.       Cls;
  204.       GotoXY (11,6);
  205.       Write ('Ballgeschwindigkeit');
  206.       Cursor;
  207.       c := ' ';
  208.       Tempo := 10;
  209.       REPEAT
  210.          FOR i := 1 TO 40 DO BEGIN
  211.             PrintAt (i,10,Ball,Ballfarbe);
  212.             Delay ((Tempo + 3) * 3);
  213.             PrintAt (i,10,Space,Black);
  214.             IF KeyPressed THEN ChangeSpeed;
  215.          END;
  216.          Ton (Mauer,10);
  217.          FOR i:= 40 DOWNTO 1 DO BEGIN
  218.             PrintAt (i,10,Ball,Ballfarbe);
  219.             Delay ((Tempo + 3) * 3);
  220.             PrintAt (i,10,Space,Black);
  221.             IF KeyPressed THEN ChangeSpeed;
  222.          END;
  223.          Ton (Mauer,10);
  224.       UNTIL Return;
  225.    END;
  226.  
  227. BEGIN
  228.    TextMode (C40);
  229.    GraphBackground (Black);
  230.    Punkte [1] := 0;
  231.    Punkte [2] := 0;
  232.    CapsLockAus;
  233.    SpielerName;
  234.    CapsUndNumLockEin;
  235.    Ein_Aus;
  236.    Maximum;
  237.    Length;
  238.    Speed;
  239. END;
  240.  
  241.  
  242. PROCEDURE StatusZeile;
  243. BEGIN
  244.    GotoXY (14,25);
  245.    TextColor (Farbe [1]);
  246.    Write (Punkte [1]);
  247.    GotoXY (26,25);
  248.    TextColor (Farbe [2]);
  249.    Write (Punkte [2]);
  250.    Cursor;
  251. END;
  252.  
  253.  
  254. PROCEDURE Rahmen;
  255. BEGIN
  256.    Cls;
  257.    TextColor (Rahmenfarbe);
  258.    FOR i := 1 TO 40 DO Write (Chr(RahmenZeich));
  259.    GotoXY (1,24);
  260.    FOR i := 1 TO 40 DO Write (Chr(RahmenZeich));
  261.    StatusZeile;
  262. END;
  263.  
  264.  
  265. PROCEDURE Zeichnen (n:INTEGER);
  266. BEGIN
  267.    j := Pred (n) * 39 + 1;
  268.    FOR i := 0 TO Laenge [n] - 1 DO
  269.       PrintAt (j,Position [n] + i,Stueck,Farbe [n]);
  270.    i := Position [n] + Laenge [n];
  271.    IF i < 24 THEN PrintAt (j,i,Space,Black);
  272.    IF Position [n] > 3 THEN PrintAt (j,Position [n] - 1,Space,Black);
  273. END;
  274.  
  275.  
  276. PROCEDURE ChangePos;
  277. BEGIN
  278.    c := GetKey;
  279.    IF (c = '*') AND (Position [2] > 3) THEN BEGIN
  280.       Position [2] := Position [2] - 1;
  281.       Zeichnen (2);
  282.    END;
  283.    IF (c = 'Q') AND (Position [1] > 3) THEN BEGIN
  284.       Position [1] := Position [1] - 1;
  285.       Zeichnen (1);
  286.    END;
  287.    IF (c = '#') AND (Position [2] + Laenge [2] < 24) THEN BEGIN
  288.       Position [2] := Position [2] + 1;
  289.       Zeichnen (2);
  290.    END;
  291.    IF (c = 'A') AND (Position [1] + Laenge [1] < 24) THEN BEGIN
  292.       Position [1] := Position [1] + 1;
  293.       Zeichnen (1);
  294.    END;
  295. END;
  296.  
  297.  
  298. PROCEDURE Anstoss;
  299. BEGIN
  300.    Zeichnen (1);
  301.    Zeichnen (2);
  302.    X := Random (8)+17;
  303.    Y := Random (16)+5;
  304.    PrintAt (X,Y,Ball,Ballfarbe);
  305.    i := Random (2);
  306.    IF i = 0 THEN Zeile := -1 ELSE Zeile := 1;
  307.    i := Random (2);
  308.    IF i = 0 THEN Spalte := -1 ELSE Spalte := 1;
  309.    c := '#';
  310.    REPEAT ChangePos UNTIL c = ' ';
  311. END;
  312.  
  313.  
  314. PROCEDURE Ballbewegung;
  315. BEGIN
  316.    REPEAT
  317.       IF Random (Switch) = 0 THEN BEGIN          { Überraschung }
  318.          Zeile := - Zeile;
  319.          Ton (Surprise,10);
  320.       END;
  321.       IF KeyPressed THEN ChangePos;
  322.       IF (Y + Zeile = 24) OR (Y + Zeile = 2) THEN BEGIN
  323.          Ton (Mauer,10);
  324.          Zeile := -Zeile;
  325.       END;
  326.       PrintAt (X,Y,Space,Black);
  327.       X := X + Spalte;
  328.       Y := Y + Zeile;
  329.       PrintAt (X,Y,Ball,Ballfarbe);
  330.       IF KeyPressed THEN ChangePos;
  331.       Delay ((Tempo + 3) * 4);
  332.       IF (X + Spalte = 40) THEN BEGIN
  333.          IF (Y <= Position [2] + Laenge [2])
  334.          AND (Y >= Position [2] - 1) THEN BEGIN
  335.             Ton (Getroffen,15);
  336.             Spalte := -1;
  337.          END
  338.          ELSE BEGIN
  339.             Ton (Daneben,25);
  340.             PrintAt (X,Y,Space,Black);
  341.             Punkte [1] := Punkte [1] + 1;
  342.             StatusZeile;
  343.             IF NOT Gewonnen THEN Anstoss;
  344.          END;
  345.       END;
  346.       IF KeyPressed THEN ChangePos;
  347.       IF (X + Spalte = 1) THEN BEGIN
  348.          IF (Y <= Position [1] + Laenge [1])
  349.          AND (Y >= Position [1] - 1) THEN BEGIN
  350.             Ton (Getroffen,15);
  351.             Spalte := 1;
  352.          END
  353.          ELSE BEGIN
  354.             Ton (Daneben,25);
  355.             PrintAt (X,Y,Space,Black);
  356.             Punkte [2] := Punkte [2] + 1;
  357.             StatusZeile;
  358.             IF NOT Gewonnen THEN Anstoss;
  359.          END;
  360.       END;
  361.    UNTIL Gewonnen;
  362. END;
  363.  
  364.  
  365. PROCEDURE Ende;
  366. VAR Sieger : STRING [15];
  367.  
  368. BEGIN
  369.    Cls;
  370.    FOR i := 1 TO 2 DO BEGIN
  371.       GotoXY (3,5 + 5 * i);
  372.       TextColor (Farbe [i]);
  373.       Write ('Punkte von ',Name [i],':');
  374.       GotoXY (35,5 + 5 * i);
  375.       WriteLn (Punkte [i]:3);
  376.       WriteLn;
  377.    END;
  378.    IF Punkte [1] > Punkte [2] THEN i := 1 ELSE i := 2;
  379.    Sieger := Name [i];
  380.    TextColor (Farbe [i] + Blink);
  381.    GotoXY (5,20);
  382.    Write ('Bravo, ',Sieger,'!');
  383.    Cursor;
  384.    c := '#';
  385.    WHILE c <> ' ' DO c := GetKey;
  386.    Cls;
  387.    GotoXY (12,12);
  388.    TextColor (Textfarbe);
  389.    Write ('Noch ein Spiel?');
  390.    Cursor;
  391.    c := ' ';
  392.    WHILE (c <> 'J') AND (c <> 'N') DO c := GetKey;
  393. END;
  394.  
  395.  
  396.  
  397. BEGIN
  398.    Farbe [1] := LightRed;
  399.    Farbe [2] := LightBlue;
  400.    REPEAT
  401.       Start;
  402.       Rahmen;
  403.       Position [1] := (25 - Laenge [1]) DIV 2;        { Zentrieren der }
  404.       Position [2] := (25 - Laenge [2]) DIV 2;        { Schläger       }
  405.       Anstoss;
  406.       Ballbewegung;
  407.       Ende;
  408.       CapsUndNumLockAus;
  409.    UNTIL c <> 'J';
  410.    TextMode (C80);
  411. END.
  412.