SSL rev19.utf8.pas

{------------------------------------------------------------------}
{    Reversi-Game designed by Jens Doll, Hamburg                   }
{             Version of January 1992                              }
{------------------------------------------------------------------}
{------------------------------------------------------------------}
{                     Agenda                                       }
{ 1.  Checksum aktivieren                                          }
{ 2.  Länge    aktivieren                                          }
{ 3.  Kopie    nach Games                                          }
{ 4.  mehrere  Spieler zulassen                                    }
{ 5.  Graphik und Fenstertechnik                                   }
{ 6.  Animation mit 3D                                             }
{ 7.  Kryptographie der Texte                                      }
{ 8.  Bei Viruscheck Soundoff := false                             }
{------------------------------------------------------------------}
program Reversi;
{$B+}     {lazy evaluation of boolean expressions}
Uses CRT,DOS;
{------------------------------------------------------------------}
{                     Constants                                    }
{------------------------------------------------------------------}
const
     Version      = '1.9';
     NameLength   = 10;
     MyName       = 'Reversi'+Version;
     Date         = 'März 1992';
     N            = 8;
     P            = 24;
     Advantage    = 8;
     Gamewon      = 4*Advantage*Advantage+24*Advantage+7*7;
     Left         = #1;
     Right        = #2;
     Up           = #3;
     Down         = #4;
     Help         = #5;
     EndIt        = #6;
     Rubout       = #8;
     Return       = #13;
     Space        = '                    ';
{------------------------------------------------------------------}
{                     Data Types                                   }
{------------------------------------------------------------------}
Type
    Range    = 0 .. N;
    HelpTexts = (Menue,Hints,Illegal,OutofSpace,Assure,
                 Copyright,Rules,Virus1,Virus2,Virus3);
    Sounds    = (SongofJoy,Bourree,RadioHamburg,Alarm);
    Commands = set of char;
    Colort   = (Blank, Dark, Light);
    BoardT   = array[Range,Range] of ColorT;
    MoveT    = record
                    Value : integer;
                    L,C   : Range
               end;
    MovesT   = record
                    Max   : integer;
                    M     : array [1 .. N*N div 2] of MoveT;
               end;
    Names    = string[NameLength];
    EntryT   = record
                  Name    : Names;
                  Average : real;
                  Games   : longint;
                  High    : longint;
                  Low     : longint
               end;
{------------------------------------------------------------------}
{                Global Variables                                  }
{------------------------------------------------------------------}
Var
   MaxDepth      : 1 .. N;
   Endofall      : boolean;
   Gameended     : boolean;
   HelpDone      : boolean;
   Permanent     : boolean;
   Perm          : char;
   Soundoff      : boolean;
   MeImpossible  : boolean;
   YouImpossible : boolean;
   Board         : BoardT;
   NoMove        : MoveT;
   Depth         : integer;
   Power         : integer;
   Human         : boolean;
   Machine       : boolean;
   Turn,Me,
   You           : ColorT;
   Move          : MoveT;
   Moves         : MovesT;
   Legal         : boolean;
   Autoplay      : boolean;
   Debug         : boolean;
   MyPieces      : integer;
   YourPieces    : integer;
   FreePlaces    : integer;
   YourName      : Names;
   HerName       : Names;
   Entries       : array[1 .. P] of EntryT;
   Memory        : file of EntryT;
   Load          : Text;
{------------------------------------------------------------------}
{              Procedure Modul                                     }
{           for debug purposes only                                }
{------------------------------------------------------------------}
Procedure Modul (Name : Names);
begin
  {
  begin
     GotoXY(61,22);
     write(Name);
     readln
  end
  }
end; { Modul }
{------------------------------------------------------------------}
{              Procedure Finish                                    }
{           for to finish  program                                }
{------------------------------------------------------------------}
procedure Finish;
begin
   Window(1, 1, 80, 25);
   ClrScr;
   GotoXY(1, 1);
   Halt(1)
end; {Finish }
{------------------------------------------------------------------}
{              Procedure Compute                                   }
{           for to get computing power                             }
{------------------------------------------------------------------}
Procedure Compute(var Power : integer);
const
   Norm = 5;
var
   i,j,k,l   : integer;
   H,M,S,C : word;
   T       : longint;
begin
   GetTime(H,M,S,C);
   T := C+S*100+M*60*100+H*60*60*100;
   for l :=1 to Norm do
   begin
   for i := 1 to N do
      for j := 1 to N do
         if odd(i+j) then
            Board[i,j] := Light
         else
            Board[i,j] := Dark;
   for k := 1 to 100 do
      for i := 1 to N do
         for j := 1 to N do
            Board[((i+5)mod N)+1,((j+3)mod N)+1] :=
            Board[((I+3)mod N)+1,((j+5)mod N)+1];
   end;
   GetTime(H,M,S,C);
   T := C+S*100+M*60*100+H*60*60*100 - T;
   Power := T div Norm
end; { Compute }
{------------------------------------------------------------------}
{              Procedure Sounder                                   }
{           for to sound a result or so                            }
{------------------------------------------------------------------}
Procedure Sounder(i : Sounds);
const
   c000 = 32.70;
   c00  = 65.41;
   c0   = 130.81;
   c    = 261.63;
   cis  = 277.18;
   d    = 293.67;
   es   = 311.13;
   e    = 329.63;
   f    = 349.23;
   fis  = 369.99;
   g    = 392.0;
   as   = 415.31;
   gis  = as;
   a    = 440.0;
   b    = 466.16;
   h    = 493.88;
   c1   = 261.63;
   c2   = 523.25;
   c3   = 1046.51;
   c4   = 2093.02;
   c5   = 4186.03;

   half  = 500;
   Quart = 250;
   eigth = 125;
var
   Hz       : real;
   j        : integer;
   BaseTone : integer;
   Offset   : integer;
procedure Tone(f : real;d : integer);
begin
   Sound(trunc(f));
   Delay(trunc(7/8*d));
   NoSound;
   Delay(trunc(1/8*d))
end;
procedure Pause(f : real);
begin
   Delay(trunc(f))
