Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Паскаль
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 06.04.2019, 17:07   #1
korobaka
Новичок
 
Регистрация: 06.04.2019
Сообщений: 2
Репутация: 10
Восклицание баше

есть программа (игра баше) нужно добавить к этой программе выбор кол-ва палочек и генератор, кто ходит первым
Код:
program Bashe;

Uses CRT;

function YouWinLose(Stick, Clear: Integer): Integer;
begin
  if (Stick = 0) or (Stick < 1) then
  begin
    WriteLn;
    WriteLn('Вы проиграли!');
    WriteLn('Замечание: Вам необходимо убрать предметы так, чтобы ваш противник остался с последним предметом!');
    WriteLn('Вы сделали немного наоборот, убрав последние количество предметов, в результате чего и проиграли...');
    Halt;
  end
       else
  if (Stick = 1) or (Stick < 1) then
  begin
    WriteLn;
    WriteLn('Вы выиграли, поздравляю!');
    Halt;
  end
  else
end;

function ComputerWinLose(Stick, RandomClear: Integer): Integer;
begin
  if (Stick = 0) or (Stick < 1) then
  begin
    WriteLn('Компьютер проиграл!');
    Halt;
  end
        else
  if (Stick = 1) or (Stick < 1) then
  begin
    WriteLn('Компьютер выиграл!');
    Halt;
  end
  else
end;

function Steps(Stick, Clear, RandomClear: Integer): Integer;
begin
  Stick := 15;
  repeat
    WriteLn;
    ReadLn(Clear);
    if Clear > 3 then
    begin
      WriteLn;
      WriteLn('Больше 3 предметов брать запрещено!');
      WriteLn;
      WriteLn('Попробуйте начать заного...');
      Halt;
    end
    else
      Stick := Stick - Clear;
    WriteLn;
    if Clear = 0 then
    begin
      WriteLn('Вы должны выбрать хоть 1 предмет!');
      WriteLn;
      WriteLn('Попробуйте начать заного...');
      Halt;
    end
         else
    if Clear = 1 then
      WriteLn('Вы убрали ', Clear, ' предмет.', ' - В наличие ещё ', '[', Stick, '] -')
    else
      WriteLn('Вы убрали ', Clear, ' предмета.', ' - В наличие ещё ', '[', Stick, '] -');
    YouWinLose(Stick, Clear);
    WriteLn;
    Sleep(1000);
    WriteLn('Теперь ходит комьютер...');
    repeat
      Randomize;
      RandomClear := Random(4);
      if RandomClear = 0 then
        RandomClear := Random(4);
    until RandomClear <> 0;
    Stick := Stick - RandomClear;
    WriteLn;
    if RandomClear = 1 then
      WriteLn('Компьютер убрал ', RandomClear, ' предмет.', ' - В наличие ещё ', '[', Stick, '] -')
    else
      WriteLn('Компьютер убрал ', RandomClear, ' предмета.', ' - В наличие ещё ', '[', Stick, '] -');
    WriteLn;
    ComputerWinLose(Stick, RandomClear);
    WriteLn('Ваш ход!');
  until Stick = 1;
end;

procedure AboutGame(Information: String);
begin
  ClrScr;
  WriteLn;
  WriteLn('(Игра Баше на 15 предметах)');
  WriteLn;
  WriteLn('Правила игры Баше таковы. Имеется 15 одинаковых предметов(обычно это деревянные палочки).');
  WriteLn('В игре участвуют двое. Соперники ходят по очереди, за каждый ход играющий может взять 1, 2 или 3 предмета.');
  WriteLn('Проигрывает тот, кто вынужден взять последний предмет.');
  WriteLn(' # Примечание - пропускать ход нельзя.');
  WriteLn;
  ReadKey;
end;

var
  Stick, Clear, RandomClear: Integer;
  Information: String;

