2011 m. balandžio 13 d., trečiadienis

Nesėkmingas bandymas suprogramint šachmatus

Žiemą buvau pasirašęs šachmatų programos juodraštį. Pavasario pradžioje dar kartą prisėdau prie programos (2011-03-04+), tiksliau pradžioje prie sąsiuvinio, ir kelias valandas programinau sąsiuvinyje. Vėliau prisiruošiau bandyti perkelinėti viską į kompiuterį ir žiūrėti, kas gausis. Perkelinėjau į kompiuterį programą tokiame lygyje, kad žaisti galima: darant ėjimus, tačiau be tokių mandrų ėjimų, kaip rokiruotė, kirtimas prasilenkiant, figūros vertimas kita pasiekus paskutinę gulstinę ir pnš. Taipogi nebuvo realizuotas matas, t.y. žaidimo esmė: "pralaimėjimo varžovui paskelbimas".

Ir, po kelių pataisymų, tokia "betikslė" programa veikė.

Tada per dar kokias dvi dienas pažaidžiau su Pascaliu, kol išmokiau daryti leistinus ėjimus su karaliumi, reaguoti į šachus, drausti kirsti prasilenkiant netinkamu laiku. Visos tokios išimtys ir j apdorojimas užima daugiau kaip 2/3 programos teksto :/

Iš pradžių pateiksiu programos screenshotą, t.y. negrafinėje aplinkoje atvaizduotą partijos pradžios fragmentą, o toliau pateiksiu kodą.
Ši programa užima virš 300 eilučių, tai ilgiausia kada nors rašyta mano programa ir daugiausiai laiko.



program chessbeta_2011_03_04_RS;
uses crt;
// type figa= (_,R,N,B,Q,K,p);
var a: array [1..8,1..8] of integer;
mv: array [1..100] of integer;
n1: array [1..8] of boolean;
rok: array [1..20] of boolean;
i,j, move,mov, fig,en, atmp, R1,RR, ec, ko1,ko2,ko3,ko4, kn,km: integer;
x,y,v,z,kx,ky,bx,by,jx,jy, xx, max,max2,min2, che: integer;
kieno, kie,ch,ch2: string;
// f: figa;
check, enorm, boo1,boo2,boo3,bool,boor, nn,m, dmw,dmb, eQ, c1,c2: boolean;

begin
clrscr;

a[1,1]:=1; a[1,8]:=11; a[8,1]:=1; a[8,8]:=11; //bokstai
a[2,1]:=2; a[2,8]:=12; a[7,1]:=2; a[7,8]:=12; //zirgai
a[3,1]:=3; a[3,8]:=13; a[6,1]:=3; a[6,8]:=13; //rikiai
a[4,1]:=4; a[4,8]:=14; a[5,1]:=5; a[5,8]:=15; //valdoves ir karaliai
for i:=1 to 8 do begin a[i,2]:=6; a[i,7]:=16; end; //pestininkai
for i:=1 to 8 do for j:=3 to 6 do a[i,j]:=0; //tusti langeliai

bx:=5; by:=1; jx:=5; jy:=8; //pradines karaliu koordinates
R1:=0; move:=0; mv[1]:=9999; mov:=0; dmb:=false; dmw:=false;
while R1=0 do
begin
clrscr;

move:=move+1;
mov:=move mod 2;

for j:=8 downto 1 do //nupiesiama grazi lenta
begin
for i:=1 to 8 do
begin
if a[i,j] div 10 = 1 then ch2:='1' else ch2:='+';
if a[i,j] mod 10 = 0 then ch:='.' else
if a[i,j] mod 10 = 1 then ch:='R' else
if a[i,j] mod 10 = 2 then ch:='N' else
if a[i,j] mod 10 = 3 then ch:='B' else
if a[i,j] mod 10 = 4 then ch:='Q' else
if a[i,j] mod 10 = 5 then ch:='K' else
if a[i,j] mod 10 = 6 then ch:='p';
if a[i,j] mod 10 = 0 then write(' ',ch,' ') else
write(' ', ch2+ch:2);
end;
writeln;
end;
writeln;
for i:=1 to move do writeln(i:2,' from: ', mv[i] div 100:2,' to: ', mv[i] mod 100:2,' ',(i+1) div 2); //isspausdinamas ejimu sarasas


if mov=1 then kieno:='Baltieji' else kieno:='Juodieji';


