uses screen, memory, crt, dos;

const
VGA=$a000;

Procedure Ifer_Table1(size, x0,y0,y_start:word; c0:byte; buf:word);
var
n,p:word;
x,y:integer;
c:integer;
color:byte;
begin
     n:=0; x:=0; y:=y_start;
     for p:=0 to size{(512*128)-2} do
       begin
          c:=round(cos(sqrt((y-y0)*(y-y0)+(x / 2-x0)*(x / 2-x0))/9)*30+30)+c0;{}
          if (c>255) then color := abs(255-c) else color := c;
          mem[buf:n]:=color;
          x:=x+1;
          if (x=512) then
             begin
               x:=0;
               y:=y+1;
             end;
        n:=n+1;
       end;
end;

Procedure Ifer_Table2(size, x0,y0,y_start:word; c0:byte; buf:word);
var
n,p:word;
x,y:integer;
c:integer;
color:byte;
a:single;
begin
     n:=0; x:=0; y:=y_start;
     for p:=0 to size{(512*128)-2} do
       begin
          if (x/2-x0>0) and (y-y0>=0) then a:=arctan((y-y0) / (x/2-x0));
          if (x/2-x0=0) and (y-y0>=0) then a:=1.57;
          if (x/2-x0>0) and (y-y0<0)  then a:=arctan((y-y0) / (x/2-x0))+2*pi;
          if (x/2-x0=0) and (y-y0<0)  then a:=-1.57 +2*pi;
          if (x/2-x0<0) then a:=arctan((y-y0) / (x/2-x0))+pi;
          a:=a / (2*pi);

          c:=integer(round(a*256));
          c:=c+round(sin(sqrt((y-y0)*(y-y0)+(x/2-x0)*(x/2-x0))/16)*38+38);{}

          if (c>255) then color := abs(255-c) else color := c;
          mem[buf:n]:=color;
          x:=x+1;
          if (x=512) then
             begin
               x:=0;
               y:=y+1;
             end;
        n:=n+1;
       end;
end;

Procedure Ifer_table3(size, x0,y0,y_start:word; c0:byte; buf:word);
var
n,p:word;
x,y:integer;
c:integer;
color:byte;
begin
     n:=0; x:=0; y:=y_start;
     for p:=0 to size do
       begin
          c:=round(sin(sqrt((y-y0)*(y-y0)+(x / 2-x0)*(x/2-x0))/18)*48);{}
          if (c>255) then color := abs(255-c) else color := c;
          mem[buf:n]:=color;
          x:=x+1;
          if (x=512) then
             begin
               x:=0;
               y:=y+1;
             end;
        n:=n+1;
       end;
end;


procedure save_data(name:string; size:longint; from:word);
var fw1:file;
i:word;
begin
Assign(fw1, name);
Rewrite(fw1,1);
Reset(fw1, 1);
for i:=0 to size-1 do BlockWrite(fw1, mem[from:i], 1);
Close(fw1);
end;


var
fw1,fw2:file;

c, i, x,y,n,m,yy,xx:word;
fr:file;
col, r,g,b:byte;
size:word;

begin
SetUpVirtual(scr,vaddr);
SetUpVirtual(scr2, vaddr2);
SetUpVirtual(scr3, vaddr3);


   Ifer_table1((512*128)-2, 128,127,0,1,vaddr2);
   Ifer_table1(512*84, 128,127,128,1,vaddr3);
   save_data('ifer_1_1.bin', 65536, vaddr2);
   save_data('ifer_1_2.bin', 512*84, vaddr3);

   WriteLn('1');

   Ifer_table2((512*128)-2, 128,127,0,1,vaddr2);
   Ifer_table2(512*84,      128,127,128,1,vaddr3);
   save_data('ifer_2_1.bin', 65536, vaddr2);
   save_data('ifer_2_2.bin', 512*84, vaddr3);

   WriteLn('2');

   Ifer_table3((512*128)-2, 128,127,0,1,vaddr2);
   Ifer_table3(512*84, 128,127,128,1,vaddr3);
   save_data('ifer_3_1.bin', 65536, vaddr2);
   save_data('ifer_3_2.bin', 512*84, vaddr3);

   WriteLn('3');


readkey;


end.