end;
begin
   if not Soundoff then
   case i of
    SongofJoy :
        begin
           Tone(e,quart);
           Tone(e,quart);
           Tone(f,eigth);
           Pause(eigth);
           Tone(g,eigth);
           Pause(eigth);
           Tone(g,quart);
           Tone(f,quart);
           Tone(e,quart);
           Tone(d,quart);
           Tone(c,quart);
           Tone(c,quart);
           Tone(d,quart);
           Tone(e,quart);
           Tone(e,quart+eigth);
           Tone(d,eigth);
           Pause(eigth);
           Tone(d,half);
           Pause(half);
           Tone(e,quart);
           Tone(e,quart);
           Tone(f,eigth);
           Pause(eigth);
           Tone(g,eigth);
           Pause(eigth);
           Tone(g,quart);
           Tone(f,quart);
           Tone(e,quart);
           Tone(d,quart);
           Tone(c,quart);
           Tone(c,quart);
           Tone(d,quart);
           Tone(e,quart);
           Tone(d,quart+eigth);
           Tone(c,eigth);
           Pause(eigth);
           Tone(c,half)
        end;
    Bourree :
        begin
           Tone(a,quart);
           Tone(h,quart);
           Tone(2*c,half+eigth);
           Tone(h,eigth);
           Tone(a,quart+eigth);
           Tone(gis,half+quart);
           Tone(a,eigth);
           Tone(h,quart+eigth);
           Tone(e,half+quart);
           Tone(fis,eigth);
           Tone(gis,quart+eigth);
           Tone(a,half+quart);
           Pause(quart);
           Tone(g,quart);
           Tone(f,quart);
           Tone(e,half+quart);
           Tone(d,eigth);
           Tone(c,quart+eigth);
           Tone(h/2,half+quart);
           Tone(c,eigth);
           Tone(d,quart+eigth);
           Tone(e,half+eigth);
           Tone(d,quart+eigth);
           Tone(c,quart);
           Tone(h/2,quart);
           Tone(a/2,half+quart)
        end;
   RadioHamburg :
       begin
          Tone(f,quart);
          Tone(d,quart);
          Tone(g,quart);
          Tone(e,half);
          Tone(c,half)
       end;
   Alarm :
        begin
          BaseTone := 880;
          Offset   := 440;
          for j := 1 to 200 do
          begin
             Hz := BaseTone + sin(j*2*3.1415/300)*Offset;
             Sound(trunc(Hz));
             Delay(10+j div 4)
          end;
          NoSound
       end;
   end
end; {Sounder}
{------------------------------------------------------------------}
{              Procedure HelpText                                  }
{           for to display help information                        }
{------------------------------------------------------------------}
procedure HelpText(i:HelpTexts);
var
   Ch : char;
   j  : integer;
begin
   case i of
   Menue :
        begin
           Window(1 ,1,32,24);
           writeln('********************ͻ');
           writeln('* 1 = Du beginnst    *');
           writeln('* 2 = Ich beginne    *');
           writeln('* 3 = Ihr alleine    *');
           writeln('* 4 = Ich alleine    *');
           writeln('* 5 = Ich permanent  *');
           writeln('*                    *');
           writeln('* Spielstärke von    *');
           writeln('*     1  bis ',MaxDepth:2,'      *');
           writeln('*                    *');
           writeln('* Namen haben nur    *');
           writeln('* Gro*buchstaben.    *');
           writeln('*                    *');
           writeln('* Viel Vergnügen !   *');
           writeln('*                    *');
           writeln('* Eine Taste drücken!*');
           writeln('********************ͼ')
        end;
   Hints :
        begin
           Window(1 ,1,32,25);
           writeln('********************ͻ');
           writeln('*     Hinweise       *');
           writeln('*     --------       *');
           writeln('* Kommandotasten :   *');
           writeln('* H  = Hinweise      *');
           writeln('* A  = Automatik     *');
           writeln('* I  = Info geben    *');
           writeln('* R  = Regeln        *');
           writeln('*                    *');
           writeln('*   Den Cursor       *');
           writeln('*        auf,        *');
           writeln('*        ab,         *');
           writeln('*        links,      *');
           writeln('*        rechts      *');
           writeln('*   bewegen.         *');
           writeln('*                    *');
           writeln('*  Enter oder Return *');
           writeln('*  setzt den Stein.  *');
           writeln('*                    *');
           writeln('* F1      = Hinweis  *');
           writeln('* F3,Esc  = Ende     *');
           writeln('*                    *');
           writeln('* Eine Taste drücken!*');
           writeln('********************ͼ')
        end;
   Illegal :
        begin
           Window(1 ,1,32,12);
           writeln('********************ͻ');
           writeln('*                    *');
           writeln('* Der Stein wurde    *');
           writeln('* falsch gesetzt.    *');
           writeln('*                    *');
           writeln('*                    *');
           writeln('* F1     = Hilfe     *');
           writeln('* F3,Esc = Ende      *');
           writeln('*                    *');
           writeln('* Eine Taste drücken!*');
           writeln('********************ͼ')
        end;
   OutofSpace :
        begin
           Window(1 ,1,32,12);
           writeln('********************ͻ');
           writeln('*                    *');
           writeln('* Dein Rechner hat   *');
           writeln('* nicht genügend     *');
           writeln('* freien Speicher    *');
           writeln('* auf der Platte !   *');
           writeln('*                    *');
           writeln('* Tabelle verloren ! *');
           writeln('*                    *');
           writeln('* Eine Taste drücken!*');
           writeln('********************ͼ')
        end;
   Copyright :
        begin
           Window(1 ,1,32,12);
           writeln('********************ͻ');
           writeln('* JDs Reversi ',Version,'    *');
           writeln('*                    *');
           writeln('* Bei Problemen      *');
           writeln('*   Hamburg,         *');
           writeln('*   040 652 19 91    *');
           writeln('* informieren.       *');
           writeln('*                    *');
           writeln('* Eine Taste drücken!*');
           writeln('********************ͼ')
        end;
   Rules :
        begin
           Window(1 ,1,32,25);
           writeln('**************************ͻ');
           writeln('*     Regeln               *');
           writeln('*     ------               *');
           writeln('*                          *');
           writeln('* Man muß mit seinen       *');
           writeln('* Steinen die gegnerischen *');
           writeln('* Steine einschließen :    *');
           writeln('*   - in der Wagerechten,  *');
           writeln('*   - der Senkrechten      *');
           writeln('*   - oder den Diagonalen. *');
           writeln('*                          *');
           writeln('* Es gewinnt der, der am   *');
           writeln('* Ende die meisten Steine  *');
           writeln('* auf dem Brett hat.       *');
           writeln('*                          *');
           writeln('* Ende ist, wenn das Brett *');
           writeln('* voll ist oder keiner     *');
           writeln('* mehr setzen kann.        *');
           writeln('*                          *');
           writeln('* In der Tabelle zählt     *');
           writeln('* die maximale Steinzahl.  *');
           writeln('*                          *');
           writeln('*   Eine Taste drücken!    *');
           writeln('**************************ͼ')
        end;
   Virus1 :
        begin
           Window(1 ,1,32,12);
           writeln('********************ͻ');
           writeln('*                    *');
           writeln('*      Hilfe,        *');
           writeln('*       mein         *');
           writeln('*   Hormonspiegel    *');
           writeln('*       ist          *');
           writeln('*   durcheinander !  *');
           writeln('*                    *');
           writeln('* Eine Taste drücken!*');
           writeln('********************ͼ')
        end;
   Virus2 :
        begin
           Window(1 ,1,32,12);
           writeln('********************ͻ');
           writeln('*                    *');
           writeln('*       Ich          *');
           writeln('*                    *');
           writeln('*       habe         *');
           writeln('*                    *');
           writeln('*     zugenommen !   *');
           writeln('*                    *');
           writeln('* Eine Taste drücken!*');
           writeln('********************ͼ')
        end;
   Virus3 :
        begin
           Window(1 ,1,32,12);
           writeln('********************ͻ');
           writeln('*                    *');
           writeln('*       Ich          *');
           writeln('*       habe         *');
           writeln('*     mein Ego       *');
           writeln('*    verloren !      *');
           writeln('*                    *');
           writeln('*                    *');
           writeln('* Eine Taste drücken!*');
           writeln('********************ͼ')
        end;
   Assure :
        begin
           Window(1 ,1,32,12);
           writeln('********************ͻ');
           writeln('*                    *');
           writeln('*      Willst        *');
           writeln('*        Du          *');
           writeln('*     wirklich       *');
           writeln('*     beenden ?      *');
           writeln('*                    *');
           writeln('* Ja   : Esc oder F3 *');
           writeln('* Nein : andere Taste*');
           writeln('********************ͼ')
        end;
     end;
   Window(1,1,80,25)
