ПРОГРАММА "ОГОНЬ"
Program Fire;
Uses Dos, VGA_MCGA;
Var
   palete:Palette;
   F,W:Word;
   R,L:Registers;

Procedure SetCols: {Устанавливает палитру}
Var                            
N:Byte;
Begin
   palete [0]:=0;
   palete [1]:=0;
   palete [3]:=0;
   r.bx:=0;
   While R.BX<85 Do
   Begin
    	r.di:=r.bx+r.bx+r.bx;
      	r.ax:=r.bx*64 div 85;
      	r.dl:=r.al;

   	palete 	[r.di+3]:=r.dl;
   	palete 	[r.di+3+1]:=0;
   	palete 	[r.di+3+2]:=0;
   	palete 	[r.di+3+85+85+85]:=63;
   	palete 	[r.di+3+85+85+85+1]:=r.dl;
   	palete 	[r.di+3+85+85+85+2]:=0;
   	palete 	[r.di+3+85+85+85+85+85+85]:=63;
   	palete 	[r.di+85+85+85+85+85+89]:=63;
   	palete 	[r.di+85+85+85+85+85+90]:=r.dl;
   	r.bx:=r.bx+1;
   End;
   SetVGAPalette (0,256,Palete);
End;

Procedure AddFiretoScr (N:Word);
Var
   G,H:Integer;
   P:^Byte;
Begin {Рисует огонь}
   For G:=1 to n do
   Begin
     r.si:=(Random(10)+1)*2;
     r.di:=Random(298)+64010;
     r.al:=Random(127)+128;
     For H:=1 to r.si Do
     Begin
        P:=Ptr(r.es,r.di);
        P^:=r.al;
        P:=Ptr(r.es,r.di+640);
        P^:=r.al;
        r.di:=r.di+1;
     End;
     End;
End;
Procedure CopyVideo;
{Скроллинг с изменением от желтого к красному и черному}
Var            
   b1,b2,b3,b4:^Byte;
   w1,w2:^Word;
Begin
   r.di:=1280;
   While r.di<65280 Do
   Begin
     r.bx:=2;
     While r.bx<318 Do
       Begin
         b1:=ptr(r.es,r.di+r.bx-2);
         b2:=ptr(r.es,r.di+r.bx+2):
         b3:=ptr(r.es,r,di+r,bs);
         b4:=ptr(r.es,r.di+r.bx+640);
         r.ax:=(b1^+b2^+b3^+b4^) div 4;
         b1:=ptr(r.ex,r.di+r.bx-640);
         r.ax:=(r.ax+b1^)shr 1;
         if r.al>128 then r.al:=r.al-2
            else if r.al>3 then r.al:=r.al-4
               else r.al:=0;
         r.ah:=r.al;
         w1:ptr(r.es,r.di+r.bx-1280);
         w2^:=r.ax;
         w2:=ptr(r.es, r.di+r.bx-1600);
         w2^:=r.ax;
         r.bx:=r.bx+2;
       End;
       r.di:=r.di+640;
   End;
End;

(----------------Основная программа-------------------)
Begin
   InitGraph13;
   SetCols;
   r.es:=$A000;
   F:=0;
   W:=Port[$60]
   repeat
      randomize;
      addfireToScr (F div 32+1);
      copyvideo;
      if (F<512) then F:=F+1;
   until port[$60]<>W;
   CloseGraph13;
End.