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 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;