Скачать Pixel Tunnel [320x200x256]

USES crt;
 
CONST Amount=30;        { number of circles }
 
VAR circles:array[1..360,1..Amount] of word;
    ypts,xpts:array[1..90,1..Amount] of integer;
    xsinus,ysinus:array[1..720] of integer;
    sinptr,
    xx,yy,
    x,y,a:integer;
    r:real;
 
PROCEDURE pal(c,r,g,b:byte);    { sets palette }
begin
     port[$3c8]:=c;
     port[$3c9]:=r;
     port[$3c9]:=g;
     port[$3c9]:=b;
end;
 
procedure sync;assembler;asm  { synchronize routine, wait for vblank }
          mov dx,03dah
@frame:   in al,dx
          test al,8
          jz @frame
@besure:  in al,dx
          test al,8
          jnz @besure
   end;
 
{ ****************************************************************** }
 
BEGIN
 
{ ** Precalculate circles ** }
 
     Writeln('Calculating, please wait..');
 
     for a:=1 to Amount do
     begin
     r:=0;
          for x:=1 to 360 do
          begin
          r:=r+(0.0175)*4;
          circles[x,a]:=round(sin(r)*(5+(a shl 2)))+(5+(a shl 2));
          end;
     end;
 
{ ** Precalc x and y sinuses ** }
 
     r:=0;
     for x:=1 to 720 do
     begin
          r:=r+0.0175;
          xsinus[x]:=round(sin(r)*140)+140;
          ysinus[x]:=round(cos(r)*90)+90;
     end;
 
{ ** Initialize 320x200x256 chunky mode ** }
 
     asm
        mov ax,13h    { Using bitplanes, this routine would be MUCH }
        int 10h      { faster, but a 256 colour pixtunnel is cooler }
     end;
 
{ ** Set grayscale palette ** }
 
     for a:=63 downto 0 do pal(a,a,a,a);
     sinptr:=0;
 
{ ** Main loop ** }
 
     repeat
     sync;
 
     if sinptr>358 then sinptr:=0;      { loop sinus }
     inc(sinptr,2);
 
{ ** Draw and clear circles ** }
 
     for a:=1 to Amount do
     for x:=1 to 90 do
     begin
         xx:=xpts[x,a];                 { store old pts }
         yy:=ypts[x,a];
         mem[$a000:xx+yy*320]:=0;       { clear old }
         xx:=(circles[x,a]+xsinus[(a shl 3)+sinptr])-a*4; { new pos }
         yy:=(circles[x+23,a]+ysinus[sinptr+90+(a shl 2)])-(a*4);
         if ((xx>0) AND (xx<319)) then     { check if inside bounds }
         if ((yy>0) AND (yy<199)) then
         begin
         mem[$a000:xx+yy*320]:=a+5;             { put pixel }
         xpts[x,a]:=xx;
         ypts[x,a]:=yy;
         end;
     end;
 
     until keypressed;       { loop }
 
{ ** Back to text mode ** }
 
     asm
        mov ax,3h
        int 10h
     end;
end.