'Code in VB 3.0 for the BHS Kala Game
'General Declarations
Option Explicit
Dim X As Integer             ' Loop variable
Dim NumberBeads As Integer   ' Number of Beads in each cell at start
Dim K(13) As Integer         ' Kala Array holding # beads in each cell
                             ' K(0) player B's home base
                             ' K(7) player A's home base
                             ' K(1) to K(6) player A's side
                             ' K(8) to K(13) player B's side
Dim PlayerFlag As String     ' Flag to determine whos move
Dim Player As String         ' Player selected to go first
Dim P As Integer             ' P is used to mark the K() array index
Dim S As Integer             ' S represent the number of beads to move
Dim PK As Integer            ' KP represents where we are to put beads
Dim OverFlag As Integer      ' Game Over Flag, 0 if game is over

Sub AdjustA ()
K(P) = 0   'We just picked up the beads in that cell...none left now
' Now calculate where to put the kala beads
For X = 1 To S
PK = (P + X) - Int((P + X) / 14) * 14
If PK = 0 Then
    PK = 1
    P = P + 1
End If
K(PK) = K(PK) + 1
Next X
If PK = 7 Then
    GoTo 5
End If
' Now check to see if we have a capture, if so ...capture
If K(PK) = 1 And PK < 7 And K(14 - PK) <> 0 Then
    K(PK) = 0
    K(7) = K(7) + 1 + K(14 - PK)
    K(14 - PK) = 0
End If
' Check for Game Over   See if player A's side is empty
5 OverFlag = 0 'Initialise OverFlag to 0  i.e, game over
For X = 1 To 6
    If K(X) <> 0 Then ' game not over
        OverFlag = 1
    End If
Next X
If OverFlag = 0 Then 'Game is over
    'Collect the rest of B's beads
    For X = 8 To 13
    K(7) = K(7) + K(X)
    K(X) = 0
    Next X
PlayerFlag = Player
GameOver ' Game Over  Adjust Grid and Show score
    GoTo 2
End If
OverFlag = 0
' Check for Game Over   See if player B's side is empty
For X = 8 To 13
    If K(X) <> 0 Then ' game not over
        OverFlag = 1
    End If
Next X
If OverFlag = 0 Then 'Game is over
    'Collect the rest of A's beads
    For X = 1 To 6
    K(0) = K(0) + K(X)
    K(X) = 0
    Next X
GameOver ' Game Over  Adjust Grid and Show score
    GoTo 2
End If
'If Game not over, see if A gets another turn
If OverFlag = 1 And PK = 7 Then
    AdjustGrid
    GoTo 2
End If
PlayerFlag = "B"
txtPlayer.Text = "Player B's turn!"
txtPlayer.BackColor = &H80FFFF
2 End Sub

Sub AdjustB ()
K(P) = 0
For X = 1 To S
PK = (P + X) - Int((P + X) / 14) * 14
If PK = 7 Then
    PK = 8
    P = P + 1
End If
K(PK) = K(PK) + 1
Next X
If PK = 0 Then
    GoTo 4
End If
If K(PK) = 1 And PK > 7 And K(14 - PK) <> 0 Then
    K(PK) = 0
    K(0) = K(0) + 1 + K(14 - PK)
    K(14 - PK) = 0
End If
4 OverFlag = 0
For X = 8 To 13
    If K(X) <> 0 Then
        OverFlag = 1
    End If
Next X
If OverFlag = 0 Then
    For X = 1 To 6
    K(0) = K(0) + K(X)
    K(X) = 0
    Next X
PlayerFlag = Player
GameOver
GoTo 3
End If
AdjustGrid
' See if B gets another turn
If OverFlag = 1 And PK = 0 Then
    AdjustGrid
    GoTo 3
End If
PlayerFlag = "A"
txtPlayer.Text = "Player A's turn!"
txtPlayer.BackColor = &H80FF80
3 End Sub

Sub AdjustGrid ()
grdKala.Row = 1
For X = 0 To 5
grdKala.Col = X
grdKala.Text = K(X + 1)
Next X
txtA.Text = K(7)
txtB.Text = K(0)
grdKala.Row = 0
For X = 5 To 0 Step -1
grdKala.Col = X
grdKala.Text = K(-X + 13)
Next X

