TURBO PASCAL

Новости

Программы   

Turbo Pascal 

Игры

Документация   

Странности

FAQ

Ссылки

Форум

Гостевая книга

Рассылка

Благодарности

Об авторе

 

 

Игра Ним

Описание программы см, п.2.7.3.

Uses CRT; {Подключение библиотеки дополнительных процедур и функций для управления экраном}

const

MAXROW = 14; {Максимальное количество рядов} 

MAXCOL = 20; {Максимальное количество фишек в ряду}

type

ColType = array [1.. MAXROW] of Integer;

var

exit : Boolean; {Признак окончания работы}

change : Boolean; {Признак изменения условий игры}

nrow : Integer; { Количество рядов}

ncol : ColType; {Максимальное количество фишек по рядам}

col : ColType; {Текущее количество фишек по рядам}

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

Procedure ShowField;

{Отображает на экране текущее состояние игрового поля}

const

FISH = #220; {Символ-указатель фишки} 

Х0 =4; {Левая колонка номеров рядов} 

X1 = 72; {Правая колонка количества фишек} 

X =20; {Левый край игрового поля}

var

i,j : Integer;

begin {ShowField}

for i := 1 to nrow do 

begin

GotoXY(X0,i+4) ;

write(i); {Номер ряда} 

GotoXY(Xl,i+4) ;

write (col [i] :2) ; {Количество фишек в ряду} 

for j := 1 to ncol [i] do {Вывод ряда фишек:} 

begin

GotoXY(X+2*j,i+4) ;

if j<=col[i] then write (FISH) else write ( ' . ' ) 

end

end 

end; {ShowField}

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

Procedure Prepare;

{ Подготовка данных и формирование экрана }

const

Header0='ИГРА НИМ';

Header1=' Вы можете взять любое число фишек из любого ряда.';

Header2='Выигрывает тот, кто возьмет последнюю фишку.';

Header3='Номер ряда';

Header4='Кол-во фишек';

var

i : Integer; 

begin {Prepare}

ClrScr;{Очищаем экран }

{Выводим заголовок:}

GotoXY( (80 -Length (Header0))div 2,1);

write (Header0) ;

GotoXY( (80-Length(Headerl))div 2,2);

write (Header1) ;

GotoXY( (80-Length(Header2))div 2,3);

writeln(Header2) ;

write (Header3) ;

GotoXY (80- Length ( Header 4 ) , 4 ) ;

write (Header4) ;

{Подготовить начальную раскладку: }

for i := 1 to nrow do col [i] := ncol [i] 

end; {Prepare}

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

Procedure GetPlayerMove;

{Получить, проконтролировать и отобразить ход игрока }

const

ТЕХТ1 = 'Введите Ваш ход в формате РЯД КОЛИЧ ' +

'(например, 2 3 - взять из 2 ряда 3 фишки)';

ТЕХТ2='или введите 0 0 для выхода из игры; -1 0 для настройки

игры'; ТЕХТЗ=' Ваш ход: '; 

Y=20; {номер строки для вывода сообщений}

var

correctly : Boolean;{признак правильности сделанного хода}

xl,x2 : Integer;{вводимый ход} 

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

Procedure GetChange;