end; {HelpText}
{------------------------------------------------------------------}
{              Procedure VirusCheck                                }
{           for to detect eventual viruses                         }
{------------------------------------------------------------------}
procedure VirusCheck;
var
   CheckSum : integer;
   Length   : longint;
   Ch       : char;
   C        : integer;
   L        : longint;
begin
   L        := 0;
   C        := 0;
   CheckSum := 121;
   Length   := 588;
   Assign(Load,'REV19.EXE');
   {$I-}Reset(Load);{$I+}
   if IOResult = 0 then
   begin
      while not Eof(Load) do
      begin
         Read(Load,Ch);
         L := L + 1;
         C := (C + ord(Ch)) mod 256
      end;
      Close(Load);
      {if (C <> CheckSum) then
      begin
         HelpText(Virus1);
         writeln('Hormonspiegel = ',C:3);
         if Soundoff then
            Delay(3000)
         else
            Sounder(Alarm);
         Finish
      end;}
      {if L <> Length then
      begin
         HelpText(Virus2);
         writeln('Gewicht = ',L:6);
         if Soundoff then
            Delay(3000)
         else
            Sounder(Alarm);
         Finish
      end}
   end
   else
   begin
      HelpText(Virus2);
      if Soundoff then
         Delay(3000)
      else
         Sounder(Alarm);
      Finish
   end;
end; { VirusCheck }
{------------------------------------------------------------------}
{              Procedure GetChar                                   }
{           for to get a char from keyboard                        }
{------------------------------------------------------------------}
procedure GetChar(var Ch:char;s:Commands;h:HelpTexts);
{liest ein bis zwei Zeichen von der Tastatur ein}
const
   Esc    = #27;
   Low    = #0;
var
   X1,Y1 : integer;
   Count : integer;
begin
   Ch       := ' ';
   Count    := 0;
   HelpDone := false;
   X1 := WhereX; Y1 := WhereY;
   repeat
      if HelpDone then
      begin
         Window(1,1,80,25);
         GotoXY(X1,Y1);
         Ch := ReadKey
      end
      else
         Ch := ReadKey;
      case ch of
         Esc    : Ch := EndIt;
         Rubout : Ch := Rubout;
         Low    : begin
                     Ch := ReadKey;
                     case Ch of
                        #59 : Ch := Help;   {F1}
                        #61 : Ch := EndIt;  {F3}
                        'K' : Ch := Left;
                        'M' : Ch := Right;
                        'P' : Ch := Up;
                        'H' : Ch := Down
                        else
                           Ch := ' '
                     end
                  end
      end;
      Ch := UpCase(Ch);
      if not (Ch in s) then
      begin
        case Ch of
           'I'      : HelpText(Copyright);
           'R'      : HelpText(Rules);
           'H',Help : HelpText(h);
           EndIt    : begin
                         Count := Count + 1;
                         HelpText(Assure);
                         if Count > 1 then
                            Finish
                      end
        end;
        HelpDone := true
     end
   until Ch in s
end; {GetChar}
{------------------------------------------------------------------}
{              Procedure NameOut                                   }
{           for to display a name                                  }
{------------------------------------------------------------------}
procedure NameOut(Name : Names);
var
   i : integer;
begin
   for i:=1 to NameLength do
      if Name[i] <> ' ' then
         write(Name[i])
end;
{------------------------------------------------------------------}
{              Procedure NameIn                                    }
{           for to read a name from keyboard                       }
{------------------------------------------------------------------}
procedure NameIn(var Name : Names);
var
   i   : integer;
   c   : char;
   X,Y : integer;
   Expected : Commands;
begin
   i := 0;
   Name := Space;
   Expected := ['A'..'Z','a'..'z',Left,Rubout,Return];
   repeat
      X := WhereX; y := WhereY;
      GetChar(c,Expected,Menue);
      if c in ['A'..'Z','a'..'z'] then
      begin
         i := i + 1;
         write(c);
         Name[i] := c;
         GotoXY(X+1,Y)
      end
      else if (c = Left) or (c=Rubout) then
      begin
         if i > 0 then begin
            Name[i] := ' ';
            i := i -1;
            GotoXY(X-1,Y);
            ClrEol
         end
      end
   until ((c = Return) or (i > NameLength)) and (i > 0);
end;{NameIn}
{------------------------------------------------------------------}
{              Procedure GetEntries                                }
{           for to read score table                                }
{------------------------------------------------------------------}
procedure GetEntries;
var
   i : integer;
