Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/xreversi/xreversi.frm

Visual Basic Form | 1995-12-10 | 29.3 KB | 908 lines

VERSION 2.00
Begin Form XReversi
   BackColor       =   &H0000FF00&
   Caption         =   "Extended Reversi"
   ClientHeight    =   3960
   ClientLeft      =   1470
   ClientTop       =   1845
   ClientWidth     =   7425
   Height          =   4650
   Icon            =   XREVERSI.FRX:0000
   Left            =   1410
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   3960
   ScaleWidth      =   7425
   Top             =   1215
   Width           =   7545
   Begin CommandButton buttonHumanForfeit
      Caption         =   "Forfeit Move"
      Height          =   495
      Left            =   5760
      TabIndex        =   7
      Top             =   2160
      Width           =   1215
   End
   Begin CommandButton buttonComputerMove
      Caption         =   "Make Move"
      Height          =   495
      Left            =   4200
      TabIndex        =   6
      Top             =   2160
      Width           =   1215
   End
   Begin PictureBox MoveMsg
      BackColor       =   &H00FFFF00&
      Height          =   975
      Left            =   3960
      ScaleHeight     =   945
      ScaleWidth      =   3225
      TabIndex        =   8
      Top             =   960
      Width           =   3255
   End
   Begin PictureBox Board
      BackColor       =   &H000000FF&
      Height          =   3680
      Left            =   120
      MousePointer    =   2  'Cross
      ScaleHeight     =   3645
      ScaleWidth      =   3645
      TabIndex        =   0
      Top             =   120
      Width           =   3680
   End
   Begin Label HumanScore
      BorderStyle     =   1  'Fixed Single
      Caption         =   "   0"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   24
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   615
      Left            =   5760
      TabIndex        =   1
      Top             =   3120
      Width           =   1215
   End
   Begin Label ComputerScore
      BorderStyle     =   1  'Fixed Single
      Caption         =   "   0"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   24
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   615
      Left            =   4200
      TabIndex        =   2
      Top             =   3120
      Width           =   1215
   End
   Begin Label Label2
      BackColor       =   &H0000FF00&
      Caption         =   "Human"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   5880
      TabIndex        =   5
      Top             =   2760
      Width           =   855
   End
   Begin Label Label1
      BackColor       =   &H0000FF00&
      Caption         =   "Computer"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   4200
      TabIndex        =   4
      Top             =   2760
      Width           =   1215
   End
   Begin Label FeedbackMsg
      BackColor       =   &H0000FFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   " "
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   615
      Left            =   3960
      TabIndex        =   3
      Top             =   120
      Width           =   3255
   End
   Begin Menu menuGame
      Caption         =   "&Game"
      Begin Menu menubarNewGame
         Caption         =   "&New Game"
      End
      Begin Menu menusepG1
         Caption         =   "-"
      End
      Begin Menu menubarModern
         Caption         =   "&Modern Opening"
      End
      Begin Menu menubarRandom
         Caption         =   "&Random Opening"
      End
      Begin Menu menusepG2
         Caption         =   "-"
      End
      Begin Menu menubar8x8
         Caption         =   "&8 x 8 Board"
      End
      Begin Menu menubar10x10
         Caption         =   "&10 x 10 Boad"
      End
      Begin Menu menubar16x16
         Caption         =   "1&6 x 16 Board"
      End
      Begin Menu menubar20x20
         Caption         =   "&20 x 20 Board"
      End
      Begin Menu menusepG3
         Caption         =   "-"
      End
      Begin Menu menubarQuit
         Caption         =   "&Quit"
      End
   End
   Begin Menu menuOptions
      Caption         =   "&Options"
      Begin Menu menubarWhite
         Caption         =   "&White for Human"
      End
      Begin Menu menubarBlack
         Caption         =   "&Black for Human"
      End
      Begin Menu menusepO1
         Caption         =   "-"
      End
      Begin Menu menubarHuman
         Caption         =   "&Human 1st"
      End
      Begin Menu menubarComputer
         Caption         =   "&Computer 1st"
      End
   End
   Begin Menu menuSkill
      Caption         =   "&Skill"
      Begin Menu menubarSkill
         Caption         =   "&Expert Computer"
         Index           =   0
      End
      Begin Menu menubarSkill
         Caption         =   "&Good Computer"
         Index           =   1
      End
      Begin Menu menubarSkill
         Caption         =   "&Fair Computer"
         Index           =   2
      End
      Begin Menu menubarSkill
         Caption         =   "&Poor Computer"
         Index           =   3
      End
      Begin Menu menubarSkill
         Caption         =   "&Idiot Computer"
         Index           =   4
      End
   End
