home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / bonus / titatoe.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-01-04  |  12.3 KB  |  500 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    TITATOE.PAS                         *)
  3. (*            Selbstlernendes TicTacToe-Spiel             *)
  4. (*                 Turbo Pascal ab 5.0                    *)
  5. (*           (c) 1991 Simon Kröger & TOOLBOX              *)
  6. (* ------------------------------------------------------ *)
  7. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  8. {$M 1024, 100000, 655360}
  9.  
  10. USES Crt;
  11.  
  12. TYPE FeldArray = ARRAY[1..9] OF BYTE;
  13.      Zug_Rec   = RECORD
  14.        Feld    : FeldArray;
  15.        Zug     : BYTE;
  16.      END;
  17.      Disk_Rec  = RECORD
  18.        Feld    : LONGINT;
  19.        Zug     : BYTE;
  20.      END;
  21.      Zeiger       =^Speicher_Rec;
  22.      Speicher_Rec = RECORD
  23.        Feld       : LONGINT;
  24.        Zug        : BYTE;
  25.        Naechster  : Zeiger;
  26.      END;
  27.  
  28. VAR  d                     : CHAR;
  29.      Com_Gew,Spi_Gew,Unent,
  30.      SpielZuege,Gewonnen,
  31.      Gew_Alt,Zhl           : INTEGER;
  32.      Ende,Zufall           : BOOLEAN;
  33.      Zuege                 : ARRAY[1..10] OF Zug_Rec;
  34.      ZErster,ZLetzter      : Zeiger;
  35.      Letzte_Zuege          : ARRAY[1..9] OF BYTE;
  36.      Halde                 :^INTEGER;
  37.  
  38. FUNCTION FeldInt(F:FeldArray):LONGINT;
  39.   VAR Int,Zehner : LONGINT;
  40.       i          : INTEGER;
  41.   BEGIN
  42.     Zehner:=1;
  43.     Int:=0;
  44.     FOR i:=9 DOWNTO 1 DO BEGIN
  45.       Int:=Int+F[i]*Zehner;
  46.       Zehner:=Zehner*10;
  47.     END;
  48.     FeldInt:=Int;
  49.   END;
  50.  
  51. PROCEDURE Kasten(x,y,x1,y1:INTEGER;Doppel:BOOLEAN);
  52.       VAR i:INTEGER;
  53.  
  54.       PROCEDURE Print(c1,c2:BYTE);
  55.           BEGIN
  56.              IF Doppel THEN Write(Chr(c1))
  57.                        ELSE Write(Chr(c2));
  58.           END;
  59.  
  60.       BEGIN
  61.          GotoXY(x,y);
  62.          Print(201,218);
  63.          FOR i:=1 TO x1-x-1 DO Print(205,196);
  64.          Print(187,191);
  65.          FOR i:=1 TO y1-y-2 DO BEGIN
  66.             GotoXY(x,i+y);
  67.             Print(186,179);
  68.             GotoXY(x1,i+y);
  69.             Print(186,179);
  70.          END;
  71.          GotoXY(x,y1-1);
  72.          Print(200,192);
  73.          FOR i:=1 TO x1-x-1 DO Print (205,196);
  74.          Print(188,217);
  75.       END;
  76.  
  77. PROCEDURE PrintAt(x,y:INTEGER;s:STRING);
  78.   BEGIN
  79.     GotoXY(x,y);
  80.     Write(s);
  81.   END;
  82.  
  83. PROCEDURE Init;
  84.   VAR i:INTEGER;
  85.   BEGIN
  86.     Com_Gew:=0;
  87.     Spi_Gew:=0;
  88.     Unent:=0;
  89.     SpielZuege:=0;
  90.     FOR i:=1 TO 9 DO Zuege[1].Feld[i]:=0;
  91.     New(ZErster);
  92.     ZLetzter:=ZErster;
  93.     ZErster^.Naechster:=NIL;
  94.     FOR i:=1 TO 9 DO Letzte_Zuege[i]:=1;
  95.     Ende:=FALSE;
  96.     Zufall:=FALSE;
  97.     Gew_Alt:=0;
  98.     Randomize;
  99.   END;
  100.  
  101. PROCEDURE Hilfe;
  102.   BEGIN
  103.     Window(28,15,47,22);
  104.     ClrScr;
  105.     Write('       Hilfe        ');
  106.     Write('--------------------');
  107.     Write('  Benutzen Sie die  ');
  108.     Write(' Tasten "1" bis "9" ');
  109.     Write('   um Ihren Stein   ');
  110.     Write('   zu setzen und    ');
  111.     Write('bestätigen Sie dann ');
  112.     Write('     mit ENTER     ');
  113.     Window(1,1,80,25);
  114.   END;
  115.  
  116. PROCEDURE SpielFeld;
  117.   BEGIN
  118.     PrintAt(19,4 ,'╔════╤════╤════╗');
  119.     PrintAt(19,5 ,'║  1 │  2 │  3 ║');
  120.     PrintAt(19,6 ,'╟────┼────┼────╢');
  121.     PrintAt(19,7 ,'║  4 │  5 │  6 ║');
  122.     PrintAt(19,8 ,'╟────┼────┼────╢');
  123.     PrintAt(19,9 ,'║  7 │  8 │  9 ║');
  124.     PrintAt(19,10,'╚════╧════╧════╝');
  125.   END;
  126.  
  127. PROCEDURE SpielStand;
  128.   BEGIN
  129.     GotoXY(74,14);Write(Com_Gew:3);
  130.     GotoXY(74,15);Write(Spi_Gew:3);
  131.     GotoXY(74,16);Write(Unent:3);
  132.     PrintAt(74,19,'    ');
  133.     GotoXY(74,19);Write(SpielZuege:3);
  134.     GotoXY(65,21);Write(MemAvail:6);
  135.   END;
  136.  
  137. PROCEDURE BildAufbau;
  138.   BEGIN
  139.     ClrScr;
  140.     Kasten(1,1,80,25,TRUE);
  141.     Kasten(50,2,78,24,FALSE);
  142.     Kasten(52,3,76,10,FALSE);
  143.     PrintAt(54,4,'   Selbstlernendes');
  144.     PrintAt(54,5,'    Tick Tack Toe');
  145.     PrintAt(54,7,'   Ein Programm von');
  146.     PrintAt(54,8,'     Simon Kröger');
  147.     PrintAt(52,12,'Spielstand :');
  148.     PrintAt(52,13,'------------');
  149.     SpielStand;
  150.     Kasten(3,2,48,14,FALSE);
  151.     Kasten(3,14,25,24,FALSE);
  152.     Kasten(27,14,48,24,FALSE);
  153.     SpielFeld;
  154.     PrintAt(54,14,'Computer gewonnen : ');
  155.     PrintAt(54,15,'Spieler gewonnen  : ');
  156.     PrintAt(54,16,'Unentschieden     : ');
  157.     PrintAt(54,19,'Bekannte Spielzüge: ');
  158.     PrintAt(54,21,'Speicher :        Bytes');
  159.     PrintAt(4,15,' Menue :');
  160.     PrintAt(4,16,'---------------------');
  161.     PrintAt(4,17,' F1 : Laden');
  162.     PrintAt(4,18,' F2 : Speichern');
  163.     PrintAt(4,19,' F3 : Neues Spiel');
  164.     PrintAt(4,20,' F4 : Zufall');
  165.     PrintAt(4,22,'ESC : Ende');
  166.     Hilfe;
  167.   END;
  168.  
  169. PROCEDURE ResetSpiel;
  170.   VAR i : INTEGER;
  171.   BEGIN
  172.     Gewonnen:=0;
  173.     Zhl:=1;
  174.     SpielFeld;
  175.     Zufall:=FALSE;
  176.     FOR i:=1 TO 9 DO Letzte_Zuege[i]:=1;
  177.     FOR i:=1 TO 9 DO Zuege[1].Feld[i]:=0;
  178.     Hilfe;
  179.   END;
  180.  
  181. PROCEDURE Laden;
  182.   VAR Datei:FILE OF Disk_Rec;
  183.       Z    :Disk_Rec;
  184.       Z1   :Zeiger;
  185.   BEGIN
  186.     ResetSpiel;
  187.     Window(28,15,47,22);
  188.     ClrScr;
  189.     Write('       Laden        ');
  190.     Write('--------------------');
  191.     Write('Falls ein anderer   ');
  192.     Write('Wissensstand im     ');
  193.     Write('Speicher ist wird   ');
  194.     Write('er gelöscht.        ');
  195.     Write('Trotzdem laden ?    ');
  196.     Window(1,1,80,25);
  197.     GotoXY(45,21);
  198.     d:=ReadKey;
  199.     Write(d);
  200.     IF (UpCase(d)='J') THEN BEGIN
  201.       Release(Halde);
  202.       Assign(Datei,'T-T-T.DAT');
  203.       Reset(Datei);
  204.       New(ZErster);
  205.       ZLetzter:=ZErster;
  206.       SpielZuege:=0;
  207.       REPEAT
  208.         Inc(SpielZuege);
  209.         Read(Datei,Z);
  210.         New(Z1);
  211.         ZLetzter^.Naechster:=Z1;
  212.         ZLetzter:=Z1;
  213.         Z1^.Feld:=Z.Feld;
  214.         Z1^.Zug:=Z.Zug;
  215.       UNTIL EoF(Datei);
  216.       Z1^.Naechster:=NIL;
  217.       Close(Datei);
  218.       SpielStand;
  219.     END;
  220.     Hilfe;
  221.   END;
  222.  
  223. PROCEDURE Speichern;
  224.   VAR Datei:FILE OF Disk_Rec;
  225.       Z    :Disk_Rec;
  226.       Z1   :Zeiger;
  227.   BEGIN
  228.     ResetSpiel;
  229.     Window(28,15,47,22);
  230.     ClrScr;
  231.     Write('      Speichern     ');
  232.     Write('--------------------');
  233.     Write('Falls ein anderer   ');
  234.     Write('Wissensstand auf    ');
  235.     Write('Disk ist wird er    ');
  236.     Write('gelöscht.           ');
  237.     Write('Trotzdem Speichern ?');
  238.     Window(1,1,80,25);
  239.     GotoXY(28,22);
  240.     d:=ReadKey;
  241.     Write(d);
  242.     IF (UpCase(d)='J') THEN BEGIN
  243.       Assign(Datei,'T-T-T.DAT');
  244.       ReWrite(Datei);
  245.       Z1:=ZErster;
  246.       REPEAT
  247.         Z1:=Z1^.Naechster;
  248.         Z.Feld:=Z1^.Feld;
  249.         Z.Zug:=Z1^.Zug;
  250.         Write(Datei,Z);
  251.       UNTIL (Z1=NIL) OR (Z1=ZLetzter);
  252.       Close(Datei);
  253.     END;
  254.     Hilfe;
  255.   END;
  256.  
  257. PROCEDURE Neu;
  258.   BEGIN
  259.     ResetSpiel;
  260.     Window(28,15,47,22);
  261.     ClrScr;
  262.     Window(1,1,80,25);
  263.     PrintAt(28,15,'    Neues Spiel');
  264.     PrintAt(28,16,'--------------------');
  265.     PrintAt(28,17,'Soll der Spielstand ');
  266.     PrintAt(28,18,'gelöscht werden ? ');
  267.     d:=ReadKey;
  268.     Write(d);
  269.     IF (UpCase(d)='J') THEN BEGIN
  270.       Com_Gew:=0;
  271.       Spi_Gew:=0;
  272.       Unent:=0;
  273.       SpielStand;
  274.     END;
  275.     PrintAt(28,20,'Soll der Wissenstand');
  276.     PrintAt(28,21,'gelöscht werden ? ');
  277.     d:=ReadKey;
  278.     Write(d);
  279.     IF (UpCase(d)='J') THEN BEGIN
  280.       Release(Halde);
  281.       New(ZErster);
  282.       ZLetzter:=ZErster;
  283.       ZErster^.Naechster:=NIL;
  284.       SpielZuege:=0;
  285.       SpielStand;
  286.     END;
  287.     Hilfe;
  288.   END;
  289.  
  290. PROCEDURE Setze_Stein(Sp,Z:INTEGER);
  291.   BEGIN
  292.     GotoXY(21+((Z+5) MOD 3)*5,((Z-1) DIV 3)*2+5);
  293.     CASE Sp OF
  294.       1 : Write(#17,#16);
  295.       2 : Write('[]');
  296.       3 : Write('  ');
  297.     END;
  298.   END;
  299. PROCEDURE Lernen;
  300.   VAR Z1:Zeiger;
  301.   BEGIN
  302.     New(Z1);
  303.     ZLetzter^.Naechster:=Z1;
  304.     ZLetzter:=Z1;
  305.     Z1^.Naechster:=NIL;
  306.     Z1^.Feld:=FeldInt(Zuege[Zhl-2].Feld);
  307.     Z1^.Zug:=Zuege[Zhl-2].Zug;
  308.     Inc(SpielZuege);
  309.     SpielStand;
  310.   END;
  311.  
  312. PROCEDURE Zufall_Spielt;
  313.   BEGIN
  314.     Zufall := NOT Zufall;
  315.     IF Zufall THEN BEGIN
  316.       Window(28,15,47,22);
  317.       ClrScr;
  318.       Write('       Zufall       ');
  319.       Write('--------------------');
  320.       Write('  Jetzt spielt ein  ');
  321.       Write('  Zufallsgenerator  ');
  322.       Write(' gegen den Computer ');
  323.       Write('  mit F4 können sie ');
  324.       Write('   wieder selber    ');
  325.       Write('     spielen !     ');
  326.       Window(1,1,80,25);
  327.     END ELSE ResetSpiel;
  328.   END;
  329.  
  330. PROCEDURE Spiel_Ende;
  331.   BEGIN
  332.     Window(28,15,47,22);
  333.     ClrScr;
  334.     Write('        Ende        ');
  335.     Write('--------------------');
  336.     Write('Das Wissen wird     ');
  337.     Write('nicht automatisch   ');
  338.     Write('gespeichert. Trotz- ');
  339.     Write('dem beenden ? ');
  340.     d:=ReadKey;
  341.     Window(1,1,80,25);
  342.     IF (UpCase(d)='J') THEN Ende:=TRUE ELSE Hilfe;
  343.   END;
  344.  
  345. PROCEDURE Spieler_Zieht;
  346.   VAR Gesetzt : BOOLEAN;
  347.       Z,er    : INTEGER;
  348.   BEGIN
  349.     PrintAt(19,12,'  Ihr Zug :    ');
  350.     Gesetzt:=FALSE;
  351.     Z:=0;
  352.     REPEAT
  353.       IF (Zufall AND KeyPressed) OR (NOT Zufall) THEN BEGIN
  354.         GotoXY(31,12);
  355.         d:=ReadKey;
  356.         CASE d OF
  357.           #27      : Spiel_Ende;
  358.           #13      : IF Z<>0 THEN Gesetzt:=TRUE;
  359.           '1'..'9' : BEGIN
  360.                        Val(d,Z,er);
  361.                        Write(Z);
  362.                      END;
  363.         END;
  364.         IF d=#0 THEN BEGIN
  365.           d:=ReadKey;
  366.           CASE d OF
  367.             ';' : Laden;
  368.             '<' : Speichern;
  369.             '=' : Neu;
  370.             '>' : Zufall_Spielt;
  371.           END;
  372.         END;
  373.       END;
  374.       IF Zufall THEN BEGIN
  375.         Z:=Letzte_Zuege[Zhl];
  376.         IF (Gew_Alt<>1) OR (Zuege[Zhl].Feld[Z]<>0)
  377.         THEN BEGIN
  378.           REPEAT
  379.             Z:=Random(9)+1;
  380.           UNTIL Zuege[Zhl].Feld[Z]=0;
  381.           Letzte_Zuege[Zhl]:=Z;
  382.         END;
  383.         Zuege[Zhl].Zug:=Z;
  384.         Gesetzt:=TRUE;
  385.       END;
  386.       IF (NOT Zufall) AND (Z<>0) THEN BEGIN
  387.         IF Gesetzt AND (Zuege[Zhl].Feld[Z]=0)
  388.           THEN Zuege[Zhl].Zug:=Z
  389.           ELSE Gesetzt:=FALSE;
  390.       END;
  391.     UNTIL Gesetzt OR Ende;
  392.     IF Gesetzt THEN Setze_Stein(1,Z);
  393.   END;
  394.  
  395. FUNCTION Verboten(Fe:FeldArray;Zu:BYTE):BOOLEAN;
  396.   VAR Z1    : Zeiger;
  397.       v     : BOOLEAN;
  398.       Jetzt : LONGINT;
  399.   BEGIN
  400.     Z1:=ZErster;
  401.     v:=FALSE;
  402.     Jetzt:=FeldInt(Fe);
  403.     WHILE (Z1<>ZLetzter) AND (NOT v) DO BEGIN
  404.       Z1:=Z1^.Naechster;
  405.       IF (Z1^.Feld=Jetzt) AND (Zu=Z1^.Zug) THEN v:=TRUE;
  406.     END;
  407.     Verboten:=v;
  408.   END;
  409.  
  410. PROCEDURE Computer_Zieht;
  411.   VAR R : INTEGER;
  412.       Gezogen : BOOLEAN;
  413.   BEGIN
  414.     R:=0;
  415.     Gezogen:=FALSE;
  416.     REPEAT
  417.       Inc(R);
  418.       IF (Zuege[Zhl].Feld[R]=0) AND
  419.       (NOT Verboten(Zuege[Zhl].Feld,R)) THEN Gezogen:=TRUE;
  420.     UNTIL Gezogen OR (R=9);
  421.     IF NOT Gezogen THEN BEGIN
  422.       Lernen;
  423.       R:=0;
  424.       REPEAT
  425.         Inc(R);
  426.       UNTIL Zuege[Zhl].Feld[R]=0;
  427.     END;
  428.     Zuege[Zhl].Zug:=R;
  429.     Setze_Stein(2,R);
  430.   END;
  431.  
  432. PROCEDURE GewinnAbfrage;
  433.   CONST M   : ARRAY[1..8,1..3] OF BYTE =
  434.           ((1,2,3),(4,5,6),(7,8,9),(1,4,7),
  435.            (2,5,8),(3,6,9),(1,5,9),(3,5,7));
  436.   VAR i,F,j : INTEGER;
  437.   BEGIN
  438.     Gewonnen:=0;
  439.     Zuege[Zhl].Feld:=Zuege[Zhl-1].Feld;
  440.     Zuege[Zhl].Feld[Zuege[Zhl-1].Zug]:=(Zhl MOD 2)+1;
  441.     i:=0;
  442.     REPEAT
  443.       Inc(i);
  444.       F:=Zuege[Zhl].Feld[M[i,1]];
  445.       IF (F<>0) AND (Zuege[Zhl].Feld[M[i,2]]=F) AND
  446.         (Zuege[Zhl].Feld[M[i,3]]=F) THEN Gewonnen:=F;
  447.     UNTIL (i=8) OR (Gewonnen<>0);
  448.     IF (Gewonnen<>0) AND (NOT Zufall) THEN BEGIN
  449.       PrintAt(19,12,'   << ENTER >>');
  450.       REPEAT
  451.         FOR j:=1 TO 3 DO Setze_Stein(3,M[i,j]);
  452.         IF NOT KeyPressed THEN Delay(200);
  453.         FOR j:=1 TO 3 DO Setze_Stein(Gewonnen,M[i,j]);
  454.         IF NOT KeyPressed THEN Delay(200);
  455.       UNTIL KeyPressed;
  456.       d:=ReadKey;
  457.     END;
  458.   END;
  459.  
  460. BEGIN
  461.   Mark(Halde);
  462.   Init;
  463.   BildAufbau;
  464.   REPEAT
  465.     Gewonnen:=0;
  466.     Zhl:=1;
  467.     SpielFeld;
  468.     SpielStand;
  469.     REPEAT
  470.       IF NOT Ende THEN BEGIN
  471.         Spieler_Zieht;
  472.         Inc(Zhl);
  473.         GewinnAbfrage;
  474.       END;
  475.       IF (Zhl<10) AND (Gewonnen=0) AND (NOT Ende)
  476.       THEN BEGIN
  477.         Computer_Zieht;
  478.         Inc(Zhl);
  479.         GewinnAbfrage;
  480.       END;
  481.     UNTIL Ende OR (Gewonnen<>0) OR (Zhl>9);
  482.     Gew_Alt:=Gewonnen;
  483.     IF Gewonnen = 1 THEN BEGIN
  484.       Inc(Spi_Gew);
  485.       Lernen;
  486.     END;
  487.     IF Gewonnen=2 THEN Inc(Com_Gew);
  488.     IF (Gewonnen=0) AND (NOT Ende) THEN BEGIN
  489.       Inc(Unent);
  490.       IF NOT Zufall THEN BEGIN
  491.         PrintAt(19,12,'   << ENTER >>');
  492.         d:=ReadKey;
  493.       END;
  494.     END;
  495.   UNTIL Ende;
  496.   Release(Halde);
  497. END.
  498. (* ------------------------------------------------------ *)
  499. (*                Ende von TITATOE.PAS                    *)
  500.