Пример текста программы на языке Pascal
В этом приложении приведён пример программы на языке Pascal, охватывающий основные возможности языка, описанные в настоящих методических указаниях. Программой реализуется игра «сапёр». В тексте программы размещены поясняющие комментарии.
Program Mines;
Uses CRT; {подключение библиотеки расширенного ввода-вывода}
Const
NR=10; NC=20; {размер поля NR строк и NC столбцов}
NM=10; {количество мин}
Type
TMineMark=(mmClosed, mmOpened, mmMarked, mmSuspicious);
TMineNumber=0..8; {количество мин}
TFieldCell = Record
Mine : Boolean; {наличие мины}
Mark : TMineMark; {отметка}
Around : TMineNumber; {количество мин вокруг ячейки}
End;
TMineField=Array[1..NR,1..NC] of TFieldCell;
Var
Field:TMineField;
X,Y,R:Integer;
pc,sc:Char;
Procedure InitField(var F:TMineField); {очистка игрового поля}
Var i,j:Integer;
Begin
For i:=1 to NR Do For j:=1 to NC Do Begin
F[i,j].Mine:=False; F[i,j].Mark:=mmClosed;
F[i,j].Around:=0;
End;
End;
Procedure FillMines(var F:TMineField); {расстановка мин}
Var i,j,k,m:Integer;
Begin
For k:=1 to NM do Begin
m:=Random(NR*NC-k+1)+1; {оставшееся количество ячеек}
For i:=1 to NR Do For j:=1 to NC Do
If Not F[i,j].Mine Then Begin
m:=m-1;
If m=0 Then F[i,j].Mine:=True;
End;
End;
End;
Procedure CountAround(var F:TMineField);
{считать количество мин вокруг ячеек}
Var i,j,ii,jj:Integer;
Begin
For i:=1 to NR Do For j:=1 to NC Do
If not F[i,j].Mine Then
For ii:=-1 to 1 Do For jj:=-1 to 1 Do
{обойти соседние ячейки}
If (i+ii>=1) And (i+ii<=NR) And
(j+jj>=1) And (j+jj<=NC) Then
{если ячейка пределах поля}
If F[i+ii,j+jj].Mine Then
F[i,j].Around:=F[i,j].Around+1;
End;
Procedure OpenField(var F:TMineField; R,C:Integer); {открыть}
Var i,j,ii,jj:Integer; Comp:Boolean;
Begin
If F[R,C].Mark=mmClosed Then F[R,C].Mark:=mmOpened;
а Repeat
ааа Comp:=True;
ааа For i:= 1 to NR Do For j:=1 to NC Do
ааааа If not F[i,j].Mine And (F[i,j].Mark=mmOpened)
аааааааа And (F[i,j].Around=0) Then
ааааааа For ii:=-1 to 1 Do For jj:=-1 to 1 Do
ааааааааа If (i+ii>=1) And (i+ii<=NR) And
аааааааааааа (j+jj>=1) And (j+jj<=NC) Then
ааааааааааа If F[i+ii,j+jj].Mark<>mmOpened Then Begin
ааааааааааааа F[i+ii,j+jj].Mark:=mmOpened; Comp:=False;
ааааааааааа End;
а Until Comp;
End;
Function GameResult(var F:TMineField):Integer;
Var i,j,R:Integer; {эрфю ыш чрърэўштрЄ№ шуЁє}
Begin
а R:=1;
а For i:=1 to NR Do For j:=1 to NC Do
ааа If R>=0 Then Begin
ааааа If (F[i,j].Mark=mmClosed) And Not F[i,j].Mine Then
ааааааа R:=0; {LуЁє ёыхфєхЄ яЁюфюыцшЄ№}
ааааа If (F[i,j].Mark=mmOpened) And F[i,j].Mine Then
ааааааа R:=-1; {LуЁр яЁюшуЁрэр}
ааа End;
а GameResult:=R;
End;
Procedure ShowGameField(var F:TMineField; ShowMines:Boolean);
Var i,j:Integer;
Begin
а Writeln;
а For i:=1 to NR Do Begin
ааа Writeln;
ааа For j:=1 to NC Do Begin
ааааа Case F[i,j].Mark Of
ааа ааааmmClosed: If Not ShowMines Or Not F[i,j].Mine Then
ааааааааааааааааааа Write('#') Else Write('*');
ааааааа mmOpened: If F[i,j].Mine Then Write('*')
ааааааааааааааааа Else Begin
ааааааааааааааааааа If F[i,j].Around=0 Then Write(#32)
ааааааааааааааааааа Else Write(F[i,j].Around);
ааааааааааааааааа End;
ааааааа mmMarked: Write('P');
ааааааа mmSuspicious: Write('?');
ааааа End;
ааа End;
а End;
а Writeln;
End;
Begin
а Randomize;
а InitField(Field); FillMines(Field); CountAround(Field);
а ClrScr; ShowGameField(Field,False); X:=1; Y:=1;
а Repeat
ааа GotoXY(X,Y+2);
ааа pc:=ReadKey; sc:=#0; If pc=#0 Then sc:=ReadKey;
ааа If pc<>#0 Then Begin
ааааа case pc of
ааааааа #13: OpenField(Field,Y,X);
ааааааа #32: Case Field[Y,X].Mark of
аааааааааааааа mmClosed:аааа Field[Y,X].Mark:=mmMarked;
аааааааааааааа mmMarked:аааа Field[Y,X].Mark:=mmSuspicious;
аааааааааааааа mmSuspicious: Field[Y,X].Mark:=mmClosed;
ааааа End;аа End;
ааааа ClrScr; ShowGameField(Field,false);
ааа End;
ааа Case sc Of
ааааа #75: If X>1 Then X:=X-1;аа #77: If X<NC Then X:=X+1;
ааааа #72: If Y>1 Then Y:=Y-1;аа #80: If Y<NR Then Y:=Y+1;
ааа End;
ааа R:=GameResult(Field);
а Until (R<>0) Or (pc=#27);
а GotoXY(1,20);
а If R=1 Then Writeln('You have won');
а If R=-1 Then Beginа
ааа ClrScr; ShowGameField(Field,True);
ааа Writeln ('You have lost');
а End;
End.