begin
  WriteLn('Добро пожаловать!');
  WriteLn;
  WriteLn('Для того чтобы начать играть в "Баше", необходимо ознакомится с правилами игры.');
  WriteLn;
  ReadKey;
  AboutGame(Information);
  ClrScr;
  WriteLn;
  WriteLn('Если вы ознакомились с правилами, тогда вперед.');
  WriteLn;
  WriteLn('Перед вами 15 предметов');
  WriteLn;
  WriteLn('[ ||||| ||||| ||||| ]');
  WriteLn;
  WriteLn('Сколько предметов вы хотите убрать? :');
  Steps(Stick, Clear, RandomClear);
end.

_____
Код программы нужно выделять (форматировать) тегами [CODE] [/CODE] (читать FAQ)
Модератор

Последний раз редактировалось Serge_Bliznykov; 06.04.2019 в 20:08.
korobaka вне форума   Ответить с цитированием
Старый 06.04.2019, 20:21   #2
Serge_Bliznykov
МегаМодератор
СуперМодератор
 
Регистрация: 09.01.2008
Сообщений: 26,100
Репутация: 5675
По умолчанию

Цитата:
Сообщение от korobaka Посмотреть сообщение
Stick := 15;
здесь нужно сделать ввод числа
Код:
repeat
  Write('Введите сколько предметов в куче (целое число больше нуля): ');
  ReadLn(Stick);
until (Stick>0);
ну, ещё можно в выводимых правилах написать, что количество предметов задаётся игроком (у Вас написано, что в куче 15 палочек).

что касается последовательности ходов, то тут чуть сложнее.
нужно запросить пользователя, кто ходит первым (1 - человек, 0 - компьютер)
а потом заключить весь блок хода в условный оператор.

примерно так (я не проверял)
Код:
function Steps(Stick, Clear, RandomClear: Integer): Integer;
var FirstStep : integer;
begin
  Randomize;

  repeat
    Write('Введите сколько предметов в куче (целое число больше нуля): ');
    ReadLn(Stick);
  until (Stick>0);

  repeat
    Write('кто ходит первым (1 - человек, 0 - компьютер):');
    ReadLn(FirstStep);
  until (FirstStep=0) or (FirstStep=1)

  
  repeat
    if(FirstStep=1) then {первый ход человека}
    begin
      WriteLn;
      ReadLn(Clear);
      if Clear > 3 then
      begin
        WriteLn;
        WriteLn('Больше 3 предметов брать запрещено!');
        WriteLn;
        WriteLn('Попробуйте начать заного...');
        Halt;
      end
      else
        Stick := Stick - Clear;
      WriteLn;
      if Clear = 0 then
      begin
        WriteLn('Вы должны выбрать хоть 1 предмет!');
        WriteLn;
        WriteLn('Попробуйте начать заного...');
        Halt;
      end
           else
      if Clear = 1 then
        WriteLn('Вы убрали ', Clear, ' предмет.', ' - В наличие ещё ', '[', Stick, '] -')
      else
        WriteLn('Вы убрали ', Clear, ' предмета.', ' - В наличие ещё ', '[', Stick, '] -');
      YouWinLose(Stick, Clear);
      Sleep(1000);
    end;

    WriteLn('Ходит комьютер...');

    repeat
      RandomClear := Random(4);
      if RandomClear = 0 then
        RandomClear := Random(4);
    until RandomClear <> 0;
    Stick := Stick - RandomClear;
    WriteLn;
    if RandomClear = 1 then
      WriteLn('Компьютер убрал ', RandomClear, ' предмет.', ' - В наличие ещё ', '[', Stick, '] -')
    else
      WriteLn('Компьютер убрал ', RandomClear, ' предмета.', ' - В наличие ещё ', '[', Stick, '] -');
    WriteLn;
    ComputerWinLose(Stick, RandomClear);
    WriteLn('Ваш ход!');

    FirstStep := 1; {теперь разрешаем человеку сделать ход - дальше ходы будут по очереди}

  until Stick = 1;
end;
Serge_Bliznykov вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
C++ Игра Баше TonySokur Помощь студентам 0 01.12.2014 15:53
Игра Баше. Что-то уже написано. Нужно разобраться LuckyStarKsu Общие вопросы C/C++ 1 17.12.2010 18:01
Задача Баше (Паскаль) smail1701 Помощь студентам 0 03.12.2010 19:26


11:11.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.