Scripted Tic Tac Toe - No Minimax [VB5 & VB6]
Code:
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Enum Flow
idle = -1
init = 0
xturn = 1
Oturn = 2
Play2Win1 = 3
Play2block1 = 4
Play2Win2 = 5
Play2Block2 = 6
CompWon = 7
KATZ = 8
End Enum
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal Y As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Dim RB(0 To 8) As RECT, XnO As Byte, moves(0 To 8) As Integer
Dim MoveCount As Integer, Lockout As Boolean
Dim Token As Flow, Gameon As Boolean
Dim MousePick As Integer
Dim Mask(0 To 8) As Integer, LEVEL As Integer, lScore(0 To 8) As Long
Dim wScore(0 To 8) As Single
Dim nodes As Single
Sub DrawBoard()
Dim i As Integer
For i = 0 To 8
If moves(i) > 0 Then
Me.Circle ((RB(i).Left + RB(i).Right) / 2, (RB(i).Top + RB(i).Bottom) / 2), 45
ElseIf moves(i) < 0 Then
Me.Line (RB(i).Left + 10, RB(i).Top + 10)-(RB(i).Right - 10, RB(i).Bottom - 10)
Me.Line (RB(i).Left + 10, RB(i).Bottom - 10)-(RB(i).Right - 10, RB(i).Top + 10)
End If
Next
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Unload Me
End Sub
Private Sub Form_Load()
Dim i As Integer, astr As String
initmask
With Me
.AutoRedraw = True
.Show
.DrawWidth = 2
.ScaleMode = vbPixels
.Caption = "TR's Tic Tac Toe"
.Width = .ScaleX(350, vbPixels, vbTwips)
.Height = .ScaleY(350, vbPixels, vbTwips)
.BackColor = &HFFFFFF
End With
For i = 0 To 8
RB(i).Top = (Me.ScaleHeight - 300) / 2 + Int(i / 3) * 100
RB(i).Left = (Me.ScaleWidth - 300) / 2 + (i Mod 3) * 100
RB(i).Bottom = RB(i).Top + 99
RB(i).Right = RB(i).Left + 99
Next
Token = init
Gameon = True
Gameloop
End Sub
Private Sub CLEARBOARD()
Dim i As Integer
Me.Cls
For i = 0 To 8
Rectangle Me.hdc, RB(i).Left, RB(i).Top, RB(i).Right, RB(i).Bottom
Next
For i = 0 To 8: moves(i) = 0: Next
MousePick = -1
End Sub
Private Sub form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim i As Integer
MousePick = -1
For i = 0 To 8
If PtInRect(RB(i), x, Y) And moves(i) = 0 Then
MousePick = i
End If
Next
End Sub
Private Sub Gameloop()
Dim x(0 To 8) As Integer, i As Integer, Y As Integer
Dim xOnEdge As Boolean, xOnCrnr As Boolean, TC As Integer
Do While Gameon
Select Case Token
Case init
CLEARBOARD
Token = xturn
Case xturn, Play2Win1, Play2block1
If MousePick > -1 Then
moves(MousePick) = -1
MousePick = -1
DrawBoard
Select Case Token
Case xturn
Token = Oturn
Case Play2block1
Token = Play2Block2
Case Play2Win1
Token = Play2Win2
End Select
End If
Case Oturn
If moves(4) = 0 Then
moves(4) = 1
DrawBoard
Token = Play2Win1
Else
moves(0) = 1
DrawBoard
Token = Play2block1
End If
Case Play2Block2
TC = ThreatCheck(moves)
If TC > -1 Then
moves(TC) = 1
ElseIf moves(0) = 0 Then
moves(0) = 1
ElseIf moves(2) = 0 Then
moves(2) = 1
ElseIf moves(6) = 0 Then
moves(6) = 1
ElseIf moves(8) = 0 Then
moves(8) = 1
ElseIf moves(1) = 0 Then
moves(1) = 1
ElseIf moves(3) = 0 Then
moves(3) = 1
ElseIf moves(5) = 0 Then
moves(5) = 1
ElseIf moves(7) = 0 Then
moves(7) = 1
End If
DrawBoard
If WinCheck(moves) = 1 Then
Token = CompWon
ElseIf WinCheck(moves) = -2 Then
Token = KATZ
Else
Token = Play2block1
End If
Case CompWon
If MsgBox("You Lost Sucka!!!!!!" & vbCrLf & "Play again?", _
vbYesNo) = vbYes Then
Token = init
Else
Token = idle
End If
Case KATZ
If MsgBox("Cats Game (Tie)" & vbCrLf & "Play again?", _
vbYesNo) = vbYes Then
Token = init
Else
Token = idle
End If
Case Play2Win2
TC = ThreatCheck(moves)
If TC > -1 Then
moves(TC) = 1
Else
xOnCrnr = False: xOnEdge = False
If moves(0) = -1 Or moves(2) = -1 Or moves(6) = -1 _
Or moves(8) = -1 Then xOnCrnr = True
If moves(1) = -1 Or moves(3) = -1 Or moves(5) = -1 _
Or moves(7) = -1 Then xOnEdge = True
If xOnCrnr = True And xOnEdge = False Then
If moves(1) = 0 Then
moves(1) = 1
ElseIf moves(3) = 0 Then
moves(3) = 1
ElseIf moves(5) = 0 Then
moves(5) = 1
ElseIf moves(7) = 0 Then
moves(7) = 1
End If
ElseIf xOnCrnr = True And xOnEdge = True Then
If moves(0) = -1 Then
moves(8) = 1
ElseIf moves(2) = -1 Then
moves(6) = 1
ElseIf moves(6) = -1 Then
moves(2) = 1
ElseIf moves(8) = -1 Then
moves(0) = 1
End If
ElseIf xOnCrnr = False And xOnEdge = True Then
If moves(1) = -1 And moves(5) = -1 Then
moves(2) = 1
ElseIf moves(5) = -1 And moves(7) = -1 Then
moves(8) = 1
ElseIf moves(7) = -1 And moves(3) = -1 Then
moves(6) = 1
ElseIf moves(3) = -1 And moves(1) = -1 Then
moves(0) = 1
Else
If moves(1) = 0 Then
moves(1) = 1
ElseIf moves(3) = 0 Then
moves(3) = 1
ElseIf moves(5) = 0 Then
moves(5) = 1
ElseIf moves(7) = 0 Then
moves(7) = 1
End If
End If
End If
End If
DrawBoard
If WinCheck(moves) = 1 Then
Token = CompWon
ElseIf WinCheck(moves) = -2 Then
Token = KATZ
Else
Token = Play2block1
End If
Case idle
DoEvents
End Select
DoEvents
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
Gameon = False
End Sub
Private Sub initmask()
Mask(0) = 448
Mask(1) = 56
Mask(2) = 7
Mask(3) = 292
Mask(4) = 146
Mask(5) = 73
Mask(6) = 273
Mask(7) = 84
End Sub
Private Function WinCheck(board() As Integer) As Long
Dim Omatrix As Long, Xmatrix As Long, x As Integer, Y As Integer
Dim i As Integer, J As Long, index As Integer, tmp As Long
Dim brd(0 To 8) As Integer, cats As Integer
cats = 0
For i = 0 To 8
brd(i) = board(i)
If brd(i) <> 0 Then cats = cats + 1
Next
If cats = 9 Then
WinCheck = -2
Exit Function
End If
'build matrices
Omatrix = 0
Xmatrix = 0
For i = 0 To 8
Omatrix = IIf(brd(i) = 1, 1, 0) + Omatrix * 2
Xmatrix = IIf(brd(i) = -1, 1, 0) + Xmatrix * 2
Next
For i = 0 To 7
If (Omatrix And Mask(i)) = Mask(i) Then
WinCheck = 1
Exit Function
ElseIf (Xmatrix And Mask(i)) = Mask(i) Then
WinCheck = -1
Exit Function
End If
Next
WinCheck = 0
End Function
Private Function ThreatCheck(board() As Integer) As Long
Dim Omatrix As Long, Xmatrix As Long, x As Integer, Y As Integer
Dim i As Integer, J As Long, tmp As Long
Dim brd(0 To 8) As Integer
For i = 0 To 8
brd(i) = board(i)
Next
Omatrix = 0
Xmatrix = 0
For i = 0 To 8
Omatrix = IIf(brd(i) = 1, 2 ^ (8 - i), 0) Or Omatrix
Xmatrix = IIf(brd(i) = -1, 2 ^ (8 - i), 0) Or Xmatrix
Next
For i = 0 To 7
If (Omatrix And Mask(i)) > 0 And (Xmatrix And Mask(i)) = 0 Then
tmp = (Omatrix And Mask(i))
Y = 0
For x = 0 To 8
If (tmp And (2 ^ (8 - x))) > 0 Then Y = Y + 1
If Y = 2 Then
J = (Omatrix And Mask(i)) Xor Mask(i)
ThreatCheck = 8 - (Log(J) / Log(2))
Exit Function
End If
Next
End If
Next
For i = 0 To 7
If (Xmatrix And Mask(i)) > 0 And (Omatrix And Mask(i)) = 0 Then
tmp = (Xmatrix And Mask(i))
Y = 0
For x = 0 To 8
If (tmp And (2 ^ (8 - x))) > 0 Then Y = Y + 1
If Y = 2 Then
J = (Xmatrix And Mask(i)) Xor Mask(i)
ThreatCheck = 8 - (Log(J) / Log(2))
Exit Function
End If
Next
End If
Next
ThreatCheck = -1
End Function
Re: Scripted Tic Tac Toe - No Minimax [VB5 & VB6]
Why it Works
I know minimax is a popular solution to this game strategy but to me it seems highly inefficient. It's like handing your car keys to a blind man and hoping that he gets you to the library after smashing in to 100,000 other buildings. Seems like an awful waste and in the end we learn nothing about strategy except how to brute force a solution.
Let's examine the often quoted numbers:
- 362,880 possible moves (factorial of 9 board positions)
- 125,168 practical games (somebody's going to win)
But wait, if you take this to the logical conclusions, there are only 168 possible combinations of a finished board!!! Take it one step further and there are only 7, yes 7 winning patterns.
Strategically there are only 3 types of moves:
To Quote the great philosopher Sammy Hagar "There's only one way to rock". Not 300,000.
If you study your strategy while playing, you'll find you do most of your strategizing in the first 3 moves after that you just block and attack depending on threats and opportunities. Simliar to chess where you start with common "book openings" and half way through the game you actually start thinking.
These decisions were simple to evaluate via the scripting "Token" method which I use so often.
The end game boils down to checking for an imminent threat and an imminent win. Both are accomplished in the ThreatCheck function.
How did I come to these sobering conclusions? Serendipity. I was looking for Texas hold'em poker ideas and stumbled upon this website. http://www.chessandpoker.com/tic_tac_toe_strategy.html.