DefStr A-Z  ' Force numeric variables to be declared
Dim CRLF$   ' CarriageReturn/LineFeed pair
Dim CurrPlayer As Integer, ModernOpening As Integer  ' Boolean
Dim MoveNoise As Integer
Dim BoardGrid() As String * 1, BoardPc(HUMAN To COMPUTER) As String * 1
Dim DescPc(HUMAN To COMPUTER) As String
Dim Score(HUMAN To COMPUTER) As Integer
Dim TurnNbr As Integer, NbrPcs As Integer
Dim ForfeitCount As Integer
Dim GameOver As Integer  ' Boolean
Dim MaxRC As Integer, MaxIJ As Integer, MidRC As Integer
Dim MaxPcs As Integer
' Raw position values
Dim Rating(MIN_RC To MAX_RATING_RC, MIN_RC To MAX_RATING_RC) As Long
' Multiplier for # turned pieces in line opposite empty square
Dim XEmpty(MIN_RC To MAX_RATING_RC, MIN_RC To MAX_RATING_RC) As Long
' "Neutralize" (neither + nor -) # turned pieces opposite border
Dim XBorder(MIN_RC To MAX_RATING_RC, MIN_RC To MAX_RATING_RC) As Long
' Multiplier for # turned pieces opposite opponent's piece
Dim XOpponent(MIN_RC To MAX_RATING_RC, MIN_RC To MAX_RATING_RC) As Long
' Translation of radial direction value into X and Y coordinate increments
Dim RowIncr(MIN_DIR To MAX_DIR) As Integer
Dim ColIncr(MIN_DIR To MAX_DIR) As Integer
' Adjust scores and total pieces after a move
Sub AdjustScores (ByVal P%, ByVal N%)
    SetScore P%, (Score(P%) + N% + 1)  ' Include new piece
    SetScore (Not P%), (Score(Not P%) - N%)
    NbrPcs = Score(HUMAN) + Score(COMPUTER)
End Sub
' Trigger Human's move on "MouseUp" instead of "Click" to get X & Y
Sub Board_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim cs As Single
    Dim r%, c%
    cs = CellSize()
    r% = 1 + Int(y / cs)
    c% = 1 + Int(x / cs)
    MoveForHuman r%, c%
End Sub
Sub Board_Paint ()
    ShowGrid
    ShowPcs
End Sub
Sub buttonComputerMove_Click ()
    MoveForComputer
End Sub
Sub buttonHumanForfeit_Click ()
If GameOver Then
        Feedback "Game Already Over" + CRLF$ + " Select Game, New Game"
        Exit Sub
    End If
    If CurrPlayer = COMPUTER Then
        Feedback "Click 'Make Move'" + CRLF$ + " for Computer's Move"
        Exit Sub
    ElseIf ForfeitAllowed() Then
        Feedback ""
        ForfeitCount = ForfeitCount + 1
        CurrPlayer = COMPUTER
        MoveMsg_Paint
        CheckGameOver
    Else
        Feedback "You have a valid move"
    End If
End Sub
Function CellSize () As Single
    CellSize = Board.Height / ((MaxRC - MIN_RC) + 1)
End Function
' See if game termination conditions have been met
Sub CheckGameOver ()
    Dim WhyDone As String, Winner As String
    Dim reply%
    If GameOver Then
        Feedback "(Game already over)"
        Exit Sub
    End If
    If ForfeitCount >= 2 Then
        GameOver = True
        WhyDone = "Double Forfeit"
    End If
    If NbrPcs = MaxPcs Then
        GameOver = True
        WhyDone = "Board Full"
    End If
    If GameOver Then
        If Score(HUMAN) > Score(COMPUTER) Then
            Winner = "You Won!"
            CurrPlayer = COMPUTER  ' Setup 1st player for next game
        ElseIf Score(COMPUTER) > Score(HUMAN) Then
            Winner = "The Computer is the Winner"
            CurrPlayer = HUMAN
        Else
            Winner = "Tie Game"
        End If
        reply% = MsgBox(Winner, (mb_OK + mb_IconInformation), WhyDone)
        Feedback "Game Over"
        MoveMsg_Paint
    End If
