home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 06 / stratego / stratego.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-10-12  |  10.4 KB  |  369 lines
  1. PROGRAM  STRATEGO;
  2. (*  System   : MS-DOS       Sprache   : Turbo Pascal 4.0  *)
  3. (* V.1.0.a  - 12.10.88      CGA-Version                   *)
  4.  
  5. {$R-,S+,I+,D+,T-,F+,V+,B+,N-,L+ }
  6. {$M 16384,0,655360 }
  7.  
  8. USES CRT, DOS, Graph, SpieleGraph, StratSp1, StratSp2, StratSp;
  9. (* in Spielegraph : GraphDir an die eigenen Verzeichnisse anpassen ! *)
  10. (* die StratSp*.*-Units enthalten die Sprites                        *)
  11.  
  12. CONST          Max       = 36;
  13.  
  14.                StartX : INTEGER = 20;
  15.                DeltaX : INTEGER = 26;
  16.                Zeilen : INTEGER = 6;
  17.                StartY : INTEGER = 30;
  18.                DeltaY : INTEGER = 26;
  19.                Spalten: INTEGER = 6;
  20.  
  21. TYPE            Brett = RECORD
  22.                            Besitzer  : 0..2;       (* 0 = leeres Feld *)
  23.                            Vorhanden : 0..4;
  24.                            Zulaessig : 0..4;
  25.                         END;
  26.  
  27. VAR              Feld          : ARRAY [1..Max] OF Brett;
  28.                  Zeile, Spalte : CHAR;
  29.                  ZE, SP        : INTEGER;
  30.          Fertig        : BOOLEAN;
  31.          Space2        : POINTER;
  32.          Runde, Spieler: INTEGER;
  33.  
  34. (*-----------------------------------------------*)
  35. FUNCTION Wirklich (Frage : STRING) : BOOLEAN;
  36. (* Ja oder Nein *)
  37. VAR Ch    : CHAR;
  38.  
  39. BEGIN
  40.   SetViewPort (MinX+1, MaxY-19, MaxX-1, MaxY-1, ClipOff);
  41.   ClearViewPort;
  42.   SetColor (1);  OutTextXY (5, 1, Frage);
  43.  
  44.   REPEAT
  45.     Ch := ReadKey
  46.   UNTIL UpCase (Ch) IN ['J', 'N'];
  47.   Wirklich := Ch IN ['J', 'j'];
  48. END;
  49. (*-----------------------------------------------*)
  50. PROCEDURE Initialisierung;
  51.  
  52. VAR   Pos : INTEGER;
  53.  
  54. BEGIN
  55.   FILLCHAR (Feld, SIZEOF (Feld),#0);
  56.   FOR Pos := 1 TO Max DO
  57.      WITH Feld [Pos] DO
  58.        CASE Pos OF
  59.          1, 6, 31, 36   : Zulaessig := 2;        (* Eckfelder *)
  60.          2..5, 7, 12,
  61.          13,18,19,24,
  62.          25,30,32..35   : Zulaessig := 3         (* Randfelder *)
  63.          ELSE             Zulaessig := 4;        (* Innenfelder *)
  64.        END;
  65.   Runde := 1;  Spieler := 2;
  66.  
  67.   GraphikInit (CGA, CGAC2);
  68.   SetTextStyle (SmallFont, HorizDir, 4);
  69.   SetColor (1);
  70.   Bar (StartX, StartY, StartX + Spalten * DeltaX, StartY + Zeilen * DeltaY);
  71.   SetColor (2);
  72.   MachRaster (StartX, Spalten, DeltaX, StartY, Zeilen, DeltaY, TRUE);
  73.   SetColor (3);    OutTextXY (130, 1, 'S T R A T E G O');
  74.   SetFillStyle (1, 1);
  75.   BAR (180, 24, 315, 64);
  76.   GetMem (Space2, ImageSize (0, 0, 20, 10));
  77.   GetImage (280, 40, 300, 50, Space2^);
  78.   SetColor (2);
  79.   OutTextXY (240, 10, 'Runde ' + Int2Str (Runde, 3));
  80.   SetColor (2);
  81.   OutTextXY (200, 150, Int2Str (0, 2) + ' Feld(er)');
  82.   SetColor (1);
  83.   OutTextXY (200, 165, Int2Str (0, 2) + ' Feld(er)');
  84. END;
  85. (*-----------------------------------------------*)
  86. PROCEDURE Steine_Im_Feld (Pos : INTEGER);
  87.  
  88. VAR      XFeld, YFeld, DX, DY  : INTEGER;
  89. (*----------*)
  90. PROCEDURE SetzeStein;
  91.  
  92. BEGIN
  93.   CASE Spieler  OF
  94.             1 : PutImage (XFeld + DX, YFeld + DY, Sprite1^, NormalPut);
  95.             2 : PutImage (XFeld + DX, YFeld + DY, Sprite2^, NormalPut);
  96.   END;
  97. END;
  98. (*----------*)
  99. PROCEDURE Leer;
  100. BEGIN
  101.    PutImage (XFeld + 0, YFeld + 0, Sprite3^, NormalPut);
  102.    PutImage (XFeld + 10, YFeld + 0, Sprite3^, NormalPut);
  103.    PutImage (XFeld + 0, YFeld + 10, Sprite3^, NormalPut);
  104.    PutImage (XFeld + 10, YFeld + 10, Sprite3^, NormalPut);
  105. END;
  106. (*----------*)
  107. PROCEDURE EinStein;
  108. BEGIN
  109.   DX := 0;  DY := 0;      SetzeStein;
  110. END;
  111. (*----------*)
  112. PROCEDURE ZweiSteine;
  113. BEGIN
  114.   EinStein;
  115.   DX := 10;   DY := 0;    SetzeStein;
  116. END;
  117. (*----------*)
  118. PROCEDURE DreiSteine;
  119. BEGIN
  120.   ZweiSteine;
  121.   DX := 0;   DY := 10;    SetzeStein;
  122. END;
  123. (*----------*)
  124. PROCEDURE VierSteine;
  125. BEGIN
  126.   DreiSteine;
  127.   DX := 10;   DY := 10;   SetzeStein;
  128. END;
  129. (*----------*)
  130. BEGIN (* Steine_Im_Feld *)
  131.  
  132.   XFeld := StartX + 5 + 26 * (SP - 1);
  133.   YFeld := StartY + 5 + 26 * (ZE - 1);
  134.  
  135.   CASE Feld [Pos].Vorhanden OF
  136.           1 : EinStein;
  137.           2 : ZweiSteine;
  138.           3 : DreiSteine;
  139.           4 : VierSteine;
  140.           ELSE Leer;
  141.     END;
  142. END;
  143. (*-----------------------------------------------*)
  144. PROCEDURE Explosion  (Ort : INTEGER);
  145.  
  146. VAR      FeldNummer  : INTEGER;
  147. (*----------*)
  148. PROCEDURE Wo;
  149.  
  150. BEGIN
  151.   ZE := (FeldNummer - 1) DIV 6 + 1;
  152.   SP := FeldNummer - 6 * (ZE - 1);
  153. END;
  154. (*----------*)
  155. PROCEDURE Deckung;
  156.  
  157. BEGIN
  158.   Beep (800, 50);
  159.   WITH Feld[FeldNummer] DO BEGIN
  160.     Vorhanden := SUCC (Vorhanden);
  161.     Besitzer := Spieler;
  162.   END;
  163.   Wo;
  164.   Steine_Im_Feld (FeldNummer);
  165.   Beep (800, 50);
  166. END;
  167. (*----------*)
  168. BEGIN  (* Explosion *)
  169.   Feld [Ort].Vorhanden := 0;
  170.   FeldNummer := Ort;  Wo;
  171.   Steine_Im_Feld (FeldNummer);
  172.   IF Ort - 6 >   0 THEN  BEGIN FeldNummer := Ort - 6; Deckung;  END;
  173.   IF Ort + 6 <= 36 THEN  BEGIN FeldNummer := Ort + 6; Deckung;  END;
  174.   IF SP - 1  >   0 THEN  BEGIN FeldNummer := Ort - 1; Deckung;  END;
  175.   IF SP + 1  <   6 THEN  BEGIN FeldNummer := Ort + 1; Deckung;  END;
  176. END;
  177. (*-----------------------------------------------*)
  178. PROCEDURE Probe;
  179. VAR         Stelle        : 1..36;
  180.             Explodiert    : BOOLEAN;
  181.             FelderVonEins,
  182.         FelderVonZwei : INTEGER;
  183.  
  184. BEGIN
  185.   REPEAT
  186.     FelderVonEins := 0;   FelderVonZwei := 0;
  187.     Explodiert := FALSE;
  188.     FOR Stelle := 1 TO Max DO
  189.       BEGIN
  190.         IF Feld [Stelle].Vorhanden >= Feld [Stelle].Zulaessig THEN
  191.           BEGIN
  192.             Explosion (Stelle);
  193.             Explodiert := TRUE;
  194.           END;
  195.         IF Feld [Stelle].Besitzer = 1 THEN FelderVonEins := SUCC(FelderVonEins);
  196.         IF Feld [Stelle].Besitzer = 2 THEN FelderVonZwei := SUCC(FelderVonZwei);
  197.       END;  (* FOR Stelle := 1 TO Max *)
  198.   UNTIL (NOT Explodiert) OR (FelderVonEins = 0) OR (FelderVonZwei = 0);
  199. END;
  200. (*-----------------------------------------------*)
  201. PROCEDURE SpielStand;
  202.  
  203. VAR      FelderVonEins, FelderVonZwei, Kasten : INTEGER;
  204.  
  205. BEGIN
  206.   FelderVonEins := 0;   FelderVonZwei := 0;   Fertig := FALSE;
  207.   FOR Kasten := 1 TO Max DO
  208.     BEGIN
  209.       IF Feld [Kasten].Besitzer = 1 THEN FelderVonEins := SUCC(FelderVonEins);
  210.       IF Feld [Kasten].Besitzer = 2 THEN FelderVonZwei := SUCC(FelderVonZwei);
  211.     END;
  212.  
  213.  
  214.   FOR Kasten := 0 TO 1 DO PutImage (200 + Kasten * 8, 151, Space^, NormalPut);
  215.   FOR Kasten := 0 TO 1 DO PutImage (200 + Kasten * 8, 166, Space^, NormalPut);
  216.   SetColor (2);
  217.   OutTextXY (200, 150, Int2Str (FelderVonEins,2));
  218.   SetColor (1);
  219.   OutTextXY (200, 165, Int2Str (FelderVonZwei,2));
  220.  
  221.     IF Runde > 1 THEN
  222.      BEGIN
  223.        IF (FelderVonEins =0) OR (FelderVonZwei = 0) THEN
  224.        BEGIN
  225.      SetColor (3);
  226.          OutTextXY (10, 190, 'SIEGER : Spieler ' + Int2Str (Spieler, 1)
  227.             + ' in Runde' + Int2Str (Runde, 3));
  228.          REPEAT UNTIL KEYPRESSED;
  229.          Fertig := TRUE;
  230.        END;
  231.      END;
  232.  
  233.   IF Spieler = 2 THEN Runde := SUCC(Runde);
  234.  
  235.   SetColor (2);
  236.   FOR Kasten := 0 TO 2 DO PutImage (276 + Kasten * 8, 11, Space^, NormalPut);
  237.   OutTextXY (276, 10, Int2Str (Runde, 3));
  238.  
  239. END;
  240. (*-----------------------------------------------*)
  241. PROCEDURE SpielBeschreibung;
  242.  
  243. CONST       Zeile : INTEGER = 5;
  244. (*----------*)
  245. BEGIN
  246.    TextMode (Co80);
  247.    CLRSCR; GOTOXY (36,1); INVERS; WRITE (' STRATEGO ');  NORMAL;
  248.    GOTOXY (2, Zeile);
  249.    WRITE ('Die Aufgabe bei diesem Spiel ist es, auf einem Brett mit 36');
  250.    WRITE (' Feldern alle');
  251.    GOTOXY (2, Zeile+1);
  252.    WRITE ('Steine des Gegners zu zerstören.');
  253.    GOTOXY (26, Zeile+4);
  254.    TextBackground (0); TextColor (9);
  255.    WRITE ('Dabei gelten folgende REGELN :');
  256.    NORMAL;
  257.    GOTOXY (2, Zeile+6);
  258.    WRITE ('1 - Die Steine werden abwechselnd gesetzt.');
  259.    GOTOXY (2, Zeile+7);
  260.    WRITE ('2 - Jedes Feld hat abhängig von seiner Lage eine bestimmte');
  261.    WRITE (' maximale Kapazität');
  262.    INVERS;
  263.    GOTOXY (24, Zeile+8); WRITE (' ':32);
  264.    GOTOXY (24, Zeile+9);
  265.    WRITE (' >>> Eckfelder   : 2 Steine <<< ');
  266.    GOTOXY (24, Zeile+10);
  267.    WRITE (' >>> Randfelder  : 3 Steine <<< ');
  268.    GOTOXY (24, Zeile+11);
  269.    WRITE (' >>> Innenfelder : 4 Steine <<< ');
  270.    GOTOXY (24, Zeile+12); WRITE (' ':32);
  271.    NORMAL;
  272.    GOTOXY (2, Zeile+13);
  273.    WRITE ('3 - Erreicht ein Feld seine maximale Kapazität, so werden die');
  274.    WRITE (' Steine explo-');
  275.    GOTOXY (6, Zeile+14);
  276.    WRITE ('sionsartig auf die Nachbarfelder geschleudert.');
  277.    GOTOXY (2, Zeile+15);
  278.    WRITE ('4 - Auf ein irgendwann vom Gegner besetztes Feld darf nicht');
  279.    WRITE (' gesetzt werden.');
  280.    GOTOXY (31, 22);  WRITE ('Spielabbruch mit CTRL-Q');
  281.    GOTOXY (31,24); INVERS;  WRITE (' Weiter mit Tastendruck ');  NORMAL;
  282.    REPEAT UNTIL KEYPRESSED;
  283. END;
  284. (*-----------------------------------------------*)
  285. PROCEDURE WerIstDran;
  286.  
  287. BEGIN
  288.   IF Spieler = 1 THEN Spieler := 2 ELSE Spieler := 1;
  289.   PutImage (280, 32, Space2^, NormalPut);
  290.   SetColor (0);
  291.   OutTextXY (185, 32, 'Zugeingabe Spieler' + Int2Str (Spieler, 2) + ' :');
  292.   OutTextXY (200, 48, 'auf Feld : ');
  293. END;
  294. (*-----------------------------------------------*)
  295. PROCEDURE ZugEingabe;
  296.  
  297. VAR    Korrekt, OK : BOOLEAN;
  298.  
  299. PROCEDURE Fehler;
  300.  
  301. BEGIN
  302.   Beep (300, 50);
  303.   SetColor (3);
  304.   OutTextXY (100, 187, ' Nicht zulaessig ! ');
  305.   Beep (800, 50);
  306.   DELAY (1000);
  307.   SetColor (0);
  308.   OutTextXY (100, 187, ' Nicht zulaessig ! ');
  309. END;
  310. (*----------*)
  311. PROCEDURE Kontrolle;
  312.  
  313. VAR   Pos : 1..36;
  314.  
  315. BEGIN
  316.   ZE := (ORD (Zeile)-48);    SP := (ORD (Spalte)-64);
  317.   Pos := (ZE - 1) * 6 + SP;
  318.   IF (Feld [Pos].Besitzer = Spieler) OR (Feld [Pos].Besitzer = 0) THEN
  319.     WITH Feld [Pos] DO BEGIN
  320.       Besitzer  := Spieler;
  321.       Vorhanden := SUCC (Vorhanden);
  322.       Korrekt   := TRUE;
  323.       Steine_Im_Feld (Pos);
  324.     END
  325.   ELSE Fehler;
  326. END;
  327. (*----------*)
  328. BEGIN  (* ZugEingabe *)
  329.  
  330.   Korrekt := FALSE;
  331.  
  332.   REPEAT
  333.     PutImage (280, 48, Space2^, NormalPut);
  334.     PutImage (287, 48, Space2^, NormalPut);
  335.  
  336.     REPEAT
  337.        HolZeichen (Spalte);  Spalte := UpCase (Spalte);
  338.        OK := Spalte IN ['A'..'F', ^Q];
  339.     UNTIL OK;
  340.  
  341.     IF Spalte = ^Q THEN BEGIN Fertig := TRUE; EXIT; END;
  342.     OutTextXY (280, 48, Spalte);
  343.  
  344.     REPEAT
  345.        HolZeichen (Zeile);
  346.        OK := Zeile IN ['1'..'6'];
  347.     UNTIL OK;
  348.  
  349.     OutTextXY (287, 48, Zeile);
  350.  
  351.     Kontrolle;
  352.   UNTIL Korrekt;
  353. END;
  354. (*-----------------------------------------------*)
  355. (* Spielabbruch mit CTRL-Q *)
  356. BEGIN
  357.   REPEAT
  358.     Fertig := FALSE;
  359.     SpielBeschreibung;
  360.     Initialisierung;
  361.     REPEAT
  362.        WerIstDran;
  363.        ZugEingabe;
  364.        IF NOT Fertig THEN BEGIN Probe; SpielStand; END;
  365.     UNTIL Fertig;
  366.   UNTIL NOT Wirklich ('Noch ein Spiel ? <J> / <N> : ');
  367.   GraphikEnde;
  368. END.
  369.