Нужно сделать игру "шашки" на паскале - Pascal
Формулировка задачи:
Мне нужна помощь. Нужно сделать игру "шашки" в PascalABC. Помогите пожалуйста.
Решение задачи: «Нужно сделать игру "шашки" на паскале»
textual
Листинг программы
procedure Select1 (p:position);{рисует курсор по передаваемым координатам}
var
dx,dy : word;
begin
SetWriteMode(CopyPut);
SetLineStyle(0,0,3);
SetColor(3);
with p, Desk do
begin
x:=x-1;y:=y-1;
dx := GetMaxX div 2 - 5 * sx;
dy := GetMaxY div 2 - 5 * sy;
Graph.MoveTo(x*sx+dx,y*sy+dy);
LineTo((x+1)*sx+dx,y*sy+dy);
LineTo((x+1)*sx+dx,(y+1)*sy+dy);
LineTo(x*sx+dx,(y+1)*sy+dy);
LineTo(x*sx+dx,y*sy+dy);
end;
end;
const
SelectStart = 1;
SelectNext = 2;
var
State : byte;
P,Q : Position;
D : DeskType;
F : Boolean;
begin
{ if GameOver then exit;}
with Player, Desk, P do
begin
P:=Start;
D := Desk;
F := Fight;
Q := P;
State := SelectStart;
Select(P); {нарисовали курсор}
repeat
if keypressed
then
case readkey of
#0 : begin {обработка стрелок - перемещение курсора}
Select(P); {стерли курсор}
case readkey of
'K' : x:=x-1;
'M' : x:=x+1;
'H' : y:=y-1;
'P' : y:=y+1;
end;
if x<1 then x:=10;
if y<1 then y:=10;
if x>10 then x:=1;
if y>10 then y:=1;
Select(P); {нарисовали новый}
end;
' ', #13 : case State of
SelectStart : begin
if Color then
begin
Start := P;
if MoveFrom (Player)
then
begin
Fight:=False;
State:=SelectNext;
Select1(P);
Q:=P
end
else Beep;
end
else
begin
Start := P;
{ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!проблема!!!!!!} if MoveFrom2 (Player)
then
begin
Fight:=False;
State:=SelectNext;
Select1(P);
Q:=P
end
else Beep;
end;
end;
SelectNext : begin
Finish := P;
if Color then
begin
if Analise (Player)
then
if Fight
then
begin
Start := Finish;
if must_fight(Player)
then Select(P)
else break
end
else break
else Beep;
end else
begin
if Analise (Player)
then
if Fight
then
begin
Start := Finish;
if must_fight2(Player)
then Select(P)
else break
end
else break
else Beep;
end;
end;
end;
'Q','q' : begin
State := SelectStart;
Fight := F;
Desk := D;
P := Q;
Draw;
Select(P);
end;
#27 : begin
GameOver := True;
break;
end;
end;
until False;
Fight := False;
ScanDamk;{count; nowin; }
end;
end;
function TDesk.MoveFrom;{проверяет возможность хода из данной клетки}
begin
if NoFight(Player) then MoveFrom := can_move(Player)
else MoveFrom := must_fight(Player)
end;
function TDesk.MoveFrom2;{проверяет возможность хода из данной клетки}
begin
if NoFight2(Player) then
MoveFrom2 := can_move2(Player)
else
MoveFrom2 := must_fight2(Player)
end;
function TDesk.NoFight;
{возвращает .t. если бить нечего}
var
f : boolean;
begin
f := False;
with Player.Start do
for y:=1 to 10 do
for x:=1 to 10 do
f := f or must_fight(Player);
NoFight := not f;
end;
function TDesk.NoFight2;
{возвращает .t. если бить нечего}
var
f : boolean;
begin
f := False;
with Player.Start do
for y:=1 to 10 do
for x:=1 to 10 do
f := f or must_fight2(Player);
NoFight2 := not f;
end;
function TDesk.can_move;
{возвращает .t. если в текущей клетке есть шашка и ею можно походить}
var
f : boolean;
begin
with Player, Start do
if Color
then
case Desk[y][x] of
W : f := (Desk[y+1][x+1] = N) or (Desk[y+1][x-1] = N);
WD : f := (Desk[y+1][x+1] = N) or (Desk[y+1][x-1] = N) or
(Desk[y-1][x+1] = N) or (Desk[y-1][x-1] = N)
else f := False
end;
can_move := f;
end;
function TDesk.can_move2;
{возвращает .t. если в текущей клетке есть шашка и ею можно походить}
var
f : boolean;
begin
with Player.Start do
case Desk[y][x] of
B : f := (Desk[y-1][x+1] = N) or (Desk[y-1][x-1] = N);
BD : f := (Desk[y+1][x+1] = N) or (Desk[y+1][x-1] = N) or
(Desk[y-1][x+1] = N) or (Desk[y-1][x-1] = N)
else f := False
end;
can_move2 := f;
end;
function TDesk.must_fight;
{возвращает .t. если в текущей позиции есть фишка и она должна что - то бить}
var
f : boolean;
i : integer;
begin
with Player, Start do
if Color
then
case Desk[y][x] of
W : f := ((Desk[y+2][x+2] = N) and (Desk[y+1][x+1] in [B,BD])) or
((Desk[y+2][x-2] = N) and (Desk[y+1][x-1] in [B,BD])) or
((Desk[y-2][x-2] = N) and (Desk[y-1][x-1] in [B,BD])) or
((Desk[y-2][x+2] = N) and (Desk[y-1][x+1] in [B,BD]));
WD : begin
i:=1;
while Desk[y+i][x+i] = N do inc (i);
{ищем ближайшую шашку в этом направлении}
f:=(Desk[y+i][x+i] in [B,BD]) and (Desk[y+i+1][x+i+1] = N);
{если эта шашка черных и за ней нет ничего - надо бить (f=.t.)}
i:=1;
while Desk[y-i][x+i] = N do inc (i);
f:=f or (Desk[y-i][x+i] in [B,BD]) and (Desk[y-i-1][x+i+1] = N);
i:=1;
while Desk[y-i][x-i] = N do inc(i);
f:=f or (Desk[y-i][x-i] in [B,BD]) and (Desk[y-i-1][x-i-1] = N);
i:=1;
while Desk[y+i][x-i] = N do inc(i);
f:=f or (Desk[y+i][x-i] in [B,BD]) and (Desk[y+i+1][x-i-1] = N);
end;
else f:= False;
end;
must_fight := f;
end;
function TDesk.must_fight2;
{возвращает .t. если в текущей позиции есть фишка и она должна что - то бить}
var
f : boolean;
i : integer;
begin
with Player, Start do
case Desk[y][x] of
B : f := ((Desk[y+2][x+2] = N) and (Desk[y+1][x+1] in [W,WD])) or
((Desk[y+2][x-2] = N) and (Desk[y+1][x-1] in [W,WD])) or
((Desk[y-2][x-2] = N) and (Desk[y-1][x-1] in [W,WD])) or
((Desk[y-2][x+2] = N) and (Desk[y-1][x+1] in [W,WD]));
BD : begin
i:=1;
while Desk[y+i][x+i] = N do inc (i);
f:=(Desk[y+i][x+i] in [W,WD]) and (Desk[y+i+1][x+i+1] = N);
i:=1;
while Desk[y-i][x+i] = N do inc (i);
f:=f or (Desk[y-i][x+i] in [W,WD]) and (Desk[y-i-1][x+i+1] = N);
i:=1;
while Desk[y-i][x-i] = N do inc(i);
f:=f or (Desk[y-i][x-i] in [W,WD]) and (Desk[y-i-1][x-i-1] = N);
i:=1;
while Desk[y+i][x-i] = N do inc(i);
f:=f or (Desk[y+i][x-i] in [W,WD]) and (Desk[y+i+1][x-i-1] = N);
end
else f := False
end;
must_fight2 := f;
end;
function TDesk.Analise;
{возвращает .f. если введенный ход не соответствует правилам игры
использует нач. и кон. коорд. положения курсора, а так же
расположение шашек на доске}
var
f,f_ : boolean;
dx,dy,ix,iy,x,y,cw,cb : Integer;
begin
with Player do
if Color
then
begin
case Desk[Start.y][Start.x] of
W : begin
if Fight then f := False else
f := (Finish.y-Start.y=1) and
(abs(Finish.x-Start.x)=1) and
(Desk[Finish.y][Finish.x] = N);
x := (Start.x+Finish.x) div 2;
y := (Start.y+Finish.y) div 2;
Fight := (abs(Finish.y-Start.y)=2) and
(abs(Finish.x-Start.x)=2) and
(Desk[Finish.y][Finish.x]=N) and
(Desk[y][x] in [B,BD]);
end;
WD : begin
if Finish.x>Start.x then dx := 1
else dx := -1;
if Finish.y>Start.y then dy := 1
else dy := -1;
ix:=Start.x+dx;
iy:=Start.y+dy;
f_ := (abs(Finish.x-Start.x) = abs(Finish.y-Start.y)) and
(Desk[Finish.y][Finish.x]=N);
cw:=0;
cb:=0;
if f_ then repeat
if Desk[iy][ix] in [W,WD] then inc(cw);
if Desk[iy][ix] in [B,BD]
then
begin
inc(cb);
x:=ix;
y:=iy;
end;
if (ix=Finish.x) or (iy=Finish.y) then break;
ix :=ix + dx;
iy :=iy + dy;
until (ix=Finish.x) or (iy=Finish.y);
if Fight then f := false
else f := (cb=0) and (cw=0) and f_;
Fight := (cb=1) and (cw=0) and f_;
end
else f := False
end;
if f or Fight
then begin
Desk[Finish.y][Finish.x]:=Desk[Start.y][Start.x];
Desk[Start.y][Start.x] := N;
if (Finish.y = 10)
then Desk[Finish.y][Finish.x]:=WD;
if Fight then Desk[y][x]:=N;
Draw;
end
end
else
begin
case Desk[Start.y][Start.x] of
B : begin
if Fight then f := False else
f := (Start.y-Finish.y=1) and
(abs(Finish.x-Start.x)=1) and
(Desk[Finish.y][Finish.x] = N);
x := (Start.x+Finish.x) div 2;
y := (Start.y+Finish.y) div 2;
Fight := (abs(Finish.y-Start.y)=2) and
(abs(Finish.x-Start.x)=2) and
(Desk[Finish.y][Finish.x]=N) and
(Desk[y][x] in [W,WD]);
end;
BD : begin
if Finish.x>Start.x then dx := 1
else dx := -1;
if Finish.y>Start.y then dy := 1
else dy := -1;
ix:=Start.x+dx;
iy:=Start.y+dy;
f_ := (abs(Finish.x-Start.x) = abs(Finish.y-Start.y)) and
(Desk[Finish.y][Finish.x]=N);
cw:=0;
cb:=0;
if f_ then repeat
if Desk[iy][ix] in [B,BD] then inc(cb);
if Desk[iy][ix] in [W,WD]
then
begin
inc(cw);
x:=ix;
y:=iy;
end;
if (ix=Finish.x) or (iy=Finish.y) then break;
ix :=ix + dx;
iy :=iy + dy;
until (ix=Finish.x) or (iy=Finish.y);
if Fight then f := false
else f:= (cb=0) and (cw=0) and f_;
Fight := (cw=1) and (cb=0) and f_;
end
else f := False
end;
if f or Fight
then begin
Desk[Finish.y][Finish.x]:=Desk[Start.y][Start.x];
Desk[Start.y][Start.x] := N;
if (Finish.y = 1)
then Desk[Finish.y][Finish.x]:=BD;
if Fight then Desk[y][x]:=N;
Draw;
end;
end;
Analise := f or Player.Fight;
end;
procedure Tdesk.ScanDamk;
{превращает шашку в дамку если она достигла нужной позиции}
var
i : byte;
begin
for i := 1 to 10 do
begin
if Desk[1,i] = B then Desk[1,i] := BD;
if Desk[10,i] = W then Desk[10,i] := WD;
end;
end;
BEGIN
Game.Init;
Game.Run;
END.
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д