if mov=1 then //konstantos baltuju...
begin
ko1:=10; ko2:=17; ko3:=-1; ko4:=6;
end;

if mov=0 then //konstantos juoduju...
begin
ko1:=0; ko2:=7; ko3:=1; ko4:=12;
end;

for i:=1 to 20 do rok[i]:=false; //rokiruotes galimos

repeat
begin
enorm:=true; // =kol kas ejimas normalus

repeat //nuskaitom ejimo koordinates
begin
writeln(kieno, ' atlikite ejima');
READLN(x,y,v,z);
m:=(x>0) and (y>0) and (v>0) and (z>0) and (x<9) and (y<9) and (v<9) and (z<9);
m:=m and (((mov=1) and (a[x,y] in [1..6])) or ((mov=0) and (a[x,y] in [11..16])));
if not m then writeln('klaida');
end;
until m=true;


if mov=1 then begin kx:=bx; ky:=by; end; //baltuju karaliaus koordinaciu nurasymas
if mov=0 then begin kx:=jx; ky:=jy; end; //juoduju karaliaus koordinaciu nurasymas
writeln('karalius: ',kx,' ',ky); //trinti veliau

{ check:=false; (...?)
...tikriname ar shachas...
if check=true then writeln('check!');
}
fig:=a[x,y]; en:=a[v,z];
writeln('fig:=a[x,y]= ',a[x,y],' en:=a[v,z]= ',a[v,z]); //trinti veliau


