Скачать: DOSMINE.PAS
Игра разработана
- На языке программирования Pascal,
- В университете Zimbabwe,
- Yonas Tesfazghi weldeselassie,
- В среду 23-го февраля 2000.
Заглушка
Именно эта программа использована в качестве примера для создания программ для запуска на других компьютерах. Если вы скачаете этот .zip, распакуете и запустите DOSMINE.EXE прямо из Windows, то «Сапёр для DOS» запустится в DOSBox аналогично тому, как это автоматизировано в School Pak.
Источник | Примечание |
---|---|
Обычный файлохостинг | |
Магнитная ссылка |
Код
Program MineSweeper;
{****************************************************************************}
Uses Crt,Graph,Dos;
{****************************************************************************}
Const Board : FillPatternType=($FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF);
Xb=225; Yb=150; Rb=8; Cb=8; Mb=10;
Xi=158; Yi=90; Ri=16; Ci=16; Mi=40;
Xe=15; Ye=90; Re=16; Ce=30; Me=100;
Dim=20;
{****************************************************************************}
Type Mine= record
Num:Integer;
Opened:Boolean;
Mistaken:Boolean;
Suspended1:Boolean;
Suspended2:Boolean;
end;
{****************************************************************************}
Var InitialX,InitialY,FinalX,FinalY,FreeSpaces,TotalMines,FreeCounter,
Level,TotalRows,TotalColumns : Integer;
Over,Interupted:Boolean;
A:Array[1..Re,1..Ce] of Mine;
Ch:Char;
{****************************************************************************}
Procedure OpenGraphics;
Var GraphDriver,GraphMode,ErrorCode:Integer;
begin
GraphDriver:=Detect;
InitGraph(GraphDriver,GraphMode,'X:\BP');
ErrorCode := GraphResult;
If (ErrorCode<>GrOk) then
begin
ClrScr;
Writeln('Graphics Error! ',GraphErrorMsg(ErrorCode));
Writeln('Please use SchoolPak to run this game...');
Writeln('Download it here: http://dim-hj.gorodok.net/ ');
Write('Press any key...');
Ch:=Readkey;
Halt(1);
end;
end;
{****************************************************************************}
Procedure Introduction;
Var i:Integer;
begin
ClearDevice;
SetColor(13);
Rectangle(40,120,600,310);
SetFillPattern(Board,1);
FloodFill(300,150,13);
SetTextStyle(DefaultFont,HorizDir,3);
OutTextXY(85,130,'Д');
SetTextStyle(DefaultFont,HorizDir,2);
OutTextXY(110,133,'обро пожаловать в игру Сапёр!');
SetColor(15);
For i:=0 to 24 do
begin
Line(325,154,325+10*i,154);
Line(325,155,325+10*i,155);
Line(325,154,325-10*i,154);
Line(325,155,325-10*i,155);
delay(50);
end;
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(200,165,'*** Игра разработана ***');
OutTextXY(170,185,'- На языке программирования Pascal,');
OutTextXY(170,205,'- В университете Zimbabwe,');
OutTextXY(170,225,'- Yonas Tesfazghi weldeselassie,');
OutTextXY(170,245,'- В среду 23-го февраля 2000.');
SetColor(Yellow);
OutTextXY(200,280,'Нажмите любую клавишу для продолжения...');
Ch := ReadKey;
end;
{****************************************************************************}
Procedure Timer(n:Integer);
Var h,m,s,hund:word;
begin
GetTime(h,m,s,hund);
If (n=1) then {The game is being started.}
begin
SetColor(2);
Rectangle(20,450,130,470);
Rectangle(510,450,610,470);
SetTextstyle(DefaultFont,HorizDir,1);
SetColor(12);
OutTextXY(25,440,'Время начала');
OutTextXY(517,440,'Время конца');
OutTextXY(35,457,Chr(h div 10+48));
OutTextXY(45,457,Chr(h mod 10+48));
OutTextXY(55,457,':');
OutTextXY(65,457,Chr(m div 10+48));
OutTextXY(75,457,Chr(m mod 10+48));
OutTextXY(85,457,':');
OutTextXY(95,457,Chr(s div 10+48));
OutTextXY(105,457,Chr(s mod 10+48));
SetTextstyle(DefaultFont,HorizDir,2);
OutTextXY(555,453,'?');
end
Else {The player has won the game or the game is over.}
begin
SetFillPattern(Board,0);
FloodFill(550,460,2);
SetColor(12);
SetTextstyle(DefaultFont,HorizDir,1);
OutTextXY(522,457,Chr(h div 10+48));
OutTextXY(532,457,Chr(h mod 10+48));
OutTextXY(542,457,':');
OutTextXY(552,457,Chr(m div 10+48));
OutTextXY(562,457,Chr(m mod 10+48));
OutTextXY(572,457,':');
OutTextXY(582,457,Chr(s div 10+48));
OutTextXY(592,457,Chr(s mod 10+48));
end;
end;
{*************************************************************** *************}
Procedure HelpMenu;
begin
ClearDevice;
SetTextStyle(DefaultFont,HorizDir,2);
SetColor(13);
Rectangle(259,0,379,20);
SetColor(2);
OutTextXY(280,3,'Сапёр');
SetColor(15);
SetTextStyle(DefaultFont,HorizDir,1);
Rectangle(10,20,630,479);
SetFillPattern(Board,1);
FloodFill(300,150,15);
SetColor(10);
OutTextXY(243,30,'Правила игры в Сапёр');
Line(237,40,408,40);
SetColor(7);
OutTextXY(25,50,' Сапёр -- это игра с игровым полем и несколькими минами на этом поле.');
OutTextXY(25,65,'Поле поделено на мелкие квадраты, и количество этих квадратов и мин зависит');
OutTextXY(25,80,'от желаемого УРОВНЯ игры. Размер поля и количество мин на каждый уровнь');
OutTextXY(25,95,'следующие:');
OutTextXY(25,110,'');
SetColor(10);
OutTextXY(30,125,' Уровень игры #Строк #Столбцов #Квадратов #Мин ');
Line(53,135,150,135); Line(173,135,223,135); Line(255,135,325,135);
Line(360,135,437,135); Line(462,135,495,135);
SetColor(15);
OutTextXY(55,140,'Новичок 8 8 8x8=64 10');
OutTextXY(55,155,'Любитель 16 16 16x16=256 40');
OutTextXY(55,170,'Эксперт 16 30 16x30=480 100');
SetColor(7);
OutTextXY(25,190,' Мины ПРОИЗВОЛЬНО расставлены в квадратах, и ваша цель -- ТОЧНО определить');
OutTextXY(25,205,'месторасположение мин. Вы указываете их, нажимая клавишу на квадрате');
OutTextXY(25,220,'с миной внутри.');
SetColor(14); OutTextXY(483,205,'<ESC>');
SetColor(7); OutTextXY(170,220,'');
OutTextXY(25,235,' Если в квадрате НЕТ мины, то на нём написано число, которое указывает');
OutTextXY(25,250,'количество соседних квадратов с минами. Чтобы узнать, ПУСТОЙ ли квадрат,');
OutTextXY(25,265,'нужно нажать клавишу на нём. Однако, нажатие клавиши ENTER в');
SetColor(14); OutTextXY(194,265,'<ENTER>');
SetColor(7); OutTextXY(485,265,'');
OutTextXY(25,280,'квадрате с миной приведёт к фатальному исходу. Поэтому нужно стараться');
OutTextXY(25,295,'не нажимать клавишу ENTER на квадрате с миной.');
OutTextXY(25,310,' Когда вы начинаете игру, вы видите индикатор, квадрат, нарисованный');
OutTextXY(25,325,'особенным цветом. Вы можете передвигать индикатор в любую сторону клавишами');
SetColor(14); OutTextXY(25,340,'<СТРЕЛКИ>'); SetColor(7);
OutTextXY(87,340,' . В самом начале вы можете нажать клавишу ENTER где угодно, и');
OutTextXY(25,355,'этот квадрат будет обязательно пустым.');
OutTextXY(25,370,' Если вы решили, что в квадрате есть мина, и поставили пометку, но');
OutTextXY(25,385,'передумали и хотите убрать пометку, нужно нажать клавишу ESC ещё раз на');
OutTextXY(25,400,'этои квадрате. На этот раз вы увидите знак вопроса, обозначающий, что вы');
OutTextXY(25,415,'отменяете пометку. Следующее нажатие ESC уберёт этот знак вопроса, и');
OutTextXY(25,430,'этот квадрат возвратится в изначальное нетронутое состояние.');
SetColor(13); OutTextXY(150,450,'Нажмите , чтобы остановить игру');
SetColor(14); OutTextXY(64,470,'НАЖМИТЕ ЛЮБУЮ КЛАВИШУ ДЛЯ ПРОДОЛЖЕНИЯ...');
SetColor(15); OutTextXY(390,470,'С наилучшими пожеланиями! Y.T.');
SetTextStyle(DefaultFont,HorizDir,2);
OutTextXY(215,447,'S');
Ch := Readkey;
end;
{****************************************************************************}
Procedure WriteHeading(Y:Integer);
begin
SetColor(13);
Rectangle(136,Y,496,Y+40);
SetColor(Green);
SetTextStyle(DefaultFont,HorizDir,3);
OutTextXY(254, Y+10,'САПЁР');
SetColor(13);
If (Y=40) then
begin
Rectangle(235,Y+40,385,Y+60);
SetColor(yellow);
SetTextStyle(DefaultFont,HorizDir,2);
OutTextXY(257,Y+45,'Уровень');
end
Else
begin
Rectangle(220,Y+40,400,Y+60);
SetColor(Yellow);
SetTextStyle(DefaultFont,HorizDir,1);
If (Level=1) then
OutTextXY(255,Y+50,'Новичок')
Else if (Level=2) then
OutTextXY(240,Y+50,'Любитель')
Else OutTextXY(265,Y+50,'Эксперт');
end;
end;
{****************************************************************************}
Procedure SetData(GL:Integer);
begin
If (GL=1) then
begin
Level:=1;
TotalMines:=Mb;
TotalRows:=Rb;
TotalColumns:=Cb;
FreeSpaces:=Rb*Cb-Mb;
InitialX:=Xb;
InitialY:=Yb;
end
Else if (GL=2) then
begin
Level:=2;
TotalMines:=Mi;
TotalRows:=Ri;
TotalColumns:=Ci;
FreeSpaces:=Ri*Ci-Mi;
InitialX:=Xi;
InitialY:=Yi;
end
Else
begin
Level:=3;
TotalMines:=Me;
TotalRows:=Re;
TotalColumns:=Ce;
FreeSpaces:=Re*Ce-Me;
InitialX:=Xe;
InitialY:=Ye;
end;
FinalX:=InitialX+TotalColumns*Dim;
FinalY:=InitialY+TotalRows*Dim;
end;
{****************************************************************************}
Procedure WelComing;
begin
Introduction;
HelpMenu;
ClearDevice;
WriteHeading(40);
SetColor(13);
Rectangle(40,120,600,270);
SetFillPattern(Board,1);
FloodFill(300,150,13);
SetColor(15);
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(170,150,'Выберите уровень игры:');
OutTextXY(230,170,'1. Новичок,');
OutTextXY(230,190,'2. Любитель или');
OutTextXY(230,210,'3. Эксперт.');
SetColor(Yellow);
OutTextXY(220,245,'Нажмите 1, 2 или 3.');
Repeat
Ch:=Readkey;
Until (Ch in ['1','2','3']);
SetData(Ord(Ch)-48);
end;
{****************************************************************************}
Procedure DrawNonOpened(X,Y:Integer);
begin
SetColor(DarkGray);
Rectangle(X,Y,X+Dim,Y+Dim);
SetFillPattern(Board,LightGray);
FloodFill(X+Dim div 2,Y+ Dim div 2,DarkGray);
Line(X+2,Y+Dim-2,X+Dim-2,Y+Dim-2);
Line(X+Dim-2,Y+2,X+Dim-2,Y+Dim-2);
SetColor(White);
Line(X+2,Y+2,X+Dim-2,Y+2);
Line(X+2,Y+2,X+2,Y+Dim-2);
end;
{****************************************************************************}
Procedure DrawField;
Var i:Integer;
begin
ClearDevice;
WriteHeading(5);
SetColor(darkGray);
Rectangle(InitialX-10,InitialY-10,FinalX+10,FinalY+10);
SetFillPattern(Board,LightGray);
FloodFill(InitialX,InitialY,DarkGray);
For i:=1 to 11 do
begin
If (i in [1,2,3,4]) then
begin
SetColor(DarkGray);
Line(initialX-i,InitialY-i,InitialX-i,Finaly+i);
Line(InitialX-i,InitialY-i,FinalX+i,InitialY-i);
SetColor(White);
Line(InitialX-i,FinalY+i,FinalX+i,FinalY+i);
Line(FinalX+i,InitialY-i,FinalX+i,FinalY+i);
end
Else if (i in [9,10,11]) then
begin
SetColor(DarkGray);
Line(InitialX-i,FinalY+i,FinalX+i,FinalY+i);
Line(FinalX+i,InitialY-i,FinalX+i,FinalY+i);
SetColor(White);
Line(InitialX-i,InitialY-i,FinalX+i,InitialY-i);
Line(InitialX-i,InitialY-i,InitialX-i,FinalY+i);
end;
end;
SetColor(darkGray);
Rectangle(InitialX-1,InitialY-1,FinalX+1,FinalY+1);
end;
{****************************************************************************}
Procedure DrawBoard;
Var X,Y,i,j:Integer;
begin
DrawField;
For i:=0 to (TotalRows-1) do
begin
Y:=InitialY+Dim*i;
For j:=0 to (TotalColumns-1) do
begin
X:=InitialX+Dim*j;
DrawNonOpened(X,Y);
end;
end;
end;
{****************************************************************************}
Procedure DrawNewIndicator(X,Y:Integer);
begin
SetColor(13);
Rectangle(X+3,Y+3,X+Dim-3,Y+Dim-3);
Rectangle(X+4,Y+4,X+Dim-4,Y+Dim-4);
end;
{****************************************************************************}
Procedure RemoveOldIndicator(X,Y:Integer);
begin
SetColor(7);
Rectangle(X+3,Y+3,X+Dim-3,Y+Dim-3);
Rectangle(X+4,Y+4,X+Dim-4,Y+Dim-4);
end;
{****************************************************************************}
Procedure MoveIndicator(Var X,Y,Row,Col:Integer; Ch:Char);
Var OldX,OldY:Integer;
begin
OldX:=X;
OldY:=Y;
Case Ch of
#72: If (Y>InitialY) then
begin
Y:=Y-Dim;
Dec(Row);
end;
#75: If (X>InitialX) then
begin
X:=X-Dim;
Dec(Col);
end;
#77: If ((X+Dim)<FinalX) then
begin
X:=X+Dim;
Inc(Col);
end;
#80: If ((Y+Dim)<FinalY) then
begin
Y:=Y+Dim;
Inc(Row);
end;
end;
If ((OldX<>X) or (OldY<>Y)) then
begin
RemoveOldIndicator(OldX,OldY);
DrawNewIndicator(X,Y);
end;
end;
{****************************************************************************}
Procedure WriteNumber(X,Y,Row,Col:Integer);
Var Color:Integer;
begin
Case A[Row,Col].Num of
1: Color:=9; 4: Color:=1; 7: Color:=12;
2: Color:=2; 5: Color:=5; 8: Color:=13;
3: Color:=4; 6: Color:=3; 9: Color:=0;
end;
SetColor(Color);
SetTextStyle(DefaultFont,HorizDir,1);
If (A[Row,Col].Num=9) then
OutTextXY(X+7,Y+7,Chr(15))
Else OutTextXY(X+7,Y+7,Chr(A[Row,Col].Num+48));
end;
{****************************************************************************}
Procedure DrawOpened(X,Y,Row,Col:Integer);
var Color:Integer;
begin
If (A[Row,Col].Suspended2) then
DrawNonOpened(X,Y);
color:=1;
SetColor(Color);
Rectangle(X+1,Y+1,X+Dim-1,Y+Dim-1);
SetFillPattern(Board,LightGray);
FloodFill(X+Dim div 2,Y+Dim div 2,Color);
If (A[Row,Col].num<>0) then
WriteNumber(X,Y,Row,Col);
end;
{****************************************************************************}
Procedure DrawSuspended1(X,Y:Integer);
Var Color:Integer;
begin
DrawNonOpened(X,Y);
Color:=Red;
SetColor(Color);
setTextStyle(defaultFont,HorizDir,1);
OutTextXY(X+7,Y+7,Chr(6));
end;
{****************************************************************************}
Procedure DrawSuspended2(X,Y:Integer);
Var Color:Integer;
begin
DrawNonOpened(X,Y);
Color:=1;
SetColor(Color);
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(X+7,Y+7,Chr(63));
end;
{****************************************************************************}
Procedure OpenSurrounding(X,Y,Row,Col:Integer);
Var XX,YY,RR,CC,i,j:Integer;
begin
For i:=-1 to 1 do
begin
RR:=Row+i;
If (RR in [1..TotalRows]) then
begin
For j:=-1 to 1 do
begin
CC:=Col+j;
If (CC in [1..TotalColumns]) then
begin
If (Not((A[RR,CC].Opened) or (A[RR,CC].Suspended1) or
(A[RR,CC].Suspended2))) then
begin
A[RR,CC].Opened:=True;
XX:=X+Dim*j;
YY:=Y+Dim*i;
DrawOpened(XX,YY,RR,CC);
Inc(FreeCounter);
If (A[RR,CC].Num=0) then
OpenSurrounding(XX,YY,RR,CC);
end;
end;
end;
end;
end;
end;
{****************************************************************************}
Procedure Allocate(Row,Col:Integer);
Var R,C,RR,CC,Sum,i,j:Integer;
begin
For i:=1 to TotalMines do
begin
Randomize;
Repeat
R:=Random(TotalRows)+1;
C:=Random(TotalColumns)+1;
Until (((R<>Row) or (C<>Col)) and (A[R,C].Num<>9));
A[R,C].Num:=9;
end;
For R:=1 to TotalRows do
begin
For C:=1 to totalColumns do
begin
If (A[R,C].Num<>9) then
begin
Sum:=0;
For i:=-1 to 1 do
begin
RR:=R+i;
If (RR in [1..TotalRows]) then
begin
For j:=-1 to 1 do
begin
CC:=C+j;
If (CC in [1..TotalColumns]) then
begin
If (A[RR,CC].Num=9) then
Inc(Sum);
end;
end;
end;
end;
A[R,C].Num:=Sum;
end;
end;
end;
end;
{****************************************************************************}
Procedure DrawCross(X,Y,Row,Col:Integer);
Var Color:Integer;
begin
SetColor(Red);
Line(X+4,Y+4,X+Dim-4,Y+Dim-4);
Line(X+5,Y+4,X+Dim-3,Y+Dim-4);
Line(X+4,Y+Dim-4,X+Dim-4,Y+4);
Line(X+5,Y+Dim-4,X+Dim-3,Y+4);
end;
{****************************************************************************}
Procedure Success;
begin
Timer(2);
SetColor(13);
SetTextStyle(DefaultFont,HorizDir,2);
OutTextXY(180,FinalY+25,'ПОЗДРАВЛЕНИЯ!');
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(220,FinalY+45,'Вы выиграли игру.');
end;
{****************************************************************************}
Procedure GameOver(X,Y:Integer);
Var XX,YY,Row,Col:Integer;
begin
Timer(2);
For Row:=1 to TotalRows do
begin
YY:=InitialY+(Row-1)*Dim;
For Col:=1 to TotalColumns do
begin
If (Not(A[Row,Col].Opened)) then
begin
XX:=InitialX+(Col-1)*Dim;
If (A[Row,Col].Mistaken) then
DrawCross(XX,YY,Row,Col)
Else if ((A[Row,Col].Num=9) and
(Not(A[Row,Col].Suspended1))) then
DrawOpened(XX,YY,Row,Col);
end;
end;
end;
SetColor(1);{Now show where the MISTAKE occured.}
Rectangle(X+1,Y+1,X+Dim-1,Y+Dim-1);
SetFillPattern(Board,Red);
FloodFill(X+Dim div 2,Y+Dim div 2,1);
OutTextXY(X+7,Y+7,Chr(47));
OutTextXY(X+7,Y+7,Chr(92));
SetColor(13);
SetTextStyle(DefaultFont,HorizDir,2);
OutTextXY(130,FinalY+30,' Вы проиграли!');
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(350,FinalY+35,' Игра окончена.');
end;
{****************************************************************************}
Procedure Warning;
begin
SetColor(15);
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(142,FinalY+25,'Вы действительно хотите прервать игру? (Y/N)');
Repeat
Ch:=Readkey;
Until (Ch in ['n','N','y','Y']);
If (Ch in ['y','Y']) then
Interupted:=True;
SetColor(0);
OutTextXY(142,FinalY+25,'Вы действительно хотите прервать игру? (Y/N)');
end;
{****************************************************************************}
Procedure Play(Var X,Y,Row,Col:Integer);
begin
Repeat
Ch:=Readkey;
Until ((Ord(Ch) in [13,27,83,115]) or (Ch in [#72,#75,#77,#80]));
If (Ch in [#72,#75,#77,#80]) then
MoveIndicator(X,Y,Row,Col,Ch)
Else if (Ord(Ch)=13) then
begin
If (Not((A[Row,Col].Opened) or (A[Row,Col].Suspended1))) then
begin
A[Row,Col].Opened:=True;
DrawOpened(X,Y,Row,Col);
DrawNewIndicator(X,Y);
If (A[Row,Col].Num=9) then
begin
Over:=True;
GameOver(X,Y);
end
Else
begin
Inc(FreeCounter);
If (A[Row,Col].Num=0) then
OpenSurrounding(X,Y,Row,Col);
If (FreeCounter=FreeSpaces) then
begin
Over:=True;
Success;
end;
end;
end;
end
Else if (Ord(Ch)=27) then
begin
If (Not(A[Row,Col].Opened)) then
begin
If (A[Row,Col].suspended1) then
begin
A[Row,Col].Suspended1:=False;
A[Row,Col].Suspended2:=True;
A[Row,Col].Mistaken:=False;
DrawSuspended2(X,Y);
end
Else if (A[Row,Col].Suspended2) then
begin
A[Row,Col].Suspended2:=False;
DrawNonOpened(X,Y);
end
Else
begin
A[Row,Col].Suspended1:=True;
DrawSuspended1(X,Y);
If (A[Row,Col].Num<>9) then
A[Row,Col].Mistaken:=True
end;
DrawNewindicator(X,Y);
end;
end
Else Warning;
end;
{****************************************************************************}
Procedure StartGame;
Var X,Y,Row,Col:Integer;
begin
Repeat
Over:=False;
Interupted:=False;
DrawBoard;
For Row:=1 to TotalRows do
begin
For Col:=1 to TotalColumns do
begin
A[Row,Col].Num:=0;
A[Row,Col].Opened:=False;
A[Row,Col].Mistaken:=False;
A[Row,Col].Suspended1:=False;
A[Row,Col].Suspended2:=False;
end;
end;
Randomize;
Row:=Random(TotalRows)+1;
Col:=Random(TotalColumns)+1;
X:=InitialX+(Col-1)*Dim;
Y:=InitialY+(Row-1)*Dim;
DrawNewIndicator(X,Y);
Repeat
Repeat
Ch:=Readkey;
Until ((Ch in [#72,#75,#77,#80]) or (Ord(Ch) in [13,83,115]));
If (Ch in [#72,#75,#77,#80]) then
MoveIndicator(X,Y,Row,Col,Ch)
Else if (Ord(Ch)=13) then
begin
Allocate(Row,Col);
A[Row,Col].Opened:=True;
DrawOpened(X,Y,Row,Col);
FreeCounter:=1;
DrawNewIndicator(X,Y);
If (A[Row,Col].Num=0) then
OpenSurrounding(X,Y,Row,Col);
If (FreeCounter=FreeSpaces) then
begin
Over:=True;
Success;
end;
end
Else Warning;
Until ((Ord(Ch)=13) or (Interupted));
If (Ord(Ch)=13) then
begin
Timer(1);
Repeat
Play(X,Y,Row,Col);
Until ((Over) or (Interupted));
end;
SetColor(15);
SetTextStyle(DefaultFont,HorizDir,1);
If Interupted then
begin
OutTextXY(210,FinalY+25,'Вы покинули игру!');
OutTextXY(190,FinalY+45,'Хотите сыграть ещё раз? (Y/N)');
end
Else
OutTextXY(190,FinalY+60,'Хотите сыграть ещё раз? (Y/N)');
Repeat
Ch:=Readkey;
Until (Ord(Ch) in [78,89,110,121]);
If (Ord(Ch) in [89,121]) then
begin
If Interupted then OutTextXY(450,FinalY+45,'y');
SetColor(0); OutTextXY(190,FinalY+60,'Хотите сыграть ещё раз? (Y/N)');
SetColor(15); OutTextXY(220,FinalY+60,'Какой уровень? (1,2 or 3)');
Repeat
Ch:=Readkey;
Until (Ord(Ch) in [49,50,51]);
SetData(Ord(Ch)-48);
end;
Until (Ord(Ch) in [78,110]);
ClearDevice;
CloseGraph;
end;
{****************************************************************************}
BEGIN{Main Program}
OpenGraphics;
WelComing;
StartGame;
END.{Main Program}
{****************************************************************************}
Uses Crt,Graph,Dos;
{****************************************************************************}
Const Board : FillPatternType=($FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF);
Xb=225; Yb=150; Rb=8; Cb=8; Mb=10;
Xi=158; Yi=90; Ri=16; Ci=16; Mi=40;
Xe=15; Ye=90; Re=16; Ce=30; Me=100;
Dim=20;
{****************************************************************************}
Type Mine= record
Num:Integer;
Opened:Boolean;
Mistaken:Boolean;
Suspended1:Boolean;
Suspended2:Boolean;
end;
{****************************************************************************}
Var InitialX,InitialY,FinalX,FinalY,FreeSpaces,TotalMines,FreeCounter,
Level,TotalRows,TotalColumns : Integer;
Over,Interupted:Boolean;
A:Array[1..Re,1..Ce] of Mine;
Ch:Char;
{****************************************************************************}
Procedure OpenGraphics;
Var GraphDriver,GraphMode,ErrorCode:Integer;
begin
GraphDriver:=Detect;
InitGraph(GraphDriver,GraphMode,'X:\BP');
ErrorCode := GraphResult;
If (ErrorCode<>GrOk) then
begin
ClrScr;
Writeln('Graphics Error! ',GraphErrorMsg(ErrorCode));
Writeln('Please use SchoolPak to run this game...');
Writeln('Download it here: http://dim-hj.gorodok.net/ ');
Write('Press any key...');
Ch:=Readkey;
Halt(1);
end;
end;
{****************************************************************************}
Procedure Introduction;
Var i:Integer;
begin
ClearDevice;
SetColor(13);
Rectangle(40,120,600,310);
SetFillPattern(Board,1);
FloodFill(300,150,13);
SetTextStyle(DefaultFont,HorizDir,3);
OutTextXY(85,130,'Д');
SetTextStyle(DefaultFont,HorizDir,2);
OutTextXY(110,133,'обро пожаловать в игру Сапёр!');
SetColor(15);
For i:=0 to 24 do
begin
Line(325,154,325+10*i,154);
Line(325,155,325+10*i,155);
Line(325,154,325-10*i,154);
Line(325,155,325-10*i,155);
delay(50);
end;
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(200,165,'*** Игра разработана ***');
OutTextXY(170,185,'- На языке программирования Pascal,');
OutTextXY(170,205,'- В университете Zimbabwe,');
OutTextXY(170,225,'- Yonas Tesfazghi weldeselassie,');
OutTextXY(170,245,'- В среду 23-го февраля 2000.');
SetColor(Yellow);
OutTextXY(200,280,'Нажмите любую клавишу для продолжения...');
Ch := ReadKey;
end;
{****************************************************************************}
Procedure Timer(n:Integer);
Var h,m,s,hund:word;
begin
GetTime(h,m,s,hund);
If (n=1) then {The game is being started.}
begin
SetColor(2);
Rectangle(20,450,130,470);
Rectangle(510,450,610,470);
SetTextstyle(DefaultFont,HorizDir,1);
SetColor(12);
OutTextXY(25,440,'Время начала');
OutTextXY(517,440,'Время конца');
OutTextXY(35,457,Chr(h div 10+48));
OutTextXY(45,457,Chr(h mod 10+48));
OutTextXY(55,457,':');
OutTextXY(65,457,Chr(m div 10+48));
OutTextXY(75,457,Chr(m mod 10+48));
OutTextXY(85,457,':');
OutTextXY(95,457,Chr(s div 10+48));
OutTextXY(105,457,Chr(s mod 10+48));
SetTextstyle(DefaultFont,HorizDir,2);
OutTextXY(555,453,'?');
end
Else {The player has won the game or the game is over.}
begin
SetFillPattern(Board,0);
FloodFill(550,460,2);
SetColor(12);
SetTextstyle(DefaultFont,HorizDir,1);
OutTextXY(522,457,Chr(h div 10+48));
OutTextXY(532,457,Chr(h mod 10+48));
OutTextXY(542,457,':');
OutTextXY(552,457,Chr(m div 10+48));
OutTextXY(562,457,Chr(m mod 10+48));
OutTextXY(572,457,':');
OutTextXY(582,457,Chr(s div 10+48));
OutTextXY(592,457,Chr(s mod 10+48));
end;
end;
{*************************************************************** *************}
Procedure HelpMenu;
begin
ClearDevice;
SetTextStyle(DefaultFont,HorizDir,2);
SetColor(13);
Rectangle(259,0,379,20);
SetColor(2);
OutTextXY(280,3,'Сапёр');
SetColor(15);
SetTextStyle(DefaultFont,HorizDir,1);
Rectangle(10,20,630,479);
SetFillPattern(Board,1);
FloodFill(300,150,15);
SetColor(10);
OutTextXY(243,30,'Правила игры в Сапёр');
Line(237,40,408,40);
SetColor(7);
OutTextXY(25,50,' Сапёр -- это игра с игровым полем и несколькими минами на этом поле.');
OutTextXY(25,65,'Поле поделено на мелкие квадраты, и количество этих квадратов и мин зависит');
OutTextXY(25,80,'от желаемого УРОВНЯ игры. Размер поля и количество мин на каждый уровнь');
OutTextXY(25,95,'следующие:');
OutTextXY(25,110,'');
SetColor(10);
OutTextXY(30,125,' Уровень игры #Строк #Столбцов #Квадратов #Мин ');
Line(53,135,150,135); Line(173,135,223,135); Line(255,135,325,135);
Line(360,135,437,135); Line(462,135,495,135);
SetColor(15);
OutTextXY(55,140,'Новичок 8 8 8x8=64 10');
OutTextXY(55,155,'Любитель 16 16 16x16=256 40');
OutTextXY(55,170,'Эксперт 16 30 16x30=480 100');
SetColor(7);
OutTextXY(25,190,' Мины ПРОИЗВОЛЬНО расставлены в квадратах, и ваша цель -- ТОЧНО определить');
OutTextXY(25,205,'месторасположение мин. Вы указываете их, нажимая клавишу на квадрате');
OutTextXY(25,220,'с миной внутри.');
SetColor(14); OutTextXY(483,205,'<ESC>');
SetColor(7); OutTextXY(170,220,'');
OutTextXY(25,235,' Если в квадрате НЕТ мины, то на нём написано число, которое указывает');
OutTextXY(25,250,'количество соседних квадратов с минами. Чтобы узнать, ПУСТОЙ ли квадрат,');
OutTextXY(25,265,'нужно нажать клавишу на нём. Однако, нажатие клавиши ENTER в');
SetColor(14); OutTextXY(194,265,'<ENTER>');
SetColor(7); OutTextXY(485,265,'');
OutTextXY(25,280,'квадрате с миной приведёт к фатальному исходу. Поэтому нужно стараться');
OutTextXY(25,295,'не нажимать клавишу ENTER на квадрате с миной.');
OutTextXY(25,310,' Когда вы начинаете игру, вы видите индикатор, квадрат, нарисованный');
OutTextXY(25,325,'особенным цветом. Вы можете передвигать индикатор в любую сторону клавишами');
SetColor(14); OutTextXY(25,340,'<СТРЕЛКИ>'); SetColor(7);
OutTextXY(87,340,' . В самом начале вы можете нажать клавишу ENTER где угодно, и');
OutTextXY(25,355,'этот квадрат будет обязательно пустым.');
OutTextXY(25,370,' Если вы решили, что в квадрате есть мина, и поставили пометку, но');
OutTextXY(25,385,'передумали и хотите убрать пометку, нужно нажать клавишу ESC ещё раз на');
OutTextXY(25,400,'этои квадрате. На этот раз вы увидите знак вопроса, обозначающий, что вы');
OutTextXY(25,415,'отменяете пометку. Следующее нажатие ESC уберёт этот знак вопроса, и');
OutTextXY(25,430,'этот квадрат возвратится в изначальное нетронутое состояние.');
SetColor(13); OutTextXY(150,450,'Нажмите , чтобы остановить игру');
SetColor(14); OutTextXY(64,470,'НАЖМИТЕ ЛЮБУЮ КЛАВИШУ ДЛЯ ПРОДОЛЖЕНИЯ...');
SetColor(15); OutTextXY(390,470,'С наилучшими пожеланиями! Y.T.');
SetTextStyle(DefaultFont,HorizDir,2);
OutTextXY(215,447,'S');
Ch := Readkey;
end;
{****************************************************************************}
Procedure WriteHeading(Y:Integer);
begin
SetColor(13);
Rectangle(136,Y,496,Y+40);
SetColor(Green);
SetTextStyle(DefaultFont,HorizDir,3);
OutTextXY(254, Y+10,'САПЁР');
SetColor(13);
If (Y=40) then
begin
Rectangle(235,Y+40,385,Y+60);
SetColor(yellow);
SetTextStyle(DefaultFont,HorizDir,2);
OutTextXY(257,Y+45,'Уровень');
end
Else
begin
Rectangle(220,Y+40,400,Y+60);
SetColor(Yellow);
SetTextStyle(DefaultFont,HorizDir,1);
If (Level=1) then
OutTextXY(255,Y+50,'Новичок')
Else if (Level=2) then
OutTextXY(240,Y+50,'Любитель')
Else OutTextXY(265,Y+50,'Эксперт');
end;
end;
{****************************************************************************}
Procedure SetData(GL:Integer);
begin
If (GL=1) then
begin
Level:=1;
TotalMines:=Mb;
TotalRows:=Rb;
TotalColumns:=Cb;
FreeSpaces:=Rb*Cb-Mb;
InitialX:=Xb;
InitialY:=Yb;
end
Else if (GL=2) then
begin
Level:=2;
TotalMines:=Mi;
TotalRows:=Ri;
TotalColumns:=Ci;
FreeSpaces:=Ri*Ci-Mi;
InitialX:=Xi;
InitialY:=Yi;
end
Else
begin
Level:=3;
TotalMines:=Me;
TotalRows:=Re;
TotalColumns:=Ce;
FreeSpaces:=Re*Ce-Me;
InitialX:=Xe;
InitialY:=Ye;
end;
FinalX:=InitialX+TotalColumns*Dim;
FinalY:=InitialY+TotalRows*Dim;
end;
{****************************************************************************}
Procedure WelComing;
begin
Introduction;
HelpMenu;
ClearDevice;
WriteHeading(40);
SetColor(13);
Rectangle(40,120,600,270);
SetFillPattern(Board,1);
FloodFill(300,150,13);
SetColor(15);
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(170,150,'Выберите уровень игры:');
OutTextXY(230,170,'1. Новичок,');
OutTextXY(230,190,'2. Любитель или');
OutTextXY(230,210,'3. Эксперт.');
SetColor(Yellow);
OutTextXY(220,245,'Нажмите 1, 2 или 3.');
Repeat
Ch:=Readkey;
Until (Ch in ['1','2','3']);
SetData(Ord(Ch)-48);
end;
{****************************************************************************}
Procedure DrawNonOpened(X,Y:Integer);
begin
SetColor(DarkGray);
Rectangle(X,Y,X+Dim,Y+Dim);
SetFillPattern(Board,LightGray);
FloodFill(X+Dim div 2,Y+ Dim div 2,DarkGray);
Line(X+2,Y+Dim-2,X+Dim-2,Y+Dim-2);
Line(X+Dim-2,Y+2,X+Dim-2,Y+Dim-2);
SetColor(White);
Line(X+2,Y+2,X+Dim-2,Y+2);
Line(X+2,Y+2,X+2,Y+Dim-2);
end;
{****************************************************************************}
Procedure DrawField;
Var i:Integer;
begin
ClearDevice;
WriteHeading(5);
SetColor(darkGray);
Rectangle(InitialX-10,InitialY-10,FinalX+10,FinalY+10);
SetFillPattern(Board,LightGray);
FloodFill(InitialX,InitialY,DarkGray);
For i:=1 to 11 do
begin
If (i in [1,2,3,4]) then
begin
SetColor(DarkGray);
Line(initialX-i,InitialY-i,InitialX-i,Finaly+i);
Line(InitialX-i,InitialY-i,FinalX+i,InitialY-i);
SetColor(White);
Line(InitialX-i,FinalY+i,FinalX+i,FinalY+i);
Line(FinalX+i,InitialY-i,FinalX+i,FinalY+i);
end
Else if (i in [9,10,11]) then
begin
SetColor(DarkGray);
Line(InitialX-i,FinalY+i,FinalX+i,FinalY+i);
Line(FinalX+i,InitialY-i,FinalX+i,FinalY+i);
SetColor(White);
Line(InitialX-i,InitialY-i,FinalX+i,InitialY-i);
Line(InitialX-i,InitialY-i,InitialX-i,FinalY+i);
end;
end;
SetColor(darkGray);
Rectangle(InitialX-1,InitialY-1,FinalX+1,FinalY+1);
end;
{****************************************************************************}
Procedure DrawBoard;
Var X,Y,i,j:Integer;
begin
DrawField;
For i:=0 to (TotalRows-1) do
begin
Y:=InitialY+Dim*i;
For j:=0 to (TotalColumns-1) do
begin
X:=InitialX+Dim*j;
DrawNonOpened(X,Y);
end;
end;
end;
{****************************************************************************}
Procedure DrawNewIndicator(X,Y:Integer);
begin
SetColor(13);
Rectangle(X+3,Y+3,X+Dim-3,Y+Dim-3);
Rectangle(X+4,Y+4,X+Dim-4,Y+Dim-4);
end;
{****************************************************************************}
Procedure RemoveOldIndicator(X,Y:Integer);
begin
SetColor(7);
Rectangle(X+3,Y+3,X+Dim-3,Y+Dim-3);
Rectangle(X+4,Y+4,X+Dim-4,Y+Dim-4);
end;
{****************************************************************************}
Procedure MoveIndicator(Var X,Y,Row,Col:Integer; Ch:Char);
Var OldX,OldY:Integer;
begin
OldX:=X;
OldY:=Y;
Case Ch of
#72: If (Y>InitialY) then
begin
Y:=Y-Dim;
Dec(Row);
end;
#75: If (X>InitialX) then
begin
X:=X-Dim;
Dec(Col);
end;
#77: If ((X+Dim)<FinalX) then
begin
X:=X+Dim;
Inc(Col);
end;
#80: If ((Y+Dim)<FinalY) then
begin
Y:=Y+Dim;
Inc(Row);
end;
end;
If ((OldX<>X) or (OldY<>Y)) then
begin
RemoveOldIndicator(OldX,OldY);
DrawNewIndicator(X,Y);
end;
end;
{****************************************************************************}
Procedure WriteNumber(X,Y,Row,Col:Integer);
Var Color:Integer;
begin
Case A[Row,Col].Num of
1: Color:=9; 4: Color:=1; 7: Color:=12;
2: Color:=2; 5: Color:=5; 8: Color:=13;
3: Color:=4; 6: Color:=3; 9: Color:=0;
end;
SetColor(Color);
SetTextStyle(DefaultFont,HorizDir,1);
If (A[Row,Col].Num=9) then
OutTextXY(X+7,Y+7,Chr(15))
Else OutTextXY(X+7,Y+7,Chr(A[Row,Col].Num+48));
end;
{****************************************************************************}
Procedure DrawOpened(X,Y,Row,Col:Integer);
var Color:Integer;
begin
If (A[Row,Col].Suspended2) then
DrawNonOpened(X,Y);
color:=1;
SetColor(Color);
Rectangle(X+1,Y+1,X+Dim-1,Y+Dim-1);
SetFillPattern(Board,LightGray);
FloodFill(X+Dim div 2,Y+Dim div 2,Color);
If (A[Row,Col].num<>0) then
WriteNumber(X,Y,Row,Col);
end;
{****************************************************************************}
Procedure DrawSuspended1(X,Y:Integer);
Var Color:Integer;
begin
DrawNonOpened(X,Y);
Color:=Red;
SetColor(Color);
setTextStyle(defaultFont,HorizDir,1);
OutTextXY(X+7,Y+7,Chr(6));
end;
{****************************************************************************}
Procedure DrawSuspended2(X,Y:Integer);
Var Color:Integer;
begin
DrawNonOpened(X,Y);
Color:=1;
SetColor(Color);
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(X+7,Y+7,Chr(63));
end;
{****************************************************************************}
Procedure OpenSurrounding(X,Y,Row,Col:Integer);
Var XX,YY,RR,CC,i,j:Integer;
begin
For i:=-1 to 1 do
begin
RR:=Row+i;
If (RR in [1..TotalRows]) then
begin
For j:=-1 to 1 do
begin
CC:=Col+j;
If (CC in [1..TotalColumns]) then
begin
If (Not((A[RR,CC].Opened) or (A[RR,CC].Suspended1) or
(A[RR,CC].Suspended2))) then
begin
A[RR,CC].Opened:=True;
XX:=X+Dim*j;
YY:=Y+Dim*i;
DrawOpened(XX,YY,RR,CC);
Inc(FreeCounter);
If (A[RR,CC].Num=0) then
OpenSurrounding(XX,YY,RR,CC);
end;
end;
end;
end;
end;
end;
{****************************************************************************}
Procedure Allocate(Row,Col:Integer);
Var R,C,RR,CC,Sum,i,j:Integer;
begin
For i:=1 to TotalMines do
begin
Randomize;
Repeat
R:=Random(TotalRows)+1;
C:=Random(TotalColumns)+1;
Until (((R<>Row) or (C<>Col)) and (A[R,C].Num<>9));
A[R,C].Num:=9;
end;
For R:=1 to TotalRows do
begin
For C:=1 to totalColumns do
begin
If (A[R,C].Num<>9) then
begin
Sum:=0;
For i:=-1 to 1 do
begin
RR:=R+i;
If (RR in [1..TotalRows]) then
begin
For j:=-1 to 1 do
begin
CC:=C+j;
If (CC in [1..TotalColumns]) then
begin
If (A[RR,CC].Num=9) then
Inc(Sum);
end;
end;
end;
end;
A[R,C].Num:=Sum;
end;
end;
end;
end;
{****************************************************************************}
Procedure DrawCross(X,Y,Row,Col:Integer);
Var Color:Integer;
begin
SetColor(Red);
Line(X+4,Y+4,X+Dim-4,Y+Dim-4);
Line(X+5,Y+4,X+Dim-3,Y+Dim-4);
Line(X+4,Y+Dim-4,X+Dim-4,Y+4);
Line(X+5,Y+Dim-4,X+Dim-3,Y+4);
end;
{****************************************************************************}
Procedure Success;
begin
Timer(2);
SetColor(13);
SetTextStyle(DefaultFont,HorizDir,2);
OutTextXY(180,FinalY+25,'ПОЗДРАВЛЕНИЯ!');
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(220,FinalY+45,'Вы выиграли игру.');
end;
{****************************************************************************}
Procedure GameOver(X,Y:Integer);
Var XX,YY,Row,Col:Integer;
begin
Timer(2);
For Row:=1 to TotalRows do
begin
YY:=InitialY+(Row-1)*Dim;
For Col:=1 to TotalColumns do
begin
If (Not(A[Row,Col].Opened)) then
begin
XX:=InitialX+(Col-1)*Dim;
If (A[Row,Col].Mistaken) then
DrawCross(XX,YY,Row,Col)
Else if ((A[Row,Col].Num=9) and
(Not(A[Row,Col].Suspended1))) then
DrawOpened(XX,YY,Row,Col);
end;
end;
end;
SetColor(1);{Now show where the MISTAKE occured.}
Rectangle(X+1,Y+1,X+Dim-1,Y+Dim-1);
SetFillPattern(Board,Red);
FloodFill(X+Dim div 2,Y+Dim div 2,1);
OutTextXY(X+7,Y+7,Chr(47));
OutTextXY(X+7,Y+7,Chr(92));
SetColor(13);
SetTextStyle(DefaultFont,HorizDir,2);
OutTextXY(130,FinalY+30,' Вы проиграли!');
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(350,FinalY+35,' Игра окончена.');
end;
{****************************************************************************}
Procedure Warning;
begin
SetColor(15);
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(142,FinalY+25,'Вы действительно хотите прервать игру? (Y/N)');
Repeat
Ch:=Readkey;
Until (Ch in ['n','N','y','Y']);
If (Ch in ['y','Y']) then
Interupted:=True;
SetColor(0);
OutTextXY(142,FinalY+25,'Вы действительно хотите прервать игру? (Y/N)');
end;
{****************************************************************************}
Procedure Play(Var X,Y,Row,Col:Integer);
begin
Repeat
Ch:=Readkey;
Until ((Ord(Ch) in [13,27,83,115]) or (Ch in [#72,#75,#77,#80]));
If (Ch in [#72,#75,#77,#80]) then
MoveIndicator(X,Y,Row,Col,Ch)
Else if (Ord(Ch)=13) then
begin
If (Not((A[Row,Col].Opened) or (A[Row,Col].Suspended1))) then
begin
A[Row,Col].Opened:=True;
DrawOpened(X,Y,Row,Col);
DrawNewIndicator(X,Y);
If (A[Row,Col].Num=9) then
begin
Over:=True;
GameOver(X,Y);
end
Else
begin
Inc(FreeCounter);
If (A[Row,Col].Num=0) then
OpenSurrounding(X,Y,Row,Col);
If (FreeCounter=FreeSpaces) then
begin
Over:=True;
Success;
end;
end;
end;
end
Else if (Ord(Ch)=27) then
begin
If (Not(A[Row,Col].Opened)) then
begin
If (A[Row,Col].suspended1) then
begin
A[Row,Col].Suspended1:=False;
A[Row,Col].Suspended2:=True;
A[Row,Col].Mistaken:=False;
DrawSuspended2(X,Y);
end
Else if (A[Row,Col].Suspended2) then
begin
A[Row,Col].Suspended2:=False;
DrawNonOpened(X,Y);
end
Else
begin
A[Row,Col].Suspended1:=True;
DrawSuspended1(X,Y);
If (A[Row,Col].Num<>9) then
A[Row,Col].Mistaken:=True
end;
DrawNewindicator(X,Y);
end;
end
Else Warning;
end;
{****************************************************************************}
Procedure StartGame;
Var X,Y,Row,Col:Integer;
begin
Repeat
Over:=False;
Interupted:=False;
DrawBoard;
For Row:=1 to TotalRows do
begin
For Col:=1 to TotalColumns do
begin
A[Row,Col].Num:=0;
A[Row,Col].Opened:=False;
A[Row,Col].Mistaken:=False;
A[Row,Col].Suspended1:=False;
A[Row,Col].Suspended2:=False;
end;
end;
Randomize;
Row:=Random(TotalRows)+1;
Col:=Random(TotalColumns)+1;
X:=InitialX+(Col-1)*Dim;
Y:=InitialY+(Row-1)*Dim;
DrawNewIndicator(X,Y);
Repeat
Repeat
Ch:=Readkey;
Until ((Ch in [#72,#75,#77,#80]) or (Ord(Ch) in [13,83,115]));
If (Ch in [#72,#75,#77,#80]) then
MoveIndicator(X,Y,Row,Col,Ch)
Else if (Ord(Ch)=13) then
begin
Allocate(Row,Col);
A[Row,Col].Opened:=True;
DrawOpened(X,Y,Row,Col);
FreeCounter:=1;
DrawNewIndicator(X,Y);
If (A[Row,Col].Num=0) then
OpenSurrounding(X,Y,Row,Col);
If (FreeCounter=FreeSpaces) then
begin
Over:=True;
Success;
end;
end
Else Warning;
Until ((Ord(Ch)=13) or (Interupted));
If (Ord(Ch)=13) then
begin
Timer(1);
Repeat
Play(X,Y,Row,Col);
Until ((Over) or (Interupted));
end;
SetColor(15);
SetTextStyle(DefaultFont,HorizDir,1);
If Interupted then
begin
OutTextXY(210,FinalY+25,'Вы покинули игру!');
OutTextXY(190,FinalY+45,'Хотите сыграть ещё раз? (Y/N)');
end
Else
OutTextXY(190,FinalY+60,'Хотите сыграть ещё раз? (Y/N)');
Repeat
Ch:=Readkey;
Until (Ord(Ch) in [78,89,110,121]);
If (Ord(Ch) in [89,121]) then
begin
If Interupted then OutTextXY(450,FinalY+45,'y');
SetColor(0); OutTextXY(190,FinalY+60,'Хотите сыграть ещё раз? (Y/N)');
SetColor(15); OutTextXY(220,FinalY+60,'Какой уровень? (1,2 or 3)');
Repeat
Ch:=Readkey;
Until (Ord(Ch) in [49,50,51]);
SetData(Ord(Ch)-48);
end;
Until (Ord(Ch) in [78,110]);
ClearDevice;
CloseGraph;
end;
{****************************************************************************}
BEGIN{Main Program}
OpenGraphics;
WelComing;
StartGame;
END.{Main Program}