home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 07_08 / bonus / explode / expklug.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-07  |  13.7 KB  |  493 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    EXPKLUG.PAS                         *)
  3. (*             Strategiespiel in Turbo Pascal             *)
  4. (*       erweiterte Version: "The Intelligent Remix"      *)
  5. (*          (c) 1991 Patrick Filipaj & TOOLBOX            *)
  6. (*            Erweiterungen von Gerald Arend              *)
  7. (* ------------------------------------------------------ *)
  8. PROGRAM Explode_Klug;
  9. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+}
  10. {$M 16384,0,0}
  11.  
  12. USES
  13.   Crt, Dos;
  14.  
  15. TYPE
  16.   Location = RECORD
  17.                x, y : SHORTINT;
  18.              END;
  19.   Zelle   = RECORD
  20.               Farbe : BYTE;
  21.               Wert  : BYTE;
  22.             END;
  23.   Verbund = ARRAY[-1..6, -1..6] OF Zelle;
  24.   Spieler = PROCEDURE(Zahl : BYTE);     { Prozeduraler Typ }
  25.  
  26. VAR
  27.   Feld               : Verbund;
  28.   Position           : ARRAY[1..2] OF Location;
  29.   Name               : ARRAY[1..2] OF STRING[17];
  30.   SpielerA, SpielerB : Spieler;
  31.   Winner             : STRING;
  32.   AltAttr            : BYTE;
  33.  
  34. CONST
  35.   Mon = $B800;  { Startadresse für Farbbildschirmspeicher, }
  36.                 { für Hercules-Karte ändern in Mon = $B000 }
  37.   Farbe: ARRAY[0..3] OF BYTE =                 { Attribute }
  38.          (White, Yellow, Black OR Green SHL 4, LightGray);
  39.  
  40. PROCEDURE Cursor(Visible : BOOLEAN);
  41. VAR
  42.   Regs : Registers;
  43. BEGIN
  44.   Regs.AH := 1;
  45.   Regs.CH := 6;
  46.   IF Visible THEN Regs.CL := 7 ELSE Regs.CL := 0;
  47.   Intr(16, Regs);
  48. END;
  49.  
  50. PROCEDURE Ende;
  51. BEGIN
  52.   Cursor(TRUE);
  53.   TextAttr := AltAttr;
  54.   WriteLn;
  55.   ClrScr;
  56.   Halt;
  57. END;
  58.  
  59. PROCEDURE SpielBeginn;
  60. VAR
  61.   n : BYTE;
  62. BEGIN
  63.   TextAttr := Farbe[0];
  64.   ClrScr;
  65.   GotoXY(18, 1);
  66.   WriteLn('* * * * * * * * * * * * * * * * * * * * * *');
  67.   GotoXY(18, 2);
  68.   WriteLn('* * * *        E X P L O D E        * * * *');
  69.   GotoXY(18, 3);
  70.   WriteLn('* * * * "Klügere" Version mit zwei  * * * *');
  71.   GotoXY(18, 4);
  72.   WriteLn('* * * *  verschiedenen Algorithmen  * * * *');
  73.   GotoXY(18, 5);
  74.   WriteLn('* * * * * * * * * * * * * * * * * * * * * *');
  75.   GotoXY(18, 8);
  76.   WriteLn('* * (c) 1991  Patrick Filipaj & toolbox * *');
  77.   GotoXY(18, 17);
  78.   Write('Computerspieler: "PC1" oder "PC2" eingeben');
  79.   GotoXY(18, 14);
  80.   Write('Name Spieler A: '); ReadLn(Name[1]);
  81.   GotoXY(18, 15);
  82.   Write('Name Spieler B: '); ReadLn(Name[2]);
  83.   FOR n := 1 TO Length(Name[1]) DO
  84.     Name[1][n] := UpCase(Name[1][n]);
  85.   FOR n := 1 TO Length(Name[2]) DO
  86.     Name[2][n] := UpCase(Name[2][n]);
  87. END;
  88.  
  89. PROCEDURE InitBildschirm;             { Spielfeld aufbauen }
  90. VAR
  91.   x, y : BYTE;
  92. BEGIN
  93.   TextAttr := Farbe[0];
  94.   ClrScr;
  95.   GotoXY(28, 3);
  96.   WriteLn('> >   E X P L O D E   < <');
  97.   TextAttr := Farbe[3];
  98.   FOR y := 0 TO 6 DO BEGIN
  99.     GotoXY(28, 2 * y + 5);
  100.     FOR x := 1 TO 25 DO Write(#196);
  101.   END;
  102.   FOR x := 0 TO 6 DO BEGIN
  103.     FOR y := 5 TO 17 DO BEGIN
  104.       GotoXY(x * 4 + 28, y);
  105.       IF (y MOD 2) = 1 THEN Write(#197)
  106.       ELSE Write(#179);
  107.     END;
  108.   END;
  109. END;
  110.  
  111. PROCEDURE InitTabelle(VAR Tabelle : Verbund);
  112. VAR
  113.   i, j : SHORTINT;
  114. BEGIN
  115.   FOR i := -1 TO 6 DO BEGIN
  116.     FOR j := -1 TO 6 DO BEGIN
  117.       Tabelle[i, j].Wert  := 0;
  118.       Tabelle[i, j].Farbe := Farbe[3];
  119.     END;
  120.   END;
  121. END;
  122.  
  123. FUNCTION Total(Tabelle : Verbund; Color : BYTE) : BYTE;
  124.    { zählt die Anzahl der mit einer Farbe besetzten Felder }
  125. VAR
  126.   x, y, c : SHORTINT;
  127. BEGIN
  128.   c := 0;
  129.   FOR x := 0 TO 5 DO BEGIN
  130.     FOR y := 0 TO 5 DO BEGIN
  131.       IF Tabelle[x, y].Farbe = Color THEN Inc(c);
  132.     END;
  133.   END;
  134.   Total := c;
  135. END;                                      { FUNCTION Total }
  136.  
  137. FUNCTION PointTotal(Tabelle : Verbund; Color : BYTE) : BYTE;
  138.                { addiert die Höhe aller Felder einer Farbe }
  139. VAR
  140.   x, y, c : BYTE;
  141. BEGIN
  142.   c := 0;
  143.   FOR x := 0 TO 5 DO BEGIN
  144.     FOR y := 0 TO 5 DO BEGIN
  145.       IF Tabelle[x, y].Farbe = Color THEN
  146.         Inc(c, Tabelle[x, y].Wert);
  147.     END;
  148.   END;
  149.   PointTotal := c;
  150. END;  { PROCEDURE PointTotal }
  151.  
  152. PROCEDURE ShowTabelle;           { alle Feldwerte anzeigen }
  153. VAR
  154.   x, y : BYTE;
  155. BEGIN
  156.   FOR x := 0 TO 5 DO BEGIN
  157.     FOR y := 0 TO 5 DO BEGIN
  158.       TextAttr := Feld[x, y].Farbe;
  159.       GotoXY(4 * x + 30, 2 * y + 6);
  160.       IF Feld[x, y].Wert > 0 THEN
  161.         Write(Feld[x, y].Wert)
  162.       ELSE Write(#249);
  163.     END;
  164.   END;
  165.   GotoXY(79, 25);
  166. END;  { PROCEDURE ShowTabelle }
  167.  
  168. PROCEDURE Blink(x, y : BYTE);
  169.                      { Anzeige des inversen Eingabecursors }
  170. BEGIN
  171.   Mem[Mon:2 * (80 * (5 + 2 * y) + 29 + 4 * x) + 1] :=
  172.   Mem[Mon:2 * (80 * (5 + 2 * y) + 29 + 4 * x) + 1] XOR 192;
  173. END;  { PROCEDURE Blink }
  174.  
  175. PROCEDURE Eingabe(CursorNummer : BYTE);
  176.     { fragt nach neuer Cursorposition, bei <ESC> Spielende }
  177. VAR
  178.   x, y : SHORTINT;
  179.   Chr  : CHAR;
  180. BEGIN
  181.   WHILE KeyPressed DO ReadKey;
  182.   x := Position[CursorNummer].x;
  183.   y := Position[CursorNummer].y;
  184.   REPEAT
  185.     Blink(x, y);
  186.     REPEAT
  187.       REPEAT UNTIL KeyPressed;
  188.       Chr := ReadKey;
  189.       IF Chr = #0 THEN Chr := ReadKey;
  190.     UNTIL Chr IN [#13, #72, #75, #77, #80, #27];
  191.     Blink(x, y);
  192.     CASE Chr OF
  193.       #72 : Dec(y);  #75 : Dec(x);  #77 : Inc(x);
  194.       #80 : Inc(y);  #27 : Ende;
  195.     END;
  196.     IF x > 5 THEN x := 5;
  197.     IF x < 0 THEN x := 0;
  198.     IF y < 0 THEN y := 0;
  199.     IF y > 5 THEN y := 5;
  200.     Position[CursorNummer].x := x;
  201.     Position[CursorNummer].y := y;
  202.   UNTIL Chr = #13;
  203. END;
  204.  
  205. PROCEDURE PutText(s1, s2 : STRING; TextFarbe : BYTE);
  206.       { Hilfsprozedur für die Ausgabe von Spielkommentaren }
  207. VAR
  208.   i : INTEGER;
  209. BEGIN
  210.   TextAttr := Farbe[0];
  211.   GotoXY(1, 21); ClrEol;
  212.   GotoXY(1, 22); ClrEol;
  213.   TextAttr := TextFarbe;
  214.   GotoXY(40 - Length(s1) DIV 2, 22);
  215.   Write(s1);
  216.   GotoXY(40 - Length(s1) DIV 2, 23);
  217.   Write(s2);
  218. END;
  219.  
  220. FUNCTION SpielEnde : BOOLEAN;
  221.                           { Gewinneranzeige und Endabfrage }
  222. VAR
  223.   s : STRING;
  224. BEGIN
  225.   s := 'Der Gewinner ist ' + Winner + ' !!';
  226.   PutText(s, 'Noch ein Spiel? <J>/<N>', Farbe[3]);
  227.   REPEAT UNTIL KeyPressed;
  228.   SpielEnde := NOT(UpCase(ReadKey) IN ['J', 'Y']);
  229. END;
  230.  
  231. FUNCTION NoMoreExplosion(VAR Tabelle : Verbund;
  232.                          Virtuell : BOOLEAN) : BOOLEAN;
  233. VAR
  234.   NoChange : BOOLEAN;
  235.   x, y     : BYTE;
  236.  
  237.   PROCEDURE Erhohen; { Nachbarstapel bei Explosion erhöhen }
  238.   BEGIN
  239.     Inc(Tabelle[x + 1, y].Wert);
  240.     Tabelle[x + 1, y].Farbe := Tabelle[x, y].Farbe;
  241.     Inc(Tabelle[x - 1, y].Wert);
  242.     Tabelle[x - 1, y].Farbe := Tabelle[x, y].Farbe;
  243.     Inc(Tabelle[x, y + 1].Wert);
  244.     Tabelle[x, y + 1].Farbe := Tabelle[x, y].Farbe;
  245.     Inc(Tabelle[x, y - 1].Wert);
  246.     Tabelle[x, y - 1].Farbe := Tabelle[x, y].Farbe;
  247.   END;
  248.  
  249.   PROCEDURE Is_Explosion(Subtraktor : SHORTINT);
  250.                              { checken, ob Feld explodiert }
  251.   BEGIN
  252.     IF Tabelle[x, y].Wert >= Subtraktor THEN BEGIN
  253.       Erhohen;
  254.       Tabelle[x, y].Wert := Tabelle[x, y].Wert - Subtraktor;
  255.       IF Tabelle[x, y].Wert = 0 THEN
  256.         Tabelle[x, y].Farbe := Farbe[3];
  257.       NoChange := FALSE;
  258.       IF NOT Virtuell THEN BEGIN
  259.         ShowTabelle;
  260.         Sound(100);
  261.         Delay(1);
  262.         NoSound;
  263.         Delay(300);
  264.       END;
  265.     END;
  266.   END;
  267.  
  268. BEGIN                              { Start NoMoreExplosion }
  269.   NoChange := TRUE;
  270.   FOR x := 1 TO 4 DO
  271.     FOR y := 1 TO 4 DO Is_Explosion(4);
  272.   x := 0;
  273.   FOR y := 1 TO 4 DO Is_Explosion(3);
  274.   y := 0;
  275.   Is_Explosion(2);
  276.   y := 5;
  277.   Is_Explosion(2);
  278.   x := 5;
  279.   FOR y := 1 TO 4 DO Is_Explosion(3);
  280.   y := 0;
  281.   Is_Explosion(2);
  282.   y := 5;
  283.   Is_Explosion(2);
  284.   y := 0;
  285.   FOR x := 1 TO 4 DO Is_Explosion(3);
  286.   y := 5;
  287.   FOR x := 1 TO 4 DO Is_Explosion(3);
  288.   NoMoreExplosion := NoChange;
  289. END;
  290.  
  291. PROCEDURE Explosion(VAR Tabelle : Verbund);
  292.                      { Hauptschleife für Explosionsabfrage }
  293. BEGIN
  294.   REPEAT
  295.     IF Total(Tabelle, Farbe[1]) = 0 THEN Winner := Name[2];
  296.     IF Total(Tabelle, Farbe[2]) = 0 THEN Winner := Name[1];
  297.   UNTIL (Winner <> '') OR (NoMoreExplosion(Tabelle, FALSE));
  298.   ShowTabelle;
  299.   Delay(500);
  300. END;
  301.  
  302. PROCEDURE VirExplosion(VAR Tabelle : Verbund);
  303.    { "virtuelle" Explosion für Zugvorausberechnung des PCs }
  304. BEGIN
  305.   REPEAT
  306.   UNTIL NoMoreExplosion(Tabelle, TRUE)
  307.     OR (Total(Tabelle, Farbe[1]) = 0)
  308.     OR (Total(Tabelle, Farbe[2]) = 0);
  309. END;
  310.  
  311. {$F+}PROCEDURE Computer1(Zahl : BYTE);{$F-}
  312.    { Computerspieler zieht: Algorithmus aus toolbox 7/8'91 }
  313. VAR
  314.   VirFeld : Verbund;
  315.   x, y, MaxX, MaxY, MaxWert, Tot : BYTE;
  316. BEGIN
  317.   MaxWert := 0;
  318.   MaxX    := 2;
  319.   MaxY    := 2;
  320.   TextAttr := Farbe[Zahl];
  321.   GotoXY(1, 25);
  322.   PutText('Standard-Algorithmus setzt!', '', Farbe[Zahl]);
  323.   FOR x := 0 TO 5 DO BEGIN
  324.     FOR y := 0 TO 5 DO BEGIN
  325.       VirFeld := Feld;
  326.       IF VirFeld[x,y].Farbe IN [Farbe[Zahl], Farbe[3]] THEN
  327.       BEGIN
  328.         Inc(VirFeld[x, y].Wert);
  329.         VirFeld[x, y].Farbe := Farbe[Zahl];
  330.         VirExplosion(VirFeld);
  331.         Tot := PointTotal(VirFeld, Farbe[Zahl]);
  332.         IF (Tot > MaxWert) OR
  333.           ((Tot = MaxWert) AND (Random > 0.75)) THEN BEGIN
  334.           MaxWert := Tot;
  335.           MaxX    := x;
  336.           MaxY    := y;
  337.         END;
  338.       END;
  339.     END;
  340.   END;
  341.   Position[Zahl].x := MaxX;
  342.   Position[Zahl].y := MaxY;
  343.   Blink(MaxX, MaxY);                        { Zug anzeigen }
  344.   Delay(1200);
  345.   Blink(MaxX, MaxY);
  346.   Inc(Feld[MaxX, MaxY].Wert);
  347.   Feld[MaxX, MaxY].Farbe := Farbe[Zahl];
  348.   ShowTabelle;
  349.   Explosion(Feld);
  350. END;
  351.  
  352. {$F+}PROCEDURE Computer2(Zahl : BYTE);        {$F-}
  353.           { Computerspieler zieht: Verbesserte Version des }
  354.           { Computer-Algorithmus aus dem Heft              }
  355. TYPE
  356.   StackType = RECORD
  357.                 x, y : BYTE;
  358.               END;
  359. VAR
  360.   x, y, r : BYTE;
  361.   MinWert : BYTE;
  362.   VirFeld : Verbund;
  363.   Summe : ARRAY[0..5, 0..5] OF BYTE;
  364.   Stack : ARRAY[1..36] OF StackType;
  365.   StackPtr : BYTE;
  366.  
  367.   PROCEDURE MacheZug(Zahl : BYTE; Feld : Verbund);
  368.   { Kernprozedur der Rechnerstrategie; diese Prozedur           }
  369.   { spielt einen virtuellen Zug für einen beliebigen            }
  370.   { Spieler durch                                               }
  371.   VAR
  372.     x, y : BYTE;
  373.     VirFeld : Verbund;
  374.     Tot : BYTE;
  375.   BEGIN
  376.     FOR x := 0 TO 5 DO
  377.       FOR y := 0 TO 5 DO BEGIN
  378.         VirFeld := Feld;                   { Spielfeld kopieren }
  379.         IF VirFeld[x,y].Farbe IN [Farbe[Zahl], Farbe[3]] THEN
  380.         BEGIN
  381.         { virtueller Zug, wenn das Feld vom Spieler besetzt ist }
  382.         { oder noch unbelegt ist }
  383.           Inc(VirFeld[x, y].Wert);           { Feldwert erhöhen }
  384.           VirFeld[x, y].Farbe := Farbe[Zahl];    { Farbe setzen }
  385.           VirExplosion(VirFeld);        { Check auf Explosionen }
  386.                                             { Minimalauswertung }
  387.           IF Feld[x, y].Farbe IN [Farbe[Zahl], Farbe[3]] THEN
  388.           BEGIN
  389.             Tot := PointTotal(VirFeld, Farbe[Zahl]);
  390.                                      { Summierung des Resultats }
  391.             IF Tot <= MinWert THEN
  392.               MinWert := Tot;
  393.           END;
  394.         END;  { FOR }
  395.       END;
  396.   END;   { MacheZug }
  397.  
  398. BEGIN
  399.   TextAttr := Farbe[Zahl];
  400.   GotoXY(1, 25);
  401.   PutText('"Volon-Tier"-Algorithmus setzt!', '', Farbe[Zahl]);
  402.  
  403.   FOR x := 0 TO 5 DO
  404.     FOR y := 0 TO 5 DO BEGIN
  405.       Summe[x, y] := 255;            { Feldoptimum löschen }
  406.       VirFeld := Feld;                { Spielfeld kopieren }
  407.       IF VirFeld[x, y].Farbe IN [Farbe[Zahl], Farbe[3]] THEN
  408.       BEGIN
  409.         Inc(VirFeld[x, y].Wert);            { eins erhöhen }
  410.         VirFeld[x, y].Farbe := Farbe[Zahl]; { +ggf. färben }
  411.         VirExplosion(VirFeld);
  412.         MinWert := 255;
  413.         MacheZug(Zahl XOR 3, VirFeld);
  414.                            { alle Züge des Gegners checken }
  415.         Summe[x, y] := MinWert;  { schlechtestes Ergebnis }
  416.                                  { des Gegners speichern  }
  417.       END;
  418.     END;
  419.                           { Auswertung der Tabelle "Total" }
  420.   MinWert := 255;
  421.   StackPtr := 0;
  422.   FOR x := 0 TO 5 DO
  423.     FOR y := 0 TO 5 DO
  424.       IF Summe[x, y] <= MinWert THEN BEGIN
  425.         IF Summe[x, y] < MinWert THEN
  426.           StackPtr := 1;
  427.         IF Summe[x, y] = MinWert THEN
  428.           Inc(StackPtr);
  429.         Stack[StackPtr].x := x;
  430.         Stack[StackPtr].y := y;
  431.         MinWert := Summe[x, y];
  432.       END;
  433.  
  434.   r := Random(StackPtr) + 1;
  435.   Position[Zahl].x := Stack[r].x;
  436.   Position[Zahl].y := Stack[r].y;
  437.   Blink(Stack[r].x, Stack[r].y);                        { Zug anzeigen }
  438.   Delay(1200);
  439.   Blink(Stack[r].x, Stack[r].y);                        { Zug anzeigen }
  440.   Inc(Feld[Stack[r].x, Stack[r].y].Wert);
  441.   Feld[Stack[r].x, Stack[r].y].Farbe := Farbe[Zahl];
  442.   ShowTabelle;
  443.   Explosion(Feld);
  444. END;
  445.  
  446. {$F+}PROCEDURE Mensch(Zahl:BYTE);{$F-}
  447.                               { menschlicher Spieler zieht }
  448. BEGIN
  449.   PutText(Name[Zahl] + ', Sie sind am Setzen!', '',
  450.           Farbe[Zahl]);
  451.   REPEAT
  452.     Eingabe(Zahl);
  453.   UNTIL Feld[Position[Zahl].x, Position[Zahl].y].Farbe
  454.         IN [Farbe[Zahl],Farbe[3]];
  455.   Inc(Feld[Position[Zahl].x, Position[Zahl].y].Wert);
  456.   Feld[Position[Zahl].x, Position[Zahl].y].Farbe :=
  457.     Farbe[Zahl];
  458.   ShowTabelle;
  459.   Delay(350);
  460.   Explosion(Feld);
  461. END;
  462.  
  463. BEGIN                                      { Hauptprogramm }
  464.   AltAttr := TextAttr;
  465.   Randomize;
  466.   SpielBeginn;
  467.   SpielerA := Mensch;
  468.   IF Name[1] = 'PC1' THEN SpielerA := Computer1;
  469.   IF Name[1] = 'PC2' THEN SpielerA := Computer2;
  470.   SpielerB := Mensch;
  471.   IF Name[2] = 'PC1' THEN SpielerB := Computer1;
  472.   IF Name[2] = 'PC2' THEN SpielerB := Computer2;
  473.  
  474.   REPEAT
  475.     Position[1].x := 2; Position[1].y := 2;
  476.     Position[2].x := 3; Position[2].y := 3;
  477.     InitBildschirm;
  478.     Cursor(FALSE);
  479.     InitTabelle(Feld);
  480.     ShowTabelle;
  481.     Winner := '';
  482.     SpielerA(1);
  483.     Winner := '';
  484.     REPEAT
  485.       SpielerB(2);
  486.       IF Winner = '' THEN SpielerA(1);
  487.     UNTIL Winner <> '';
  488.   UNTIL SpielEnde;
  489.   Ende;
  490. END.
  491. (* ------------------------------------------------------ *)
  492. (*                 Ende von EXPKLUG.PAS                   *)
  493.