home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 07_08 / titel / explode.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-06  |  10.3 KB  |  388 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    EXPLODE.PAS                         *)
  3. (*             Strategiespiel in Turbo Pascal             *)
  4. (*          (c) 1991 Patrick Filipaj & TOOLBOX            *)
  5. (*         Update vom 6.6.91: Fehler in Prozedur          *)
  6. (*         "PointTotal" behoben, Zeile 139 (ga)           *)
  7. (* ------------------------------------------------------ *)
  8. PROGRAM Explode;
  9. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-,X+}
  10. {$M 1024,0,0}
  11. USES
  12.   Crt, Dos;
  13.  
  14. TYPE
  15.   Location = RECORD
  16.                x, y : SHORTINT;
  17.              END;
  18.   Zelle   = RECORD
  19.               Farbe : BYTE;
  20.               Wert  : BYTE;
  21.             END;
  22.   Verbund = ARRAY[-1..6, -1..6] OF Zelle;
  23.   Spieler = PROCEDURE(Zahl : BYTE);     { Prozeduraler Typ }
  24.  
  25. VAR
  26.   Feld               : Verbund;
  27.   Position           : ARRAY[1..2] OF Location;
  28.   Name               : ARRAY[1..2] OF STRING[17];
  29.   SpielerA, SpielerB : Spieler;
  30.   Winner             : STRING;
  31.   AltAttr            : BYTE;
  32.  
  33. CONST
  34.   Mon = $B800;  { Startadresse für Farbbildschirmspeicher, }
  35.                 { für Hercules-Karte ändern in Mon = $B000 }
  36.   Farbe: ARRAY[0..3] OF BYTE =                 { Attribute }
  37.          (White, Yellow, Black OR Green SHL 4, LightGray);
  38.  
  39. PROCEDURE Cursor(Visible : BOOLEAN);
  40. VAR
  41.   Regs : Registers;
  42. BEGIN
  43.   Regs.AH := 1;
  44.   Regs.CH := 6;
  45.   IF Visible THEN Regs.CL := 7 ELSE Regs.CL := 0;
  46.   Intr(16, Regs);
  47. END;
  48.  
  49. PROCEDURE Ende;
  50. BEGIN
  51.   Cursor(TRUE);
  52.   TextAttr := AltAttr;
  53.   WriteLn;
  54.   ClrScr;
  55.   Halt;
  56. END;
  57.  
  58. PROCEDURE SpielBeginn;
  59. VAR
  60.   n : BYTE;
  61. BEGIN
  62.   TextAttr := Farbe[0];
  63.   ClrScr;
  64.   GotoXY(18, 1);
  65.   WriteLn('* * * * * * * * * * * * * * * * * * * * * *');
  66.   GotoXY(18, 2);
  67.   WriteLn('* * * *        E X P L O D E        * * * *');
  68.   GotoXY(18, 3);
  69.   WriteLn('* * * * * * * * * * * * * * * * * * * * * *');
  70.   GotoXY(18, 8);
  71.   WriteLn('* * (c) 1991  Patrick Filipaj & toolbox * *');
  72.   GotoXY(18, 14);
  73.   Write('Name Spieler A: '); ReadLn(Name[1]);
  74.   GotoXY(18, 15);
  75.   Write('Name Spieler B: '); ReadLn(Name[2]);
  76.   FOR n := 1 TO Length(Name[1]) DO
  77.     Name[1][n] := UpCase(Name[1][n]);
  78.   FOR n := 1 TO Length(Name[2]) DO
  79.     Name[2][n] := UpCase(Name[2][n]);
  80. END;
  81.  
  82. PROCEDURE InitBildschirm;             { Spielfeld aufbauen }
  83. VAR
  84.   x, y : BYTE;
  85. BEGIN
  86.   TextAttr := Farbe[0];
  87.   ClrScr;
  88.   GotoXY(28, 3);
  89.   WriteLn('> >   E X P L O D E   < <');
  90.   TextAttr := Farbe[3];
  91.   FOR y := 0 TO 6 DO BEGIN
  92.     GotoXY(28, 2 * y + 5);
  93.     FOR x := 1 TO 25 DO Write(#196);
  94.   END;
  95.   FOR x := 0 TO 6 DO BEGIN
  96.     FOR y := 5 TO 17 DO BEGIN
  97.       GotoXY(x * 4 + 28, y);
  98.       IF (y MOD 2) = 1 THEN Write(#197)
  99.       ELSE Write(#179);
  100.     END;
  101.   END;
  102. END;
  103.  
  104. PROCEDURE InitTabelle(VAR Tabelle : Verbund);
  105. VAR
  106.   i, j : BYTE;
  107. BEGIN
  108.   FOR i := 0 TO 5 DO BEGIN
  109.     FOR j := 0 TO 5 DO BEGIN
  110.       Tabelle[i, j].Wert  := 0;
  111.       Tabelle[i, j].Farbe := Farbe[3];
  112.     END;
  113.   END;
  114. END;
  115.  
  116. FUNCTION Total(Tabelle : Verbund; Color : BYTE) : BYTE;
  117.    { zählt die Anzahl der mit einer Farbe besetzten Felder }
  118. VAR
  119.   x, y, c : SHORTINT;
  120. BEGIN
  121.   c := 0;
  122.   FOR x := 0 TO 5 DO BEGIN
  123.     FOR y := 0 TO 5 DO BEGIN
  124.       IF Tabelle[x, y].Farbe = Color THEN Inc(c);
  125.     END;
  126.   END;
  127.   Total := c;
  128. END;                                      { FUNCTION Total }
  129.  
  130. FUNCTION PointTotal(Tabelle : Verbund; Color : BYTE) : BYTE;
  131.                { addiert die Höhe aller Felder einer Farbe }
  132. VAR
  133.   x, y, c : SHORTINT;
  134. BEGIN
  135.   c := 0;
  136.   FOR x := 0 TO 5 DO BEGIN
  137.     FOR y := 0 TO 5 DO BEGIN
  138.       IF Tabelle[x, y].Farbe = Color THEN
  139.         Inc(c, Tabelle[x, y].Wert);  { nicht Farbe, wie im Heft!!! }
  140.     END;
  141.   END;
  142.   PointTotal := c;
  143. END;  { PROCEDURE PointTotal }
  144.  
  145. PROCEDURE ShowTabelle;           { alle Feldwerte anzeigen }
  146. VAR
  147.   x, y : BYTE;
  148. BEGIN
  149.   FOR x := 0 TO 5 DO BEGIN
  150.     FOR y := 0 TO 5 DO BEGIN
  151.       TextAttr := Feld[x, y].Farbe;
  152.       GotoXY(4 * x + 30, 2 * y + 6);
  153.       IF Feld[x, y].Wert > 0 THEN
  154.         Write(Feld[x, y].Wert)
  155.       ELSE Write(#249);
  156.     END;
  157.   END;
  158.   GotoXY(79, 25);
  159. END;  { PROCEDURE ShowTabelle }
  160.  
  161. PROCEDURE Blink(x, y : BYTE);
  162.                      { Anzeige des inversen Eingabecursors }
  163. BEGIN
  164.   Mem[Mon:2 * (80 * (5 + 2 * y) + 29 + 4 * x) + 1] :=
  165.   Mem[Mon:2 * (80 * (5 + 2 * y) + 29 + 4 * x) + 1] XOR 192;
  166. END;  { PROCEDURE Blink }
  167.  
  168. PROCEDURE Eingabe(CursorNummer : BYTE);
  169.     { fragt nach neuer Cursorposition, bei <ESC> Spielende }
  170. VAR
  171.   x, y : SHORTINT;
  172.   Chr  : CHAR;
  173. BEGIN
  174.   WHILE KeyPressed DO ReadKey;
  175.   x := Position[CursorNummer].x;
  176.   y := Position[CursorNummer].y;
  177.   REPEAT
  178.     Blink(x, y);
  179.     REPEAT
  180.       REPEAT UNTIL KeyPressed;
  181.       Chr := ReadKey;
  182.       IF Chr = #0 THEN Chr := ReadKey;
  183.     UNTIL Chr IN [#13, #72, #75, #77, #80, #27];
  184.     Blink(x, y);
  185.     CASE Chr OF
  186.       #72 : Dec(y);  #75 : Dec(x);  #77 : Inc(x);
  187.       #80 : Inc(y);  #27 : Ende;
  188.     END;
  189.     IF x > 5 THEN x := 5;
  190.     IF x < 0 THEN x := 0;
  191.     IF y < 0 THEN y := 0;
  192.     IF y > 5 THEN y := 5;
  193.     Position[CursorNummer].x := x;
  194.     Position[CursorNummer].y := y;
  195.   UNTIL Chr = #13;
  196. END;
  197.  
  198. PROCEDURE PutText(s1, s2 : STRING; TextFarbe : BYTE);
  199.       { Hilfsprozedur für die Ausgabe von Spielkommentaren }
  200. VAR
  201.   i : INTEGER;
  202. BEGIN
  203.   TextAttr := Farbe[0];
  204.   GotoXY(1, 21); ClrEol;
  205.   GotoXY(1, 22); ClrEol;
  206.   TextAttr := TextFarbe;
  207.   GotoXY(40 - Length(s1) DIV 2, 22);
  208.   Write(s1);
  209.   GotoXY(40 - Length(s1) DIV 2, 23);
  210.   Write(s2);
  211. END;
  212.  
  213. FUNCTION SpielEnde : BOOLEAN;
  214.                           { Gewinneranzeige und Endabfrage }
  215. VAR
  216.   s : STRING;
  217. BEGIN
  218.   s := 'Der Gewinner ist ' + Winner + ' !!';
  219.   PutText(s, 'Noch ein Spiel? <J>/<N>', Farbe[3]);
  220.   REPEAT UNTIL KeyPressed;
  221.   SpielEnde := NOT(UpCase(ReadKey) IN ['J', 'Y']);
  222. END;
  223.  
  224. FUNCTION NoMoreExplosion(VAR Tabelle : Verbund;
  225.                          Virtuell : BOOLEAN) : BOOLEAN;
  226. VAR
  227.   NoChange : BOOLEAN;
  228.   x, y     : BYTE;
  229.  
  230.   PROCEDURE Erhohen; { Nachbarstapel bei Explosion erhöhen }
  231.   BEGIN
  232.     Inc(Tabelle[x + 1, y].Wert);
  233.     Tabelle[x + 1, y].Farbe := Tabelle[x, y].Farbe;
  234.     Inc(Tabelle[x - 1, y].Wert);
  235.     Tabelle[x - 1, y].Farbe := Tabelle[x, y].Farbe;
  236.     Inc(Tabelle[x, y + 1].Wert);
  237.     Tabelle[x, y + 1].Farbe := Tabelle[x, y].Farbe;
  238.     Inc(Tabelle[x, y - 1].Wert);
  239.     Tabelle[x, y - 1].Farbe := Tabelle[x, y].Farbe;
  240.   END;
  241.  
  242.   PROCEDURE Is_Explosion(Subtraktor : SHORTINT);
  243.                              { checken, ob Feld explodiert }
  244.   BEGIN
  245.     IF Tabelle[x, y].Wert >= Subtraktor THEN BEGIN
  246.       Erhohen;
  247.       Tabelle[x, y].Wert := Tabelle[x, y].Wert - Subtraktor;
  248.       IF Tabelle[x, y].Wert = 0 THEN
  249.         Tabelle[x, y].Farbe := Farbe[3];
  250.       NoChange := FALSE;
  251.       IF NOT Virtuell THEN BEGIN
  252.         ShowTabelle;
  253.         Sound(100);
  254.         Delay(1);
  255.         NoSound;
  256.         Delay(300);
  257.       END;
  258.     END;
  259.   END;
  260.  
  261. BEGIN                              { Start NoMoreExplosion }
  262.   NoChange := TRUE;
  263.   FOR x := 1 TO 4 DO
  264.     FOR y := 1 TO 4 DO Is_Explosion(4);
  265.   x := 0;
  266.   FOR y := 1 TO 4 DO Is_Explosion(3);
  267.   y := 0;
  268.   Is_Explosion(2);
  269.   y := 5;
  270.   Is_Explosion(2);
  271.   x := 5;
  272.   FOR y := 1 TO 4 DO Is_Explosion(3);
  273.   y := 0;
  274.   Is_Explosion(2);
  275.   y := 5;
  276.   Is_Explosion(2);
  277.   y := 0;
  278.   FOR x := 1 TO 4 DO Is_Explosion(3);
  279.   y := 5;
  280.   FOR x := 1 TO 4 DO Is_Explosion(3);
  281.   NoMoreExplosion := NoChange;
  282. END;
  283.  
  284. PROCEDURE Explosion(VAR Tabelle : Verbund);
  285.                      { Hauptschleife für Explosionsabfrage }
  286. BEGIN
  287.   REPEAT
  288.     IF Total(Tabelle, Farbe[1]) = 0 THEN Winner := Name[2];
  289.     IF Total(Tabelle, Farbe[2]) = 0 THEN Winner := Name[1];
  290.   UNTIL (Winner <> '') OR (NoMoreExplosion(Tabelle, FALSE));
  291.   ShowTabelle;
  292.   Delay(500);
  293. END;
  294.  
  295. PROCEDURE VirExplosion(VAR Tabelle : Verbund);
  296.    { "virtuelle" Explosion für Zugvorausberechnung des PCs }
  297. BEGIN
  298.   REPEAT UNTIL NoMoreExplosion(Tabelle, TRUE)
  299.     OR (Total(Tabelle, Farbe[1]) = 0)
  300.     OR (Total(Tabelle, Farbe[2]) = 0);
  301. END;
  302.  
  303. {$F+}PROCEDURE Computer(Zahl : BYTE);{$F-}
  304.                                    { Computerspieler zieht }
  305. VAR
  306.   VirFeld : Verbund;
  307.   x, y, MaxX, MaxY, MaxWert, Tot : BYTE;
  308. BEGIN
  309.   MaxWert := 0;
  310.   MaxX    := 2;
  311.   MaxY    := 2;
  312.   TextAttr := Farbe[Zahl];
  313.   GotoXY(1, 25);
  314.   PutText('Der Computer ist am Setzen!', '', Farbe[Zahl]);
  315.   FOR x := 0 TO 5 DO BEGIN
  316.     FOR y := 0 TO 5 DO BEGIN
  317.       VirFeld := Feld;
  318.       IF VirFeld[x,y].Farbe IN [Farbe[Zahl], Farbe[3]] THEN
  319.       BEGIN
  320.         Inc(VirFeld[x, y].Wert);
  321.         VirFeld[x, y].Farbe := Farbe[Zahl];
  322.         VirExplosion(VirFeld);
  323.         Tot := PointTotal(VirFeld, Farbe[Zahl]);
  324.         IF (Tot > MaxWert) OR
  325.           ((Tot = MaxWert) AND (Random > 0.75)) THEN BEGIN
  326.           MaxWert := Tot;
  327.           MaxX    := x;
  328.           MaxY    := y;
  329.         END;
  330.       END;
  331.     END;
  332.   END;
  333.   Position[Zahl].x := MaxX;
  334.   Position[Zahl].y := MaxY;
  335.   Blink(MaxX, MaxY);                        { Zug anzeigen }
  336.   Delay(1200);
  337.   Blink(MaxX, MaxY);
  338.   Inc(Feld[MaxX, MaxY].Wert);
  339.   Feld[MaxX, MaxY].Farbe := Farbe[Zahl];
  340.   ShowTabelle;
  341.   Explosion(Feld);
  342. END;
  343.  
  344. {$F+}PROCEDURE Mensch(Zahl:BYTE);{$F-}
  345.                               { menschlicher Spieler zieht }
  346. BEGIN
  347.   PutText(Name[Zahl] + ', Sie sind am Setzen!', '',
  348.           Farbe[Zahl]);
  349.   REPEAT
  350.     Eingabe(Zahl);
  351.   UNTIL Feld[Position[Zahl].x, Position[Zahl].y].Farbe
  352.         IN [Farbe[Zahl],Farbe[3]];
  353.   Inc(Feld[Position[Zahl].x, Position[Zahl].y].Wert);
  354.   Feld[Position[Zahl].x, Position[Zahl].y].Farbe :=
  355.     Farbe[Zahl];
  356.   ShowTabelle;
  357.   Delay(350);
  358.   Explosion(Feld);
  359. END;
  360.  
  361. BEGIN                                      { Hauptprogramm }
  362.   AltAttr := TextAttr;
  363.   Randomize;
  364.   SpielBeginn;
  365.   IF Name[1] = 'PC' THEN SpielerA := Computer
  366.                     ELSE SpielerA := Mensch;
  367.   IF Name[2] = 'PC' THEN SpielerB := Computer
  368.                     ELSE SpielerB := Mensch;
  369.   REPEAT
  370.     Position[1].x := 2; Position[1].y := 2;
  371.     Position[2].x := 3; Position[2].y := 3;
  372.     InitBildschirm;
  373.     Cursor(FALSE);
  374.     InitTabelle(Feld);
  375.     ShowTabelle;
  376.     Winner := '';
  377.     SpielerA(1);
  378.     Winner := '';
  379.     REPEAT
  380.       SpielerB(2);
  381.       IF Winner = '' THEN SpielerA(1);
  382.     UNTIL Winner <> '';
  383.   UNTIL SpielEnde;
  384.   Ende;
  385. END.
  386. (* ------------------------------------------------------ *)
  387. (*                Ende von EXPLODE.PAS                    *)
  388.