old/PAS/XO/BENCH/XO.PAS

uses CRT;
Const
 n      = 20;
 NameX  = 'Rod2';
 NameO  = 'Rod';
 ColorX = LightBlue;
 ColorO = LightRed;
 PoleY1 = 110;
 PoleL  = 460-PoleY1;
 Cell   = PoleL / n;
 PoleX1 = round(320 - (Cell*n) / 2);
 PoleX2 = round(320 + (Cell*n) / 2);
 PoleY2 = round(PoleY1+n*cell);
 TimeT  = 5*25*2;
 DelX   = round(TimeT/Cell/2);
 DelO   = round(TimeT/360);

Type TPole    = array [-4..n+4,-4..n+4] of byte;
     TurnProc = procedure(cx:byte;var x,y:byte);
     PointType = record
               x,y : byte;
     end;

Var
  Pole  : TPole;
  TP    : Tpole;
  Ex    : boolean;
  Win   : byte;
  xc,yc : byte;
  count : 0..n*n+1;
  WinX,WinO,Games,i,j : word;
  ENDS  : array [1..5] of pointtype;
  TurnX : TurnProc;
  TurnO : TurnProc;
  TurnT : turnProc;

{$I Rod.inc}
{$I GRISHA1.inc}


{---------------------------}
Function IsWin(x,y:byte):byte;
var
 x1,y1 : byte;
 k1,k2,l1,l2 : byte;
 res : byte;
begin
 res := 0;
 if x-4<1 then k1 := 1 else k1 := x - 4;
 if x+4>n then k2 := n else k2 := x + 4;
 if y-4<1 then l1 := 1 else l1 := y - 4;
 if y+4>n then l2 := n else l2 := y + 4;
 for x1 := k1 to k2 do
   for y1 := l1 to l2 do
     if (pole[x1,y1]<>0) then begin
       if ((pole[x1,y1]=pole[x1,y1-2]) and
           (pole[x1,y1]=pole[x1,y1-1]) and
           (pole[x1,y1]=pole[x1,y1+1]) and
           (pole[x1,y1]=pole[x1,y1+2])) then res := pole[x1,y1];
       if ((pole[x1,y1]=pole[x1-2,y1]) and
           (pole[x1,y1]=pole[x1-1,y1]) and
           (pole[x1,y1]=pole[x1+1,y1]) and
           (pole[x1,y1]=pole[x1+2,y1])) then res := pole[x1,y1];
       if ((pole[x1,y1]=pole[x1-2,y1-2]) and
           (pole[x1,y1]=pole[x1-1,y1-1]) and
           (pole[x1,y1]=pole[x1+1,y1+1]) and
           (pole[x1,y1]=pole[x1+2,y1+2])) then res := pole[x1,y1];
       if  ((pole[x1,y1]=pole[x1+2,y1-2]) and
           (pole[x1,y1]=pole[x1+1,y1-1]) and
           (pole[x1,y1]=pole[x1-1,y1+1]) and
           (pole[x1,y1]=pole[x1-2,y1+2])) then res := pole[x1,y1];
            end;
 IsWin := Res;
end;{IsWin}
{---------------------------}
Function IsLeg(x,y:byte):boolean;
var res:boolean; i,j : byte;
begin
  res := true;
  if not (x in [1..n]) then
    res := false;
  if not (y in [1..n]) then
    res := false;
  for i := 1 to n do for j := 1 to n do if pole[i,j] <> tp[i,j] then
    res := false;
  if tp[x,y] <> 0 then
    res := false;
  pole := tp;
  IsLeg:=res;
end;{IsLeg}
{-------------------------}
Procedure GameOver(c : byte);
Var
 sc,s1 : string;
Begin
  Case c of
   1: inc(Winx);
   2: inc(WinO);
   3: inc(WinO);
   4: inc(Winx);
   end;
  Ex := true;
End;{GameOver}
{------------------------}
const
 GA = 1000;
BEGIN
  TurnX:=GRISHA1;
  TurnO:=RodNewTurn;
  ClrScr;
  Write('WinX:');
  for games := 1 to ga do begin
  for i := 1 to n do for j:= 1 to n do pole[i,j] :=0;
  ex := false;
  count := 0;
  repeat
    tp := pole;
    TurnX(1,xc,yc);
    if not isLeg(xc,yc) then GameOver(3)
    else begin
    inc(count);
    Pole[xc,yc] := 1;
    win := iswin(xc,yc);
    if (count=n*n) then GameOver(5) else begin
    if Win <> 0 then GameOver(1) else
    begin
      tp := pole;
      TurnO(2,xc,yc);
      if not isLeg(xc,yc) then gameover(4)
      else
      begin
       Pole[xc,yc] := 2;
       Inc(count);
       win := iswin(xc,yc);
       if (count=n*n) then GameOver(5) else begin
        if Win <> 0 then GameOver(2);
      end;
    end;
    end;
    end;
    end;
  until Ex;
  TurnT := TurnX;
  TurnX := TurnO;
  TurnO := TurnT;
  WinX := WinX xor WinO;
  WinO := WinX xor WinO;
  WinX := WinX xor WinO;
  end;
  Write(WinX:4,' WinO: ',WinO:4);
  WriteLn;
  WriteLn(WinX / ga * 100:2:0,'%');
  ReadKey;
END.