Đề thi Trò chơi Tích - Tắc vuông

Bài 75/2001 - Trò chơi Tích - Tắc vuông 
(Dành cho học sinh THCS và PTTH)
(* Thuat toan:
Chia ban co lam 4 huong: Dong , Tay , Nam , Bac. Ta co cach di sau: 
i) Luon di theo o lien canh voi o truoc
ii) Di theo huong khong bi chan. Vi du: o buoc 1 neu bi chan o huong Dong
thi di theo huong nguoc lai la huong Tay. Di theo huong Tay den khi huong Tay bi chan thi di theo huong Bac hoac Nam.
Trong khi di ta luon de y 2 dieu kien sau:
1. Neu co 3 o da lap thanh 3 dinh cua 1 hinh vuong ma o thu 4 chua bi di
thi ta se di o thu 4 va gianh duoc thang loi.
2. Neu co 2k+1(k>=1) o lien canh lien tiep thi kiem tra co the gianh thang
loi bang nuoc do^i khong? Nuoc do^i la nuoc ta danh vao 1 o nhung co the co duoc 2 hinh vuong. vi du: co 3 o (1,1);(1,2);(1,3) thi ta co the danh nuoc doi bang cach danh vao o (2,2) nhu vay ta co kha nang hinh thanh 2 o vuong. Nhung sau 1 nuoc di doi thi chi duy nhat chan duoc 1 o vuong, ta co the danh nuoc tiep theo de hinh thanh o vuong con lai va gianh duoc thang loi.
 Bang cach danh nhu vay ban co the chien thang trong vong toi da la 10 nuoc.*)
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
CONST Min=-50;
 Max=50;
TYPE Ma=Array[Min..Max,Min..Max] of char;
 diem= Record
 hg,cot:Integer;
 End;
 Qu=Array[1..Max] of diem;
VAR dmay,dng,dc1,dc2:diem;
 hgdi:Integer; (*1:B ; 2:D ; -1:N ; -2:T*)
 fin,ok:Boolean;
 A:Ma;
 Q,Qc:Qu;
 dlt,dq,cq:Integer;
Procedure HienA(hgd,hgc,cotd,cotc:Integer);
Var i,j:Integer;
 Begin
 For i:=hgd to hgc do
 Begin
 For j:=cotd to cotc do Write(A[i,j],' ');
 Writeln;
 End;
 End;
Procedure finish(d:diem);
 Begin
 A[d.hg,d.cot]:='x';
 HienA(-10,10,-10,10);
 Writeln('Ban da thua! An ENTER de ket thuc chuong trinh');
 Readln;
 Halt;
 End;
Procedure Init;
 Begin
 Fillchar(A,sizeof(A),'.');
 fin:=false;
 Writeln('Gia thiet bang o vuong co: 101 hang (-50 -> 50)');
 Writeln(' 101 cot (-50 -> 50)');
 Writeln('Gia thiet may luon di nuoc dau tien tai o co toa do (0:0)');
 dmay.hg:=0; dmay.cot:=0; A[dmay.hg,dmay.cot]:='X';
 HienA(-10,10,-10,10);
 dlt:=1;
 End;
Procedure Sinh(d1:diem; Var d2:diem; hgdi,k:integer);
Var h,c:Integer;
 Begin
 h:=d1.hg; c:=d1.cot;
 Case hgdi of
 1: Dec(h,k);
 2: Inc(c,k);
 -1: Inc(h,k);
 -2: Dec(c,k);
 End;
 d2.hg:=h; d2.cot:=c;
 End;
