Microsoft Small Basic

Program Listing: LSM678-2
' Connect Four 0.4b
' Clone version written by Nonki Takahashi
'
' History:
' 0.4b 2013-11-11 Added mouse handler for human player. (LSM678-2)
' 0.3a 2013-11-11 Added checking for game end. (LSM678-1)
' 0.2a 2013-11-10 Modified as demo version. (LSM678-0)
' 0.1a 2013-11-07 Created as alpha version. (LSM678)
'
gw = 640
gh = 480
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
GraphicsWindow.Title = "Connect Four 0.4b"
dx = 90
dy = 80
InitDisks()
InitBoard()
InitRing()
InitFour()
While "True"
i = 0
inGame = "True" ' game start
clicked = "False"
GraphicsWindow.MouseDown = OnMouseDown
While inGame
If clicked Then
If (0 <= my) And (my <= gh) And (0 <= mx) Then
For col = 1 To 7
If mx <= cx[col] Then
i = i + 1
DropDisk()
Goto colFound
EndIf
EndFor
colFound:
EndIf
clicked = "False"
Else
Program.Delay(200)
EndIf
EndWhile
' game reset
Shapes.HideShape(ring)
For i = 1 To 42
board[i] = 0
Shapes.Move(disk[i], 0, -100)
EndFor
EndWhile
Sub OnMouseDown
mx = GraphicsWindow.MouseX
my = GraphicsWindow.MouseY
clicked = "True"
EndSub
Sub InitDisks
color = "1=Gold;2=Red;"
GraphicsWindow.PenWidth = 0
For i = 1 To 42
GraphicsWindow.BrushColor = color[Math.Remainder(i - 1, 2) + 1]
disk[i] = Shapes.AddEllipse(dy, dy)
Shapes.Move(disk[i], 0, -100)
EndFor
EndSub
Sub InitBoard
For i = 1 To 42
board[i] = 0
EndFor
For col = 1 To 7
cx[col] = col * dx + 5
EndFor
url = "http://www.nonkit.com/smallbasic.files/Connect4Board.png"
Shapes.AddImage(url)
EndSub
Sub InitRing
GraphicsWindow.PenWidth = 10
GraphicsWindow.PenColor = "LightGray"
GraphicsWindow.BrushColor = "#00000000" ' transparent
ring = Shapes.AddEllipse(dy, dy) ' to show last move
Shapes.SetOpacity(ring, 50)
Shapes.HideShape(ring)
EndSub
Sub InitFour
InitCheckList()
nFour = 0
For row = 1 To 6
For col = 1 To 4
nFour = nFour +1
four[nFour][1] = (row - 1) * 7 + col
four[nFour][2] = (row - 1) * 7 + col + 1
four[nFour][3] = (row - 1) * 7 + col + 2
four[nFour][4] = (row - 1) * 7 + col + 3
AddCheckList()
EndFor
EndFor
For row = 1 To 3
For col = 1 To 7
nFour = nFour +1
four[nFour][1] = (row - 1) * 7 + col
four[nFour][2] = row * 7 + col
four[nFour][3] = (row + 1) * 7 + col
four[nFour][4] = (row + 2) * 7 + col
AddCheckList()
EndFor
EndFor
For row = 1 To 3
For col = 1 To 4
nFour = nFour +1
four[nFour][1] = (row - 1) * 7 + col
four[nFour][2] = row * 7 + col + 1
four[nFour][3] = (row + 1) * 7 + col + 2
four[nFour][4] = (row + 2) * 7 + col + 3
AddCheckList()
EndFor
EndFor
For row = 1 To 3
For col = 4 To 7
nFour = nFour +1
four[nFour][1] = (row - 1) * 7 + col
four[nFour][2] = row * 7 + col - 1
four[nFour][3] = (row + 1) * 7 + col - 2
four[nFour][4] = (row + 2) * 7 + col - 3
AddCheckList()
EndFor
EndFor
EndSub
Sub InitCheckList
For i = 1 To 42
list[i]["n"] = 0
EndFor
EndSub
Sub AddCheckList
' param nFour - entry index of four
For i = 1 To 4
cell = four[nFour][i]
n = list[cell]["n"] + 1
list[cell][n] = nFour
list[cell]["n"] = n
EndFor
EndSub
Sub DropDisk
' param i - disk index
' param col - column number 1..7
' return succeed - "True" if succeed
succeed = "False"
x = (col - 1) * dx + 10
ms = 500
For row = 6 To 1 Step -1
cell = (row - 1) * 7 + col
If board[cell] = 0 Then
Shapes.Move(disk[i], x, -100)
y = (row - 1) * dy + 5
Shapes.Animate(disk[i], x, y, ms)
Program.Delay(ms)
Shapes.HideShape(ring)
Shapes.Move(ring, x, y - 5)
Shapes.ShowShape(ring)
Sound.PlayClick()
board[cell] = Math.Remainder(i - 1, 2) + 1
succeed = "True"
CheckFour()
Goto break
EndIf
EndFor
break:
EndSub
Sub CheckFour
' param cell
' return inGame - "True" if not four
inGame = "True"
n = list[cell]["n"]
For f = 1 To n
fi = list[cell][f]
turn = board[four[fi][1]]
For d = 2 To 4
If turn <> board[four[fi][d]] Then
Goto notFour
EndIf
EndFor
ShowWinner()
inGame = "False"
Goto break2
notFour:
EndFor
break2:
EndSub
Sub ShowWinner
' param turn - winner
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = "Black"
pw = 300
ph = 200
popup = Shapes.AddRectangle(pw, ph)
Shapes.SetOpacity(popup, 80)
x = (gw - pw) / 2
y = (gh - ph) / 2
Shapes.Move(popup, x, y)
fs = 40
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = color[turn]
winner = Shapes.AddEllipse(fs, fs)
Shapes.Move(winner, x + 20, y + fs * 0.1 + 30)
GraphicsWindow.FontSize = fs
GraphicsWindow.BrushColor = "White"
msg = Shapes.AddText("wins!")
Shapes.Move(msg, x + fs * 1.2 + 20, y + 30)
GraphicsWindow.BrushColor = "Black"
ok = Controls.AddButton("OK", x + 20, y + fs * 2 + 30)
wait = "True"
Controls.ButtonClicked = OnButtonClicked
While wait
Program.Delay(200)
EndWhile
Controls.Remove(ok)
Shapes.Remove(msg)
Shapes.Remove(winner)
Shapes.Remove(popup)
EndSub
Sub OnButtonClicked
wait = "False"
EndSub