old/PAS/XO/PINPANPO.inc

procedure  game(flag : byte; var x,y : byte);far;
var
waitesplay : array [1..n*n] of integer;
waitesenemy : array[1..n*n] of integer;
maxwaitpl,maxpl,maxen  : integer;
maxwaiten   : integer;
i,x1,y1,pl,en : integer;
{==============================================} {x v pole}
  function coordx(k : byte) : byte;
   begin
    if  k mod n = 0 then
     coordx := n
    else
     coordx := k mod n;
   end;
{=============================================}
{==============================================} {y v pole}
  function coordy(k : byte) : byte;
   begin
    if k mod n = 0 then
     coordy := k div n
    else
    coordy := k div n +1
   end;
{=============================================}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
{==============================================} {schitibaet massiv po diagonali}
  procedure getmasrow (var mas:mo2; k:byte; pol:mo);
   var
   l,i,j : integer;
   begin
    j := coordy(k);
    l := coordx(k);
     for i := l-4 to l+4 do
      begin
       if (i < 1)or (i>n) then
        mas[i-l+5]:=3
      else
        mas[i-l+5]:= pol[j,i];  {!@!!@@$#@$##$%#%^$%^$%^$%^$^}
      end;
   end;
{=============================================}
{==============================================}  {schitibaet massiv po verticali}
  procedure getmasst (var mas: mo2;k:byte;pol: mo);
   var
   l,i,j : integer;
   begin
    l := coordy(k);
    j := coordx(k);
    for i := l-4 to l+4 do
     begin
      if (i<1) or (i>n) then
       mas[i-l+5] := 3
      else
       mas[i-l+5]:=pol[i,j];
     end;
   end;
{=============================================}
{==============================================}  {schitibaet massiv po naclonnnoy c left to right}
  procedure getmasleftn (var mas: mo2;k:byte;pol: mo);
   var
   l,i,j,h,f : integer;
   begin
    f := 1;
    h := coordy(k);
    l := coordx(k);
    j := h-4;
    for i := l-4 to l+4 do
      begin
       if (i<1)or (i>n)or(j<1)or(j>n) then
        begin
         mas[f]:=3;
         inc(f);
        end
       else
        begin
         mas[f] := pol[j,i];
         inc(f);
        end;
       inc(j);
      end;
   end;
{=============================================}
{=============================================} {schitibaet massiv po naclonnoy c right to left}
  procedure getmasrightn (var mas: mo2;k:byte;pol :mo);
   var
   l,i,j,h,r,f : integer;
   begin
    f := 1;
    h := coordy(k);
    l := coordx(k);
    j := h-4;
    for i := l+4  downto l-4 do
      begin
       if (i<1)or (i>n)or(j<1)or(j>n) then
        begin
         mas[f]:=3;
         inc(f);
        end
       else
        begin
         mas[f] := pol[j,i];
         inc(f);
        end;
       inc(j);
      end;
    end;
{=============================================}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
{==============================================}      {osnovnoy prov!!!!!!}
  function analis (play: byte; k: byte; pol: mo):byte ;
   var
   mas:mo2;
   weight1 :array[1..4] of byte;
   maxweight,i : byte;
   {------------------------------------------------------}
    function   analis9 (play:byte;pol: mo;mas:mo2): byte ;
    var
     i,right,left,nx,l,r,max : integer;
     wait6 :array[1..4] of byte;
    {------------------------------------------------------}
     function analis6(left:integer;mas : mo2;play : byte) : byte;
      var
       i,nz,nzz,nzx,nxx,nx,nzzxx,nx1 :integer;
      begin
       nx:=0;
       nz:=0;
       for i := l to l+5 do
        if mas[i] = 0 then
         begin
          inc(nz);
           if nzz < nz then
            nzz:=nz;
           if nxx >0 then
            inc(nzx);
          nx := 0;
         end
        else
         begin
          inc(nx1);
          inc(nx);
           if nxx<nx then
            nxx:=nx;
          nz :=0;
          nzzxx:=nzx;
         end;
       case nxx of
          5 :  analis6 :=99;  {-xxxxx}
          4 : begin if nzz = 1 then analis6 :=96 {-xxxx-}
                      else analis6 :=87;       {xxxx--}
                    if nx1 = 5 then analis6 :=93;{xxxx-x}
              end;
          3 : begin case nx1 of
                     5 : analis6 := 91;   {xxx-xx}
                     4 : if nzz=1 then analis6 := 91{xxx-x-}
                         else analis6 :=76;      {xxx--x}
                     3 : if nzz = 2 then analis6 := 90   {-xxx--}
                         else analis6 := 50;{xxx---}
                    end;
              end;
          2 : begin  case nx1 of
                     4 : if nzz=1 then analis6:=78  {xx-x-x}
                         else  analis6 :=60;     {xx--xx}
                     3 : begin case nzz of
                                  1 : analis6 :=60;     {-xx-x-}
                                  2 : if nzzxx =1 then analis6:=50 {xx-x--}
                                      else analis6 :=51;{xx--xx-}
                                  3 : analis6 := 40;   {xx---x}
                               end
                         end;
                     2 : if (nzz=2)and(nzz=3) then analis6 := 20   {--xx-- -xx---}
                         else analis6 := 15; {xx----}
                     end
              end;
          1 : begin  case nx1 of
                      3 : analis6 := 30; {x-x-x-}
                      2 : analis6 := 9;
                      1 : if nzz < 5 then analis6 := 5 {-x-}
                          else analis6 := 1; {x-----}
                     end
              end
       end;
      end;
    {------------------------------------------------------}
    begin
      nx := 0;
      for i := 6 to 9 do
        if (mas[i] <> play)and(mas[i]<>0) then
         begin
          right := i-1;
          break;
         end
        else right := i;
      for i :=4 downto 1 do
        if (mas[i] <> play)and(mas[i]<>0) then
         begin
          left := i+1;
          break;
         end
        else left := i;
       if (right-left)<= 3 then
        begin
         analis9 := 0;
         exit;
        end
       else
        begin
         if right-left = 4 then
          begin
           for i := left to right do
            if mas[i] = play then inc(nx);
            case nx of
              5 : analis9 :=99;
              4 : analis9 :=80;
              3 : analis9 :=30;
              2 : analis9 :=15;
              1 : analis9 := 7;
             end;
           exit;
          end
         else
          begin
           l :=left;
           for i:=l to(right-left)-4 do
            begin
             wait6[i-l+1] := analis6(l,mas,play);
             inc(l);
            end;
           max := mas[1];
           for i :=2 to 4 do
             if wait6[i] > wait6[max] then
              max:= i;
           analis9 := wait6[max];

          end;
        end;
    end;
   {-------------------------------------------------}
  begin
   getmasrow (mas,k,pol);
   weight1[1] := analis9 (play,pol,mas);
   getmasst  (mas,k,pol);
   weight1[2] := analis9 (play,pol,mas);
   getmasrightn (mas,k,pol);
   weight1[3] := analis9 (play,pol,mas);
   getmasleftn (mas,k,pol);
   weight1[4]:= analis9 (play,pol,mas);
   maxweight := weight1[1];
    for i := 2 to 4 do
     if weight1[i]>maxweight then
      maxweight := weight1[i];
   analis :=maxweight;
  end;
{=============================================}
 begin
  fillchar(waitesplay,n*n,0);
  fillchar(waitesenemy,n*n,0);
  if flag = 1 then
    begin
     pl := 1;
     en := 2;
    end
  else
    begin
     pl :=2;
     en :=1;
    end;
  for i :=1 to n*n do
   begin
    x1:= coordx(i);
    y1 := coordy(i);
    if pole[y1,x1] = 0 then
     begin
      pole[y1,x1]:=pl;
      waitesplay[i]:=analis(pl,i,pole);
      pole[y1,x1]:=en;
      waitesenemy[i] := analis(en,i,pole);
      pole[y1,x1]:=0;
     end
    else
     begin
      waitesplay[i]:=-1;
      waitesenemy[i] :=-1;
     end
   end;
  maxwaitpl := waitesplay[1];
  maxwaiten := waitesenemy[1];
  maxpl := 1;
  maxen := 1;
   for i := 2 to n*n do
    begin
     if maxwaitpl < waitesplay[i] then
       begin
        maxwaitpl := waitesplay[i];
        maxpl := i;
       end;
     if maxwaiten < waitesenemy[i] then
       begin
        maxwaiten := waitesenemy[i];
        maxen := i;
       end;
    end;
   if maxwaitpl >= maxwaiten then
    begin
     x := coordx(maxpl);
     y := coordy(maxpl);
    end
   else
    begin
     x := coordx(maxen);
     y := coordy(maxen);
    end;
 end;