BSD 1 development

[unix-history] / puman / eightqueens2.p

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

  procedure print;
     var k, l: integer;
  begin
     writeln;
     writeln('*** Solution to the Eight Queens Problem ***');
     writeln;
     for l := 1 to 8 do begin
        write(tab, 9 - l : 1, '  ');
        for k := 1 to 8 do begin
           if x[l] = k then
               write('Q ')
           else if odd (k + l) then
               write('* ')
           else
               write('- ')
        end;
        writeln
     end;
     writeln;
     writeln(tab, '   q q q q k k k k');
     writeln(tab, '   r n b     b n r');
     writeln;
     goto 13
  end ;

procedure trycol(j : integer);
  var i : integer;

  procedure setqueen;
  begin a[i] := false; b[i+j] := false; c[i-j] := false;
  end ;

  procedure removequeen;
  begin a[i] := true; b[i+j] := true; c[i-j] := true;
  end ;

   begin
     repeat i := i+1; safe := a[i] and b[i+j] and c[i-j];
        if safe then
        begin setqueen; x[j] := i;
           if j < 8 then trycol(j+1) else print;
           removequeen
        end
     until i = 8
end;

begin
     for i := 1 to 8 do a[i] := true;
     for i := 2 to 16 do b[i] := true;
     for i := -7 to 7 do c[i] := true;
     trycol(1);
     writeln('No solutions!');
     halt;
13:
end.