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.