BSD 1 development

[unix-history] / 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.