' Connect Four 0.5b
' Small Basic clone version written by Nonki Takahashi
'
' History:
' 0.5b 2013-12-13 Added very weak AI. (LSM678-3)
' 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.5b"
dx = 90
dy = 80
Not = "True=False;False=True;"
InitDisks()
InitBoard()
InitRing()
InitFour()
'DumpCheckList()
While "True"
i = 0
inGame = "True" ' game start
clicked = "False"
GraphicsWindow.MouseDown = OnMouseDown
While inGame
AI()
If inGame Then
Human()
EndIf
If 42 <= i Then
turn = 0
inGame = "False"
EndIf
EndWhile
ShowResult()
' game reset
Shapes.HideShape(ring)
For i = 1 To 42
board[i] = 0
Shapes.Move(disk[i], 0, -100)
EndFor
EndWhile
Sub AI
succeed = "False"
While Not[succeed]
i = i + 1
col = Math.GetRandomNumber(7)
DropDisk()
If succeed Then
AnimateDisk()
Else
i = i - 1
EndIf
EndWhile
EndSub
Sub Human
succeed = "False"
While Not[succeed]
clicked = "False"
While Not[clicked]
Program.Delay(100)
EndWhile
If (0 <= my) And (my <= gh) And (0 <= mx) Then
For col = 1 To 7
If mx <= cx[col] Then
i = i + 1
DropDisk()
If succeed Then
AnimateDisk()
EndIf
Goto break3
EndIf
EndFor
break3:
EndIf
EndWhile
EndSub
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 DumpCheckList
For row = 1 To 6
line = ""
For col = 1 To 7
cell = (row - 1) * 7 + col
n = list[cell]["n"]
If Text.GetLength(n) < 2 Then
line = Text.Append(line, " ")
EndIf
line = Text.Append(line, n)
If col < 7 Then
line = line + " "
EndIf
EndFor
TextWindow.WriteLine(line)
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"
For row = 6 To 1 Step -1
cell = (row - 1) * 7 + col
If board[cell] = 0 Then
board[cell] = Math.Remainder(i - 1, 2) + 1
succeed = "True"
CheckFour()
Goto break
EndIf
EndFor
break:
EndSub
Sub AnimateDisk
' param i - disk index
' param col - column number 1..7
x = (col - 1) * dx + 10
ms = 500
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()
EndSub
Sub CheckFour
' param cell - to check
' return inGame - "True" if not four
' return turn - winner (0 means draw)
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
inGame = "False"
Goto break2
notFour:
EndFor
break2:
EndSub
Sub ShowResult
' param turn - winner (0 means draw)
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
If turn <> 0 Then
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)
Else
GraphicsWindow.FontSize = fs
GraphicsWindow.BrushColor = "White"
msg = Shapes.AddText("Draw")
Shapes.Move(msg, x + 20, y + 30)
EndIf
GraphicsWindow.BrushColor = "Black"
ok = Controls.AddButton("OK", x + 20, y + fs * 2 + 30)
wait = "True"
Sound.PlayChime()
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
Program Listing: LSM678-3