if fig in [1,11,4,14] then //bokstas (valdove)
begin
if fig in [1,11] then writeln('fig 1/11') else writeln('fig 4,14');
if ((en=0) or ((en>ko1) and (en
begin
if x-v<>0 then
begin
xx:=abs(x-v);
max:=(x+v+xx) div 2;
while xx>1 do
begin
max:=max-1; xx:=xx-1;
if a[max,y]<>0 then
begin enorm:=false; xx:=0; ec:=1; end;
end;
end;
if y-z<>0 then
begin
xx:=abs(y-z);
max:=(y+z+xx) div 2;
while xx>1 do
begin
max:=max-1; xx:=xx-1;
if a[x,max]<>0 then
begin enorm:=false; xx:=0; ec:=1; end;
end;
end;
end
else begin enorm:=false; ec:=3; end;
end;
eQ:=enorm;
enorm:=true;

if fig in [3,13,4,14] then //rikis (valdove)
begin
if fig in [3,13] then writeln('fig 3/13');
if ((en=0) or ((en>ko1) and (en
begin
if x-v=y-z then
begin
xx:=abs(x-v);
max:=(x+v+xx) div 2;
max2:=(y+z+xx) div 2;
while xx>1 do
begin
max:=max-1; max2:=max2-1; xx:=xx-1;
if a[max,max2]<>0 then
begin enorm:=false; xx:=0; ec:=1; end;
end;
end;
if x-v=z-y then //cia su klaidom kol kas palieku.... gal istaisiau?
begin
xx:=abs(x-v);
max:=(x+v+xx) div 2;
max2:=(y+z+xx) div 2;
min2:=max2-xx;
while xx>1 do
begin
max:=max-1; min2:=min2+1; xx:=xx-1;
if a[max,min2]<>0 then
begin enorm:=false; xx:=0; ec:=1; end;
end;
end;
end
else begin enorm:=false; ec:=3; end;
end;

if fig in [4,14] then //del valdoves
begin
if eQ or enorm then enorm:=true;
end
else enorm:=enorm and eQ;




if fig in [2,12] then //zirgas
begin
writeln('fig 2/12');
if ((en=0) or ((en>ko1) and (en
else begin enorm:=false; ec:=3; end;
end;


boo2:=false;

if fig in [6,16] then //pestininkai
begin
writeln('fig 6/16');
boo1:=(en=0) and (x=v) and (y-z=ko3); //+1
boo2:=(en=0) and (x=v) and ((y-z=2*ko3) and (y+z=ko4) and (a[x,(y+z) div 2]=0)); //+2
boo3:=((en>ko1) and (en
bool:=false;
if x>1 then bool:=(en=0) and (y-z=ko3) and (abs(x-v)=1) and (a[x-1,y]=6+ko1);
if mov=1 then bool:=bool and dmb;
if mov=0 then bool:=bool and dmw;
boor:=false;
if x<8 then boor:=(en=0) and (y-z=ko3) and (abs(x-v)=1) and (a[x+1,y]=6+ko1);
if mov=1 then boor:=boor and dmb;
if mov=0 then boor:=boor and dmw;

if (boo1=true) or (boo2=true) or (boo3=true) or (bool=true) or (boor=true) then
enorm:=true
else begin enorm:=false; ec:=3; end;
end;

if (mov=1) then if (boo2=true) then dmw:=true else dmw:=false;
if (mov=0) then if (boo2=true) then dmb:=true else dmb:=false;
//...klaida dmw kai true, tada ir i kaire ir i desine kirsti galima...

if fig in [5,15] then //karalius
begin
writeln('fig 5/15');
if ((en=0) or ((en>ko1) and (en<=1) and (abs(y-z)<=1) then enorm:=true
else begin enorm:=false; ec:=3; end;

end;


{ if fig=4 ... //valdove
...tikrinam ar leistinas ejimas...
(kazkaip sunkiai pridejau prie rikio ir boksto)
}
if (mov=1) and (a[x,y]=5) and enorm then begin kx:=v; ky:=z; end;
if (mov=0) and (a[x,y]=15) and enorm then begin kx:=v; ky:=z; end;
atmp:=a[v,z]; a[v,z]:=a[x,y]; a[x,y]:=0;
writeln('atmp:=a[v,z]; a[v,z]:=a[x,y]; ',atmp,' ',a[v,z]); //trinti veliau


{ //idesime sacho tikrinima
che:=0;
repeat
begin
che:=che+1;
if che=2 then
begin a[x,y]:=a[v,z]; a[v,z]:=atmp; end;
if che=3 then
begin a[x,y]:=a[v,z]; a[v,z]:=atmp; a[(x+v) div 2,y] end;
if a[v,z] in [5,15]}

check:=false;
//tikriname ar shachas?

//ar shachas nuo boksto/valdoves?
kn:=kx; km:=ky;
while kn<8 do //1
begin
kn:=kn+1;
if (a[kn,km]-ko1) in [1,4] then check:=true;
if ((a[kn,km]+ko1) in [11..16]) or ((a[kn,km]-ko1) in [2,3,5,6]) then kn:=8;
end;
writeln('is desines ',check);
kn:=kx; km:=ky;
while km<8 do //2
begin
km:=km+1;
if (a[kn,km]-ko1) in [1,4] then check:=true;
if ((a[kn,km]+ko1) in [11..16]) or ((a[kn,km]-ko1) in [2,3,5,6]) then km:=8;
end;
writeln('is virsaus ',check);
kn:=kx; km:=ky;
while kn>1 do //3
begin
kn:=kn-1;
if (a[kn,km]-ko1) in [1,4] then check:=true;
if ((a[kn,km]+ko1) in [11..16]) or ((a[kn,km]-ko1) in [2,3,5,6]) then kn:=1;
end;
writeln('is kaires ',check);
kn:=kx; km:=ky;
while km>1 do //4
begin
km:=km-1;
if (a[kn,km]-ko1) in [1,4] then check:=true;
if ((a[kn,km]+ko1) in [11..16]) or ((a[kn,km]-ko1) in [2,3,5,6]) then km:=1;
end;
writeln('is apacios ',check);

//ar shachas nuo zirgo?
kn:=kx; km:=ky;
for i:=1 to 8 do n1[i]:=false;
if (kn-2>0) and (kn-2<9) and (km-1>0) and (km-1<9) then n1[1]:= (a[kn-2,km-1]-ko1=2);
if (kn-2>0) and (kn-2<9) and (km+1>0) and (km+1<9) then n1[2]:= (a[kn-2,km+1]-ko1=2);
if (kn-1>0) and (kn-1<9) and (km-2>0) and (km-2<9) then n1[3]:= (a[kn-1,km-2]-ko1=2);
if (kn-1>0) and (kn-1<9) and (km+2>0) and (km+2<9) then n1[4]:= (a[kn-1,km+2]-ko1=2);
if (kn+1>0) and (kn+1<9) and (km-2>0) and (km-2<9) then n1[5]:= (a[kn+1,km-2]-ko1=2);
if (kn+1>0) and (kn+1<9) and (km+2>0) and (km+2<9) then n1[6]:= (a[kn+1,km+2]-ko1=2);
if (kn+2>0) and (kn+2<9) and (km-1>0) and (km-1<9) then n1[7]:= (a[kn+2,km-1]-ko1=2);
if (kn+2>0) and (kn+2<9) and (km+1>0) and (km+1<9) then n1[8]:= (a[kn+2,km+1]-ko1=2);
nn:=false;
for i:=1 to 8 do nn:=nn or n1[i];
if nn=true then check:=true;
writeln;
writeln(check);

//ar shachas nuo rikio/valdoves/pestininko?
kn:=kx; km:=ky;
while (kn<8) and (km<8) do //1
begin
kn:=kn+1; km:=km+1;
if (a[kn,km]-ko1) in [3,4] then check:=true;
if mov=1 then if (a[kn,km]=16) and (kn-kx=1) then check:=true;
if (a[kn,km]<>0) then kn:=8;
end;
writeln('++ ',check);
kn:=kx; km:=ky;
while (kn>1) and (km>1) do //2
begin
kn:=kn-1; km:=km-1;
if (a[kn,km]-ko1) in [3,4] then check:=true;
if mov=0 then if (a[kn,km]=6) and (kn-kx=-1) then check:=true;
if (a[kn,km]<>0) then kn:=1;
end;
writeln('-- ',check);
kn:=kx; km:=ky;
while (kn<8) and (km>1) do //3
begin
kn:=kn+1; km:=km-1;
if (a[kn,km]-ko1) in [3,4] then check:=true;
if mov=0 then if (a[kn,km]=6) and (kn-kx=1) then check:=true;
if (a[kn,km]<>0) then kn:=8;
end;
writeln('+- ',check);
kn:=kx; km:=ky;
while (kn>1) and (km<8) do //4
begin
kn:=kn-1; km:=km+1;
if (a[kn,km]-ko1) in [3,4] then check:=true;
if mov=1 then if (a[kn,km]=16) and (kn-kx=-1) then check:=true;
if (a[kn,km]<>0) then kn:=1;
end;
writeln('-+ ',check);

{ if che=2 then
begin
atmp:=a[v,z]; a[v,z]:=a[x,y];
if check then c1:=true else c1:=false;
if not cast then che:=che+1;
end; }

{ end;
until che=3 ;
//idesime sacho tikrinima
}

if check=true then
begin writeln('neleistinas ejimas. testi: 0, pasiduoti: 1');
readln(RR);
enorm:=false; ec:=2;
end;


a[x,y]:=a[v,z]; a[v,z]:=atmp;
if (mov=1) and (a[x,y]=5) then begin kx:=bx; ky:=by; end;
if (mov=0) and (a[x,y]=15) then begin kx:=jx; ky:=jy; end;

if enorm=false then
begin
if ec=1 then writeln('kelyje trukdo figura, ec 1');
if ec=2 then writeln('neleistinas ejimas: sachas, ec 2');
if ec=3 then writeln('uzimtas langelis, ec 3');
end;

//rokiruociu aprasas
rok[1]:= enorm and (a[x,y] =1) and (x=1);
rok[2]:= enorm and (a[x,y] =1) and (x=8);
rok[3]:= enorm and (a[x,y]=11) and (x=1);
rok[4]:= enorm and (a[x,y]=11) and (x=8);
for i:=5 to 8 do rok[i]:=rok[i] or rok[i-4]; //ar sugadinti bokstai
rok[9]:= enorm and (a[x,y]= 5) and (abs(x-v)<=1) and (abs(y-z)<=1);
rok[10]:= enorm and (a[x,y]=15) and (abs(x-v)<=1) and (abs(y-z)<=1);
for i:=5 to 8 do rok[i]:=rok[i] or rok[((i+1) div 2)+6]; //ar sugadinti karaliai


end;
until (enorm=true) or (RR=1);

mv[move]:=x*1000+y*100+v*10+z;
if fig=5 then begin bx:=v; by:=z; writeln('fig 5! ',bx,' ',by,' bx:=v; by:=z;'); end;
if fig=15 then begin jx:=v; jy:=z; writeln('fig15! ',jx,' ',jy,' jx:=v; jy:=z;'); end;

a[v,z]:=a[x,y]; a[x,y]:=0;
if bool or boor then a[v,z+ko3]:=0; //kirtimui prasilenkiant

if RR=1 then R1:=RR;
end;


if mov=1 then writeln('juodieji laimejo') else writeln('baltieji laimejo');
readln;

end.

Komentarų nėra:

Rašyti komentarą