home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 06 / deckeln / deckeln.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-03  |  16.9 KB  |  692 lines
  1. (*************************************************
  2. *                                                *
  3. *                DECKELN.PAS                     *
  4. *              Turbo Pascal 4.0                  *
  5. *   (C) 1988 TOOLBOX Spezial VI - Spiele         *
  6. *            & Berthold Freier                   *
  7. **************************************************)
  8.  
  9.  
  10. PROGRAM deckeln;
  11.    (* Spiel zur Addition und Multiplikation *)
  12.    (* Copyright 1988 by Berthold Freier     *)
  13.  
  14. (* =========================================== *)
  15.  
  16. USES Crt,Graph,Drivers;
  17.  
  18. (* =========================================== *)
  19.  
  20. TYPE
  21.   feldtyp = RECORD
  22.     x : BYTE;
  23.     y : BYTE;
  24.     zahl : BYTE;
  25.     wert : BYTE;
  26.     haeufig : BYTE;
  27.   END;
  28.   zweipointer = ARRAY[1..2] OF Pointer;
  29.  
  30. (* =========================================== *)
  31.  
  32. CONST
  33.   feld : ARRAY [1..20] OF feldtyp =
  34.     ((x:1 ; y:1 ; zahl: 1 ; wert:0 ; haeufig:1),
  35.      (x:2 ; y:1 ; zahl: 2 ; wert:0 ; haeufig:3),
  36.      (x:3 ; y:1 ; zahl: 3 ; wert:0 ; haeufig:4),
  37.      (x:4 ; y:1 ; zahl: 4 ; wert:0 ; haeufig:6),
  38.      (x:1 ; y:2 ; zahl: 5 ; wert:0 ; haeufig:6),
  39.      (x:2 ; y:2 ; zahl: 6 ; wert:0 ; haeufig:9),
  40.      (x:3 ; y:2 ; zahl: 7 ; wert:0 ; haeufig:6),
  41.      (x:4 ; y:2 ; zahl: 8 ; wert:0 ; haeufig:7),
  42.      (x:1 ; y:3 ; zahl: 9 ; wert:0 ; haeufig:5),
  43.      (x:2 ; y:3 ; zahl:10 ; wert:0 ; haeufig:5),
  44.      (x:3 ; y:3 ; zahl:11 ; wert:0 ; haeufig:2),
  45.      (x:4 ; y:3 ; zahl:12 ; wert:0 ; haeufig:5),
  46.      (x:1 ; y:4 ; zahl:15 ; wert:0 ; haeufig:2),
  47.      (x:2 ; y:4 ; zahl:16 ; wert:0 ; haeufig:1),
  48.      (x:3 ; y:4 ; zahl:18 ; wert:0 ; haeufig:2),
  49.      (x:4 ; y:4 ; zahl:20 ; wert:0 ; haeufig:2),
  50.      (x:1 ; y:5 ; zahl:24 ; wert:0 ; haeufig:2),
  51.      (x:2 ; y:5 ; zahl:25 ; wert:0 ; haeufig:1),
  52.      (x:3 ; y:5 ; zahl:30 ; wert:0 ; haeufig:2),
  53.      (x:4 ; y:5 ; zahl:36 ; wert:0 ; haeufig:1));
  54.  
  55. (* =========================================== *)
  56.  
  57. VAR
  58.   name : ARRAY [1..2] OF STRING[8];
  59.   punkte : ARRAY [1..2] OF INTEGER;
  60.   augenzahl : ARRAY [1..2] OF BYTE;
  61.   deckel : zweipointer;
  62.   ch: CHAR;
  63.   zahlwert : STRING[2];
  64.   rundenzahl,
  65.   gespielt,
  66.   weggenommen,
  67.   spielerzahl,
  68.   spielstaerke,
  69.   spieler,
  70.   summe,
  71.   produkt,
  72.   wurfzahl,
  73.   wurfaugen : BYTE;
  74.   i,
  75.   kontrolle,
  76.   wuerfelx : INTEGER;
  77.   beenden : BOOLEAN;
  78.  
  79. (* =========================================== *)
  80.  
  81. PROCEDURE erklaerung;
  82.  
  83. BEGIN
  84.   ClrScr;
  85.   TextColor(11);
  86.   GotoXY(30,1);
  87.   Write('D E C K E L N');
  88.   GotoXY(30,3);
  89.   Write('Spielerklärung');
  90.   TextColor(7);
  91.   GotoXY(1,5);
  92.   Write('Dieses Spiel können 2 Personen gegen');
  93.   Write('einander oder 1 Person gegen den PC');
  94.   Write(' spielen.');
  95.   GotoXY(1,7);
  96.   Write('Ein Feld mit 20 Abteilungen enthält ');
  97.   Write('jeweils eine Zahl und einen Wert.');
  98.   GotoXY(1,9);
  99.   Write('Es wird mit zwei Würfeln geworfen, ');
  100.   Write('anschließend wählt der Spieler, ob er');
  101.   GotoXY(1,10);
  102.   Write('lieber die Summe oder das Produkt der');
  103.   Write(' erzielten Augen "deckeln" will.');
  104.   GotoXY(1,12);
  105.   Write('"Deckeln" heißt, daß der angegebene ');
  106.   Write('Wert dem Spieler gutgeschrieben wird');
  107.   Write(' und ');
  108.   GotoXY(1,13);
  109.   Write('zugleich ein Deckel über das gewählte');
  110.   Write(' Feld gestülpt wird, damit ist es ');
  111.   Write('nicht');
  112.   GotoXY(1,14);
  113.   Write('mehr wählbar.');
  114.   GotoXY(1,16);
  115.   Write('Gewonnen hat, wer am Ende der Runde');
  116.   Write(' die meisten Punkte erreicht hat.');
  117.   Delay(2000);
  118.   TextColor(3);
  119.   GotoXY(3,18);
  120.   Write('Und jetzt bitte einige Vorgaben zum');
  121.   Write(' Spiel:');
  122. END;
  123.  
  124. (* =========================================== *)
  125.  
  126. PROCEDURE spielereingaben;
  127.  
  128. VAR  eingabe : STRING;
  129.  
  130. BEGIN
  131.   GotoXY(3,20);                 (* Spielerzahl *)
  132.   Write('Wieviele Spieler wollen teilnehmen ');
  133.   Write('( 1 oder 2 ) ?');
  134.   REPEAT
  135.     ch:=ReadKey;
  136.   UNTIL ((ch='1') OR (ch='2'));
  137.   Val(ch,spielerzahl,kontrolle);
  138.   Write (' ',spielerzahl);
  139.   GotoXY(1,22);
  140.   Write('Bitte den Namen des ersten Spielers ');
  141.   Write('eingeben (bis 8 Buchstaben) : ');
  142.   Readln(eingabe);
  143.   name[1]:=Copy(eingabe,1,8);
  144.  
  145. (* ------------------------------------------- *)
  146.  
  147.   IF spielerzahl=2 THEN       (* Namenseingabe *)
  148.     BEGIN
  149.     GotoXY(1,23);
  150.     Write('Bitte den Namen des zweiten Spieler');
  151.     Write('s eingeben (bis 8 Buchstaben) : ');
  152.     Readln(eingabe);
  153.     name[2]:=Copy(eingabe,1,8);
  154.     END
  155.   ELSE
  156.     name[2]:='Computer';
  157.  
  158. (* ------------------------------------------- *)
  159.  
  160.   IF spielerzahl=1 THEN      (* Spielstärke PC *)
  161.     BEGIN
  162.     GotoXY(1,23);
  163.     Write('Wie soll der Computer spielen ?');
  164.     Write('     1 = schwach         2 = stark');
  165.     REPEAT
  166.       ch:=ReadKey;
  167.     UNTIL ((ch='1') OR (ch='2'));
  168.     Val(ch,spielstaerke,kontrolle);
  169.     Write (' ',spielstaerke);
  170.     END;
  171.   GotoXY(1,25);
  172.   Write('Nach wieviel Runden wird abgebrochen ');
  173.   Write('( 10 - 50 ) ? Mit ENTER abschließen !');
  174.   REPEAT
  175.     GotoXY(75,25);
  176.     Readln(eingabe);
  177.     Val(eingabe,rundenzahl,kontrolle);
  178.   UNTIL ((rundenzahl>9) AND (rundenzahl<51));
  179. END;
  180.  
  181. (* =========================================== *)
  182.  
  183. PROCEDURE initialisierung    (*Graphiktreiber *);
  184.  
  185. VAR
  186.   GraphDriver,GraphMode : INTEGER;
  187.  
  188. (* ------------------------------------------- *)
  189.  
  190. PROCEDURE Abort(Msg : STRING);
  191.   BEGIN
  192.   Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
  193.   Halt(1);
  194. END;
  195.  
  196. (* ------------------------------------------- *)
  197.  
  198. BEGIN
  199.   IF RegisterBGIdriver(@CGADriverProc) < 0 THEN
  200.     Abort('CGA');
  201.   GraphDriver:=CGA;
  202.   GraphMode:=CGAC1;
  203.   InitGraph(GraphDriver,GraphMode,'');
  204.   IF GraphResult <> 0 THEN
  205.     BEGIN
  206.     Write ('Fehler bei Initialisierung der ');
  207.     Write ('Graphik :',GraphDriver);
  208.     Writeln ('Bitte RETURN drücken ');
  209.     Readln;halt;
  210.     END;
  211. END;
  212.  
  213. (* =========================================== *)
  214.  
  215. PROCEDURE deckeleinlesen;
  216.  
  217. VAR groesse : INTEGER;
  218.  
  219. BEGIN
  220.   ClearViewPort;
  221.   FOR i:=1 TO 2 DO
  222.   BEGIN
  223.     SetColor(i);
  224.     SetFillStyle(CloseDotFill,i);
  225.     Ellipse(i*30,40,0,360,14,19);
  226.     FloodFill(i*30,40,i);
  227.     groesse:=ImageSize(i*30-14,21,i*30+14,59);
  228.     GetMem(deckel[i],groesse);
  229.     GetImage(i*30-14,21,i*30+14,59,deckel[i]^);
  230.   END;
  231. END;
  232.  
  233. (* =========================================== *)
  234.  
  235. PROCEDURE wertbelegung;
  236.  
  237. BEGIN
  238.   FOR i:=1 TO 20 DO
  239.     feld[i].wert:=random(5)+1;
  240. END;
  241.  
  242. (* =========================================== *)
  243.  
  244. PROCEDURE spielfeld;
  245.  
  246. BEGIN
  247.   SetTextJustify(CenterText,CenterText);
  248.   FOR i:=1 TO 20 DO
  249.   BEGIN
  250.  
  251. (* ------------------------------------------- *)
  252.  
  253.     SetColor(1);                  (* Wertmarke *)
  254.     Str(feld[i].wert,zahlwert);
  255.     OutTextXY(feld[i].x*30-15,feld[i].y*40-12,
  256.       zahlwert);
  257.     Circle(feld[i].x*30-15,feld[i].y*40-13,8);
  258.  
  259. (* ------------------------------------------- *)
  260.  
  261.     SetColor(2);                       (* Zahl *)
  262.     Str(feld[i].zahl,zahlwert);
  263.     OutTextXY(feld[i].x*30-15,feld[i].y*40-27,
  264.       zahlwert);
  265.  
  266. (* ------------------------------------------- *)
  267.  
  268.     SetColor(3);                     (* Rahmen *)
  269.     Ellipse(feld[i].x*30-15,feld[i].y*40-21,0,
  270.       360,14,19);
  271.   END;
  272.  
  273. (* ------------------------------------------- *)
  274.  
  275.   SetColor(1);                 (* Würfelrahmen *)
  276.   SetTextJustify(LeftText,BottomText);
  277.   OutTextXY(152,48,'╔═════╗     ╔═════╗');
  278.   FOR i:=7 TO 10 DO
  279.     OutTextXY(152,i*8,'║     ║     ║     ║');
  280.   OutTextXY(152,88,'╚═════╝     ╚═════╝');
  281.  
  282. (* ------------------------------------------- *)
  283.  
  284.   SetColor(3);                 (* Titelausgabe *)
  285.   OutTextXY(180,8,'D E C K E L N');
  286.  
  287. (* ------------------------------------------- *)
  288.  
  289.   SetColor(1);                 (* Namenausgabe *)
  290.   OutTextXY(156,22,name[1]);
  291.   OutTextXY(156,32,'0 Punkte');     (* Punkte *)
  292.   SetColor(2);
  293.   OutTextXY(252,22,name[2]);
  294.   OutTextXY(252,32,'0 Punkte');
  295. END;
  296.  
  297. (* =========================================== *)
  298.  
  299. PROCEDURE punktausgabe;
  300.  
  301. BEGIN
  302.   SetViewPort(148,24,165,32,ClipOn);
  303.   ClearViewPort;
  304.   SetViewPort(244,24,261,32,ClipOn);
  305.   ClearViewPort;
  306.   SetViewPort(0,0,319,199,ClipOn);
  307.   SetColor(1);
  308.   Str(punkte[1]:2,zahlwert);
  309.   OutTextXY(148,32,zahlwert);
  310.   SetColor(2);
  311.   Str(punkte[2]:2,zahlwert);
  312.   OutTextXY(244,32,zahlwert);
  313. END;
  314.  
  315. (* =========================================== *)
  316.  
  317. PROCEDURE wuerfelloeschen;
  318.  
  319. BEGIN
  320.   SetViewPort(wuerfelx,48,wuerfelx+40,80,ClipOn);
  321.   ClearViewPort;
  322.   SetViewPort(0,0,319,199,ClipOn);
  323. END;
  324.  
  325. (* =========================================== *)
  326.  
  327. PROCEDURE wuerfelaugen;
  328.  
  329. BEGIN
  330.  
  331.   CASE wurfzahl OF          (* Wievielter Wurf *)
  332.    1 : wuerfelx:=161;
  333.    2 : wuerfelx:=257;
  334.   END;
  335.   wuerfelloeschen;
  336.   SetColor(2);
  337.  
  338. (* ------------------------------------------- *)
  339.  
  340.   CASE wurfaugen OF    (* Augenzahl darstellen *)
  341.    1 : OutTextXY(wuerfelx,68,'  O  ');
  342.    2 : BEGIN
  343.          OutTextXY(wuerfelx,56,'O    ');
  344.          OutTextXY(wuerfelx,80,'    O');
  345.        END;
  346.    3 : BEGIN
  347.          OutTextXY(wuerfelx,56,'O    ');
  348.          OutTextXY(wuerfelx,68,'  O  ');
  349.          OutTextXY(wuerfelx,80,'    O');
  350.        END;
  351.    4 : BEGIN
  352.          OutTextXY(wuerfelx,56,'O   O');
  353.          OutTextXY(wuerfelx,80,'O   O');
  354.        END;
  355.    5 : BEGIN
  356.          OutTextXY(wuerfelx,56,'O   O');
  357.          OutTextXY(wuerfelx,68,'  O  ');
  358.          OutTextXY(wuerfelx,80,'O   O');
  359.        END;
  360.    6 : BEGIN
  361.          OutTextXY(wuerfelx,56,'O   O');
  362.          OutTextXY(wuerfelx,68,'O   O');
  363.          OutTextXY(wuerfelx,80,'O   O');
  364.        END;
  365.   END;
  366. END;
  367.  
  368. (* =========================================== *)
  369.  
  370. PROCEDURE wuerfeln;
  371. VAR text : STRING;
  372. BEGIN
  373.   SetColor(spieler);         (* Aufruf Spieler *)
  374.   text:=ConCat(name[spieler],' ist dran!');
  375.   OutTextXY(156,104,text);
  376.   OutTextXY(140,118,'Würfeln mit Leertaste!');
  377.   REPEAT
  378.     ch:=ReadKey;
  379.   UNTIL ch=' ';
  380.   sound(320);delay(50);nosound;delay(40);
  381.   sound(260);delay(50);nosound;delay(40);
  382.   sound(220);delay(50);nosound;
  383.   wurfzahl:=1;
  384.   wurfaugen:=Random(6)+1;;
  385.   augenzahl[1]:=wurfaugen;
  386.   wuerfelaugen;
  387.   wurfzahl:=2;
  388.   wurfaugen:=Random(6)+1;;
  389.   augenzahl[2]:=wurfaugen;
  390.   wuerfelaugen;
  391.   summe:=augenzahl[1]+augenzahl[2];
  392.   produkt:=augenzahl[1]*augenzahl[2];
  393. END;
  394.  
  395. (* =========================================== *)
  396.  
  397. PROCEDURE meldungloeschen;
  398. BEGIN
  399.   SetViewPort(140,93,319,199,ClipOn);
  400.   ClearViewPort;
  401.   SetViewPort(0,0,319,199,ClipOn);
  402. END;
  403.  
  404. (* =========================================== *)
  405.  
  406. PROCEDURE spielerzug;
  407. BEGIN
  408.   SetColor(2);             (* Auswahl anbieten *)
  409.   OutTextXY(180,140,'S');
  410.   OutTextXY(180,150,'P');
  411.   OutTextXY(180,160,'V');
  412.   SetColor(3);
  413.   OutTextXY(190,140,'umme');
  414.   OutTextXY(190,150,'rodukt');
  415.   OutTextXY(190,160,'erzichten');
  416.   OutTextXY(140,174,'S , P oder V drücken!');
  417.   REPEAT                      (* und auswählen *)
  418.     ch:=ReadKEY;
  419.     ch:=UpCase(ch);
  420.   UNTIL ch in ['S','P','V'];
  421.  
  422. (* ------------------------------------------- *)
  423.  
  424.   CASE ch OF                    (* Verzweigung *)
  425.    'S' : BEGIN
  426.       IF feld[summe].wert<>0 THEN
  427.         BEGIN
  428.         punkte[spieler]:=punkte[spieler]+
  429.           feld[summe].wert;
  430.         feld[summe].wert:=0;
  431.         PutImage(feld[summe].x*30-29,
  432.           feld[summe].y*40-40,deckel[spieler]^,
  433.           NormalPut);
  434.         INC(weggenommen,1);
  435.         END;
  436.       END;
  437.  
  438.    'P' : BEGIN
  439.     IF produkt>12 THEN
  440.       BEGIN
  441.       FOR i:=13 TO 20 DO
  442.         BEGIN
  443.          IF feld[i].zahl=produkt THEN produkt:=i;
  444.         END;
  445.       END;
  446.       IF feld[produkt].wert<>0 THEN
  447.         BEGIN
  448.         punkte[spieler]:=punkte[spieler]+
  449.           feld[produkt].wert;
  450.         feld[produkt].wert:=0;
  451.         PutImage(feld[produkt].x*30-29,
  452.           feld[produkt].y*40-40,deckel[spieler]^,
  453.           NormalPut);
  454.         INC(weggenommen,1);
  455.         END;
  456.       END;
  457.  
  458.    'V' : BEGIN
  459.        OutTextXY(180,190,'Schade !');
  460.        Delay(2000);
  461.       END;
  462.   END;                           (* CASE-Block *)
  463.   punktausgabe;
  464. END;
  465.  
  466. (* =========================================== *)
  467.  
  468. PROCEDURE weitermitleer;
  469. BEGIN
  470.   SetColor(3);
  471.   OutTextXY(140,190,'Weiter mit Leertaste!');
  472.   REPEAT
  473.     ch:=ReadKey;
  474.   UNTIL ch=' ';
  475. END;
  476.  
  477. (* =========================================== *)
  478.  
  479. PROCEDURE computerzug;
  480.  
  481. BEGIN
  482.   IF produkt>12 THEN      (* Ergebnis anpassen *)
  483.     BEGIN
  484.     FOR i:=13 TO 20 DO
  485.       BEGIN
  486.         IF feld[i].zahl=produkt THEN produkt:=i;
  487.       END;
  488.     END;
  489.  
  490. (* ------------------------------------------- *)
  491.  
  492.   IF ((feld[summe].wert=0) AND  (* Nichts geht *)
  493.     (feld[produkt].wert=0)) THEN
  494.   BEGIN
  495.     OutTextXY(140,170,'Ich muß verzichten');
  496.     weitermitleer;
  497.     punktausgabe;
  498.     Exit;
  499.   END;
  500.  
  501. (* ------------------------------------------- *)
  502.  
  503.   IF feld[summe].wert>feld[produkt].wert THEN
  504.   BEGIN
  505.     OutTextXY(140,170,'Ich nehme die Summe.');
  506.     weitermitleer;
  507.     punkte[2]:=punkte[2]+feld[summe].wert;
  508.     feld[summe].wert:=0;
  509.     PutImage(feld[summe].x*30-29,
  510.       feld[summe].y*40-40,deckel[2]^,NormalPut);
  511.     INC(weggenommen,1);
  512.     punktausgabe;
  513.     Exit;
  514.   END;
  515.  
  516. (* ------------------------------------------- *)
  517.  
  518.   IF feld[produkt].wert>feld[summe].wert THEN
  519.   BEGIN
  520.     OutTextXY(140,170,'Ich nehme das Produkt.');
  521.     weitermitleer;
  522.     punkte[2]:=punkte[2]+feld[produkt].wert;
  523.     feld[produkt].wert:=0;
  524.     PutImage(feld[produkt].x*30-29,
  525.      feld[produkt].y*40-40,deckel[2]^,NormalPut);
  526.     INC(weggenommen,1);
  527.     punktausgabe;
  528.     Exit;
  529.   END;
  530.  
  531. (* ------------------------------------------- *)
  532.  
  533.   IF feld[produkt].wert=feld[summe].wert THEN
  534.   BEGIN
  535.     IF spielstaerke=2 THEN
  536.     BEGIN
  537.       IF feld[summe].haeufig<
  538.         feld[produkt].haeufig THEN
  539.         BEGIN
  540.           MoveTo(140,170);
  541.           OutText('Ich nehme die Summe.');
  542.           weitermitleer;
  543.           punkte[2]:=punkte[2]+feld[summe].wert;
  544.           feld[summe].wert:=0;
  545.           PutImage(feld[summe].x*30-29,
  546.             feld[summe].y*40-40,deckel[2]^,
  547.           NormalPut);
  548.           INC(weggenommen,1);
  549.         END
  550.  
  551.       ELSE
  552.         BEGIN
  553.           MoveTo(140,170);
  554.           OutText('Ich nehme das Produkt.');
  555.           weitermitleer;
  556.           punkte[2]:=punkte[2]+
  557.             feld[produkt].wert;
  558.           feld[produkt].wert:=0;
  559.           PutImage(feld[produkt].x*30-29,
  560.           feld[produkt].y*40-40,deckel[2]^,
  561.           NormalPut);
  562.           INC(weggenommen,1);
  563.        END;
  564.      END;
  565.     punktausgabe;
  566.   END;
  567. END;
  568.  
  569. (* =========================================== *)
  570.  
  571. PROCEDURE hauptsteuerung;
  572.  
  573. BEGIN
  574.   spieler:=2;              (* Voreinstellungen *)
  575.   gespielt:=0;
  576.   weggenommen:=0;
  577.   punkte[1]:=0;
  578.   punkte[2]:=0;
  579.  
  580. (* ------------------------------------------- *)
  581.  
  582.   REPEAT                         (* Steuerteil *)
  583.     spieler:=3-spieler;
  584.     sound(400);delay(40);nosound;
  585.     IF spieler=2 THEN INC(gespielt,1);
  586.     wuerfeln;
  587.     IF ((spielerzahl=1) AND (spieler=2)) THEN
  588.       computerzug
  589.     ELSE
  590.       spielerzug;
  591.     meldungloeschen;
  592.     wuerfelx:=161;
  593.     wuerfelloeschen;
  594.     wuerfelx:=257;
  595.     wuerfelloeschen;
  596.   UNTIL ((weggenommen=20) OR
  597.     (gespielt=rundenzahl));
  598. END;
  599.  
  600. (* =========================================== *)
  601.  
  602. PROCEDURE ergebnismeldung;
  603. BEGIN
  604.   TextMode(LastMode);
  605.   ClrScr;
  606.   TextBackGround(8);
  607.   TextColor(11);
  608.   GotoXY(30,1);
  609.   Write('D E C K E L N');
  610.   GotoXY(30,3);
  611.   Write('Endergebnis :');
  612.   TextColor(7);
  613.   GotoXY(25,8);
  614.   Write(name[1],' erreichte ',punkte[1]);
  615.   Write(' Punkte.');
  616.   GotoXY(25,10);
  617.   Write(name[2],' erreichte ',punkte[2]);
  618.   Write(' Punkte.');
  619.   TextColor(2);
  620.   GotoXY(25,14);
  621.  
  622. (* ------------------------------------------- *)
  623.  
  624.   IF punkte[1]=punkte[2] THEN    (* Auswertung *)
  625.     Write('Es gab ein Unentschieden !');
  626.   IF punkte[1]>punkte[2] THEN
  627.   BEGIN
  628.     Write(name[1],' hat gewonnen !');
  629.     GotoXY(25,20);
  630.     TextColor(7);
  631.     Write('Herzlichen Glückwunsch !');
  632.   END;
  633.   IF punkte[1]<punkte[2] THEN
  634.   BEGIN
  635.     Write(name[2],' hat gewonnen !');
  636.     GotoXY(25,20);
  637.     TextColor(7);
  638.     Write('Herzlichen Glückwunsch !');
  639.   END;
  640. END;
  641.  
  642. (* =========================================== *)
  643.  
  644. PROCEDURE wiederholungsfrage;
  645.  
  646. BEGIN
  647.   TextColor(2);
  648.   GotoXY(25,23);
  649.   Write('Noch ein Spiel ( J / N ) ?');
  650.   REPEAT
  651.     ch:=ReadKey;
  652.     ch:=UpCase(ch);
  653.   UNTIL ch in ['N','J'];
  654.   CASE ch OF
  655.   'N' : beenden:=TRUE;
  656.   'J' : beenden:=FALSE;
  657.   END;
  658.   SetGraphMode(CGAC1);
  659. END;
  660.  
  661. (* =========================================== *)
  662.  
  663. BEGIN                         (* Hauptprogramm *)
  664.   TextMode (C80);
  665.   Randomize;
  666.   beenden:=FALSE;
  667.   erklaerung;
  668.   spielereingaben;
  669.   initialisierung;
  670.   deckeleinlesen;
  671.  
  672. (* ------------------------------------------- *)
  673.  
  674.   REPEAT                      (* Hauptschleife *)
  675.     SetColor(1);
  676.     ClearViewPort;
  677.     wertbelegung;
  678.     spielfeld;
  679.     hauptsteuerung;
  680.     ergebnismeldung;
  681.     wiederholungsfrage;
  682.   UNTIL beenden=TRUE;
  683.  
  684. (* ------------------------------------------- *)
  685.  
  686.   CloseGraph;              (* Abschlußarbeiten *)
  687.   TextMode(LastMode);
  688.   ClrScr;
  689. END.                   (* Ende des Quelltextes *)
  690.  
  691. (* =========================================== *)
  692.