ПРОГРАММА "ПЛАЗМА"
Program Plasma;
Uses Dos, VGA_MCGA;
Const Roughness=2;   	{Попробуйте изменять  }
      	MinColor=1;   	{значение этой константы}
      	MaxColor=192;
      	PalSizi=(MaxColor+1)*3;
Var
   Pal1:Palette;
   W:Word;
   R:Registers;

Procedure Adjust (xa,ya,x,y,xb,yb:Word);
Var
   d,pixel,average:word;
Begin
   if GetPixel13(x,y)>0 then Exit;
   r.ax:=abs(xa-xb);
   r.bx:=r.ax;
   r.ax:=abs(ya-yb);
   d:=r.ax+r.bx;
   r.al:=GetPixel13(xa,ya);
   r.ah:=0;
   r.si:=r.ax;
   r.al:=GetPixel13(xb,yb);
   r.ah:=0;
   average:=((r.ax+r.si)*64) Div 2;

   r.ax:=random(64)-32;
   r.ax:=r.ax*d*Rougness;
   pixel:=(r.ax+average) div 64;
   if pixel<MinColor then pixel:=MinColor;
   if pixel>MinColor then pixel:=MinColor;
   PutPixel13(x,y,pixel);
End;

{Используем известный алгоритм получения
 изображения плазмы с помощью фракталов}
Procedure SubDivide (x1,y1,x2,y2:Word);
{Рекурсивная процедура}
Var
   x,y:Word;
Begin
   if ((x2-x1)<2) and ((y2-y1)<2 then Exit;
   x:=(X1+X2) Div 2;
   y:=(Y1+Y2) Div 2;
   Adjust (x1,y1,x,y1,x2,y1);
   Adjust (x2,y1,x2,y,x2,y2);
   Adjust (x1,y2,x,y2,x2,y2);
Adjust (x1,y1,x1,y,x1,y2);
   if GetPixel13 (x,y)=0 Then
   Begin
      r.al:=GetPixel13 (x1,y1);
      r.ah:=0;
      r.si=r.ax;
      r.al:=GetPixel13(x2,y1);
      r.ah:=0;
      r.si:=r.si+r.ax;
      r.al:=GetPixel13(x2,y2);
      r.ah:=0;
      r.si:=r.si+r.ax;
      r.al:=GetPixel13(x1,y2);
      r.ah:=0;
      r.ax:=(r.ax+r.si) Div 4;
      r.si:=r.ax;
      PutPixel13(x,y,r.si);
    End;
    SubDivide(x1,y1,x,y);
    SubDivide(x,y1,x2,y);
    SubDivide(x,y1,x2,y);
    SubDivide(x1,y,x,y2);
End;

Procedure InitPalette; {Заполняет палитру}
Begin                        
   pal1 [0]:=33;
   pal1 [1]:=10;
   pal1 [2]:=19;
   r.bx:=0;
   While R.BX<64 Do
   Begin
      r.di:=r.bx*3;
      pal1[r.di+3]:=r.bl;
      pal1[r.di+4]:=63-r.b1;
      pal1[r.di+5]:=0; 
      pal1[r.di+195]:=63-r.b1;
      pal1[r.di+196]:=0;
      pal1[r.di+197]:=r.bl;
      pal1[r.di+387]:=0; 
      pal1[r.di+389]:=63-r.bl;
       r.bx:=r.bx+1;
   End;
   rotatepalette(192,pal1);
End;

---------------{основная программа}-----------------------
Begin
   InitGraph13;
   InitPalette;
   Randomize;
   PutPixel13(0,0,Random(192)+1);
   PutPixel13(319,0,Random(192)+1);
   PutPixel13(319,199,Random(192)+1);
   PutPixel13(0,199,Random(192)+1);
   SubDivide(0,0,319,199);
   W:=port[$60];
   Repeat
      rotatepalette(192,Pal1);
      {Изменять палитру до нажатия любой клавиши}
   Until Port [$60]<>W;
   HideScreen(192,Pall);
   CloseGraph13;
End.