home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / MODULA2 / QUEENS8.MOD < prev    next >
Text File  |  2000-06-30  |  1KB  |  61 lines
  1. (* Find all settings of 8 queens on an 8x8 chess board such
  2.    that no queen checks another queen.
  3.    [see also, Comm. ACM 14, 4, 221-27 (April 74)]. *)
  4.  
  5. MODULE queens;
  6.  
  7. FROM InOut IMPORT Write, WriteLn, WriteInt;
  8.  
  9. VAR i: INTEGER;
  10.     a: ARRAY [1..8] OF BOOLEAN;
  11.     b: ARRAY [2..16] OF BOOLEAN;
  12.     c: ARRAY [-7..7] OF BOOLEAN;
  13.     x: ARRAY [1..8] OF INTEGER;
  14.     safe: BOOLEAN;
  15.  
  16. PROCEDURE print;
  17. VAR k: INTEGER;
  18. BEGIN
  19.   Write(' ');
  20.   FOR k:= 1 TO 8 DO WriteInt(x[k],2) END;
  21.   WriteLn
  22. END print;
  23.  
  24. PROCEDURE trycol(j: INTEGER);
  25. VAR i: INTEGER;
  26.  
  27.   PROCEDURE setqueen;
  28.   BEGIN
  29.     a[i] := FALSE;
  30.     b[i+j] := FALSE;
  31.     c[i-j] := FALSE
  32.   END setqueen;
  33.  
  34.   PROCEDURE removequeen;
  35.   BEGIN
  36.     a[i] := TRUE;
  37.     b[i+j] := TRUE;
  38.     c[i-j] := TRUE
  39.   END removequeen;
  40.  
  41. BEGIN
  42.   i := 0;
  43.   REPEAT
  44.     INC(i);
  45.     safe := a[i] AND b[i+j] AND c[i-j];
  46.     IF safe THEN
  47.       setqueen;
  48.       x[j] := i;
  49.       IF j < 8 THEN trycol(j+1) ELSE print END;
  50.       removequeen
  51.     END
  52.   UNTIL i = 8
  53. END trycol;
  54.  
  55. BEGIN
  56.   FOR i := 1 TO 8 DO a[i] := TRUE END;
  57.   FOR i := 2 TO 16 DO b[i] := TRUE END;
  58.   FOR i := -7 TO 7 DO c[i] := TRUE END;
  59.   trycol(1)
  60. END queens.
  61.