Geum.ru

Прогон и отладка программы Справочная служба Турбо Паскаля

Вид материалаДокументы
Maxrow = 14
Подобный материал:
1   2   3   4   5   6   7
{Начальное значение минимума и максимума равно значению биоритмов для текущего дня} 

dmin := days; 

dmax := days ; 

for i := 0 to INTERVAL do 

begin

x := sin((days+i)*TF) + sin((days+i)*TE) +

sin((days+i)*TI); 

if x > max then 

begin

max := x; 

dmax := days + i 

end

else 

if x < min then 

begin

min := x; 

dmin := days + i 

end 

end; 

end; {FindMaxMin}

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

Procedure WriteDates (dmin, dmax, days : Integer);

{Определение и вывод дат критических дней. Вывод дополнительной информации о количестве прожитых дней, часов, минут и секунд }

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

Procedure WriteDatettext: String; dd: Integer);

{Определение даты для дня DD от момента рождения. В глобальных переменных d, m и у имеется текущая дата, в переменной DAYS - количество дней, прошедших от момента рождения до текущей даты. Выводится сообщение TEXT и найденная дата в формате ДД-МЕС-ГГГГ}

const

Names_of_Monthes : array [1..12] of String [3] = ( ' янв ' , ' фев ' , ' мар ' , ' апр ' , ' мая '' июн ',

' июл ' , ' авг ' , ' сен ' , ' окт ' , ' ноя ',' дек ' ) ;

var

d0,m0,y0,ddd : Integer; 

begin {WriteDate} 

d0 := d; 

m0 := m; 

y0 := y; 

ddd := days; 

while ddd<>dd do 

begin

inc(d0); {Наращиваем число} 

if (y0 mod 4 <> 0) and (d0 > Size_of_Month [m0] ) or 

(y0 mod 4=0) and (d0=30) then

begin{Корректируем месяц}

d0 := 1; 

inc(m0); 

if m0 = 13 then{Корректируем год} 

begin

m0 := 1; 

inc(y0) 

end

end;

inc(ddd) 

end;

WriteLn(text,d0, ' - ' , Names_of_Monthes [m0] , ' - ' ,y0) 

end; {WriteDate}

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

var

LongDays: Longlnt; {"Длинная" целая переменная для часов, минут и секунд } 

begin {WriteDates}

LongDays := days;

WriteLn ( ' Пропшо : ', LongDays,' дней, ' , longDays*24,

' часов, ',LongDays*24*60,'минут,',LongDays*24*60*60,'секунд');

WriteDate (' Наименее благоприятный день: ',dmin);

WriteDate ( 'Наиболее благоприятный день: ',dmax) 

end ; { WriteDates}

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

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

InputDates (d0,m0,y0,d, m, у) ;

Get_numbers_of_days (d0,m0,y0,d,m,y,days) ;

FindMaxMin (dmin, dmax, days) ;

WriteDates (dmin, dmax, days) 

end .

 

Игра Ним

Описание программы см, п.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]
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
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.