One Key Connect 4 (8x8) Halloween Style

[Pete]

Ah, you did find a more recent picture of Steve. Thanks!

Pete

[Cobalt]

@Cobalt Did you insert resizable in code?

@bplus nope just the code straight from the zip, course the one where I added the  overlay.

not just the sides of the screen, but anything showing up on top of the game window too.

[bplus]

Hi Cobalt, is that Windows or Linux? If Windows what version? Those icons look different (top right corner).

I image that would mess up with any QB64 window.

[bplus]

Here is version #3, here you can play any opponent you want by using a 600 X 680 pixel (or same ratio width X height for least distortion when stretching over screen)  .png file and naming it "Opponent.png". I have 3 sample scary faces in zip, just add digit to current Opponent and remove digit from 1 of the others to try it.

Code: QB64: [Select]

1. Option _Explicit ' One Key Connect 4 (8x8) Halloween Style - bplus 2021-10-19
2. Const SQ = 60 '       square or grid cell
3. Const NumCols = 8 '   number of columns
4. Const NumRows = 8 '   you guessed it
5. Const NCM1 = NumCols - 1 ' NumCols minus 1
6. Const NRM1 = NumRows - 1 ' you can guess surely
7. Const SW = SQ * (NumCols + 2) '  screen width
8. Const SH = SQ * (NumRows + 3) '  screen height
9. Const P = 1 '       Player is 1 on grid
10. Const AI = -1 '     AI is -1 on grid
11. Const XO = SQ '     x offset for grid
12. Const YO = 3 * SQ ' y offset for grid
13.  
14. ReDim Shared Grid(NCM1, NRM1) ' 0 = empty  P=1 for Player,  AI=-1  for AI so -4 is win for AI..
15. ReDim Shared DX(7), DY(7) ' Directions
16. DX(0) = 1: DY(0) = 0 ': DString$(0) = "East"
17. DX(1) = 1: DY(1) = 1 ': DString$(1) = "South East"
18. DX(2) = 0: DY(2) = 1 ': DString$(2) = "South"
19. DX(3) = -1: DY(3) = 1 ': DString$(3) = "South West"
20. DX(4) = -1: DY(4) = 0 ': DString$(4) = "West"
21. DX(5) = -1: DY(5) = -1 ': DString$(5) = "North West"
22. DX(6) = 0: DY(6) = -1 ': DString$(6) = "North"
23. DX(7) = 1: DY(7) = -1 ' : DString$(7) = "North East"
24. ReDim Shared Scores(NCM1) ' rating column for AI and displaying them
25. ReDim Shared AIX, AIY ' last move of AI for highlighting in display
26. ReDim Shared WinX, WinY, WinD ' display Winning Connect 4
27. ReDim Shared GameOn, Turn, GoFirst, PlayerLastMoveCol, PlayerLastMoveRow, MoveNum ' game tracking
28. ReDim Shared Record$(NCM1, NRM1)
29. Dim Shared sx, pr ' for pumpkin recursion shifty eyes and pumkin radius
30. Dim place, k$, t, r, s$, d, temp&, target, y, delaid
31. Dim Shared Overlay& 'the board overlay
32. Dim Shared BF& 'opponent's face
33. Screen _NewImage(SW, SH, 32)
34. _Delay .25
35. _ScreenMove 360, 60
36. Overlay& = _NewImage(SW, SH, 32)
37. BF& = _LoadImage("Opponent.png")
38. Create_Board
39. _Title "One Key Connect 4 (8x8) Halloween Style #3"
40. d = 1
41. While _KeyDown(32) = 0
42.     Cls
43.     pumpkin 0, _Width / 2, _Height / 2, _Height / 2.3, 3
44.     sx = sx + d
45.     If sx > 10 Then d = -d: sx = 10
46.     If sx < -10 Then d = -d: sx = -10
47.     Color &HFFFFFFFF
48.     Locate 40, 33: Print "Spacebar Only"
49.     _Display
50.     _Limit 20
51. Wend
52. _KeyClear
53. GameOn = -1: GoFirst = AI: Turn = AI: MoveNum = 0
54. _PrintMode _KeepBackground
55. ShowGrid
56. place = -1
57. t = Timer
58. pr = (SQ - 2) / 2
59. While GameOn
60.     Cls
61.     If Turn = P Then
62.         k$ = InKey$
63.         If k$ = Chr$(27) Then System ' emergency exit
64.         If k$ = " " Then
65.             t = Timer: place = place + 1
66.             If place >= NumCols Then place = -1
67.         Else ' watch out for midnight!
68.             If Timer - t < 0 Then 'midnight problem
69.                 t = Timer ' wait a little longer
70.             Else
71.                 If Timer - t > 2 And place <> -1 Then ' col selected
72.                     r = GetOpenRow(place)
73.                     If r <> NumRows Then
74.                         y = 2 * SQ + SQ / 2
75.                         target = r * SQ + YO + SQ / 2
76.                         delaid = 6
77.                         While y < target
78.                             y = y + 1
79.                             Cls
80.                             ShowGrid
81.                             pumpkin 0, place * SQ + XO + SQ / 2, y, pr, 2
82.                             sx = Rnd * 6 - 3
83.                             _PutImage , Overlay&, _Display
84.                             _Display
85.                             _Limit delaid
86.                             delaid = delaid * 2
87.                         Wend
88.                         Grid(place, r) = P: Turn = AI: PlayerLastMoveCol = place: PlayerLastMoveRow = r: MoveNum = MoveNum + 1
89.                         place = -1 ' reset back to hold area
90.                     Else
91.                         Beep
92.                     End If
93.                 End If
94.             End If
95.         End If
96.     Else
97.         AIMove
98.         Turn = P: MoveNum = MoveNum + 1: t = Timer
99.     End If
100.     ShowGrid
101.     If Turn = P Then
102.         If place = -1 Then
103.             s$ = "Holding area, press spacebar until over column to play."
104.         Else
105.             s$ = "Press Spacebar, if don't want to play" + Str$(place) + " column."
106.         End If
107.         dp XO + 1, YO - SQ - 16 + 1, s$
108.     End If
109.     pumpkin 0, place * SQ + XO + SQ / 2, 2 * SQ + SQ / 2, pr, 2
110.     sx = Rnd * 6 - 3
111.     _PutImage , Overlay&, _Display
112.     _Display
113.     _Limit 15
114. Wend
115.  
116. Sub AIMove
117.     ' What this sub does in English:
118.     ' This sub assigns the value to playing each column, then plays the best value with following caveats:
119.     ' + If it finds a winning move, it will play that immediately.
120.     ' + If it finds a spoiler move, it will play that if no winning move was found.
121.     ' + It will poisen the column's scoring, if opponent can play a winning move if AI plays this column,
122.     '   but it might be the only legal move left.  We will have to play it if no better score was found.
123.  
124.     Dim c, r, d, cntA, cntP, bestScore, startR, startC, iStep, test, goodF, i
125.     Dim openRow(NCM1) ' find open rows once
126.     ReDim Scores(NCM1) ' evaluate each column's potential
127.     AIX = -1: AIY = -1 ' set these when AI makes move, they are signal to display procedure AI's move.
128.     For c = 0 To NCM1
129.         openRow(c) = GetOpenRow(c)
130.         r = openRow(c)
131.         If r <> NumRows Then
132.             For d = 0 To 3 ' 4 directions to build connect 4's that use cell c, r
133.                 startC = c + -3 * DX(d): startR = r + -3 * DY(d)
134.                 For i = 0 To 3 ' here we backup from the potential connect 4 in opposite build direction of c, r
135.                     cntA = 0: cntP = 0: goodF = -1 ' reset counts and flag for good connect 4
136.                     'from this start position run 4 steps forward to count all connects involving cell c, r
137.                     For iStep = 0 To 3 ' process a potential connect 4
138.                         test = GR(startC + i * DX(d) + iStep * DX(d), startR + i * DY(d) + iStep * DY(d))
139.                         If test = NumRows Then goodF = 0: Exit For 'cant get connect4 from here
140.                         If test = AI Then cntA = cntA + 1
141.                         If test = P Then cntP = cntP + 1
142.                     Next iStep
143.                     If goodF Then 'evaluate the Legal Connect4 we could build with c, r
144.                         If cntA = 3 Then ' we are done!  winner!
145.                             AIX = c: AIY = r ' <<< this is the needed 4th cell to win tell ShowGrid last cell
146.                             Grid(c, r) = AI '  <<< this is the needed 4th cell to win, add to grid this is AI move
147.                             Scores(c) = 1000
148.                             Exit Sub
149.                         ElseIf cntP = 3 Then 'next best move spoiler!
150.                             AIX = c: AIY = r 'set the move but don't exit there might be a winner
151.                             Scores(c) = 900
152.                         ElseIf cntA = 0 And cntP = 2 Then
153.                             Scores(c) = Scores(c) + 8
154.                         ElseIf cntA = 2 And cntP = 0 Then ' very good offense or defense
155.                             Scores(c) = Scores(c) + 4 'play this to connect 3 or prevent player from Connect 3
156.                         ElseIf cntA = 0 And cntP = 1 Then
157.                             Scores(c) = Scores(c) + 4
158.                         ElseIf (cntA = 1 And cntP = 0) Then 'good offense or defense
159.                             Scores(c) = Scores(c) + 2 ' play this to connect 2 or prevent player from Connect 2
160.                         ElseIf (cntA = 0 And cntP = 0) Then ' OK it's not a wasted move as it has potential for connect4
161.                             Scores(c) = Scores(c) + 1 ' this is good move because this can still be a Connect 4
162.                         End If
163.                     End If ' in the board
164.                 Next i
165.             Next d
166.             If Stupid(c, r) Then Scores(c) = -1000 + Scores(c) ' poison because if played the human can win
167.         End If
168.     Next
169.     If AIX <> -1 Then ' we found a spoiler so move there since we haven't found a winner
170.         Grid(AIX, AIY) = AI ' make move on grid and done!
171.         Exit Sub
172.     Else
173.         If GetOpenRow(PlayerLastMoveCol) < NumRows Then 'all things being equal play on top of player's last move
174.             bestScore = Scores(PlayerLastMoveCol): AIY = PlayerLastMoveRow - 1: AIX = PlayerLastMoveCol
175.         Else
176.             bestScore = -1000 ' a negative score indicates that the player can beat AI with their next move
177.         End If
178.         For c = 0 To NCM1
179.             r = openRow(c)
180.             If r <> NumRows Then
181.                 If Scores(c) > bestScore Then bestScore = Scores(c): AIY = r: AIX = c
182.             End If
183.         Next
184.         If AIX <> -1 Then
185.             Grid(AIX, AIY) = AI ' make first best score move we found
186.         Else 'We have trouble!  Oh but it could be there are no moves!!!
187.             ' checkWin is run after every move by AI or Player if there were no legal moves left it should have caught that.
188.             ' Just in case it didn't here is an error stop!
189.             Beep
190.             dp 2 * 8, 4 * 16, "AI has failed to find a proper move, press any to end..."
191.             Sleep ' <<< pause until user presses a key
192.             End
193.         End If
194.     End If
195. End Sub
196.  
197. Function GetOpenRow (forCol)
198.     Dim i
199.     GetOpenRow = NumRows 'assume none open
200.     If forCol < 0 Or forCol > NCM1 Then Exit Function
201.     For i = NRM1 To 0 Step -1
202.         If Grid(forCol, i) = 0 Then GetOpenRow = i: Exit Function
203.     Next
204. End Function
205.  
206. Function Stupid (c, r)
207.     Dim ppr
208.     Grid(c, r) = AI
209.     ppr = GetOpenRow(c)
210.     If ppr <> NumRows Then
211.         Grid(c, ppr) = P
212.         If CheckWin = 4 Then Stupid = -1
213.         Grid(c, ppr) = 0
214.     End If
215.     Grid(c, r) = 0
216. End Function
217.  
218. Function GR (c, r) ' if c, r are out of bounds returns N else returns grid(c, r)
219.     ' need to check the grid(c, r) but only if c, r is on the board
220.     If c < 0 Or c > NCM1 Or r < 0 Or r > NRM1 Then GR = NumRows Else GR = Grid(c, r)
221. End Function
222.  
223. Sub ShowGrid
224.     Static lastMoveNum
225.     Dim i, r, c, check, s$, k$
226.     If MoveNum <> lastMoveNum Then ' file newest move
227.         If MoveNum = 1 Then ReDim Record$(NCM1, NRM1)
228.         If Turn = -1 Then
229.             Record$(PlayerLastMoveCol, PlayerLastMoveRow) = _Trim$(Str$(MoveNum)) + " " + "P"
230.         Else
231.             Record$(AIX, AIY) = _Trim$(Str$(MoveNum)) + " " + "A"
232.         End If
233.         lastMoveNum = MoveNum
234.     End If
235.     Color _RGB32(255, 255, 255), _RGB32(0): Cls
236.     _PutImage , BF&, 0, (10, 10)-(_Width(BF&) - 20, _Height(BF&) - 50)
237.     'Line (XO, YO)-Step(NumCols * SQ, NumRows * SQ), &HFF004400, BF
238.     For i = 0 To NumCols 'grid
239.         Line (SQ * i + XO, YO)-Step(0, NumRows * SQ), &HFFFFFFFF
240.     Next
241.     For i = 0 To NumRows
242.         Line (XO, SQ * i + YO)-Step(NumCols * SQ, 0), &HFFFFFFFF
243.     Next
244.     Color
245.     For r = NRM1 To 0 Step -1 ''in grid rows are reversed 0 is top row
246.         For c = 0 To NCM1
247.             If Grid(c, r) = P Then
248.                 'Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF000000, BF
249.                 pumpkin 0, c * SQ + XO + SQ / 2, r * SQ + YO + SQ / 2, pr, 2
250.  
251.             ElseIf Grid(c, r) = AI Then
252.                 If c = AIX And r = AIY Then 'highlite last AI move
253.                     'Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF8888FF, BF  ' no overlay
254.                     Line (c * SQ + XO, r * SQ + YO)-Step(SQ, SQ), &HFF8888FF, BF
255.                 Else
256.                     'Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF4444FF, BF  ' no overlay
257.                     Line (c * SQ + XO, r * SQ + YO)-Step(SQ, SQ), &HFF4444FF, BF
258.                 End If
259.                 drawSpinner c * SQ + XO + SQ / 2, r * SQ + YO + SQ / 2, .4, _Pi(-c / 8), _RGB32(Rnd * 30 + 40, Rnd * 15 + 20, Rnd * 6 + 10)
260.             End If
261.             s$ = _Trim$(Str$(Scores(c)))
262.             dp XO + c * SQ + (60 - Len(s$) * 8) / 2, YO + SQ * NumRows + 22, s$
263.         Next
264.     Next
265.     '_Display
266.     check = CheckWin
267.     If check Then 'report end of round ad see if want to play again
268.         If check = 4 Or check = -4 Then
269.             For i = 0 To 3
270.                 Line ((WinX + i * DX(WinD)) * SQ + XO + 10, (WinY + i * DY(WinD)) * SQ + YO + 10)-Step(SQ - 20, SQ - 20), &HFFFFFF00, B
271.             Next
272.         End If
273.         For r = 0 To NRM1
274.             For c = 0 To NCM1
275.                 If Record$(c, r) <> "" Then
276.                     s$ = Mid$(Record$(c, r), 1, InStr(Record$(c, r), " ") - 1)
277.                     dp SQ * c + XO + (SQ - Len(s$) * 8) / 2, SQ * r + YO + 22, s$
278.                 End If
279.             Next
280.         Next
281.         If check = -4 Then
282.             s$ = " AI is Winner!"
283.         ElseIf check = 4 Then
284.             s$ = " Human is Winner!"
285.         ElseIf check = NumRows Then
286.             s$ = " Board is full, no winner." ' keep Turn the same
287.         End If
288.         dp (SW - Len(s$) * 8) / 2, 2 * 16, s$
289.         s$ = " Play again? press spacebar, escape to quit... "
290.         dp (SW - Len(s$) * 8) / 2, 4 * 16, s$
291.         _PutImage , Overlay&, _Display
292.         _Display
293.         keywait:
294.         While Len(k$) = 0
295.             k$ = InKey$
296.             _Limit 200
297.         Wend
298.         If k$ = " " Then
299.             ReDim Grid(NCM1, NRM1), Scores(NCM1)
300.             If GoFirst = P Then GoFirst = AI Else GoFirst = P
301.             Turn = GoFirst: MoveNum = 0
302.         ElseIf Asc(k$) = 27 Then
303.             System
304.         Else
305.             k$ = "": GoTo keywait:
306.         End If
307.     End If
308. End Sub
309.  
310. Function CheckWin ' return WinX, WinY, WinD along with +/- 4, returns NumRows if grid full, 0 if no win and grid not full
311.     Dim gridFull, r, c, s, i
312.     gridFull = NumRows
313.     For r = NRM1 To 0 Step -1 'bottom to top
314.         For c = 0 To NCM1
315.             If Grid(c, r) Then ' check if c starts a row
316.                 If c < NCM1 - 2 Then
317.                     s = 0
318.                     For i = 0 To 3 ' east
319.                         s = s + Grid(c + i, r)
320.                     Next
321.                     If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 0: CheckWin = s: Exit Function
322.                 End If
323.                 If r > 2 Then ' check if c starts a col
324.                     s = 0
325.                     For i = 0 To 3 ' north
326.                         s = s + Grid(c, r - i)
327.                     Next
328.                     If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 6: CheckWin = s: Exit Function
329.                 End If
330.                 If r > 2 And c < NCM1 - 2 Then 'check if c starts diagonal up to right
331.                     s = 0
332.                     For i = 0 To 3 ' north  east
333.                         s = s + Grid(c + i, r - i)
334.                     Next
335.                     If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 7: CheckWin = s: Exit Function
336.                 End If
337.                 If r > 2 And c > 2 Then 'check if c starts a diagonal up to left
338.                     s = 0
339.                     For i = 0 To 3 ' north west
340.                         s = s + Grid(c - i, r - i)
341.                     Next
342.                     If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 5: CheckWin = s: Exit Function
343.                 End If
344.             Else
345.                 gridFull = 0 ' at least one enpty cell left
346.             End If 'grid is something
347.         Next
348.     Next
349.     CheckWin = gridFull
350. End Function
351.  
352.  
353. Sub pumpkin (dh&, cx, cy, pr, limit)
354.     Dim lastr, u, dx, i, tx1, tx2, tx3, ty1, ty2, ty3, ty22, sxs
355.     'carve this!
356.     Color &HFFFF0000
357.     fEllipse cx, cy, pr, 29 / 35 * pr
358.     Color &HFF000000
359.     lastr = 2 / 7 * pr
360.     Do
361.         ellipse cx, cy, lastr, 29 / 35 * pr
362.         lastr = .5 * (pr - lastr) + lastr + 1 / 35 * pr
363.         If pr - lastr < 1 / 80 * pr Then Exit Do
364.     Loop
365.  
366.     ' 'flickering candle light
367.     'Color _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
368.  
369.     ' eye sockets
370.     ftri2 dh&, cx - 9 * pr / 12, cy - 2 * pr / 12, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
371.     ftri2 dh&, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, cx - 2 * pr / 12, cy - 3 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
372.     ftri2 dh&, cx + 9 * pr / 12, cy - 2 * pr / 12, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
373.     ftri2 dh&, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, cx + 2 * pr / 12, cy - 3 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
374.  
375.     ' nose
376.     ftri2 dh&, cx, cy - rand%(2, 5) * pr / 12, cx - 2 * pr / 12, cy + 2 * pr / 12, cx + rand%(1, 2) * pr / 12, cy + 2 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
377.  
378.     ' evil grin
379.     ftri2 dh&, cx - 9 * pr / 12, cy + 1 * pr / 12, cx - 7 * pr / 12, cy + 7 * pr / 12, cx - 6 * pr / 12, cy + 5 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
380.     ftri2 dh&, cx + 9 * pr / 12, cy + 1 * pr / 12, cx + 7 * pr / 12, cy + 7 * pr / 12, cx + 6 * pr / 12, cy + 5 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
381.  
382.     ' moving teeth/talk/grrrr..
383.     u = rand%(4, 8)
384.     dx = pr / u
385.     For i = 1 To u
386.         tx1 = cx - 6 * pr / 12 + (i - 1) * dx
387.         tx2 = tx1 + .5 * dx
388.         tx3 = tx1 + dx
389.         ty1 = cy + 5 * pr / 12
390.         ty3 = cy + 5 * pr / 12
391.         ty2 = cy + (4 - Rnd) * pr / 12
392.         ty22 = cy + (6 + Rnd) * pr / 12
393.         ftri2 dh&, tx1, ty1, tx2, ty2, tx3, ty3, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
394.         ftri2 dh&, tx1 + .5 * dx, ty1, tx2 + .5 * dx, ty22, tx3 + .5 * dx, ty3, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
395.     Next
396.     If limit Then
397.         'shifty eyes
398.         If limit = 3 Then sxs = sx Else sxs = .1 * limit * sx
399.         pumpkin dh&, sxs + cx - 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
400.         pumpkin dh&, sxs + cx + 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
401.     End If
402. End Sub
403.  
404. Sub fEllipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
405.     Dim scale As Single, x As Long, y As Long
406.     scale = yRadius / xRadius
407.     Line (CX, CY - yRadius)-(CX, CY + yRadius), , BF
408.     For x = 1 To xRadius
409.         y = scale * Sqr(xRadius * xRadius - x * x)
410.         Line (CX + x, CY - y)-(CX + x, CY + y), , BF
411.         Line (CX - x, CY - y)-(CX - x, CY + y), , BF
412.     Next
413. End Sub
414.  
415. Sub ellipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
416.     Dim scale As Single, xs As Long, x As Long, y As Long
417.     Dim lastx As Long, lasty As Long
418.     scale = yRadius / xRadius: xs = xRadius * xRadius
419.     PSet (CX, CY - yRadius): PSet (CX, CY + yRadius)
420.     lastx = 0: lasty = yRadius
421.     For x = 1 To xRadius
422.         y = scale * Sqr(xs - x * x)
423.         Line (CX + lastx, CY - lasty)-(CX + x, CY - y)
424.         Line (CX + lastx, CY + lasty)-(CX + x, CY + y)
425.         Line (CX - lastx, CY - lasty)-(CX - x, CY - y)
426.         Line (CX - lastx, CY + lasty)-(CX - x, CY + y)
427.         lastx = x: lasty = y
428.     Next
429. End Sub
430.  
431. Sub ftri2 (returnDest&, x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
432.     Dim a&
433.     a& = _NewImage(1, 1, 32)
434.     _Dest a&
435.     PSet (0, 0), K
436.     _Dest returnDest&
437.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
438.     _FreeImage a& '<<< this is important!
439. End Sub
440.  
441. Function rand% (lo%, hi%)
442.     rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
443. End Function
444.  
445.  
446.  
447. Sub drawLink (x1, y1, r1, x2, y2, r2, c As _Unsigned Long)
448.     Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
449.     a = _Atan2(y2 - y1, x2 - x1)
450.     a1 = a + _Pi(1 / 2)
451.     a2 = a - _Pi(1 / 2)
452.     x3 = x1 + r1 * Cos(a1): y3 = y1 + r1 * Sin(a1)
453.     x4 = x1 + r1 * Cos(a2): y4 = y1 + r1 * Sin(a2)
454.     x5 = x2 + r2 * Cos(a1): y5 = y2 + r2 * Sin(a1)
455.     x6 = x2 + r2 * Cos(a2): y6 = y2 + r2 * Sin(a2)
456.     fquad x3, y3, x4, y4, x5, y5, x6, y6, c
457.     Fcirc x1, y1, r1, c
458.     Fcirc x2, y2, r2, c
459. End Sub
460.  
461. 'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
462. Sub fquad (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long)
463.     ftri x1, y1, x2, y2, x4, y4, c
464.     ftri x3, y3, x4, y4, x1, y1, c
465. End Sub
466.  
467. Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
468.     Dim a&
469.     a& = _NewImage(1, 1, 32)
470.     _Dest a&
471.     PSet (0, 0), K
472.     _Dest 0
473.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
474.     _FreeImage a& '<<< this is important!
475. End Sub
476.  
477. Sub TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c As _Unsigned Long)
478.     Dim max As Integer, mx2 As Integer, i As Integer, j As Integer, k As Single, lasti As Single, lastj As Single
479.     Dim prc As _Unsigned Long, tef As Long
480.     prc = _RGB32(255, 255, 255, 255)
481.     If a > b Then max = a + 1 Else max = b + 1
482.     mx2 = max + max
483.     tef = _NewImage(mx2, mx2)
484.     _Dest tef
485.     _Source tef 'point wont read without this!
486.     For k = 0 To 6.2832 + .05 Step .1
487.         i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
488.         j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang)
489.         If k <> 0 Then
490.             Line (lasti, lastj)-(i, j), prc
491.         Else
492.             PSet (i, j), prc
493.         End If
494.         lasti = i: lastj = j
495.     Next
496.     Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer
497.     For y = 0 To mx2
498.         x = 0
499.         While Point(x, y) <> prc And x < mx2
500.             x = x + 1
501.         Wend
502.         xleft(y) = x
503.         While Point(x, y) = prc And x < mx2
504.             x = x + 1
505.         Wend
506.         While Point(x, y) <> prc And x < mx2
507.             x = x + 1
508.         Wend
509.         If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x
510.     Next
511.     _Dest destHandle&
512.     For y = 0 To mx2
513.         If xleft(y) <> mx2 Then Line (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF
514.     Next
515.     _FreeImage tef
516. End Sub
517.  
518. Sub Fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
519.     Dim Radius As Long, RadiusError As Long
520.     Dim X As Long, Y As Long
521.     Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
522.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
523.     Line (CX - X, CY)-(CX + X, CY), C, BF
524.     While X > Y
525.         RadiusError = RadiusError + Y * 2 + 1
526.         If RadiusError >= 0 Then
527.             If X <> Y + 1 Then
528.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
529.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
530.             End If
531.             X = X - 1
532.             RadiusError = RadiusError - X * 2
533.         End If
534.         Y = Y + 1
535.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
536.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
537.     Wend
538. End Sub
539.  
540. Sub drawSpinner (x As Integer, y As Integer, scale As Single, heading As Single, c As _Unsigned Long)
541.     Dim x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd
542.     Dim rred, bblue, ggreen
543.     Static switch As Integer
544.     switch = switch + 2
545.     switch = switch Mod 16 + 1
546.     rred = _Red32(c): ggreen = _Green32(c): bblue = _Blue32(c)
547.     r = 10 * scale
548.     x1 = x + r * Cos(heading): y1 = y + r * Sin(heading)
549.     r = 2 * r 'lg lengths
550.     For lg = 1 To 8
551.         If lg < 5 Then
552.             a = heading + .9 * lg * _Pi(1 / 5) + (lg = switch) * _Pi(1 / 10)
553.         Else
554.             a = heading - .9 * (lg - 4) * _Pi(1 / 5) - (lg = switch) * _Pi(1 / 10)
555.         End If
556.         x2 = x1 + r * Cos(a): y2 = y1 + r * Sin(a)
557.         drawLink x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(rred + 20, ggreen + 10, bblue + 5)
558.         If lg = 1 Or lg = 2 Or lg = 7 Or lg = 8 Then d = -1 Else d = 1
559.         a1 = a + d * _Pi(1 / 12)
560.         x3 = x2 + r * 1.5 * Cos(a1): y3 = y2 + r * 1.5 * Sin(a1)
561.         drawLink x2, y2, 2 * scale, x3, y3, scale, _RGB32(rred + 35, ggreen + 17, bblue + 8)
562.         rd = Int(Rnd * 8) + 1
563.         a2 = a1 + d * _Pi(1 / 8) * rd / 8
564.         x4 = x3 + r * 1.5 * Cos(a2): y4 = y3 + r * 1.5 * Sin(a2)
565.         drawLink x3, y3, scale, x4, y4, scale, _RGB32(rred + 50, ggreen + 25, bblue + 12)
566.     Next
567.     r = r * .5
568.     Fcirc x1, y1, r, _RGB32(rred - 20, ggreen - 10, bblue - 5)
569.     x2 = x1 + (r + 1) * Cos(heading - _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading - _Pi(1 / 12))
570.     Fcirc x2, y2, r * .2, &HFF000000
571.     x2 = x1 + (r + 1) * Cos(heading + _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading + _Pi(1 / 12))
572.     Fcirc x2, y2, r * .2, &HFF000000
573.     r = r * 2
574.     x1 = x + r * .9 * Cos(heading + _Pi): y1 = y + r * .9 * Sin(heading + _Pi)
575.     TiltedEllipseFill 0, x1, y1, r, .7 * r, heading + _Pi, _RGB32(rred, ggreen, bblue)
576. End Sub
577.  
578. Sub Create_Board
579.     Dim As Integer x, y
580.     _Dest Overlay&
581.     Line (XO, YO)-Step(SQ * NumCols, SQ * NumRows), _RGB32(40, 20, 10), BF
582.     For y = 0 To NRM1
583.         For x = 0 To NCM1
584.             Fcirc SQ * x + XO + SQ / 2, SQ * y + YO + SQ / 2, (SQ - 2) / 2, _RGB32(0)
585.     Next x, y
586.     _ClearColor _RGB32(0), Overlay&
587.     _Dest _Display
588. End Sub
589.  
590. Sub dp (x, y, s$) ' double print white over black to stand out over images
591.     Color &HFF000000
592.     _PrintString (x + 1, y + 1), s$
593.     Color &HFFFFFFFF
594.     _PrintString (x, y), s$
595. End Sub
596.  
597.  

I have given spiders solid background so they may be seen wiggling better.

 

That's probably my final version.

[Pete]

@bplus and @Cobalt

I'm using Windows 10, and I don't get the distortion effect when dragging the game to the edges, as depicted in the video. BTW @Cobalt What type of screen recorder are you using to produce the vids?

Pete

[Cobalt]

Hi Cobalt, is that Windows or Linux? If Windows what version? Those icons look different (top right corner).

I image that would mess up with any QB64 window.

Windows.
Typically only does that on programs using the _DISPLAY keyword. And on random occasion with the IDE.

[Cobalt]

I'm using Windows 10, and I don't get the distortion effect when dragging the game to the edges, as depicted in the video. BTW @Cobalt What type of screen recorder are you using to produce the vids?

Pete

@Pete its called Active Presenter.

[Pete]

@Cobalt. Thanks, I bookmarked the download site.

@bplus

I combined Halloween with Easter and can someone tell me what month they celebrate gay pride?

 

Kidding aside, I did try it with a "straight" black background, and I really liked that rendition.
 
Pete

[Dav]

@Dav you had it figured out some time ago, my guess your memory getting like mine. This is old Connect 4 posted almost year ago but now we see our opponent!

I remember playing it before, but couldn't remember a technique that worked, but I think I found it again.  I've found if I mirror the AI play, and divide the playing field, it's easier to out think it.  Like this image shows, it drops on one side, I drop one on the opposite side. I drew boxes around the pieces to show how I matched the pieces.  This way I can beat it pretty often.

Had fun playing this.

- Dav

 

[bplus]

@Dav you might be onto how to play a perfect game! Supposedly it's been proved that for 8x8 Connect 4 Boards the 2nd player always wins in perfect game.

DaiHard at Syntax Bomb pointed me to a link about proof
https://tromp.github.io/c4/c4.html

and code for 8x8 game, I think? :)
https://github.com/tromp/fhourstones88/commit/8378b3256e9dcb79d90b856820cbcc7cef31e66f

[Pete]

Nice work, Dav!

I noticed the A.I. would almost always stack on top. I figured this was a vulnerability that could be exploited, but I wasn't willing to investigate it further. I also "felt" there was a distinct advantage to going second.

So if we use your strategy, maybe Mark should code in a "Screw you, I quit!" message from the A.I.? Hey, he already uses a variable named "Stupid" to track our mistakes. :D

Pete

[bplus]

Or the Board could suddenly be overrun by spiders!

The Stupid subroutine is to avoid making a stupid move ie putting a piece upon which the opponent may place his piece and win, sometimes stupid moves can't be avoided, that's when board should be overrun by spiders LOL!

I wish the human could use the Stupid sub too, hey maybe another mod! ;-))