End Sub
' Simulate a random outcome of Reversi's original player opening protocol
Sub DoRandomOpening ()
    Dim m As Integer
    Dim p1$, p2$
    If Rnd > .5 Then
        p1$ = WHITE_PC
        p2$ = BLACK_PC
    Else
        p1$ = BLACK_PC
        p2$ = WHITE_PC
    End If
    m = MidRC
    BoardGrid(m, m) = p1$
    If Rnd > .5 Then
        BoardGrid(m, m + 1) = p1$
        BoardGrid(m + 1, m) = p2$
        BoardGrid(m + 1, m + 1) = p2$
    Else
        BoardGrid(m, m + 1) = p2$
        If Rnd > .5 Then
            BoardGrid(m + 1, m) = p1$
            BoardGrid(m + 1, m + 1) = p2$
        Else
            BoardGrid(m + 1, m) = p2$
            BoardGrid(m + 1, m + 1) = p1$
        End If
    End If
End Sub
Sub DrawPc (ByVal pc$, ByVal r%, ByVal c%)
    Dim x As Single, y As Single
    Dim cs As Single, hc As Single, cr As Single
    Dim color As Long
    Select Case pc$
    Case BLACK_PC
        color = COLOR_BLACK
    Case WHITE_PC
        color = COLOR_WHITE
    Case Else
        Exit Sub
    End Select
    cs = CellSize()
    hc = cs * .5
    cr = hc * .9
    x = ((c% - MIN_RC) * cs) + hc
    y = ((r% - MIN_RC) * cs) + hc
    Board.FillStyle = SOLID
    Board.FillColor = color
    Board.Circle (x, y), cr, color
End Sub
' Display a feedback message to the user
Sub Feedback (ByVal s$)
    FeedbackMsg.Caption = "  " + s$
    If s$ = "" Then
        FeedbackMsg.Visible = False
    Else
        FeedbackMsg.Visible = True
        Beep
    End If
End Sub
' See if the current player must forfeit
Function ForfeitAllowed () As Integer  ' Boolean
    Dim ok%, r%, c%, v&
    ok% = True
    ''Debug.Print "Forfeit?"
    For r% = MIN_RC To MaxRC
        For c% = MIN_RC To MaxRC
            v& = MoveValue(r%, c%, False)
            ''Debug.Print " "; v&;
            If v& > INVALID_MOVE Then ok% = False
        Next c%
        ''Debug.Print
    Next r%
    ForfeitAllowed = ok%
End Function
' For debugging, a Click on the form background repaints key controls
Sub Form_Click ()
    Board_Paint
    MoveMsg_Paint
