program CAAnts;

uses Graph,Crt;

const

 Use256ColorMode : boolean = true;

 MatrixWidth = 100;
 MatrixHeight = 100;
 NumAnts : integer = 100;            { how many ants are there? }
 NumNeedles : integer = 2000;         { how many needles? }

 GraphicCell = 4;           { size of the cell on screen }
 HalfGraphicCell = GraphicCell div 2;

type

 TPoint =
  record
   x,y : integer;
  end;

 TCell = (Empty,Ant,Needle,AntNeedle);

 TMatrix = array[0..MatrixWidth-1,0..MatrixHeight-1] of TCell; { the matrix }

var
 Matrix : TMatrix;
 Finish,InGraphics : boolean;
 Generation : longint;
 LogF : text;
 CM : array[0..MatrixWidth-1,0..MatrixHeight-1] of integer;
 cn : array[0..2000] of integer;
 f : array[1..1000] of TPoint;

procedure PaintCell(x,y : integer);
 begin
  if not InGraphics then exit;
  SetFillStyle(SolidFill,Black);
  Bar(x*GraphicCell,y*GraphicCell,
   x*GraphicCell+GraphicCell-1,y*GraphicCell+GraphicCell-1);
  case Matrix[x,y] of
   Empty : {nothing};
   Ant :
    begin
     SetFillStyle(SolidFill,White);
     Bar(x*GraphicCell+1,y*GraphicCell+1,
         x*GraphicCell+GraphicCell-2,y*GraphicCell+GraphicCell-2);
    end;
   Needle :
    begin
     SetFillStyle(SolidFill,LightGreen);
     Bar(x*GraphicCell+1,y*GraphicCell+1,
         x*GraphicCell+HalfGraphicCell-1,y*GraphicCell+GraphicCell-2);
    end;
   AntNeedle :
    begin
     SetFillStyle(SolidFill,White);
     Bar(x*GraphicCell+1,y*GraphicCell+1,
         x*GraphicCell+GraphicCell-2,y*GraphicCell+GraphicCell-2);
     SetFillStyle(SolidFill,LightGreen);
     Bar(x*GraphicCell+1,y*GraphicCell+1,
         x*GraphicCell+HalfGraphicCell-1,y*GraphicCell+GraphicCell-2);
    end;
  end;
 end;

procedure UpdateMatrixRect(x1,y1,x2,y2 : integer);
 var x,y : integer;
 begin
  if x1<0 then x1:=0;
  if y1<0 then y1:=0;
  if x2>MatrixWidth-1 then x2:=MatrixWidth-1;
  if y2>MatrixHeight-1 then y2:=MatrixHeight-1;
  for x:=x1 to x2 do
   for y:=y1 to y2 do
    PaintCell(x,y);
 end;

procedure RefreshMatrix;
 begin
  UpdateMatrixRect(0,0,MatrixWidth-1,MatrixHeight-1);
 end;

function North(y:integer):integer;
 begin
  if y>0 then North:=y-1 else North:=MatrixHeight-1;
 end;

function South(y:integer):integer;
 begin
  South:=(y+1) mod MatrixHeight;
 end;

function West(x:integer):integer;
 begin
  if x>0 then West:=x-1 else West:=MatrixWidth-1;
 end;

function East(x:integer):integer;
 begin
  East:=(x+1) mod MatrixWidth;
 end;

procedure SetGraphicsMode;
 var
  gd, gm : integer;
  gp : string;
  ErrCode : integer;
 begin
  gp:='';
  repeat
   if Use256ColorMode then
    begin
     gd:=installuserdriver('svga256',nil);
     gm:=2;
    end else
    begin
     gd:=vga; gm:=vgahi;
    end;
   InitGraph(gd,gm,gp);
   ErrCode := GraphResult;
   if ErrCode <> grOk then
    begin
     writeln('Graphics error:', GraphErrorMsg(ErrCode));
     writeln('Path to graphics driver (ENTER to exit): ');
     readln(gp);
    end else InGraphics:=true;
  until (ErrCode = grOk) or (gp='');
 end;

