
program bouncingball(input,output);
{Courtesy Chris Thornborrow CS2  19 Jun 1987}

%include 'level1:graphinc.pas'

var
  rad,xoff,yoff:integer;
  xdir,ydir:integer;
  inittime :integer;
  col:colourmap;

const
   pi = 3.141593;


procedure set_globals;
var i: integer;
begin
  rad:=100;
  xoff:=250;
  yoff:=250;
  xdir:=16;
  ydir:=16;
  for i:=0 to 255 do col[i] := 0
end;


procedure pause (time:integer);
var
  i:integer;
begin
 for i:=1 to time do ;
end;


procedure drawball;
var
  i:integer;
  j1:real;
  j:real;
  c:integer;
begin
  c:=3;
  clear;
  offset(xoff,yoff);
  {draw the background}
  colour (1);
  for i:=1 to 64 do
  begin
    vline (i*16,0,1023);
    hline (0,1023,i*16);
  end;
  colour(0);
  disc (541,491,100);
  colour(2);
  disc (511,511,rad);
  for i:=- 10 to 10 do
  begin
    j:=-2;
     c:=c+1;
     if c>7 then c:=3;
     colour(c);
    repeat
     j:=j+0.3;
     line (trunc(cos(j)*i*10)+511,trunc(sin(j)*100+511),trunc(cos(j+0.3)*i*10)+511
           ,trunc(sin(j+0.3)*100)+511);
    until j>pi-2;
  end;
  col[1]:=24;
  col[2]:=85;
  col[7]:=1000;
  updatecolourmap(col);
end;



procedure scroll ;
begin
  if yoff>=411 then ydir:=-16;
  if xoff=426 then xdir:=-16;
  if yoff<=100 then ydir:=16;
  if xoff<-50 then xdir:=16;
  yoff:=yoff+ydir;
  xoff:=xoff+xdir;
  offset (xoff,yoff);
end;


procedure leftrotate;
var
  i,dum:integer;
begin
  dum:=col [3];
  for i:=3 to 6 do col [i]:=col[i+1];
  col [7]:=dum;
  updatecolourmap(col);
end;


procedure rightrotate;
var
 i,dum:integer;
begin
  dum:=col [7];
  for i:=7 downto 4 do col[i]:=col[i-1];
  col [3]:=col[7];
  updatecolourmap (col);
end;


begin
  set_globals;
  clear;
  drawball;
  while true do
  begin
    inittime:=cputime;
    scroll;
    if xdir>0 then leftrotate else rightrotate;
    pause (950); {empirical fix to avoid flyback problems}
  end;
end.
