uses crt;
var e:array[1..5] of string;
    l:array[1..5] of string;
    i,ex,ey,mx,my:byte;
    k:char;n:byte;
    c,doing:boolean;

    Procedure Fereastra(n,ex,ey:byte);
 var e:array[0..24] of char;
     x,y:array[1..200] of byte;
     i,j:byte;
 procedure writeif(x,y:byte;c:char);
 var mx,my:byte;
begin
  mx:=lo(windmax)+1;my:=hi(windmax)+1;
  if (x in [1..mx])and(y in [1..my])and(x+y<mx+my)then begin gotoxy(x,y);write(c);end;
end;
    begin
e[0]:=#201; e[5]:=#186; e[10]:=#199; e[15]:=#204; e[20]:=#200;
e[1]:=#205; e[6]:=#32;  e[11]:=#196; e[16]:=#205; e[21]:=#205;
e[2]:=#209; e[7]:=#179; e[12]:=#197; e[17]:=#216; e[22]:=#207;
e[3]:=#203; e[8]:=#186; e[13]:=#215; e[18]:=#206; e[23]:=#202;
e[4]:=#187; e[9]:=#186; e[14]:=#182; e[19]:=#185; e[24]:=#188;

 for i:=1 to 2*n*n do
  begin x[i]:=((i-1)mod 2)+1+(((i-1)mod(2*n))+1)div(2*n)+i div(2*n*n);y[i]:=5*x[i];end;
  writeif(ex-n*n+1,ey-n*n+1,e[0]);
 for i:=1 to 2*n*n do begin
  writeif(ex-n*n+i+1,ey-n*n+1,e[x[i]]);
  writeif(ex-n*n+1,ey-n*n+i+1,e[y[i]]);
                      end;
 for i:=1 to 2*n*n do for j:=1 to 2*n*n do writeif(ex-n*n+i+1,ey-n*n+j+1,e[x[i]+y[j]]);
    end;

begin
textmode(259);
textattr:=$1f;
clrscr;
mx:=lo(windmax)+1;
my:=hi(windmax)+1;
ex:=mx div 2;ey:=my div 2;
n:=1;c:=true;doing:=true;
repeat
fereastra(n,ex,ey);
if keypressed or not doing then begin k:=readkey;
 case upcase(k) of
  '1':n:=1;
  '2':n:=2;
  '3':n:=3;
  '4':n:=4;
  '5':n:=5;
  'S':doing:=not doing;
 end;
  k:=readkey;
end else delay(maxint*2);
if c then inc(n) else dec(n);
if not (n in [2..4]) then c:=not c;
clrscr;
until k=#27;
halt(1);
end.