[Back to MISC SWAG index] [Back to Main SWAG index] [Original]

    uses crt, dos;  {$R-}
    (****************************************************************************)
    (*           TPONG-1.PAS        Glenn A. Reiff    74035,400     4/5/85      *)
    (*                                                                          *)
    (*  Note:  While this program is usable and will provide some fun, the      *)
    (*         Paddle control is not as responsive as it is in the original     *)
    (*         Basic program.  Also, the side bounces could be better.  If      *)
    (*         you are able to make any improvements I'd appreciate knowing     *)
    (*         about them.                                                      *)
    (****************************************************************************)
    type Str80 = string[80];
    procedure CENTER(Y:integer; Bt:Str80);
    BEGIN gotoXY((80-Length(Bt)) div 2, Y); write(Bt) END;

    procedure INTRODUCTION;
    BEGIN
         clrscr;                    CENTER(5,'TURBO PONG');
         CENTER(8,'This is an adaption to Turbo Pascal of the Basic program  ');
         CENTER(9,'called PChallenge written by Karl Koessel and published in');
         CENTER(10,'a 1982 issue of PC Magazine.                              ');
         CENTER(12,'His was a simplification of Pong, the orignial video game.');
         CENTER(13,'Pong was developed in the early 1970''s by Nolan Bushnell. ');
         CENTER(20,'Tap a Key to Continue');
         writeln; gotoXY(80,25);
         repeat until keypressed;
    END; { INTRODUCTION }

    type       CharSet = set of Char;
               Str9    = string[9];

    var        Paddle  : Str9;
               StartTime,
               EndTime,
               CurTime,
               BestTime,
               Drag : integer;
               Ch: char;

    Procedure TEXTBORDER (color: integer);
      var regs: registers;
    BEGIN
      With regs do begin
        AH := 11; BH := 0; BL := color end;
      Intr($10,regs)
    END; { TEXTBORDER }

    Procedure BEEP(N : Integer);
    BEGIN   Sound(n);  Delay(100);  NoSound; END;

    function GET_TIME: integer;
    var regs: registers;
    BEGIN
      with regs do begin
        ax := $2C * 256;
        MsDos(regs);
        GET_TIME := 3600 * ch + 60 * cl + dh
      end
    END;  { GET_TIME }

    procedure CHOOSE(    X,Y    : integer;
                         Prompt : Str80;
                         Term   : CharSet;
                     var TC     : Char    );
    var   I  : integer;
          Ch : char;
    BEGIN
      lowvideo; gotoXY(X,Y);
      for I:=1 to length(Prompt) do begin
          Ch:=Prompt[I];
          if I>4 then begin
            lowvideo;
            if (Prompt[I-2]=' ') and (Prompt[I-1]=' ') then highvideo;
            if (Prompt[I-1]='<') or  (Prompt[I-1]='/') then highvideo;
          end; { if I>3 }
          write(Ch)
      end; { for I }
      repeat
        TC := Upcase(ReadKey);
        if not (TC in Term) then BEEP(1000)
      until TC in Term
    END; { CHOOSE }

    procedure RESET(var Drag: integer;  var Paddle: Str9);
    BEGIN
         TEXTBORDER(Black); textbackground(Black); clrscr;
         CENTER(10,'Left and right cursor keys move paddle.');
         textcolor(LightCyan);
         CENTER(12,'Input drag factor: (100 is Medium...0 is FAST!)  ');
    read(Drag);     CHOOSE(17,14,'Pick a paddle size:  Small,  Medium or
    Large',['S','M','L'],Ch);     if Ch = 'S' then Paddle := ' '+chr(27)+'
    '+chr(26)+' '       else if Ch = 'M' then Paddle := ' '+chr(27)+'
    '+chr(26)+' '          else if Ch = 'L' then Paddle := ' '+chr(27)+'
    '+chr(26)+' 'END; { RESET }

    procedure RUN;
    label NewBall;
    var   Used                                 :   array[1..10] of integer;
    var   X,dX,Xpad,Y,dY,B,C,I,J,BallNr,Xstart :   integer;
          Flag                                 :   boolean;

      procedure RANDOMIZE;
      BEGIN
        dx := random(7)- integer (random(7));
        if dX < 0  then
          repeat
            dX := random(7) - integer (random(7));
            if dX=0 then dX:=-1;
          until (X-6)/dX=trunc((X-6)/dX);
        if dX > 0  then
          repeat
            dX := random(7) - integer (random(7));
            if dX=0 then dX:=1;
          until (59-X)/dX=trunc((59-X)/dX)
      END; { RANDOMIZE }

      procedure POSITION_PADDLE;
      BEGIN
        gotoXY(Xpad,22); textbackground(LightGray);
        textcolor(DarkGray); write(Paddle); textbackground(C);
      END; { POSITION_PADDLE }

      procedure ONKEY;
      BEGIN
        Ch := ReadKey;
        if Ch = #27 then  { it must be a function key }
          Ch := ReadKey;
        case Ch of
          'K':   if Xpad > 7 then begin
            Xpad:=Xpad-3; POSITION_PADDLE;
            gotoXY(Xpad+length(Paddle),22); write('   '); end;
          'M':   if Xpad + length(Paddle) < 60 then begin
            Xpad:=Xpad+2; POSITION_PADDLE;
            gotoXY(Xpad-3,22); write('   '); end;
        end;   { case }
      END; { ONKEY }

    BEGIN
         J := 11; Xpad := 29; C := random(16);
         if c in [0, 1, 6..9, 12, 15] then C := 2;
         textbackground(C); clrscr; TEXTBORDER(C);

         for X:=8 to 17 do begin   { Setup  10 Balls }
             J := J + 4; textbackground(red); textcolor(white);
             gotoXY(J,2); write(#2); textbackground(C);
         end; { for X }
         textcolor(Blue);
         GotoXY (5, 3);
         for X:=5 to 59 do write(#219);  { Draw Backboard }
         for Y:=3 to 21 do begin         { Draw Walls  }
            gotoXY  (5,Y); write (#219#219);
            gotoXY (59,Y); write (#219#219);
         end;
         POSITION_PADDLE; textcolor(Black);
         gotoXY(5,24); write('Best Time so far is ',BestTime,' seconds.');
         gotoXY(66,3); write('TURBOPONG');
         gotoXY(63,6); write('Initial Drag ',Drag);
         FillChar (Used, 20, 0);
         BallNr := 10;
         StartTime := GET_TIME;

         while BallNr > 0 do begin
           repeat
             Xstart := 1 + random(10); Flag:=false;
             for I:=1 to 10 do if Used[I] = Xstart then Flag:=true;
           until not Flag;
           Used[BallNr]:=Xstart;
           Xstart := 11 + 4 * Xstart;
           gotoXY(Xstart,2); write(' ');
           X := Xstart; Y := 4; dY := 1; Flag := false;
           RANDOMIZE;
           while Y < 23 do begin
             if keypressed then ONKEY;
             textbackground(C);
             if (Y > 4)  and (X in [7..58]) then     { Erase Previous Ball Below }
               begin gotoXY(X,Y-1); write(' '); end;
             if (Y < 21) and (X in [7..58]) then
               begin gotoXY(X,Y+1); write(' '); end; { Erase Previous Ball Above }
             if (Y=21) and (X-Xpad in [0..length (Paddle)]) then
               begin gotoXY(X,Y); write(' '); end;   { Erase Ball On Paddle      }

             X:=X + dX;

             textbackground(red); textcolor(white);
             if X in [7..58] then begin
               gotoXY(X,Y); write(#1)         { Print New Ball Position }
             end;
             gotoXY(80,25);
             if not (x in [8..57]) then begin
               BEEP(300+random(80*BallNr)); dX:=-dX;
             end;    { Side Wall Bounce        }
             if keypressed then ONKEY;

             if (Y=21) and (X-Xpad in [0..length(Paddle)]) then begin
               dY := -dY; BEEP(700);      { Bounce Off Of Paddle }
               if dX = 0 then RANDOMIZE;
             end; { if Y=21 }

             if Y = 22 then begin
               textbackground(C); gotoXY(X,Y); write(' ');
               textbackground(red); textcolor(white);      { Park Used Ball }
               gotoXY(25+Xstart,Y+2); write(#1); gotoXY(80,25);
             end;
             if keypressed then ONKEY;

             if (Y = 4) and Flag then begin   { Bounce Off of Top Backboard }
               BEEP(300+random(80*BallNr));
               Drag := Drag - 5;  { Reduce Amout of Drag    }
               if dX = 0 then RANDOMIZE;
               inc (dX); dY := -dY; Y := Y + dY
             end else begin Y := Y + dY; Flag := true end;
             if Drag <0 then Drag := 0;
             delay(50+Drag);
           end; { while Y }
           BallNr := BallNr - 1; textbackground(C);
         end; { while BallNr }
         gotoXY(1,22); clreol;
         textcolor(Black); gotoXY(63,8); if Drag < 0 then Drag := 0;
         write('Final Drag   ',Drag);
         EndTime := GET_TIME;
         CurTime := EndTime - StartTime;
         if CurTime > BestTime then BestTime := CurTime;
         gotoXY  (5,24); write('Best Time so far is ',BestTime,' seconds.');
         gotoXY (63,11); write('This Run ', CurTime, ' sec.');
    END; { RUN }

    {MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM}
    BEGIN
              BestTime := 0; Drag := 0; Paddle := '';
              INTRODUCTION;
              RESET(Drag,Paddle);
              repeat
                RUN;
                CHOOSE(19,22,'    Quit  Reset  Continue   ',['Q','R','C'],Ch);
                if Ch = 'R' then RESET(Drag,Paddle);
              until Ch = 'Q';
              TEXTBORDER(Black); textbackground(Black); clrscr;
    END.

[Back to MISC SWAG index] [Back to Main SWAG index] [Original]