pascal 游戏

pascal 游戏

uses graph,crt;type Tqp=array[1..8,1..8]of integer; Twjyw=array[1..6]of boolean;const spx:array[1..9] of integer=(140,180,220,260,300,340,380,420,460); spy:array[1..9] of integer=(80,120,160,200,240,280,320,360,400); yqp:Tqp= ((11,10, 9, 8, 7, 9,10,11), (12,12,12,12,12,12,12,12), ( 0, 0, 0, 0, 0, 0, 0, 0), ( 0, 0, 0, 0, 0, 0, 0, 0), ( 0, 0, 0, 0, 0, 0, 0, 0), ( 0, 0, 0, 0, 0, 0, 0, 0), ( 6, 6, 6, 6, 6, 6, 6, 6), ( 5, 4, 3, 2, 1, 3, 4, 5)); ck:string[5]='KPMH!'; fx:array[1..4,1..2]of shortint=((-1,0),(0,1),(1,0),(0,-1));var image:array[0..26]of pointer; cm:array[1..8,1..8]of boolean; qp:Tqp; kx,ky,k2x,k2y:integer; k2f:boolean; wjyw:Twjyw;procedure initg;var gd,gm:integer;begin gd:=detect; initgraph(gd,gm,'bgi\');end;function inttostr(i:longint):string;var st:string;begin str(i,st); inttostr:=st;end;function min(a,b:longint):longint;begin if ab then max:=a else max:=b;end;procedure loadimg(st:string;var img1:pointer);var i,j:integer; c:byte; size:word; f:file of byte;begin new(img1); assign(f,'贺脊img\'+st); reset(f); for i:=1 to 40 do for j:=1 to 40 do begin read(f,c); putpixel(j,i,c); end; size:=ImageSize(1,1,40,40); getMem(img1,Size); getimage(1,1,40,40,img1^); close(f); cleardevice;end;procedure loadallimg;var i:integer;begin for i:=1 to 26 do loadimg('皮拍祥燃搏img'+inttostr(i),image[i]);end;procedure init;begin kx:=1;ky:=1; cleardevice; loadallimg; qp:=yqp; fillchar(wjyw,sizeof(wjyw),0);end;procedure drawbar(x,y,c:integer);begin setcolor(c); line(spx[x],spy[y],spx[x+1]-1,spy[y]); line(spx[x],spy[y],spx[x],spy[y+1]-1); line(spx[x+1]-1,spy[y],spx[x+1]-1,spy[y+1]-1); line(spx[x],spy[y+1]-1,spx[x+1]-1,spy[y+1]-1);end;procedure print;var i,j:integer;begin for i:=1 to 8 do for j:=1 to 8 do putimage(spx[j],spy[i],image[qp[i,j]*2+2-(i+j) mod 2]^,0); {if k2f then for i:=1 to 8 do for j:=1 to 8 do if cm[j,i] then drawbar(i,j,blue); } drawbar(kx,ky,4); if k2f then drawbar(k2x,k2y,green);end;function canmover(qp:Tqp;wjyw:Twjyw;x1,y1,x2,y2:integer):boolean;var i,j,hx,hy,h2x,h2y:integer;begin canmover:=false; if (x1=x2)and(y1=y2) then exit; if not(qp[x1,y1] in [1..6]) then exit; if qp[x2,y2] in [1..6] then exit; case qp[x1,y1] of 1: begin if (y1=5)and(y2=3)and(x1=8)and(x2=8)and(not wjyw[1])and(not wjyw[3]) and(qp[8,2]=0)and(qp[8,3]=0)and(qp[8,4]=0)then else if (y1=5)and(y2=7)and(x1=8)and(x2=8)and(not wjyw[2])and(not wjyw[3]) and(qp[8,5]=0)and(qp[8,6]=0)and(qp[8,7]=0)then else if (abs(x2-x1)>1)or(abs(y2-y1)>1) then exit; end; 2: begin if (abs(x2-x1)=abs(y2-y1))or(x2=x1)or(y2=y1) then else exit; if x2>x1 then h2x:=1 else if x2y1 then h2y:=1 else if y20 then exit; inc(hx,h2x); inc(hy,h2y); if (hx=x2)and(hy=y2) then break; end; end; 3: begin if (abs(x2-x1)=abs(y2-y1)) then else exit; if x2>x1 then h2x:=1 else if x2y1 then h2y:=1 else if y20 then exit; inc(hx,h2x); inc(hy,h2y); if (hx=x2)and(hy=y2) then break; end; end; 4: begin if ((abs(x1-x2)=2)and(abs(y1-y2)=1))or((abs(x1-x2)=1)and(abs(y1-y2)=2)) then else exit; end; 5: begin if (x2=x1)or(y2=y1) then else exit; if x2>x1 then h2x:=1 else if x2y1 then h2y:=1 else if y20 then exit; inc(hx,h2x); inc(hy,h2y); if (hx=x2)and(hy=y2) then break; end; end; 6: begin if (x1-x2=1)or((x1=7)and(x2=5)and(qp[6,y2]=0)) then else exit; if (x1-x2=2)and(y1<>y2) then exit; if abs(y1-y2)>1 then exit; if (y1=y2)and(qp[x2,y2]<>0) then exit; if (abs(y1-y2)=1)and not (qp[x2,y2]in [7..12]) then exit; end; end; canmover:=true;end;function canmoveb(qp:Tqp;wjyw:Twjyw;x1,y1,x2,y2:integer):boolean;var i,j,hx,hy,h2x,h2y:integer;begin canmoveb:=false; if (x1=x2)and(y1=y2) then exit; if not(qp[x1,y1] in [7..12]) then exit; if qp[x2,y2] in [7..12] then exit; case qp[x1,y1] of 7: begin if (y1=5)and(y2=3)and(x1=1)and(x2=1)and(not wjyw[4])and(not wjyw[6]) and(qp[1,2]=0)and(qp[1,3]=0)and(qp[1,4]=0)then else if (y1=5)and(y2=7)and(x1=1)and(x2=1)and(not wjyw[5])and(not wjyw[6]) and(qp[8,5]=0)and(qp[8,6]=0)and(qp[8,7]=0)then else if (abs(x2-x1)>1)or(abs(y2-y1)>1) then exit; end; 8: begin if (abs(x2-x1)=abs(y2-y1))or(x2=x1)or(y2=y1) then else exit; if x2>x1 then h2x:=1 else if x2y1 then h2y:=1 else if y20 then exit; inc(hx,h2x); inc(hy,h2y); if (hx=x2)and(hy=y2) then break; end; end; 9: begin if (abs(x2-x1)=abs(y2-y1)) then else exit; if x2>x1 then h2x:=1 else if x2y1 then h2y:=1 else if y20 then exit; inc(hx,h2x); inc(hy,h2y); if (hx=x2)and(hy=y2) then break; end; end; 10: begin if ((abs(x1-x2)=2)and(abs(y1-y2)=1))or((abs(x1-x2)=1)and(abs(y1-y2)=2)) then else exit; end; 11: begin if (x2=x1)or(y2=y1) then else exit; if x2>x1 then h2x:=1 else if x2y1 then h2y:=1 else if y20 then exit; inc(hx,h2x); inc(hy,h2y); if (hx=x2)and(hy=y2) then break; end; end; 12: begin if (x1-x2=-1)or((x1=2)and(x2=4)and(qp[3,y2]=0)) then else exit; if (x1-x2=-2)and(y1<>y2) then exit; if abs(y1-y2)>1 then exit; if (y1=y2)and(qp[x2,y2]<>0) then exit; if (abs(y1-y2)=1)and not (qp[x2,y2]in [1..6]) then exit; end; end; canmoveb:=true;end;function eatone(qp:Tqp;x,y,f:integer):boolean;var i,j:integer;begin if f=1 then begin eatone:=false; for i:=1 to 8 do for j:=1 to 8 do if canmover(qp,wjyw,i,j,x,y) then begin eatone:=true;exit;end; end else begin eatone:=false; for i:=1 to 8 do for j:=1 to 8 do if canmoveb(qp,wjyw,i,j,x,y) then begin eatone:=true;exit;end; end;end;function runqz(var qp:Tqp;var wjyw:Twjyw;k2x,k2y,kx,ky:integer):boolean;var f:boolean;begin if not cm[ky,kx] then begin k2f:=false;runqz:=false;exit;end; runqz:=true; if qp[8,1]<>5 then wjyw[1]:=true; if qp[8,8]<>5 then wjyw[2]:=true; if qp[8,5]<>1 then wjyw[3]:=true; if qp[1,1]<>11 then wjyw[4]:=true; if qp[1,8]<>11 then wjyw[5]:=true; if qp[1,5]<>7 then wjyw[6]:=true; if qp[k2y,k2x]=1 then begin f:=true; end; if (k2x=5)and(kx=3)and(k2y=8)and(ky=8)and(qp[8,5]=1) then begin wjyw[1]:=true; wjyw[2]:=true; wjyw[3]:=true; qp[8,4]:=5; qp[8,1]:=0; end; if (k2x=5)and(kx=3)and(k2y=1)and(ky=1)and(qp[1,5]=7) then begin wjyw[4]:=true; wjyw[5]:=true; wjyw[6]:=true; qp[1,4]:=11; qp[1,1]:=0; end; if (k2x=5)and(kx=7)and(k2y=8)and(ky=8)and(qp[8,5]=1) then begin wjyw[1]:=true; wjyw[2]:=true; wjyw[3]:=true; qp[8,6]:=5; qp[8,8]:=0; end; if (k2x=5)and(kx=7)and(k2y=1)and(ky=1)and(qp[1,5]=7) then begin wjyw[4]:=true; wjyw[5]:=true; wjyw[6]:=true; qp[1,6]:=11; qp[1,8]:=0; end; qp[ky,kx]:=qp[k2y,k2x]; qp[k2y,k2x]:=0; if (qp[ky,kx]=6)and(ky=1) then qp[ky,kx]:=2; if (qp[ky,kx]=12)and(ky=8)then qp[ky,kx]:=8;end;const wzfz:array[7..12]of Tqp={king} ((( 16, 14, 12, 10, 10, 12, 14, 16), ( 16, 14, 12, 0, 0, 12, 14, 16), ( 16, 14, 0, 0, 0, 0, 14, 16), ( 16, 0, 0, 0, 0, 0, 0, 16), ( 0, 0, 0, 0, 0, 0, 0, 0), ( 0, 0, 0, 0, 0, 0, 0, 0), ( 0, 0, 0, 0, 0, 0, 0, 0), ( 0, 0, 0, 0, 0, 0, 0, 0)),{quwwn} (( 3, 5, 8, 8, 8, 8, 5, 3), ( 5, 6, 8, 8, 8, 8, 6, 5), ( 5, 6, 8, 8, 8, 8, 6, 5), ( 5, 6, 8, 8, 8, 8, 6, 5), ( 5, 6, 8, 8, 8, 8, 6, 5), ( 5, 6, 8, 8, 8, 8, 6, 5), ( 5, 6, 8, 6, 8, 8, 6, 5), ( 3, 5, 8, 5, 8, 8, 5, 3)),{elephant} (( 3, 5, 0, 5, 5, 0, 5, 3), ( 5, 8, 8, 8, 8, 8, 8, 5), ( 5, 8, 7, 7, 7, 7, 8, 5), ( 5, 8, 7, 6, 6, 7, 8, 5), ( 5, 8, 7, 6, 6, 7, 8, 5), ( 5, 8, 7, 7, 7, 7, 8, 5), ( 5, 8, 8, 8, 8, 8, 8, 5), ( 3, 5, 5, 5, 5, 5, 5, 3)),{horse} (( 2, 2, 4, 4, 4, 4, 2, 2), ( 3, 4, 6, 6, 6, 6, 4, 3), ( 3, 6, 8, 8, 8, 8, 6, 3), ( 3, 6, 8, 8, 8, 8, 6, 3), ( 3, 6, 8, 8, 8, 8, 6, 3), ( 3, 6, 8, 8, 8, 8, 6, 3), ( 3, 4, 6, 6, 6, 6, 4, 3), ( 2, 3, 3, 3, 3, 3, 3, 2)),{car} (( 0, 4, 4, 3, 3, 4, 4, 0), ( 2, 4, 4, 3, 3, 4, 4, 2), ( 0, 0, 0, 0, 0, 0, 0, 0), ( 0, 0, 0, 0, 0, 0, 0, 0), ( 0, 0, 0, 0, 0, 0, 0, 0), ( 0, 0, 0, 0, 0, 0, 0, 0), ( 2, 4, 4, 3, 3, 4, 4, 2), ( 0, 4, 4, 3, 3, 4, 4, 0)),{pawn} (( 0, 0, 0, 0, 0, 0, 0, 0), ( 0, 0, 0, 0, 0, 0, 0, 0), ( 1, 1, 1, 1, 1, 1, 1, 1), ( 3, 3, 3, 3, 3, 3, 3, 3), ( 5, 5, 5, 5, 5, 5, 5, 5), ( 7, 7, 7, 7, 7, 7, 7, 7), ( 10, 10, 10, 10, 10, 10, 10, 10), ( 15, 15, 15, 15, 15, 15, 15, 15)));function qpcost(qp:Tqp):longint;const fz:array[0..12]of longint=(0,10000,1800,600,600,1000,200,-10000,-1800,-600,-600,-1000,-200);var t,i,j:longint;begin t:=0; for i:=1 to 8 do for j:=1 to 8 do begin inc(t,fz[qp[i,j]]); if qp[i,j] in [7..12] then dec(t,wzfz[qp[i,j],i,j]); end; qpcost:=t;end;function search(qp:Tqp;wjyw:Twjyw;dep:integer;f:integer):longint;const smax=9;var ch:char; temp:Tqp; temp2:Twjyw; i1,i2,i3,i4,j1,j2,j3,j4,i,t:longint; x1l,x2l,y1l,y2l,fl:array[1..smax+1]of longint;begin if dep=0 then begin search:=qpcost(qp);exit;end; if keypressed then begin ch:=readkey; if ch=#27 then halt; end; fillchar(x1l,sizeof(x1l),0); fillchar(x2l,sizeof(x2l),0); fillchar(y1l,sizeof(y1l),0); fillchar(y2l,sizeof(y2l),0);if f=1 thenbegin for i:=1 to smax+1 do fl[i]:=maxint; for i1:=1 to 8 do for j1:=1 to 8 do for i2:=1 to 8 do for j2:=1 to 8 do if canmoveb(qp,wjyw,i1,j1,i2,j2) then begin i:=smax+1; x1l[smax+1]:=i1; x2l[smax+1]:=i2; y1l[smax+1]:=j1; y2l[smax+1]:=j2; temp:=qp; temp2:=wjyw; fillchar(cm,sizeof(cm),1); runqz(temp,temp2,i1,j1,i2,j2); fl[smax+1]:=qpcost(temp); while (fl[i]1) do begin t:=x1l[i];x1l[i]:=x1l[i-1];x1l[i-1]:=t; t:=x2l[i];x2l[i]:=x2l[i-1];x2l[i-1]:=t; t:=y1l[i];y1l[i]:=y1l[i-1];y1l[i-1]:=t; t:=y2l[i];y2l[i]:=y2l[i-1];y2l[i-1]:=t; t:=fl[i];fl[i]:=fl[i-1];fl[i-1]:=t; dec(i); end; end; t:=maxint; for i:=1 to smax do if fl[i]<>maxint then begin temp:=qp; temp2:=wjyw; fillchar(cm,sizeof(cm),1); runqz(temp,temp2,x1l[i],y1l[i],x2l[i],y2l[i]); t:=min(t,search(temp,temp2,dep-1,2)); end; search:=t;endelsebegin for i:=1 to smax+1 do fl[i]:=-maxint; for i1:=1 to 8 do for j1:=1 to 8 do for i2:=1 to 8 do for j2:=1 to 8 do if canmover(qp,wjyw,i1,j1,i2,j2) then begin i:=smax+1; x1l[smax+1]:=i1; x2l[smax+1]:=i2; y1l[smax+1]:=j1; y2l[smax+1]:=j2; temp:=qp; temp2:=wjyw; fillchar(cm,sizeof(cm),1); runqz(temp,temp2,i1,j1,i2,j2); fl[smax+1]:=qpcost(temp); while (fl[i]>fl[i-1])and(i>1) do begin t:=x1l[i];x1l[i]:=x1l[i-1];x1l[i-1]:=t; t:=x2l[i];x2l[i]:=x2l[i-1];x2l[i-1]:=t; t:=y1l[i];y1l[i]:=y1l[i-1];y1l[i-1]:=t; t:=y2l[i];y2l[i]:=y2l[i-1];y2l[i-1]:=t; t:=fl[i];fl[i]:=fl[i-1];fl[i-1]:=t; dec(i); end; end; t:=-maxint; for i:=1 to smax do if fl[i]<>-maxint then begin temp:=qp; temp2:=wjyw; fillchar(cm,sizeof(cm),1); runqz(temp,temp2,x1l[i],y1l[i],x2l[i],y2l[i]); t:=max(t,search(temp,temp2,dep-1,0)); end; search:=t;end;end;function searchblack(qp:Tqp;wjyw:Twjyw;var x1,y1,x2,y2:integer):boolean;var i1,i2,i3,i4,t,t2:longint; temp:Tqp; temp2:Twjyw;begin searchblack:=false; t2:=maxint; for i1:=1 to 8 do for i2:=1 to 8 do for i3:=1 to 8 do for i4:=1 to 8 do if canmoveb(qp,wjyw,i1,i2,i3,i4) then begin temp:=qp; temp2:=wjyw; fillchar(cm,sizeof(cm),1); runqz(temp,temp2,i2,i1,i4,i3); t:=search(temp,temp2,3,2); if t>50000 then continue; searchblack:=true; if t#0; if ch=#27 then halt; if ch=#13 then begin if k2f then begin if runqz(qp,wjyw,k2x,k2y,kx,ky) then begin if lost(qp) then break; fillchar(cm,sizeof(cm),1); if not searchblack(qp,wjyw,i2,i1,i4,i3) then break; runqz(qp,wjyw,i1,i2,i3,i4); end; k2f:=false; end else if choose then begin k2x:=kx; k2y:=ky; k2f:=true; end; end; for i:=1 to 5 do if ch=ck[i] then break; if i=5 then continue; inc(kx,fx[i,1]); inc(ky,fx[i,2]); if kx<1 then kx:=8; if kx>8 then kx:=1; if ky<1 then ky:=8; if ky>8 then ky:=1; end; clrscr; outtextxy(100,100,'You win!'); repeat ch:=readkey; until ch=#13;end;procedure initchess;var y:integer; ch:char;begin settextstyle(7,horizdir,6); setcolor(white); outtextxy(10,10,'WY Chess'); settextstyle(1,horizdir,1); y:=100; outtextxy(50,y,'Made by WangYu'); outtextxy(50,300,'Pressed Enter to continue'); repeat ch:=readkey;until ch=#13;end;begin initg; initchess; init; main; readkey;end.国际象棋