…Show last 471 lines
61 FindMoves HumanColor, WinningLength, FALSE
62 IF NOT FoundMoves THEN
63 FOR TriggerLength = WinningLength TO 0 STEP -1
64 FindMoves ComputerColor, TriggerLength, FALSE
65 IF FoundMoves THEN EXIT FOR
66 NEXT TriggerLength
67
68 IF NOT FoundMoves THEN
69 FOR TriggerLength = WinningLength TO 0 STEP -1
70 FindMoves HumanColor, TriggerLength, TRUE
71 IF FoundMoves THEN EXIT FOR
72 NEXT TriggerLength
73 END IF
74 END IF
75 END IF
76
77 IF FoundMoves THEN
78 DO
79 Column = INT(RND * (LastColumn + 1)) + FirstColumn
80 IF MovesFound(Column) THEN
81 DropDisk Column, CurrentPlayer
82 EXIT DO
83 END IF
84 LOOP
85 END IF
86END SUB
87
88FUNCTION CountDisks (StartColumn, StartRow, ColorO, XDirection, YDirection)
89DIM CheckCount
90DIM Column
91DIM DiskCount
92DIM Row
93
94 Column = StartColumn
95 CheckCount = 0
96 DiskCount = 0
97 Row = StartRow
98 DO WHILE CheckCount < WinningLength
99 SELECT CASE Disks(Column, Row, DCNone, FALSE)
100 CASE ColorO
101 DiskCount = DiskCount + 1
102 CASE NOT DCNone
103 EXIT DO
104 END SELECT
105
106 Column = Column + XDirection
107 Row = Row + YDirection
108 CheckCount = CheckCount + 1
109 LOOP
110
111 CountDisks = DiskCount
112END FUNCTION
113
114FUNCTION Disks (Column, Row, NewDisk, ResetDisks)
115DIM Disk
116
117 Disk = DCOutsideField
118
119 IF ResetDisks THEN
120 ERASE CurrentDisks
121 Disk = DCNone
122
123 FOR Column = FirstColumn TO LastColumn
124 FOR Row = FirstRow TO LastRow
125 CurrentDisks(Column, Row) = DCNone
126 NEXT Row
127 NEXT Column
128 ELSE
129 IF Column >= FirstColumn AND Column <= LastColumn THEN
130 IF Row >= FirstRow AND Row <= LastRow THEN
131 IF NOT NewDisk = DCNone THEN CurrentDisks(Column, Row) = NewDisk
132 Disk = CurrentDisks(Column, Row)
133 END IF
134 END IF
135 END IF
136
137 Disks = Disk
138END FUNCTION
139
140SUB DisplayHelp
141 CLS : COLOR 15
142 PRINT
143 PRINT SPC(3); "Connect Four - Help"
144 PRINT
145 PRINT SPC(3); "Keys:"
146 PRINT SPC(3); "F1 = This help."
147 PRINT SPC(3); "F2 = No computer player."
148 PRINT SPC(3); "F3 = Computer plays as red."
149 PRINT SPC(3); "F4 = Computer plays as yellow."
150 PRINT SPC(3); "A = Restart game."
151 PRINT SPC(3); "Q = Quit game."
152 PRINT SPC(3); "R = Red plays first."
153 PRINT SPC(3); "Y = Yellow plays first."
154 PRINT SPC(3); "1-7 = Drop disk into column."
155 DO WHILE INKEY$ = "": LOOP
156END SUB
157
158SUB DrawDisk (Column, Row, ColorO)
159 LINE (Column * SlotSize, Row * SlotSize)-STEP(SlotSize, SlotSize), 0, B
160 CIRCLE ((Column + .5) * SlotSize, (Row + .5) * SlotSize), SlotSize / 2.5, 0
161 SELECT CASE ColorO
162 CASE DCNone
163 COLOR 11
164 CASE DCRed
165 COLOR 12
166 CASE DCYellow
167 COLOR 14
168 END SELECT
169 PAINT ((Column + .5) * SlotSize, (Row + .5) * SlotSize), , 0
170END SUB
171
172SUB DrawDisks
173DIM Column
174DIM Row
175
176 CLS
177 LINE (-1, -1)-(((ABS(LastColumn - FirstColumn) + 1) * SlotSize) + 1, ((ABS(LastRow - FirstRow) + 1) * SlotSize) + 1), 7, BF
178 LINE (0, 0)-((ABS(LastColumn - FirstColumn) + 1) * SlotSize, (ABS(LastRow - FirstRow) + 1) * SlotSize), 1, BF
179 FOR Column = FirstColumn TO LastColumn
180 FOR Row = FirstRow TO LastRow
181 DrawDisk Column, Row, Disks(Column, Row, DCNone, FALSE)
182 NEXT Row
183 NEXT Column
184END SUB
185
186SUB DropDisk (Column, ColorO)
187DIM DelayStart!
188DIM Disk
189DIM KeyStroke$
190DIM Row
191
192 IF Disks(Column, FirstRow, DCNone, FALSE) = DCNone THEN
193 Row = FirstRow
194 DO
195 DrawDisk Column, Row, ColorO
196
197 IF Row = LastRow THEN
198 EXIT DO
199 ELSE
200 IF NOT Disks(Column, Row + 1, DCNone, FALSE) = DCNone THEN EXIT DO
201 END IF
202
203 DelayStart! = TIMER
204 DO WHILE TIMER < DelayStart! + DropDelay!
205 IF TIMER < DelayStart! THEN DelayStart! = TIMER
206 LOOP
207
208 DrawDisk Column, Row, DCNone
209 Row = Row + 1
210 KeyStroke$ = INKEY$
211 LOOP
212
213 Disk = Disks(Column, Row, ColorO, FALSE)
214
215 SELECT CASE CurrentPlayer
216 CASE DCRed
217 CurrentPlayer = DCYellow
218 CASE DCYellow
219 CurrentPlayer = DCRed
220 END SELECT
221
222 END IF
223 SelectedColumn = NoColumn
224END SUB
225
226SUB FindMoves (ColorO, TriggerLength, AllowHelpingOpponent)
227DIM Column
228DIM CheckColumn
229DIM CheckCount
230DIM CheckRow
231DIM DiskCount
232DIM FoundMove
233DIM Row
234DIM XDirection
235DIM YDirection
236
237 ERASE MovesFound
238
239 FOR Column = FirstColumn TO LastColumn
240 FOR Row = FirstRow TO LastRow
241 FOR XDirection = -1 TO 1
242 FOR YDirection = -1 TO 1
243 IF NOT (XDirection = 0 AND YDirection = 0) THEN
244 CheckColumn = Column
245 CheckRow = Row
246 CheckCount = 0
247 DiskCount = 0
248 FoundMove = NoColumn
249
250 DO UNTIL CheckCount = TriggerLength
251 SELECT CASE Disks(CheckColumn, CheckRow, DCNone, FALSE)
252 CASE ColorO
253 DiskCount = DiskCount + 1
254 CASE DCNone
255 SELECT CASE Disks(CheckColumn, CheckRow + 1, DCNone, FALSE)
256 CASE DCRed, DCYellow, DCOutsideField
257 FoundMove = CheckColumn
258 END SELECT
259 CASE ELSE
260 EXIT DO
261 END SELECT
262
263 CheckColumn = CheckColumn + XDirection
264 CheckRow = CheckRow + YDirection
265 CheckCount = CheckCount + 1
266 LOOP
267
268 IF DiskCount = TriggerLength - 1 THEN
269 IF NOT FoundMove = NoColumn THEN
270 IF AllowHelpingOpponent THEN
271 MovesFound(FoundMove) = TRUE
272 ELSE
273 IF NOT MoveHelpsOpponent(HumanColor, FoundMove) THEN MovesFound(FoundMove) = TRUE
274 END IF
275 END IF
276 END IF
277 END IF
278 NEXT YDirection
279 NEXT XDirection
280 NEXT Row
281 NEXT Column
282END SUB
283
284FUNCTION FoundMoves
285DIM Column
286DIM Found
287
288 Found = FALSE
289 FOR Column = FirstColumn TO LastColumn
290 IF MovesFound(Column) THEN
291 Found = TRUE
292 EXIT FOR
293 END IF
294 NEXT Column
295
296 FoundMoves = Found
297END FUNCTION
298
299FUNCTION GameDone
300DIM Column
301DIM Done
302
303 Done = TRUE
304 FOR Column = FirstColumn TO LastColumn
305 IF Disks(Column, FirstRow, DCNone, FALSE) = DCNone THEN
306 Done = FALSE
307 EXIT FOR
308 END IF
309 NEXT Column
310
311 GameDone = Done
312END FUNCTION
313
314FUNCTION GetGameState
315DIM GameState
316
317 SELECT CASE WinningPlayer
318 CASE DCNone
319 IF GameDone THEN
320 GameState = GSTied
321 ELSE
322 SELECT CASE CurrentPlayer
323 CASE DCNone
324 GameState = GSNeitherPlaying
325 CASE DCRed
326 GameState = GSRedPlaying
327 CASE DCYellow
328 GameState = GSYellowPlaying
329 END SELECT
330 END IF
331 CASE DCRed
332 GameState = GSRedWon
333 CASE DCYellow
334 GameState = GSYellowWon
335 END SELECT
336
337 GetGameState = GameState
338END FUNCTION
339
340SUB GreyOutDisks
341DIM Column
342DIM Row
343
344 FOR Column = FirstColumn TO LastColumn
345 FOR Row = FirstRow TO LastRow
346 CIRCLE ((Column + .5) * SlotSize, (Row + .5) * SlotSize), SlotSize / 2.5, 0
347 SELECT CASE Disks(Column, Row, DCNone, FALSE)
348 CASE DCRed
349 COLOR 4
350 CASE DCYellow
351 COLOR 6
352 CASE ELSE
353 COLOR 8
354 END SELECT
355 PAINT ((Column + .5) * SlotSize, (Row + .5) * SlotSize), , 0
356 NEXT Row
357 NEXT Column
358END SUB
359
360SUB InitializeGame
361STATIC CurrentFirstColor
362
363 RANDOMIZE TIMER
364 CurrentPlayer = DCNone
365 tmp = Disks(FirstColumn, FirstRow, DCNone, TRUE)
366 DrawDisks
367 GreyOutDisks
368 SelectedColumn = NoColumn
369
370 COLOR 15: LOCATE 3, 3: PRINT "Connect Four, by: Peter Swinkels - press any key."
371 DO WHILE INKEY$ = "": LOOP
372 DrawDisks
373 CurrentPlayer = FirstColor
374END SUB
375
376FUNCTION MoveHelpsOpponent (OpponentColor, Column)
377DIM HelpsOpponent
378DIM Row
379DIM XDirection
380DIM YDirection
381
382 HelpsOpponent = FALSE
383 Row = 0
384 DO UNTIL (Row = LastRow) OR (NOT Disks(Column, Row + 1, DCNone, FALSE) = DCNone) OR (NOT InterfaceWindow.Visible)
385 Row = Row + 1
386 LOOP
387
388 IF Row > FirstRow THEN
389 Row = Row - 1
390
391 FOR XDirection = -1 TO 1
392 FOR YDirection = -1 TO 1
393 IF NOT (XDirection = 0 AND YDirection = 0) THEN
394 IF CountDisks(Column, Row, OpponentColor, XDirection, YDirection) = WinningLength - 1 THEN
395 HelpsOpponent = TRUE
396 END IF
397 END IF
398 NEXT YDirection
399 NEXT XDirection
400 END IF
401
402 MoveHelpsOpponent = HelpsOpponent
403END FUNCTION
404
405SUB PlayGame
406DIM KeyStroke$
407
408 ComputerColor = DCYellow
409 FirstColor = DCRed
410 HumanColor = DCRed
411
412 InitializeGame
413
414 DO
415 COLOR 15
416 LOCATE 3, 3: PRINT "Connect Four - F1 = Help"
417 LOCATE 5, 1: PRINT SPACE$(80)
418 LOCATE 5, 20: PRINT StateText
419
420 SELECT CASE GetGameState
421 CASE GSRedPlaying, GSYellowPlaying
422 IF NOT CurrentPlayer = ComputerColor THEN
423 DO
424 KeyStroke$ = INKEY$
425 LOOP WHILE KeyStroke$ = ""
426 SELECT CASE KeyStroke$
427 CASE "A", "a"
428 InitializeGame
429 CASE "Q", "q"
430 SCREEN 0: WIDTH 80, 25: COLOR 7, 0: CLS
431 END
432 CASE "R", "r"
433 FirstColor = DCRed
434 InitializeGame
435 CASE "Y", "y"
436 FirstColor = DCYellow
437
438 InitializeGame
439 CASE CHR$(0) + ";"
440 DisplayHelp
441 DrawDisks
442 CASE CHR$(0) + "<"
443 ComputerColor = DCNone
444
445 InitializeGame
446 CASE CHR$(0) + "="
447 ComputerColor = DCRed
448 HumanColor = DCYellow
449
450 InitializeGame
451 CASE CHR$(0) + ">"
452 ComputerColor = DCYellow
453 HumanColor = DCRed
454
455 InitializeGame
456 CASE "1" TO "7"
457 IF NOT GetGameState = GSNeitherPlaying THEN SelectedColumn = VAL(KeyStroke$) - 1
458 END SELECT
459 END IF
460 END SELECT
461
462 SELECT CASE GetGameState
463 CASE GSRedPlaying, GSYellowPlaying
464 IF ComputerColor = DCNone THEN
465 IF NOT SelectedColumn = NoColumn THEN DropDisk SelectedColumn, CurrentPlayer
466 ELSE
467 IF CurrentPlayer = ComputerColor THEN
468 ComputerMakeMove
469 ELSE
470 IF NOT SelectedColumn = NoColumn THEN DropDisk SelectedColumn, CurrentPlayer
471 END IF
472 END IF
473 CASE GSRedWon, GSYellowWon, GSTied
474 GreyOutDisks
475 DO WHILE INKEY$ = "": LOOP
476 InitializeGame
477 END SELECT
478 LOOP
479END SUB
480
481FUNCTION StateText$
482DIM Text$
483
484 Text$ = ""
485 SELECT CASE GetGameState
486 CASE GSNeitherPlaying
487 Text$ = "Inactive."
488 CASE GSRedPlaying
489 Text$ = "Red's turn."
490 CASE GSYellowPlaying
491 Text$ = "Yellow's turn."
492 CASE GSRedWon
493 Text$ = "Red won."
494 CASE GSYellowWon
495 Text$ = "Yellow won."
496 CASE GSTied
497 Text$ = "Game is tied."
498 END SELECT
499
500 StateText$ = Text$
501END FUNCTION
502
503FUNCTION WinningPlayer
504DIM ColorO
505DIM Column
506DIM Row
507DIM XDirection
508DIM YDirection
509DIM Winner
510
511 Winner = DCNone
512
513 FOR ColorO = DCRed TO DCYellow
514 FOR Column = FirstColumn TO LastColumn
515 FOR Row = FirstRow TO LastRow
516 FOR XDirection = -1 TO 1
517 FOR YDirection = -1 TO 1
518 IF NOT (XDirection = 0 AND YDirection = 0) THEN
519 IF CountDisks(Column, Row, ColorO, XDirection, YDirection) = WinningLength THEN
520 Winner = ColorO
521 END IF
522 END IF
523 NEXT YDirection
524 NEXT XDirection
525 NEXT Row
526 NEXT Column
527 NEXT ColorO
528
529 WinningPlayer = Winner
530END FUNCTION