{-----------------------------------------------------------
  Aceasta este prima versiune a programului.
  Programul deschide fisierul 'Exemplu.sdk' si il rezolva,
  aplicand doar o metoda logica (prin excludere), ceea ce ii
  permite sa rezolve multe exemple, dar NU toate.
 -----------------------------------------------------------}
uses crt,dos,windos,strings;
type cub3=array[1..9,1..9,1..9] of byte;
var tabla:cub3;
    ex,ey,mx,my:byte;
    all:boolean;
    FN:string;
    k:char;

    Procedure PCs(n,ex,ey,x,y,z:byte);
begin
gotoxy(ex-n*n+2*x,ey-n*n+2*y);write(z);
end;

    Procedure Fereastra(n,ex,ey:byte);
 var e:array[0..24] of char;
     x,y:array[1..100] 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;

  Function ix(x,y,i:byte):byte;
 var nx:byte;
begin
 nx:=((x-1)div 3)*3;
 ix:=nx+(x+i-nx)mod 3+1;
end;
  Function iy(x,y,i:byte):byte;
 var nx,ny:byte;
begin
 nx:=((x-1)div 3)*3;
 ny:=((y-1)div 3)*3;
 iy:=ny+((x+i-nx)div 3+y-1-ny)mod 3+1;
end;
   Function unicax(x,y:byte;c:char):byte;
  var i,z,n,v:byte;
 begin
    z:=0;n:=0;
  for i:=1 to 9 do begin
   case c of
    'x':v:=tabla[i,x,y];
    'y':v:=tabla[y,i,x];
    'z':v:=tabla[x,y,i];
   end;
        if v=2 then begin
if z=0 then z:=i;n:=i;end;
if z=n then unicax:=z else unicax:=0;
   end;
 end;
    Function unicp(p,z:byte):byte;
  var i,n,o,x,y:byte;
 begin
   n:=0;o:=0;x:=((p-1)mod 3+1)*3;y:=(p-1)div 3+1;
  for i:=1 to 9 do
  if tabla[ix(x,y,i-2),iy(x,y,i-2),z]=2 then begin
                      if o=0 then o:=i;n:=i; end;
  if o=n then unicp:=o else unicp:=0;
 end;

    Procedure bif(x,y,z:byte);
   var i:byte;
  Begin
 tabla[x,y,z]:=1;
for i:=0 to 7 do begin
  tabla[(x+i)mod 9+1,y,z]:=0;
  tabla[x,(y+i)mod 9+1,z]:=0;
  tabla[x,y,(z+i)mod 9+1]:=0;
  tabla[ix(x,y,i),iy(x,y,i),z]:=0;
  PCs(3,ex,ey,x,y,z);
  all:=false;
end;
  End;
    Procedure verunic;
   var x,y,z:byte;
  begin
   for x:=1 to 9 do for y:=1 to 9 do
 begin
  if unicax(x,y,'x')<>0 then bif(unicax(x,y,'x'),x,y);
  if unicax(x,y,'y')<>0 then bif(y,unicax(x,y,'y'),x);
  if unicax(x,y,'z')<>0 then bif(x,y,unicax(x,y,'z'));
 end;
  end;

    Function Arg(n:byte):string;
 var
  ArgN: PChar;
begin
  GetMem(ArgN, 20);
  GetArgStr(ArgN, n, 19);
  Arg:=StrPas(ArgN);
end;
    Procedure OpenF(fl:string);
 Var f:text;
     n:longint;
     i,j,h:byte;
  Begin
if fl='' then fn:='Exemplu.sdk' else fn:=fl;
Assign(f,fn);reset(f);
j:=0;
repeat
inc(j);
i:=10;
 readln(f,n);
 Repeat
dec(i);
h:=n mod 10;
if h<>0 then bif(i,j,h);
n:=n div 10;
 until i=1;
until eof(f);
close(f);
   end;


begin
textmode(258);textattr:=$1f;clrscr;
mx:=lo(windmax)+1;
my:=hi(windmax)+1;
ex:=mx div 2;ey:=my div 2;
fereastra(3,ex,ey);
OpenF(arg(1));
 Repeat
  Repeat
  All:=true;
If keypressed then k:=readkey;
  verunic;
  UNtil (k=#27);
 Until (k=#27);
Readkey;
end.
