Unit petnash1;
(**************)Interface(*****************)
uses
 crt,graph;
const
 {Коды клавиш,используемых в программе }
 Up=#72;
 Down=#80;
 Left=#75;
 Right=#77;
 Space=#32;
 Esc=#27;
 Enter=#13;
type
 strok=string[10];
var
 stroka:array[1..12] of strok;
 f02,f03:text;
 st02:string[10];
 stl2:string[20];
 a,b2,pl,kl,o:char;
 st,st1:string[5];
 step:string[5];
 u,vict:boolean;
 mas:array [1..16] of integer;
 a02,b3,c02,b,b1,d,e,e02,i,i1,j,n,r,steps,x,
 x1,y,y1,yme:integer;
 grDriver,grMode:integer;
 m,m1,m2,m3:integer;
 p,p1,p2,p3:pointer;

 procedure recod;
 procedure buk(a,b,c:integer;s:char);
 procedure victory;
 procedure nomer(xp,yp,ip:integer);
 procedure kv(xk,yk:integer);
 procedure tabl(xv,yv:integer;klv:char;var xv1,yv1:integer);
 procedure menu(var ym:integer);
 procedure game;
 procedure best;
 procedure help;

(*************)Implementation(****************)

(*Процедура считывания таблицы рекордов*)
(*из файла 'rezult.dat'*)
procedure recod;
 begin(*recod*)
 assign(f02,'rezult.dat');
 reset(f02);{Открытие файла с результатами}
 for i:=1 to 10 do {Чтение из файла}
readln(f02,stroka[i]);
 end;(*recod*)
(*Процедура движения заданной буквы по экрану *)
procedure buk(a,b,c:integer;s:char);
 begin (*buk*)
 for I:=a downto b do
begin
 {Буква рисуется темным цветом}
 setcolor(1);
 settextstyle(1,0,10);{Параметры текста}
 outtextxy(c,i,s);
 {Буква рисуется таким же цветом,
 что и фон экрана}
 setcolor(14);
 settextstyle(1,0,10);
 outtextxy(c,i,s);
end;
 {Рисование буквы по ее конечным координатам}
 setcolor(1);
 settextstyle(1,0,10);
 outtextxy(c,b,s);
end;(*buk*)

(*Процедура победы*)
procedure victory;
begin (*victory*)
 {Создание на желтом фоне надписи Victoty}
 setbkcolor(14);
 buk(480,220,100,'V');
 buk(480,220,170,'i');
 buk(480,220,205,'c');
 buk(480,220,255,'t');
 buk(480,220,300,'o');
 buk(480,220,359,'r');
 buk(480,220,410,'y');
 {Очерчивние надписи 2 линиями}
 setcolor(4);
 setlinestyle(0,0,3);
 for i:=115 to 405 do
 begin
delay(3);
line(i,355,i+20,355);
line(i,240,i,240);
 end;
 for i:=455 to 470 do
 begin
delay(3);
line(i,355,i+5,355)
 end
 end;(*victory*)

(* Процедура рисования номера пятнашки*)
procedure nomer(xp,yp,ip:integer);
 begin (*nomer*)
 {Преобразование числа mas[ip] в 
 посл-ть символов}
 str(mas[ip]:1,st); 
 {Вывод посл-ти символов st} 
 outtextxy(175+xp*86,120+yp*86,st);
 end;(*nomer*)

(*Процедура рисования парал-да*)
procedure kv(xk,yk:integer);
 begin(*kv*)
bar3d(160+xk*86,100+yk*86,235+xk*86,
175+yk*86,7,true);
 end;(*kv*)

