1BSD/puman/eightout2

UNIX Pascal PXP -- Version 1.0 (September 6, 1977)

Tue Sep  6 10:40 1977  [eightqueens.p]

Profiled Tue Sep  6 15:24 1977

     1        1.---|program eightqueens(output);
     2             |label
     2             |    13;
     3             |var
     3             |    i: integer;
     4             |    a: array [1..8] of boolean;
     5             |    b: array [2..16] of boolean;
     6             |    c: array [-7..7] of boolean;
     7             |    x: array [1..8] of integer;
     8             |    safe: boolean;

    10            1.---|procedure print;
    11                 |var
    11                 |    k, l: integer;
    12                 |begin
    13                 |    writeln;
    14                 |    writeln('*** Solution to the Eight Queens Problem ***');
    15                 |    writeln;
    16                 |    for l := 1 to 8 do begin
    17                8.---|    write(tab, 9 - l: 1, '  ');
    18                     |    for k := 1 to 8 do begin
    19                   64.---|    if x[l] = k then 
    20                        8.---|    write('Q ')
    20                   56.---|    else if odd(k + l) then 
    22                       28.---|    write('* ')
    22                   28.---|    else 
    24                       28.---|    write('- ')
    24               64.---|    end;
    27                     |    writeln
    27                 |    end;
    28                 |    writeln;
    29                 |    writeln(tab, '   q q q q k k k k');
    30                 |    writeln(tab, '   r n b     b n r');
    31                 |    writeln;
    32                 |    goto 13
    32                 |end;

    35          113.---|procedure trycol(j: integer);
    36                 |var
    36                 |    i: integer;

    38              113.---|procedure setqueen;
    39                     |begin
    39                     |    a[i] := false;
    39                     |    b[i + j] := false;
    39                     |    c[i - j] := false
    39                     |end;

    42              105.---|procedure removequeen;
    43                     |begin
    43                     |    a[i] := true;
    43                     |    b[i + j] := true;
    43                     |    c[i - j] := true
    43                     |end;

    46          113.---|begin
    46                 |    repeat
    47              876.---|    i := i + 1;
    47                     |    safe := a[i] and b[i + j] and c[i - j];
    48                     |    if safe then begin
    49                  113.---|    setqueen;
    49                         |    x[j] := i;
    50                         |    if j < 8 then 
    50                      112.---|    trycol(j + 1)
    50                    1.---|    else 
    50                        1.---|    print;
    52                  113.---|    removequeen
    52                     |    end
    52                     |until i = 8
    52                 |end;

    56        1.---|begin
    57             |    for i := 1 to 8 do 
    57            8.---|    a[i] := true;
    58             |    for i := 2 to 16 do 
    58           15.---|    b[i] := true;
    59             |    for i := -7 to 7 do 
    59           15.---|    c[i] := true;
    60             |    trycol(1);
    61             |    writeln('No solutions!');
    62             |    halt;
    63  13:
    63        1.---|    null
    63             |end.