home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 05 / damen1.pas next >
Encoding:
Pascal/Delphi Source File  |  1987-04-15  |  3.9 KB  |  116 lines
  1. {---------------------------------------------------------------------------}
  2. { Auf einem normalen 8*8 Schachbrett sieben weitere Damen positionieren,
  3.   nach dem die erste auf ein beliebiges Feld gesetzt wurde. Dabei darf
  4.   keine Dame von einer anderen bedroht werden!                              }
  5.  
  6. PROGRAM acht_Damen;
  7.  
  8. TYPE    index = 1..8;
  9.  
  10. VAR     x0, y0  : INTEGER;             { Anfangskoordinaten der ersten Dame }
  11.         geloest : BOOLEAN;                             { Loesung gefunden ? }
  12.         ch      : CHAR;
  13.         Pos     : PACKED ARRAY[index] OF INTEGER;      { Position der Damen }
  14.         zeile   : PACKED ARRAY[index] OF BOOLEAN;      { Zeile noch frei ?  }
  15.         r_diag  : PACKED ARRAY[2..16] OF BOOLEAN;      { /-Diagonale frei ? }
  16.         l_diag  : PACKED ARRAY[-7..7] OF BOOLEAN;      { \-Diagonale frei ? }
  17.  
  18. {---------------------------------------------------------------------------}
  19. {          alle Diagonalen und Zeilen als frei markieren:                   }
  20.  
  21. PROCEDURE initialisieren;
  22.  
  23. VAR  i : INTEGER;
  24.  
  25. BEGIN
  26.   FOR i := 1 TO 8 DO
  27.   BEGIN
  28.     Pos[i] := 0;
  29.     zeile[i] := TRUE;
  30.   END;
  31.   FOR i := 2 TO 16 DO r_diag[i] := TRUE;
  32.   FOR i := -7 TO 7 DO l_diag[i] := TRUE;
  33. END;
  34.  
  35. {---------------------------------------------------------------------------}
  36.  
  37. PROCEDURE loesung_ausgeben;
  38.  
  39. VAR  i : INTEGER;
  40.  
  41. BEGIN
  42.   FOR i := 1 TO 8 DO
  43.     WriteLn('Dame ', i, ' : ', Chr(Ord('a')-1+i),Pos[9-i]);
  44. END;
  45.  
  46. {---------------------------------------------------------------------------}
  47. {                       Problem loesen:                                     }
  48.  
  49. PROCEDURE suche_loesung (anz : index; VAR q : BOOLEAN);
  50.  
  51. VAR  versuch, spalte : INTEGER;
  52.      erfolgreich     : BOOLEAN;
  53.  
  54. BEGIN
  55.   FOR versuch := 1 TO 8 DO                            { freie Spalte suchen }
  56.     IF Pos[versuch] = 0 THEN spalte := versuch;
  57.   versuch := 0;
  58.   REPEAT
  59.     erfolgreich := FALSE;
  60.     versuch := Succ(versuch);
  61.     IF zeile[versuch] AND
  62.        (r_diag[spalte+versuch] AND l_diag[spalte-versuch]) THEN
  63.     BEGIN                   { Zeile, Spalte und Diagonalen noch unbesetzt ? }
  64.       Pos[spalte] := versuch;
  65.       zeile[versuch] := FALSE;                  { Zeile als belegt makieren }
  66.       r_diag[spalte+versuch] := FALSE;    { /-Diagonale als belegt makieren }
  67.       l_diag[spalte-versuch] := FALSE;    { \-Diagonale als belegt makieren }
  68.       IF anz < 8 THEN
  69.         BEGIN
  70.           suche_loesung(Succ(anz), erfolgreich);
  71.           IF NOT erfolgreich THEN
  72.           BEGIN
  73.             Pos[spalte] := 0;
  74.             zeile[versuch] := TRUE;                { Zeile wieder freigeben }
  75.             r_diag[spalte+versuch] := TRUE;  { /-Diagonale wieder freigeben }
  76.             l_diag[spalte-versuch] := TRUE;  { \-Diagonale wieder freigeben }
  77.           END;
  78.         END
  79.       ELSE
  80.         erfolgreich := TRUE;
  81.     END;
  82.   UNTIL erfolgreich OR (versuch = 8);
  83.   q := erfolgreich;
  84. END;
  85.  
  86. {---------------------------------------------------------------------------}
  87.  
  88. BEGIN { acht_Damen }
  89.   initialisieren;
  90.   WriteLn;  WriteLn;
  91.   Write('Position der ersten Dame :  ');
  92.   REPEAT
  93.     Read(Kbd, ch);               { ein Zeichen ohne Echo von Tastatur lesen }
  94.     IF (ch >= 'a') AND (ch <= 'h') THEN
  95.       ch := Chr(Ord(ch)-Ord('a')+Ord('A'));
  96.   UNTIL ch IN ['A'..'H'];
  97.   Write(ch);
  98.   x0 := Ord('A')+8-Ord(ch);
  99.   REPEAT
  100.     Read(Kbd, ch);
  101.   UNTIL ch IN ['1'..'8'];
  102.   WriteLn(ch);
  103.   y0 := Succ(Ord(ch)-Ord('1'));
  104.   Pos[x0] := y0;                                { Anfangsposition makieren  }
  105.   zeile[y0] := FALSE;                           { Zeile als belegt makieren }
  106.   r_diag[x0+y0] := FALSE;                 { /-Diagonale als belegt makieren }
  107.   l_diag[x0-y0] := FALSE;                 { \-Diagonale als belegt makieren }
  108.   suche_loesung(2, geloest);
  109.   WriteLn;  WriteLn;  WriteLn;
  110.   IF geloest THEN
  111.     loesung_ausgeben
  112.   ELSE
  113.     Write('Keine Loesung gefunden ! ');
  114.   REPEAT UNTIL KeyPressed;
  115. END.
  116.