begin
   Assign(Memory,'rev19.DAT');
   {$I-}Reset(Memory);{$I+}
   if IOResult <> 0 then
      for i := 1 to P do
         with Entries[i] do
         begin
            Name := Space;
            Average := 0;
            Games   := 0;
            High    := 0;
            Low     := 0
         end
   else
   begin
      for i := 1 to P do
         read(Memory,Entries[i]);
      Close(Memory)
   end
end; {GetEntries}
{------------------------------------------------------------------}
{              Procedure PutEntries                                }
{           for to write score table                               }
{------------------------------------------------------------------}
procedure PutEntries;
var
   i : integer;
   c : char;
begin
   Assign(Memory,'rev19.DAT');
   {$I-}Rewrite(Memory);{$I+}
   if IOResult = 0 then
      for i := 1 to P do
         write(Memory,Entries[i])
   else
   begin
      HelpText(OutofSpace);
      GetChar(C,[' ',Return],OutofSpace)
   end;
   Close(Memory);
end; {PutEntries}
{------------------------------------------------------------------}
{              Procedure UpdateEntries                             }
{           for to change score table                              }
{------------------------------------------------------------------}
procedure UpdateEntries;
var
   i,j : integer;
   Least : real;
begin
   i := 0;
   repeat
      i := i + 1;
   until (i > P)  or (Entries[i].Name = YourName)
   or (Entries[i].Name = Space);
   if i > P then
   begin
      Least := N * MaxDepth;
      i     := P;
      for j := 1 to P do
         if Entries[j].High < Least then
         begin
            i := j;
            Least := Entries[j].High
         end;
      with Entries[i] do
      begin
         Name    := YourName;
         Average := YourPieces*Depth;
         Games   := 1;
         High    := YourPieces*Depth;
         Low     := YourPieces*Depth
      end
   end
   else if Entries[i].Name = Space then
      with Entries[i] do
      begin
         Name    := YourName;
         Average := YourPieces*Depth;
         Games   := 1;
         High    := YourPieces*Depth;
         Low     := YourPieces*Depth
      end
   else
      with Entries[i] do
      begin
         Name    := YourName;
         Average := (Games * Average+YourPieces*Depth)/(Games+1);
         Games   := Games+1;
         if YourPieces*Depth > High then
            High    := YourPieces*Depth;
         if YourPieces*Depth < Low then
            Low     := YourPieces*Depth
      end
end; {UpdateEntries}
{------------------------------------------------------------------}
{              Procedure OwnEntry                                  }
{           for to write entry for this program                    }
{------------------------------------------------------------------}
procedure OwnEntry;
var
   i,j : integer;
   Least : real;
begin
   i := 0;
   repeat
      i := i + 1;
   until (i > P)  or (Entries[i].Name = MyName)
   or (Entries[i].Name = HerName) or (Entries[i].Name = Space);
   if i > P then
   begin
      Least := N * MaxDepth;
      i     := P;
      for j := 1 to P do
         if Entries[j].High < Least then
         begin
            i := j;
            Least := Entries[j].High
         end;
      with Entries[i] do
      begin
         if Human then
            Name := HerName
         else
            Name    := MyName;
         Average := MyPieces*Depth;
         Games   := 1;
         High    := MyPieces*Depth;
         Low     := MyPieces*Depth
      end
   end
   else if Entries[i].Name = Space then
      with Entries[i] do
      begin
         if Human then
            Name := HerName
         else
            Name    := MyName;
         Average := MyPieces*Depth;
         Games   := 1;
         High    := MyPieces*Depth;
         Low     := MyPieces*Depth
      end
   else
      with Entries[i] do
      begin
         if Human then
            Name := HerName
         else
            Name    := MyName;
         Average := (Games*Average+MyPieces*Depth)/(Games+1);
         Games   := Games+1;
         if MyPieces*Depth > High then
            High    := MyPieces*Depth;
         if MyPieces*Depth < Low then
            Low     := MyPieces*Depth
      end
end; {OwnEntry}
{------------------------------------------------------------------}
{              Procedure SortEntries                               }
{           for to sort score table                                }
{------------------------------------------------------------------}
procedure SortEntries;
var
   i,j : integer;
   Help : EntryT;
begin
   for i := 1 to P-1 do
      for j := i+1 to P do
         if Entries[j].High > Entries[i].High then
         begin
            Help       := Entries[i];
            Entries[i] := Entries[j];
            Entries[j] := Help
         end
end; {SortEntries}
{------------------------------------------------------------------}
{              Procedure ShowEntries                               }
{           for to display score table                             }
{------------------------------------------------------------------}
procedure ShowEntries;
var
   i,j : integer;
begin
   TextColor(Blue);
   GotoXY(12,6);
   writeln('   Name      * Mittel  * Spiele* Max. * Min.');
   GotoXY(12,7);
   writeln('********************************************');
   for i := 1 to 12 do
   begin
      GotoXY(12,7+i);
      writeln(Entries[i].Name:10,'   * ',
              Entries[i].Average:7:1,' * ',
              Entries[i].Games:5,' * ',
              Entries[i].High:4,' * ',
              Entries[i].Low:3)
   end
end; {ShowEntries}
{------------------------------------------------------------------}
{              Function Revert                                     }
{           for to turn color in game                              }
{------------------------------------------------------------------}
function Revert(Turn : ColorT) : ColorT;
begin
     if Turn = Dark then
        Revert := Light
     else
        Revert := Dark
end;
{------------------------------------------------------------------}
{              Procedure Ask                                       }
{           for to ask player after end of game                    }
{------------------------------------------------------------------}
procedure Ask;
{beendet das Spiel}
const
   Column = 61;
var
   c : char;
begin
   c := ' ';
   GotoXY(Column,20);
   ClrEOL;
   write('Spielende');
   if not Permanent then
   begin
      GetChar(c,[Return,' '],Menue);
   end;
   ClrScr;
   GetEntries;
   UpdateEntries;
   OwnEntry;
   SortEntries;
   PutEntries;
   ShowEntries;
   TextColor(White);
   repeat
      GotoXY(12,22);
      write('Noch einmal spielen (J or N) ?  ............. ');
      if not Permanent then
         GetChar(c,['J','N'],Menue);
      if c in ['J','N'] then
         write(c)
      else
         write(' ');
   until (c in ['J','N',EndIt]) or Permanent;
   Endofall := (c = 'N') or (c = EndIt)
end; {Ask}
{------------------------------------------------------------------}
{              Procedure Message                                   }
{           for to write messages to display                       }
{------------------------------------------------------------------}
procedure Message(Move:MoveT);
const
   Column = 61;
var
   i : integer;
