unit SDKkrnl;
interface
const n=3; nn=n*n;

type domen=1..nn;
     dom0 =0..nn;
     dmn  =0..2;
     TCub =array[domen, domen, domen] of Boolean;
     TArea=array[domen, domen]of dom0;

   TSdk=object
     Procedure at(x, y, z: dom0);
     Procedure UnicXYZ(x, y: domen; d: dmn);
     Procedure UnicP(pn, z: domen);
     Procedure Analpat(z: domen; d: dmn);
   public
     Val: array[domen, domen]of 0..7;
     AllDone, Errors, Full_Area, Full_Cub: Boolean;
     Area: TArea;
     Cub: TCub;
     Procedure NewSheet;
     Procedure Generate;
     Procedure VerUnic;
     Procedure Rezolva;
     Procedure AreaToCub;
     Function IsComplete: Boolean;
     Function IsFull_Area: Boolean;
     Function IsFull_Cub: Boolean;
     Function GetXY(x,y:domen):dom0;
     Function GetXYZ(x,y,z:domen):boolean;
   private

    End;

var i, j, k: integer; x, y, z: dom0; {temp}


Function HexChr(x: dom0): char;
Function ChrHex(c: char): integer;
Function px(p, pp: domen): domen;
Function py(p, pp: domen): domen;
Function pp(x, y: domen): domen;
Function p(x, y: domen): domen;
Procedure NullArea(var a:TArea);
Procedure NullCub(var a:TCub);

implementation


Function HexChr(x: dom0): char;
 begin
  case x of
   0: HexChr:=chr(32);
   1..9: HexChr:=chr(x+48);
   else HexChr:=chr(x+55);
  end;
 end;

Function ChrHex(c: char): integer;
 begin
  case upcase(c) of
   '1'..'9': ChrHex:=ord(c)-48;
   'a'..'z',
   'A'..'Z': ChrHex:=ord(UpCase(c))-55;
   ' ', '0': ChrHex:=0;
  else ChrHex:=ord(c); end;
 end;
Function px(p, pp: domen): domen; begin px:=((p-1)mod n)*n+((pp-1)mod n)+1 end;
Function py(p, pp: domen): domen; begin py:=((p-1)div n)*n+((pp-1)div n)+1 end;
Function pp(x, y: domen): domen; begin pp:=(x-1) mod n+1+((y-1)mod n)*n end;
Function p(x, y: domen): domen; begin p:=(x-1)div n+1+((y-1)div n)*n end;

Procedure NullArea(var a:TArea);
var x, y: domen;
begin
 for x:=1 to nn do for y:=1 to nn do a[x,y]:=0;
end;
Procedure NullCub(var a:TCub);
var x, y, z: domen;
begin
 for x:=1 to nn do for y:=1 to nn do for z:=1 to nn do a[x, y, z]:=True;
end;

Procedure TSDK.NewSheet;
var i,j:domen;
 begin
  NullArea(Area);
  NullCub(Cub);
  Errors:=False;
  AllDone:=True;
  Full_Area:=False;
  Full_Cub:=False;
  for i:=1 to nn do for j:=1 to nn do Val[i,j]:=0;
 end;

Function TSDK.IsFull_Area: Boolean;
var x, y:dom0;
 begin
  Full_Area:=True;
  x:=0;
 repeat
  x:=x+1;
  y:=1;
  while(Area[x, y]<>0)and(y<nn)do y:=y+1;
 until(Area[x, y]=0)or(x=nn)or(y<nn);
 if Area[x, y]=0 then Full_Area:=False;
 IsFull_Area:=Full_Area;
 end;

Function TSDK.IsFull_Cub: Boolean;
var x, y, z:dom0;
 begin
  Full_Cub:=True;
  x:=0;
  repeat
   inc(x);
   y:=0;
   repeat
    Inc(y);;
    z:=1;
    while(not Cub[x, y, z])and(z<nn)do inc(z);
   until(Cub[x, y, z])or(z<nn)or(y=nn);
  until(Cub[x, y, z])or(z<nn)or(x=nn);
  Full_Cub:=not Cub[x, y, z];
  IsFull_Cub:=Full_Cub;
 end;

