USES crt,USudoku,windos,strings,dos;
var name: string;
    nr: longint;
    st: array[domen,domen] of 0..n*n;
    nf: integer;

Procedure GenFil;
    var f: text;
        fn,ns: string;
        i: byte;
        DirInfo: TSearchRec;
Begin
    if nr=0 then
    repeat
        str(nr,ns);
        for i:=1 to 5-length(ns) do ns:='0'+ns;
        fn:='St'+ns+'.sdk';
        FindFirst(fn, faanyfile, DirInfo);
        inc(nr);
    until DosError <> 0
    else begin
        str(nr,ns);
        for i:=1 to 5-length(ns) do ns:='0'+ns;
        fn:='St'+ns+'.sdk';
        inc(nr);
    end;
    Assign(f,fn);
    rewrite(f);
    for y:=1 to n*n do
    begin
        for x:=1 to n*n do write(f,HexChr(st[x,y]));
        writeln(f);
    end;
    close(f);
end;

procedure reduce;
begin
    for x:=1 to n*n do for y:=1 to n*n do
    begin
        z:=n*n+1;
        repeat
            dec(z);
        until (z=0)or(tabla[x,y,z]=1);
        st[x,y]:=z;
    end;
end;

procedure genereaza;
    var chek:boolean;
    procedure rand;
        const mnv=n*n*n*n;
        var nv:0..mnv;
    begin
        nv:=0;
        repeat
            nv:=nv+1;chek:=true;
            x:=random(n*n)+1;
            y:=random(n*n)+1;
            z:=random(n*n)+1;
            if tabla[x,y,z]=2 then
            begin
                bif(x,y,z,cl[5]);
                st[x,y]:=z;
                chek:=false;
            end;
        until not chek or (nv=mnv);
    end;

begin
    randomize;
    repeat
        repeat
        rand;
        rezolva;
        until comp or chek;
        if not comp then
        begin
            anula;
            delete;
            for x:=1 to n*n do
                for y:=1 to n*n do
                    st[x,y]:=0;
        end;
    until comp;
end;

Procedure addtof(flr:integer);
    const dn=2*n*n+1;
    var f: text;
        fn,ns: string;
        i,nf: byte;
        doc: array[1..dn,1..dn]of char;

    Procedure Fereastra;
        var e: array[0..24] of char;
            x, y: array[1..100] of byte;
            i, j: byte;

        procedure writeif(x,y:byte;c:char);
        begin
            if ord(c)=32 then doc[x,y] := hexchr(st[x div 2,y div 2])
            else doc[x,y] := c;
            gotoxy(x,y);
            write(c);
        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(1,1,e[0]);

        for i:=1 to 2*n*n do
        begin
            writeif(i+1,1,e[x[i]]);
            writeif(1,i+1,e[y[i]]);
        end;

        for i:=1 to 2*n*n do
            for j:=1 to 2*n*n do
                writeif(i+1,j+1,e[x[i]+y[j]]);
    end;

    Procedure store;
        var i,j:byte;
    begin
        writeln(f,nf);
        for i:=1 to dn do
        begin
            for j:=1 to dn do
                write(f,doc[j,i]);
            writeln(f);
        end;
        writeln(f);
    end;

    Begin
        fn:='Sudoku.doc';
        Assign(f,fn);rewrite(f);
        nf:=0;
        repeat
            inc(nf);
            anula;
            for x:=1 to n*n do
                for y:=1 to n*n do
                    st[x,y]:=0;
            genereaza;
            Fereastra;
            store;
            writeln(nf);
        until nf=flr;
        close(f);
    end;

Procedure attr;
begin
    cl[25]:=textattr;
    cl[1]:=$1f;
    for i:=2 to 25 do
        cl[i] := fonc(cl[1]);

    cl[2] := fonc(cl[1])+$2;
    cl[3] := fonc(cl[1])+$9;
    cl[4] := fonc(cl[1])+$d;
    cl[5] := fonc(cl[1])+$b;
    textattr := cl[1];
    clrscr;
    nr:=0;

    for x:=1 to n*n do
        for y:=1 to n*n do
            st[x,y]:=0;
end;

begin
    attr;
    Write('Nr. de stadii: ');readln(nf);
    addtof(nf);
    {
    repeat
        anula;
        for x:=1 to n*n do
            for y:=1 to n*n do
                st[x,y]:=0;
        genereaza;
        genfil;
    until keypressed;
    }
end.