begin
   TextColor(White);
   GotoXY(Column,4);
   ClrEOL;
   GotoXY(Column,5);
   ClrEOL;
   GotoXY(Column,18);
   ClrEOL;
   if (Move.l = 0) and (Move.c = 0) then
   begin
      TextColor(White+Blink);
      if Turn = Me then begin
         if not Human then
            write('Ich kann nicht     ')
          else begin
             NameOut(HerName);
             write(' kann nicht');
          end
      end
      else begin
         if not Human then
            write('Du kannst nicht   ')
         else begin
            NameOut(YourName);
            write(' kann nicht');
         end
      end;
      TextColor(White);
   end
   else
      if not Human then
         if Turn = Me then
            write('Mein Zug =',Move.l,',',Move.c,' (',Move.Value,')')
         else
            write('Dein Zug =',Move.l,',',Move.c,' (',Move.Value,')')
end; {Message}
{------------------------------------------------------------------}
{              Procedure BoardFrame                                }
{           for to write Gameboard to display                      }
{           and to check for end of game                           }
{------------------------------------------------------------------}
procedure BoardFrame;
var
   Temp,Top,Bot,V,H  : string[255];
   j                 : integer;
begin
   Temp := chr(205)+chr(205)+chr(205);
   Top  := Temp+chr(209)+Temp;
   Top  := Top+Top+Top+Top+Top+Top+Top;
   Top  := chr(201)+Temp+Top+Temp+chr(187);
   Bot  := Temp+chr(207)+Temp;
   Bot  := chr(200)+Temp+Bot+Bot+Bot+Bot+Bot+Bot+Bot+Temp+chr(188);
   V    := chr(179)+'      ';
   V    := V+V+V+V+V+V+V+V+chr(186);
   V[1] := chr(186);
   H    := chr(196)+chr(196)+chr(196);
   H    := H+H+chr(197);
   H    := chr(199)+H+H+H+H+H+H+H;
   H    := H+chr(196)+chr(196)+chr(196)+chr(196)+chr(196)+chr(196);
   H    := H+chr(182);
   GotoXY(1,1);
   Textcolor(White);
   write('  ',Top);
   for j := 1 to 23 do
   begin
      GotoXY(1,j+1);
      if (j div 3)*3=j then write('  ',H) else write('  ',V)
   end;
   GotoXY(1,25);
   write('  ',Bot);
end;
{------------------------------------------------------------------}
{              Procedure Pieces                                    }
{           for to put Pieces onto Board                           }
{------------------------------------------------------------------}
procedure Pieces(Board:BoardT);
var
   Piece             : string[8];
   i,j,l,c           : integer;
begin
   for i := 1 to N do
      for j := 1 to N do
         if Board[i,j] <> Blank then
         begin
            l := 3*i-1;
            c := 7*j-2;
            if Board[i,j]=Dark  then
            begin
               TextColor(Lightblue);
               Piece:= chr(176)+chr(176);
            end;
            if Board[i,j]=Light then
            begin
               TextColor(LightRed);
               Piece:= chr(178)+chr(178);
            end;
            Piece := Piece + Piece;
            GotoXY(c,l);
            writeln(Piece);
            GotoXY(c,l+1);
            writeln(Piece)
         end;
   Textcolor(White)
end;
{------------------------------------------------------------------}
{              Procedure Info                                      }
{           for to display information                             }
{------------------------------------------------------------------}
procedure Info(Board:BoardT);
const
   Column = 61;
var
   i,j               : integer;
   Li,Da             : integer;
   Full              : boolean;
begin
   Li := 0;
   Da := 0;
   Full := true;
   for i := 1 to N do
      for j := 1 to N do
         if Board[i,j] = Blank then
            Full := false
         else if Board[i,j] = Light then
            Li := Li + 1
         else if Board[i,j] = Dark then
            Da := Da + 1;
   GotoXY(Column,2);
   ClrEOL;
   write('JDs Reversi ',Version);
   GotoXY(Column,7);
   ClrEOL;
   write('Stärke = ',Depth);
   GotoXY(Column,9);
   ClrEOL;
   write('Stand = ',Li,' : ',Da);
   MyPieces := Da;
   YourPieces := Li;
   if Full or (Mypieces = 0) or (Yourpieces = 0)
   or MeImpossible and YouImpossible then
   begin
      GotoXY(Column,5);
      ClrEol;
      Textcolor(Blue+Blink);
      GotoXY(Column,4);
      ClrEol;
      if Mypieces = 0 then
      begin
         if Human then begin
            NameOut(YourName);
            write(' gewinnt')
         end
         else
            write('Du gewinnst');
         Sounder(SongofJoy)
      end
      else if Yourpieces = 0 then
      begin
         if Human then begin
            NameOut(HerName);
            write(' gewinnt')
         end
         else
            write('Ich gewinne');
         Sounder(RadioHamburg)
      end
      else if Li > Da then
      begin
         if Human then begin
            NameOut(YourName);
            write(' gewinnt')
         end
         else
            write('Du gewinnst');
         Sounder(SongofJoy)
      end
      else if Da > Li then
      begin
         if Human then begin
            NameOut(HerName);
            write(' gewinnt')
         end
         else
            write('Ich gewinne');
         Sounder(RadioHamburg)
      end
      else
      begin
         write('unentschieden');
         Sounder(Bourree)
      end;
      TextColor(White);
      Gameended := true
   end
end; {Display}
{------------------------------------------------------------------}
{              Procedure ClearBuffer                               }
{           for to skip characters from keyboard                   }
{------------------------------------------------------------------}
procedure ClearBuffer;
{löscht Tastaturbuffer}
var
   Ch   : char;
begin
   while KeyPressed do
      Ch := ReadKey
end; {ClearBuffer}
{------------------------------------------------------------------}
{              Procedure GetMove                                   }
{           for to read human answer in game                       }
{------------------------------------------------------------------}
procedure GetMove(Board:BoardT;var Move:MoveT);
var
   ch     : char;
   i,j    : integer;
   OK     : boolean;
   Expected : Commands;
