Pascal. Игра. 2 Игрока Вычеркивают Клетки, Вычеркнувший Последнюю - Пр

malt

New member
16.12.2012
3
0
#1
Игра. Играют 2 игрока, по очереди отрезают 1,2 или 3 клетки из 11, кто отрежет последнюю - проиграл.
Прописал "руками" ИИ, надо переписать через dfs (поиск в глубину). Может кто помочь в этом деле или подкинуть светлые идеи/какие-то ссылки??

Код:
uses
crt;

procedure player(var course:integer);
label
1;
var
rand:integer;
begin
writeln('Полосочный нагибатор 1.0');readln;
clrscr;
1: rand:=random(3);
if (rand<1) then goto 1;
if (rand=1) then
begin
writeln('По результатам жребия право первого хода передается игроку!');
course:=1
end;
if (rand=2) then
begin
writeln('По результатам жребия право первого хода передается нагибатору!');
course:=2
end;
readln
end;

procedure ending(var course:integer);
begin
if (course=1) then writeln('Противостояние закончилось победой игрока!')
else writeln('Противостояние закончилось победой нагибатора!')
end;

{---------------------------------------------------------------------------------------}

procedure player1(var course,score:integer);
var
pl1:integer;
begin
if (course=1) then
begin
clrscr;
writeln('Ход игрока.');
write('Осталось клеточек: ');writeln(score);
write('Введите, сколько клеточек вы хотите отрезать: ');readln(pl1);
if (pl1>0) and (pl1<4) and (pl1<=score) then
begin
score:=score-pl1;
write('Вы отрезали ',pl1,' клеточ');
if (pl1>1) and (pl1<4) then writeln('ки')
else writeln('ку');
write('Осталось клеточек: ');writeln(score)
end
else
begin
clrscr;
writeln('Вы не можете столько отрезать!')
end;
readln;
course:=2
// if (score=0) then ending(course)
end;
end;

procedure player2(var course,score:integer);
label
1;
var
pl2:integer;
begin
if (course=2) then
begin
case score of
11: pl2:=2;
10: pl2:=1;
9: pl2:=1;
8: pl2:=3;
7: pl2:=2;
6: pl2:=1;
5: pl2:=1;
4: pl2:=3;
3: pl2:=2;
2: pl2:=1;
1: pl2:=1;
0: goto 1
end;
write('Ход нагибатора.');
write('Осталось клеточек: ');writeln(score);
score:=score-pl2;
clrscr;
write('Нагибатор, не долго думая, отрезал ',pl2,' клеточ');
if (pl2>1) and (pl2<4) then writeln('ки.')
else writeln('ку.');
readln;
course:=1;
1: if (score=0) then ending(course)
end;
end;

procedure game(var course,score:integer);
begin
player(course);
score:=11;
while (score<>0) do
begin
player1(course,score);
player2(course,score)
end;
end;

var
course,score:integer;
begin
game(course,score)
end.