Sub GameOver ()
AdjustGrid
txtPlayer.BackColor = &HFFFFFF
If K(7) > K(0) Then
    txtPlayer.Text = "Player A wins by  " & Abs(K(7) - K(0)) & "  beads!"
    txtPlayer.BackColor = &H80FF80
ElseIf K(0) > K(7) Then
    txtPlayer.Text = "Player B wins by  " & Abs(K(7) - K(0)) & "  beads!"
    txtPlayer.BackColor = &H80FFFF
Else
    txtPlayer.Text = "It's a tie!"
    txtPlayer.BackColor = &HFFFFFF
End If
Player = PlayerFlag
End Sub

Sub Illegal ()
MsgBox "Sorry...Illegal Move!"
End Sub

Sub Form_Load ()
OverFlag = 0
NumberBeads = 3
Player = "A"
PlayerFlag = "A"
txtPlayer.Text = "Player A's turn!"
txtPlayer.BackColor = &H80FF80
grdKala.Width = 520 * 6
grdKala.Height = 2 * 530
For X = 0 To 5
    grdKala.ColWidth(X) = 500
Next X
For X = 0 To 1
    grdKala.RowHeight(X) = 500
Next X
mnuNewGame_Click
End Sub

Sub grdKala_Click ()
txtPlayer.Text = "Player " & PlayerFlag & "'s turn!"
' Check to see if legal move with respect to whose turn it is
If grdKala.Row = 1 And PlayerFlag <> "A" Then
    Illegal
    GoTo 1
End If
If grdKala.Row = 0 And PlayerFlag <> "B" Then
    Illegal
    GoTo 1
End If
' Convert the cell picked to the appropriate K() array index.
' Use the variable P
If grdKala.Row = 1 Then
    P = grdKala.Col + 1
Else
    P = -1 * grdKala.Col + 13
End If
'Check to see if the cell picked is legal with respect to
'whether it has anything in it
If K(P) = 0 Then
    Illegal
    GoTo 1
End If
' Assign S a value.  S will represent the number of beads to move
S = K(P)
' Adjust the array now.
If PlayerFlag = "A" Then
    AdjustA
Else
    AdjustB
End If
AdjustGrid
1 End Sub

Sub mnuAbout_Click ()
MsgBox "This Kala game is brought to you by Mr. Sweeny's Visual Basic programming class at Berlin High School http://www.ncia.net/schools/berlin.  Enjoy!"
End Sub

Sub mnuDetermine_Click ()
Player = InputBox("Who goes first?          (Choose A or B)", "Who goes first?")
If Player = "A" Then
    txtPlayer.Text = "Player A's turn!"
    txtPlayer.BackColor = &H80FF80
Else
    txtPlayer.Text = "Player B's turn!"
    txtPlayer.BackColor = &H80FFFF
End If
PlayerFlag = Player
End Sub

Sub mnuHelp_Click ()
MsgBox "The object of this game is to acquire the most Kala beads in your 'home'.  A turn involves selecting a cell on your side by clicking the mouse on it. The beads in that cell will be picked up and dropped one at a time in successive cells moving counterclockwise.  If the last bead ends up on your side and in an empty cell, any beads directly across from that cell on your opponent's side will be captured and sent to your home along with your bead.  Clearing your side first is advantageous because you will then capture the remainding beads on your opponent's side. As you play you will often wrap-around but you will never drop beads into your opponent's home. By the way, if the last bead ends up in your home on any particular turn, then you get another turn right away. Have fun!!"
End Sub

Sub mnuNewGame_Click ()
K(0) = 0
K(7) = 0
For X = 1 To 6
K(X) = NumberBeads
Next X
For X = 8 To 13
K(X) = NumberBeads
Next X
txtA.Text = 0
txtB.Text = 0
' Put Beads(numbers) in Grid
grdKala.Row = 1
For X = 0 To 5
grdKala.Col = X
grdKala.Text = K(X + 1)
Next X
grdKala.Row = 0
For X = 5 To 0 Step -1
grdKala.Col = X
grdKala.Text = K(-X + 13)
Next X
txtPlayer.Text = "Player " & Player & "'s turn!"
End Sub

Sub mnuQuit_Click ()
MsgBox "Thanks for playing Berlin High School's version of Kala!"
End
End Sub

Sub mnuSelect_Click ()
NumberBeads = InputBox("How many beads per cell?", "Option")
mnuNewGame_Click
End Sub