old/PAS/XO/rod4.inc

Procedure RodNew(cx:byte; var x,y : byte);far;
Procedure incM(var x : real;a:real);
begin
 x:=x+a;
end;

Var
 Prior : array [1..n,1..n] of real;
 xx,yy,bx,by   : 1..n;
 k   : -4..4;
 pr  : byte;
 cn : array[1..4] of real;
Begin
  for xx:=1 to n do for yy := 1 to n do prior[xx,yy] := 0;
  pr := 3-cx;
  for yy := 1 to n do
    for xx := 1 to n do
      if pole[xx,yy] = 0 then
      begin
       for k := -4 to 4 do cn[k] := 0;
       if (pole[xx-1,yy-1]=pr) and
          (pole[xx-1,yy+1]=pr) and
          (pole[xx+1,yy-1]=pr) and
          (pole[xx+1,yy+1]=pr) then prior[xx,yy] := MAxINt;
       {-------------------------------------------------}
       for k := -4 to 4 do
        begin
         if (pole[xx+k,yy+k]=pr) then incm(cn[1],1+1/abs(k));
         if (pole[xx+k,yy-k]=pr) then incm(cn[2],1+1/abs(k));
         if (pole[xx+k,yy]=pr) then incm(cn[3],1+1/abs(k));
         if (pole[xx,yy-k]=pr) then incm(cn[4],1+1/abs(k));

         if (pole[xx+k,yy+k]=cx) then incm(cn[1],-1/abs(k));
         if (pole[xx+k,yy-k]=cx) then incm(cn[2],-1/abs(k));
         if (pole[xx+k,yy]=cx) then incm(cn[3],-1/abs(k));
         if (pole[xx,yy-k]=cx) then incm(cn[4],-1/abs(k));
        end;
       for k := 1 to 4 do if cn[1] > 4.8 then
       begin
        if cn[1] > 6 then prior[xx,yy] := maxint else
        incm(prior[xx,yy],cn[k]*2);
       end;
       {-------------------------------------------------}
{-------==================‚®¤®à §¤¥«====================----------}
       for k := -4 to 4 do
        begin
         if (pole[xx+k,yy+k]=cx) then incm(prior[xx,yy],1+1/2/abs(k));
         if (pole[xx+k,yy-k]=cx) then incm(prior[xx,yy],1+1/2/abs(k));
         if (pole[xx+k,yy]=cx) then incm(prior[xx,yy],1+1/2/abs(k));
         if (pole[xx,yy-k]=cx) then incm(prior[xx,yy],1+1/2/abs(k));
        end;
      end;

{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

  randomize;

  bx:=1;
  by:=1;

  for yy := 1 to n do for xx := 1 to n do
    if (prior[xx,yy] > prior[bx,by]) or
       ((prior[xx,yy] =prior[bx,by]) and (random(100)=5)) then
    begin
      bx := xx;
      by := yy;
    end;

  x := bx;
  y := by
End;