begin
   Autoplay := false;
   with Move do
   begin
      if (l=0) and (c=0) then
      begin
         l := N div 2;
         c := N div 2
      end;
      Expected := ['D','A',' ',Return,Left,Right,
                   Up,Down];
      repeat
         i := 3*l-1;
         j := 7*c-1;
         GotoXY(j,i);
         OK := false;
         GetChar(ch,Expected,Hints);
         if HelpDone then
         begin
            BoardFrame;Pieces(Board)
         end;
         case ch of
            'D'      : Debug := not Debug;
            'A'      : begin
                          Autoplay := true;
                          OK       := true
                       end;
            Return   : OK := true;
            Left     : c := (c - 1);
            Right    : c := (c + 1);
            Up       : l := (l + 1);
            Down     : l := (l - 1)
         end;
         if c = 0 then c := N;
         if l = 0 then l := N;
         if c = N+1 then c := 1;
         if l = N+1 then l := 1
      until (l >= 1) and (l <= N)
      and   (c >= 1) and (c <= N)
      and   OK
      or    AutoPlay
      or    Gameended
   end
end; {GetMove}
{------------------------------------------------------------------}
{              Procedure Parameters                                }
{           for to start game and read parameters                  }
{------------------------------------------------------------------}
procedure Parameters;
const
   Column = 24;
var
   c : char;
   i : integer;
   s   : string[20];
begin
   i := ParamCount;
   if i > 0 then
   begin
      s := ParamStr(1);
      for i := 1 to 20 do
         s[i] := UpCase(S[i]);
      if s = 'SOUND' then
         Soundoff := false
   end;
   ClrScr;
   TextColor(White);
   GotoXY(Column,8);
   writeln('JDs Reversi Version ',Version,' , ',Date);
   GotoXY(Column,10);
   writeln('    Rechnerstärke =',Power:4);
   repeat
      GotoXY(Column,12);
      write('Start (1=Du, 2=Ich, 3=Ihr) ?  ..... ');
      if not Permanent then
         GetChar(c,['1'..'5'],Menue)
      else
         c := '5';
      if c in ['1'..'5'] then
         write(c)
      else
         write(' ')
   until (c>='1') and (c<= '5');
   if c = '1' then
      Turn := You
   else if c = '2' then
      Turn := Me
   else if c = '3' then begin
      Turn  := Me;
      Depth := MaxDepth - 1;
      Human := True
   end
   else if (c = '4') or (c = '5') then
   begin
      if Random > 0.5 then
         Turn    := Me
      else
         Turn := You;
      Machine  := true;
      YourName := MyName;
      if c = '5' then
         Permanent := true
   end;
   if not Human then
      repeat
         GotoXY(Column,14);
         write('Spielstärke ( 1 bis ',MaxDepth:2,') ?     ..... ');
         if not Permanent or (Perm = ' ') then
            GetChar(c,['1'..'9'],Menue)
         else
            c := Perm;
         if (c >= '1') and (c <= Chr(MaxDepth+ord('0'))) then
            write(c)
         else
            write(' ');
         Depth := ord(c)-ord('0');
      until (c>='1') and (c<=Chr(MaxDepth+ord('0')));
   Perm := c;
   if not Machine then begin
      if Human then
         GotoXY(Column,14)
      else
         GotoXY(Column,16);
      write('Wie heißt Du ? .................... ');
      NameIn(YourName);
   end;
   if Human then begin
      GotoXY(Column,16);
      write('Wie heißt Dein(e) Partner(in) ? ... ');
      NameIn(HerName);
   end;
   ClrScr
end; {Parameters}
{------------------------------------------------------------------}
{              Procedure Busy                                      }
{           for to display a text of waiting                       }
{------------------------------------------------------------------}
procedure Busy(Turn : ColorT);
const
   Column = 61;
var
   i : integer;
begin
   TextColor(Blue);
   GotoXY(Column,5);
   ClrEOL;
   GotoXY(Column,4);
   ClrEOL;
   if not Human or AutoPlay then begin
      if not Human and not AutoPlay then
         if Turn = Me then begin
            TextColor(Blue+Blink);
            write('Ich denke')
         end
         else begin
            write('Du bist dran');
            GotoXY(Column,5);
            write('Du hast Rot')
         end
      else if not Human and Autoplay then begin
         TextColor(Blue+Blink);
         if Turn = Me then
            write('Ich denke')
         else
            write('Ich denke für Dich')
      end
      else if Human then begin
         TextColor(Blue+Blink);
         write('Ich denke für ');
         if Turn = Me then
            NameOut(HerName)
         else
            NameOut(YourName)
      end
   end
   else
      if Turn = Me then begin
         NameOut(HerName);
         write(' ist dran');
         GotoXY(Column,5);
         NameOut(HerName);
         write(' hat Blau')
      end
      else begin
         NameOut(YourName);
         write(' ist dran');
         GotoXY(Column,5);
         NameOut(YourName);
         write(' hat Rot')
      end;
   TextColor(White)
end; {Busy}
{------------------------------------------------------------------}
{              Procedure Debugger                                  }
{           for to debug this program                              }
{------------------------------------------------------------------}
procedure Debugger(Move:MoveT;Value:integer);
const
   Column = 61;
begin
   if Debug then
   begin
      GotoXY(Column,16);
      Textcolor(White);
      ClrEOL;
      write('T=',Move.l,',',Move.c,',',
            Move.Value,' (',Value,')');
      readln
   end
end; {Debugger}
{------------------------------------------------------------------}
{              Procedure GetMoves                                  }
{           for to find out possible moves for                     }
{           color Turn                                             }
{------------------------------------------------------------------}
procedure GetMoves(Board : BoardT; Var Moves : MovesT;Turn : ColorT);
var
   i,j,i1,j1,k1  : Range;
   count         : integer;
   MaxValue      : integer;
   Reverse       : ColorT;
