Изучение принципов алгоритмического программирования на языке Pascal

       

Пример текста программы на языке 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.






Содержание раздела