Задача о расстановке ферзей / QUEEN95 / QUEEN1 / QUEEN1

{Џа®Ја ¬¬  ­Ґ гзЁвлў ой п бЁ¬¬ҐваЁо аҐиҐ­Ё©.}
program queen_;
Uses Dos;

const maxN = 20;
type Nat = 1..maxN;
var n : Nat;
fout : Text;
t, t1,t2 : LongInt;
min, sec, s100 : Word;

procedure Queen( n : Nat );

type Nat0 = 0..maxN;
Nat1 = 1..maxN+1;
pos = array [Nat] of Nat1;
var k : Nat0;
i : Nat;
a, s : pos; { s[k] - ­ Ё¬Ґ­миЁ© н«Ґ¬Ґ­в ¬­®¦Ґбвў  Sk }
{ ­Ґ®Їа®Ў®ў ­­ле (¤®ЇгбвЁ¬ле) §­ зҐ­Ё© }
count : Longint; { бзҐвзЁЄ ®Ўб«Ґ¤®ў ­­ле 㧫®ў ¤ҐаҐў  Ї®ЁбЄ }
countS : Longint; { бзҐвзЁЄ ­ ©¤Ґ­ле аҐиҐ­Ё© }

function NoQueen : Boolean;
{ NoFerz = 'дҐа§м ­Ґ ¬®¦Ґв Ўлвм Ї®бв ў«Ґ­ ў бва®Єг s[k] бв®«Ўж  k' }
var Flag : Boolean;
i : Nat;
begin {NoFerz}
Flag := True;
i := 1;
while (i<k) and Flag do
begin { Flag='дҐа§Ё [1..i) ­Ґ  в Єгов Ї®«Ґ <k,s[k]>'}
{  в ЄгҐв «Ё дҐа§м Ё§ i-Ј® бв®«Ўж  Ї®«Ґ <k,s[k]>?}
Flag := not ( (a[i]=s[k]) or (abs(a[i]-s[k])=k-i) );
i := i+1
end {while};
NoQueen := not Flag
end {NoQueen};

procedure RestSk;
{ ­ ©вЁ б«Ґ¤го饥 ­ Ё¬Ґ­м襥 §­ зҐ­ЁҐ s[k],
­ зЁ­ п б ⥪г饣® s[k]; Ґб«Ё в Є®ў®Ј® ­Ґв, в® s[k]=n+1 }
begin
while (s[k]<=n) and NoQueen do s[k] := s[k] + 1
end {RestSk};

begin{queen}
a[1] := 1; s[1] := 1;
k := 1;
count :=0; countS := 0;

while k>0 do
begin
while (k>=1) and (s[k]<=n) do
begin
a[k] := s[k];
s[k] := s[k] + 1;
RestSk;
count := count + 1;
if k=n then
begin { аҐиҐ­ЁҐ ­ ©¤Ґ­® }
countS := countS + 1; Write(fout,countS:7,' :: ');
for i:=1 to n do Write(fout, a[i]:3); WriteLn(fout)
end { дЁЄб жЁЁ аҐиҐ­Ёп }
else
begin { ЇҐаҐе®¤ Є б«Ґ¤го饩 ўҐавЁЄ «Ё }
k := k + 1;
s[k] := 1;
RestSk
end {if}
end {while};
k := k-1 {backtrack}
end {while};
WriteLn(fout,'ўбҐЈ® ўҐаиЁ­ = ',count)
end {Queen};

procedure MyGetTime ( var t : LongInt );
{ўл¤ Ґв ўаҐ¬п ў б®вле ¤®«пе ᥪ㭤л}
var h, m, s , hund : Word;
begin
GetTime( h, m , s, hund);
t := s + 60 * m;
t := hund + 100 * t
end { MyGetTime };

procedure MyUnPackTime ( t: LongInt; var m, s, hund : Word );
{ЇҐаҐў®¤Ёв ўаҐ¬п t (ў б®вле ¤®«пе ᥪ㭤л)
ў ¬Ё­гвл m, ᥪ㭤л s, б®влҐ hund }
begin
hund := t mod 100;
t := t div 100; {ў ᥪ㭠е}
s := t mod 60;
m := t div 60
end { MyUnPackTime };

begin
WriteLn(' n=?'); ReadLn(n);
Assign(fout,'QOUT.DAT');
Rewrite{Append}(fout);
WriteLn(fout,'Є®«ЁзҐбвў® дҐа§Ґ© = ',n:2);
WriteLn(fout,'а Ґ и Ґ ­ Ё п :');
MyGetTime(t1);

Queen ( n );

MyGetTime(t2);
t := t2 - t1; MyUnPackTime( t, min, sec, s100);
if(s100<10)
then WriteLn(fout,'ўаҐ¬п = ', min,' ¬Ё­ ', sec,'.0', s100,' ᥪ')
else WriteLn(fout,'ўаҐ¬п = ', min,' ¬Ё­ ', sec,'.', s100,' ᥪ');
Close (fout)
end.