Procedure TSdk.AreaToCub;
var x,y: domen;
begin
 NullCub(Cub);
 for x:=1 to nn do for y:=1 to nn do
  if Area[x,y]<>0 then At(x,y,Area[x,y]);
end;

Procedure TSDK.Rezolva;
var i: domen;
begin
 Repeat
  VerUnic;
  if not IsFull_Area then for i:=1 to nn do
   begin
    analpat(i, 0);
    analpat(i, 1);
    analpat(i, 2);
   end else
    AllDone:=True;
 Until Errors or AllDone;
end;

Procedure TSDK.Generate;
var x,y,z: domen;
    n    : integer;
begin
 Randomize;
 repeat
  NewSheet;
  while not(Errors or IsFull_Cub)do begin
   n:=0;
   Repeat
    x:=random(nn)+1;
    y:=random(nn)+1;
    z:=random(nn)+1;
    inc(n);
   until(Cub[x,y,z])or(n=$ff);
   if Cub[x,y,z]then begin
    At(x,y,z);
    Val[x,y]:=2;
   end else NewSheet;
   Rezolva;
  end;
 until IsFull_Area;
 for x:=1 to nn do for y:=1 to nn do if Val[x,y]<>2 then At(x,y,0);
 AreaToCub;
end;

Procedure TSDK.at(x, y, z: dom0);
var i, pc: domen;
 begin
  pc:=p(x, y);
  if z=0 then
   if Area[x,y]=0 then
    for i:=1 to nn do Cub[x, y, i]:=True
   else begin
    for i:=1 to nn do begin
     Cub[x, y, i]:=True;
     Cub[x, i, Area[x,y]]:=True;
     Cub[i, y, Area[x,y]]:=True;
     Cub[px(pc, i), py(pc, i), Area[x,y]]:=True;
    end;
    Area[x,y]:=0;
  end else
  if (Area[x, y]=0)or(Area[x, y]=z)then begin
    for i:=1 to nn do begin
     Cub[x, y, i]:=False;
     Cub[x, i, z]:=False;
     Cub[i, y, z]:=False;
     Cub[px(pc, i), py(pc, i), z]:=False;
    end;
    Area[x, y]:=z; AllDone:=False;
  end;
 end;

Function TSDK.IsComplete: Boolean;
 begin
 end;


Procedure TSDK.UnicXYZ(x, y: domen; d: dmn);
var forbif: domen;
    v: array[dmn]of domen;
 begin
  v[(d+1)mod 3]:=x;
  v[(d+2)mod 3]:=y;
  v[d]:=1;
  while not Cub[v[0],v[1],v[2]]and(v[d]<nn)do inc(v[d]);
   if(v[d]<nn)then
    begin
     forbif:=v[d]; inc(v[d]);
     while not Cub[v[0], v[1], v[2]]and(v[d]<nn)do inc(v[d]);
     if not Cub[v[0], v[1], v[2]]then begin
      v[d]:=forbif;
      at(v[0], v[1], v[2]);
     end;
    end else
     if Cub[v[0],v[1],v[2]] then at(v[0],v[1],v[2]);
 end;

Procedure TSDK.UnicP(pn, z: domen);
var i, j: domen;
 begin
  i:=1;
  while not Cub[px(pn, i), py(pn, i), z]and(i<nn)do inc(i);
  if Cub[px(pn, i), py(pn, i), z] then
   if i=nn then at(px(pn, i), py(pn, i), z) else
    begin
     j:=i+1;
     while not Cub[px(pn, j), py(pn, j), z]and(j<nn)do inc(j);
     if not Cub[px(pn, j), py(pn, j), z]then at(px(pn, i), py(pn, i), z);
    end;
 end;