End Sub
' Initialize the program upon startup
Sub Form_Load ()
    CRLF$ = Chr$(13) + Chr$(10)
    Randomize
    MaxRC = MIN_RC  ' No board exists
    ' Setup the special arrays used to evaluate board positions for
    ' Computer moves.
    ' Note that XReversi plays on a par with Microsoft's Reversi (as "Expert")
    ' but WITHOUT using move lookahead.  XReversi plays by POSITION only!
    ' Raw position values
    ' ((999, -20,+15,+15),
    Rating(MIN_RC + 0, MIN_RC + 0) = 999
    Rating(MIN_RC + 1, MIN_RC + 0) = -20
    Rating(MIN_RC + 2, MIN_RC + 0) = 15
    Rating(MIN_RC + 3, MIN_RC + 0) = 15
    '  (-20,-333,-20,-20),
    Rating(MIN_RC + 0, MIN_RC + 1) = -20
    Rating(MIN_RC + 1, MIN_RC + 1) = -333
    Rating(MIN_RC + 2, MIN_RC + 1) = -20
    Rating(MIN_RC + 3, MIN_RC + 1) = -20
    '  (+15, -20, +6,  0),
    Rating(MIN_RC + 0, MIN_RC + 2) = 15
    Rating(MIN_RC + 1, MIN_RC + 2) = -20
    Rating(MIN_RC + 2, MIN_RC + 2) = 6
    Rating(MIN_RC + 3, MIN_RC + 2) = 0
    '  (+15, -20,  0,  0));
    Rating(MIN_RC + 0, MIN_RC + 3) = 15
    Rating(MIN_RC + 1, MIN_RC + 3) = -20
    Rating(MIN_RC + 2, MIN_RC + 3) = 0
    Rating(MIN_RC + 3, MIN_RC + 3) = 0
    ' Multiplier for # turned pieces in line opposite an empty square
    ' (Used to favor "unflankable" move directionss over raw piece count.)
    ' ((+3, +3, +3, +3),
    XEmpty(MIN_RC + 0, MIN_RC + 0) = 3
    XEmpty(MIN_RC + 1, MIN_RC + 0) = 3
    XEmpty(MIN_RC + 2, MIN_RC + 0) = 3
    XEmpty(MIN_RC + 3, MIN_RC + 0) = 3
    '  (+3, +1, +3, +3),
    XEmpty(MIN_RC + 0, MIN_RC + 1) = 3
    XEmpty(MIN_RC + 1, MIN_RC + 1) = 1
    XEmpty(MIN_RC + 2, MIN_RC + 1) = 3
    XEmpty(MIN_RC + 3, MIN_RC + 1) = 3
    '  (+3, +3, +3, +3),
    XEmpty(MIN_RC + 0, MIN_RC + 2) = 3
    XEmpty(MIN_RC + 1, MIN_RC + 2) = 3
    XEmpty(MIN_RC + 2, MIN_RC + 2) = 3
    XEmpty(MIN_RC + 3, MIN_RC + 2) = 3
    '  (+3, +3, +3, +3));
    XEmpty(MIN_RC + 0, MIN_RC + 3) = 3
    XEmpty(MIN_RC + 1, MIN_RC + 3) = 3
    XEmpty(MIN_RC + 2, MIN_RC + 3) = 3
    XEmpty(MIN_RC + 3, MIN_RC + 3) = 3
    ' Multiplier for # turned pieces opposite opponent's piece
    ' (Prevents creating a line of our pieces, just to be re-flanked
    '  by the opponent.  Works by creating negative value in this
    '  direction.  Note, however, that if we land between two opponent
    '  pieces, the two negatives multiple to positive;  this yields
    '  XReversi's powerful "divide and conquer" behavior!)
    ' ((  0,-40,-30,-30),
    XOpponent(MIN_RC + 0, MIN_RC + 0) = 0
    XOpponent(MIN_RC + 1, MIN_RC + 0) = -40
    XOpponent(MIN_RC + 2, MIN_RC + 0) = -30
    XOpponent(MIN_RC + 3, MIN_RC + 0) = -30
    '  (-40, -9, -5, -5),
    XOpponent(MIN_RC + 0, MIN_RC + 1) = -40
    XOpponent(MIN_RC + 1, MIN_RC + 1) = -9
    XOpponent(MIN_RC + 2, MIN_RC + 1) = -5
    XOpponent(MIN_RC + 3, MIN_RC + 1) = -5
    '  (-30, -5, -3, -3),
    XOpponent(MIN_RC + 0, MIN_RC + 2) = -30
    XOpponent(MIN_RC + 1, MIN_RC + 2) = -5
    XOpponent(MIN_RC + 2, MIN_RC + 2) = -3
    XOpponent(MIN_RC + 3, MIN_RC + 2) = -3
    '  (-30, -5, -3, -3));
    XOpponent(MIN_RC + 0, MIN_RC + 3) = -30
    XOpponent(MIN_RC + 1, MIN_RC + 3) = -5
    XOpponent(MIN_RC + 2, MIN_RC + 3) = -3
    XOpponent(MIN_RC + 3, MIN_RC + 3) = -3
    ' "Neutralize" (neither + nor -) # turned pieces opposite border
    ' (Causes harmless opponents near border to be ignored.)
    For i% = MIN_RC To MAX_RATING_RC
        For j% = MIN_RC To MAX_RATING_RC
            XBorder(i%, j%) = 0
        Next j%
    Next i%
    ' ( 0, -1, -1, -1,  0, +1, +1, +1);
    RowIncr(MIN_DIR + 0) = 0
    RowIncr(MIN_DIR + 1) = -1
    RowIncr(MIN_DIR + 2) = -1
    RowIncr(MIN_DIR + 3) = -1
    RowIncr(MIN_DIR + 4) = 0
    RowIncr(MIN_DIR + 5) = 1
    RowIncr(MIN_DIR + 6) = 1
    RowIncr(MIN_DIR + 7) = 1
    ' (+1, +1,  0, -1, -1, -1,  0, +1);
    ColIncr(MIN_DIR + 0) = 1
    ColIncr(MIN_DIR + 1) = 1
    ColIncr(MIN_DIR + 2) = 0
    ColIncr(MIN_DIR + 3) = -1
    ColIncr(MIN_DIR + 4) = -1
    ColIncr(MIN_DIR + 5) = -1
    ColIncr(MIN_DIR + 6) = 0
    ColIncr(MIN_DIR + 7) = 1
    ' Now setup for the first game
    Feedback ""
    SetHumanPc WHITE_PC
    SetFirstPlayer HUMAN
    SetModernOpening True
    SetSkill MIN_SKILL
    SetBoardSize 8  ' Will, in turn, call InitializeBoard
