Pascal. Игра. 2 игрока, вычеркивают клеточки, последний проигрывает.

Ответить
malt
Сообщения: 2
Зарегистрирован: 16 дек 2012, 03:06

Игра. Играют 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.
Ответить