procedure ClearMatrix;
 var
  x,y : integer;
 begin
  for x:=0 to MatrixWidth-1 do
   for y:=0 to MatrixHeight-1 do
    Matrix[x,y]:=Empty;
 end;

procedure RandomMatrix;
 var a,x,y : integer;
 begin
  for a:=1 to NumNeedles do
   begin
    repeat
     x:=random(MatrixWidth);
     y:=random(MatrixHeight);
    until Matrix[x,y]=Empty;
    {possible deadlock!}
    Matrix[x,y] := Needle;
   end;
  for a:=1 to NumAnts do
   begin
    repeat
     x:=random(MatrixWidth);
     y:=random(MatrixHeight);
    until Matrix[x,y]=Empty;
    {possible deadlock!}
    Matrix[x,y]:=Ant;
   end;
 end;

function DirX(x,d : integer):integer;
 begin
  DirX:=x;
  case d of
   1,3 : {DirX:=x};   {north, south}
   2 : DirX:=West(x); {west}
   4 : DirX:=East(x); {east}
  end;
 end;

function DirY(y,d : integer):integer;
 begin
  DirY:=y;
  case d of
   2,4 : {DirY:=Y};   {north, south}
   1 : DirY:=North(y);
   3 : DirY:=South(y);
  end;
 end;

function Dir8X(x,d : integer):integer;
 begin
  Dir8X:=x;
  case d of
   1,5 : {Dir8X:=x};   {north, south}
   2,3,4 : Dir8X:=West(x); {west}
   6,7,8 : Dir8X:=East(x); {east}
  end;
 end;

function Dir8Y(y,d : integer):integer;
 begin
  Dir8Y:=y;
  case d of
   3,7 : {Dir8Y:=Y};   {north, south}
   1,2,8 : Dir8Y:=North(y);
   4,5,6 : Dir8Y:=South(y);
  end;
 end;

procedure MoveAnts;
 var
  NewMatrix : TMatrix;
  x,y,n,a : integer;
  ed : array[1..8] of integer;
  NearNeedle : boolean;
 begin
  {skopirujeme ihlicie:}
  for x:=0 to MatrixWidth-1 do
   for y:=0 to MatrixHeight-1 do
    if Matrix[x,y] = Needle then
     NewMatrix[x,y]:=Matrix[x,y] else
     NewMatrix[x,y]:=Empty;
  {posunieme mravce:}
  for x:=0 to MatrixWidth-1 do
   for y:=0 to MatrixHeight-1 do
    if Matrix[x,y] in [Ant,AntNeedle] then
     begin
      NearNeedle:=false;
      for a:=1 to 4 do
       if NewMatrix[DirX(x,a),DirY(y,a)] = Needle then NearNeedle:=true;
      if Matrix[x,y] = Ant then
       begin
        n:=0;
        for a:=1 to 4 do
         if (NewMatrix[DirX(x,a),DirY(y,a)] in [Empty,Needle]) and
           (Matrix[DirX(x,a),DirY(y,a)] in [Empty,Needle])  then
          begin inc(n); ed[n]:=a; end;
       end else
       begin
        {s ihlicim nemoze prejst na ine ihlicie}
        n:=0;
        for a:=1 to 4 do
         if (NewMatrix[DirX(x,a),DirY(y,a)] = Empty) and
           (Matrix[DirX(x,a),DirY(y,a)] = Empty) then
          begin inc(n); ed[n]:=a; end;
       end;
      {ak sa moze pohnut, pohne sa, inak ostava:}
      if n>0 then
       begin
        a:=ed[random(n)+1];
        {ak je pri ihlici a uz nesie, moze pustit a "odist bez" s pravdep. 50%:}
        if Matrix[x,y]=AntNeedle then
         begin
          if NearNeedle and (NewMatrix[x,y]=Empty) and (random(2)=1) then
           begin
            NewMatrix[x,y] := Needle;
            NewMatrix[DirX(x,a),DirY(y,a)] := Ant; {!predp., ze ide na Empty}
           end else
            NewMatrix[DirX(x,a),DirY(y,a)] := Matrix[x,y]; {!predp., ze ide na Empty}
         end else
         if NewMatrix[DirX(x,a),DirY(y,a)] = Needle then
          NewMatrix[DirX(x,a),DirY(y,a)] := AntNeedle else
          NewMatrix[DirX(x,a),DirY(y,a)] := Matrix[x,y];
       end else
        NewMatrix[x,y]:=Matrix[x,y];
     end;
  Matrix:=NewMatrix;
  RefreshMatrix;
 end;

