{*******************************************************************************

Program to bounce animated balls around screen

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

program ball6(input, output);

uses gralib,
     sndlib;

label 99;

const ballsize = 61;
      halfball = ballsize div 2;
      maxball = 6;
      reprate = 2; { number of moves per frame, should be low }
      wavstr = 90; { starting noise wave time }
      wavcnt = 10; { number of frames to wait for wave output }

type balrec = record { ball data record }

        x, y:   integer; { current position }
        lx, ly: integer; { last position }
        xd, yd: integer; { deltas }
        c:      color    { color }
   
     end;
     balinx = 1..maxball; { index for balls }
   
var cd:     boolean; { current display flip select }
    baltbl: array [1..maxball] of balrec; { ball data table }
    i:      balinx; { index for table }
    rndseq: integer; { random sequence seed }
    rc:     integer; { repetition counter }
    cc:     color;   { color assignment counter }
    n:      note;    { note variable }
    bounce: boolean; { a bounce took place }
    wavtim: integer; { wave output timer }

{ wait time in 100 microseconds }

procedure wait(t: integer);

var er: evtrec; { event record }

begin

   timer(input, 1, t, false);
   repeat event(input, er) until er.etype = ettim

end;

procedure chkbrk;

var er: evtrec; { event record }

begin

   repeat event(input, er) until (er.etype = etframe) or (er.etype = etterm);
   if er.etype = etterm then goto 99

end;

function rand: integer;

const a = 16807;
      m = 2147483647;

var gamma: integer;

begin

   gamma := a*(rndseq mod (m div a))-(m mod a)*(rndseq div (m div a));
   if gamma > 0 then rndseq := gamma else rndseq := gamma+m;
   rand := rndseq

end;

{*******************************************************************************

Draw centered ball

Draws a ball with the given center and size. If the size is not odd, it is
rounded up a pixel.

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

procedure drawball(x, y, s: integer);

var hs: integer;

begin

   hs := s div 2;
   fellipse(output, x-hs, y-hs, x+hs, y+hs);

end;

{*******************************************************************************

Draw shaded ball

Draws a shaded ball with highlighting from upper left lighting. The center
and size of the ball is specified. The offset of the highlight is expressed
as a percentage from the center to edge of the ball, and the number of shading
steps is specified. The color is specified as RGB.

Note that the more steps specified, the more drawing time, so only as many steps
as needed should be used. Steps will be more apparent on larger balls.

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

procedure drawsball(x, y, size, o, steps, r, g, b: integer);

var i:    integer;
    k, q: integer;
    offs: integer;
    shad: integer;

{ subtract from level without allowing negative }

function level(c: integer): integer;

begin

   c := c-(steps-i)*shad;
   if c < 0 then c := 0;
   level := c

end;
   
begin

   offs := o*(size div 2) div 100; { find offset from percentage }
   shad := maxint div 2 div steps; { find shading steps }
   for i := 1 to steps do begin

      fcolorg(output, level(r), level(g), level(b));
      k := round((i-1)*(size/steps));
      q := round((i-1)*(offs/steps));
      drawball(x-q, y-q, size-k);

   end

end;

function redv(c: color): integer;

var cv: integer;

begin

   if (c = red) or (c = magenta) or (c = yellow) then cv := maxint
   else cv := 0;
   redv := cv

end;

function greenv(c: color): integer;

var cv: integer;

begin

   if (c = green) or (c = yellow) or (c = cyan) then cv := maxint
   else cv := 0;
   greenv := cv

end;

function bluev(c: color): integer;

var cv: integer;

begin

   if (c = blue) or (c = cyan) or (c = magenta) then cv := maxint
   else cv := 0;
   bluev := cv

end;

procedure movbal(b: balinx);

var nx, ny: integer; { temp coordinates holders }

begin

   with baltbl[b] do begin 

         nx := x+xd; { trial move ball }
         ny := y+yd;
         { check out of bounds and reverse direction }
         if (nx < halfball) or (nx > maxxg(output)-halfball+1) then begin

            bounce := true; { set bounce occurred }
            xd := -xd

         end;
         if (ny < halfball) or (ny > maxyg(output)-halfball+1) then begin

            bounce := true; { set bounce occurred }
            yd := -yd

         end;
         x := x+xd; { move ball }
         y := y+yd

   end

end;

begin

   rndseq := 1; { set random number generator inital to mid sequence }
   openwaveout(1); { open main wave output }
   playwave(1, 0, 'car_rev');
   wavtim := wavstr; { place starting wave time (60 seconds) }
   { initalize ball data }
   cc := red; { start colors }
   for i := 1 to maxball do with baltbl[i] do begin

      x := rand mod (maxxg(output)-ballsize)+halfball;
      y := rand mod (maxyg(output)-ballsize)+halfball;
      if rand mod 2 = 0 then xd := +1 else xd := -1;
      if rand mod 2 = 0 then yd := +1 else yd := -1;
      lx := x; { set last position to same }
      ly := y;
      c := cc; { set color }
      if cc < magenta then cc := succ(cc) else cc := red { next color }

   end;
   curvis(output, false); { turn off cursor }
   cd := false; { set 1st display }
   rc := 0; { count reps }
   bounce := false; { set no bounce }
   frame(output, true); { turn on the framing timer }
   while true do begin

      { select display and update surfaces }
      select(output, ord(not cd)+1, ord(cd)+1);
      { erase old balls }
      fcolor(output, white);
      for i := 1 to maxball do with baltbl[i] do drawball(lx, ly, ballsize);
      fcolor(output, black);
      { save last position }
      for i := 1 to maxball do with baltbl[i] do begin

         lx := x; { save last position }
         ly := y

      end;
      { move balls }
      for rc := 1 to reprate do { repeat per frame }
         for i := 1 to maxball do movbal(i);
      { draw new balls }
      for i := 1 to maxball do with baltbl[i] do 
         drawsball(x, y, ballsize, 30, 30, redv(c), greenv(c), bluev(c));
      cd := not cd; { flip display and update surfaces }
      chkbrk; { wait frame and check for break }
      if bounce and (wavtim = 0) then begin { a bounce occurred in cycle }

         playwave(1, 0, 'pong'); { start sound }
         wavtim := wavcnt { start timer }

      end;
      bounce := false; { set no bounce }
      if wavtim > 0 then wavtim := wavtim-1 { count down wave timer }

   end;

   99:

end.