{$A-,B-,D-,E-,F+,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}
unit aut;
interface
uses Graph, Crt;
const
  MaxH   = 100;{100;}
  MaxV   = 100;{80; }
  Pic    = 1;
  Width  = Pic * MaxH;
  Height = Pic * MaxV;
  MX     = 640;
  MY     = 480;
  StartX = 15;{(Pred (MX) - Width) div 2;}
  StartY = 15;{(Pred (MY) - Height) div 2;}
  Step   : longint = 0;
  Delta  = 20;
  BkColor = White;
  Color = Black;
type
  Items = boolean;
  PMap = ^Map;
  Map = array[1..MaxH, 1..MaxV] of Items;
  Area = record
      C, N, S, W, E, NW, NE, SW, SE : Items;
    end;
  Method = function (var A : Area) : boolean;
var
  MapRef, MapAct : PMap;
  CurArea : Area;
  Gd, Gm : integer;
  CurrentMethod : Method;
  PredState : boolean;
  RS : longint;
  RStep : longint;
procedure One (var Val : boolean);
procedure EnableRescan;
procedure DisableRescan;
procedure ClearKbBuf;
procedure GetArea (H, V : word; var A : Area);
function ParityMethod (var A : Area) : boolean;
function GoWestMethod (var A : Area) : boolean;
function GoEastMethod (var A : Area) : boolean;
function GoNorthMethod (var A : Area) : boolean;
function GoSouthMethod (var A : Area) : boolean;
function AnnealMethod (var A : Area) : boolean;
procedure MQuit;
procedure DrawBuffer;
procedure Create;
procedure Dif (Cfg : byte);
procedure Dif2 (Cfg : byte);
implementation
{$L egavga}
procedure EVD; external;
procedure One (var Val : boolean);
  begin
    if Val then byte(Val) := 1;
  end;
procedure EnableRescan; assembler;
  asm
    mov  ah, 12h
    mov  bl, 36h
    mov  al, 0
    int  10h
  end;
procedure DisableRescan; assembler;
  asm
    mov  ah, 12h
    mov  bl, 36h
    mov  al, 1
    int  10h
  end;
procedure ClearKbBuf;
  begin
    while KeyPressed do ReadKey
  end;
procedure GetArea (H, V : word; var A : Area);
  var
    Tmp1, Tmp2 : word;
  begin
    with A do
      begin
        C := MapRef^[H,V];
        if (V - 1) = 0
          then N := MapRef^[H, MaxV]
          else N := MapRef^[H, V-1];
        if (V + 1) = MaxV+1
          then S := MapRef^[H, 1]
          else S := MapRef^[H, V+1];
        if (H - 1) = 0
          then W := MapRef^[MaxH, V]
          else W := MapRef^[H-1, V];
        if (H + 1) = MaxH+1
          then E := MapRef^[1, V]
          else E := MapRef^[H+1, V];

        Tmp1 := H-1;
        Tmp2 := V-1;
        if Tmp1 = 0 then Tmp1 := MaxH;
        if Tmp2 = 0 then Tmp2 := MaxV;
        NW := MapRef^[Tmp1, Tmp2];

        Tmp1 := H+1;
        Tmp2 := V-1;
        if Tmp1 = MaxH+1 then Tmp1 := 0;
        if Tmp2 = 0 then Tmp2 := MaxV;
        NE := MapRef^[Tmp1, Tmp2];

        Tmp1 := H-1;
        Tmp2 := V+1;
        if Tmp1 = 0 then Tmp1 := MaxH;
        if Tmp2 = MaxV+1 then Tmp2 := 0;
        SW := MapRef^[Tmp1, Tmp2];

        Tmp1 := H+1;
        Tmp2 := V+1;
        if Tmp1 = MaxH+1 then Tmp1 := 0;
        if Tmp2 = MaxV+1 then Tmp2 := 0;
        SE := MapRef^[Tmp1, Tmp2];
      end
  end;
function ParityMethod (var A : Area) : boolean;
  var
    Val : byte;
  begin
    with A do
      begin
        One (C);
        One (N);
        One (S);
        One (W);
        One (E);
        Val := byte(C) + byte(N) + byte(S) + byte(W) + byte(E);
        ParityMethod := Odd (Val);
      end
  end;
function GoWestMethod (var A : Area) : boolean;
  begin
    with A do
      begin
        GoWestMethod := E;
      end
  end;
function GoEastMethod (var A : Area) : boolean;
  begin
    with A do
      begin
        GoEastMethod := W;
      end
  end;
function GoNorthMethod (var A : Area) : boolean;
  begin
    with A do
      begin
        GoNorthMethod := S;
      end
  end;
function GoSouthMethod (var A : Area) : boolean;
  begin
    with A do
      begin
        GoSouthMethod := N;
      end
  end;
procedure MQuit;
  begin
    CloseGraph;
    ExitProc := nil;
    TextAttr := 7;
    ClrScr;
    Halt
  end;
function AnnealMethod (var A : Area) : boolean;
  var
    Val : byte;
  begin
    with A do
      begin
        One (C);
        One (N);
        One (S);
        One (W);
        One (NW);
        One (NE);
        One (SW);
        One (SE);
        Val := byte(C)+byte(N)+byte(S)+byte(W)+byte(E)+byte(NW)+byte(NE)+
          byte(SW)+byte(SE);
        if Val in [0..3, 5]
          then AnnealMethod := false
          else AnnealMethod := true;
      end
  end;
