DECLARE SUB Cover (Row%, Col%, Inc%, Grid%(), Choice%(), N%)
DECLARE SUB ChangeRow (Row%, Col%, Inc%, Grid%(), N%)
DECLARE SUB ChangeDiag (Row%, Col%, Inc%, Grid%(), N%)
DECLARE SUB RecordSolution (Temp%(), Solution%(), Found%, N%)
DECLARE SUB Backtrack (Choice%(), Grid%(), Row%, Col%, N%, Done%)
DECLARE SUB Initialize (N%, Done%, Found%, Col%, Row%)
DECLARE SUB Guts (N%, Done%, Found%, Col%, Row%, Grid%(), Choice%(), Solution%())
'============================================================================
'   G.H. George                                                 1991 NOV 03
'                                QUEENS.BAS           Modified  1998 APR 27
'  -  finds all solutions to the  N  queens problem.
'============================================================================
'                       ' ------   Initialize variables and arrays   --------
DEFINT A-Z
CONST False = 0, True = NOT False
CLS
CALL Initialize(N, Done, Found, Col, Row)
DIM Grid(1 TO N, 1 TO N) AS INTEGER
DIM Choice(1 TO N) AS INTEGER, Solution(1 TO 100, 1 TO N) AS INTEGER
LET Filename$ = "queen" + LTRIM$(RTRIM$(STR$(N))) + ".dat"
OPEN Filename$ FOR OUTPUT AS 1
'-------------------------------   Core of program   ------------------------

DO UNTIL Done
    CALL Guts(N, Done, Found, Col, Row, Grid(), Choice(), Solution())
LOOP

'-------------------------------   Print summary   --------------------------
LOCATE 20, 1
PRINT SPACE$(40)
LOCATE 22, 20
PRINT "Number of solutions found ="; Found
PRINT #1, "Number of solutions found ="; Found
CLOSE

END

'============================================================================
'  SUB to backtrack to the previous column when the queen to be moved is on
'                               the last row.
'============================================================================
SUB Backtrack (Choice(), Grid(), Row, Col, N, Done)

IF Col = 1 OR (Col = 2 AND Choice(1) = N) THEN
                                ' <--  can't backtrack any further --
    Done = True                 '      program complete, set done = true.
ELSE
    CALL Cover(Row, Col, -1, Grid(), Choice(), N) '<-- uncover squares
                                '                      attacked by that queen.
    IF Row = N THEN             ' <--  if that queen is also on the last row,
                                ' <--  then erase the record of this queen                          
                                '      also and backtrack to the queen on the
                                '      previous column (it cannot be in row n)
        CALL Cover(Row, Col, -1, Grid(), Choice(), N)
    END IF

END IF

END SUB

'============================================================================
' -----   Alter values in squares on the same diagonals as and to the right
'                              of the current queen.
'============================================================================
SUB ChangeDiag (Row, Col, Inc, Grid(), N)

LET Up = Row
LET Dn = Row

FOR j = Col + 1 TO N
    LET Up = Up - 1                         ' <--  march up LL-UR diagonal
    LET Dn = Dn + 1                         '      and down UL-LR diagonal
   
    IF Up > 0 THEN                      ' <--  until off the top of the board
        LET Grid(Up, j) = Grid(Up, j) + Inc
    END IF
   
    IF Dn <= N THEN                     ' <--  or off the bottom.
        LET Grid(Dn, j) = Grid(Dn, j) + Inc
    END IF

NEXT j

END SUB

'============================================================================
' -----   Alter values in squares on the same row as and to the right of
'                               the current queen.
'============================================================================
SUB ChangeRow (Row, Col, Inc, Grid(), N)

FOR j = Col + 1 TO N
    LET Grid(Row, j) = Grid(Row, j) + Inc
NEXT j

END SUB

'============================================================================
' ----------------    Adds   Inc (= +1 or -1)  to each square    ------------
'                        covered by a queen at  (row,col) .
'============================================================================
SUB Cover (Row, Col, Inc, Grid(), Choice(), N)

IF Inc = 1 THEN                     ' <--  case of placing new queen.
    LET Choice(Col) = Row           '      note position of this queen.
ELSE                                ' <--  case of removing old queen.
    LET Choice(Col) = 0             '      erase this queen.
    LET Col = Col - 1               '      move back to the previous column.
    LET Row = Choice(Col)           '      retrieve position of queen to be
END IF                                                          '    moved.

CALL ChangeRow(Row, Col, Inc, Grid(), N)
CALL ChangeDiag(Row, Col, Inc, Grid(), N)