(*Процедура смены активной таблички*)
procedure tabl(xv,yv:integer;klv:char;var
xv1,yv1:integer); 
 begin(*tabl*)
{Фишка(табличка),которая была активизирована
рисуется таким же цветом, что и остальные 
фишки}
setcolor(13);
kv(xv,yv);
{Надпись номера фишки}
if mas[4*yv+xv+1]<>0 then 
nomer(xv,yv,4*yv+xv+1); 
{Нажатие пользователем одной из клафиш case 
управления}
klv of
Down :if yv<3 then yv:=yv+1;
Up :if yv>0 then yv:=yv-1;
Left :if xv>0 then xv:=xv-1;
Right :if xv<3 then xv:=xv+1;
end;(*case*)
xv1:=xv;
yv1:=yv;
{Фишка, которая становится активизированной,
рисуется темным цветом}
setcolor(1);
kv(x,y);
{Надпись номера активизированной фишки}
if mas[4*yv+xv+1]<>0
then nomer(x,y,4*y+x+1);
 end;(*tabl*)

(*Процедура меню*)
procedure menu(var ym:integer);
 var
om:char;
 begin(*menu*)
ym:=0;
cleardevice; {Очистка графического экрана}
{Рисование тени пунктов меню,прямоугольники 
 серого цвета}