Procedure TSDK.VerUnic;
var x, y:domen;
 begin
  Repeat
   AllDone:=True;
   for x:=1 to nn do for y:=1 to nn do BEGIN
    UnicXYZ(x, y, 0);
    UnicXYZ(x, y, 1);
    UnicXYZ(x, y, 2);
   end;
   for x:=1 to nn do for y:=1 to nn do UnicP(x, y);
  Until AllDone or Errors;
 end;

Procedure TSDK.Analpat(z: domen; d: dmn);
var colx, coly: array[domen]of dom0;
    pat: array[domen, domen]of Boolean;
    dx, dy, dz: dmn;  nr: 2..nn-2;
    v: array[dmn]of 1..nn+1;
    xb, yb: set of domen;
    ng: dom0;
 Procedure getpat;
  var i: domen;
  begin
   for i:=1 to nn do begin colx[i]:=0; coly[i]:=0; end;
   v[dx]:=1;
   repeat
    v[dy]:=1;
    repeat
     if not Cub[v[0], v[1], v[2]] then begin
      inc(colx[v[dx]]); inc(coly[v[dy]]);
     end;
     pat[v[dx], v[dy]]:=Cub[v[0], v[1], v[2]];
     inc(v[dy])
    until v[dy]>nn;
    inc(v[dx])
   until v[dx]>nn;
  end;
 Function PosibMult: Boolean;
  var nx, ny, i: dom0;
  begin
   nx:=0; ny:=0; i:=0;
   PosibMult:=False;
   repeat
    inc(i);
    if colx[i]in[nr..nn-2]then nx:=nx+1;
   until(i=nn)or(nx=nn-nr); i:=0;
   if nx=nn-nr then begin
    repeat
     inc(i);
     if coly[i]in[nn-nr..nn-2]then ny:=ny+1;
    until(i=nn)or(ny=nr);
    if ny=nr then PosibMult:=True;
   end;
  end;
 Procedure ExclMult;
  label 1;
  var i, j: dom0;
      c: array[1..nn-2]of domen;
 function CasePos: Boolean;
  begin CasePos:=True; i:=1;
   while (coly[c[i]]in[nn-nr..nn-2])and(i<=nr) do inc(i);
   if i<=nr then CasePos:=False;
  end;

   begin
    for i:=1 to nr do c[i]:=nn-nr+i;
1: if CasePos then for i:=1 to nr do begin
{Analiza si excluderea posibilitatilor nefavorabile p/u cazul c[...]}
xb:=[]; ng:=0;
for x:=1 to nn do begin y:=1;
 while (not pat[x, c[y]])and(y<nr)do inc(y);
 if(y=nr)and not pat[x, c[y]]then begin xb:=xb+[x]; inc(ng); end;
end;
 if ng=nn-nr then begin yb:=[];
  for x:=1 to nr do yb:=yb+[c[x]];
  for x:=1 to nn do if not(x in xb)then for y:=1 to nn do if not(y in yb) then
    if pat[x, y] then begin pat[x, y]:=False; AllDone:=False; end;
 end;
{Sfarsitul analizei p/u c[...]}
end;
    if c[1]>1then begin dec(c[1]); goto 1; end;
    if c[nr]>nr then begin
     j:=nr; while(c[j-1]<>j-1) do dec(j);
     dec(c[j]); for i:=j downto 2 do c[i-1]:=c[i]-1;
     goto 1;
    end;
   end;

 Begin
  dx:=d; dy:=(d+1)mod 3; dz:=(d+2)mod 3; v[dz]:=z;
  {VerUnic;}
   getpat;
  x:=1;
  for nr:=2 to nn-2 do if PosibMult then ExclMult;
  for x:=1 to nn do for y:=1 to nn do begin
   v[dx]:=x; v[dy]:=y; Cub[v[0], v[1], v[2]]:=pat[v[dx], v[dy]];
  end;
 End;

function Tsdk.GetXY(x, y: domen): dom0;
begin
GetXY:=Area[x,y];
end;

function Tsdk.GetXYZ(x, y, z: domen): boolean;
begin
 GetXYZ:=Cub[x,y,z];
end;

end.