home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 08 / vier.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1989-05-16  |  7.5 KB  |  199 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                                VIER.PAS                                 *)
  3. (* "Vier gewinnt" (C) 1988 PASCAL & Jens Vygen                             *)
  4. PROGRAM vier;
  5. TYPE
  6.   t1 = ARRAY[1..4] OF BYTE;
  7.   t2 = RECORD
  8.          art, zahl : BYTE;
  9.          feldnr    : t1;
  10.        END;
  11.   t3 = RECORD
  12.          art, reiheanz, hoehe : BYTE;
  13.          reihenr              : ARRAY[1..13] OF BYTE;
  14.        END;
  15.   tReihe = ARRAY[1..69] OF t2;
  16.   tFeld  = ARRAY[11..76] OF t3;
  17. VAR
  18.   reihe : tReihe;
  19.   feld  : tFeld;
  20.   spieler, i, j, sieg, zug, tiefe, maxtiefe : BYTE;
  21.   wert  : REAL;
  22.   maxwert : ARRAY[0..6] OF REAL;
  23. (* ----------------------------------------------------------------------- *)
  24. PROCEDURE U1;                             (* Initialisierung der Variablen *)
  25. VAR i1, j1, k1 : BYTE;
  26. BEGIN
  27.   ClrScr;
  28.   WriteLn('V  I  E  R      G  E  W  I  N  N  T');
  29.   WriteLn('-----------------------------------');
  30.   WriteLn;
  31.   WriteLn('Stufe 1 - sehr schlecht');
  32.   WriteLn('Stufe 2 - maessig');
  33.   WriteLn('Stufe 3 - akzeptabel');
  34.   WriteLn('Stufe 4 - sehr gut');
  35.   WriteLn('Stufe 5 - hervorragend');
  36.   WriteLn('Stufe 6 - einsame Spitze');
  37.   WriteLn;   Write('Schwierigkeitsgrad(1-6)? ');   ReadLn(maxtiefe);
  38.   FOR i1 := 1 TO 69 DO WITH reihe[i1] DO BEGIN art := 0;  zahl := 0; END;
  39.   FOR j1 := 1 TO 4 DO BEGIN
  40.     FOR i1 := 1 TO 24 DO
  41.       reihe[i1].feldnr[j1] := ((i1-1) DIV 4)+1+10*(((i1-1) MOD 4)+j1);
  42.     FOR i1 := 25 TO 45 DO
  43.       reihe[i1].feldnr[j1] := ((i1-1) MOD 3)+j1+10*((i1-25) DIV 3+1);
  44.     FOR i1 := 46 TO 57 DO BEGIN
  45.       reihe[i1].feldnr[j1] := ((i1-46) DIV 4)+11*j1+10*(((i1-2) MOD 4));
  46.       reihe[i1+12].feldnr[j1] := ((i1-46) DIV 4)-9*j1+10*(8-((i1-2) MOD 4));
  47.     END;
  48.   END;
  49.   maxwert[0] := -1E11;  i := 0;  sieg := 0;
  50.   Write('Wer soll beginnen (1=Spieler, 2=Computer)? ');  ReadLn(spieler);
  51.   FOR i1 := 11 TO 76 DO BEGIN
  52.     WITH feld[i1] DO BEGIN
  53.       art := 0;  hoehe := i1 MOD 10;  reiheanz := 0;
  54.       FOR j1 := 1 TO 69 DO
  55.         FOR k1 := 1 TO 4 DO
  56.           IF reihe[j1].feldnr[k1] = i1 THEN BEGIN
  57.             reiheanz := Succ(reiheanz);  reihenr[reiheanz] := j1;
  58.           END;
  59.     END;
  60.   END;
  61. END;
  62. (* ----------------------------------------------------------------------- *)
  63. (* Prozedur zur Aktualisierung der Variablen "reihe2","feld2" und "sieg2"  *)
  64. (* nach einem tatsaechlichen oder angenommenen Zug "zug2" durch den Spie-  *)
  65. (* ler "spieler2".                                                         *)
  66. PROCEDURE U2 (VAR reihe2 : tReihe; VAR feld2 : tFeld;
  67.               VAR sieg2, zug2, spieler2 : BYTE);
  68. VAR i2, pos2 : BYTE;
  69. BEGIN
  70.   pos2 := 10*zug2+7-feld2[10*zug2+6].hoehe;  feld2[pos2].art := spieler2;
  71.   FOR i2 := pos2 TO 10*zug2+6 DO feld2[i2].hoehe := Pred(feld2[i2].hoehe);
  72.   FOR i2 := 1 TO feld2[pos2].reiheanz DO
  73.     WITH reihe2[feld2[pos2].reihenr[i2]] DO BEGIN
  74.       art := art OR spieler2;  zahl := Succ(zahl);
  75.       IF (zahl = 4) AND (art < 3) THEN sieg2 := art;
  76.     END;
  77. END;
  78. (* ----------------------------------------------------------------------- *)
  79. (* Funktion zur statischen Stellungsbewertung. Ohne weiter vorauszudenken, *)
  80. (* wird die an die Funktion uebergebene Stellung aus Sicht desjenigen Spie-*)
  81. (* lers,dessen Nummer uebergeben wurde,mit einer simplen Methode bewertet. *)
  82. FUNCTION U3 (VAR reihe3 : tReihe; VAR feld3 : tFeld;
  83.              VAR spieler3 : BYTE): REAL;
  84. VAR i3 : BYTE;  wert3 : REAL;
  85. BEGIN
  86.   wert3 := 0;
  87.   FOR i3 := 1 TO 69 DO
  88.     WITH reihe3[i3] DO
  89.       IF (art = 1) OR (art = 2) THEN
  90.         wert3 := wert3+zahl*(0.5-abs(spieler3-art));
  91.   U3 := wert3;
  92. END;
  93. (* ----------------------------------------------------------------------- *)
  94. (* Funktion zur dynamischen Stellungsbewertung. Diese rekursive Funktion   *)
  95. (* geht alle moeglichen Zuege durch und ruft sich selbst wieder auf. Ist   *)
  96. (* allerdings die maximale Suchtiefe "maxtiefe" erreicht, so wird die Funk-*)
  97. (* tion U3 (statische Stellungsbewertung) aufgerufen. Ausserdem speichert  *)
  98. (* die Funktion U4 den nach dem Minimax-Prinzip ermittelten zur Zeit bes-  *)
  99. (* ten Zug (Variable:zug) und ist somit Hauptbestandteil der Funktion U7   *)
  100. (* (Computerzug).                                                          *)
  101. (*$A-*)
  102. FUNCTION U4 (reihe4 : tReihe; feld4 : tFeld; spieler4 : BYTE) : REAL;
  103. VAR sieg4, gegenspieler4, i4 : BYTE;
  104.     wert4 : REAL;
  105.     reiheneu4 : tReihe;
  106.     feldneu4 : tFeld;
  107.     abbr : BOOLEAN;
  108. BEGIN
  109.   gegenspieler4 := 3-spieler4;  tiefe := Succ(tiefe);
  110.   maxwert[tiefe] := -1E10;      i4 := 4;               abbr := FALSE;
  111.   REPEAT
  112.     IF feld4[10*i4+6].hoehe>0 THEN BEGIN
  113.       reiheneu4 := reihe4;  feldneu4 := feld4;  sieg4 := 0;
  114.       U2(reiheneu4,feldneu4,sieg4,i4,spieler4);
  115.       IF sieg4 > 0 THEN  wert4 := (0.5-abs(sieg4-spieler4))*1E10
  116.       ELSE IF tiefe = maxtiefe THEN  wert4 := U3(reiheneu4,feldneu4,spieler4)
  117.       ELSE wert4 := -U4(reiheneu4,feldneu4,gegenspieler4);
  118.       IF wert4 >= -maxwert[tiefe-1] THEN
  119.         BEGIN  abbr := TRUE;  maxwert[tiefe] := wert4+1;  END
  120.       ELSE IF wert4 > maxwert[tiefe] THEN BEGIN
  121.         maxwert[tiefe] := wert4;
  122.         IF tiefe = 1 THEN zug := i4;
  123.       END;
  124.     END;
  125.     IF i4 > 3 THEN i4 := 7-i4 ELSE i4 := 8-i4;
  126.   UNTIL (i4 = 0) OR abbr;
  127.   U4 := maxwert[tiefe];  tiefe := Pred(tiefe);
  128. END;
  129. (*$A+*)
  130. (* ----------------------------------------------------------------------- *)
  131. (* Funktion zur Eingabe des Spielerzuges. Dieser ist dann auch das Ergeb-  *)
  132. (* nis der Funktion                                                        *)
  133. FUNCTION U5 : BYTE;
  134. VAR b5 : BOOLEAN;  zug5 : BYTE;
  135. BEGIN
  136.   b5 := FALSE;
  137.   REPEAT
  138.     WriteLn;
  139.     Write('In welche Spalte (1-7) setzen Sie Ihren Stein? ');  ReadLn(zug5);
  140.     IF (zug5 > 0) AND (zug5 < 8) AND (feld[10*zug5+6].hoehe > 0) THEN
  141.       b5 := TRUE;
  142.     IF NOT b5 THEN BEGIN
  143.       WriteLn;
  144.       WriteLn('   Dieser Zug ist nicht erlaubt.');
  145.     END;
  146.   UNTIL b5;
  147.   WriteLn;  U5 := zug5;
  148. END;
  149. (* ----------------------------------------------------------------------- *)
  150. (*        Prozedur zur Ausgabe der momentanen Stellung am Bildschirm       *)
  151. PROCEDURE U6;
  152. VAR i6, j6, k6 : BYTE;
  153. BEGIN
  154.   WriteLn;
  155.   FOR i6 := 6 DOWNTO 1 DO BEGIN
  156.     FOR k6 := 1 TO 2 DO BEGIN
  157.       FOR j6 := 1 TO 7 DO BEGIN
  158.         CASE feld[10*j6+i6].art OF
  159.           0: Write('----');
  160.           1: Write('OOOO');
  161.           2: Write('####');
  162.         END;
  163.         Write('  ');
  164.       END;
  165.       WriteLn;
  166.     END;
  167.     WriteLn;
  168.   END;
  169. END;
  170. (* ----------------------------------------------------------------------- *)
  171. (* Funktion zum Berechnen des besten Computerzuges. Dieser beste Zug (1-7) *)
  172. (* ist dann auch das Ergebnis der Funktion                                 *)
  173. FUNCTION U7 : BYTE;
  174. VAR wert7 : REAL;
  175. BEGIN
  176.   WriteLn;  Write('Ich denke...');  tiefe := 0;
  177.   CASE i OF
  178.     0..2  : zug := 4;                                  (* Fest eingegebene *)
  179.     3     : IF feld[31].hoehe=0 THEN zug:=5 ELSE zug:=3;   (* Anfangszuege *)
  180.     4..42 : wert7:=U4(reihe,feld,spieler);               (* sonstige Zuege *)
  181.   END;
  182.   WriteLn('  Ich setze einen Stein in Spalte ',zug,'.');  WriteLn;
  183.   U7 := zug;
  184. END;
  185. (* ----------------------------------------------------------------------- *)
  186. BEGIN
  187.   U1;  U6;
  188.   WHILE (i < 42) AND (sieg = 0) DO BEGIN
  189.     spieler := 3-spieler;
  190.     IF spieler = 1 THEN zug := U7 ELSE zug := U5;
  191.     U2(reihe,feld,sieg,zug,spieler);  U6;  i := Succ(i);
  192.   END;
  193.   CASE sieg OF
  194.     0 : WriteLn('Unentschieden.');
  195.     1 : WriteLn('Ich habe gewonnen.');
  196.     2 : WriteLn('Du hast gewonnen.');
  197.   END;
  198. END.
  199.