program sdjsq;{数独解算器}
{-------------调用库------------------------------------------------USES}
  uses CRT,Dos;{使用CRT Dos库}
{-------------数据类型定义------------------------------------------TYPE}
  type
    sz=0..9;{数字，byte类型的子界占一byte}
    sy=1..9;{same as sz}
    sd=array [sy,sy] of sz;{数独，占8×8×1byte=81byte}
    ss=set of sy;{数字的集合}
{-------------变量定义-----------------------------------------------VAR}
  var
    a:sd;
    x,y:byte;
{=============打印边框============================================PRINTK}
  procedure printk;
    var
      i, k : byte;
      flag : boolean;
  begin
    gotoxy(1,1);textcolor(15);textbackground(0);
    write(#218);for k:=1 to 8 do write(#196#194);writeln(#196#191);
    for i := 1 to 9 do begin
      write(#179);for k:=1 to 9 do begin
        textbackground(1-ord(((i-1) div 3+(k-1) div 3) mod 2=0));
        write(#32);textbackground(0);write(#179);
      end;
      writeln;
      if i<>9 then begin
        write(#195);for k:=1 to 8 do write(#196#197);writeln(#196#180);
      end;
    end;
    write(#192);for k:=1 to 8 do write(#196#193);writeln(#196#217);
    gotoxy(1,1);
  end;
{=============可以填的数==============================================KY}
  procedure ky(a:sd;x,y:byte;var s:ss);
    var
      i,j:byte;
  begin
    s:=[1,2,3,4,5,6,7,8,9];
    for i:=1 to 9 do if i<>x then s:=s-[a[i,y]];
    for i:=1 to 9 do if i<>y then s:=s-[a[x,i]];
    for i:=1 to 3 do for j:=1 to 3 do
      if ((x-1)div 3*3+i<>x) and ((y-1)div 3*3+j<>y)
       then s:=s-[a[(x-1)div 3*3+i,(y-1)div 3*3+j]];
    s:=s-[0];
  end;
{=============打印数据=============================================PRINT}
    procedure print(xn,yn,color:byte);
    begin
      gotoxy(2*xn,2*yn);
      textcolor(color);
      textbackground(5+ord(not ((x=xn)and(y=yn)))*(-4-ord(((xn-1) div 3+(yn-1) div 3) mod 2=0)));
      if a[xn,yn]<>0 then write(a[xn,yn]) else write(#32);
      gotoxy(1,1);
    end;

{=============用键盘读入数据===========================INPUT BY KEYBOARD}
  procedure inputbkb(var a:sd);
    label 1;
    var
      xi,yi:byte;
      c:char;
      s:ss;i:byte;
  begin
    printk;
    fillchar(a,sizeof(a),0);x:=1;y:=1;print(1,1,0);
    textcolor(15);textbackground(0);
    s:=[1..9];gotoxy(1,20);for i:=1 to 9 do write(i:2);
    repeat
      c:=readkey;
      xi:=x;yi:=y;
      case c of
        (*#13{Enter}, #27{Esc}*)
        #27:halt;
        (*#72{Up}, #75{Left}, #77{Right}, #80{Down}*)
        #0:begin
          c:=readkey;
          case c of
            #75:if x<>1 then x:=x-1 else write('');
            #72:if y<>1 then y:=y-1 else write('');
            #80:if y<>9 then y:=y+1 else write('');
            #77:if x<>9 then x:=x+1 else write('');
            #83:a[x,y]:=0;
          end;
        end;
        #48..#58:if (ord(c)-48 in s) or (c=#48)
          then a[x,y]:=ord(c)-48 else write('');
      end;
      print(xi,yi,12);print(x,y,12);
      ky(a,x,y,s);
      gotoxy(1,20);
      textcolor(15);textbackground(0);delline;
      for i:=1 to 9 do if i in s then write(i:2);
    until c=#13;
    x:=0;y:=0;print(xi,yi,12);
  end;
  procedure noans;
  begin
    gotoxy(1,20);
    delline;
    textcolor(143);textbackground(0);
    write('No answer!');
    readkey;
    halt;
  end;
{=============用文件读入数据===============================INPUT BY FILE}
  procedure inputbf(var a:sd;const path:string);
    function Exist(Path:string):boolean;
      var
        S: PathStr;
    begin
      S := FSearch(Path, GetEnv(''));
      Exist := S <> '';
    end;
    var
      x,y:byte;
      c:char;
      f:text;
  begin
    if not exist(path) then begin
      inputbkb(a);
    end else begin
      assign(f,path);reset(f);printk;
      for y:=1 to 9 do begin
        for x:=1 to 9 do begin
          repeat read(f,c); until (c<>#32) or eoln(f);
          if not (c in [#48..#58]) then begin
            inputbkb(a);exit;
          end;
          a[x,y]:=ord(c)-48;print(x,y,12)
        end;
        readln(f);
      end;
    end;
  end;
{=============填入固定数据============================================TC}
  procedure tc;
    var
      x,y,i,t,n,f:byte;
      s:ss;
  begin
    repeat
      f:=0;
      for x:=1 to 9 do
       for y:=1 to 9 do
        if a[x,y]=0 then begin
         ky(a,x,y,s);t:=0;if s=[] then noans;
         for i:=1 to 9 do if i in s then begin
           t:=t+1;n:=i;
         end;
         if t=1 then begin a[x,y]:=n;print(x,y,14);f:=f+1; end;
       end;
    until f=0;
  end;
{=============递归求解===============================================TRY}
  procedure try(x,y:byte);
    var
      i,j,n:byte;
      s:ss;
  begin
    if keypressed then if readkey=#27 then halt;
    if (y<>10) then begin
      if a[x,y]<>0 then if x=9 then try(1,y+1) else try(x+1,y) else begin
        ky(a,x,y,s);if s=[] then exit;
        n:=random(8)+1;
        for j:=n to n+8 do begin
          i:=n mod 9+1;
          if i in s then begin
            a[x,y]:=i;print(x,y,10);
           if x=9 then try(1,y+1) else try(x+1,y);
            a[x,y]:=0;print(x,y,0);
          end;
        end;
      end;
    end else begin
      gotoxy(1,20);textcolor(15);delline;write('Complete!');if readkey=#27 then halt;
      textcolor(15);textbackground(0);gotoxy(1,20);delline;writeln('Trying Next...');gotoxy(1,1);
    end;
  end;
  procedure crtinit;
    var
      OrigMode: Word;
  begin
    OrigMode:=LastMode;                  { Remember original video mode }
    TextMode(Lo(LastMode)+Font8x8);      { use 43 or 50 lines on EGA/VGA }
  end;
begin
  randomize;
  crtinit;
  textbackground(0);clrscr;
  if ParamCount=0 then inputbkb(a) else inputbf(a,ParamStr(1));
  tc;
  textcolor(15);textbackground(0);gotoxy(1,20);delline;writeln('Trying...');gotoxy(1,1);
  try(1,1);
  noans;
end.