{******************************************************************************
*                                                                             *
*                                 PONG GAME                                   *
*                                                                             *
*                       COPYRIGHT (C) 1997 S. A. MOORE                        *
*                                                                             *
* Plays pong in text mode.                                                    *
*                                                                             *
******************************************************************************}

program pong(input, output);

uses trmlib;

label 88, 99; { loop and termination labels }

const

   movtim = 400; { ball move time (1/25) sec }
   newbal = 25*2;  { wait for new ball time, 1 sec (in ball move units) }  
   

type

   string = packed array of char;

var 

   padx:   integer; { paddle position x }
   ballx:  integer; { ball position x }
   bally:  integer; { ball position y }
   bdx:    integer; { ball direction x }
   bdy:    integer; { ball direction y }
   bsx:    integer; { ball position save x }
   bsy:    integer; { ball position save y }
   baltim: integer; { ball start timer }
   er:     evtrec;  { event record }
   jchr:   integer; { number of characters to joystick movement }
   score:  integer; { score }

{******************************************************************************

Wait time

Waits for the elapsed time, in 100 microseconds. Ignores other timers.

*******************************************************************************}

procedure wait(t: integer);

var er: evtrec; { event record }

begin

   timer(input, 2, t, false); { set timer }
   { wait event }
   repeat

      repeat event(input, er) until (er.etype = ettim) or (er.etype = etterm);
      if er.etype = etterm then goto 99; { terminate }

   until er.timnum = 2 { this is our timer }

end;

{******************************************************************************

Write string to screen

Writes a string to the indicated position on the screen.

*******************************************************************************}

procedure writexy(     x, y: integer; { position to write to }
                  view s:    string); { string to write }

begin

   cursor(output, x, y); { position cursor }
   write(s) { output string }

end;

{******************************************************************************

Write centered string

Writes a string that is centered on the line given. Returns the
starting position of the string.

*******************************************************************************}

procedure wrtcen(     y:   integer;  { y position of string }
                 view s:   string;   { string to write }
                 var  off: integer); { returns string offset }

begin

   off := maxx(output) div 2-max(s) div 2;
   writexy(off, y, s) { write out contents }

end;

{******************************************************************************

Draw screen

Draws a new screen, with borders.

*******************************************************************************}

procedure drwscn;

var x, y: integer; { screen indexes }

begin

   page; { clear screen }
   { draw borders }
   for x := 1 to maxx(output) do writexy(x, 1, '*');
   for x := 1 to maxx(output) do writexy(x, maxy(output), '*');
   for y := 1 to maxy(output) do writexy(1, y, '*');
   for y := 1 to maxy(output) do writexy(maxx(output), y, '*');
   wrtcen(maxy(output), ' PONG VS. 1.0 ', x)

end;

{******************************************************************************

Set new paddle position

Places the paddle at the given position.

*******************************************************************************}

procedure padpos(x: integer);

begin

   if x < 5 then x := 5; { clip to ends }
   if x > maxx(output)-4 then x := maxx(output)-4; 
   writexy(padx-3, maxy(output)-1, '       '); { blank paddle }
   padx := x; { move right }
   writexy(padx-3, maxy(output)-1, '=======') { place paddle }

end;

begin

   jchr := maxint div ((maxx(output)-2) div 2); { find basic joystick increment }
   select(output, 2, 2); { switch screens }
   curvis(output, false); { remove drawing cursor }
   auto(output, false); { turn off scrolling }
   timer(output, 1, movtim, true); { set movement timer }
   88: { start new game }
   drwscn; { draw game screen }
   padx := maxx(output) div 2; { find intial paddle position }
   writexy(padx-1, maxy(output)-1, '======='); { place paddle }
   ballx := 0; { set ball not on screen }
   bally := 0;
   baltim := 0; { set ball ready to start }
   repeat { game loop }

      if (ballx = 0) and (baltim = 0) then begin
 
         { ball not on screen, and time to wait expired, send out ball }
         ballx := 2; { place ball }
         bally := maxy(output)-3;
         bdx := +1; { set direction of travel }
         bdy := -1;
         writexy(ballx, bally, '*'); { draw the ball }
         score := 0; { clear score }

      end;
      { place updated score on screen }
      cursor(output, maxx(output) div 2-11 div 2, 1);
      writeln('SCORE ', score:5);
      repeat event(input, er) { wait relivant events }
      until er.etype in [etterm, etleft, etright, etfun, ettim, etjoymov];
      if er.etype = etterm then goto 99; { game exits }
      if er.etype = etfun then goto 88; { restart game }
      { process paddle movements }
      if er.etype = etleft then padpos(padx-1) { move left }
	   else if er.etype = etright then padpos(padx+1) { move right }
      else if er.etype = etjoymov then { move joystick }
         padpos(maxx(output) div 2+er.joypx div jchr)
      else if er.etype = ettim then begin { move timer }

         if er.timnum = 1 then begin { ball timer }

            if ballx > 0 then begin { ball on screen }

               writexy(ballx, bally, ' '); { erase the ball }
               bsx := ballx; { save ball position }
               bsy := bally;
               ballx := ballx+bdx; { move the ball }
               bally := bally+bdy;
               { check off screen motions }
               if (ballx = 1) or (ballx = maxx(output)) then begin

                  ballx := bsx; { restore }
                  bdx := -bdx; { change direction }
                  ballx := ballx+bdx { recalculate }

               end;
               if bally = 1 then begin { hits top }

                  bally := bsy; { restore }
                  bdy := -bdy; { change direction }
                  bally := bally+bdy { recalculate }

               end else if ((bally = maxy(output)-1) and
                            (ballx >= padx-3) and 
                            (ballx <= padx+3)) then begin

                  { hits paddle }
                  bally := bsy; { restore }
                  bdy := -bdy; { change direction }
                  bally := bally+bdy; { recalculate }
                  score := score+1 { count hits }

               end;
               if bally <> maxy(output) then
                  writexy(ballx, bally, '*') { redraw the ball }

            end;
            { if the ball timer is running, decrement it }
            if baltim > 0 then baltim := baltim-1

         end

      end;
      if bally = maxy(output) then begin { ball out of bounds }

         ballx := 0; { set ball not on screen }
         bally := 0;
         baltim := newbal { start time on new ball wait }

      end

   until false; { forever }
   99: { exit game }
   curvis(output, true); { restore drawing cursor }
   auto(output, true); { turn scrolling back on }
   select(output, 1, 1) { restore screen }

end.