begin
   count := 0;
   Moves.Max := 0;
   Reverse := Revert(Turn);
   FreePlaces := 0;
   for i :=1 to N do
      for j := 1 to N do
         if Board[i,j] = Blank then
         begin
            MaxValue := 0;
            FreePlaces := FreePlaces + 1;
            i1 := i + 1;
            while (i1 <= N) and (Board[i1,j] = Reverse) do
               i1 := i1 + 1;
            if (i1 <= N) and (Board[i1,j] = Turn) then
               MaxValue := i1 - i - 1;
            i1 := i - 1;
            while (i1 >= 1) and (Board[i1,j] = Reverse) do
               i1 := i1 - 1;
            if (i1 >= 1) and (Board[i1,j] = Turn) then
               MaxValue := MaxValue + i - i1 - 1;
            j1 := j + 1;
            while (j1 <= N) and (Board[i,j1] = Reverse) do
               j1 := j1 + 1;
            if (j1 <= N) and (Board[i,j1] = Turn) then
               MaxValue := MaxValue + j1 - j - 1;
            j1 := j - 1;
            while (j1 >= 1) and (Board[i,j1] = Reverse) do
               j1 := j1 - 1;
            if (j1 >= 1) and (Board[i,j1] = Turn) then
               MaxValue := MaxValue + j - j1 - 1;
            k1 := 1;
            while (i + k1 <= N) and (j + k1 <= N)
               and (Board[i+k1,j+k1] = Reverse) do
               k1 := k1 + 1;
            if (i+k1 <= N) and  (j+k1 <= N)
               and (Board[i+k1,j+k1] = Turn) then
               MaxValue := MaxValue + k1 - 1;
            k1 := 1;
            while (i - k1 >= 1) and (j - k1 >= 1)
               and (Board[i-k1,j-k1] = Reverse) do
               k1 := k1 + 1;
            if (i-k1 >= 1) and  (j-k1 >= 1)
               and (Board[i-k1,j-k1] = Turn) then
               MaxValue := MaxValue + k1 - 1;
            k1 := 1;
            while (i + k1 <= N) and (j - k1 >= 1)
               and (Board[i+k1,j-k1] = Reverse) do
               k1 := k1 + 1;
            if (i+k1 <= N) and  (j-k1 >= 1)
               and (Board[i+k1,j-k1] = Turn) then
               MaxValue := MaxValue + k1 - 1;
            k1 := 1;
            while (i - k1 >= 1) and (j + k1 <= N)
               and (Board[i-k1,j+k1] = Reverse) do
               k1 := k1 + 1;
            if (i-k1 >= 1) and  (j+k1 <= N)
               and (Board[i-k1,j+k1] = Turn) then
               MaxValue := MaxValue + k1 - 1;
            if MaxValue > 0 then
            begin
               count := count + 1;
               with Moves do
               begin
                  Max := count;
                  M[count].Value := 0;
                  M[count].l := i;
                  M[count].c := j
               end
            end
         end
end; {GetMoves}
{------------------------------------------------------------------}
{              Procedure BoardValue                                }
{           for to evaluate winning strategy                       }
{------------------------------------------------------------------}
function BoardValue(Board:BoardT;Turn:ColorT) : integer;
var
   i,j    : Range;
   Value  : integer;
begin
   Value := 0;
      for i:=1 to N do
      for j := 1 to N do
         if Board[i,j] = Turn then
         begin
            if (i=1) and (j=1)
            or (i=1) and (j=N)
            or (i=N) and (j=1)
            or (i=N) and (j=N) then
               Value := Value + Advantage*Advantage
            else if (i=1) or (i=N)
            or      (j=1) or (j=N) then
               Value := Value + Advantage
            else if ((i=2) or (i=N-1)) and ((j=2) or (j=N-1)) then
               Value := Value - Advantage*Advantage
            else
               Value := Value + 1;
         end;
         if Value < 0 then
            Value := 0;
   BoardValue := Value
end; {BoardValue}
{------------------------------------------------------------------}
{              Procedure SetMove                                   }
{           for to turn around pieces                              }
{------------------------------------------------------------------}
procedure SetMove (var Board:BoardT;Move:MoveT;Turn:ColorT);
var
   i,j,i1,j1,k1   : Range;
   Reverse        : ColorT;
begin
   Legal := false;
   Reverse := Revert(Turn);
   if not ((Move.l=0) and (Move.c=0) and (Move.Value=0))
   and (Board[Move.l,Move.c] = Blank) then
   with Move do
   begin
       i1 := l + 1;
       while (i1 <= N) and (Board[i1,c] = Reverse) do
          i1 := i1 + 1;
       if (i1 <= N) and (Board[i1,c] = Turn) then
          for i := l+1 to i1 - 1 do
          begin
             Legal := true;
             Board[i,c] := Turn
          end;
       i1 := l - 1;
       while (i1 >= 1) and (Board[i1,c] = Reverse) do
          i1 := i1 - 1;
       if (i1 >= 1) and (Board[i1,c] = Turn) then
          for i := l-1 downto i1 + 1 do
          begin
             Legal := true;
             Board[i,c] := Turn
          end;
       j1 := c + 1;
       while (j1 <= N) and (Board[l,j1] = Reverse) do
          j1 := j1 + 1;
       if (j1 <= N) and (Board[l,j1] = Turn) then
          for j := c+1 to j1 - 1 do
          begin
             Legal := true;
             Board[l,j] := Turn
          end;
       j1 := c - 1;
       while (j1 >= 1) and (Board[l,j1] = Reverse) do
          j1 := j1 - 1;
       if (j1 >= 1) and (Board[l,j1] = Turn) then
          for j := c-1 downto j1 + 1 do
          begin
             Legal := true;
             Board[l,j] := Turn
          end;
       k1 := 1;
       while (l + k1 <= N) and (c + k1 <= N)
          and (Board[l+k1,c+k1] = Reverse) do
          k1 := k1 + 1;
       if (l+k1 <= N) and  (c+k1 <= N)
          and (Board[l+k1,c+k1] = Turn) then
          for i := 1 to k1 - 1 do
          begin
             Legal := true;
             Board[l+i,c+i] := Turn
          end;
       k1 := 1;
       while (l - k1 >= 1) and (c - k1 >= 1)
          and (Board[l-k1,c-k1] = Reverse) do
          k1 := k1 + 1;
       if (l-k1 >= 1) and  (c-k1 >= 1)
          and (Board[l-k1,c-k1] = Turn) then
          for i := k1-1 downto 1 do
          begin
             Legal := true;
             Board[l-i,c-i] := Turn
          end;
       k1 := 1;
       while (l + k1 <= N) and (c - k1 >= 1)
          and (Board[l+k1,c-k1] = Reverse) do
          k1 := k1 + 1;
       if (l+k1 <= N) and  (c-k1 >= 1)
          and (Board[l+k1,c-k1] = Turn) then
          for i := 1 to k1 - 1 do
          begin
             Legal := true;
             Board[l+i,c-i] := Turn
          end;
       k1 := 1;
       while (l - k1 >= 1) and (c + k1 <= N)
          and (Board[l-k1,c+k1] = Reverse) do
          k1 := k1 + 1;
       if (l-k1 >= 1) and  (c+k1 <= N)
          and (Board[l-k1,c+k1] = Turn) then
          for i := k1-1 downto 1 do
          begin
             Legal := true;
             Board[l-i,c+i] := Turn
          end;
       if Legal then
          Board[l,c] := Turn;
   end
end; {SetMove}
{------------------------------------------------------------------}
{              Procedure Play                                      }
{           for to make senseful moves                             }
{           recursive procedure                                    }
{------------------------------------------------------------------}
procedure Play(Lookahead:integer; Board:BoardT;
               Turn:ColorT;var BestMove:MoveT);
