Unit Cell;          {$I-}
Interface
Uses Crt,Graph,Dos;
{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{}
{}Type                                                     {}
{}RuleType = ( Life, Parity, fill, Banks, Escal, Neg );    {}
{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{}
{}Const     PgDn=#81;   Hm=#71;      F2=#60;    F3=#61;    {}
{}Xx=64;    F4=#62;     Left=#75;    Up=#72;    F8=#66;    {}
{}Yy=48;    F10=#68;    Right=#77;   Down=#80;  F1=#59;    {}
{}Rr=8;     Fire=#32;   F6=#64;      F7=#65;    PgUp=#73;  {}
{}Ed=#79;   BckSp=#8;   Ent=#13;     F9=#67;    F5=#63;    {}
{}Tab=#9;   Esc=#27;                                       {}
{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{}
{}Var                                                      {}
{} MapAct,MapRef:Array[1..Xx,1..Yy] Of Boolean;            {}
{} O,N,S,E,W,NW,SE,NE,SW:Integer;                          {}
{} Gd,Gm,X,Y,Kk,Pp,Sm,Sm2,Sm4,Sm8,Es,Ff,A,B:Integer;       {}
{} Ch,Curs,Symb,Jkl:Char;                                  {}
{} Str,Str2:String;                                        {}
{} Fs:Text;                                                {}
{} Od:Char;                                                {}
{} Rule:RuleType;                                          {}
{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{}
Procedure ChangeAlg;
Procedure IG;
Procedure Glider(I,J:Integer);
Procedure LineVer(Rt:Byte);
Procedure LineHor(Rt:Byte);
Procedure Header(Hr,Vr:Integer);
Procedure RandomMap;
Procedure ClearMap(Z:Boolean);
Procedure OutMap(C,D,Zl:Integer);
Procedure OutAllMap;
Procedure Editor;
Procedure Alg2;
Procedure Algoritm;
Procedure Enter;
Procedure Save;
Procedure Load;
Function Confirm:Boolean;
                             Implementation

{#} Procedure ChangeAlg;
 Begin
  ClearDevice;
  SetTextStyle(DefaultFont,0,2);
  OutTextXY(0,0,'F1 Life');
  OutTextXY(0,20,'F2 Parity');
  OutTextXY(0,40,'F3 fill');
  OutTextXY(0,60,'F4 Banks');
  OutTextXY(0,80,'F5 Escal');
  OutTextXY(0,100,'F6 Neg');
  Repeat
   Ch := ReadKey;
    Case Ch of
     F1 : begin Rule := Life; Sound(400); Delay(50); NoSound;
                                                    Header(0,0);exit; end;
     F2 : begin Rule := Parity;Sound(400); Delay(50); NoSound;
                                                    Header(0,0);exit; end;
     F3 : begin Rule := fill; Sound(400); Delay(50); NoSound;
                                                    Header(0,0);exit; end;
     F4 : begin Rule := Banks;Sound(400); Delay(50); NoSound;
                                                    Header(0,0);exit; end;
     F5 : begin Rule := Escal;Sound(400); Delay(50); NoSound;
                                                    Header(0,0);exit; end;
     F6 : begin Rule := Neg;Sound(400); Delay(50); NoSound;
                                                    Header(0,0);exit; end;
    end;
  Until false;

 End;
{#} Procedure Ig;
 Begin
DetectGraph(Gd,Gm);
InitGraph(Gd, Gm, 'c:\work\bp\bgi\');
if GraphResult < 0 then
  Halt(1);
OutText('Driver loaded by user program');
 End;
{#} Procedure Glider(I,J:Integer);
 Begin
  MapAct[I,J]:=True;
  MapAct[I,J+1]:=True;
  MapAct[I-1,J-1]:=True;
  MapAct[I+1,J]:=True;
  MapAct[I+1,J-1]:=True;
  OutAllMap;
  X:=I;Y:=J;
 End;
{------------------------------------}
{#}  Procedure LineVer(Rt:Byte);
Var P:Integer;
  Begin
   For P:=Rt+1 to Yy-Rt do begin MapAct[X,P]:=True; OutMap(X,P,1) end;
  End;
{------------------------------------}
{#}  Procedure LineHor(Rt:Byte);
Var P:Integer;
  Begin
   For P:=Rt+1 to Xx-Rt do begin MapAct[P,Y]:=True; OutMap(P,Y,1) end;
  End;
{-----------------------------------}
{#} Procedure Header(Hr,Vr:Integer);
 Begin
 ClearDevice;
 SetTextStyle(DefaultFont,0,2);
 OutTextXY(Hr,Vr,'F1 This information');
 OutTextXY(Hr,Vr+20,'F2 Save map');
 OutTextXY(Hr,Vr+40,'F3 Load map');
 OutTextXY(Hr,Vr+60,'F4 Edit map');
 OutTextXY(Hr,Vr+80,'F5 Random map');
 OutTextXY(Hr,Vr+100,'F6 One step');
 OutTextXY(Hr,Vr+120,'F7 Go until key');
 OutTextXY(Hr,Vr+140,'F8 Clear map');
 OutTextXY(Hr,Vr+160,'F9 Show map');
 OutTextXY(Hr,Vr+180,'F10 Exit from program');
 OutTextXY(Hr,Vr+200,'Tab Change algoritm ( Life is default )');
 Repeat until KeyPressed;
 ClearDevice;
 OutAllMap;
 End;
{------------------------------------}
{#} Procedure EditorHelp;
Begin
ClearDevice;
SetTextStyle(DefaultFont,0,2);
OutText('Editor help');
OutTextXY(0,20,'H Horizontal line');
OutTextXY(0,40,'V Vertical line');
OutTextXY(0,60,'G Glider');
OutTextXY(0,80,'Esc exit from editor');
OutTextXY(0,100,'Arrows key for move cursor,space On/Off Bar');
Repeat until KeyPressed;
ClearDevice;
OutAllMap;
X:=A;Y:=B;
End;
{------------------------------------}
   {#} Procedure RandomMap;
Begin
 Randomize;
  For X:=1 To Xx Do
   For Y:=1 To Yy Do Begin MapAct[X,Y]:=Odd(Round(Random*10));
    OutMap(X,Y,1); end;
  End;
{---------------------------------------------}
{#} Procedure OutMap(C,D,Zl:Integer);
  Begin
        If Zl=1 then SetFillStyle(1,Ord(MapAct[C,D])+3)
        else SetFillStyle(1,Ord(MapRef[C,D])+3);
        Kk:=Round(640/Xx);
        Pp:=Round(480/Yy);
           Bar(Kk*C-Rr,Pp*D-Rr,Kk*C,Pp*D);
 End;
{------------------------------------}
Procedure OutAllMap;
Begin
For Y:=1 to Yy do
 For X:=1 to Xx do OutMap(X,Y,1);
End;
{------------------------------------}
{#} Procedure ClearMap(Z:Boolean);
   Begin
    For X:=1 To Xx Do
     For Y:=1 To Yy Do Begin MapAct[X,Y]:=Z; OutMap(X,Y,1) end;
     X:=A;Y:=B;
   End;
{------------------------------------}
{#} Procedure Editor;
Begin
Sound(100); Delay(200); NoSound;
For Y:=1 to Yy do for X:=1 to Xx do OutMap(X,Y,1);
 X:=Round(Xx/2);Y:=Round(Yy/2);
 A:=X;B:=Y;
 Repeat
 {}  OutMap(A,B,1);
 {}  OutMap(X,Y,1);
 {}  SetFillStyle(7,3+Ord(MapAct[X,Y]));
 {}  Bar(Kk*X-Rr,Pp*y-Rr,Kk*X,Pp*Y);
 {}   Curs:=ReadKey;
 {}   A:=X;B:=Y;
 {}      Case Curs of
 {}{}          Up:    Y:=y-1;
 {}{}          Down:  Y:=y+1;
 {}{}          Left:  X:=x-1;
 {}{}          Right: X:=x+1;
 {}{}          PgUp:  begin X:=x+1; Y:=y-1 end;
 {}{}          PgDn:  begin X:=x+1; Y:=y+1 end;
 {}{}          Hm:    begin X:=x-1; Y:=y-1 end;
 {}{}          Ed:    begin X:=x-1; Y:=y+1 end;
 {}{}          F1:    EditorHelp;
 {}{}          F8:    ClearMap(False);
 {}{}          'h':   LineHor(0);
 {}{}          'v':   LineVer(0);
 {}{}          'g':   Glider(X,Y);
 {}{}          #27:   begin Sound(2000);Delay(100);NoSound;OutMap(X,Y,1);Exit end;
 {}         end;
 {}          If Y=0 then Y:=Yy;
 {}          If X=0 then X:=Xx;
 {}          If X=Xx+1 then X:=1;
 {}          If Y=Yy+1 then Y:=1;
 {}       If Curs=Fire  then Begin
 {}               If MapAct[X,Y]=False then MapAct[X,Y]:=True
 {}               Else MapAct[X,Y]:=False;
 {}                          end;
  Sound(2000); Delay(5); NoSound;
 Until false;
End;
{------------------------------------}
{#} Procedure Alg2;
  Begin
  Case Rule of
 Life: begin
       Sm4:=Ord(MapAct[X,S])+Ord(MapAct[X,N])+Ord(MapAct[E,Y])+Ord(MapAct[W,Y]);
       Sm8:=Ord(MapAct[W,N])+Ord(MapAct[W,S])+Ord(MApAct[E,N])+Ord(MapAct[E,S]);
       Sm:=Sm4+Sm8;
       MapRef[X,Y]:=MapAct[X,Y];
       If Sm=3 then MapRef[X,Y]:=True;
       If (Sm<2) or (Sm>3) then MapRef[X,Y]:=False;
      end;
Parity: begin
         Sm:=Ord(MapAct[X,S])+Ord(MapAct[X,N])+
         Ord(MapAct[E,Y])+Ord(MapAct[W,Y])+Ord(MapAct[X,Y]);
         MapRef[X,Y]:=MapAct[X,Y];
         If Odd(Sm) then MapRef[X,Y]:=True
                    else MapRef[X,Y]:=False;
        end;
Escal: begin
      Sm:=Ord(MapAct[E,S])+Ord(MapAct[W,N])+Ord(MapAct[E,S])+Ord(MapAct[W,N]);
        MapRef[X,Y]:=MapAct[X,Y];
        If Sm<2 then MapRef[X,Y]:=False
                 else MapRef[X,Y]:=True;
       end;
fill: begin
      Sm:=Ord(MapAct[X,S])+Ord(MapAct[X,N])+Ord(MapAct[E,Y])+Ord(MapAct[W,Y]);
      If (MapAct[X,S] and MapAct[X,N]) or (MapAct[W,Y] and MapAct[E,Y])
                                           then Sm2:= 0
                                           else Sm2:= 1;
        MapRef[X,Y]:=MapAct[X,Y];
        If (Sm=2) and (Sm2=1) then MapRef[X,Y]:=True;
       end;
Banks:begin
      Sm:=Ord(MapAct[X,S])+Ord(MapAct[X,N])+Ord(MapAct[E,Y])+Ord(MapAct[W,Y]);
      If (MapAct[X,S] and MapAct[X,N]) or (MapAct[W,Y] and MapAct[E,Y])
                                           then Sm2:= 0
                                           else Sm2:= 1;

      MapRef[X,Y]:=MapAct[X,Y];
        If (Sm=2) and (Sm2=1) then MapRef[X,Y]:=False;
        If  Sm>2 then MapRef[X,Y]:=True;
      end;
Neg:  begin
      MapRef[X,Y] := MapAct[X,Y];
      If MapRef[X,Y] = False then MapRef[X,Y] :=  True
                             else MapRef[X,Y] := False;
      end;
  End;
    If MapAct[X,Y]<>MapRef[X,Y] then OutMap(X,Y,0);
  End;
{------------------------------------}
{#} Procedure Algoritm;
 Begin
  For Y:=1 To Yy Do
   For X:=1 To Xx Do
       Begin
         If X=1 then W:=Xx
          else W:=X-1;
         If X=Xx then E:=1
          else E:=X+1;
         If Y=1 then N:=Yy
          else N:=Y-1;
         If Y=Yy then S:=1
          else S:=Y+1;
         Alg2;
       End;
       MapAct:=MapRef;
  End;
{------------------------------------}
{#} Function Confirm:Boolean;
Begin
Symb:=ReadKey;
If (SymB='Y') or (SymB='y') then Confirm:=True
else confirm:=False;
End;
{------------------------------------}
{#} Procedure Enter;
Begin
ClearDevice;
SetTextStyle(3,0,2);
OutTextXY(50,50,'Enter file name,please (8 characters)');
SetTextStyle(DefaultFont,0,2);
Str:='';
Gm:=0;
Repeat
SymB:=ReadKey;
SetColor(Black); OutTextXY(65,100,Str); SetColor(White);
If SymB=BckSp then Delete(Str,Length(Str),1);
If (Ord(Symb)>32) and (Ord(Symb)<123) then Str:=Str+Symb;
Delete(Str,9,1);
OutTextXY(65,100,Str);
Until SymB=Ent;
If Str='' then Enter;
SetColor(Black); OutTextXY(65,100,Str); SetColor(White);
Str2:=Str+'.map';
Str2:=FExpand('MAP\'+Str2);
SetTextStyle(3,0,1);
OutTextXY(65,100,Str2);
SetTextStyle(3,0,2);
End;
{-------------------------------}
{#} Procedure Save;
Begin
Enter;
OutTextXY(60,175,'Are you sure? (Y/N)');
If not confirm then begin ClearDevice; header(0,0); exit end;
ClearDevice;
Assign(Fs,Str2);
If FSearch(Str2,'')<>''then begin
OutTextXY(65,100,'File "'+Str2+'" already exists!');
OutTextXY(65,130,'Do you wish to overwrite it? (Y/N)');
If not Confirm then begin ClearDevice; Header(0,0); exit end;
                            end;
ClearDevice;
ReWrite(Fs);
For Y:=1 to Yy do    Begin
 For X:=1 to Xx do Write(Fs,Ord(MapAct[X,Y]));
  WriteLn(Fs);
                     End;
 Close(Fs);
 If IOResult=(0) then OutText('Saved succesful!')
 else OutText('Error! File not saved!');
 Repeat until KeyPressed; Header(0,0);
End;
Procedure Load;
Begin
Enter;
OutTextXY(60,175,'Are you sure? (Y/N)');
If not confirm then begin ClearDevice; header(0,0); exit end;
ClearDevice;
If FSearch(Str2,GetEnv('Path'))='' then begin
                        OutText('File not found : '+FExpand(Str2));
                        Repeat Until KeyPressed;
                        ClearDevice;
                        OutAllMap;
                        exit            end;
ClearDevice;
Assign(Fs,Str2);
Reset(Fs);
For Y:=1 to Yy do    Begin
 For X:=1 to Xx do   begin Read(Fs,Od); MapAct[X,Y]:=Odd(Ord(Od)-48);
                                        OutMap(X,Y,1)     end;
    ReadLn(Fs);      End;
End;


                                      {}{}{}{}{}{}{}
                                      {}Begin End.{}
                                      {}{}{}{}{}{}{}