End Sub
' Fold general board coordinates into upper-left corner of 8x8 board
Function HalfRC (ByVal RC%) As Integer
    If (RC% <= MAX_RATING_RC) Then
        HalfRC = RC%
    ElseIf (RC% >= (1 + (MaxRC - MAX_RATING_RC))) Then
        HalfRC = 1 + (MaxRC - RC%)
    Else
        HalfRC = MAX_RATING_RC
    End If
End Function
' Set up the board (of arbritrary size) for a new game
Sub InitializeBoard (ByVal Size%)
    Dim i%, j%
    Feedback ""
    MaxRC = Size%
    MidRC = MaxRC \ 2
    MaxIJ = MaxRC + 1
    MaxPcs = MaxRC * MaxRC
    ReDim BoardGrid(MIN_IJ To MaxIJ, MIN_IJ To MaxIJ)  As String
    For i% = MIN_IJ To MaxIJ
        For j% = MIN_IJ To MaxIJ
            BoardGrid(i%, j%) = BORDER
        Next j%
    Next i%
    For i% = MIN_RC To MaxRC
        For j% = MIN_RC To MaxRC
            BoardGrid(i%, j%) = EMPTY
        Next j%
    Next i%
    If ModernOpening Then  ' Modern Othello opening
        BoardGrid(MidRC + 0, MidRC + 0) = BLACK_PC
        BoardGrid(MidRC + 1, MidRC + 1) = BLACK_PC
        BoardGrid(MidRC + 0, MidRC + 1) = WHITE_PC
        BoardGrid(MidRC + 1, MidRC + 0) = WHITE_PC
    Else  ' Original Reversi had special opening player "protocol",
          ' simply choose a random outcome from this opening
        DoRandomOpening
    End If
    SetScore HUMAN, 2
    SetScore COMPUTER, 2
    ForfeitCount = 0
    TurnNbr = 1
    GameOver = False
    MoveMsg_Paint
    Board_Paint
End Sub
Sub menubar10x10_Click ()
    SetBoardSize 10
End Sub
Sub menubar16x16_Click ()
    SetBoardSize 16
End Sub
Sub menubar20x20_Click ()
    SetBoardSize 20
End Sub
Sub menubar8x8_Click ()
    SetBoardSize 8
End Sub
Sub menubarBlack_Click ()
    SetHumanPc BLACK_PC
End Sub
Sub menubarComputer_Click ()
    SetFirstPlayer COMPUTER
End Sub
Sub menubarHuman_Click ()
    SetFirstPlayer HUMAN
End Sub
Sub menubarModern_Click ()
    SetModernOpening True
End Sub
Sub menubarNewGame_Click ()
    InitializeBoard MaxRC
End Sub
Sub menubarQuit_Click ()
    End
End Sub
Sub menubarRandom_Click ()
    SetModernOpening False
End Sub
Sub menubarSkill_Click (Index As Integer)
    SetSkill (Index)
