Game chess.pas (cờ vua)

uses crt,dos; {http://vn.myblog.yahoo.com/kien_coi_1997}
type
quan=(k,xeD,maD,tuongD,hauD,vuaD,totD,
          xeT,maT,tuongT,hauT,vuaT,totT);
nguoi=(Trang,Den);
mType=array[1..8,1..8]of quan;
his=record
xh1,yh1,xh2,yh2:0..8;
Old:quan;dirh:0..3;
end;
const xStart=2; yStart=1; Player:nguoi=trang;
{den:darkgray;trang:white}
New:mType=            ((xeT,MaT,TuongT,HauT,VuaT,TuongT,MaT,XeT)
                         ,(totT,totT,totT,totT,totT,totT,totT,totT)
                         ,(k,k,k,k,k,k,k,k),(k,k,k,k,k,k,k,k)
                         ,(k,k,k,k,k,k,k,k),(k,k,k,k,k,k,k,k)
                         ,(totD,totD,totD,totD,totD,totD,totD,totD)
                         ,(xeD,MaD,TuongD,HauD,VuaD,TuongD,MaD,XeD));
function mouseinstalled:boolean; assembler; asm
xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;

function getmousex:word; assembler; asm
mov ax,3; int 33h; mov ax,cx end;

function getmousey:word; assembler; asm
mov ax,3; int 33h; mov ax,dx end;

function leftpressed:boolean; assembler; asm
mov ax,3; int 33h; and bx,1; mov ax,bx end;

function rightpressed:boolean; assembler; asm
mov ax,3; int 33h; and bx,2; mov ax,bx end;

procedure mousesensetivity(x,y:word); assembler; asm
mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;

function mouserange(x1,y1,x2,y2:word):boolean;
begin
if        (getmousex div 8>=x1)
     and (getmousex div 8<=x2)
     and (getmousey div 8>=y1)
     and (getmousey div 8<=y2)
then mouserange:=true
else mouserange:=false;
end;

function getmousexcrt:word;
begin
getmousexcrt:=trunc(getmousex/8+1);
end;

function getmouseycrt:word;
begin
getmouseycrt:=trunc(getmousey/8+1);
end;

procedure vekhung(x1,y1,x2,y2:word);
var z,a,b:word;
begin
if (x1<>x2) and (y1<>y2) then
begin
a:=wherex; b:=wherey;
if x1>x2 then
 begin z:=x1; x1:=x2; x2:=z; end;
if y1>y2 then
 begin z:=y1; y1:=y2; y2:=z; end;
gotoxy(x1,y1); write(#201);
if x2-x1>1 then for z:=1 to x2-x1-1 do write(#205);
gotoxy(x2,y1); write(#187);
gotoxy(x1,y2); write(#200);
if x2-x1>1 then for z:=1 to x2-x1-1 do write(#205);
gotoxy(x2,y2); write(#188);
if y2-y1>1 then for z:=1 to y2-y1-1 do begin
gotoxy(x1,z+y1); write(#186); end;
if y2-y1>1 then for z:=1 to y2-y1-1 do begin
gotoxy(x2,z+y1); write(#186); end;
end;
gotoxy(a,b);
end;
procedure RangeMouse(x1,y1,x2,y2:word);
var regs:registers;
begin
Regs.AX:=7; Regs.CX:=x1; Regs.DX:=x2;
Intr($33,Regs);
Regs.AX:=8; Regs.CX:=y1; Regs.DX:=y2;
Intr($33,Regs);
end;
var x1,y1,x2,y2:byte;
   xMove1,yMove1,xMove2,yMove2:byte;
   Moving:boolean;c:char;
   History:array[1..4]of his;
   dir:0..3;m:mtype;
function Lawful(x1,y1,x2,y2:byte):boolean;
var z:quan;
function NotBlock(x1,y1,x2,y2:byte):boolean;
var c,d:byte;
begin
NotBlock:=true;c:=0;d:=0;
if m[x2,y2]=k then
d:=1;
if (x1>x2)and(y1=y2) then
begin c:=x1; x1:=x2; x2:=c; end;
if (y1>y2)and(x1=x2) then
begin c:=y1; y1:=y2; y2:=c; end;
if x1=x2 then
begin
for c:= y1 to y2 do
if m[x1,c]<>k then
d:=d+1;
end;
if y1=y2 then
begin
for c:= x1 to x2 do
if m[c,y1]<>k then d:=d+1;
end;
if abs(x2-x1)=abs(y2-y1) then
begin
if x1<x2 then
for c:= x1 to x2 do
begin
 if y1<y2 then
 if m[c,c+y1-x1]<>k then
 d:=d+1;
 if y1>y2 then
 if m[c,x2+y2-c]<>k then
 d:=d+1;
end;
if x1>x2 then
for c:= x2 to x1 do
begin
if y1<y2
 if m[c,x2+y2-c]<>k then
 d:=d+1;
if y1>y2 then
 if m[c,c+y2-x2]<>k then
 d:=d+1;
end;
end;
if d>2then
notblock:=false;
end;
begin
z:=m[x1,y1]; textbackground(black);
gotoxy(68,7); write('             ');
gotoxy(75,5); write('      ');
if ((m[x1,y1]in[xeD..totD])and(m[x2,y2]in[xeT..totT])
or (m[x1,y1]in[xeT..totT])and(m[x2,y2]in[xeD..totD])
or (m[x2,y2]=k)) and ((x1<>x2)or(y1<>y2)) then
case z of
xeT,xeD:        Lawful:=((x1=x2)xor(y1=y2))and NotBlock(x1,y1,x2,y2);
maT,maD:        lawful:=(abs(x1-x2)+abs(y1-y2)=3)and(x1<>x2)and(y1<>y2);
tuongT,tuongD:  Lawful:=(abs(x2-x1)=abs(y2-y1))and NotBlock(x1,y1,x2,y2);
hauT,hauD:      Lawful:=(((x1=x2)or(y1=y2))or(abs(x2-x1)=abs(y2-y1)))
                        and NotBlock(x1,y1,x2,y2);
vuaT,vuaD:      Lawful:=(abs(x2-x1)<2)and(abs(y2-y1)<2)
                        and((x1<>x2)or(y1<>y2));
totT:           Lawful:=(((dir=0)and(x2-x1=1)and(y1=y2)
                    or (x2-x1=1)and(abs(y1-y2)=1)and(m[x2,y2]<>k)
                    or (x2-x1=2)and(x1=2)and(y1=y2))
                    or ((dir=1)and(y2-y1=1)and(x1=x2)
                    or (y2-y1=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k)
                    or (y2-y1=2)and(y1=2)and(x1=x2))
                    or ((dir=2)and(x1-x2=1)and(y1=y2)
                    or (x1-x2=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k)
                    or (x1-x2=2)and(x1=7)and( y1=y2))
                    or ((dir=3)and(y1-y2=1)and(x1=x2)
                    or (y1-y2=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k)
                    or (y1-y2=2)and(y1=7)and(x1=x2)))
                    and notblock(x1,y1,x2,y2);
totD:           Lawful:=(((dir=2)and(x2-x1=1)and(y1=y2)
                    or (x2-x1=1)and(abs(y1-y2)=1)and(m[x2,y2]<>k)
                    or (x2-x1=2)and(x1=2)and(y1=y2))
                    or ((dir=3)and(y2-y1=1)and(x1=x2)
                    or (y2-y1=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k)
                    or (y2-y1=2)and(y1=2)and(x1=x2))
                    or ((dir=0)and(x1-x2=1)and(y1=y2)
                    or (x1-x2=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k)
                    or (x1-x2=2)and(x1=7)and(y1=y2))
                    or ((dir=1)and(y1-y2=1)and(x1=x2)
                    or (y1-y2=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k)
                    or (y1-y2=2)and(y1=7)and(x1=x2)))
                    and notblock(x1,y1,x2,y2);

end else begin Lawful:=false;
gotoxy(68,7);textcolor(lightred);textbackground(Red);
write('!QuanCungMau'); end;
if not notblock(x1,y1,x2,y2) then
begin gotoxy(75,5);textcolor(lightred);
textbackground(Red);write('! Can'); end;

end;

procedure clearCell(x,y,z:byte);
begin
if z =0 then
if odd(x+y) then textcolor(black)
else textcolor(lightgray)
else textcolor(z);
gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#219,#219,#219,#219,#219,#219,#219,#219);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#219,#219,#219,#219,#219,#219,#219,#219);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#219,#219,#219,#219,#219,#219,#219,#219);
textcolor(white);
end;
procedure qXe(x,y,z,b:byte);
begin

textcolor(z);
if b>0 then textbackground(b)
else if odd(x+y+1) then textbackground(white)
else textbackground(black);



gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#32,#219,#32,#219,#32,#219,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#32,#32,#178,#178,#178,#32,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#32,#219,#219,#219,#219,#219,#32,#32);
end;
procedure qMa(x,y,z,b:byte);
begin

textcolor(z);
if b>0 then textbackground(b)
else if odd(x+y+1) then textbackground(white)
else textbackground(black);
gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#32,#222,#223,#219,#220,#32,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#32,#32,#222,#219,#219,#221,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#32,#32,#219,#219,#219,#219,#32,#32);
end;
procedure qTot(x,y,z,b:byte);
begin

textcolor(z);
if b>0 then textbackground(b)
else if odd(x+y+1) then textbackground(white)
else textbackground(black);
gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#32,#32,#32,#32,#254,#32,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#32,#32,#32,#40,#42,#41,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#32,#32,#220,#219,#219,#219,#220,#32);
end;
procedure qTuong(x,y,z,b:byte);
begin

textcolor(z);
if b>0 then textbackground(b)
else if odd(x+y+1) then textbackground(white)
else textbackground(black);


gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#32,#32,#32,#234,#32,#32,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#32,#32,#222,#254,#221,#32,#32,#32);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#32,#220,#219,#219,#219,#220,#32,#32);
end;
procedure qVua(x,y,z,b:byte);
begin

textcolor(z);
if b>0 then textbackground(b)
else if odd(x+y+1) then textbackground(white)
else textbackground(black);
gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#32,#47,#92,#32,#42,#32,#47,#92);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#32,#92,#32,#221,#254,#222,#32,#47);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#32,#32,#219,#219,#42,#219,#219,#32);
end;
procedure qHau(x,y,z,b:byte);
begin

textcolor(z);
if b>0 then textbackground(b)
else if odd(x+y+1) then textbackground(white)
else textbackground(black);
gotoxy(x*8-8+xStart,y*3-3+yStart);
write(#95,#46,#61,#42,#42,#61,#46,#95);
gotoxy(x*8-8+xStart,y*3-3+yStart+1);
write(#92,#92,#30,#30,#30,#30,#47,#47);
gotoxy(x*8-8+xStart,y*3-3+yStart+2);
write(#32,#176,#177,#178,#178,#177,#176,#32);
end;
procedure Draw(x,y,z:byte);
procedure ex(k0:byte);
begin
case m[x,y] of
xeT:qxe(x,y,white,k0);
maT:qMa(x,y,white,k0);
tuongT:qTuong(x,y,white,k0);
HauT:qHau(x,y,white,k0);
VuaT:qVua(x,y,white,k0);
TotT:qTot(x,y,white,k0);
(*_*)
xeD:qxe(x,y,darkgray,k0);
maD:qMa(x,y,darkgray,k0);
TuongD:qTuong(x,y,darkgray,k0);
HauD:qHau(x,y,darkgray,k0);
VuaD:qVua(x,y,darkgray,k0);
TotD:qTot(x,y,darkgray,k0);
k:clearcell(x,y,z);
end;
end;
begin
if x+y=0 then
for x:=1 to 8 do
for y:=1 to 8 do
ex(0);
if x+y>1 then ex(z);
end;
procedure Rotate;
var c,d:byte;
t:mtype;
begin
for c:=1 to 8 do
for d:=1 to 8 do
t[c,d]:=m[d,9-c];
m:=t;draw(0,0,0);
end;
procedure Shift(xuong:boolean);
var c:byte;
begin
if xuong then
for c:=2 to 4 do
history[c]:=history[c-1]
else for c:=1 to 3 do
history[c]:=history[c+1];
end;
procedure Update;
var c,d:byte;
begin
shift(true);
with history[1] do
begin
xh1:=xMove1; yh1:=yMove1;
xh2:=xMove2; yh2:=yMove2;
Old:=m[xMove2,yMove2];
dirh:=dir;
end;
inc(player);
end;
procedure Undo;
begin
if history[1].xh1+history[1].yh1=0 then exit;
if (4-history[1].dirh+dir)mod 4=1 then begin rotate; rotate; rotate; end;
if (4-history[1].dirh+dir)mod 4=2 then begin rotate; rotate; end;
if (4-history[1].dirh+dir)mod 4=3 then begin rotate; end;
dir:=history[1].dirh;
m[history[1].xh1,history[1].yh1]
:=m[history[1].xh2,history[1].yh2];
m[history[1].xh2,history[1].yh2]:=history[1].Old;
draw(0,0,0); shift(false); inc(player);
end;

procedure NewGame;
var x,y:byte;
begin
m:=new;player:=trang;
textcolor(lightgreen); textbackground(black); clrscr;
gotoxy(70,3);write('CHESS 2p');
gotoxy(70,10);write(#67#111#112#121#32#102#114#111#109#58);
Gotoxy(68,11);write(#75#105#101#110#95#99#111#105#95#49#57#57#55);
gotoxy(68,15);write(#27#58#82#111#116#97#116#101#32,'-90');
gotoxy(68,16);write(#25#58#82#111#116#97#116#101#32,'180');
gotoxy(68,17);write(#26#58#82#111#116#97#116#101#32,'+90');
gotoxy(68,19);write(#67#116#114#108#43#90#58#32#85#110#100#111);
gotoxy(68,20);write(#67#116#114#108#43#78#58#32#78#101#119);
gotoxy(68,21);write(#82#67#108#105#99#107#58#32#69#120#105#116);
{Cells}
for x:=1 to 8 do
for y:=1 to 8 do
clearcell(x,y,0);
{H}
gotoxy(2,25);
for x:=1 to 64 do
if x mod 8 = 4 then
begin
textcolor(darkgray);
textbackground(white);
write(chr(x div 8 + 65));
textcolor(white);
textbackground(black);
end else
write(#219);
{V}
for y:=1 to 25 do
begin
gotoxy(1,y);
if y mod 3 = 2 then
begin
textcolor(darkgray);
textbackground(white);
write(y div 3 + 1);
textcolor(white);
textbackground(black);
end else write(#219);
gotoxy(66,y);
write(#219);
end;
draw(0,0,0);
end;
(*_*)(*_*)
begin
clrscr;
NewGame;
RangeMouse(8,8,511,191);
repeat
x2:=x1; y2:=y1;
x1:=(getmousexcrt-1) div 8 +1;
y1:=(getmouseycrt-1) div 3 +1;
if leftpressed then
if (x1>0) and (y1>0) and (x1<= and (y1<= then
begin
if not moving then
begin
xMove1:=x1; yMove1:=y1;
draw(xMove2,yMove2,0);
draw(xMove1,yMove1,1);
moving:=true;
end
else
begin
xMove2:=x1; yMove2:=y1; update;
if lawful(xMove1,yMove1,xMove2,yMove2) then
begin
m[xMove2,yMove2]:=m[xMove1,yMove1];
m[xMove1,yMove1]:=k;
draw(xMove1,yMove1,0);
draw(xMove2,yMove2,6);
end else draw(xMove1,yMove1,0);
inc(player);
moving:=false;
end;
repeat until not leftpressed;
end;
if (x2>0) and (y2>0) and (x2<= and (y2<= then
if not (moving and (x1=xMove1) and (y1=ymove1)) then draw(x2,y2,0);
if (x1>0) and (y1>0) and (x1<= and (y1<= then
if not (moving and (x1=xMove1) and (y1=ymove1))then draw(x1,y1,10);
if not moving and (xMove2>0) and
(x1<>xMove2) and (y1<>yMove2) then draw(xMove2,yMove2,6);
if keypressed then
begin c:=readkey;
if c=#0 then
begin
c:=readkey;
case c of
'P':begin rotate;rotate; dir:=(dir+2)mod 4; end;
'K':begin rotate;rotate;rotate; dir:=(dir+3)mod 4; end;
'M':begin rotate; dir:=(dir+1)mod 4; end;
end;
end else if c=#26 then undo
else if c=#14 then newgame;
end;
repeat until ((getmousexcrt-1) div 8 +1<>x1)
or ((getmouseycrt-1) div 3 +1<>y1)
or rightpressed or leftpressed or keypressed;
until rightpressed;
rangemouse(1,1,639,199);
end.