procedure DrawBuffer;
  var
    x, y, OffsetX, OffsetY : word;
  begin
    SetFillStyle (1, BkColor);
    Bar (StartX, StartY, Pred (StartX+Width), Pred (StartY+Height));
    SetColor (Color);
    SetFillStyle (1, Color);
    for y := 1 to MaxV do
      for x := 1 to MaxH do
        if MapAct^[x,y]
          then
            begin
              OffsetX := StartX + (x-1)*Pic;
              OffsetY := StartY + (y-1)*Pic;
              Bar (OffsetX, OffsetY, OffsetX+Pred (Pic), OffsetY+Pred (Pic));
            end;
  end;
procedure Create;
  var
    x, y : word;
  begin
    for y := 1 to MaxV do
      for x := 1 to MaxH do
        begin
          GetArea (x, y, CurArea);
          MapAct^[x,y] := CurrentMethod (CurArea);
        end;
  end;
procedure Dif (Cfg : byte);
  var
    Sw : boolean;
    Iter : longint;
    XPoint, XPoint2, YPoint, YPoint2, OffsetX, OffsetY, x, y : word;
  begin
    FillChar (MapRef^, SizeOf (Map), 0);
    case Cfg of
      0:
        begin
          for x := (MaxH div 2)-Delta to (MaxH div 2)+Delta do
            for y := 1 to MaxV do
              MapRef^[x, y] := true;
          MapAct^ := MapRef^;
        end;
      1:
        begin
          for x := (MaxH div 2) - Delta to (MaxH div 2) + Delta do
            for y := (MaxV div 2) - Delta to (MaxV div 2) + Delta do
              MapRef^[x, y] := true;
          MapAct^ := MapRef^;
        end;
    end;
    ClearDevice;
    DrawBuffer;
    ReadKey;
    Iter := 0;
    repeat
      XPoint := 1+Random (MaxH-1);
      YPoint := 1+Random (MaxV-1);
      if Odd (Random (1000))
        then
          begin
            XPoint2 := XPoint+1;
            YPoint2 := YPoint;
          end
        else
          begin
            XPoint2 := XPoint;
            YPoint2 := YPoint+1;
          end;
      if not (MapAct^[XPoint,YPoint] = MapAct^[XPoint2,YPoint2]) then
        begin
          Sw := MapAct^[XPoint,YPoint];
          MapAct^[XPoint,YPoint] := MapAct^[XPoint2,YPoint2];
          MapAct^[XPoint2,YPoint2] := Sw;
          if Sw
            then SetFillStyle (1,BkColor)
            else SetFillStyle (1,Color);
          OffsetX := StartX+(XPoint-1)*Pic;
          OffsetY := StartY+(YPoint-1)*Pic;
          Bar (OffsetX, OffsetY, OffsetX+Pred (Pic), OffsetY+Pred (Pic));
          if Sw
            then SetFillStyle (1,Color)
            else SetFillStyle (1,BkColor);
          OffsetX := StartX+(XPoint2-1)*Pic;
          OffsetY := StartY+(YPoint2-1)*Pic;
          Bar (OffsetX, OffsetY, OffsetX+Pred (Pic), OffsetY+Pred (Pic));
        end;
      Inc (Iter);
      if Iter > 60000 then begin Randomize; Iter := 0 end;
    until KeyPressed;
    ClearKbBuf;
  end;
procedure Dif2 (Cfg : byte);
  var
    Sw : boolean;
    Iter : longint;
    XPoint, XPoint2, YPoint, YPoint2, OffsetX, OffsetY, x, y : word;
  begin
    FillChar (MapRef^, SizeOf (Map), 0);
    case Cfg of
      0:
        begin
          for x := (MaxH div 2)-Delta to (MaxH div 2)+Delta do
            for y := 1 to MaxV do
              MapRef^[x, y] := true;
          MapAct^ := MapRef^;
        end;
      1:
        begin
          for x := (MaxH div 2) - Delta to (MaxH div 2) + Delta do
            for y := (MaxV div 2) - Delta to (MaxV div 2) + Delta do
              MapRef^[x, y] := true;
          MapAct^ := MapRef^;
        end;
    end;
    ClearDevice;
    DrawBuffer;
    ReadKey;
    Iter := 0;
    RStep := 0;
    repeat
      XPoint := 1+Random (MaxH-1);
      YPoint := 1+Random (MaxV-1);
      if Odd (Random (1000))
        then
          begin
            XPoint2 := XPoint+1;
            YPoint2 := YPoint;
          end
        else
          begin
            XPoint2 := XPoint;
            YPoint2 := YPoint+1;
          end;
      if not (MapAct^[XPoint,YPoint] = MapAct^[XPoint2,YPoint2]) then
        begin
          Sw := MapAct^[XPoint,YPoint];
          MapAct^[XPoint,YPoint] := MapAct^[XPoint2,YPoint2];
          MapAct^[XPoint2,YPoint2] := Sw;
        end;
      if RStep >= RS then
        begin
          DisableRescan;
          DrawBuffer;
          EnableRescan;
          Rstep := 0;
        end;
      Inc (Iter);
      Inc (RStep);
      if Iter > 60000 then begin Randomize; Iter := 0 end;
    until KeyPressed;
    ClearKbBuf;
  end;
begin
  Randomize;
  New (MapRef);
  New (MapAct);
  RegisterBGIDriver (@EVD);
  Gd := VGA; Gm := VGAHi;
  InitGraph (Gd, Gm, '');
  if GraphResult <> 0 then Halt;
  ExitProc := @MQuit;
end.