Microsoft Small Basic

Program Listing: LSM678-1
' Connect Four 0.3a
' Clone version written by Nonki Takahashi
'
' History:
' 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.3a"
dx = 90
dy = 80
InitDisks()
InitBoard()
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)
InitFour()
a2col = "A=1;B=2;C=3;D=4;E=5;F=6;G=7;"
rec = "1=D;2=D;3=E;4=C;5=C;6=D;7=F;8=G;9=F;10=D;"
rec = rec + "11=D;12=F;13=C;14=C;15=F;16=F;17=B;18=C;19=A;20=E;"
rec = rec + "21=E;22=E;23=A;24=B;25=B;26=B;"
For i = 1 To Array.GetItemCount(rec)
col = a2col[rec[i]]
DropDisk()
EndFor
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
url = "http://www.nonkit.com/smallbasic.files/Connect4Board.png"
Shapes.AddImage(url)
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 isFour - "True" if four
isFour = "False"
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()
isFour = "True"
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