Function kt(Var d1,d2:diem):boolean;
Var g1,g,g2:diem;
 k,p:integer;
 Begin
 kt:=true;
 k:=(dlt-1) div 2;
 p:=2 div abs(hgdi);
 sinh(dmay,g1,-hgdi,k);
 sinh(dmay,g2,-hgdi,2*k);
 sinh(g1,g,p,k);
 sinh(dmay,d1,p,k);
 sinh(g2,d2,p,k);
 If (A[d1.hg,d1.cot]='.')and(A[g.hg,g.cot]='.')and(A[d2.hg,d2.cot]='.')then
 begin A[g.hg,g.cot]:='x'; HienA(-10,10,-10,10); exit; end;
 sinh(g1,g,-p,k);
 sinh(dmay,d1,-p,k);
 sinh(g2,d2,-p,k);
 If (A[d1.hg,d1.cot]='.')and(A[g.hg,g.cot]='.')and(A[d2.hg,d2.cot]='.')then
 begin A[g.hg,g.cot]:='x'; HienA(-10,10,-10,10); exit; end;
 kt:=false;
 End;
Procedure Ngdi;
 Begin
 Repeat
 Write('Nhap toa do diem (hang,cot): '); Readln(dng.hg,dng.cot);
 Until (dng.hg>=Min)and(dng.hg=Min)and(dng.cot<=Max)and(A[dng.hg,dng.cot]='.');
 A[dng.hg,dng.cot]:='1'; HienA(-10,10,-10,10);
 End;
Function Hgchan:Integer;
Var Hgc:Integer;
Begin
If dmay.cot<dng.cot then
Begin
Hgc:=2;
If Hgc=hgdi then Begin Hgchan:=Hgc; Exit; End;
End;
If dmay.cot>dng.cot then
Begin
Hgc:=-2;
If Hgc=hgdi then Begin Hgchan:=Hgc; Exit; End;
End;
If dmay.hg<dng.hg then
Begin
Hgc:=-1;
If Hgc=hgdi then Begin Hgchan:=Hgc; Exit; End;
End;
If dmay.hg>dng.hg then
Begin
Hgc:=1;
If Hgc=hgdi then Begin Hgchan:=Hgc; Exit; End;
End;
Hgchan:=Hgc;
End;
Procedure Nap(Var Q:Qu; d1:diem; hgdi,k:Integer);
Var h,c:Integer;
 d2:diem;
 Begin
 Sinh(d1,Q[cq],hgdi,k);
 End;
Procedure Maydi;
 Begin
 Inc(dq);
 if not ok then
 Begin
 If Q[dq].hg<dmay.hg then hgdi:=1
 Else If Q[dq].hg>dmay.hg then hgdi:=-1
 Else If Q[dq].cot<dmay.cot then hgdi:=-2
 Else If Q[dq].cot>dmay.cot then hgdi:=2;
 End;
 dmay:=Q[dq];
 A[q[dq].hg,q[dq].cot]:='x';
 HienA(-10,10,-10,10)
 End;
Procedure Process;
Var Hgc,p,i,ntt:Integer;
 Begin
 ok:=true; ntt:=0;
 Ngdi;
 Hgc:=Hgchan; Hgdi:=-Hgc;
 Inc(cq); Nap(Q,dmay,hgdi,1); Maydi; Inc(dlt);
 Repeat
 Ngdi; Hgc:=Hgchan;
 If ntt=1 then
 If A[dc1.hg,dc1.cot]='.' then finish(dc1)
 Else finish(dc2);
 If ntt=0 then If (dlt>=3) and (kt(dc1,dc2)) then ntt:=1;
 If (Hgc=Hgdi) then
 If ok then
 Begin
 p:=2 div abs(Hgc);
 For i:=1 to dlt-1 do
 Begin
 Inc(cq); Nap(Q,dmay,p,i); Nap(Qc,Q[cq],-hgdi,i);
 Inc(cq); Nap(Q,dmay,-p,i);Nap(Qc,Q[cq],-hgdi,i);
 End;
 ok:=false;
 dlt:=1;
 End
 Else
 Begin
 hgdi:=-hgdi; Inc(cq); Nap(Q,dmay,hgdi,dlt);
 End;
 If ntt=0 then
 Begin
 If dq=cq then Begin Inc(cq); Nap(Q,dmay,hgdi,1); End;
 If A[Qc[dq].hg,Qc[dq].cot]='.' then finish(Qc[dq]);
 Maydi; Inc(dlt);
 End;
 Until fin;
 End;
BEGIN
 Init;
 Process;
END.