End Sub
Sub menubarWhite_Click ()
    SetHumanPc WHITE_PC
End Sub
Sub menuGame_Click ()
    Dim e%
    e% = (GameOver) Or (TurnNbr = 1)  ' See if a game is in progress
    menubarModern.Enabled = e%
    menubarRandom.Enabled = e%
    menubar8x8.Enabled = e%
    menubar10x10.Enabled = e%
    menubar16x16.Enabled = e%
    menubar20x20.Enabled = e%
End Sub
Sub menuOptions_Click ()
    Dim e%
    e% = (GameOver) Or (TurnNbr = 1)  ' See if a game is in progress
    menubarHuman.Enabled = e%
    menubarComputer.Enabled = e%
End Sub
Sub MoveForComputer ()
    Dim r%, c%, value%, found%
    If GameOver Then
        Feedback "Game Already Over" + CRLF$ + " Select Game, New Game"
        Exit Sub
    End If
    If CurrPlayer = HUMAN Then
        Feedback "It's your turn"
        Exit Sub
    End If
    best% = MIN_INTEGER
    found% = False
    For r% = MIN_RC To MaxRC
        For c% = MIN_RC To MaxRC
            If BoardGrid(r%, c%) = EMPTY Then
                value% = MoveValue(r%, c%, False)  ' Don't actually move
                If value% > INVALID_MOVE Then
                    value% = value% + Int(Rnd * MoveNoise)
                    If (value% > best%) Or ((value% = best%) And (Rnd > .5)) Then
                        best% = value%
                        br% = r%
                        bc% = c%
                        found% = True
                    End If
                End If
            End If
        Next c%
    Next r%
    If found% Then
        Feedback ""
        value% = MoveValue(br%, bc%, True)  ' Actually make the move
        BoardGrid(br%, bc%) = BoardPc(COMPUTER)
        DrawPc BoardPc(COMPUTER), br%, bc%
    Else
        Feedback "Computer forfeits!" + CRLF$ + " Move again"
        ForfeitCount = ForfeitCount + 1
    End If
    CurrPlayer = HUMAN
    MoveMsg_Paint
    CheckGameOver
End Sub
Sub MoveForHuman (ByVal Row%, ByVal Col%)
    Dim N%
    If GameOver Then
        Feedback "Game Already Over" + CRLF$ + " Select Game, New Game"
        Exit Sub
    End If
    If CurrPlayer = COMPUTER Then
        Feedback "Click 'Make Move'" + CRLF$ + " for Computer's Move"
        Exit Sub
    End If
    If ForfeitAllowed() Then
        Feedback "Forfeit!" + CRLF$ + " You have no legal move"
        ForfeitCount = ForfeitCount + 1
        CurrPlayer = COMPUTER
        MoveMsg_Paint
        CheckGameOver
        Exit Sub
    End If
    If MoveValue(Row%, Col%, False) = INVALID_MOVE Then
        Feedback "Invalid move!" + CRLF$ + " Try another square"
        Exit Sub
    End If
    Feedback ""
    N% = MoveValue(Row%, Col%, True)
    BoardGrid(Row%, Col%) = BoardPc(HUMAN)
    DrawPc BoardPc(HUMAN), Row%, Col%
    CurrPlayer = COMPUTER
    MoveMsg_Paint
    CheckGameOver
    If GameOver Then Exit Sub
    If ForfeitAllowed() Then
        Feedback "Computer forfeits!" + CRLF$ + " Move again"
        ForfeitCount = ForfeitCount + 1
        CurrPlayer = HUMAN
        MoveMsg_Paint
        CheckGameOver
    End If
End Sub
Sub MoveMsg_Paint ()
    MoveMsg.Cls
    If GameOver Then
        MoveMsg.Print
        MoveMsg.Print
        MoveMsg.Print " Score Difference = "; Abs(Score(HUMAN) - Score(COMPUTER))
        Exit Sub
    End If
    MoveMsg.Print "Turn # "; TurnNbr
    MoveMsg.Print
    If CurrPlayer = HUMAN Then
        MoveMsg.Print " Your move for "; DescPc(HUMAN)
        MoveMsg.Print " (point and click on desired square)"
    Else
        MoveMsg.Print " Computer's move for "; DescPc(COMPUTER)
        MoveMsg.Print " (click 'Make Move' button)"
    End If
