PROGRAM eight_queens_problem;

{   Eight Queens Solution   by      Paul Lefebvre 3-20-89

   This program will find and display all 92 ways to place 8 queens on
   a chessboard.

}

TYPE
   row_type = ARRAY[1..8] OF BOOLEAN;
   sum_type = ARRAY[2..16] OF BOOLEAN;
   dif_type = ARRAY[-7..7] OF BOOLEAN;
   pick_type = ARRAY[1..8] OF INTEGER;
   
VAR
   rowchk : row_type;     { Values contain TRUE if row unavailable }
   diagsum : sum_type;    { Values contain TRUE if daigonal unavailable }
   diagdif : dif_type;    { Values contain TRUE if diagonal unavailable }
   picked : pick_type;    { Contains the row number of each column }
   i : INTEGER;

{ ---------------------------------------------------------------------- }

PROCEDURE display_solution(picked : pick_type; VAR solnum : INTEGER);

{ This procedure will display the solution that was found to the screen }

VAR
   i, j : INTEGER;
   
BEGIN
   solnum := solnum + 1;    { Keep a running count of the solutions }
   writeln; writeln;

   { This puts the actual chessboard on the screen }

   FOR i := 1 TO 8 DO BEGIN
      FOR j := 1 TO 8 DO
         IF (picked[j] = i) THEN
            write('Q ')
         ELSE
            write('+ ');
      writeln
   END;

   writeln('That is solution number ',solnum)
END; { display_solution }

{ ---------------------------------------------------------------------- }

PROCEDURE back_up(VAR row, col : INTEGER; VAR rowchk : row_type;
                  VAR diagsum : sum_type; VAR diagdif : dif_type;
                  VAR picked : pick_type);
                  
{ This procedure allows the computer to 'back up' if it comes to a dead
  end.  The computer is moved back one column and the marking variables are
  set back to FALSE.  The row position is moved up by one so that the
  computer does not try the same position twice.  If the row position is
  already in the last one (8), then the procedure loops again to back
  up another column. }
  
BEGIN
   REPEAT
      col := col - 1;
      IF (col > 0) THEN BEGIN
         row := picked[col];
         picked[col] := 0;
         rowchk[row] := FALSE;
         diagsum[col+row] := FALSE;
         diagdif[col-row] := FALSE;
   
         IF (row < 8) THEN
            row := row + 1
         ELSE
            row := 99
      END
    UNTIL (row <= 8) OR (col = 0)
END; { back_up }

{ ---------------------------------------------------------------------- }

PROCEDURE control_back_ups(VAR row, col : INTEGER; VAR rowchk : row_type;
                           VAR diagsum : sum_type; VAR diagdif : dif_type;
                           VAR picked : pick_type; VAR found : BOOLEAN;
                           VAR solnum : INTEGER);
                           
{ This is the procedure that determines if a solution has been found or
  if the computer is stuck and should back up. }
  

BEGIN

   { Solution found! }

   IF (col = 8) AND found THEN BEGIN
      display_solution(picked, solnum);
      found := FALSE;
      col := 9;
      back_up(row, col, rowchk, diagsum, diagdif, picked)
   END
   ELSE

      { Solution not found, so back up }

      IF (row > 8) THEN
         back_up(row, col, rowchk, diagsum, diagdif, picked)

END; { control_back_ups }

{ ---------------------------------------------------------------------- }

PROCEDURE find_solutions(rowchk : row_type; diagsum : sum_type;
                         diagdif : dif_type; picked : pick_type);
                         
{ This is the procedure that does the actual checking for a correct solution.
  It will return to the main body only when all the solutions are found. }
  
VAR
   found, done : BOOLEAN;
   start, solnum, row, col : INTEGER;
   
BEGIN
   start := 1;
   picked[1] := start;
   rowchk[start] := TRUE;
   diagsum[1+start] := TRUE;
   diagdif[1-start] := TRUE;
   done := FALSE;
   solnum := 0;
   col := 2;
   REPEAT
      row := 1;
      REPEAT
         found := FALSE;
         IF (col > 0) THEN BEGIN
            IF (NOT rowchk[row]) AND (NOT diagsum[col+row]) AND
               (NOT diagdif[col-row]) THEN BEGIN
               
               found := TRUE;
               rowchk[row] := TRUE;
               diagsum[col+row] := TRUE;
               diagdif[col-row] := TRUE;
               picked[col] := row
            
            END
            ELSE
               row := row + 1;
            control_back_ups(row, col, rowchk, diagsum, diagdif, picked,
                             found, solnum)
         END
         ELSE BEGIN
            found := TRUE;
            done := TRUE
         END
      UNTIL found;
      col := col + 1
   UNTIL done
END; { find_solutions }
   
{ ====================================================================== }

BEGIN { Main body }

   { Make sure all the arrays are correctly initialized }

   FOR i := 1 TO 8 DO BEGIN
      rowchk[i] := FALSE;
      picked[i] := 0
   END;
   FOR i := 2 TO 16 DO
      diagsum[i] := FALSE;
   FOR i := -7 TO 7 DO
      diagdif[i] := FALSE;

   writeln('Working ...');
   writeln;
   
   find_solutions(rowchk,diagsum,diagdif,picked);

   writeln;
   writeln('That''s all folks!')  { Program takes approx. 41 seconds to get here }
   
END.