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;