End Sub
' Calculate the legality and value of a given square
' Also used to make actual moves if "MakingMove" is TRUE
' This is the "nerve center" of XReversi's Computer player
' The square evaluation algorithm was designed/written by Rick Rutt in 1984
Function MoveValue (ByVal Row%, ByVal Col%, ByVal MakingMove%) As Long
    Static DirScore(MIN_DIR To MAX_DIR) As Integer
    Dim ok%, i%, j%, ii%, jj%, d%, temp%, pvalue%
    ' First, see if the current square touches an opponent
    ok% = False
    If BoardGrid(Row%, Col%) = EMPTY Then
        For ii% = -1 To 1
            For jj% = -1 To 1
                If BoardGrid(Row% + ii%, Col% + jj%) = BoardPc(Not CurrPlayer) Then
                    ok% = True
                End If
            Next jj%
        Next ii%
    End If
    If Not ok% Then
        MoveValue = INVALID_MOVE
    Else
        ' Next, see if any pieces will be reversed; also assign a value
        reversed% = 0
        For d% = MIN_DIR To MAX_DIR  ' Examine all neighboring squares
            ii% = RowIncr(d%)
            jj% = ColIncr(d%)
            i% = Row% + ii%
            j% = Col% + jj%
            temp% = 0
            Select Case BoardGrid(i%, j%)
            Case EMPTY
                DirScore(d%) = XEmpty(HalfRC(Row%), HalfRC(Col%))
            Case BORDER
                DirScore(d%) = XBorder(HalfRC(Row%), HalfRC(Col%))
            Case BoardPc(CurrPlayer)
                ' No pieces to reverse, but see if we put "friends" at risk
                ' if we bump up against an opponent on the opposite side
                Do
                    i% = i% + ii%
                    j% = j% + jj%
                Loop Until BoardGrid(i%, j%) <> BoardPc(CurrPlayer)
                Select Case BoardGrid(i%, j%)  ' What is beyond our friends
                Case EMPTY
                    DirScore(d%) = XEmpty(HalfRC(Row%), HalfRC(Col%))
                Case BORDER
                    DirScore(d%) = XBorder(HalfRC(Row%), HalfRC(Col%))
                Case Else
                    DirScore(d%) = XOpponent(HalfRC(Row%), HalfRC(Col%))
                End Select
            Case BoardPc(Not CurrPlayer)
                ' Scan down a line of opponents, to see what is past them
                Do
                    temp% = temp% + 1
                    i% = i% + ii%
                    j% = j% + jj%
                Loop Until BoardGrid(i%, j%) <> BoardPc(Not CurrPlayer)
                Select Case BoardGrid(i%, j%)
                Case EMPTY, BORDER
                    DirScore(d%) = XOpponent(HalfRC(Row%), HalfRC(Col%))
                Case Else  ' Current Player, we have a legal flanking move
                    reversed% = reversed% + temp%
                    Do  ' Find what is beyond the flanking "friend"
                        i% = i% + ii%
                        j% = j% + jj%
                    Loop Until BoardGrid(i%, j%) <> BoardPc(CurrPlayer)
                    Select Case BoardGrid(i%, j%)
                    Case EMPTY
                        DirScore(d%) = XEmpty(HalfRC(Row%), HalfRC(Col%))
                    Case BORDER
                        DirScore(d%) = XBorder(HalfRC(Row%), HalfRC(Col%))
                    Case Else
                        DirScore(d%) = XOpponent(HalfRC(Row%), HalfRC(Col%))
                    End Select
                    If MakingMove% Then  ' Actually reverse the pieces
                        i% = Row% + ii%
                        j% = Col% + jj%
                        Do While BoardGrid(i%, j%) = BoardPc(Not CurrPlayer)
                            BoardGrid(i%, j%) = BoardPc(CurrPlayer)
                            DrawPc BoardPc(CurrPlayer), i%, j%
                            i% = i% + ii%
                            j% = j% + jj%
                        Loop
                    End If
                End Select
            End Select
        Next d%
        If MakingMove Then
            AdjustScores CurrPlayer, reversed%
            ForfeitCount = 0
            TurnNbr = TurnNbr + 1
        End If
        If reversed% = 0 Then
            MoveValue = INVALID_MOVE
        Else
            pvalue% = 0
            For d% = MIN_DIR To MID_DIR
                pvalue% = pvalue% + (DirScore(d%) * DirScore(d% + MID_DIR))
            Next d%
            ' Add up all "components" of the square's value
            MoveValue = reversed% + pvalue% + Rating(HalfRC(Row%), HalfRC(Col%))
        End If
    End If
