Turbo Toolbox/Turbo_Toolbox.iso/1991/09_10/explode/exterm.pas

Pascal/Delphi Source File | 1991-08-08 | 27.0 KB | 818 lines

(* ======================================================================== *)
(*                             EXTERM.PAS                                   *)
(*          Strategiespiel "Explode", die "Exterminator"-Version            *)
(*                    (c) 1991 Gerald Arend & toolbox                       *)
(*    Turbo Pascal (ich denke, ab 5.0 müßte es sich compilieren lassen)     *)
(*    funktioniert auf beliebigen Farbgrafikkarten, für Hercules sind       *)
(*    einige Änderungen notwendig                                           *)
(*                                                                          *)
(*  Dieses Programm wurde aufgrund einer leichtfertigen Äußerung des        *)
(*  Redakteurs Ulrich Schmitz ins Leben gerufen, der ernsthaft behauptete,  *)
(*  er könne in C ein Strategiespiel nach Art von "Explode" programmieren,  *)
(*  das so ziemlich unschlagbar sei. Der "Exterminator" ist die Turbo-      *)
(*  Pascal-Antwort auf diese Herausforderung. Und eine erfolgreiche dazu:   *)
(*  Sie zerschmetterte den "Bestrafer" in einem 14-ründigen Turnier mit      *)
(*  13 : 1.                                                                 *)
(*                                                                          *)
(*  Die hier vorliegende Version wurde gegenüber der Turnierversion noch    *)
(*  einmal leicht verbessert. Wenn Sie gegen die Originalversion spielen    *)
(*  möchten, entfernen Sie bitte die Compiler-Option "{$DEFINE IMPROVED}"   *)
(*  in einer der nächsten Zeilen.                                           *)
(*                                                                          *)
(*  Viel Spaß beim Spielen (und Verlieren?)!                                *)
(*                                                                          *)
(*  Gerald Arend                                                            *)
(* ======================================================================== *)

{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+}
{$M 65000,0,0}
{$DEFINE IMPROVED}

PROGRAM Exterminator;

(* Compilerdirektiven:
   {$DEFINE SPEED}    - keine Verzögerungsschleife beim Sprengen
   {$DEFINE DEBUG}    - zeigt Feldbewertung auf dem Spielbrett an
   {$DEFINE IMPROVED} - Verbesserung des Turnier-Algorithmus         *)

