Scripted Tic Tac Toe - No Minimax [VB5 & VB6]

[technorobbo]

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

[technorobbo]

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:

• Center
• Edge
• Corner

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.