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.