procedure MeasureEmergence;
 var
  x,y,c,cx,cy,nx,ny,a,cmax : integer;
  fn : integer;
 begin
  { ofarbime ostrovy - kopky: }
  c:=0;
  fillchar(CM,sizeof(CM),0);
  for x:=0 to MatrixWidth-1 do
   for y:=0 to MatrixHeight-1 do
    if (Matrix[x,y]=Needle) and (CM[x,y]=0) then
     {!!!! otazne, ci sa maju ratat aj mravci s ihlicim}
     begin
      inc(c);
      CM[x,y]:=c;
      fn:=1;
      f[1].x:=x; f[1].y:=y;
      while fn>0 do
       begin
        cx:=f[fn].x;
        cy:=f[fn].y;
        dec(fn);
        for a:=1 to 8 do
         begin
          nx:=Dir8X(cx,a);
          ny:=Dir8Y(cy,a);
          if (Matrix[nx,ny]=Needle) and (CM[nx,ny]=0) then
           begin
            CM[nx,ny]:=c;
            inc(fn);
            f[fn].x:=nx; f[fn].y:=ny;
           end;
         end;
       end;
     end;
  {spocitame ostrovy:}
  fillchar(cn,sizeof(cn),0);
  for x:=0 to MatrixWidth-1 do
   for y:=0 to MatrixHeight-1 do
    inc(cn[CM[x,y]]); {!!!! ak bude viac ako 2000 kopok?}
  {ak sme v textovom mode, vypiseme vysledok:}
  if not InGraphics then
   begin
    write('Generation: ',Generation,' Piles: ',c,' (');
    cmax:=c;
    for a:=1 to c do
     begin
      write(cn[a],' ');
      if cn[a]>cn[cmax] then cmax:=a;
     end;
    writeln(') Max: ',cn[cmax],' = ',100.0*cn[cmax]/NumNeedles:5:2,'%');
   end;
  writeln(LogF,'G: ',Generation,' Piles: ',c,' Max: ',cn[cmax],' = ',100.0*cn[cmax]/NumNeedles:5:2,'%');
 end;

