Uses Crt, Dos;

const n=100;
      MaxMat = 1;
      MaxVek = 16;
      MaxNemVek = 8;
type StavBunky = record
		  Stav : (Zdrava, Nemocna, Mrtva);
		  Vek : Byte;
		 end;
     Rng = Zdrava..Mrtva;
     SS = array[RNG] of 0..8;
     R = 0..n-1;
     CMat = 0..MaxMat;
     MAT = array[R,R] of StavBunky;
     ANT = array[Cmat] of Mat;
var  Cella : ANT;
      X, Y : R;
     AkMat : CMat;

Procedure InitVGA;
var R : Registers;
Begin
 r.ah:=00;
 r.al:=$13;
 Intr($10,r);
End;

Procedure CloseVGA;
var R : Registers;
Begin
 r.ah:=00;
 r.al:=03;
 Intr($10,r);
End;

Procedure PutPixel(X,Y:Word;Color:Byte);
var ofs:Word;
begin
 ofs:=Y*320+X;
 Asm
  Mov AX, ofs
  Mov DI,AX
  Mov AX,$A000
  Mov ES,AX
  Mov Al, color
  Mov [ES:DI],AL
 end;
end;

Procedure InitMat;
var Xp, Yp : R;
begin
 For Xp:=0 to n-1 do for Yp:=0 to n-1 do
  begin
   Case Random(3)+1 of
   1: Cella[0][Xp,Yp].Stav:=Nemocna;
   2: Cella[0][Xp,Yp].Stav:=Zdrava;
   else Cella[0][Xp,Yp].Stav:=Mrtva;
   end;
   Cella[0][Xp,Yp].Vek:=Random(255);
  end;
 Cella[1]:=Cella[0];
end;

Procedure NovyStav(X, Y : R; MX : CMat; var Novy : StavBunky);
const Okoli : array[1..8,1..2] of ShortInt = ((-1,-1),( 0,-1),( 1,-1),
					      (-1, 0),{BUNKA} ( 1, 0),
					      (-1, 1),( 0, 1),( 1, 1));
var PO : 1..8;
    Bn : SS;
    Zatim : StavBunky;
begin
 Zatim:=Cella[MX][X,Y];
 Novy.Stav:=Zatim.Stav;
 Bn[Mrtva]:=0; Bn[Zdrava]:=0; Bn[Nemocna]:=0;
 For PO:=1 to 8 do Inc(Bn[Cella[MX][((X+Okoli[PO,1]+N) mod n),((Y+Okoli[PO,2]+N) mod n)].Stav]);
 If (Bn[Zdrava]>2)AND(Cella[MX][X,Y].Stav=Mrtva) then Novy.Stav:=Zdrava;
 If (Bn[Nemocna]>1)AND(Cella[MX][X,Y].Stav=Zdrava) then Novy.Stav:=Nemocna;
 If (Zatim.Stav=Nemocna)AND(Zatim.Vek > MaxNemVek) then Novy.Stav:=Mrtva;
 If Zatim.Stav<>Mrtva then If Novy.Vek < MaxVek then Novy.Vek:=Zatim.Vek+1 else begin Novy.Stav:=Mrtva; Novy.Vek:=0; end;
end;

Function Barva(Stav : StavBunky) : Byte;
begin
 Case Stav.Stav of
  Mrtva : Barva:=16;
  Nemocna : Barva:={64-Stav.Vek mod 16} 4;
  Zdrava : Barva:=31-Stav.Vek mod 16;
 end;
end;


begin
 InitVGA;
 InitMat;
 Repeat
  For X:=0 to n-1 do For Y:=0 to n-1 do PutPixel(X+10,Y+10,Barva(Cella[0][X,Y]));
  For X:=0 to n-1 do For Y:=0 to n-1 do NovyStav(X,Y,0,Cella[1][X,Y]);
  Cella[0]:=Cella[1];
 Until KeyPressed; ReadKey;
 CloseVGA;
end.