This game is generalized to do any number of columns and rows, I think. I have it setup for Standard Board Game at 7 columns and 6 Rows. This has been proven to be a certain winner but I forget, the first or 2nd player.
Don't worry AI aint that good but OK.
Must be something wrong < 300 LOC!?!?
I threw out a challenge for an 8x8 board not proven that I could find to be anyone's certain advantage if they played perfect.
That news may be old as maths love to prove such things for all rows and cols.
Don't worry AI aint that good but OK.
Code: (Select All)
Option _Explicit ' Connect 4 NumRows X NumCols 2020_12_16.bas update bplus
DefLng A-Z
Const SQ = 60 ' square or grid cell
Const NumCols = 7 ' number of columns 7 across 6 down is standard for board game
Const NumRows = 6 ' you guessed it
Const NCM1 = NumCols - 1 ' NumCols minus 1
Const NRM1 = NumRows - 1 ' you can guess surely
Const SW = SQ * (NumCols + 2) ' screen width
Const SH = SQ * (NumRows + 3) ' screen height
Const P = 1 ' Player is 1 on grid
Const AI = -1 ' AI is -1 on grid
Const XO = SQ ' x offset for grid
Const YO = 2 * SQ ' y offset for grid
ReDim Shared Grid(NCM1, NRM1) ' 0 = empty P=1 for Player, AI=-1 for AI so -4 is win for AI..
ReDim Shared DX(7), DY(7) ' Directions
DX(0) = 1: DY(0) = 0 ': DString$(0) = "East"
DX(1) = 1: DY(1) = 1 ': DString$(1) = "South East"
DX(2) = 0: DY(2) = 1 ': DString$(2) = "South"
DX(3) = -1: DY(3) = 1 ': DString$(3) = "South West"
DX(4) = -1: DY(4) = 0 ': DString$(4) = "West"
DX(5) = -1: DY(5) = -1 ': DString$(5) = "North West"
DX(6) = 0: DY(6) = -1 ': DString$(6) = "North"
DX(7) = 1: DY(7) = -1 ' : DString$(7) = "North East"
ReDim Shared Scores(NCM1) ' rating column for AI and displaying them
ReDim Shared AIX, AIY ' last move of AI for highlighting in display
ReDim Shared WinX, WinY, WinD ' display Winning Connect 4
ReDim Shared GameOn, Turn, GoFirst, PlayerLastMoveCol, PlayerLastMoveRow, MoveNum ' game tracking
ReDim Shared Record$(NCM1, NRM1)
Screen _NewImage(SW, SH, 32)
_ScreenMove 360, 60
Dim mb, mx, my, row, col, r
_Title "Connect 4: " + _Trim$(Str$(NumCols)) + "x" + _Trim$(Str$(NumRows)) + " with AI"
GameOn = -1: GoFirst = AI: Turn = AI: MoveNum = 0
ShowGrid
While GameOn
If Turn = P Then
While _MouseInput: Wend
mb = _MouseButton(1): mx = _MouseX: my = _MouseY
If mb Then 'get last place mouse button was down
_Delay .25 'for mouse release
row = ((my - YO) / SQ - .5): col = ((mx - XO) / SQ - .5)
If col >= 0 And col <= NCM1 And row >= 0 And row < 8 Then
r = GetOpenRow(col)
If r <> NumRows Then
Grid(col, r) = P: Turn = AI: PlayerLastMoveCol = col: PlayerLastMoveRow = r: MoveNum = MoveNum + 1
End If
Else
Beep
End If
End If
Else
AIMove
Turn = P: MoveNum = MoveNum + 1
End If
ShowGrid
_PrintString (10, 10), Space$(50)
_PrintString (10, 10), Str$(AIX) + Str$(AIY)
_Display
_Limit 60
Wend
Sub AIMove
' What this sub does in English:
' This sub assigns the value to playing each column, then plays the best value with following caveats:
' + If it finds a winning move, it will play that immediately.
' + If it finds a spoiler move, it will play that if no winning move was found.
' + It will poisen the column's scoring, if opponent can play a winning move if AI plays this column,
' but it might be the only legal move left. We will have to play it if no better score was found.
Dim c, r, d, cntA, cntP, bestScore, startR, startC, iStep, test, goodF, i
Dim openRow(NCM1) ' find open rows once
ReDim Scores(NCM1) ' evaluate each column's potential
AIX = -1: AIY = -1 ' set these when AI makes move, they are signal to display procedure AI's move.
For c = 0 To NCM1
openRow(c) = GetOpenRow(c)
r = openRow(c)
If r <> NumRows Then
For d = 0 To 3 ' 4 directions to build connect 4's that use cell c, r
startC = c + -3 * DX(d): startR = r + -3 * DY(d)
For i = 0 To 3 ' here we backup from the potential connect 4 in opposite build direction of c, r
cntA = 0: cntP = 0: goodF = -1 ' reset counts and flag for good connect 4
'from this start position run 4 steps forward to count all connects involving cell c, r
For iStep = 0 To 3 ' process a potential connect 4
test = GR(startC + i * DX(d) + iStep * DX(d), startR + i * DY(d) + iStep * DY(d))
If test = NumRows Then goodF = 0: Exit For 'cant get connect4 from here
If test = AI Then cntA = cntA + 1
If test = P Then cntP = cntP + 1
Next iStep
If goodF Then 'evaluate the Legal Connect4 we could build with c, r
If cntA = 3 Then ' we are done! winner!
AIX = c: AIY = r ' <<< this is the needed 4th cell to win tell ShowGrid last cell
Grid(c, r) = AI ' <<< this is the needed 4th cell to win, add to grid this is AI move
Scores(c) = Scores(c) + 1000
Exit Sub
ElseIf cntP = 3 Then 'next best move spoiler!
AIX = c: AIY = r 'set the move but don't exit there might be a winner
Scores(c) = Scores(c) + 900
ElseIf cntA = 0 And cntP = 2 Then
Scores(c) = Scores(c) + 8
ElseIf cntA = 2 And cntP = 0 Then ' very good offense or defense
Scores(c) = Scores(c) + 4 'play this to connect 3 or prevent player from Connect 3
ElseIf cntA = 0 And cntP = 1 Then
Scores(c) = Scores(c) + 4
ElseIf (cntA = 1 And cntP = 0) Then 'good offense or defense
Scores(c) = Scores(c) + 2 ' play this to connect 2 or prevent player from Connect 2
ElseIf (cntA = 0 And cntP = 0) Then ' OK it's not a wasted move as it has potential for connect4
Scores(c) = Scores(c) + 1 ' this is good move because this can still be a Connect 4
End If
End If ' in the board
Next i
Next d
If Stupid(c, r) Then Scores(c) = -1000 + Scores(c) ' poison because if played the human can win
End If
Next
If AIX <> -1 Then ' we found a spoiler so move there since we haven't found a winner
Grid(AIX, AIY) = AI ' make move on grid and done!
Exit Sub
Else
If GetOpenRow(PlayerLastMoveCol) < NumRows Then 'all things being equal play on top of player's last move
bestScore = Scores(PlayerLastMoveCol): AIY = PlayerLastMoveRow - 1: AIX = PlayerLastMoveCol
Else
bestScore = -1000 ' a negative score indicates that the player can beat AI with their next move
End If
For c = 0 To NCM1
r = openRow(c)
If r <> NumRows Then
If Scores(c) > bestScore Then bestScore = Scores(c): AIY = r: AIX = c
End If
Next
If AIX <> -1 Then
Grid(AIX, AIY) = AI ' make first best score move we found
Else 'We have trouble! Oh but it could be there are no moves!!!
' checkWin is run after every move by AI or Player if there were no legal moves left it should have caught that.
' Just in case it didn't here is an error stop!
Beep: Locate 4, 2: Print "AI has failed to find a proper move, press any to end..."
Sleep ' <<< pause until user presses a key
End
End If
End If
End Sub
Function GetOpenRow (forCol)
Dim i
GetOpenRow = NumRows 'assume none open
If forCol < 0 Or forCol > NCM1 Then Exit Function
For i = NRM1 To 0 Step -1
If Grid(forCol, i) = 0 Then GetOpenRow = i: Exit Function
Next
End Function
Function Stupid (c, r)
Dim pr
Grid(c, r) = AI
pr = GetOpenRow(c)
If pr <> NumRows Then
Grid(c, pr) = P
If CheckWin = 4 Then Stupid = -1
Grid(c, pr) = 0
End If
Grid(c, r) = 0
End Function
Function GR (c, r) ' if c, r are out of bounds returns N else returns grid(c, r)
' need to check the grid(c, r) but only if c, r is on the board
If c < 0 Or c > NCM1 Or r < 0 Or r > NRM1 Then GR = NumRows Else GR = Grid(c, r)
End Function
Sub ShowGrid
Static lastMoveNum
Dim i, r, c, check, s$, k$
If MoveNum <> lastMoveNum Then ' file newest move
If MoveNum = 1 Then ReDim Record$(NCM1, NRM1)
If Turn = -1 Then
Record$(PlayerLastMoveCol, PlayerLastMoveRow) = _Trim$(Str$(MoveNum)) + " " + "P"
Else
Record$(AIX, AIY) = _Trim$(Str$(MoveNum)) + " " + "A"
End If
lastMoveNum = MoveNum
End If
Cls
Line (XO, YO)-Step(NumCols * SQ, NumRows * SQ), &HFF004400, BF
For i = 0 To NumCols 'grid
Line (SQ * i + XO, YO)-Step(0, NumRows * SQ), &HFFFFFFFF
Next
For i = 0 To NumRows
Line (XO, SQ * i + YO)-Step(NumCols * SQ, 0), &HFFFFFFFF
Next
For r = NRM1 To 0 Step -1 ''in grid rows are reversed 0 is top row
For c = 0 To NCM1
If Grid(c, r) = P Then
Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFFFF2200, BF
ElseIf Grid(c, r) = AI Then
If c = AIX And r = AIY Then 'highlite last AI move
Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF680044, BF
Else
Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF390027, BF
End If
End If
s$ = _Trim$(Str$(Scores(c)))
_PrintString (XO + c * SQ + (60 - Len(s$) * 8) / 2, YO + SQ * NumRows + 22), s$
Next
Next
_Display
check = CheckWin
If check Then 'report end of round ad see if want to play again
If check = 4 Or check = -4 Then
For i = 0 To 3
Line ((WinX + i * DX(WinD)) * SQ + XO + 5, (WinY + i * DY(WinD)) * SQ + YO + 5)-Step(SQ - 10, SQ - 10), &HFFFFFF00, B
Next
End If
For r = 0 To NRM1
For c = 0 To NCM1
If Record$(c, r) <> "" Then
s$ = Mid$(Record$(c, r), 1, InStr(Record$(c, r), " ") - 1)
If Right$(Record$(c, r), 1) = "A" Then Color , &HFF390027 Else Color , &HFFFF2200
_PrintString (SQ * c + XO + (SQ - Len(s$) * 8) / 2, SQ * r + YO + 22), s$
End If
Next
Color , &HFF000000
Next
If check = -4 Then
s$ = " AI is Winner!"
ElseIf check = 4 Then
s$ = " Human is Winner!"
ElseIf check = NumRows Then
s$ = " Board is full, no winner." ' keep Turn the same
End If
Locate 2, ((SW - Len(s$) * 8) / 2) / 8: Print s$
s$ = " Play again? press spacebar, any other to quit... "
Locate 4, ((SW - Len(s$) * 8) / 2) / 8: Print s$
_Display
While Len(k$) = 0
k$ = InKey$
_Limit 200
Wend
If k$ = " " Then
ReDim Grid(NCM1, NRM1), Scores(NCM1)
If GoFirst = P Then GoFirst = AI Else GoFirst = P
Turn = GoFirst: MoveNum = 0
Else
GameOn = 0
End If
End If
End Sub
Function CheckWin ' return WinX, WinY, WinD along with +/- 4, returns NumRows if grid full, 0 if no win and grid not full
Dim gridFull, r, c, s, i
gridFull = NumRows
For r = NRM1 To 0 Step -1 'bottom to top
For c = 0 To NCM1
If Grid(c, r) Then ' check if c starts a row
If c < NCM1 - 2 Then
s = 0
For i = 0 To 3 ' east
s = s + Grid(c + i, r)
Next
If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 0: CheckWin = s: Exit Function
End If
If r > 2 Then ' check if c starts a col
s = 0
For i = 0 To 3 ' north
s = s + Grid(c, r - i)
Next
If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 6: CheckWin = s: Exit Function
End If
If r > 2 And c < NCM1 - 2 Then 'check if c starts diagonal up to right
s = 0
For i = 0 To 3 ' north east
s = s + Grid(c + i, r - i)
Next
If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 7: CheckWin = s: Exit Function
End If
If r > 2 And c > 2 Then 'check if c starts a diagonal up to left
s = 0
For i = 0 To 3 ' north west
s = s + Grid(c - i, r - i)
Next
If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 5: CheckWin = s: Exit Function
End If
Else
gridFull = 0 ' at least one enpty cell left
End If 'grid is something
Next
Next
CheckWin = gridFull
End Function
Must be something wrong < 300 LOC!?!?
I threw out a challenge for an 8x8 board not proven that I could find to be anyone's certain advantage if they played perfect.
That news may be old as maths love to prove such things for all rows and cols.
b = b + ...