setcolor(8);
setfillstyle(1,8);
bar(45,152,615,202);
bar(45,222,615,272);
bar(45,292,615,342);
bar(45,362,615,412);
fillellipse(304,62,210,35);
{Рисование пунктов меню,прямоугольники синего 
цвета}
setcolor(1);
setfillstyle(1,1);
bar(35,145,605,195);
bar(35,215,605,265);
bar(35,285,605,335);
bar(35,355,605,405);
{Рисование эллипса под надписью ***MENU***}
fillellipse(298,57,210,35);
{Надписи на экране об авторе прграммы}
setcolor(12);
settextstyle(1,0,1);
outtextxy(20,430,'Copyright Software 1998');
outtextxy(20,450,'Written by Volkov 
Konstantin');
{Надпись ***MENU*** печатается серым цветом,
тем самым создается эффект тени}
setcolor(8);
settextstyle(1,0,6);
outtextxy(142,33,'*** MENU ***');
{Печать надписи ***MENU*** синим цветом}
setcolor(10);
outtextxy(140,30,'*** MENU ***');
setbkcolor(9); {Цвет фона экрана}
repeat
 setfillstyle(1,5); {Орнамент и цвет 
 заполнения полоски-указателя}
 {Полоска,передвигающаяся по пунктам меню} 
 bar(35,145+70*ym,605,195+70*ym); 
 {Печать пунктов меню}
 outtextxy(50,135,'Game');
 outtextxy(50,205,'Best players');
 outtextxy(50,275,'About this game');
 outtextxy(50,345,'Exit');
 om:=readkey;
 {При переходе указателя на другой пункт,
 возврашение пункту меню прежнего цвета}
 setfillstyle(1,1);
 bar(35,145+70*ym,605,195+70*ym);
 {Изменение координат указателя, в 
 зависимости от нажатия пользователем 
 однойиз клавиш управления} 
 if om=up then ym:=ym-1;
 if om=down then ym:=ym+1;
 if ym=-1 then ym:=3;
 if ym=4 then ym:=0;
 setcolor(10); {Цвет пунктов меню}
 {Создание звукового эффекта при перемещении 
 по пунктам меню}
 sound(300); 
 for i:=-maxint to maxint do
 j:=j;
 nosound;
 until om=Enter ;
 end;(*menu*)

(* Процедура начала игры *)
procedure game;
 begin(*game*)
cleardevice; {Очистка экрана}
steps:=0;{Число шагов 0}
{Рисование области, на фоне которой будет 
выводится кол-во шагов}
setfillstyle(1,3);
bar(10,90,130,155);
setfillstyle(1,7);
bar(30,120,80,145);
{Обведение области темными линиями}
setlinestyle(0,0,1);
setcolor(1);
rectangle(10,90,130,155);
rectangle(29,119,81,146);
setlinestyle(0,0,1);
{Печать надписи и кол-ва шагов,
пока число шагов просто 0}
setcolor(4);
settextstyle(0,0,1);
outtextxy(20,100,'Number steps ');
outtextxy(40,130,'0');
setcolor(13);
vict:=false; {Победа не инициализирована}

setfillstyle(1,14); {Параметры заполнения 
кубика}
bar3d(152,86,509,445,10,true);{Рисование 
коробки}
{Создание в верхней части экрана полоски и 
надписи на ней}
bar(0,0,639,50);
settextstyle(7,0,5);
outtextxy(125,2,'* 15 *');
{Создание в нижней части экрана полоски и 
надписи на ней}
bar(0,450,639,480);
settextstyle(7,0,3);
outtextxy(80,450,'Press Esc for quit to 
main menu');
{Задание прежних параметров}
settextstyle(7,0,5);
setfillstyle(1,11);

{Включение генератора случайных чисел}
randomize;
{Заполнение массива случайными числами 
от 1 до 15}
mas[16]:=0;
mas[1]:=random(14)+1;
n:=2;
repeat
 u:=true;
 while u do
 begin{Раскладывание пятнашек}
j:=random(15)+1;
u:=false;
for i:=1 to n-1 do 
 {Проверка элементов массива на 
 равенство друг другу}
 if mas[i]=j then u:=true;
 end;{Раскладывание пятнашек}
 mas[n]:=j;
 n:=n+1;
until n=16;{Условие выхода заполнение всего 
массива}

{Рисование фишек игрового поля (табличек)}
for j:=0 to 3 do
 for i:=0 to 3 do
kv(i,j);

{Рисование фона на котором расположена 
коробка}
setbkcolor(7);

{Разкраска коробки}
setfillstyle(1,8);
floodfill(157,90,13);
setfillstyle(1,3);
floodfill(168,82,13);
floodfill(513,90,13);
setfillstyle(1,11);

{Нумерация табличек}
n:=1;
for j:=0 to 3 do
 for i:=0 to 3 do
 if (i<>3) or (j<>3) then
begin
 nomer(i,j,n);
 n:=n+1;
end;

x1:=3;
y1:=3;
x:=3;
y:=3;
{Рисование таблички в нижнем правом 
углу,пока не сделанно ни одного хода}
setcolor(1);
setfillstyle(1,11);
bar3d(418,358,493,433,7,true);

repeat
 kl:=readkey; 
 tabl(x,y,kl,x,y); {Cмены активной 
 таблички}

 {Проверка условия нажатия клавиши пробел}
 if kl=Space then
begin(*if1*)
 u:=(abs(x1-x)=1) and (abs(y1-y)=0) or 
 (abs(x-x1)=0) and (abs(y1-y)=1);

 {Условие перестановки элементов 
 массива}
 if u then
 begin(*if2*)
{Элементы массива, которые меняются 
местами}
i:=4*y+x+1; 
i1:=4*y1+x1+1;
setcolor(11);
nomer(x,y,i);
setcolor(13);
nomer(x1,y1,i);
n:=mas[i1]; {Перестановка элементов 
массива}
mas[i1]:=mas[i];
mas[i]:=n;
x1:=x;
y1:=y;
steps:=steps+1; {Увеличение числа 
шагов на единицу}

{Вывод на экран числа шагов}
setfillstyle(1,7);
bar(30,120,80,145);{Рисование табл.}
setcolor(4);
str(steps,st1);
settextstyle(0,0,1);
outtextxy(40,130,st1);
setcolor(13);
settextstyle(7,0,5);
setfillstyle(1,11);
{Проверка следования чисел в массиве}
u:=true;
j:=0;
n:=0;
repeat
 j:=j+1;
 n:=n+1;
 if (n<>mas[j]) and (n<>12)
 then u:=false;
 if (n=11) and (mas[12]=0)
 then j:=j+1;
until mas[j]=15;
if u and ((mas[15]=15) or
(mas[16]=15)) 
then
 begin(*if3*)
 pl:=Esc;{Выход из цикла}
 vict:=true;{Инициализация победы}
 end;(*if3*)
 end;(*if2*)
 end;(*if1*)
 
{Игрок нажал клавишу Esc}
 if kl=Esc
 then
 begin (*if*)
 {Помещение странички в буфер 
 посредством разбиения 
 ее на 4 части}
 m:=imagesize(0,0,320,240);
 getmem(p,m);
 getimage(0,0,320,240,p^);

 m1:=imagesize(320,0,639,240);
 getmem(p1,m1);
 getimage(320,0,639,240,p1^);

 m2:=imagesize(0,240,320,480);
 getmem(p2,m2);
 getimage(0,240,320,480,p2^);

 m3:=imagesize(320,240,639,480);
 getmem(p3,m3);
 getimage(320,240,639,480,p3^);

 {Вывод меню, после того как игрок 
 нажал Esc} 
 cleardevice;
 setbkcolor(0);
 b3:=0;
 repeat
 {Рисование двойной рамочки}
 setcolor(1);
 setlinestyle(0,0,1);
 rectangle(243,183,417,257);
 rectangle(248,188,412,252);
 setfillstyle(1,14);{Орнамент и 
 цвет заполнения указателя}
 
 {Указатель-выбор пункта}
 bar(250,190+30*b3,410,220+30*b3);
 setcolor(13);
 settextstyle(8,0,1);
 outtextxy(275,195,'Continue . . 
 .');
 outtextxy(275,220,'Exit ');
 b2:=readkey;
 setfillstyle(1,0);
 bar(250,190+30*b3,410,220+30*b3);
 {Движение по пунктам меню}
 if b2=up then b3:=0;
 if b2=down then b3:=1;
 if b3=0
 then kl:='z'{Выбран пункт 
 Continue}
 else kl:=Esc{Выбран пункт Exit}
 until b2=Enter;
 end; (*if*)
 {Если выбран пункт Continue,то 
 страничка возвращается из буфера,а 
 затем буфер очищается}
 if kl='z'
 then
 begin
 cleardevice;
 setbkcolor(7);

 putimage(0,0,p^,normalput);
 freemem(p,m);

 putimage(320,0,p1^,normalput);
 freemem(p1,m1);

 putimage(0,240,p2^,normalput);
 freemem(p2,m2);

 putimage(320,240,p3^,normalput);
 freemem(p3,m3);

 settextstyle(7,0,5);
 setfillstyle(1,11)
 end
 until (kl=Esc) or (pl=Esc) ;

 {Демонстрация победы после завершения игры}
 if vict then
begin(*vict*)
 cleardevice;{Очистка экрана}
 victory;{Процедура победы}
 {Вывод на экран числа шагов,сделанных 
 пользователем, и поздравления}
 setcolor(4);
 settextstyle(7,0,5);
 outtextxy(100,50,'You are win ! ! !');
 str(steps,step);
 outtextxy(100,100,'You made');
 outtextxy(150,150,step);
 outtextxy(250,150,'steps.');
 repeat
 until keypressed;
 kl:=readkey;
 i:=0;
 {Сравнение результатов}
 repeat
 i:=i+1;
 val(stroka[i*2],b,x);
 until (b>steps) or (i=6);
 {Если результат игрока превосходит один из 
 результатов в таблице,он заносится в 
 таблицу}
 if i<6 then
 begin(*Переформирование таблицы 
 рекордов*)
 for j:=5 downto i do
 begin(*Сдвиг рекордов*)
stroka[j*2+1]:=stroka[j*2-1];
stroka[j*2+2]:=stroka[j*2];
 end;(*Сдвиг рекордов*)
{Преглашение игрока к вводу имени}
cleardevice;
setbkcolor(0);
outtextxy(10,130,'Please, enter your 
name :');

{Создание рамочки}
setcolor(10);
rectangle(100,225,525,290);
rectangle(98,223,527,292);
{Ввод имени игрока}
kl:=readkey;
j:=1;
stroka[i*2-1]:='';
u:=not(kl=enter);
while u do
 begin(*Чтение имени игрока*)
 u:=(kl>' ') and (kl<'z') and (j<11);
 if u
 then
begin(*нц*)
 stroka[i*2-1]:=stroka[i*2-1]+kl;
 outtextxy(80+j*40,230,kl);{Печать 
 буквы на новой позиции}
 j:=j+1;
end;(*кц*)
 kl:=readkey;
 u:=not(kl=Enter);
 end;(*Чтение имени игрока*)

 {Если игрок не ввел имя, то его имя 
 Noname}
 if length(stroka[i*2-1])=0 
 then stroka[i*2-1]:='Noname';
stroka[i*2]:=step;
(*Запись рекорда в файл*)
rewrite(f02);
for i:=1 to 10 do
 writeln(f02,stroka[i]);
close(f02);
 end;(*Переф. табл. рекорд.*)
end;(*vict*)
end;(*game*)

(*Процедура вывода таблицы рекордов*)
procedure best;
 begin(*best*)
 cleardevice; {Очистка экрана}
 {Рисование двойной рамочки}
 setlinestyle(0,0,3);
 setcolor(13);
 rectangle(13,138,621,434);
 rectangle(9,132,625,440);
 setlinestyle(0,0,1);
 {Задание параметров заполнения рамочки}
 setfillstyle(1,14);
 floodfill(24,140,13);
 {Надпись лучшие игроки}
 setcolor(10);
 settextstyle(7,0,7);
 outtextxy(30,45,'Best players are:');
 {Печать таблицы результатов}
 setcolor(13);
 settextstyle(0,0,100);
 for a02:=1 to 5 do
begin(*for a02*)
 str(a02,stl2);{Преобразование числа в 
 посл-ть}
 c02:=length(stroka[a02*2-1]);
 stl2:=stl2+' '+stroka[a02*2-1];
 for e02:=1 to 11-c02 do{Разделение имени 
 игрока и результата точками}
 stl2:=stl2+'.';
 for e02:=1 to 5-length(stroka[a02*2]) do
 stl2:=stl2+'.';
 stl2:=stl2+stroka[a02*2];
 outtextxy(40,100+50*a02,stl2);
 if a02<>0 then setcolor(9); {Выделение 
 лучшего игрока другим цветом}
 end;(*for a02*)
 repeat
 until keypressed;
 kl:=readkey;
 setcolor(13);
 end;(*best*)

(*Процедура вывода помощи*)
procedure help;
 var
 st3:string;
 begin(*help*)
 assign(f03,'pravila.dat');
 reset(f03); {Открытие файла pravila.dat}
 closegraph; {Выход из графического режима}
 clrscr; {Очистка экрана}
 kl:='n';
 while not(eof(f03)) {Не конец файла} and 
 (kl<>Esc) {Не нажата кл. Esc} do
 begin {нц1}
 i:=1;
 while (i<25) {Страница} and not(eof(f03)) do
 begin {нц2}
i:=i+1;
readln(f03,st3); {Чтение из файла 
элементов строки st3}
writeln('',st3); {Печать 
содержимого строки st3 }
{Условие необходимое для того,
чтобы в конце не нажимать Enter 2 раза}
if eof(f03)
then kl:=enter
else kl:=#10
 end;{кц2}
 gotoxy(12,25);
 repeat {Ожидание нажатия клавиши Enter 
 или Esc}
 if keypressed then kl:=readkey;
 until (kl=enter) or (kl=esc);
end;{кц1}
clrscr;
gotoxy(21,12);
writeln('Нажмите любую клавишу для выхода в 
меню');
repeat
until keypressed;
kl:=readkey;
kl:='n';
{Инициализация графического режима и установка 
прежних параметров}
InitGraph(grDriver, grMode,'');
setbkcolor(11);
setcolor(13);
setlinestyle(0,0,3);
 end;(*help*)
END.