1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:

procedure TAmazone.Setz(S:Integer);
  var Z,K:Integer;
      F:TBrett;
      ZNeu,SNeu:Integer;
  begin
   for Z:=1 to BG do
    if Brett[Z,S]=0 then
     begin
      F:=Brett; // Brett zwischenspeichern
      // Felder waagerecht sperren
      for K:=S+1 to BG do Brett[Z,K]:=Gesperrt;
      // Diagonalen sperren
      for K:=1 to 2 do
       begin
        ZNeu:=Z+RY[K];SNeu:=S+RX[K];
        while Erlaubt(ZNeu,SNeu) do
         begin
          Brett[ZNeu,SNeu]:=Gesperrt;
          SNeu:=SNeu+RX[K];ZNeu:=ZNeu+RY[K];
         end
       end;
      // Springerzugmöglichkeit
      for K:=1 to 8 do
       begin
        ZNeu:=Z+WA[K];SNeu:=S+SE[K];
        if Erlaubt(ZNeu,SNeu) then
        Brett[ZNeu,SNeu]:=Gesperrt;
       end;
      Brett[Z,S]:=SpringerDame;
   (*   Application.ProcessMessages;
      if GetAsyncKeyState(VK_Escape)<0 then
       begin
        Abbruch:=True;
        exit;
       end;    *)
      if S<BG then Setz(S+1)
      else
       begin
       // if Abbruch then exit;
        inc(N);
        if Zeigen.Checked then
         begin
          Ausgabe(N,Brett,0);
          if not Vorhanden(Brett) then
           begin
            inc(SN);Ausgabe(SN,Brett,1);
       //     LabelSN.Caption:=IntToStr(SN);LabelSN.Repaint;
           end;
         end;
       // LabelN.Caption:=IntToStr(N);LabelN.Repaint;
       end;
      Brett:=F; // Zug rückgängig machen
      if (N>0) and STerste.Checked then exit
     end
  end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:

program Amazone;
{$IFDEF FPC}
  {$MODE DELPHI}
  {$OPTIMIZATION ON}
{$ELSE}
  {$Apptype console}
{$ENDIF}

uses
  sysutils;// TDatetime
const
  nmax = 17;
type
{$IFNDEF FPC}
  NativeInt = longInt;
{$ENDIF}
  //ala Nikolaus Wirth  A-1  = H - 8
  //diagonal left  (A1) to rigth (H8)
  tLR_diagonale = array[-nmax-1..nmax-1] of char;
  //diagonal right (A8) to left (H1)
  tRL_diagonale = array[0..2*nmax-2] of char;
  //up to Col are the used Cols, after that the unused
  //added 2 fields in front to remove check if row>=1 or row>=2 for knight move
  tFreeCol = array[-2..nmax] of NativeInt;
var
  LR_diagonale:tLR_diagonale;
  RL_diagonale:tRL_diagonale;
  //Using pChar, cause it is implicit an array
  //It is always set to
  //@LR_diagonale[row] ,@RL_diagonale[row]
  pLR,pRL : pChar;
  FreeCol : tFreeCol;
  i,
  n : nativeInt;
  gblCount : nativeUInt;
  T0,T1 : TdateTime;

procedure Solution;
var
  i : NativeInt;
begin
// Take's a lot of time under DOS/Win32
  If gblCount AND $FFF = 0 then
    write(gblCount:10,#8#8#8#8#8#8#8#8#8#8);
  // IF n< 9 then
  IF n < 0 then
   begin
     For i := 1 to n do
       write(FreeCol[i]:4);
     writeln;
   end;
end;

procedure SetAmazone(Row:nativeInt);
var
  i,Col : nativeInt;
begin
IF row <= n then
  begin
  For i := row to n do
    begin
    Col := FreeCol[i];
    //check diagonals are not occupied
    If (ORD(pLR[-Col]) AND ORD(pRL[Col]))<>0 then
      //check knight-move one and two rows before actual row
      IF (Abs(FreeCol[row-1]-col)<>2) AND (Abs(FreeCol[row-2]-col)<>1) then
      Begin
        //a "free" position is found
        //mark it
        pRL[ Col]:=#0;      //RL_Diagonale[ Row +Col] := 0;
        pLR[-Col]:=#0;      //LR_Diagonale[ Row -Col] := 0;
        //swap FreeRow[Row<->i]
        FreeCol[i] := FreeCol[Row];
        FreeCol[Row] := Col;
        //next row
        inc(pRL);
        inc(pLR);
        // check next row
          SetAmazone(Row+1);
        //Undo
        dec(pLR);
        dec(pRL);
        FreeCol[Row] := FreeCol[i];
        FreeCol[i] := Col;
        pRL[ Col]:=#1;
        pLR[-Col]:=#1;
        end;
      end;
  end
else
  begin
  //solution ist found
  inc(gblCount);
  //Solution
  end;
end;

begin
  FreeCol[-2] := High(FreeCol[0]);
  FreeCol[-1] := High(FreeCol[0]);
  FreeCol[0] := High(FreeCol[0]);
  For i := 1 to nmax do
    FreeCol[i] := i;
  FreeCol[nmax+1] := High(FreeCol[0]);
  //diagonals filled with True = #1 , something <>0
  fillchar(LR_Diagonale[low(LR_Diagonale)],sizeof(tLR_Diagonale),#1);
  fillchar(RL_Diagonale[low(RL_Diagonale)],sizeof(tRL_Diagonale),#1);
  For n := 1 to nMax-1 do
    begin
    t0 := time;
    pLR:=@LR_Diagonale[0];
    pRL:=@RL_Diagonale[0];
    gblCount := 0;
    SetAmazone(1);
    t1:= time;
    WriteLn(n:6,gblCount:12,FormatDateTime(' NN:SS.ZZZ',T1-t0),' secs');
    end;
  WriteLn('Fertig');
end.
{    9           0 00:00.000 secs
    10           4 00:00.001 secs
    11          44 00:00.000 secs
    12         156 00:00.001 secs
    13        1876 00:00.005 secs
    14        5180 00:00.028 secs
    15       32516 00:00.168 secs
    16      202900 00:01.116 secs}