home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 11 / tictac.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-09-08  |  6.4 KB  |  193 lines
  1. (* ------------------------------------------------------------------ *)
  2. (*                            TICTAC.PAS                              *)
  3. PROGRAM TicTacToe_3D;
  4.  
  5. CONST bell = 7;
  6.  
  7. VAR spieler, computer,                  (* Spieler-, Computerwertung *)
  8.     start,                              (* wer faengt an ?           *)
  9.     ebene, spalte, reihe, feld,         (* bestimmen Feld im Brett   *)
  10.     zug: INTEGER;                       (* Zugzaehler                *)
  11.     f: ARRAY [0..63] OF INTEGER;        (* Brettdarstellung          *)
  12.     b: ARRAY [0..75] OF INTEGER;        (* Bewertungsfeld            *)
  13.     ch: CHAR;
  14. (* ------------------------------------------------------------------ *)
  15. PROCEDURE neues_Spiel;
  16. VAR i: INTEGER;
  17. BEGIN
  18.  ClrScr;      (* Bildschirm loeschen und Cursor in linke, obere Ecke *)
  19.  FOR i := 0 TO 63 DO f[i] := 0;
  20.  FOR i := 0 TO 75 DO b[i] := 0;
  21.  zug := 1;  start := -1;
  22.  FOR i := 1 TO 4 DO BEGIN
  23.   WriteLn('     -----------------------');
  24.   WriteLn('    / .     .     .     . /');
  25.   WriteLn('   / .     .     .     . /');
  26.   WriteLn('  / .     .     .     . /');
  27.   WriteLn(' / .     .     .     . /');
  28.   WriteLn('-----------------------');
  29.  END;
  30.  GotoXY(50,1);  Write(' 3D Tic Tac Toe ');
  31.  GotoXY(37,2);  Write('Ziel des Spieles ist, vier eigene Steine in');
  32.  GotoXY(37,3);  Write('eine horizontale, diagonale, vertikale oder');
  33.  GotoXY(37,4);  Write('raumdiagonale Reihe zu legen.');
  34.  GotoXY(37,5);  Write('Die Ebenen sind von unten nach oben, die');
  35.  GotoXY(37,6);  Write('Spalten von links nach rechts, die Reihen');
  36.  GotoXY(37,7);  Write('von vorne nach hinten durchnummeriert (1-4).');
  37.  GotoXY(47,15);  Write('Wer soll beginnen ?');
  38.  GotoXY(47,16);  Write('[M]ensch oder [C]omputer');
  39.  GotoXY(48,16);
  40.  REPEAT
  41.   Read(Kbd,ch);                      (* von Tastatur ohne Echo lesen *)
  42.   IF ch IN ['M','m'] THEN start := 0
  43.   ELSE IF ch IN ['C','c'] THEN start := 1;
  44.  UNTIL start <> -1;
  45.  GotoXY(47,15);  Write('                   ');
  46.  GotoXY(47,16);  Write('                        ');
  47. END;
  48. (* ------------------------------------------------------------------ *)
  49. PROCEDURE Pause (x: INTEGER);
  50. VAR i: INTEGER; j: REAL;
  51. BEGIN  j := 100.0;  FOR i := 0 TO x DO  j := j * j / j;  END;
  52.  
  53. PROCEDURE Setzen (stein: CHAR);
  54. VAR i: INTEGER;
  55. BEGIN
  56.  FOR i := 1 TO 10 DO
  57.  BEGIN
  58.   GotoXY(spalte*6+4+reihe,23-ebene*6-reihe); Write(' ');   Pause(70);
  59.   GotoXY(spalte*6+4+reihe,23-ebene*6-reihe); Write(stein); Pause(70);
  60.  END;
  61. END;
  62. (* ------------------------------------------------------------------ *)
  63. PROCEDURE SpielerZug;
  64.  
  65.   FUNCTION Eingabe: INTEGER;
  66.   VAR ch: CHAR;  i: INTEGER;
  67.   BEGIN
  68.    REPEAT
  69.     Write(Chr(bell));  Read(Kbd,ch);  i := Ord(ch)-Ord('1');
  70.    UNTIL i IN [0..3];
  71.    Eingabe := i;  Write(ch);
  72.   END;
  73.  
  74. BEGIN
  75.  REPEAT
  76.   GotoXY(43,15);  Write('Bitte geben Sie ihren Zug ein.');
  77.   GotoXY(52,18);  Write(' Ebene ? ');  ebene  := Eingabe;
  78.   GotoXY(52,19);  Write('Spalte ? ');  spalte := Eingabe;
  79.   GotoXY(52,20);  Write(' Reihe ? ');  reihe  := Eingabe;
  80.   feld := ebene * 16 + spalte + reihe * 4;
  81.  UNTIL f[feld] = 0;
  82.  f[feld] := 5;   Setzen('O');
  83.  GotoXY(52,18);  Write('          ');
  84.  GotoXY(52,19);  Write('          ');
  85.  GotoXY(52,20);  Write('          ');
  86. END;
  87. (* ------------------------------------------------------------------ *)
  88. PROCEDURE Bewertung;
  89. VAR i, c, m: INTEGER;
  90. BEGIN
  91.  FOR i := 0 TO 15 DO b[i] := f[i] + f[i+16] + f[i+32] + f[i+48];
  92.  m := 16;  c := 0;
  93.  FOR i := 0 TO 3 DO
  94.  BEGIN
  95.   b[m]   := f[c]    + f[c+1]  + f[c+2]  + f[c+3];
  96.   b[m+1] := f[c+4]  + f[c+5]  + f[c+6]  + f[c+7];
  97.   b[m+2] := f[c+8]  + f[c+9]  + f[c+10] + f[c+11];
  98.   b[m+3] := f[c+12] + f[c+13] + f[c+14] + f[c+15];
  99.   m := m+4;  c := c+16;
  100.  END;
  101.  c := 0;
  102.  FOR i := 0 TO 3 DO
  103.  BEGIN
  104.   b[m]   := f[c]   + f[c+4] + f[c+8]  + f[c+12];
  105.   b[m+1] := f[c+1] + f[c+5] + f[c+9]  + f[c+13];
  106.   b[m+2] := f[c+2] + f[c+6] + f[c+10] + f[c+14];
  107.   b[m+3] := f[c+3] + f[c+7] + f[c+11] + f[c+15];
  108.   m := m+4;  c := c+16;
  109.  END;
  110.  c := 0;
  111.  FOR i := 0 TO 3 DO
  112.  BEGIN
  113.   b[m]   := f[c]   + f[c+5] + f[c+10] + f[c+15];
  114.   b[m+1] := f[c+3] + f[c+6] + f[c+9]  + f[c+12];
  115.   m := m+2;  c := c+16;
  116.  END;
  117.  c := 0;
  118.  FOR i := 0 TO 3 DO
  119.  BEGIN
  120.   b[m]   := f[c]   + f[c+17] + f[c+34] + f[c+51];
  121.   b[m+1] := f[c+3] + f[c+18] + f[c+33] + f[c+48];
  122.   m := m+2;  c := c+4;
  123.  END;
  124.  FOR i := 0 TO 3 DO
  125.  BEGIN
  126.   b[m]   := f[i]    + f[i+20] + f[i+40] + f[i+60];
  127.   b[m+1] := f[i+12] + f[i+24] + f[i+36] + f[i+48];
  128.   m := m+2;
  129.  END;
  130.  b[m] := f[0]  + f[21] + f[42] + f[63];  m := m+1;
  131.  b[m] := f[3]  + f[22] + f[41] + f[60];  m := m+1;
  132.  b[m] := f[48] + f[37] + f[26] + f[15];  m := m+1;
  133.  b[m] := f[51] + f[38] + f[25] + f[12];
  134.  spieler := 0;  computer := 0;
  135.  FOR i := 0 TO 75 DO
  136.  BEGIN
  137.   IF b[i]=0 THEN BEGIN
  138.    spieler := spieler+1;  computer := computer+2;
  139.   END;
  140.   IF b[i]=1  THEN computer := computer+2;
  141.   IF b[i]=5  THEN spieler  := spieler+7;
  142.   IF b[i]=2  THEN computer := computer+7;
  143.   IF b[i]=10 THEN spieler  := spieler+22;
  144.   IF b[i]=3  THEN computer := computer+22;
  145.   IF b[i]=15 THEN spieler  := spieler+222;
  146.   IF b[i]=4  THEN computer := computer+10000;
  147.   IF b[i]=20 THEN spieler  := spieler+10000;
  148.  END;
  149. END;
  150. (* ------------------------------------------------------------------ *)
  151. PROCEDURE Computerzug;
  152. VAR i, best, bestzug: INTEGER;
  153. BEGIN
  154.  GotoXY(43,15);  Write('    Der Computer rechnet.     ');
  155.  best := -15000;
  156.  FOR i := 0 TO 63 DO BEGIN
  157.   IF f[i] = 0 THEN BEGIN
  158.    f[i] := 1;  Bewertung;
  159.    IF (computer-spieler) > best THEN BEGIN
  160.      best := computer-spieler; bestzug := i;
  161.    END;
  162.    f[i] := 0;
  163.   END;
  164.  END;
  165.  ebene := bestzug DIV 16;  spalte := bestzug MOD 4;
  166.  f[bestzug] := 1;          reihe := (bestzug-ebene*16) DIV 4;
  167.  Setzen('X');
  168. END;
  169. (* ------------------------------------------------------------------ *)
  170. FUNCTION Spielende: BOOLEAN;
  171. BEGIN
  172.  Bewertung;  Spielende := FALSE;
  173.  IF computer > 9999 THEN BEGIN
  174.   GotoXY(46,22); Write('Der Computer hat gewonnen.'); Spielende := TRUE;
  175.  END;
  176.  IF spieler > 9999 THEN BEGIN
  177.   GotoXY(48,22); Write('Sie haben gewonnen.'); Spielende := TRUE;
  178.  END;
  179. END;
  180. (* ------------------------------------------------------------------ *)
  181. BEGIN
  182.  REPEAT
  183.   neues_Spiel;
  184.   REPEAT
  185.    IF start = 1 THEN start := 0 ELSE SpielerZug;
  186.    IF NOT Spielende THEN Computerzug;
  187.    zug := zug+1;
  188.   UNTIL Spielende OR (zug > 32);
  189.   Pause(3000);  GotoXY(46,23);  Write(' Ein neues Spiel (J/N) ?  ');
  190.   Read(Kbd,ch);
  191.  UNTIL ch IN ['N','n'];
  192. END.
  193.