Основы программирования

USES crt;
 
CONST Amount=30;        { количество кругов }
 
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);    { определяет палитру }
begin
     port[$3c8]:=c;
     port[$3c9]:=r;
     port[$3c9]:=g;
     port[$3c9]:=b;
end;
 
procedure sync;assembler;asm    { синхронизация, ожидание vblank }
          mov dx,03dah
@frame:   in al,dx
          test al,8
          jz @frame
@besure:  in al,dx
          test al,8
          jnz @besure
   end;
 
BEGIN
 
{ Расчет окружностей }
 
     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;
 
{ Расчет синусов для Х и У }
 
     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;
 
{ Иницилизация режима 320x200x256  }
 
     asm
        mov ax,13h      
        int 10h         
     end;
 
{ Установить палитру оттенков серого }
 
     for a:=63 downto 0 do pal(a,a,a,a);
     sinptr:=0;
 
{ Основной цикл }
 
     repeat
     sync;
 
     if sinptr>358 then sinptr:=0;      { Цикл для синусов}
     inc(sinptr,2);
 
{ Рисование и чистка окружностей }
 
     for a:=1 to Amount do
     for x:=1 to 90 do
     begin
         xx:=xpts[x,a];                 { хранение старых pts }
         yy:=ypts[x,a];
         mem[$a000:xx+yy*320]:=0;       { очистка памяти }
         xx:=(circles[x,a]+xsinus[(a shl 3)+sinptr])-a*4;       { определение новых позиций }
         yy:=(circles[x+23,a]+ysinus[sinptr+90+(a shl 2)])-(a*4);
         if ((xx>0) AND (xx<319)) then           { Проверить лежит ли внути границ }
         if ((yy>0) AND (yy<199)) then
         begin
         mem[$a000:xx+yy*320]:=a+5;             { постановка пикселя }
         xpts[x,a]:=xx;
         ypts[x,a]:=yy;
         end;
     end;
 
     until keypressed;       { зацикливание }
 
{Возврат к текстовому режиму}
     asm
        mov ax,3h
        int 10h
     end;
end.