| | | |
| 1 | | - | Program MineSweeper; |
| 1 | + | 5x74z |
| 2 | | - | {****************************************************************************} |
| 3 | | - | Uses Crt,Graph,Dos; |
| 4 | | - | {****************************************************************************} |
| 5 | | - | Const Board : FillPatternType=($FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF); |
| 6 | | - | Xb=225; Yb=150; Rb=8; Cb=8; Mb=10; |
| 7 | | - | Xi=158; Yi=90; Ri=16; Ci=16; Mi=40; |
| 8 | | - | Xe=15; Ye=90; Re=16; Ce=30; Me=100; |
| 9 | | - | Dim=20; |
| 10 | | - | {****************************************************************************} |
| 11 | | - | Type Mine= record |
| 12 | | - | Num:Integer; |
| 13 | | - | Opened:Boolean; |
| 14 | | - | Mistaken:Boolean; |
| 15 | | - | Suspended1:Boolean; |
| 16 | | - | Suspended2:Boolean; |
| 17 | | - | end; |
| 18 | | - | {****************************************************************************} |
| 19 | | - | Var InitialX,InitialY,FinalX,FinalY,FreeSpaces,TotalMines,FreeCounter, |
| 20 | | - | Level,TotalRows,TotalColumns : Integer; |
| 21 | | - | Over,Interupted:Boolean; |
| 22 | | - | A:Array[1..Re,1..Ce] of Mine; |
| 23 | | - | Ch:Char; |
| 24 | | - | {****************************************************************************} |
| 25 | | - | Procedure OpenGraphics; |
| 26 | | - | Var GraphDriver,GraphMode,ErrorCode:Integer; |
| 27 | | - | begin |
| 28 | | - | GraphDriver:=Detect; |
| 29 | | - | InitGraph(GraphDriver,GraphMode,'X:\BP'); |
| 30 | | - | ErrorCode := GraphResult; |
| 31 | | - | If (ErrorCode<>GrOk) then |
| 32 | | - | begin |
| 33 | | - | ClrScr; |
| 34 | | - | Writeln('Graphics Error! ',GraphErrorMsg(ErrorCode)); |
| 35 | | - | Writeln('Please use School Pak to run this game...'); |
| 36 | | - | Writeln('Download it here: http://pascal.net.ru/SchoolPak '); |
| 37 | | - | Write('Press any key...'); |
| 38 | | - | Ch:=Readkey; |
| 39 | | - | Halt(1); |
| 40 | | - | end; |
| 41 | | - | end; |
| 42 | | - | {****************************************************************************} |
| 43 | | - | Procedure Introduction; |
| 44 | | - | Var i:Integer; |
| 45 | | - | begin |
| 46 | | - | ClearDevice; |
| 47 | | - | SetColor(13); |
| 48 | | - | Rectangle(40,120,600,310); |
| 49 | | - | SetFillPattern(Board,1); |
| 50 | | - | FloodFill(300,150,13); |
| 51 | | - | SetTextStyle(DefaultFont,HorizDir,3); |
| 52 | | - | OutTextXY(85,130,'Д'); |
| 53 | | - | SetTextStyle(DefaultFont,HorizDir,2); |
| 54 | | - | OutTextXY(110,133,'обро пожаловать в игру Сапёр!'); |
| 55 | | - | SetColor(15); |
| 56 | | - | For i:=0 to 24 do |
| 57 | | - | begin |
| 58 | | - | Line(325,154,325+10*i,154); |
| 59 | | - | Line(325,155,325+10*i,155); |
| 60 | | - | Line(325,154,325-10*i,154); |
| 61 | | - | Line(325,155,325-10*i,155); |
| 62 | | - | delay(50); |
| 63 | | - | end; |
| 64 | | - | SetTextStyle(DefaultFont,HorizDir,1); |
| 65 | | - | OutTextXY(200,165,'*** Игра разработана ***'); |
| 66 | | - | OutTextXY(170,185,'- На языке программирования Pascal,'); |
| 67 | | - | OutTextXY(170,205,'- В университете Zimbabwe,'); |
| 68 | | - | OutTextXY(170,225,'- Yonas Tesfazghi weldeselassie,'); |
| 69 | | - | OutTextXY(170,245,'- В среду 23-го февраля 2000.'); |
| 70 | | - | SetColor(Yellow); |
| 71 | | - | OutTextXY(200,280,'Нажмите любую клавишу для продолжения...'); |
| 72 | | - | Ch := ReadKey; |
| 73 | | - | end; |
| 74 | | - | {****************************************************************************} |
| 75 | | - | Procedure Timer(n:Integer); |
| 76 | | - | Var h,m,s,hund:word; |
| 77 | | - | begin |
| 78 | | - | GetTime(h,m,s,hund); |
| 79 | | - | If (n=1) then {The game is being started.} |
| 80 | | - | begin |
| 81 | | - | SetColor(2); |
| 82 | | - | Rectangle(20,450,130,470); |
| 83 | | - | Rectangle(510,450,610,470); |
| 84 | | - | SetTextstyle(DefaultFont,HorizDir,1); |
| 85 | | - | SetColor(12); |
| 86 | | - | OutTextXY(25,440,'Время начала'); |
| 87 | | - | OutTextXY(517,440,'Время конца'); |
| 88 | | - | OutTextXY(35,457,Chr(h div 10+48)); |
| 89 | | - | OutTextXY(45,457,Chr(h mod 10+48)); |
| 90 | | - | OutTextXY(55,457,':'); |
| 91 | | - | OutTextXY(65,457,Chr(m div 10+48)); |
| 92 | | - | OutTextXY(75,457,Chr(m mod 10+48)); |
| 93 | | - | OutTextXY(85,457,':'); |
| 94 | | - | OutTextXY(95,457,Chr(s div 10+48)); |
| 95 | | - | OutTextXY(105,457,Chr(s mod 10+48)); |
| 96 | | - | SetTextstyle(DefaultFont,HorizDir,2); |
| 97 | | - | OutTextXY(555,453,'?'); |
| 98 | | - | end |
| 99 | | - | Else {The player has won the game or the game is over.} |
| 100 | | - | begin |
| 101 | | - | SetFillPattern(Board,0); |
| 102 | | - | FloodFill(550,460,2); |
| 103 | | - | SetColor(12); |
| 104 | | - | SetTextstyle(DefaultFont,HorizDir,1); |
| 105 | | - | OutTextXY(522,457,Chr(h div 10+48)); |
| 106 | | - | OutTextXY(532,457,Chr(h mod 10+48)); |
| 107 | | - | OutTextXY(542,457,':'); |
| 108 | | - | OutTextXY(552,457,Chr(m div 10+48)); |
| 109 | | - | OutTextXY(562,457,Chr(m mod 10+48)); |
| 110 | | - | OutTextXY(572,457,':'); |
| 111 | | - | OutTextXY(582,457,Chr(s div 10+48)); |
| 112 | | - | OutTextXY(592,457,Chr(s mod 10+48)); |
| 113 | | - | end; |
| 114 | | - | end; |
| 115 | | - | {*************************************************************** *************} |
| 116 | | - | Procedure HelpMenu; |
| 117 | | - | begin |
| 118 | | - | ClearDevice; |
| 119 | | - | SetTextStyle(DefaultFont,HorizDir,2); |
| 120 | | - | SetColor(13); |
| 121 | | - | Rectangle(259,0,379,20); |
| 122 | | - | SetColor(2); |
| 123 | | - | OutTextXY(280,3,'Сапёр'); |
| 124 | | - | SetColor(15); |
| 125 | | - | SetTextStyle(DefaultFont,HorizDir,1); |
| 126 | | - | Rectangle(10,20,630,479); |
| 127 | | - | SetFillPattern(Board,1); |
| 128 | | - | FloodFill(300,150,15); |
| 129 | | - | SetColor(10); |
| 130 | | - | OutTextXY(243,30,'Правила игры в Сапёр'); |
| 131 | | - | Line(237,40,408,40); |
| 132 | | - | SetColor(7); |
| 133 | | - | OutTextXY(25,50,' Сапёр -- это игра с игровым полем и несколькими минами на этом поле.'); |
| 134 | | - | OutTextXY(25,65,'Поле поделено на мелкие квадраты, и количество этих квадратов и мин зависит'); |
| 135 | | - | OutTextXY(25,80,'от желаемого УРОВНЯ игры. Размер поля и количество мин на каждый уровнь'); |
| 136 | | - | OutTextXY(25,95,'следующие:'); |
| 137 | | - | OutTextXY(25,110,''); |
| 138 | | - | SetColor(10); |
| 139 | | - | OutTextXY(30,125,' Уровень игры #Строк #Столбцов #Квадратов #Мин '); |
| 140 | | - | Line(53,135,150,135); Line(173,135,223,135); Line(255,135,325,135); |
| 141 | | - | Line(360,135,437,135); Line(462,135,495,135); |
| 142 | | - | SetColor(15); |
| 143 | | - | OutTextXY(55,140,'Новичок 8 8 8x8=64 10'); |
| 144 | | - | OutTextXY(55,155,'Любитель 16 16 16x16=256 40'); |
| 145 | | - | OutTextXY(55,170,'Эксперт 16 30 16x30=480 100'); |
| 146 | | - | SetColor(7); |
| 147 | | - | OutTextXY(25,190,' Мины ПРОИЗВОЛЬНО расставлены в квадратах, и ваша цель -- ТОЧНО определить'); |
| 148 | | - | OutTextXY(25,205,'месторасположение мин. Вы указываете их, нажимая клавишу на квадрате'); |
| 149 | | - | OutTextXY(25,220,'с миной внутри.'); |
| 150 | | - | SetColor(14); OutTextXY(483,205,'<ESC>'); |
| 151 | | - | SetColor(7); OutTextXY(170,220,''); |
| 152 | | - | OutTextXY(25,235,' Если в квадрате НЕТ мины, то на нём написано число, которое указывает'); |
| 153 | | - | OutTextXY(25,250,'количество соседних квадратов с минами. Чтобы узнать, ПУСТОЙ ли квадрат,'); |
| 154 | | - | OutTextXY(25,265,'нужно нажать клавишу на нём. Однако, нажатие клавиши ENTER в'); |
| 155 | | - | SetColor(14); OutTextXY(194,265,'<ENTER>'); |
| 156 | | - | SetColor(7); OutTextXY(485,265,''); |
| 157 | | - | OutTextXY(25,280,'квадрате с миной приведёт к фатальному исходу. Поэтому нужно стараться'); |
| 158 | | - | OutTextXY(25,295,'не нажимать клавишу ENTER на квадрате с миной.'); |
| 159 | | - | OutTextXY(25,310,' Когда вы начинаете игру, вы видите индикатор, квадрат, нарисованный'); |
| 160 | | - | OutTextXY(25,325,'особенным цветом. Вы можете передвигать индикатор в любую сторону клавишами'); |
| 161 | | - | SetColor(14); OutTextXY(25,340,'<СТРЕЛКИ>'); SetColor(7); |
| 162 | | - | OutTextXY(87,340,' . В самом начале вы можете нажать клавишу ENTER где угодно, и'); |
| 163 | | - | OutTextXY(25,355,'этот квадрат будет обязательно пустым.'); |
| 164 | | - | OutTextXY(25,370,' Если вы решили, что в квадрате есть мина, и поставили пометку, но'); |
| 165 | | - | OutTextXY(25,385,'передумали и хотите убрать пометку, нужно нажать клавишу ESC ещё раз на'); |
| 166 | | - | OutTextXY(25,400,'этои квадрате. На этот раз вы увидите знак вопроса, обозначающий, что вы'); |
| 167 | | - | OutTextXY(25,415,'отменяете пометку. Следующее нажатие ESC уберёт этот знак вопроса, и'); |
| 168 | | - | OutTextXY(25,430,'этот квадрат возвратится в изначальное нетронутое состояние.'); |
| 169 | | - | SetColor(13); OutTextXY(150,450,'Нажмите , чтобы остановить игру'); |
| 170 | | - | SetColor(14); OutTextXY(64,470,'НАЖМИТЕ ЛЮБУЮ КЛАВИШУ ДЛЯ ПРОДОЛЖЕНИЯ...'); |
| 171 | | - | SetColor(15); OutTextXY(390,470,'С наилучшими пожеланиями! Y.T.'); |
| 172 | | - | SetTextStyle(DefaultFont,HorizDir,2); |
| 173 | | - | OutTextXY(215,447,'S'); |
| 174 | | - | Ch := Readkey; |
| 175 | | - | end; |
| 176 | | - | {****************************************************************************} |
| 177 | | - | Procedure WriteHeading(Y:Integer); |
| 178 | | - | begin |
| 179 | | - | SetColor(13); |
| 180 | | - | Rectangle(136,Y,496,Y+40); |
| 181 | | - | SetColor(Green); |
| 182 | | - | SetTextStyle(DefaultFont,HorizDir,3); |
| 183 | | - | OutTextXY(254, Y+10,'САПЁР'); |
| 184 | | - | SetColor(13); |
| 185 | | - | If (Y=40) then |
| 186 | | - | begin |
| 187 | | - | Rectangle(235,Y+40,385,Y+60); |
| 188 | | - | SetColor(yellow); |
| 189 | | - | SetTextStyle(DefaultFont,HorizDir,2); |
| 190 | | - | OutTextXY(257,Y+45,'Уровень'); |
| 191 | | - | end |
| 192 | | - | Else |
| 193 | | - | begin |
| 194 | | - | Rectangle(220,Y+40,400,Y+60); |
| 195 | | - | SetColor(Yellow); |
| 196 | | - | SetTextStyle(DefaultFont,HorizDir,1); |
| 197 | | - | If (Level=1) then |
| 198 | | - | OutTextXY(255,Y+50,'Новичок') |
| 199 | | - | Else if (Level=2) then |
| 200 | | - | OutTextXY(240,Y+50,'Любитель') |
| 201 | | - | Else OutTextXY(265,Y+50,'Эксперт'); |
| 202 | | - | end; |
| 203 | | - | end; |
| 204 | | - | {****************************************************************************} |
| 205 | | - | Procedure SetData(GL:Integer); |
| 206 | | - | begin |
| 207 | | - | If (GL=1) then |
| 208 | | - | begin |
| 209 | | - | Level:=1; |
| 210 | | - | TotalMines:=Mb; |
| 211 | | - | TotalRows:=Rb; |
| 212 | | - | TotalColumns:=Cb; |
| 213 | | - | FreeSpaces:=Rb*Cb-Mb; |
| 214 | | - | InitialX:=Xb; |
| 215 | | - | InitialY:=Yb; |
| 216 | | - | end |
| 217 | | - | Else if (GL=2) then |
| 218 | | - | begin |
| 219 | | - | Level:=2; |
| 220 | | - | TotalMines:=Mi; |
| 221 | | - | TotalRows:=Ri; |
| 222 | | - | TotalColumns:=Ci; |
| 223 | | - | FreeSpaces:=Ri*Ci-Mi; |
| 224 | | - | InitialX:=Xi; |
| 225 | | - | InitialY:=Yi; |
| 226 | | - | end |
| 227 | | - | Else |
| 228 | | - | begin |
| 229 | | - | Level:=3; |
| 230 | | - | TotalMines:=Me; |
| 231 | | - | TotalRows:=Re; |
| 232 | | - | TotalColumns:=Ce; |
| 233 | | - | FreeSpaces:=Re*Ce-Me; |
| 234 | | - | InitialX:=Xe; |
| 235 | | - | InitialY:=Ye; |
| 236 | | - | end; |
| 237 | | - | FinalX:=InitialX+TotalColumns*Dim; |
| 238 | | - | FinalY:=InitialY+TotalRows*Dim; |
| 239 | | - | end; |
| 240 | | - | {****************************************************************************} |
| 241 | | - | Procedure WelComing; |
| 242 | | - | begin |
| 243 | | - | Introduction; |
| 244 | | - | HelpMenu; |
| 245 | | - | ClearDevice; |
| 246 | | - | WriteHeading(40); |
| 247 | | - | SetColor(13); |
| 248 | | - | Rectangle(40,120,600,270); |
| 249 | | - | SetFillPattern(Board,1); |
| 250 | | - | FloodFill(300,150,13); |
| 251 | | - | SetColor(15); |
| 252 | | - | SetTextStyle(DefaultFont,HorizDir,1); |
| 253 | | - | OutTextXY(170,150,'Выберите уровень игры:'); |
| 254 | | - | OutTextXY(230,170,'1. Новичок,'); |
| 255 | | - | OutTextXY(230,190,'2. Любитель или'); |
| 256 | | - | OutTextXY(230,210,'3. Эксперт.'); |
| 257 | | - | SetColor(Yellow); |
| 258 | | - | OutTextXY(220,245,'Нажмите 1, 2 или 3.'); |
| 259 | | - | Repeat |
| 260 | | - | Ch:=Readkey; |
| 261 | | - | Until (Ch in ['1','2','3']); |
| 262 | | - | SetData(Ord(Ch)-48); |
| 263 | | - | end; |
| 264 | | - | {****************************************************************************} |
| 265 | | - | Procedure DrawNonOpened(X,Y:Integer); |
| 266 | | - | begin |
| 267 | | - | SetColor(DarkGray); |
| 268 | | - | Rectangle(X,Y,X+Dim,Y+Dim); |
| 269 | | - | SetFillPattern(Board,LightGray); |
| 270 | | - | FloodFill(X+Dim div 2,Y+ Dim div 2,DarkGray); |
| 271 | | - | Line(X+2,Y+Dim-2,X+Dim-2,Y+Dim-2); |
| 272 | | - | Line(X+Dim-2,Y+2,X+Dim-2,Y+Dim-2); |
| 273 | | - | SetColor(White); |
| 274 | | - | Line(X+2,Y+2,X+Dim-2,Y+2); |
| 275 | | - | Line(X+2,Y+2,X+2,Y+Dim-2); |
| 276 | | - | end; |
| 277 | | - | {****************************************************************************} |
| 278 | | - | Procedure DrawField; |
| 279 | | - | Var i:Integer; |
| 280 | | - | begin |
| 281 | | - | ClearDevice; |
| 282 | | - | WriteHeading(5); |
| 283 | | - | SetColor(darkGray); |
| 284 | | - | Rectangle(InitialX-10,InitialY-10,FinalX+10,FinalY+10); |
| 285 | | - | SetFillPattern(Board,LightGray); |
| 286 | | - | FloodFill(InitialX,InitialY,DarkGray); |
| 287 | | - | For i:=1 to 11 do |
| 288 | | - | begin |
| 289 | | - | If (i in [1,2,3,4]) then |
| 290 | | - | begin |
| 291 | | - | SetColor(DarkGray); |
| 292 | | - | Line(initialX-i,InitialY-i,InitialX-i,Finaly+i); |
| 293 | | - | Line(InitialX-i,InitialY-i,FinalX+i,InitialY-i); |
| 294 | | - | SetColor(White); |
| 295 | | - | Line(InitialX-i,FinalY+i,FinalX+i,FinalY+i); |
| 296 | | - | Line(FinalX+i,InitialY-i,FinalX+i,FinalY+i); |
| 297 | | - | end |
| 298 | | - | Else if (i in [9,10,11]) then |
| 299 | | - | begin |
| 300 | | - | SetColor(DarkGray); |
| 301 | | - | Line(InitialX-i,FinalY+i,FinalX+i,FinalY+i); |
| 302 | | - | Line(FinalX+i,InitialY-i,FinalX+i,FinalY+i); |
| 303 | | - | SetColor(White); |
| 304 | | - | Line(InitialX-i,InitialY-i,FinalX+i,InitialY-i); |
| 305 | | - | Line(InitialX-i,InitialY-i,InitialX-i,FinalY+i); |
| 306 | | - | end; |
| 307 | | - | end; |
| 308 | | - | SetColor(darkGray); |
| 309 | | - | Rectangle(InitialX-1,InitialY-1,FinalX+1,FinalY+1); |
| 311 | | - | end; |
| 312 | | - | {****************************************************************************} |
| 313 | | - | Procedure DrawBoard; |
| 314 | | - | Var X,Y,i,j:Integer; |
| 315 | | - | begin |
| 316 | | - | DrawField; |
| 317 | | - | For i:=0 to (TotalRows-1) do |
| 318 | | - | begin |
| 319 | | - | Y:=InitialY+Dim*i; |
| 320 | | - | For j:=0 to (TotalColumns-1) do |
| 321 | | - | begin |
| 322 | | - | X:=InitialX+Dim*j; |
| 323 | | - | DrawNonOpened(X,Y); |
| 324 | | - | end; |
| 325 | | - | end; |
| 326 | | - | end; |
| 327 | | - | {****************************************************************************} |
| 328 | | - | Procedure DrawNewIndicator(X,Y:Integer); |
| 329 | | - | begin |
| 330 | | - | SetColor(13); |
| 331 | | - | Rectangle(X+3,Y+3,X+Dim-3,Y+Dim-3); |
| 332 | | - | Rectangle(X+4,Y+4,X+Dim-4,Y+Dim-4); |
| 333 | | - | end; |
| 334 | | - | {****************************************************************************} |
| 335 | | - | Procedure RemoveOldIndicator(X,Y:Integer); |
| 336 | | - | begin |
| 337 | | - | SetColor(7); |
| 338 | | - | Rectangle(X+3,Y+3,X+Dim-3,Y+Dim-3); |
| 339 | | - | Rectangle(X+4,Y+4,X+Dim-4,Y+Dim-4); |
| 340 | | - | end; |
| 341 | | - | {****************************************************************************} |
| 342 | | - | Procedure MoveIndicator(Var X,Y,Row,Col:Integer; Ch:Char); |
| 343 | | - | Var OldX,OldY:Integer; |
| 344 | | - | begin |
| 345 | | - | OldX:=X; |
| 346 | | - | OldY:=Y; |
| 347 | | - | Case Ch of |
| 348 | | - | #72: If (Y>InitialY) then |
| 349 | | - | begin |
| 350 | | - | Y:=Y-Dim; |
| 351 | | - | Dec(Row); |
| 352 | | - | end; |
| 353 | | - | #75: If (X>InitialX) then |
| 354 | | - | begin |
| 355 | | - | X:=X-Dim; |
| 356 | | - | Dec(Col); |
| 357 | | - | end; |
| 358 | | - | #77: If ((X+Dim)<FinalX) then |
| 359 | | - | begin |
| 360 | | - | X:=X+Dim; |
| 361 | | - | Inc(Col); |
| 362 | | - | end; |
| 363 | | - | #80: If ((Y+Dim)<FinalY) then |
| 364 | | - | begin |
| 365 | | - | Y:=Y+Dim; |
| 366 | | - | Inc(Row); |
| 367 | | - | end; |
| 368 | | - | end; |
| 369 | | - | If ((OldX<>X) or (OldY<>Y)) then |
| 370 | | - | begin |
| 371 | | - | RemoveOldIndicator(OldX,OldY); |
| 372 | | - | DrawNewIndicator(X,Y); |
| 373 | | - | end; |
| 374 | | - | end; |
| 375 | | - | {****************************************************************************} |
| 376 | | - | Procedure WriteNumber(X,Y,Row,Col:Integer); |
| 377 | | - | Var Color:Integer; |
| 378 | | - | begin |
| 379 | | - | Case A[Row,Col].Num of |
| 380 | | - | 1: Color:=9; 4: Color:=1; 7: Color:=12; |
| 381 | | - | 2: Color:=2; 5: Color:=5; 8: Color:=13; |
| 382 | | - | 3: Color:=4; 6: Color:=3; 9: Color:=0; |
| 383 | | - | end; |
| 384 | | - | SetColor(Color); |
| 385 | | - | SetTextStyle(DefaultFont,HorizDir,1); |
| 386 | | - | If (A[Row,Col].Num=9) then |
| 387 | | - | OutTextXY(X+7,Y+7,Chr(15)) |
| 388 | | - | Else OutTextXY(X+7,Y+7,Chr(A[Row,Col].Num+48)); |
| 389 | | - | end; |
| 390 | | - | {****************************************************************************} |
| 391 | | - | Procedure DrawOpened(X,Y,Row,Col:Integer); |
| 392 | | - | var Color:Integer; |
| 393 | | - | begin |
| 394 | | - | If (A[Row,Col].Suspended2) then |
| 395 | | - | DrawNonOpened(X,Y); |
| 396 | | - | color:=1; |
| 397 | | - | SetColor(Color); |
| 398 | | - | Rectangle(X+1,Y+1,X+Dim-1,Y+Dim-1); |
| 399 | | - | SetFillPattern(Board,LightGray); |
| 400 | | - | FloodFill(X+Dim div 2,Y+Dim div 2,Color); |
| 401 | | - | If (A[Row,Col].num<>0) then |
| 402 | | - | WriteNumber(X,Y,Row,Col); |
| 403 | | - | end; |
| 404 | | - | {****************************************************************************} |
| 405 | | - | Procedure DrawSuspended1(X,Y:Integer); |
| 406 | | - | Var Color:Integer; |
| 407 | | - | begin |
| 408 | | - | DrawNonOpened(X,Y); |
| 409 | | - | Color:=Red; |
| 410 | | - | SetColor(Color); |
| 411 | | - | setTextStyle(defaultFont,HorizDir,1); |
| 412 | | - | OutTextXY(X+7,Y+7,Chr(6)); |
| 413 | | - | end; |
| 414 | | - | {****************************************************************************} |
| 415 | | - | Procedure DrawSuspended2(X,Y:Integer); |
| 416 | | - | Var Color:Integer; |
| 417 | | - | begin |
| 418 | | - | DrawNonOpened(X,Y); |
| 419 | | - | Color:=1; |
| 420 | | - | SetColor(Color); |
| 421 | | - | SetTextStyle(DefaultFont,HorizDir,1); |
| 422 | | - | OutTextXY(X+7,Y+7,Chr(63)); |
| 423 | | - | end; |
| 424 | | - | {****************************************************************************} |
| 425 | | - | Procedure OpenSurrounding(X,Y,Row,Col:Integer); |
| 426 | | - | Var XX,YY,RR,CC,i,j:Integer; |
| 427 | | - | begin |
| 428 | | - | For i:=-1 to 1 do |
| 429 | | - | begin |
| 430 | | - | RR:=Row+i; |
| 431 | | - | If (RR in [1..TotalRows]) then |
| 432 | | - | begin |
| 433 | | - | For j:=-1 to 1 do |
| 434 | | - | begin |
| 435 | | - | CC:=Col+j; |
| 436 | | - | If (CC in [1..TotalColumns]) then |
| 437 | | - | begin |
| 438 | | - | If (Not((A[RR,CC].Opened) or (A[RR,CC].Suspended1) or |
| 439 | | - | (A[RR,CC].Suspended2))) then |
| 440 | | - | begin |
| 441 | | - | A[RR,CC].Opened:=True; |
| 442 | | - | XX:=X+Dim*j; |
| 443 | | - | YY:=Y+Dim*i; |
| 444 | | - | DrawOpened(XX,YY,RR,CC); |
| 445 | | - | Inc(FreeCounter); |
| 446 | | - | If (A[RR,CC].Num=0) then |
| 447 | | - | OpenSurrounding(XX,YY,RR,CC); |
| 448 | | - | end; |
| 449 | | - | end; |
| 450 | | - | end; |
| 451 | | - | end; |
| 452 | | - | end; |
| 453 | | - | end; |
| 454 | | - | {****************************************************************************} |
| 455 | | - | Procedure Allocate(Row,Col:Integer); |
| 456 | | - | Var R,C,RR,CC,Sum,i,j:Integer; |
| 457 | | - | begin |
| 458 | | - | For i:=1 to TotalMines do |
| 459 | | - | begin |
| 460 | | - | Randomize; |
| 461 | | - | Repeat |
| 462 | | - | R:=Random(TotalRows)+1; |
| 463 | | - | C:=Random(TotalColumns)+1; |
| 464 | | - | Until (((R<>Row) or (C<>Col)) and (A[R,C].Num<>9)); |
| 465 | | - | A[R,C].Num:=9; |
| 466 | | - | end; |
| 467 | | - | For R:=1 to TotalRows do |
| 468 | | - | begin |
| 469 | | - | For C:=1 to totalColumns do |
| 470 | | - | begin |
| 471 | | - | If (A[R,C].Num<>9) then |
| 472 | | - | begin |
| 473 | | - | Sum:=0; |
| 474 | | - | For i:=-1 to 1 do |
| 475 | | - | begin |
| 476 | | - | RR:=R+i; |
| 477 | | - | If (RR in [1..TotalRows]) then |
| 478 | | - | begin |
| 479 | | - | For j:=-1 to 1 do |
| 480 | | - | begin |
| 481 | | - | CC:=C+j; |
| 482 | | - | If (CC in [1..TotalColumns]) then |
| 483 | | - | begin |
| 484 | | - | If (A[RR,CC].Num=9) then |
| 485 | | - | Inc(Sum); |
| 486 | | - | end; |
| 487 | | - | end; |
| 488 | | - | end; |
| 489 | | - | end; |
| 490 | | - | A[R,C].Num:=Sum; |
| 491 | | - | end; |
| 492 | | - | end; |
| 493 | | - | end; |
| 494 | | - | end; |
| 495 | | - | {****************************************************************************} |
| 496 | | - | Procedure DrawCross(X,Y,Row,Col:Integer); |
| 497 | | - | Var Color:Integer; |
| 498 | | - | begin |
| 499 | | - | SetColor(Red); |
| 500 | | - | Line(X+4,Y+4,X+Dim-4,Y+Dim-4); |
| 501 | | - | Line(X+5,Y+4,X+Dim-3,Y+Dim-4); |
| 502 | | - | Line(X+4,Y+Dim-4,X+Dim-4,Y+4); |
| 503 | | - | Line(X+5,Y+Dim-4,X+Dim-3,Y+4); |
| 504 | | - | end; |
| 505 | | - | {****************************************************************************} |
| 506 | | - | Procedure Success; |
| 507 | | - | begin |
| 508 | | - | Timer(2); |
| 509 | | - | SetColor(13); |
| 510 | | - | SetTextStyle(DefaultFont,HorizDir,2); |
| 511 | | - | OutTextXY(180,FinalY+25,'ПОЗДРАВЛЕНИЯ!'); |
| 512 | | - | SetTextStyle(DefaultFont,HorizDir,1); |
| 513 | | - | OutTextXY(220,FinalY+45,'Вы выиграли игру.'); |
| 514 | | - | end; |
| 515 | | - | {****************************************************************************} |
| 516 | | - | Procedure GameOver(X,Y:Integer); |
| 517 | | - | Var XX,YY,Row,Col:Integer; |
| 518 | | - | begin |
| 519 | | - | Timer(2); |
| 520 | | - | For Row:=1 to TotalRows do |
| 521 | | - | begin |
| 522 | | - | YY:=InitialY+(Row-1)*Dim; |
| 523 | | - | For Col:=1 to TotalColumns do |
| 524 | | - | begin |
| 525 | | - | If (Not(A[Row,Col].Opened)) then |
| 526 | | - | begin |
| 527 | | - | XX:=InitialX+(Col-1)*Dim; |
| 528 | | - | If (A[Row,Col].Mistaken) then |
| 529 | | - | DrawCross(XX,YY,Row,Col) |
| 530 | | - | Else if ((A[Row,Col].Num=9) and |
| 531 | | - | (Not(A[Row,Col].Suspended1))) then |
| 532 | | - | DrawOpened(XX,YY,Row,Col); |
| 533 | | - | end; |
| 534 | | - | end; |
| 535 | | - | end; |
| 536 | | - | SetColor(1);{Now show where the MISTAKE occured.} |
| 537 | | - | Rectangle(X+1,Y+1,X+Dim-1,Y+Dim-1); |
| 538 | | - | SetFillPattern(Board,Red); |
| 539 | | - | FloodFill(X+Dim div 2,Y+Dim div 2,1); |
| 540 | | - | OutTextXY(X+7,Y+7,Chr(47)); |
| 541 | | - | OutTextXY(X+7,Y+7,Chr(92)); |
| 542 | | - | SetColor(13); |
| 543 | | - | SetTextStyle(DefaultFont,HorizDir,2); |
| 544 | | - | OutTextXY(130,FinalY+30,' Вы проиграли!'); |
| 545 | | - | SetTextStyle(DefaultFont,HorizDir,1); |
| 546 | | - | OutTextXY(350,FinalY+35,' Игра окончена.'); |
| 547 | | - | end; |
| 548 | | - | {****************************************************************************} |
| 549 | | - | Procedure Warning; |
| 550 | | - | begin |
| 551 | | - | SetColor(15); |
| 552 | | - | SetTextStyle(DefaultFont,HorizDir,1); |
| 553 | | - | OutTextXY(142,FinalY+25,'Вы действительно хотите прервать игру? (Y/N)'); |
| 554 | | - | Repeat |
| 555 | | - | Ch:=Readkey; |
| 556 | | - | Until (Ch in ['n','N','y','Y']); |
| 557 | | - | If (Ch in ['y','Y']) then |
| 558 | | - | Interupted:=True; |
| 559 | | - | SetColor(0); |
| 560 | | - | OutTextXY(142,FinalY+25,'Вы действительно хотите прервать игру? (Y/N)'); |
| 561 | | - | end; |
| 562 | | - | {****************************************************************************} |
| 563 | | - | Procedure Play(Var X,Y,Row,Col:Integer); |
| 564 | | - | begin |
| 565 | | - | Repeat |
| 566 | | - | Ch:=Readkey; |
| 567 | | - | Until ((Ord(Ch) in [13,27,83,115]) or (Ch in [#72,#75,#77,#80])); |
| 568 | | - | If (Ch in [#72,#75,#77,#80]) then |
| 569 | | - | MoveIndicator(X,Y,Row,Col,Ch) |
| 570 | | - | Else if (Ord(Ch)=13) then |
| 571 | | - | begin |
| 572 | | - | If (Not((A[Row,Col].Opened) or (A[Row,Col].Suspended1))) then |
| 573 | | - | begin |
| 574 | | - | A[Row,Col].Opened:=True; |
| 575 | | - | DrawOpened(X,Y,Row,Col); |
| 576 | | - | DrawNewIndicator(X,Y); |
| 577 | | - | If (A[Row,Col].Num=9) then |
| 578 | | - | begin |
| 579 | | - | Over:=True; |
| 580 | | - | GameOver(X,Y); |
| 581 | | - | end |
| 582 | | - | Else |
| 583 | | - | begin |
| 584 | | - | Inc(FreeCounter); |
| 585 | | - | If (A[Row,Col].Num=0) then |
| 586 | | - | OpenSurrounding(X,Y,Row,Col); |
| 587 | | - | If (FreeCounter=FreeSpaces) then |
| 588 | | - | begin |
| 589 | | - | Over:=True; |
| 590 | | - | Success; |
| 591 | | - | end; |
| 592 | | - | end; |
| 593 | | - | end; |
| 594 | | - | end |
| 595 | | - | Else if (Ord(Ch)=27) then |
| 596 | | - | begin |
| 597 | | - | If (Not(A[Row,Col].Opened)) then |
| 598 | | - | begin |
| 599 | | - | If (A[Row,Col].suspended1) then |
| 600 | | - | begin |
| 601 | | - | A[Row,Col].Suspended1:=False; |
| 602 | | - | A[Row,Col].Suspended2:=True; |
| 603 | | - | A[Row,Col].Mistaken:=False; |
| 604 | | - | DrawSuspended2(X,Y); |
| 605 | | - | end |
| 606 | | - | Else if (A[Row,Col].Suspended2) then |
| 607 | | - | begin |
| 608 | | - | A[Row,Col].Suspended2:=False; |
| 609 | | - | DrawNonOpened(X,Y); |
| 610 | | - | end |
| 611 | | - | Else |
| 612 | | - | begin |
| 613 | | - | A[Row,Col].Suspended1:=True; |
| 614 | | - | DrawSuspended1(X,Y); |
| 615 | | - | If (A[Row,Col].Num<>9) then |
| 616 | | - | A[Row,Col].Mistaken:=True |
| 617 | | - | end; |
| 618 | | - | DrawNewindicator(X,Y); |
| 619 | | - | end; |
| 620 | | - | end |
| 621 | | - | Else Warning; |
| 622 | | - | end; |
| 623 | | - | {****************************************************************************} |
| 624 | | - | Procedure StartGame; |
| 625 | | - | Var X,Y,Row,Col:Integer; |
| 626 | | - | begin |
| 627 | | - | Repeat |
| 628 | | - | Over:=False; |
| 629 | | - | Interupted:=False; |
| 630 | | - | DrawBoard; |
| 631 | | - | For Row:=1 to TotalRows do |
| 632 | | - | begin |
| 633 | | - | For Col:=1 to TotalColumns do |
| 634 | | - | begin |
| 635 | | - | A[Row,Col].Num:=0; |
| 636 | | - | A[Row,Col].Opened:=False; |
| 637 | | - | A[Row,Col].Mistaken:=False; |
| 638 | | - | A[Row,Col].Suspended1:=False; |
| 639 | | - | A[Row,Col].Suspended2:=False; |
| 640 | | - | end; |
| 641 | | - | end; |
| 642 | | - | Randomize; |
| 643 | | - | Row:=Random(TotalRows)+1; |
| 644 | | - | Col:=Random(TotalColumns)+1; |
| 645 | | - | X:=InitialX+(Col-1)*Dim; |
| 646 | | - | Y:=InitialY+(Row-1)*Dim; |
| 647 | | - | DrawNewIndicator(X,Y); |
| 648 | | - | Repeat |
| 649 | | - | Repeat |
| 650 | | - | Ch:=Readkey; |
| 651 | | - | Until ((Ch in [#72,#75,#77,#80]) or (Ord(Ch) in [13,83,115])); |
| 652 | | - | If (Ch in [#72,#75,#77,#80]) then |
| 653 | | - | MoveIndicator(X,Y,Row,Col,Ch) |
| 654 | | - | Else if (Ord(Ch)=13) then |
| 655 | | - | begin |
| 656 | | - | Allocate(Row,Col); |
| 657 | | - | A[Row,Col].Opened:=True; |
| 658 | | - | DrawOpened(X,Y,Row,Col); |
| 659 | | - | FreeCounter:=1; |
| 660 | | - | DrawNewIndicator(X,Y); |
| 661 | | - | If (A[Row,Col].Num=0) then |
| 662 | | - | OpenSurrounding(X,Y,Row,Col); |
| 663 | | - | If (FreeCounter=FreeSpaces) then |
| 664 | | - | begin |
| 665 | | - | Over:=True; |
| 666 | | - | Success; |
| 667 | | - | end; |
| 668 | | - | end |
| 669 | | - | Else Warning; |
| 670 | | - | Until ((Ord(Ch)=13) or (Interupted)); |
| 671 | | - | If (Ord(Ch)=13) then |
| 672 | | - | begin |
| 673 | | - | Timer(1); |
| 674 | | - | Repeat |
| 675 | | - | Play(X,Y,Row,Col); |
| 676 | | - | Until ((Over) or (Interupted)); |
| 677 | | - | end; |
| 678 | | - | SetColor(15); |
| 679 | | - | SetTextStyle(DefaultFont,HorizDir,1); |
| 680 | | - | If Interupted then |
| 681 | | - | begin |
| 682 | | - | OutTextXY(210,FinalY+25,'Вы покинули игру!'); |
| 683 | | - | OutTextXY(190,FinalY+45,'Хотите сыграть ещё раз? (Y/N)'); |
| 684 | | - | end |
| 685 | | - | Else |
| 686 | | - | OutTextXY(190,FinalY+60,'Хотите сыграть ещё раз? (Y/N)'); |
| 687 | | - | Repeat |
| 688 | | - | Ch:=Readkey; |
| 689 | | - | Until (Ord(Ch) in [78,89,110,121]); |
| 690 | | - | If (Ord(Ch) in [89,121]) then |
| 691 | | - | begin |
| 692 | | - | If Interupted then OutTextXY(450,FinalY+45,'y'); |
| 693 | | - | SetColor(0); OutTextXY(190,FinalY+60,'Хотите сыграть ещё раз? (Y/N)'); |
| 694 | | - | SetColor(15); OutTextXY(220,FinalY+60,'Какой уровень? (1,2 or 3)'); |
| 695 | | - | Repeat |
| 696 | | - | Ch:=Readkey; |
| 697 | | - | Until (Ord(Ch) in [49,50,51]); |
| 698 | | - | SetData(Ord(Ch)-48); |
| 699 | | - | end; |
| 700 | | - | Until (Ord(Ch) in [78,110]); |
| 701 | | - | ClearDevice; |
| 702 | | - | CloseGraph; |
| 703 | | - | end; |
| 704 | | - | {****************************************************************************} |
| 705 | | - | BEGIN{Main Program} |
| 706 | | - | OpenGraphics; |
| 707 | | - | WelComing; |
| 708 | | - | StartGame; |
| 709 | | - | END.{Main Program} |