{ view help of sudoku }
procedure Help;
begin
end;
{ move to position and write number }
{ write possible number for this }
procedure Kurzor(x,y,c:integer);
var xr,yr:integer;
i:integer;
begin
gotoxy(4,5); write(x);
gotoxy(8,5); write(y);
{ view choice }
gotoxy(2,8);
for i:=1 to 9 do
if( s[x,y,i]=0 )then
write(SPACE)
else
write(i);
{ calc real position }
xr:=LEFT + x*4 -2;
yr:=UP + y*2 -1;
gotoxy(xr,yr);
textbackground(c);
if( s[x,y,0]=0 )then
write( SPACE )
else
write(s[x,y,0]);
gotoxy(xr,yr);
end;
{ clear area }
procedure Clear;
var xc,yc,i: integer;
begin
for xc:=1 to 9 do
for yc:=1 to 9 do
begin
for i:=0 to 9 do
s[xc,yc,i]:=i;
Kurzor(xc,yc,COLBG);
end;
end;
{ save to file }
procedure Save;
var f: file of byte;
xc,yc: integer;
begin
Assign(f, DAT_FILE);
ReWrite(f);
for xc:=1 to 9 do
for yc:=1 to 9 do
Write(f, s[xc,yc,0]);
Close(f);
end;
{ load from file }
procedure Load;
var f: file of byte;
xc,yc: integer;
begin
Clear;
{$I-}
Assign(f, DAT_FILE);
ReSet(f);
{$I+}
{ if file exist }
if( IOResult=0 )then
begin
for xc:=1 to 9 do
for yc:=1 to 9 do
begin
Read(f, s[xc,yc,0]);
Kurzor(xc,yc,COLBG);
end;
Close(f);
end;
end;
{ if only one kind than it's a resolve }
function GetSingle(x,y: integer):byte;
var i: integer;
w: integer;
begin
w:=0;
for i:=1 to 9 do
if( s[x,y,i]<>0 ) then
begin
if( w=0 )then w:=i
else w:=-1;
end;
{ result }
if( w>0 )then GetSingle:=w
else GetSingle:=0;
end;
{ cross test of use some number }
function KrossTest(xc,yc:integer):byte;
var x,y: integer;
xs,ys: integer;
i: integer;
poc: integer;
begin
KrossTest:=0;
for i:=1 to 9 do
if( s[xc,yc,i]<>0 )then
begin
poc:=0;
{ left to right }
for x:=1 to 9 do
if(( s[x,yc,i]=i ) and (s[x,yc,0]=0 ))then
inc(poc);
{ single? }
if( poc=1 )then
KrossTest:=i;
poc:=0;
{ up to down }
for y:=1 to 9 do
if(( s[xc,y,i]=i ) and (s[xc,y,0]=0 ))then
inc(poc);
{ single }
if( poc=1 )then
KrossTest:=i;
{ in square }
poc:=0;
xs:=(xc-1) div 3;
ys:=(yc-1) div 3;
for x:=1 to 3 do
for y:=1 to 3 do
if(( s[3*xs+x,3*ys+y,i]=i ) and (s[3*xs+x,3*ys+y,0]=0 ))then
inc(poc);
{ single }
if( poc=1 )then
KrossTest:=i;
end;
end;
{ make resolve }
function Resolve:boolean;
var xc,yc: integer;
xs,ys: integer;
xi,yi: integer;
c,i: integer;
begin
Resolve:=false;
for xc:=1 to 9 do
for yc:=1 to 9 do
if( s[xc,yc,0]=0 )then
begin
{ resolve this }
c:=s[xc,yc,0];
{ x-axis }
for i:=1 to 9 do
s[xc,yc, s[i,yc,0]]:=0;
{ y-axis }
for i:=1 to 9 do
s[xc,yc, s[xc,i,0]]:=0;
{ do square }
xs:=(xc-1) div 3;
ys:=(yc-1) div 3;
for xi:=1 to 3 do
for yi:=1 to 3 do
s[xc,yc, s[3*xs+xi,3*ys+yi,0]] := 0;
{ resolve of simply test }
s[xc,yc,0]:=GetSingle(xc,yc);
{ simply test without result try cross test }
if( s[xc,yc,0]=0 )then
s[xc,yc,0]:=KrossTest(xc,yc);