home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 08_09 / stratego.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-09  |  10.2 KB  |  365 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   STRATEGO.PAS                         *)
  3. (*         Version für Turbo Pascal 3.0                   *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM  STRATEGO;
  6.  
  7. CONST          Max       = 36;
  8.                Stein_1   = #111;
  9.                Stein_2   = #223;
  10.                Runde     : INTEGER = 1;
  11.                Spieler   : INTEGER = 2;
  12.  
  13. TYPE            Brett = RECORD         (* 0 = leeres Feld *)
  14.                            Besitzer  : 0..2;
  15.                            Vorhanden : 0..4;
  16.                            Zulaessig : 0..4;
  17.                         END;
  18.  
  19. VAR              Feld          : ARRAY [1..Max] OF Brett;
  20.                  Zeile, Spalte : CHAR;
  21.                  ZE, SP        : INTEGER;
  22.                  Fertig        : BOOLEAN;
  23. (* ------------------------------------------------------ *)
  24. PROCEDURE Initialisierung;
  25. VAR   Pos : INTEGER;
  26. BEGIN
  27.   FILLCHAR (Feld, SIZEOF (Feld),#0);
  28.   FOR Pos := 1 TO Max DO
  29.      WITH Feld [Pos] DO
  30.        CASE Pos OF
  31.          1, 6, 31, 36   : Zulaessig := 2;
  32.          2..5, 7, 12,
  33.          13,18,19,24,
  34.          25,30,32..35   : Zulaessig := 3
  35.          ELSE             Zulaessig := 4;
  36.        END;
  37. END;
  38. (* ------------------------------------------------------ *)
  39. PROCEDURE INVERS;                    (* LOWVIDEO bei CP/M *)
  40.  BEGIN TextColor(0); TextBackGround(15) END;
  41. (* ------------------------------------------------------ *)
  42. PROCEDURE NORMAL;                   (* NORMVIDEO bei CP/M *)
  43.  BEGIN TextColor(15); TextBackGround(0) END;
  44. (* ------------------------------------------------------ *)
  45. PROCEDURE BELL;                   (* WRITE (^G) fuer CP/M *)
  46. BEGIN  Sound (800); Delay (50); NoSound;  END;
  47. (* ------------------------------------------------------ *)
  48. PROCEDURE Steine_Im_Feld (Pos : INTEGER);
  49. VAR      XFeld, YFeld : INTEGER;
  50.  
  51. PROCEDURE SetzeStein;
  52. BEGIN
  53.   CASE Spieler  OF
  54.     1 : WRITE (Stein_1);
  55.     2 : BEGIN INVERS;  WRITE (Stein_2);  NORMAL; END;
  56.   END;
  57. END;
  58.  
  59. PROCEDURE Leer;
  60. BEGIN
  61.   GOTOXY (XFeld, YFeld);       WRITE ('':3);
  62.   GOTOXY (XFeld,SUCC(YFeld));  WRITE ('':3);
  63. END;
  64.  
  65. PROCEDURE EinStein;
  66. BEGIN
  67.   GOTOXY (XFeld, YFeld);  SetzeStein;
  68. END;
  69.  
  70. PROCEDURE ZweiSteine;
  71. BEGIN
  72.   EinStein;
  73.   GOTOXY (XFeld+2, YFeld);  SetzeStein;
  74. END;
  75.  
  76. PROCEDURE DreiSteine;
  77. BEGIN
  78.   ZweiSteine;
  79.   GOTOXY (XFeld, SUCC(YFeld));  SetzeStein;
  80. END;
  81.  
  82. PROCEDURE VierSteine;
  83. BEGIN
  84.   DreiSteine;
  85.   GOTOXY (XFeld+2,SUCC(YFeld));  SetzeStein;
  86. END;
  87.  
  88. BEGIN                                  (* Steine_Im_Feld *)
  89.   XFeld := 5 + 6 * SP;
  90.   YFeld := 2 + 3 * ZE;
  91.   CASE Feld [Pos].Vorhanden OF
  92.     1 : EinStein;
  93.     2 : ZweiSteine;
  94.     3 : DreiSteine;
  95.     4 : VierSteine;
  96.     ELSE Leer;
  97.   END;
  98. END;
  99. (* ------------------------------------------------------ *)
  100. PROCEDURE Explosion  (Ort : INTEGER);
  101. VAR      FeldNummer  : INTEGER;
  102.  
  103. PROCEDURE Wo;
  104. BEGIN
  105.   ZE := (FeldNummer - 1) DIV 6 + 1;
  106.   SP := FeldNummer - 6 * (ZE - 1);
  107. END;
  108.  
  109. PROCEDURE Deckung;
  110. BEGIN
  111.   BELL;
  112.   WITH Feld[FeldNummer] DO BEGIN
  113.     Vorhanden := SUCC (Vorhanden);
  114.     Besitzer := Spieler;
  115.   END;
  116.   Wo;
  117.   Steine_Im_Feld (FeldNummer);
  118.   BELL;
  119. END;
  120.  
  121. BEGIN  (* Explosion *)
  122.   Feld [Ort].Vorhanden := 0;
  123.   FeldNummer := Ort;  Wo;
  124.   Steine_Im_Feld (FeldNummer);
  125.   IF Ort - 6 >   0 THEN  BEGIN
  126.     FeldNummer := Ort - 6; Deckung;  END;
  127.   IF Ort + 6 <= 36 THEN  BEGIN
  128.     FeldNummer := Ort + 6; Deckung;  END;
  129.   IF SP - 1  >   0 THEN  BEGIN
  130.     FeldNummer := Ort - 1; Deckung;  END;
  131.   IF SP + 1  <   6 THEN  BEGIN
  132.     FeldNummer := Ort + 1; Deckung;  END;
  133. END;
  134. (* ------------------------------------------------------ *)
  135. PROCEDURE Probe;
  136. VAR         Stelle     : 1..36;
  137.             Explodiert : BOOLEAN;
  138. BEGIN
  139.   REPEAT
  140.     Explodiert := FALSE;
  141.     FOR Stelle := 1 TO Max DO
  142.     IF Feld [Stelle].Vorhanden >= Feld [Stelle].Zulaessig
  143.     THEN BEGIN
  144.       Explosion (Stelle);
  145.       Explodiert := TRUE;
  146.     END;
  147.   UNTIL NOT Explodiert;
  148. END;
  149. (* ------------------------------------------------------ *)
  150. PROCEDURE SpielStand;
  151. VAR      FelderVonEins, FelderVonZwei, Kasten : INTEGER;
  152.  
  153. BEGIN
  154.   FelderVonEins := 0;   FelderVonZwei := 0;
  155.   Fertig := FALSE;
  156.   FOR Kasten := 1 TO Max DO BEGIN
  157.     IF Feld [Kasten].Besitzer = 1 THEN
  158.       FelderVonEins := SUCC(FelderVonEins);
  159.     IF Feld [Kasten].Besitzer = 2 THEN
  160.       FelderVonZwei := SUCC(FelderVonZwei);
  161.   END;
  162.   IF Runde > 1 THEN BEGIN
  163.     IF (FelderVonEins =0) OR (FelderVonZwei = 0)
  164.     THEN BEGIN
  165.       GOTOXY (25,23);  WRITE ('SIEGER : Spieler ');
  166.       WRITE (Spieler,' in Runde ',Runde);
  167.       REPEAT UNTIL KEYPRESSED;
  168.       Fertig := TRUE;
  169.     END;
  170.   END;
  171.   IF Spieler = 2 THEN Runde := SUCC(Runde);
  172.   GOTOXY (55,2);   WRITE ('Runde ',Runde);
  173.   GOTOXY (70,19);  WRITE (FelderVonEins:2,' Feld(er)');
  174.   GOTOXY (70,20);  WRITE (FelderVonZwei:2,' Feld(er)');
  175. END;
  176. (* ------------------------------------------------------ *)
  177. PROCEDURE SpielBeschreibung;
  178. CONST       Zeile : INTEGER = 5;
  179.  
  180. PROCEDURE TITEL;
  181. BEGIN
  182.   CLRSCR;
  183.   GOTOXY (36,1); INVERS; WRITE (' STRATEGO ');  NORMAL;
  184. END;
  185.  
  186. BEGIN
  187.   TITEL;
  188.   GOTOXY (2, Zeile);
  189.   WRITE ('Die Aufgabe bei diesem Spiel ist es, auf ',
  190.          'einem Brett mit 36 Feldern alle');
  191.   GOTOXY (2, Zeile+1);
  192.   WRITE ('Steine des Gegners zu zerstoeren.');
  193.   GOTOXY (26, Zeile+4);
  194.   TextBackground (0); TextColor (9);
  195.   WRITE ('Dabei gelten folgende REGELN :');
  196.   NORMAL;
  197.   GOTOXY (2, Zeile+6);
  198.   WRITE ('1 - Die Steine werden abwechselnd gesetzt.');
  199.   GOTOXY (2, Zeile+7);
  200.   WRITE ('2 - Jedes Feld hat abhaengig von seiner Lage ',
  201.          'eine bestimmte maximale Kapazitaet');
  202.   INVERS;
  203.   GOTOXY (24, Zeile+8); WRITE (' ':32);
  204.   GOTOXY (24, Zeile+9);
  205.   WRITE (' >>> Eckfelder   : 2 Steine <<< ');
  206.   GOTOXY (24, Zeile+10);
  207.   WRITE (' >>> Randfelder  : 3 Steine <<< ');
  208.   GOTOXY (24, Zeile+11);
  209.   WRITE (' >>> Innenfelder : 4 Steine <<< ');
  210.   GOTOXY (24, Zeile+12); WRITE (' ':32);
  211.   NORMAL;
  212.   GOTOXY (2, Zeile+13);
  213.   WRITE ('3 - Erreicht ein Feld seine maximale ',
  214.          'Kapazitaet, so werden die Steine explo-');
  215.   GOTOXY (6, Zeile+14);
  216.   WRITE ('sionsartig auf die Nachbarfelder geschleudert.');
  217.   GOTOXY (2, Zeile+15);
  218.   WRITE ('4 - Auf ein irgendwann vom Gegner besetztes ',
  219.          'Feld darf nicht gesetzt werden.');
  220.   GOTOXY (31,23); INVERS;
  221.   WRITE (' Weiter mit Tastendruck ');  NORMAL;
  222.   REPEAT UNTIL KEYPRESSED;
  223.   TITEL;
  224. END;
  225. (* ------------------------------------------------------ *)
  226. PROCEDURE  SpielBrett;
  227. (* Linien fuer den erweiterten IBM-Zeichensatz *)
  228. CONST     E1 = #218;  (* OBEN LINKS *)
  229.           E2 = #191;  (* OBEN  RECHTS *)
  230.           E3 = #192;  (* UNTEN LINKS *)
  231.           E4 = #217;  (* UNTEN RECHTS *)
  232.           VE = #179;  (* VERTIKALE LINIE *)
  233.           HO = #196;  (* HORIZONTALE LINIE *)
  234.           KR = #197;  (* KREUZUNG *)
  235.           ZL = #180;  (* ZEIGER NACH LINKS *)
  236.           ZR = #195;  (* ZEIGER NACH RECHTS *)
  237.           ZO = #193;  (* ZEIGER NACH OBEN *)
  238.           ZU = #194;  (* ZEIGER NACH UNTEN *)
  239.           Leer = #32#32#32#32#32;
  240.           XL : INTEGER =  8;
  241.           YL : INTEGER =  3;
  242. VAR      Schleife :  INTEGER;
  243.  
  244. PROCEDURE Spalte;
  245. BEGIN
  246.   GOTOXY (XL-2,YL); WRITE (Schleife);
  247. END;
  248.  
  249. PROCEDURE Zeile2;
  250. VAR Zaehler : INTEGER;
  251. BEGIN
  252.   YL := SUCC(YL);
  253.   GOTOXY (XL,YL);
  254.   FOR Zaehler := 1 TO 6 DO WRITE (VE,Leer);
  255.   WRITE (VE);
  256. END;
  257.  
  258. PROCEDURE Zeile3;
  259. VAR Zaehler : INTEGER;
  260. BEGIN
  261.   YL := SUCC(YL);
  262.   GOTOXY (XL,YL);  WRITE (ZR);
  263.   FOR Zaehler := 1 TO 5 DO BEGIN
  264.       WRITE (HO,HO,HO,HO,HO,KR);
  265.   END;
  266.   WRITE (HO,HO,HO,HO,HO,ZL);
  267. END;
  268.  
  269. BEGIN    (* SpielBrett *)
  270.   FOR Schleife := 1 TO 6 DO BEGIN
  271.     GOTOXY (XL-2+6*Schleife,YL); WRITE (CHR(64+Schleife));
  272.   END;
  273.   XL := SUCC(XL);    YL := SUCC(YL);
  274.   GOTOXY (XL,YL);    WRITE (E1);
  275.   FOR Schleife := 1 TO 5 DO WRITE (HO,HO,HO,HO,HO,ZU);
  276.   WRITE (HO,HO,HO,HO,HO,E2);
  277.   FOR Schleife := 1 TO 5 DO BEGIN
  278.     Zeile2; Zeile2; Spalte; Zeile3;
  279.   END;
  280.   Schleife := SUCC(Schleife);  Zeile2; Zeile2; Spalte;
  281.   YL := SUCC(YL);
  282.   GOTOXY (XL,YL);  WRITE (E3);
  283.   FOR Schleife := 1 TO 5 DO WRITE (HO,HO,HO,HO,HO,ZO);
  284.   WRITE (HO,HO,HO,HO,HO,E4);
  285.   GOTOXY (52,12);  WRITE ('Eingabebeispiel : A1');
  286.   GOTOXY (52,14);  WRITE ('Ende mit "^Q"');
  287.   GOTOXY (52,18);  INVERS;  WRITE (' ':17);
  288.   GOTOXY (52,19);  WRITE (' Spieler 1   : ',Stein_1,' ');
  289.   GOTOXY (52,20);  WRITE (' Spieler 2   : ',Stein_2,' ');
  290.   GOTOXY (52,21);  WRITE (' ':17);  NORMAL;
  291. END;
  292. (* ------------------------------------------------------ *)
  293. PROCEDURE WerIstDran;
  294. BEGIN
  295.   IF Spieler = 1 THEN Spieler := 2 ELSE Spieler := 1;
  296.   INVERS;
  297.   GOTOXY (50,5);
  298.   WRITE (' Zugeingabe Spieler ',Spieler,' : ');
  299.   GOTOXY (50,7);  WRITE (' ':14);
  300.   GOTOXY (50,8);  WRITE ('  auf Feld  : ');
  301.   GOTOXY (50,9);  WRITE (' ':14);
  302.   NORMAL;
  303. END;
  304. (* ------------------------------------------------------ *)
  305. PROCEDURE ZugEingabe;
  306. VAR    Korrekt, OK : BOOLEAN;
  307.  
  308. PROCEDURE Fehler;
  309. BEGIN
  310.   BELL;
  311.   GOTOXY (32,23);  INVERS; WRITE (' Nicht zulaessig ! ');
  312.   BELL;
  313.   DELAY (1000);
  314.   NORMAL;  GOTOXY (32,23);  CLREOL;
  315. END;
  316.  
  317. PROCEDURE Kontrolle;
  318. VAR   Pos : 1..36;
  319. BEGIN
  320.   ZE := (ORD (Zeile)-48);    SP := (ORD (Spalte)-64);
  321.   Pos := (ZE - 1) * 6 + SP;
  322.   IF (Feld [Pos].Besitzer = Spieler) OR
  323.      (Feld [Pos].Besitzer = 0) THEN
  324.     WITH Feld [Pos] DO BEGIN
  325.       Besitzer  := Spieler;
  326.       Vorhanden := SUCC (Vorhanden);
  327.       Korrekt   := TRUE;
  328.       Steine_Im_Feld (Pos);
  329.     END
  330.   ELSE Fehler;
  331. END;
  332.  
  333. BEGIN  (* ZugEingabe *)
  334.   Korrekt := FALSE;
  335.   REPEAT
  336.     GOTOXY (65,8);  CLREOL;
  337.     REPEAT
  338.       READ (KBD, Spalte);
  339.       Spalte := UPCASE (Spalte);
  340.       OK := Spalte IN ['A'..'F',^Q];
  341.     UNTIL OK;
  342.     IF Spalte = ^Q THEN HALT;
  343.     WRITE (Spalte);
  344.     REPEAT
  345.       READ (KBD, Zeile);
  346.       OK := Zeile IN ['1'..'6'];
  347.     UNTIL OK;
  348.     WRITE (Zeile);
  349.     Kontrolle;
  350.   UNTIL Korrekt;
  351. END;
  352. (* ------------------------------------------------------ *)
  353. BEGIN
  354.   SpielBeschreibung;
  355.   SpielBrett;
  356.   Initialisierung;
  357.   REPEAT
  358.     WerIstDran;
  359.     ZugEingabe;
  360.     Probe;
  361.     SpielStand;
  362.   UNTIL Fertig
  363. END.
  364. (* ------------------------------------------------------ *)
  365. (*               Ende von STRATEGO.PAS                    *)