1BSD/puman/eightqueens.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 [ 1..8 ] 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.