Tám quân hậu

uses crt;
Var a,x:array[1..8] of integer;
    b:array[2..16] of integer;
    c:array[-7..7] of integer;
    i,n:integer;

procedure banco;
var i,j: integer;
begin
 clrscr;
 window(0,0,80,25);
 textbackground(6);
 clrscr;
 window(20,2,67,25);
 textbackground(15);
 clrscr;
 window(20,2,20+5,2+2);
 textbackground(black);
 clrscr;
 for j:=0 to 7 do
  begin
   if ((j+2) mod 2)=0 then
    begin
     for i:=0 to 7 do
      begin
       if ((i+2) mod 2)=0 then
        begin
         window(20+6*i,2+3*j,20+5+6*i,2+2+3*j);
         textbackground(black);
         clrscr;
        end;
      end;
     end;
  end;

  for j:=0 to 7 do
  begin
   if ((j+2) mod 2)=0 then
    begin
     for i:=0 to 7 do
      begin
       if ((i+2) mod 2)=0 then
        begin
         window(26+6*i,5+3*j,26+5+6*i,5+2+3*j);
         textbackground(black);
         clrscr;
        end;
      end;
     end;
  end;
end;

procedure socach;
begin
window(1,1,7,3);
textbackground(black);
clrscr;
write('Cach ',n);
end;

procedure love;
var j:integer;
begin
  n:=n+1;
  banco;
  socach;
  for j:=1 to 8 do
   begin
    window(22+(j-1)*6,2+(x[j]-1)*3,20+4+(j-1)*6,2+2+3*(x[j]-1));
    textbackground(red);
    clrscr;
   end;
   readln;
end;

procedure her(i:integer);
var j:integer;
 begin
  if i>8 then love else
  for j:=1 to 8 do
   if (a[j]=0) and (b[i+j]=0) and (c[i-j]=0) then
    begin
     x[i]:=j;
     a[j]:=1;
     b[i+j]:=1;
     c[i-j]:=1;
     her(i+1);
     c[i-j]:=0;
     b[i+j]:=0;
     a[j]:=0;
    end;
  end;

procedure forever;
var j:integer;
begin
 fillchar(a, sizeof(a),0);
 fillchar(b, sizeof(b),0);
 fillchar(c, sizeof(c),0);
end;

begin
clrscr;
forever;
her(1);
end.