home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 07_08 / bonus / explode / explode2.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-06-07  |  21.7 KB  |  691 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   EXPLODE2.PAS                         *)
  3. (*            Strategiespiel Explode Plus                 *)
  4. (*                 Turbo Pascal ab 5.5                    *)
  5. (*             (c) 1991 Patrick Filipaj                   *)
  6. (* ------------------------------------------------------ *)
  7. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-}
  8.  
  9. PROGRAM Explode2;
  10.  
  11. {$DEFINE BGILINK}
  12.  
  13. (* Der Schalter "BGILINK" setzt die bedingte Compilierung für das
  14.    Einlinken der BGI-Treiber und des Triplex-Vektorfonts. Wenn Sie
  15.    von dieser Möglichkeit Gebrauch machen möchten, müssen Sie die
  16.    Units "Drivers" und "Fonts" compilieren, die zum Lieferumfang
  17.    von Turbo Pascal gehören. Genauere Informationen über das Linken
  18.    des Grafikpakets und der Zeichensätz finden Sie in den Quellcodes
  19.    der beiden Units. Bitte beachten Sie, daß das Einbinden der
  20.    Treiber und des Vektorfonts die Größe des EXE-Files um zirka
  21.    30 kByte aufbläht!
  22.  
  23.    Wenn der Schalter "BGILINK" nicht gesetzt ist (löschen Sie dazu
  24.    einfach die Zeile "{$DEFINE BGILINK}"), wird das Grafikpaket
  25.    auf herkömmliche Art und Weise installiert. Bitte beachten Sie,
  26.    daß "InitGraph" die BGI-Treiber und Vektorfonts in dem Verzeichnis
  27.    sucht, daß mittels der Umgebungsvariable "BGIPATH" definiert ist.
  28.    Um diesen Pfad zu definieren, geben Sie ihn einfach auf der
  29.    Kommandozeile an:
  30.    SET BGIPATH = {PFAD}
  31.  
  32.    Beispiel:
  33.    SET BGIPATH = C:\TP\BGI
  34.  
  35.    Wenn das Programm keine entsprechende  Variable im Umgebungsbereich
  36.    findet, sucht es die Treiber im aktuellen Verzeichnis. *)
  37.  
  38. USES  Graph,Crt,
  39. {$IFDEF BGILINK}
  40.       Drivers,Fonts,
  41. {$ENDIF}
  42.       Dos;
  43.  
  44. TYPE
  45.   Location   = RECORD
  46.                  X, Y : SHORTINT;
  47.                END;
  48.   Zelle      = RECORD                { symbolisiert 1 Spielfeld }
  49.                  Farbe : BYTE;
  50.                  Wert  : BYTE;
  51.                END;
  52.   Verbund    = ARRAY[-1..6,-1..6] OF Zelle;
  53.   Spieler    = PROCEDURE(Zahl:BYTE);
  54.   GroundFeld = ARRAY[1..10] OF INTEGER;
  55.   CursorFeld = ARRAY[1..10] OF INTEGER;
  56.   WurfelFeld = ARRAY[1..14] OF INTEGER;
  57.  
  58. VAR
  59.   Feld              : Verbund;        { Spielfläche, 6x6 Felder }
  60.   Position          : ARRAY[1..2] OF Location;
  61.   Name              : ARRAY[1..2] OF STRING[17];
  62.   SpielerA,SpielerB : Spieler;
  63.   Winner            : STRING;
  64.   Farbe             : ARRAY [0..3] OF BYTE;
  65.   F                 : BYTE;              { Vergrösserungsfaktor }
  66.   Visual            : SHORTINT;          { aktive Graphikseite  }
  67.   GraphDriver       : INTEGER;
  68.   GraphMode         : INTEGER;
  69.   Mouse             : BOOLEAN;      { Wenn Maus vorhanden: TRUE }
  70.   Regs              : Registers;                { Hilfsvariable }
  71.  
  72. CONST
  73.   Wait = 50;
  74.   UrWurfel : WurfelFeld =
  75.   (141, 153,  148, 149,  148, 141,  144, 134,
  76.    137, 138,  137, 146,  141, 153);
  77.  
  78.   UrCursor : CursorFeld =
  79.   (139, 160,  155, 151,  146, 135,  130, 144,  139, 160);
  80.  
  81.   UrGround : GroundFeld =
  82.   (139, 159,  234, 106,  181, 011,  086, 064,  139, 159);
  83.  
  84. PROCEDURE Ende;
  85. BEGIN
  86.   CloseGraph;
  87.   Halt;
  88. END;
  89.  
  90. PROCEDURE ShowMouse;
  91. { Macht Mauspfeil auf dem Bildschirm sichtbar                   }
  92. BEGIN
  93.   Regs.AX := 1;
  94.   Intr($33, Regs);
  95. END;
  96.  
  97. PROCEDURE HideMouse;
  98. { Macht Mauspfeil unsichtbar                                    }
  99. BEGIN
  100.   Regs.AX := 2;
  101.   Intr($33, Regs);
  102. END;
  103.  
  104. PROCEDURE PutMouse(X, Y : WORD);
  105. { Setzt den Mauszeiger an eine bestimmte Position               }
  106. BEGIN
  107.   Regs.AX := 4;
  108.   Regs.CX := X;
  109.   Regs.DX := Y;
  110.   Intr($33, Regs);
  111. END;
  112.  
  113. FUNCTION MausVorhanden : BOOLEAN;
  114. { Testet, ob Maus angeschlossen ist, führt Mausreset durch      }
  115. BEGIN
  116.   Regs.AX := 0;
  117.   Intr($33, Regs);
  118.   MausVorhanden := (Regs.AX <> 0);
  119. END;
  120.  
  121. PROCEDURE SetMouseScreen(Seite : BYTE);
  122. { Bestimmt den aktuellen Mausbildschirmseite, ähnlich den       }
  123. { verschiedenen Bildschirmseiten bei den Videokarten            }
  124. BEGIN
  125.   Regs.AX := $1D;
  126.   Regs.BX := Seite;
  127.   Intr($33, Regs);
  128. END;
  129.  
  130. PROCEDURE SpielBeginn;
  131. VAR ch : CHAR;
  132.     n  : BYTE;
  133. BEGIN
  134.   TextBackground(0);
  135.   TextColor(7);
  136.   ClrScr;
  137.   GotoXY(18, 1);
  138.   WriteLn('* * * * * * * * * * * * * * * * * * * * * *');
  139.   GotoXY(18, 2);
  140.   WriteLn('* * * *   E X P L O D E   P L U S   * * * *');
  141.   GotoXY(18, 3);
  142.   WriteLn('* * * * * * * * * * * * * * * * * * * * * *');
  143.   GotoXY(18, 8);
  144.   WriteLn('* * (c) 1991  Patrick Filipaj & toolbox * *');
  145.   GotoXY(18, 17);
  146.   Write('Computerspieler: "PC1" = alte, "PC2" = neue Strategie');
  147.   GotoXY(18, 14);
  148.   Write('Name Spieler A: '); ReadLn(Name[1]);
  149.   GotoXY(18, 15);
  150.   Write('Name Spieler B: '); ReadLn(Name[2]);
  151.   IF Name[1] = '' THEN Name[1] := ' ';
  152.   IF Name[2] = '' THEN Name[2] := ' ';
  153.   FOR n := 1 TO Length(Name[1]) DO
  154.     Name[1][n] := UpCase(Name[1][n]);
  155.   FOR n := 1 TO Length(Name[2]) DO
  156.     Name[2][n] := UpCase(Name[2][n]);
  157.   WriteLn;
  158.   IF MausVorhanden THEN BEGIN
  159.     GotoXY(18, 19);
  160.     Write('Soll mit der Maus gespielt werden? <J>/<N>  ');
  161.     REPEAT UNTIL KeyPressed;
  162.     ch := ReadKey;
  163.     Mouse := ch IN ['Y', 'y', 'J', 'j', #13];
  164.   END;
  165. END;
  166.  
  167. PROCEDURE Abort(Message : STRING);
  168. BEGIN
  169.   WriteLn;
  170.   WriteLn(Message, ^G);
  171.   Halt(2);
  172. END;
  173.  
  174. PROCEDURE InitBildschirm;
  175. { Initialisiert Graphikmodus, setzt Vergrösserungsfaktor,       }
  176. { setzt Textattribute (TextStyle ...)                           }
  177. CONST
  178.   NoGrafics = 'Konnte Grafik nicht initialisieren!';
  179. BEGIN
  180.   DetectGraph(GraphDriver, GraphMode);
  181.   CASE GraphDriver OF
  182.     1, 2 : BEGIN
  183.              F := 1;
  184.              Farbe[1] := 1;
  185.              Farbe[2] := 2;
  186.              Farbe[3] := 3;
  187.            END;
  188.     3, 9 : BEGIN
  189.              F := 2;
  190.              Farbe[1] := 2;
  191.              Farbe[2] := 4;
  192.              Farbe[3] := 7;
  193.            END;
  194.     ELSE   Abort('(M)CGA-, EGA256- oder VGA-Karte erforderlich');
  195.   END;
  196.   GraphMode := 1;
  197. {$IFDEF BGILINK}
  198. { bedingte Compilierung: BGI-Treiber und Vektorfont linken }
  199.   CASE GraphDriver OF
  200.     CGA,
  201.     MCGA:     IF RegisterBGIDriver(@CGADriverProc) < 0 THEN
  202.                 Abort(NoGrafics);
  203.     EGA,
  204.     VGA:      IF RegisterBGIDriver(@EGAVGADriverProc) < 0 THEN
  205.                 Abort(NoGrafics);
  206.     HercMono: IF RegisterBGIDriver(@HercDriverProc) < 0 THEN
  207.                 Abort(NoGrafics);
  208.   ELSE
  209.     Abort('(M)CGA-, EGA256- oder VGA-Karte erforderlich');
  210.   END;
  211.   IF RegisterBGIFont(@SmallFontProc) < 0 THEN
  212.     Abort('Konnte Vektorschrift nicht initialisieren!');
  213. {$ENDIF}
  214.   InitGraph(GraphDriver, GraphMode, GetEnv('BGIPATH'));
  215.   IF GraphResult <> 0 THEN
  216.     Abort(NoGrafics);
  217.   SetTextStyle(SmallFont, HorizDir, 5);
  218.   SetTextJustify(LeftText, CenterText);
  219.   Visual := 0;
  220. END;
  221.  
  222. PROCEDURE InitTabelle(VAR Tabelle : Verbund);
  223. { Setzt alle Felder auf 0 und belegt sie mit neutraler Farbe }
  224. VAR
  225.   i,j : BYTE;
  226. BEGIN
  227.   FOR i := 0 TO 5 DO BEGIN
  228.     FOR j := 0 TO 5 DO BEGIN
  229.       Tabelle[i,j].Wert  := 0;
  230.       Tabelle[i,j].Farbe := Farbe[3];
  231.     END;
  232.   END;
  233. END;
  234.  
  235. FUNCTION Total(Tabelle : Verbund; Color : BYTE) : BYTE;
  236. { Ermittelt Anzahl der Felder mit der Farbe "Color"             }
  237. VAR
  238.   X, Y, C : SHORTINT;
  239. BEGIN
  240.   C := 0;
  241.   FOR X := 0 TO 5 DO BEGIN
  242.     FOR Y := 0 TO 5 DO BEGIN
  243.       IF Tabelle[X,Y].Farbe = Color THEN Inc(C);
  244.     END;
  245.   END;
  246.   Total := C;
  247. END;
  248.  
  249. FUNCTION PointTotal(Tabelle : Verbund; Color : BYTE) : BYTE;
  250. { Ermittelt die Summe aller Feldwerte mit der in "Color"        }
  251. { festgelegten  Farbe                                           }
  252. VAR
  253.   X, Y, C : SHORTINT;
  254. BEGIN
  255.   C := 0;
  256.   FOR X := 0 TO 5 DO BEGIN
  257.     FOR Y := 0 TO 5 DO BEGIN
  258.       IF Tabelle[X,Y].Farbe = Color
  259.         THEN Inc(C,Tabelle[X,Y].Wert);
  260.     END;
  261.   END;
  262.   PointTotal := C;
  263. END;
  264.  
  265. PROCEDURE ShowTabelle(CursorNr : INTEGER);
  266. { Gibt aktuelles Spielfeld auf dem Bildschirm aus               }
  267. VAR
  268.   X, Y , i : BYTE;
  269.   Ground   : GroundFeld;
  270.   Cursor   : CursorFeld;
  271.   Wurfel   : WurfelFeld;
  272.   Hohe     : BYTE;
  273. BEGIN
  274.   IF (GraphDriver = CGA)              { Bei CGA wird Bildschirm-}
  275.     THEN Port[$3D8]:=Port[$3D8] XOR 8 { ausgabe unterdrückt,    }
  276.     ELSE SetActivePage(Visual XOR 1); { sonst aktuelle Graphik- }
  277.   SetColor(0);                        { seite gewechselt        }
  278.   SetFillStyle(SolidFill, 0);
  279.   Bar(84*F, 0, F*236, F*160);
  280.   SetFillStyle(SolidFill, 3);
  281.   Ground := GroundFeld(UrGround);             { Kopie erstellen }
  282.   FOR i := 1 TO 10 DO Ground[i] := Ground[i]*F;
  283.   FillPoly(5, Ground);
  284.   FOR i := 0 TO 6 DO BEGIN  { Spielfeldlinien werden gezeichnet }
  285.     Line(F*(139-i*9), F*(160-i*16), F*(235-i*9), F*(106-i*16));
  286.     Line(F*(85+i*16), F*(64-i*9), F*(139+i*16), F*(160-i*9));
  287.   END;
  288.   IF CursorNr IN [1, 2] THEN BEGIN
  289.     Cursor := CursorFeld(UrCursor);           { Kopie erstellen }
  290.     FOR i := 1 TO 5 DO BEGIN    { Cursorkoordinaten verschieben }
  291.       Cursor[i*2-1] := Cursor[i*2-1]+Position[CursorNr].X*16;
  292.       Cursor[i*2]   := Cursor[i*2] + Position[CursorNr].X*-9;
  293.       Cursor[i*2-1] := Cursor[i*2-1]+Position[CursorNr].Y*-9;
  294.       Cursor[i*2]   := Cursor[i*2] + Position[CursorNr].Y*-16;
  295.     END;
  296.     FOR i := 1 TO 10 DO Cursor[i] := Cursor[i]*F;
  297.     SetFillStyle(1, 0);
  298.     FillPoly(5, Cursor);
  299.   END;
  300.   FOR X := 5 DOWNTO 0 DO BEGIN
  301.     FOR Y := 5 DOWNTO 0 DO BEGIN
  302.       SetFillStyle(SolidFill, Feld[X, Y].Farbe);
  303.       SetColor(1);
  304.       FOR Hohe := 1 TO Feld[X, Y].Wert DO BEGIN
  305.         Wurfel := WurfelFeld(UrWurfel);       { Kopie erstellen }
  306.         FOR i := 1 TO 7 DO BEGIN  { Würfelkoordinaten verschieb.}
  307.           Wurfel[i*2-1] := Wurfel[i*2-1] + X *  16;
  308.           Wurfel[i*2]   := Wurfel[i*2]   + X *  -9;
  309.           Wurfel[i*2-1] := Wurfel[i*2-1] + Y *  -9;
  310.           Wurfel[i*2  ] := Wurfel[i*2  ] + Y * -16 - 8*(Hohe-1);
  311.         END;
  312.         FOR i := 1 TO 14 DO Wurfel[i] := Wurfel[i]*F;
  313.         FillPoly(7, Wurfel);
  314.         SetColor(0);
  315. {  nachfolgend werden die Kanten des Würfels nachgezeichnet     }
  316.         Line(Wurfel[1],Wurfel[2],Wurfel[3],Wurfel[4]);
  317.         Line(Wurfel[3],Wurfel[4],Wurfel[5],Wurfel[6]);
  318.         Line(Wurfel[5],Wurfel[6],Wurfel[7],Wurfel[8]);
  319.         Line(Wurfel[7],Wurfel[8],Wurfel[9],Wurfel[10]);
  320.         Line(Wurfel[9],Wurfel[10],Wurfel[11],Wurfel[12]);
  321.         Line(Wurfel[13],Wurfel[14],Wurfel[11],Wurfel[12]);
  322.         Line(Wurfel[1],Wurfel[2],Wurfel[1],Wurfel[2]-F*8);
  323.         Line(Wurfel[5],Wurfel[6],Wurfel[1],Wurfel[2]-F*8);
  324.         Line(Wurfel[9],Wurfel[10],Wurfel[1],Wurfel[2]-F*8);
  325.       END;
  326.     END;
  327.   END;
  328.   IF GraphDriver = CGA
  329.   THEN Port[$3D8]:=Port[$3D8] XOR 8    { Bildschirmaufbau       }
  330.   ELSE BEGIN                           { wieder aktivieren;     }
  331.     Visual := Visual XOR 1;            { Bei VGA sichtbare Gra- }
  332.     SetVisualPage(Visual);             { phikseite wechseln     }
  333.   END;
  334. END;
  335.  
  336. PROCEDURE PutText(s1, s2 : STRING; TextFarbe : BYTE);
  337. { Hilfsprozedur für die Ausgabe von Spielkommentaren            }
  338. VAR
  339.   i : INTEGER;
  340. BEGIN
  341.   SetFillStyle(SolidFill, 0);
  342.   FOR i := 1 TO 2 DO BEGIN
  343.     SetColor(0);
  344.     Bar(0, F*161, F*319, 50+149*F);
  345.     SetColor(TextFarbe);
  346.     OutTextXY(10, 20+152*F, s1);
  347.     OutTextXY(10, 35+152*F, s2);
  348.     IF (GraphDriver = CGA) THEN Port[$3D8]:=Port[$3D8] XOR 8
  349.     ELSE SetActivePage(Visual XOR 1);
  350.   END;
  351. END;
  352.  
  353. PROCEDURE TastaturEingabe(CursorNummer : BYTE);
  354. { Fragt nach neuer Cursorposition, bei <ESC> Spielende          }
  355. VAR
  356.   X, Y : SHORTINT;
  357.   Chr  : CHAR;
  358. BEGIN
  359.   X := Position[CursorNummer].X;
  360.   Y := Position[CursorNummer].Y;
  361.   REPEAT
  362.     ShowTabelle(CursorNummer);
  363.     REPEAT
  364.       REPEAT UNTIL KeyPressed;
  365.       Chr:=ReadKey;
  366.       IF Chr=#0 THEN Chr := ReadKey;
  367.     UNTIL Chr IN [#13,#72,#75,#77,#80,#27];
  368.     CASE Chr OF
  369.       #72 : Inc(Y);  #75 : Dec(X);  #77 : Inc(X);
  370.       #80 : Dec(Y);  #27 : Ende;    END;
  371.     IF X > 5 THEN X := 5;
  372.     IF X < 0 THEN X := 0;
  373.     IF Y < 0 THEN Y := 0;
  374.     IF Y > 5 THEN Y := 5;
  375.     Position[CursorNummer].X := X;
  376.     Position[CursorNummer].Y := Y;
  377.   UNTIL Chr = #13;
  378. END;
  379.  
  380. PROCEDURE MausEingabe(Nr : BYTE);
  381. { Die Mausposition beim Niederdrücken des linken Buttons wird   }
  382. { ermittelt; anschliessend wird geprüft, ob diese Position auf  }
  383. { einem der 6x6 Spielfelder liegt                               }
  384. VAR
  385.   X1, Y1 : INTEGER;                     { Absolute Mausposition }
  386.   X2, Y2 : REAL;  { Mausposition nach Drehen in die Orthogonale }
  387.   sa, sb : STRING;
  388. BEGIN
  389.   SetMouseScreen(Visual);
  390.   PutMouse((143 + 16*Position[Nr].X -  9*Position[Nr].Y) * 2,
  391.            (147 -  9*Position[Nr].X - 16*Position[Nr].Y) * F);
  392.   ShowMouse;
  393.   REPEAT
  394.     REPEAT
  395.       Regs.AX := 3;
  396.       Intr($33, Regs);
  397.       IF (KeyPressed AND (ReadKey = #27)) THEN Ende;
  398.     UNTIL (Regs.BX MOD 2) = 1;
  399.     X1 := Regs.CX -139 * 2;
  400.     Y1 := Regs.DX -159 * F;
  401.     X2 := ( X1 * 0.8716 / 2 - Y1 * 0.4903 / F) / 18.3576;
  402.     Y2 := (-X1 * 0.4903 / 2 - Y1 * 0.8716 / F) / 18.3576;
  403. { In den oberen beiden Zeilen wurden die X- bzw. Y-Koordinaten  }
  404. { um ca. 30 Grad nach rechts gedreht --> ermöglicht einfachere  }
  405. { Positionsüberprüfung der Eingabe                              }
  406.     SetActivePage(Visual);
  407.   UNTIL (X2 > 0) AND (X2 < 6)
  408.     AND (Frac(X2) > 0.1) AND (Frac(X2) < 0.9)
  409.     AND (Y2 > 0) AND (Y2 < 6)
  410.     AND (Frac(Y2) > 0.1) AND (Frac(Y2) < 0.9);
  411. { Im obstehenden 'Rattenschwanz' wurde überprüft, ob sich die   }
  412. { Maus überhaupt im Spielfeld befand                            }
  413.   Position[Nr].X := Trunc(X2);
  414.   Position[Nr].Y := Trunc(Y2);
  415.   HideMouse;
  416. END;
  417.  
  418. FUNCTION SpielEnde : BOOLEAN;
  419. { Fragt, ob neues Spiel gestartet werden soll                   }
  420. VAR
  421.   s : STRING;
  422. BEGIN
  423.   s := 'Der Gewinner ist ' + Winner + '.               ';
  424.   PutText(s, 'Noch ein Spiel?  (<J>/<N>)', Farbe[3]);
  425.   REPEAT UNTIL KeyPressed;
  426.   SpielEnde := NOT(ReadKey IN ['y','j','Y','J']);
  427.   CloseGraph;
  428. END;
  429.  
  430. FUNCTION NoMoreExplosion(VAR Tabelle  : Verbund;
  431.                              Virtuell : BOOLEAN) : BOOLEAN;
  432. VAR
  433.   NoChange : BOOLEAN;
  434.   X, Y     : BYTE;
  435.  
  436.   PROCEDURE Erhohen;
  437.   { Erhöht Nachbarfelder des explodierenden Feldes und belegt   }
  438.   { sie mit der Farbe des explodierten Feldes                   }
  439.   BEGIN
  440.     Inc(Tabelle[X+1,Y].Wert);
  441.     Tabelle[X+1,Y].Farbe := Tabelle[X,Y].Farbe;
  442.     Inc(Tabelle[X-1,Y].Wert);
  443.     Tabelle[X-1,Y].Farbe := Tabelle[X,Y].Farbe;
  444.     Inc(Tabelle[X,Y+1].Wert);
  445.     Tabelle[X,Y+1].Farbe := Tabelle[X,Y].Farbe;
  446.     Inc(Tabelle[X,Y-1].Wert);
  447.     Tabelle[X,Y-1].Farbe := Tabelle[X,Y].Farbe;
  448.   END;
  449.  
  450.   PROCEDURE Is_Explosion(Subtraktor : SHORTINT);
  451.   { Testet, ob der Explosionsgrenzwert erreicht ist             }
  452.   BEGIN
  453.     IF Tabelle[X,Y].Wert  >= Subtraktor THEN BEGIN
  454.       Erhohen;
  455.       Tabelle[X,Y].Wert   := Tabelle[X,Y].Wert-Subtraktor;
  456.       IF Tabelle[X,Y].Wert = 0 THEN Tabelle[X,Y].Farbe := Farbe[3];
  457.       NoChange            := FALSE;
  458.       IF NOT Virtuell THEN BEGIN
  459.         ShowTabelle(0);
  460.         Delay(Wait * 7);
  461.       END;
  462.     END
  463.   END;
  464.  
  465. BEGIN
  466.   NoChange := TRUE;
  467.   FOR X:=1 TO 4 DO BEGIN
  468.     FOR Y:=1 TO 4 DO Is_Explosion(4);
  469.   END;
  470.   X := 0;
  471.   FOR Y:=1 TO 4 DO Is_Explosion(3);
  472.   Y := 0;
  473.   Is_Explosion(2);
  474.   Y := 5;
  475.   Is_Explosion(2);
  476.   X := 5;
  477.   FOR Y:=1 TO 4 DO Is_Explosion(3);
  478.   Y := 0;
  479.   Is_Explosion(2);
  480.   Y := 5;
  481.   Is_Explosion(2);
  482.   Y := 0;
  483.   FOR X := 1 TO 4 DO Is_Explosion(3);
  484.   Y := 5;
  485.   FOR X := 1 TO 4 DO Is_Explosion(3);
  486.   NoMoreExplosion := NoChange;
  487. END;
  488.  
  489. {$B+}
  490. PROCEDURE Explosion(VAR Tabelle : Verbund);
  491. { Testet, ob Spielende erreicht ist; ruft Funktion              }
  492. { NoMoreExplosion auf                                           }
  493. BEGIN
  494.   REPEAT
  495.     IF Total(Tabelle,Farbe[2]) = 0 THEN Winner := Name[1];
  496.     IF Total(Tabelle,Farbe[1]) = 0 THEN Winner := Name[2];
  497.   UNTIL (Winner <> '') OR (NoMoreExplosion(Tabelle,FALSE));
  498. END;
  499. {$B-}
  500.  
  501. PROCEDURE VirExplosion(VAR Tabelle : Verbund);
  502. { Ähnlich wie Prozedur Explosion; Explosionen werden jedoch     }
  503. { in einem virtuellen Feld, nämlich VirFeld, ausgeführt         }
  504. BEGIN
  505.   REPEAT UNTIL NoMoreExplosion(Tabelle,TRUE)
  506.     OR (Total(Tabelle,Farbe[1]) = 0)
  507.     OR (Total(Tabelle,Farbe[2]) = 0);
  508. END;
  509.  
  510. {$F+}PROCEDURE Computer1(Zahl:BYTE);{$F-}
  511. { Simuliert einen Spieler                                       }
  512. VAR
  513.   VirFeld : Verbund;
  514.   X, Y, MaxX, MaxY, MaxWert, Tot : BYTE;
  515. BEGIN
  516.   IF KeyPressed THEN
  517.     IF ReadKey = #27 THEN
  518.       Ende;
  519.   MaxWert := 0;
  520.   MaxX    := 2;
  521.   MaxY    := 2;
  522.   PutText('Der Computer ist am Setzen.','',Farbe[Zahl]);
  523.   FOR X := 0 TO 5 DO BEGIN
  524.     FOR Y := 0 TO 5 DO BEGIN
  525.       VirFeld := Feld;
  526.       IF VirFeld[X,Y].Farbe IN [Farbe[Zahl],Farbe[3]] THEN BEGIN
  527.         Inc(VirFeld[X,Y].Wert);
  528.         VirFeld[X,Y].Farbe := Farbe[Zahl];
  529.         VirExplosion(VirFeld);
  530.         Tot := PointTotal(VirFeld,Farbe[Zahl]);
  531.         IF (Tot > MaxWert) OR
  532.           ((Tot = MaxWert) AND (Random > 0.75)) THEN BEGIN
  533.           MaxWert := Tot;
  534.           MaxX    := X;
  535.           MaxY    := Y;
  536.         END   ELSE BEGIN END;
  537.       END   ELSE BEGIN END;
  538.     END;
  539.   END;
  540.   Position[Zahl].X := MaxX;
  541.   Position[Zahl].Y := MaxY;
  542.   ShowTabelle(Zahl);
  543.   Delay(10 * Wait);
  544.   Inc(Feld[MaxX,MaxY].Wert);
  545.   Feld[MaxX,MaxY].Farbe := Farbe[Zahl];
  546.   ShowTabelle(Zahl);
  547.   Delay(10 * Wait);
  548.   Explosion(Feld);
  549. END;
  550.  
  551. {$F+}PROCEDURE Mensch(Zahl:BYTE);{$F-}
  552. { Ruft Prozedur Eingabe auf und testet, ob zurückgelieferte     }
  553. { Cursorposition zulässig ist                                   }
  554. BEGIN
  555.   PutText(Name[Zahl] + ', Sie sind am Setzen.','',Farbe[Zahl]);
  556.   REPEAT
  557.     IF Mouse THEN MausEingabe(Zahl)
  558.              ELSE TastaturEingabe(Zahl);
  559.   UNTIL Feld[Position[Zahl].X,Position[Zahl].Y].Farbe
  560.                                    IN [Farbe[Zahl],Farbe[3]];
  561.   Inc(Feld[Position[Zahl].X,Position[Zahl].Y].Wert);
  562.   Feld[Position[Zahl].X,Position[Zahl].Y].Farbe :=
  563.                                            Farbe[Zahl];
  564.   IF MausVorhanden THEN ShowTabelle(0)
  565.                    ELSE ShowTabelle(Zahl);
  566.   Delay(5 * Wait);
  567.   Explosion(Feld);
  568. END;
  569.  
  570. {$F+}PROCEDURE Computer2(Zahl : BYTE);        {$F-}
  571.           { Computerspieler zieht: Verbesserte Version des }
  572.           { Computer-Algorithmus aus dem Heft              }
  573. TYPE
  574.   StackType = RECORD
  575.                 x, y : BYTE;
  576.               END;
  577. VAR
  578.   x, y, r : BYTE;
  579.   MinWert : BYTE;
  580.   VirFeld : Verbund;
  581.   Summe : ARRAY[0..5, 0..5] OF BYTE;
  582.   Stack : ARRAY[1..36] OF StackType;
  583.   StackPtr : BYTE;
  584.  
  585.   PROCEDURE MacheZug(Zahl : BYTE; Feld : Verbund);
  586.   { Kernprozedur der Rechnerstrategie; diese Prozedur           }
  587.   { spielt einen virtuellen Zug für einen beliebigen            }
  588.   { Spieler durch                                               }
  589.   VAR
  590.     x, y : BYTE;
  591.     VirFeld : Verbund;
  592.     Tot : BYTE;
  593.   BEGIN
  594.     FOR x := 0 TO 5 DO
  595.       FOR y := 0 TO 5 DO BEGIN
  596.         VirFeld := Feld;                   { Spielfeld kopieren }
  597.         IF VirFeld[x,y].Farbe IN [Farbe[Zahl], Farbe[3]] THEN
  598.         BEGIN
  599.         { virtueller Zug, wenn das Feld vom Spieler besetzt ist }
  600.         { oder noch unbelegt ist }
  601.           Inc(VirFeld[x, y].Wert);           { Feldwert erhöhen }
  602.           VirFeld[x, y].Farbe := Farbe[Zahl];    { Farbe setzen }
  603.           VirExplosion(VirFeld);        { Check auf Explosionen }
  604.                                             { Minimalauswertung }
  605.           IF Feld[x, y].Farbe IN [Farbe[Zahl], Farbe[3]] THEN
  606.           BEGIN
  607.             Tot := PointTotal(VirFeld, Farbe[Zahl]);
  608.                                      { Summierung des Resultats }
  609.             IF Tot <= MinWert THEN
  610.               MinWert := Tot;
  611.           END;
  612.         END;  { FOR }
  613.       END;
  614.   END;   { MacheZug }
  615.  
  616. BEGIN
  617.   TextAttr := Farbe[Zahl];
  618.   GotoXY(1, 25);
  619.   PutText('Volon-Tier-Algorithmus setzt.', '', Farbe[Zahl]);
  620.  
  621.   FOR x := 0 TO 5 DO
  622.     FOR y := 0 TO 5 DO BEGIN
  623.       Summe[x, y] := 255;            { Feldoptimum löschen }
  624.       VirFeld := Feld;                { Spielfeld kopieren }
  625.       IF VirFeld[x, y].Farbe IN [Farbe[Zahl], Farbe[3]] THEN
  626.       BEGIN
  627.         Inc(VirFeld[x, y].Wert);            { eins erhöhen }
  628.         VirFeld[x, y].Farbe := Farbe[Zahl]; { +ggf. färben }
  629.         VirExplosion(VirFeld);
  630.         MinWert := 255;
  631.         MacheZug(Zahl XOR 3, VirFeld);
  632.                            { alle Züge des Gegners checken }
  633.         Summe[x, y] := MinWert;  { schlechtestes Ergebnis }
  634.                                  { des Gegners speichern  }
  635.       END;
  636.     END;
  637.                           { Auswertung der Tabelle "Total" }
  638.   MinWert := 255;
  639.   StackPtr := 0;
  640.   FOR x := 0 TO 5 DO
  641.     FOR y := 0 TO 5 DO
  642.       IF Summe[x, y] <= MinWert THEN BEGIN
  643.         IF Summe[x, y] < MinWert THEN
  644.           StackPtr := 1;
  645.         IF Summe[x, y] = MinWert THEN
  646.           Inc(StackPtr);
  647.         Stack[StackPtr].x := x;
  648.         Stack[StackPtr].y := y;
  649.         MinWert := Summe[x, y];
  650.       END;
  651.  
  652.   r := Random(StackPtr) + 1;
  653.   Position[Zahl].x := Stack[r].x;
  654.   Position[Zahl].y := Stack[r].y;
  655.   ShowTabelle(Zahl);                                    { Zug anzeigen }
  656.   Delay(10 * Wait);
  657.   Inc(Feld[Stack[r].x, Stack[r].y].Wert);
  658.   Feld[Stack[r].x, Stack[r].y].Farbe := Farbe[Zahl];
  659.   ShowTabelle(Zahl);
  660.   Delay(10 * Wait);
  661.   Explosion(Feld);
  662. END;
  663.  
  664. BEGIN
  665.   Randomize;
  666.   Spielbeginn;
  667.   SpielerA := Mensch;
  668.   IF Name[1] = 'PC1' THEN SpielerA := Computer1;
  669.   IF Name[1] = 'PC2' THEN SpielerA := Computer2;
  670.   SpielerB := Mensch;
  671.   IF Name[2] = 'PC1' THEN SpielerB := Computer1;
  672.   IF Name[2] = 'PC2' THEN SpielerB := Computer2;
  673.   REPEAT
  674.     Position[1].X := 3;    Position[1].Y := 3;
  675.     Position[2].X := 2;    Position[2].Y := 3;
  676.     InitBildschirm;
  677.     InitTabelle(Feld);
  678.     ShowTabelle(0);
  679.     Winner := '';
  680.     SpielerA(1);
  681.     Winner := '';
  682.     REPEAT
  683.       SpielerB(2);
  684.       IF Winner = '' THEN SpielerA(1);
  685.     UNTIL Winner <> '';
  686.   UNTIL SpielEnde;
  687.   Ende;
  688. END.
  689. (* ------------------------------------------------------ *)
  690. (*                Ende von EXPLODE2.PAS                   *)
  691.