{ Ввести новую настройку игры (количество рядов и количество фишек в каждом ряду} 

const

t1= 'НАСТРОЙКА ИГРЫ';

t2= '(ввод количества рядов и количества фишек в каждом ряду)'; 

var

correctly : Boolean; 

i : Integer; 

begin {GetChange} 

clrscr;

GotoXY((80-Length (t1)) div 2,1); 

write(t1);

GotoXY((80-Length(t2)) div 2,2); 

write(t2); 

repeat

GotoXY(1,3);

write('Введите количество рядов (максимум ',MAXROW,'): ');

GotoXY(WhereX-6,WhereY);

readln(nrow);

correctly := (nrow<=MAXROW) and (nrow>1);

if not correctly then

write (#7) 

until correctly; 

for i : = 1 to nrow do 

repeat

GotoXY(1,i+3) ;

write ('ряд',i,',количество фишек(максимум',MAXCOL,'):           ');

GotoXY (Wherex- 6, WhereY) ;

readlntncol [i] ) ;

correctly := (ncol [i] <=MAXCOL) and (ncol [i] >0) ;

if not correctly then

write (#7) 

until correctly 

end; {GetChange} 

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

begin {GetPlayerMove}

ShowField; {Показать начальное состояние поля }

{ Сообщить игроку правила ввода хода: }

GotoXY ( (80 -Length (TEXT1) ) div 2,Y);

write (TEXT1) ;

GotOXY( (80-Length(TEXT2) ) div 2, Y+1);

write (TEXT2) ;

repeat

{ Пригласить игрока ввести ход: } 

GotoXY (1, Y+2) ;

Write (ТЕХТЗ ); {вывести приглашение и стереть предыдущий ход} 

GotoXY (WhereX-1 6, Y+2) ; {курсор влево на 16 позиций} 

ReadLn (x1 , х2 ) ; {ввести очередной ход} 

exit := x1=0; {контроль команды выхода} 

change := x1=-1; {контроль команды изменения} 

if not (exit or change) then 

begin

correctly := (x1>0) and (x1<=nrow) and 

(x2<=col [x1] ) and (x2>0) ; 

if correctly then

begin {ход правильный: }

col [x1] := col[x1]-x2; {изменить раскладку фишек} 

ShowField {показать поле} 

end 

else

write (#7) {ход неправильный: дать звуковой сигнал } 

end 

else

correctly := true {случай EXIT или CHANGE} 

until correctly; 

if change then

GetChange

end; {GetPlayerMove} 

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

Procedure SetOwnerMove;

{ Найти и отобразить очередной ход программы }

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

Function CheckField : Integer;

{ Проверка состояния игры. Возвращает 0, если нет ни одной фишки (победа игрока) , 1 - есть один ряд (победа машины) и количество непустых рядов в остальных случаях } 

var

i,j : Integer; 

begin {CheckField}

j := 0;

for i := 1 to nrow do if col[i]>0 then inc(j);

CheckField := j

end; {CheckField}

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

Procedure CheckPlay;

{ Контроль окончания игры }

var

i : Integer; 

begin {CheckPlay}

GotoXY(1,25) ;

write ( 'Введите 1, если хотите сыграть еще раз, 0 - выход:');

readln(i);

if i=l then change := true else exit := true 

end; {CheckPlay}

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

Procedure PlayerVictory;

{ Поздравить игрока с победой и усложнить игру }

const

t1 = 'ПОЗДРАВЛЯЮ С ОТЛИЧНОЙ ПОБЕДОЙ!'; var i : Integer; begin

GotoXY( (80-Length(t1) ) div 2,24);

writeln(t1,#7) ;

for i : = 1 to nrow do

if ncol [i] <MAXROW then inc (ncol [i] ) ; 

CheckPlay

end; {PlayerVictory} 

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

Procedure OwnVictory; 

{ Победа машины } 

const

t1 = 'ВЫ ПРОИГРАЛИ: СЛЕДУЮЩИМ ХОДОМ Я БЕРУ ВЕСЬ РЯД';

var

i : Integer; 

begin {OwnVictory} 

i := 1;

while col[i]=0 do inc(i); 

GotoXY( (80-Length(t1) ) div 2,24); 

write(t1,i,#7);

delay (2000); {задержка на 2 секунды} 

col [i] := 0; 

ShowField; 

CheckPlay 

end; {OwnVictory}

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

Procedure ChooseMove;

{ Выбор очередного хода }

const

BIT = 6; {количество двоичных разрядов} 

type

BitType = array [1..BIT] of Integer; 

var

ncbit : array [1..MAXROW] of BitType;

i,j,k : Integer;

nbit : BitType; 

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

Procedure BitForm(n : Integer; var b : BitType);

{ Формирует двоичное представление b целого числа n }

var

i : Integer; 

begin {BitForm}

for i := BIT downto 1 do 

begin

if odd(n) then b[i] := 1 else b[i] := 0;

n := n shr 1 

end 

end; {BitForm}

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

begin {ChooseMove}

{Найти двоичное представление количества фишек во всех рядах:} 

for i := 1 to nrow do BitForm(col [i] ,ncbit [i] ) ; 

{Найти сумму разрядов по модулю 2:} 

for i := 1 to BIT do 

begin

nbitti] := 0;

for j := 1 to nrow do nbitti] := nbitti] xor ncbit [j / i] 

end;

{Найти i = старший ненулевой разряд суммы} 

i := 1;

while nbitti] =0 do inc(i); 

if i>BIT then

{Опасный вариант} 

begin j := 1;

while col[j]=0 do inc(j); {найти ненулевой ряд} 

k := 1 {взять из него 1 фишку} 

end 

else

{Безопасный вариант} 

begin j := 1;

while ncbit [j,i]=0 do inc(j); {найти нужный ряд} 

for i := i to BIT do 

if nbit[i] =1 then

ncbit [j,i] := ord (ncbit [j , i] =0) ; {инверсия разрядов} 

k := 0;

for i := 1 to BIT do 

begin

if ncbit [j,i]=1 then inc(k); 

if i<BIT then k := k shl 1 

end;

k := col [j] - k 

end;

GotoXY(1,23);

write('Мой ход: '); 

GotoXY(WhereX-8,WhereY); 

delay (.1000) ; 

write (j, ' ' ,k) ; 

col[j] := col[j] -k 

end; {ChooseMove}

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

begin {SetOwnerMove} 

case CheckField of {проверить количество непустых рядов} 

0 : PlayerVictory; {все ряды пусты - Победа игрока} 

1 : OwnVictory; {один непустой ряд - победа машины} 

else

ChooseMove; {выбрать очередной ход} 

end;{case}

end; {SetOwnerMove}

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

begin {Главная программа} 

nrow : = 3 ; { Подготовить игру } 

ncol [1] := 3; { на поле из трех } 

ncol [2] := 4; { рядов фишек } 

ncol [3] := 5; 

repeat{ Цикл изменения условий игры }

Prepare; { Подготовить экран } 

repeat { Игровой цикл }

GetPlayerMove; { Получить ход пользователя } 

if not (exit or change) then

SetOwnerMove { Определить собственный ход } 

until exit or change 

until exit 

end.

 

 

На первую страницу

Rambler's Top100 Rambler's Top100
PROext: Top 1000

(с)Все права защищены

По всем интересующим вопросам прошу писать на электронный адрес

Hosted by uCoz