End Function
Sub SetBoardSize (ByVal Size%)
    menubar8x8.Checked = False
    menubar10x10.Checked = False
    menubar16x16.Checked = False
    menubar20x20.Checked = False
    Select Case Size%
    Case 8
        menubar8x8.Checked = True
    Case 10
        menubar10x10.Checked = True
    Case 16
        menubar16x16.Checked = True
    Case 20
        menubar20x20.Checked = True
    End Select
    If (MaxRC <> Size%) Then InitializeBoard Size%
End Sub
Sub SetFirstPlayer (ByVal P%)
    If P% = HUMAN Then
        menubarHuman.Checked = True
        menubarComputer.Checked = False
    Else
        menubarHuman.Checked = False
        menubarComputer.Checked = True
    End If
    CurrPlayer = P%
    MoveMsg_Paint
End Sub
Sub SetHumanPc (ByVal P$)
    Dim s1%, s2%
    If P$ = BoardPc(HUMAN) Then  ' No change
        Exit Sub
    Else
        CurrPlayer = Not CurrPlayer  ' Trade places, even in mid-game
        s1% = Score(HUMAN)
        s2% = Score(COMPUTER)
        SetScore HUMAN, s2%
        SetScore COMPUTER, s1%
    End If
    If P$ = BLACK_PC Then
        menubarBlack.Checked = True
        menubarWhite.Checked = False
        BoardPc(HUMAN) = BLACK_PC
        BoardPc(COMPUTER) = WHITE_PC

        DescPc(HUMAN) = "Black"
        DescPc(COMPUTER) = "White"
    Else
        menubarBlack.Checked = False
        menubarWhite.Checked = True
        BoardPc(HUMAN) = WHITE_PC
        BoardPc(COMPUTER) = BLACK_PC
        DescPc(HUMAN) = "White"
        DescPc(COMPUTER) = "Black"
    End If
    If TurnNbr = 1 Then
        SetFirstPlayer CurrPlayer
    End If
    MoveMsg_Paint
End Sub
Sub SetModernOpening (ByVal Modern%)
    If Modern% Then
        menubarModern.Checked = True
        menubarRandom.Checked = False
    Else
        menubarModern.Checked = False
        menubarRandom.Checked = True
    End If
    ModernOpening = Modern%
    InitializeBoard MaxRC
End Sub
' Set a given player's score, and make related adjustments
Sub SetScore (ByVal P%, ByVal s%)
    Score(P%) = s%
    NbrPcs = Score(HUMAN) + Score(COMPUTER)
    If P% = HUMAN Then
        HumanScore.Caption = Format$(s%, " ##0")
    Else
        ComputerScore.Caption = Format$(s%, " ##0")
    End If
End Sub
Sub SetSkill (ByVal Idx%)
    Dim i%
    For i% = MIN_SKILL To MAX_SKILL
        menubarSkill(i%).Checked = False
    Next i%
    menubarSkill(Idx%).Checked = True
    MoveNoise = NOISE_GAIN * Idx%
End Sub
' Draw grid lines on the board area
Sub ShowGrid ()
    Dim cs As Single
    Dim x As Single
    Dim i%
    Board.Cls
    cs = CellSize()
    For i% = 1 To (MaxRC - 1)
        x = i% * cs
        Board.Line (x, 0)-(x, Board.Height)
        Board.Line (0, x)-(Board.Width, x)
    Next i%
End Sub
' Refresh all pieces in the board area
Sub ShowPcs ()
    Dim i%, j%, pc$
    For i% = MIN_RC To MaxRC
        For j% = MIN_RC To MaxRC
            pc$ = BoardGrid(i%, j%)
            DrawPc pc$, i%, j%
        Next j%
    Next i%
End Sub