| | | |
1 | | - | Program MineSweeper; |
| 1 | + | jh344 |
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} |