IPB
ЛогинПароль:

> 2 игрока вычеркивают клетки по очереди, последний - проиграл
malt
сообщение 16.12.2012 3:05
Сообщение #1





Группа: Пользователи
Сообщений: 2
Пол: Мужской

Репутация: -  0  +


Игра. Играют 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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 28.07.2025 19:29
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"