var
   Future    : MoveT;
   Moves     : MovesT;
   Save      : BoardT;
   DepthSave : integer;
   i         : integer;
function Choice : boolean;
begin
   Choice := (Future.Value = BestMove.Value) and (Random > 0.5)
end;
begin
   GetMoves(Board,Moves,Turn);
   DepthSave := Depth;
   if FreePlaces < Depth then
      Depth := FreePlaces;
   BestMove := NoMove;
   if Lookahead = Depth then
   begin
     for i := 1 to Moves.Max do
     begin
        Save := Board;
        SetMove(Board,Moves.M[i],Turn);
        Moves.M[i].Value := BoardValue(Board,Turn);
        if Moves.M[i].Value > BestMove.Value then
           BestMove := Moves.M[i];
        Board := Save
     end
   end
   else if Lookahead = 1 then
   begin
      Busy(Turn);
      if not odd(Depth) then
         BestMove.Value := GameWon;
      for i := 1 to Moves.Max do
      begin
         Save := Board;
         SetMove(Board,Moves.M[i],Turn);
         Moves.M[i].Value := BoardValue(Board,Turn);
         if Moves.M[i].Value < Advantage*Advantage then
         begin
            Play(Lookahead+1,Board,Revert(Turn),Future);
            if odd(Depth) then
            begin
               if (Future.Value > BestMove.Value)
               or Choice then
               begin
                  BestMove := Moves.M[i];
                  BestMove.Value := Future.Value
               end
            end
            else
            begin
               if (Future.Value < BestMove.Value)
               or Choice then
               begin
                  BestMove := Moves.M[i];
                  BestMove.Value := Future.Value
               end
            end
         end
         else
            BestMove := Moves.M[i];
         Board := Save;
         Debugger(Moves.M[i],BestMove.Value)
      end
   end
   else if (Lookahead <= Depth) then
   begin
      for i := 1 to Moves.Max do
      begin
         Save := Board;
         SetMove(Board,Moves.M[i],Turn);
         Play(Lookahead+1,Board,Revert(Turn),Future);
         if Future.Value > BestMove.Value then
            begin
               BestMove := Moves.M[i];
               BestMove.Value := Future.Value
            end;
         Board := Save
      end
   end;
   Depth := DepthSave
end; {Play}
{------------------------------------------------------------------}
{              Procedure InitGame                                  }
{           for to start a new game                                }
{------------------------------------------------------------------}
procedure InitGame;
var
   i,j  : integer;
begin
   Compute(Power);
   MaxDepth      := 4 + trunc(ln(Power/6));
   { ---------- }
   Soundoff      := true;
   HelpDone      := false;
   FreePlaces    := N*N;
   YourPieces    := 0;
   MyPieces      := 0;
   MeImpossible  := false;
   YouImpossible := false;
   Autoplay      := false;
   Gameended     := false;
   Debug         := false;
   Human         := false;
   Machine       := false;
   Me            := Dark;
   You           := Light;
   YourName      := Space;
   HerName       := 'Partner';
   with NoMove do
   begin
      Value := 0;
      l     := 0;
      c     := 0
   end;
   with Move do
   begin
      Value := 0;
      l     := N div 2;
      c     := N div 2
   end;
   for i := 1 to N do
      for j := 1 to N do
         Board[i,j] := Blank;
   Board[N div 2,N div 2] := Light;
   Board[N div 2, N div 2 + 1] := Light;
   Board[N div 2 + 1, N div 2] := Dark;
   Board[N div 2 + 1, N div 2 + 1] := Dark;
   if Random > 0.5 then
   begin
      Board[N div 2, N div 2 + 1] := Dark;
      Board[N div 2 + 1, N div 2 + 1] := Light
   end;
end; {InitGame}
{------------------------------------------------------------------}
{              Procedure HumanPlayer                               }
{           for to get command from keyboard                       }
{------------------------------------------------------------------}
procedure HumanPlayer(He:ColorT);
var
   c : char;
begin
   AutoPlay := false;
   if He = Me then
      MeImpossible := false
   else
      YouImpossible := false;
   Busy(He);
   GetMoves(Board,Moves,He);
   if Moves.Max = 0 then
   begin
      Message(NoMove);
      if He = Me then
         MeImpossible := true
      else
         YouImpossible := true
   end
   else
   begin
      GetMove(Board,Move);
      if Autoplay then
      begin
         Play(1,Board,He,Move);
         SetMove(Board,Move,He);
         Message(Move)
      end
      else if not Gameended then
      begin
         SetMove(Board,Move,He);
         if not Legal then
         begin
            HelpText(Illegal);
            GetChar(c,[Return,Left,Right,Up,Down,'A','D',' '],Hints);
            BoardFrame;Pieces(Board);
            Turn := Revert(Turn)
         end
      end;
      Message(Move)
   end
end; {HumanPlayer }
{------------------------------------------------------------------}
{              Procedure Initialize                                }
{           for to start program                                   }
{------------------------------------------------------------------}
procedure Initialize;
begin
   Randomize;
   Endofall  := false;
   Permanent := false;
   Perm      := ' ';
   VirusCheck
end; { Initialize }
{------------------------------------------------------------------}
{              Program Body                                        }
{           overall organization                                   }
{------------------------------------------------------------------}
begin
   Initialize;
   repeat
      InitGame;
      Parameters;
      BoardFrame;
      Pieces(Board);
      Info(Board);
      repeat
         { -------------------- }
         { Me-Player is on Turn }
         { -------------------- }
         if Turn = Me then
         begin
            if not Human then
            begin
               Play(1,Board,Me,Move);
               MeImpossible := Move.l = 0;
               if not MeImpossible then
                  SetMove(Board,Move,Me);
               Message(Move)
            end
            else
               HumanPlayer(Me)
         end
         { --------------------- }
         { You-Player is on Turn }
         { --------------------- }
         else if Turn = You then
         begin
            if Machine then
            begin
               Play(1,Board,You,Move);
               YouImpossible := Move.l = 0;
               if not YouImpossible then
                  SetMove(Board,Move,You);
               Message(Move)
            end
            else
               HumanPlayer(You);
         end;
         Pieces(Board);
         Info(Board);
         Turn := Revert(Turn)
      until Gameended or MeImpossible and YouImpossible;
      Ask
   until Endofall;
   Finish
end. {Program}
{------------------------------------------------------------------}
{              End of Program                                      }
{------------------------------------------------------------------}