IF Inc = 1 THEN                     ' <--  if new queen has been placed, then
    LET Col = Col + 1               '      move on to top of next column.
    LET Row = 1
END IF

END SUB

'============================================================================
' Places a new queen at the current (row,col) on the grid() ;
'  checks to see if any previous queen covers that square;
'  if so move on (or backtrack if in last row),
'  if not then place queen and try next column (or record solution)
'============================================================================
SUB Guts (N, Done, Found, Col, Row, Grid(), Choice(), Solution())

LET Covered = Grid(Row, Col)  ' <--  0 if square is free, >0 if under attack.

IF Covered <= 0 THEN    ' ------------   Square is free   ------------------
    IF Col < N THEN     ' ------------   & not yet in last column   --------
        CALL Cover(Row, Col, 1, Grid(), Choice(), N)
        '                            ' ^ Note squares attacked by this queen
        '                                and move on to top of next column.
    ELSE       ' --------   In last column & solution has been found   -----
        LET Choice(N) = Row            ' <--  record position of final queen.
        CALL RecordSolution(Choice(), Solution(), Found, N)
        CALL Cover(Row, Col, -1, Grid(), Choice(), N)
        '                            ' ^ Erase record of its attack squares.
        IF Row = N THEN                 ' <--  if penultimate queen in last
                                        '         row then remove it too and
            CALL Cover(Row, Col, -1, Grid(), Choice(), N)' backtrack further.
        END IF

        LET Row = Row + 1             ' <--  move this queen to the next row.
    END IF
    '------------------------------------------------------------------------
ELSE                    '---   Queen is under attack, can't put it here.   --
    IF Row = N THEN                     ' <--  column exhausted, must
        CALL Backtrack(Choice(), Grid(), Row, Col, N, Done) '    backtrack.
    END IF

    LET Row = Row + 1                       ' <--  move on to next row.
    '------------------------------------------------------------------------
END IF
'                     ---   Temporary debugging tracer   ---
DO WHILE 0     ' To activate, make this command and the LOOP into comments.
   
    IF Found > 15 THEN
        LOCATE 6, 25
        PRINT "(row,col) = ("; Row; ","; Col; ")";
        LOCATE 8, 1
       
        FOR i = 1 TO N
            PRINT TAB(10);               ' <--  begin each row in column 10.
           
            FOR j = 1 TO N
                PRINT Grid(i, j);
            NEXT j
           
            PRINT TAB(40);
           
            FOR j = 1 TO N
               
                IF Choice(j) = i THEN
                    PRINT "Q ";
                ELSE
                    PRINT "- ";
                END IF
           
            NEXT j
           
            PRINT                      ' <--  blank PRINT at end of each row.
        NEXT i
       
        'IF row = n THEN
        INPUT Dummy$
    END IF

LOOP

END SUB

'============================================================================
' Ask user for size (N X N) of chessboard, then initialize variables.
'============================================================================
SUB Initialize (N, Done, Found, Col, Row)

DO
    INPUT "N queens on an  N X N chessboard.   Value of  N "; N
LOOP UNTIL FIX(N) = N AND N > 0

LET Done = False               ' <--  loop exit flag set to logical false.
LET Found = 0                  ' <--  number of solutions found, initialized.
LET Col = 1                    ' \<--  begin at top left corner.
LET Row = 1                    ' /

END SUB

'============================================================================
' Print each solution to screen and to file as it is discovered.
'============================================================================
SUB RecordSolution (Temp(), Solution(), Found, N)

LET Found = Found + 1                       ' <--  update # solutions found.

FOR Col = 1 TO N                        ' <--  keep record of this solution.
    LET Solution(Found, Col) = Temp(Col)
NEXT Col

'---------------------------   Print this solution   ------------------------
LOCATE 5, 10
PRINT "Solution number "; Found; ":          "
PRINT #1, "Solution number "; Found; ":          "
PRINT #1,
LOCATE 8, 1

FOR Row = 1 TO N
    PRINT TAB(10);                    ' <--  begin each row in column 10.
    PRINT #1, TAB(10);
   
    FOR Col = 1 TO N
       
        IF Temp(Col) = Row THEN       ' <--  Q  for queen,  -  for space.
            PRINT "Q ";
            PRINT #1, "Q ";
        ELSE
            PRINT "- ";
            PRINT #1, "- ";
        END IF

    NEXT Col
   
    PRINT                             ' <--  blank PRINT at end of each row.
    PRINT #1,
NEXT Row

PRINT #1, : PRINT #1, : PRINT #1,
LOCATE 20, 1
PRINT "Press any key to continue: "

DO WHILE INKEY$ = ""
LOOP

END SUB