home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 05 / damen2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-04-15  |  3.3 KB  |  100 lines
  1. {---------------------------------------------------------------------------}
  2. {               findet alle Loesungen des Acht-Damen Problems               }
  3.  
  4. PROGRAM alle_acht_Damen;
  5.  
  6. TYPE    index = 1..8;
  7.  
  8. VAR     x0, y0  : INTEGER;             { Anfangskoordinaten der ersten Dame }
  9.         ch      : CHAR;
  10.         Pos     : PACKED ARRAY[index] OF INTEGER;      { Position der Damen }
  11.         zeile   : PACKED ARRAY[index] OF BOOLEAN;      { Zeile noch frei ?  }
  12.         r_diag  : PACKED ARRAY[2..16] OF BOOLEAN;      { /-Diagonale frei ? }
  13.         l_diag  : PACKED ARRAY[-7..7] OF BOOLEAN;      { \-Diagonale frei ? }
  14.  
  15. {---------------------------------------------------------------------------}
  16. {              alle Diagonalen und Zeilen als frei makieren:                }
  17.  
  18. PROCEDURE initialisieren;
  19.  
  20. VAR  i : INTEGER;
  21.  
  22. BEGIN
  23.   FOR i := 1 TO 8 DO
  24.   BEGIN
  25.     Pos[i] := 0;
  26.     zeile[i] := TRUE;
  27.   END;
  28.   FOR i := 2 TO 16 DO r_diag[i] := TRUE;
  29.   FOR i := -7 TO 7 DO l_diag[i] := TRUE;
  30. END;
  31.  
  32. {---------------------------------------------------------------------------}
  33.  
  34. PROCEDURE loesung_ausgeben;
  35.  
  36. VAR  i : INTEGER;
  37.  
  38. BEGIN
  39.   WriteLn;  WriteLn;
  40.   FOR i := 1 TO 8 DO
  41.     WriteLn('Dame ', i, ' :  ', Chr(Ord('a')-1+i), Pos[9-i]);
  42.   REPEAT UNTIL KeyPressed;
  43. END;
  44.  
  45. {---------------------------------------------------------------------------}
  46. {                          Problem loesen:                                  }
  47.  
  48. PROCEDURE suche_loesung (anz : index);
  49.  
  50. VAR  versuch, spalte : INTEGER;
  51.  
  52. BEGIN
  53.   FOR versuch := 1 TO 8 DO                            { freie Spalte suchen }
  54.     IF Pos[versuch] = 0 THEN spalte := versuch;
  55.   FOR versuch := 1 TO 8 DO
  56.   BEGIN
  57.     IF zeile[versuch] AND
  58.        (r_diag[spalte+versuch] AND l_diag[spalte-versuch]) THEN
  59.     BEGIN                   { Zeile, Spalte und Diagonalen noch unbesetzt ? }
  60.       Pos[spalte] := versuch;
  61.       zeile[versuch] := FALSE;                  { Zeile als belegt makieren }
  62.       r_diag[spalte+versuch] := FALSE;    { /-Diagonale als belegt makieren }
  63.       l_diag[spalte-versuch] := FALSE;    { \-Diagonale als belegt makieren }
  64.       IF anz < 8 THEN
  65.         suche_loesung(Succ(anz))
  66.       ELSE
  67.         loesung_ausgeben;
  68.       Pos[spalte] := 0;
  69.       zeile[versuch] := TRUE;                      { Zeile wieder freigeben }
  70.       r_diag[spalte+versuch] := TRUE;        { /-Diagonale wieder freigeben }
  71.       l_diag[spalte-versuch] := TRUE;        { \-Diagonale wieder freigeben }
  72.     END;
  73.   END;
  74. END;
  75.  
  76. {---------------------------------------------------------------------------}
  77.  
  78. BEGIN { alle_acht_Damen }
  79.   initialisieren;
  80.   WriteLn;  WriteLn;
  81.   Write('Position der ersten Dame :  ');
  82.   REPEAT
  83.     Read(Kbd, ch);
  84.     IF (ch >= 'a') AND (ch <= 'h') THEN
  85.       ch := Chr(Ord(ch)-Ord('a')+Ord('A'));
  86.   UNTIL ch IN ['A'..'H'];
  87.   Write(ch);
  88.   x0 := Ord('A')+8-Ord(ch);
  89.   REPEAT
  90.     Read(Kbd, ch);
  91.   UNTIL ch IN ['1'..'8'];
  92.   WriteLn(ch);
  93.   y0 := Succ(Ord(ch)-Ord('1'));
  94.   Pos[x0] := y0;                                 { Anfangsposition makieren }
  95.   zeile[y0] := FALSE;                          { Zeilen als belegt makieren }
  96.   r_diag[x0+y0] := FALSE;                 { /-Diagonale als belegt makieren }
  97.   l_diag[x0-y0] := FALSE;                 { \-Diagonale als belegt makieren }
  98.   suche_loesung(2);
  99. END.
  100.