USES Crt, Dos;
TYPE
  BlockType = ARRAY[0..3] OF STRING[9];                    { einzelne Blöcke }
  SpielerProc = PROCEDURE(Spieler : BYTE);
      { prozedurale Parameter für die Spielprozeduren "Mensch" und Computer" }
  AuswertRec  = RECORD                                      { für Rechnerzug }
                  x, y : BYTE;
                  Wert : INTEGER;
                END;
  AuswertType = ARRAY[1..36] OF AuswertRec;

CONST
  MaxX = 5;                               { Felder von 0 bis MaxX horizontal }
  MaxY = 5;                               { Felder von 0 bis MaxY vertikal   }
  MaxWert = 5;                              { max. Stapelhöhe auf einem Feld }

  Farbe : ARRAY[0..2] OF BYTE =                          { die Spielerfarben }
          (DarkGray, LightRed, LightGreen);
  InfoCol = Yellow OR Blue SHL 4;
  Info2Col = White OR LightGray SHL 4;
  LastZugCol = LightGray;
  Feld2Col = LightGray;
  CheckerCol : ARRAY[FALSE..TRUE] OF BYTE =
               (Blue, Black);                          { "Schachbrettfarben" }

  xFeld2 = 56;                        { Koordinaten für das kleine Spielfeld }
  yFeld2 = 12;

  Block : ARRAY [0..5] OF BlockType =
((                                                  { die einzelnen "Steine" }
'         ',
'         ',
'         ',
'         '),
(
'         ',
' ┌──┐    ',
' │  │    ',
' └──┘    '),
(
'         ',
' ┌─▒▒▒   ',
' │ ▒▒▒   ',
' └──┘    '),
(
'    ▄▄▄  ',
' ┌─▒███  ',
' │ ▒▒▒   ',
' └──┘    '),
(
'   ▄▄▄   ',
' ┌▒██╔═╗ ',
' │▒▒▒╚═╝ ',
' └──┘    '),
(
' . ▒▒▒ o ',
'  o ▒▒███',
' ┌─┐.▀▀▀ ',
' └─┘ ''    '));

TYPE
  FeldRec   = RECORD
                Wert  : BYTE;
                Farbe : BYTE;
              END;
  FeldArray = ARRAY[0..MaxX, 0..MaxY] OF FeldRec;

  WertRec   = RECORD              { Record für Auswertung während Rechnerzug }
                DiffFelder : BYTE;        { Differenz eigene Felder nach Zug }
                DiffPoints : BYTE;        { Differenz eigene Punkte nach Zug }
                VerlFelder : BYTE;      { Max. Verlust Felder nach Gegnerzug }
                VerlPoints : BYTE;      { Max. Verlust Punkte nach Gegnerzug }
                Nachbarn   : INTEGER;             { Auswertung Nachbarfelder }
                ZugLegal   : BOOLEAN;                    { Eigenzug erlaubt? }
                ZugBad     : BOOLEAN; { TRUE, wenn tödlicher Gegnerzug mögl. }
              END;
  WertMatrix = ARRAY[0..MaxX, 0..MaxY] OF WertRec;
  TotalRec   = ARRAY[0..2] OF BYTE;       { für Summierung Punkte und Felder }

VAR
  Spieler : ARRAY[1..2] OF SpielerProc;
  GameOver : BOOLEAN;
  Feld : FeldArray;
  xr, yr : BYTE;
  x, y : ARRAY[0..2] OF BYTE;
  Screen : ARRAY[0..24, 0..79] OF WORD ABSOLUTE $B800:$0;
           { die vorliegende Version versteht sich nur mit Farbgrafikkarten! }
  ZugZaehler : BYTE;
  ch : CHAR;
  n : BYTE;

CONST
  BX = 9;                                           { Breite der Spielsteine }
  BY = 4;                                             { Höhe der Spielsteine }
  Kritisch : ARRAY[0..MaxX, 0..MaxY] OF BYTE =
             ((2, 3, 3, 3, 3, 2),          { Werte, wann ein Feld explodiert }
              (3, 4, 4, 4, 4, 3),
              (3, 4, 4, 4, 4, 3),
              (3, 4, 4, 4, 4, 3),
              (3, 4, 4, 4, 4, 3),
              (2, 3, 3, 3, 3, 2));

PROCEDURE SchalteCursor(An: BOOLEAN);
VAR
  Reg : REGISTERS;
BEGIN
  WITH Reg DO
  BEGIN
    IF An THEN
      CX := $A0B
    ELSE
      CX := $FFFF;
    BX := 0;
    AX := $0100
  END;
  Intr($10, Reg)
END;  { Cursor }

PROCEDURE ProgrammEnde;
TYPE
  Screen2Type = ARRAY[1..4000] OF WORD;
VAR
  n : WORD;
  Screen2 : Screen2Type ABSOLUTE $B800:$0000;
CONST
  Step = 77;
BEGIN
  n := 1;
  REPEAT
    Inc(n, Step);
    IF n > 4000 THEN BEGIN
      Dec(n, 4000);
      Delay(5);
    END;
    Screen2[n] := 0;
  UNTIL n = 1;
  TextMode(LastMode);
  SchalteCursor(TRUE);
  ClrScr;
  LowVideo;
  Write('Denke immer daran: Der  ');
  HighVideo;
  Write('E X T E R M I N A T O R  ');
  LowVideo;
  WriteLn('wartet auf Dich...');
  Halt;
END;  { ProgrammEnde }


PROCEDURE Info(Message1, Message2 : STRING; Attr : BYTE);
BEGIN
  Window(xFeld2, 6, 80, 10);
  TextAttr := Attr;
  Write('╔═══════════════════════╗');
  Write('║                       ║');
  Write('║                       ║');
  Write('╚═══════════════════════╝');
  GotoXY((80 - xFeld2 - Length(Message1)) DIV 2 + 2, 2); Write(Message1);
  GotoXY((80 - xFeld2 - Length(Message2)) DIV 2 + 2, 3); Write(Message2);
  Window(1, 1, 80 ,25);
END;  { Info }

PROCEDURE ShowLastZug(Nr, x, y, Attr : BYTE);
BEGIN
  GotoXY(xFeld2 + 16 + Nr * 3, 11);
  TextAttr := Attr;
  Write(Chr(BYTE('A') + x), y + 1);
END;

PROCEDURE DrawBlock(x, y : BYTE);             { einzelnes Spielfeld zeichnen }
VAR
  n : BYTE;
BEGIN
  IF Feld[x, y].Farbe = 0 THEN
    TextAttr := CheckerCol[Odd(x + y)] SHL 4
  ELSE
    TextAttr := CheckerCol[Odd(x + y)] SHL 4 OR
                Farbe[Feld[x, y].Farbe];
  FOR n := 0 TO 3 DO BEGIN
    GotoXY(Succ(x * BX), Succ(y * BY) + n);
    Write(Block[Feld[x, y].Wert][n]);
  END;
  TextBackGround(Black);
  GotoXY(xFeld2 + 2 + 4 * x, yFeld2 + 1 + 2 * y);
  IF Feld[x, y].Wert > 0 THEN
    Write(Feld[x, y].Wert:1)
  ELSE
    Write(#32);
END;

PROCEDURE DrawFeld;                            { gesamtes Spielfeld zeichnen }
VAR
  x, y : BYTE;
BEGIN
  FOR x := 0 TO MaxX DO
    FOR y := 0 TO MaxY DO BEGIN
      DrawBlock(x, y);
    END;
END;

PROCEDURE DrawInfos;
BEGIN
  Window(xFeld2, 1, 80, 24);
  TextAttr := InfoCol;
  Write('█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█');
  Write('▌  E  X  P  L  O  D  E  ▐');
  Write('▌E x t e r m i n a t o r▐');
  Write('█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█');
  WriteLn;
  WriteLn;
  WriteLn;
  WriteLn;
  TextAttr := LastZugCol;
  Writeln;
  ClrEol;
  WriteLn('    Züge gespielt');
  Write(' Letzte Spielzüge:');
  ClrEol;
  Window(1, 1, 80, 25);
  TextAttr := InfoCol;
  GotoXY(1, 25);
  Write('   (c) 1991 Gerald Arend und toolbox nach einer Spielidee von Patrick Filipaj');
  ClrEol;
END;

PROCEDURE DrawFeld2;
BEGIN
  Window(xFeld2, yFeld2, 80, 25);
  TextAttr := Feld2Col;
  Write('╔═A═╤═B═╤═C═╤═D═╤═E═╤═F═╗');
  Write('1   │   │   │   │   │   1');
  Write('╟───┼───┼───┼───┼───┼───╢');
  Write('2   │   │   │   │   │   2');
  Write('╟───┼───┼───┼───┼───┼───╢');
  Write('3   │   │   │   │   │   3');
  Write('╟───┼───┼───┼───┼───┼───╢');
  Write('4   │   │   │   │   │   4');
  Write('╟───┼───┼───┼───┼───┼───╢');
  Write('5   │   │   │   │   │   5');
  Write('╟───┼───┼───┼───┼───┼───╢');
  Write('6   │   │   │   │   │   6');
  Write('╚═A═╧═B═╧═C═╧═D═╧═E═╧═F═╝');
  Window(1, 1, 80, 25);
END;

PROCEDURE Cursor(x, y : BYTE);           { blinkender "Cursor" auf Spielfeld }
VAR
  xx, yy, cx, cy : BYTE;
CONST
  Maske = $F800;
BEGIN
  cx := x * BX;
  cy := y * BY;
  FOR xx := cx TO cx + 8 DO
    FOR yy := cy TO cy + 3 DO
      Screen[yy, xx] := Screen[yy, xx] XOR Maske;
  Screen[yFeld2 + 2 * y, xFeld2 + 1 + 4 * x] :=
    Screen[yFeld2 + 2 * y, xFeld2 + 1 + 4 * x] XOR Maske;
END;

PROCEDURE Addiere(VAR Feld : FeldArray; x, y : SHORTINT; n : BYTE);
BEGIN                                                         { Stein setzen }
  IF (x >= 0) AND (x <= MaxX) AND
     (y >= 0) AND (y <= MaxY) THEN
    WITH Feld[x, y] DO BEGIN
      Inc(Wert);
      Farbe := n;
    END;
END;

PROCEDURE Summiere(VAR Feld : FeldArray; VAR TotFeld, TotPoints : TotalRec);
VAR                     { Punkte und Felder des gesamten Spielfelds addieren }
  x, y : BYTE;
BEGIN
  TotFeld[0] := 0;
  TotFeld[1] := 0;
  TotFeld[2] := 0;
  TotPoints[0] := 0;
  TotPoints[1] := 0;
  TotPoints[2] := 0;
  FOR x := 0 TO MaxX DO
    FOR y := 0 TO MaxY DO BEGIN
      Inc(TotFeld[Feld[x, y].Farbe]);
      Inc(TotPoints[Feld[x, y].Farbe], Feld[x, y].Wert);
    END;
END;  { Summiere }

PROCEDURE Check(VAR Feld : FeldArray; Virtuell : BOOLEAN);
VAR                                                       { Explosions-Check }
  x, y, n : BYTE;
  Stabil : BOOLEAN;
  Total : ARRAY[0..2] OF BYTE;
BEGIN
  REPEAT
    Stabil := TRUE;
    Total[0] := 0;
    Total[1] := 0;
    Total[2] := 0;
    FOR x := 0 TO MaxX DO
      FOR y := 0 TO MaxY DO BEGIN
        Inc(Total[Feld[x, y].Farbe]);
        IF Feld[x, y].Wert >= Kritisch[x, y] THEN BEGIN
          n := Feld[x, y].Farbe;                     { Nachbarfelder erhöhen }
          Addiere(Feld, x-1, y, n);
          Addiere(Feld, x+1, y, n);
          Addiere(Feld, x, y-1, n);
          Addiere(Feld, x, y+1, n);
          Dec(Feld[x, y].Wert, Kritisch[x, y]);
          IF Feld[x, y].Wert = 0 THEN                       { Feld ist leer: }
            Feld[x, y].Farbe := 0;                          { neutrale Farbe }
          IF NOT Virtuell THEN BEGIN
            DrawFeld;                                     { Spielfeld zeigen }
{$IFNDEF SPEED}
            Sound(600);
            Delay(3);
            NoSound;
            Delay(300);
{$ENDIF}
          END;
        Stabil := FALSE;
        END;
      END;
      IF (Total[1] = 0) OR (Total[2] = 0) AND
         (ZugZaehler > 2) THEN
      BEGIN
        IF NOT Virtuell THEN
          GameOver := TRUE;                                   { verlooooorn! }
        Exit;
      END;
  UNTIL Stabil;
END;

PROCEDURE Pause;
BEGIN
  REPEAT UNTIL ReadKey > '';
END;

{$F+}
PROCEDURE Mensch(n : BYTE);
{$F-}
VAR
  ch : CHAR;
BEGIN
  Info('Mensch, Du ziehst!', 'Ich warte...', Farbe[n]);
  REPEAT
    Cursor(x[n], y[n]);
    WHILE KeyPressed DO ReadKey;
    ch := ReadKey;
    Cursor(x[n], y[n]);
    CASE UpCase(ch) OF
      #0 :  { Cursorsteuerung }
        CASE ReadKey OF
          #75 : IF x[n] > 0 THEN Dec(x[n]);
          #77 : IF x[n] < MaxX THEN Inc(x[n]);
          #72 : IF y[n] > 0 THEN Dec(y[n]);
          #80 : IF y[n] < MaxY THEN Inc(y[n]);
        END;
      #27 : { Abbruch }
        ProgrammEnde;
      'A'..'F' :
        x[n] := Ord(UpCase(ch)) - Ord('A');
      '1'..'6' :
        y[n] := Ord(ch) - Ord('1');
    END;
  UNTIL (ch = #13) AND (Feld[x[n], y[n]].Farbe IN [0, n]);
  ShowLastZug(n, x[n], y[n], Farbe[n]);
END;

{$F+}
PROCEDURE Computer(Selbst : BYTE);                     { der "Exterminator"! }
{$F-}
VAR
  Matrix : WertMatrix;                            { Feld für Brettauswertung }
  WertFeld : AuswertType;                             { Array für Zugauswahl }
  FeldAlt : FeldArray;                                     { Spielfeldpuffer }
  Gegner : BYTE;                                         { Farbe des Gegners }

  PROCEDURE Sort(VAR M : AuswertType);               { sortiert die Zugliste }
  VAR
    a, b : BYTE;
    s : AuswertRec;
  BEGIN
    FOR a := 1 TO 35 DO
      FOR b := a + 1 TO 36 DO
        IF M[a].Wert < M[b].Wert THEN BEGIN
          s := M[a];
          M[a] := M[b];
          M[b] := s;
        END;
  END;  { Sort }

  PROCEDURE Analyse(VAR Feld2 : FeldArray);           { analysiert alle Züge }

    FUNCTION CheckNachbarn(x, y : SHORTINT;
                           Referenz : SHORTINT) : SHORTINT;
                { gibt den Wert zurück, um wieviel näher das Nachbarfeld am
                    Explosionsstatus liegt als das eigene Feld, dessen Wert
                                              als "Referenz" übergeben wird  }
    VAR
      Test : SHORTINT;
    BEGIN
      Test := 0;
      IF (x >= 0) AND (x <= MaxX) AND (y >= 0) AND (y <= MaxY) THEN
{$IFDEF IMPROVED}
{ Kleine Verbesserung, die erst nach dem Turnier dazukam: Nur Felder des
  Gegners oder neutrale Felder werden in die Nachbarschaftsbewertung
  mit einbezogen }
        IF (Feld2[x, y].Farbe = 0) OR (Feld2[x, y].Farbe = Gegner) THEN
{$ENDIF}
          Test := Referenz - (Kritisch[x, y] - Feld2[x, y].Wert);
      CheckNachbarn := Test;
    END;  { CheckNachbarn }

    FUNCTION CountNachbarn : INTEGER; { Nachbarschaftswerte für ganzes Brett }
    VAR
      x, y : BYTE;
      Ref : SHORTINT;                                    { Referenzwert Feld }
      Test : INTEGER;
    BEGIN
      Test := 0;
      FOR x := 0 TO MaxX DO
        FOR y := 0 TO MaxY DO
          IF Feld2[x, y].Farbe = Selbst THEN BEGIN
        { Referenzwert: Wieviel Steine benötigt das Feld noch zur Explosion? }
            Ref := Kritisch[x, y] - Feld2[x, y].Wert;
            Inc(Test, CheckNachbarn(x - 1, y, Ref));
            Inc(Test, CheckNachbarn(x + 1, y, Ref));
            Inc(Test, CheckNachbarn(x, y - 1, Ref));
            Inc(Test, CheckNachbarn(x, y + 1, Ref));
          END;
      CountNachbarn := Test;
    END;  { CountNachbarn }

  VAR
    x, y, n, xx, yy : BYTE;
    Feld3, Feld2Alt : FeldArray;
    TotPoints,
    TotFeld,
    TotPointsAlt,
    TotFeldAlt : TotalRec;
    MaxFeldGegner : BYTE;
    MaxPointsGegner : BYTE;
    NachbarnAlt : INTEGER;
  CONST
    BlubberLen = 22;
    Blubber : STRING =
    '                      ....denk.....                       ';

  BEGIN                                                            { Analyse }
    TextColor(Farbe[Selbst]);
    Feld2Alt := Feld2;
    Summiere(Feld2Alt, TotFeldAlt, TotPointsAlt);
    NachbarnAlt := CountNachbarn;
    FOR x := 0 TO MaxX DO
      FOR y := 0 TO MaxY DO BEGIN
        Feld2 := Feld2Alt;                              { Feld2 restaurieren }
        WITH Matrix[x, y] DO BEGIN                     { Defaultwerte setzen }
          DiffFelder := 0;
          DiffPoints := 0;
          VerlFelder := 0;
          VerlPoints := 0;
          Nachbarn   := 0;
          ZugLegal   := FALSE;
          ZugBad     := FALSE;
        END;

        IF Feld2[x, y].Farbe = Selbst THEN
        BEGIN                                       { eigenes Feld besetzbar }
          Matrix[x, y].ZugLegal := TRUE;
          Inc(Feld2[x, y].Wert);                             { Feld besetzen }
          Check(Feld2, TRUE);                                 { Explosionen? }
          Summiere(Feld2, TotFeld, TotPoints);           { Feldsummen bilden }
          Matrix[x, y].DiffFelder :=                      { gewonnene Felder }
            TotFeld[Selbst] - TotFeldAlt[Selbst];
          Matrix[x, y].DiffPoints :=                      { gewonnene Punkte }
            TotPoints[Selbst] - TotPointsAlt[Selbst];
        END;

        IF Feld2[x, y].Farbe = 0 THEN
        BEGIN                                     { neutrales Feld besetzbar }
          Matrix[x, y].ZugLegal := TRUE;
          Matrix[x, y].DiffFelder := 1;
          Matrix[x, y].DiffPoints := 1;
          Inc(Feld2[x, y].Wert);                             { Feld besetzen }
          Feld2[x, y].Farbe := Selbst;              { Farbe nicht vergessen! }
        END;             { Explosions-Check entfällt, da Feld stabil bleibt! }

                       { Differenz kritische Felder für diesen Zug ermitteln }
        IF Matrix[x, y].ZugLegal THEN
          Matrix[x, y].Nachbarn := NachBarnAlt - CountNachbarn;

{ Gegnerzug: Der nächste Programmteil führt  a l l e  möglichen
  Züge des Gegners durch; ermittelt wird der Verlust an Feldern und
  Punkten, die der beste Gegnerzug der Spielsituation des Rechners
  zufügt }

        IF Matrix[x, y].ZugLegal THEN BEGIN
         { dieser Check ist nur nötig, wenn auch ein Rechnerzug möglich ist! }
          MaxFeldGegner := 0;
          MaxPointsGegner := 0;

          FOR xx := 0 TO MaxX DO
            FOR yy := 0 TO MaxY DO BEGIN
              Feld3 := Feld2;           { Situation nach PC-Zug restaurieren }
              IF (Feld3[xx, yy].Farbe IN [0, Gegner]) THEN
              BEGIN                                     { Gegnerzug möglich! }
                Inc(Feld3[xx, yy].Wert);                         { Gegnerzug }
                Check(Feld3, TRUE);                            { Feldprüfung }
                Summiere(Feld3, TotFeld, TotPoints);     { Feldsummen bilden }
                IF TotFeld[Gegner] > MaxFeldGegner THEN
                  MaxFeldGegner := TotFeld[Gegner];
                IF TotPoints[Gegner] > MaxPointsGegner THEN
                  MaxPointsGegner := TotPoints[Gegner];
                IF (TotFeld[Selbst] = 0) AND (ZugZaehler > 2) THEN
                  Matrix[x, y].ZugBad := TRUE;           { oha: PC is platt! }
              END;
            END;                                  { Hauptschleife Gegnerzüge }
          Matrix[x, y].VerlFelder := MaxFeldGegner;
          Matrix[x, y].VerlPoints := MaxPointsGegner;
        END;                                             { Routine Gegnerzug }

      GotoXY(xFeld2 + 1, 8);
      Write(Copy(Blubber, y + x * 6 + 1, BlubberLen));
    END;                                                 { Schleife Eigenzug }
  END;                                                             { Analyse }

  PROCEDURE Auswertung;
  TYPE
    ZugSetType = SET OF BYTE;
  LABEL
    CheckNext, KillHim;
  VAR
    xx, yy, n, i, i1, i2 : BYTE;
  BEGIN
    n := 1;
    FOR xx := 0 TO MaxX DO                              { "Matrix" aufteilen }
      FOR yy := 0 TO MaxY DO BEGIN
        CASE Matrix[xx, yy].ZugLegal OF
          TRUE :
          BEGIN
            WertFeld[n].x := xx;
            WertFeld[n].y := yy;
            IF NOT Matrix[xx, yy].ZugBad THEN
            WITH Matrix[xx, yy] DO                           { Feldbewertung }
              WertFeld[n].Wert := DiffFelder * 8
                                + DiffPoints * 2
                                - VerlFelder * 4
                                - VerlPoints * 2
                                + Nachbarn   * 4
                                - Kritisch[xx, yy]
            ELSE
              WertFeld[n].Wert := -32000;       { unglückliche Züge erhalten
                                                        miserable Bewertung! }
          END;

          FALSE :
            WertFeld[n].Wert := -32500;           { illegale Züge erhalten
                                                    hundsmiserable Bewertung }
        END;                                                          { CASE }

{$IFDEF DEBUG}                                       { für Debugging-Zwecke: }
        TextColor(White);              { die Auswertung für alle Felder wird }
        GotoXY(xx * 9 + 1, yy * 4 + 1);        { auf dem Spielfeld angezeigt }
        Window(WhereX, WhereY, WhereX + 8, WhereY + 3);
        WITH Matrix[xx, yy] DO
          IF ZugLegal THEN BEGIN
            IF ZugBad THEN
              TextColor(LightRed)
            ELSE
              IF Feld[xx, yy].Farbe = 0 THEN
                TextColor(White)
              ELSE
                TextColor(Farbe[Feld[xx, yy].Farbe]);
            TextBackGround(CheckerCol[Odd(xx + yy)]);
            ClrScr;
            Write('ΣF', DiffFelder:2, ' P', DiffPoints:3);
            Write('±F', VerlFelder:2, ' P', VerlPoints:3);
            WriteLn('±N', Nachbarn);
            Write(WertFeld[n].Wert);
          END;
        Window(1, 1, 80, 25);
{$ENDIF}

        Inc(n);
      END;    { Hauptschleife }

{$IFDEF DEBUG}
      Pause;
{$ENDIF}

    Sort(WertFeld);           { Array sortieren; schlechte und illegale Züge }
                            { gelangen dabei automatisch ans Ende der Liste! }
    i1 := 1;                                     { Zug nach Zufall auswählen }
    i2 := i1;
    REPEAT                     { Ermittlung des Bereichs gleichwertiger Züge }
      Inc(i2);
    UNTIL WertFeld[i2].Wert < WertFeld[i1].Wert;
    Dec(i2);
    IF i1 = i2 THEN
      i := i1                                        { nur ein optimaler Zug }
    ELSE
      REPEAT              { Zufallsgenerator wählt einen der besten Züge aus }
        i := Random(36) + 1;
      UNTIL i IN [i1..i2];

    x[Selbst] := WertFeld[i].x;                                 { Zugvorgabe }
    y[Selbst] := WertFeld[i].y;
  END;   { Auswertung }

BEGIN                                                             { Computer }
  Info('Der Exterminator zieht!', '', Farbe[Selbst]);
  Gegner := Selbst XOR 3;
  FeldAlt := Feld;
  Analyse(Feld);                                          { Spielfeldanalyse }
  Auswertung;                                                   { Zugauswahl }
  Feld := FeldAlt;                                       { Feld restaurieren }
  DrawFeld;
  ShowLastZug(Selbst, x[Selbst], y[Selbst], Farbe[Selbst]);
  Cursor(x[Selbst], y[Selbst]);

{$IFNDEF SPEED}
  Sound(400);
  Delay(15);
  NoSound;
  Delay(900);
{$ENDIF}

  Cursor(x[Selbst], y[Selbst]);
END;                                                              { Computer }

PROCEDURE InitGame;
BEGIN
  x[1] := 2;
  y[1] := 2;
  x[2] := 3;
  y[2] := 3;
  GameOver := FALSE;
END;                                                              { InitGame }

PROCEDURE SetupFeld;
VAR
  x, y : BYTE;
BEGIN
  FOR x := 0 TO MaxX DO
    FOR y := 0 TO MaxY DO
      WITH Feld[x, y] DO BEGIN
        Wert := 0;
        Farbe := 0;
      END;
END;                                                             { SetUpFeld }

PROCEDURE Taeterae(n : BYTE);
VAR
  i : BYTE;
  s : WORD;
BEGIN
  IF @Spieler[n] = @Computer THEN BEGIN
    Info('Glorreicher Sieger ist',
         'der Exterminator (' + Chr(Ord('1') + n - 1) + ')', Farbe[n]);
    s := 440;
    FOR i := 1 TO 5 DO BEGIN
      Sound(s * i);
      Delay(150);
    END;
  END ELSE BEGIN
    Info('Glorreicher Sieger ist',
         'der Mensch (' + Chr(Ord('1') + n - 1) + ')', Farbe[n]);
    s := 440;
    FOR i := 5 DOWNTO 1 DO BEGIN
      Sound(s * i);
      Delay(150);
    END;
  END;
  NoSound;
  REPEAT
  UNTIL ReadKey > '';
END;                                                              { Taeterae }

PROCEDURE Titel;
BEGIN
  TextBackGround(Blue);
  TextColor(Yellow);
  ClrScr;
  WriteLn;
  WriteLn('        ████████ ██    ██ ████████ ██       ████████ ███████  ████████');
  WriteLn('        ██        ██  ██  ██    ██ ██       ██    ██ ██    ██ ██');
  WriteLn('        ██         ████   ██    ██ ██       ██    ██ ██     █ ██');
  WriteLn('        █████       ██    ████████ ██       ██    ██ ██     █ █████');
  WriteLn('        ██         ████   ██       ██       ██    ██ ██    ██ ██');
  WriteLn('        ████████  ██  ██  ██       ████████ ████████ ████████ ████████');
  WriteLn('        ████████ ██    ██ ██       ████████ ████████ ██████   ████████');
  WriteLn;
  WriteLn;
  TextColor(LightRed);
  WriteLn('     ▒▒▒▒▒ ▒▒ ▒▒ ▒▒▒▒▒ ▒▒▒▒▒ ▒▒▒▒  ▒▒▒▒▒ ▒▒▒ ▒▒  ▒  ▒▒▒  ▒▒▒▒▒ ▒▒▒▒▒ ▒▒▒▒');
  WriteLn('     ▒      ▒▒▒    ▒   ▒     ▒   ▒ ▒ ▒ ▒  ▒  ▒ ▒ ▒ ▒   ▒   ▒   ▒   ▒ ▒   ▒');
  WriteLn('     ▒▒▒▒    ▒     ▒   ▒▒▒   ▒▒▒▒  ▒ ▒ ▒  ▒  ▒ ▒ ▒ ▒▒▒▒▒   ▒   ▒   ▒ ▒▒▒▒');
  WriteLn('     ▒      ▒▒▒    ▒   ▒     ▒ ▒   ▒   ▒  ▒  ▒ ▒ ▒ ▒   ▒   ▒   ▒   ▒ ▒ ▒');
  WriteLn('     ▒▒▒▒▒ ▒▒ ▒▒   ▒   ▒▒▒▒▒ ▒  ▒▒ ▒   ▒ ▒▒▒ ▒  ▒▒ ▒   ▒   ▒   ▒▒▒▒▒ ▒  ▒▒');
  WriteLn;
  WriteLn;
  TextColor(LightGreen);
  WriteLn('                 O F F I Z I E L L E R   G E W I N N E R   D E S');
  WriteLn;
  WriteLn('              t o o l b o x - E X P L O D E - W E T T B E W E R B S');
  WriteLn;
  WriteLn;
  TextColor(LightCyan);
  WriteLn('        Programmiert von Gerald Arend nach einer Idee von Patrick Filipaj');
  WriteLn('                         (c) 1991 Gerald Arend & toolbox');
  Pause;
END;

BEGIN                                                        { Hauptprogramm }
  Randomize;
  CheckBreak := FALSE;
  SchalteCursor(FALSE);

  Titel;
  REPEAT
    TextBackGround(Black);
    ClrScr;
    InitGame;
    SetUpFeld;
    DrawInfos;
    DrawFeld2;

    Info('Spieler 1:', '<P>C oder <M>ensch?', Farbe[1]);
    REPEAT
      ch := UpCase(ReadKey);
    UNTIL ch IN ['P', 'M'];
    IF ch = 'P' THEN
      Spieler[1] := Computer
    ELSE
      Spieler[1] := Mensch;
    Info('Spieler 2:', '<P>C oder <M>ensch?', Farbe[2]);
    REPEAT
      ch := UpCase(ReadKey);
    UNTIL ch IN ['P', 'M'];
    IF ch = 'P' THEN
      Spieler[2] := Computer
    ELSE
      Spieler[2] := Mensch;

    ZugZaehler := 0;
    REPEAT
      DrawFeld;
      n := 1;
      REPEAT
        IF KeyPressed THEN
          IF ReadKey = #27 THEN
            ProgrammEnde;
        TextAttr := White;
        GotoXY(xFeld2 + 1, 10);
        Write(ZugZaehler : 2);
        Spieler[n](n);
        Feld[x[n], y[n]].Farbe := n;
        Inc(Feld[x[n], y[n]].Wert);
        Inc(ZugZaehler);
        DrawFeld;
{$IFNDEF SPEED}
        Delay(300);
{$ENDIF}
        Check(Feld, FALSE);
        n := n XOR 3;
      UNTIL GameOver;
    UNTIL GameOver;

    Taeterae(n XOR 3);

    Info('Noch ein Spiel?', '<J>/<N>', Info2Col);
    REPEAT
      ch := UpCase(ReadKey);
    UNTIL ch IN ['J', 'N', #27];
  UNTIL ch <> 'J';
  ProgrammEnde;
END.
(* ======================================================================== *)
(*                         Ende von EXTERM.PAS                              *)