procedure UserMonitor;
 var
  st,st2 : string;
  i,x,y,a,n : integer;
  uc : boolean;
 begin
  if keypressed then
   begin
    CloseGraph;
    InGraphics:=false;
    writeln('User monitoring dialog enabled.');
    writeln(' press ENTER to continue');
    writeln(' type "x" to exit');
    writeln(' type "?" for help');
    writeln;
    repeat
     uc:=true;
     write('> ');
     readln(st);
     for i:=1 to length(st) do st[i]:=UpCase(st[i]);
     if st='X' then
      begin
       writeln('Bye...');
       Finish:=true;
       uc:=false;
      end;
     if st='I' then
      begin
       writeln('Generation: ',Generation);
       writeln(LogF,'Generation: ',Generation);
       a:=0; n:=0;
       for x:=0 to MatrixWidth-1 do
        for y:=0 to MatrixHeight-1 do
         case Matrix[x,y] of
          Ant : inc(a);
          Needle : inc(n);
          AntNeedle : begin inc(a); inc(n); end;
         end;
       writeln('Ants: ',a,' (init: ',NumAnts,')');
       writeln(LogF,'Ants: ',a,' (init: ',NumAnts,')');
       writeln('Needles: ',n,' (init: ',NumNeedles,')');
       writeln(LogF,'Needles: ',n,' (init: ',NumNeedles,')');
       writeln('Matrix X: ',MatrixWidth);
       writeln(LogF,'Matrix X: ',MatrixWidth);
       writeln('Matrix Y: ',MatrixHeight);
       writeln(LogF,'Matrix Y: ',MatrixHeight);
       writeln('% needles: ',100.0*n/(MatrixWidth*MatrixHeight):10:3);
       writeln(LogF,'% needles: ',100.0*n/(MatrixWidth*MatrixHeight):10:3);
       writeln('% ants: ',100.0*a/(MatrixWidth*MatrixHeight):10:3);
       writeln(LogF,'% ants: ',100.0*a/(MatrixWidth*MatrixHeight):10:3);
       uc:=false;
      end;
     if st='R' then
      begin
       writeln('Restart with:');
       repeat
        write('Number of ants: '); readln(NumAnts);
       until NumAnts>0;
       repeat
        write('Number of needles: '); readln(NumNeedles);
       until NumAnts>0;
       writeln(Logf,'-----------');
       writeln(LogF,'Restarting with ants: ',NumAnts,' needles: ',NumNeedles);
       writeln(LogF,'Matrix: ',MatrixWidth,' x ',MatrixHeight);
       Generation:=0;
       ClearMatrix;
       RandomMatrix;
       uc:=false;
      end;
     if st='C' then
      begin
       write('Measure (also to log-file) every ? steps (0 not to measure): ');
       readln(n);
       writeln('Continuing, press Esc key to stop.');
       repeat
        inc(Generation);
        write('Generation: ',Generation:10,#13);
        MoveAnts;
        if (n>0) and (Generation mod n = 0) then
         begin
          writeln;
          MeasureEmergence;
         end;
       until keypressed;
       writeln;
       uc:=false;
      end;
     if st='M' then
      begin
       writeln('Measuring...');
       MeasureEmergence;
       uc:=false;
      end;
     if st='P' then
      begin
       writeln('Press ENTER to preview, then press ENTER to return.');
       readln;
       SetGraphicsMode;
       RefreshMatrix;
       readln;
       CloseGraph;
       InGraphics:=false;
       uc:=false;
      end;
     if st='L' then
      begin
       write('Log>'); readln(st2);
       writeln(LogF,st2);
       uc:=false;
      end;
     if st='D' then
      begin
       Use256ColorMode:=not Use256ColorMode;
       if Use256ColorMode then writeln('256 color mode') else writeln('16 color mode');
       uc:=false;
      end;
     if st='?' then
      begin
       writeln(' press ENTER (empty line) to continue');
       writeln(' "x" - exit');
       writeln(' "?" - this help');
       writeln(' "i" - info (also to log-file)');
       writeln(' "r" - restart with given parameters (also to log-file)');
       writeln(' "c" - continue without preview');
       writeln(' "p" - still preview');
       writeln(' "m" - measure "emergence" - number of piles (also to log-file)');
       writeln(' "l" - write user string to log file');
       writeln(' "d" - change display mode (16/256 color mode)');
       uc:=false;
      end;
     if st='' then uc:=false;
     if uc then writeln('Unknown command');
    until (st='') or (st='X');
    if not(Finish) then SetGraphicsMode;
   end;
 end;

begin
 assign(LogF,'caants.log');
 {$I-} append(LogF); {$I+}
 if ioresult<>0 then rewrite(LogF);
 writeln(LogF,'--------- starting application --------');
 writeln('During simulation, press Esc to break.');
 InGraphics:=false;
 SetGraphicsMode;
 ClearMatrix;
 RandomMatrix;
 RefreshMatrix;
 Finish:=false;
 Generation:=0;
 repeat
  inc(Generation);
  MoveAnts;
  UserMonitor;
 until Finish;
 CloseGraph; {!!!! teraz uz netreba...}
 InGraphics:=false;
 writeln(LogF,'--------- ending application --------');
 writeln(LogF);
 close(LogF);
end.