Microsoft Small Basic

Program Listing: VRZ081-1

List Program

' Solitaire Marbles
' Version 0.3b
' Copyright © 2016 Nonki Takahashi. The MIT License.
' Last update 2016-03-19
' Program ID VRZ081-1
'
GraphicsWindow.Title = "Solitaire Marbles 0.3b"
Not = "False=True;True=False;"
gw = 600
gh = 600
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
InitBoard()
img = ImageList.LoadImage(folder + "/Marble.png")
n = 0
For row = 1 To 7
y = y1 + (row - 1) * size * 2
For col = 1 To 7
x = x1 + (col - 1) * size * 2
If board[row][col] Then
n = n + 1
shp[n] = Shapes.AddImage(img)
Shapes.Move(shp[n], x - size / 2, y - size / 2)
r[n] = row
c[n] = col
index[row][col] = n
removed[n] = "False"
EndIf
EndFor
EndFor
GraphicsWindow.MouseDown = OnMouseDown
While "True"
If mouseDown Then
If 0 < picked Then
For i = 1 To nc
ox = xt[i] - mx ' offset
oy = yt[i] - my
d = Math.SquareRoot(ox * ox + oy * oy)
If d < size / 2 Then
Move()
picked = 0
i = nc ' break
EndIf
EndFor
Else
CheckPicked()
If 0 < picked Then
CanPick()
If 0 < picked Then
y = y1 + (r[picked] - 1) * size * 2
x = x1 + (c[picked] - 1) * size * 2
Shapes.Move(shp[picked], x - size / 2, y - size * 0.7)
EndIf
EndIf
EndIf
mouseDown = "False"
Else
Program.Delay(200)
EndIf
EndWhile
Sub Move
' param picked - marble index to check
' param i - candidate move index
index[r[picked]][c[picked]] = ""
board[r[picked]][c[picked]] = "False"
If 0 < ir[i] Then
index[r[ir[i]]][c[ir[i]]] = ""
board[r[ir[i]]][c[ir[i]]] = "False"
Shapes.Remove(shp[ir[i]])
EndIf
index[rt[i]][ct[i]] = picked
board[rt[i]][ct[i]] = "True"
removed[ir[i]] = "True"
Shapes.Move(shp[picked], xt[i] - size / 2, yt[i] - size / 2)
r[picked] = rt[i]
c[picked] = ct[i]
EndSub
Sub CanPick
' param picked - marble index to check
row = r[picked]
col = c[picked]
nc = 0 ' number of candidate moves
xt = "" ' target x candidate array
yt = "" ' target y candidate array
rt = "" ' target row candidate array
ct = "" ' target column candidate array
rr = "" ' row array to remove
cr = "" ' column array to remove
For d = 1 To 4
row2 = row + dr[d] * 2
col2 = col + dc[d] * 2
rp = row + dr[d]
cp = col + dc[d]
If board[rp][cp] And Not[board[row2][col2]] Then
nc = nc + 1
yt[nc] = y1 + (row2 - 1) * size * 2
xt[nc] = x1 + (col2 - 1) * size * 2
rt[nc] = row2
ct[nc] = col2
ir[nc] = index[rp][cp] ' marble index to remove
EndIf
EndFor
If nc = 0 Then
picked = 0
Else
nc = nc + 1
yt[nc] = y1 + (row - 1) * size * 2
xt[nc] = x1 + (col2 - 1) * size * 2
rt[nc] = row
ct[nc] = col
EndIf
EndSub
Sub CheckPicked
' param n - number of marbles
' param mx, my - mouse clicked coordinate
' return picked - picked marble index or 0
For i = 1 To n
If Not[removed[i]] Then
y = y1 + (r[i] - 1) * size * 2
x = x1 + (c[i] - 1) * size * 2
ox = x - mx ' offset
oy = y - my
d = Math.SquareRoot(ox * ox + oy * oy)
If d < size / 2 Then
picked = i
i = n ' break
EndIf
EndIf
EndFor
EndSub
Sub OnMouseDown
mx = GraphicsWindow.MouseX
my = GraphicsWindow.MouseY
mouseDown = "True"
EndSub
Sub InitBoard
b[1] = "XX@@@XX"
b[2] = "X@@@@@X"
b[3] = "@@@@@@@"
b[4] = "@@@ @@@"
b[5] = "@@@@@@@"
b[6] = "X@@@@@X"
b[7] = "XX@@@XX"
For row = 1 To 7
For col = 1 To 7
m = Text.GetSubText(b[row], col, 1)
If m = "@" Then
board[row][col] = "True"
ElseIf m = " " Then
board[row][col] = "False"
ElseIf m = "X" Then
board[row][col] = "OB"
EndIf
EndFor
EndFor
folder = "http://www.nonkit.com/smallbasic.files"
GraphicsWindow.DrawImage(folder + "/SolitaireMarblesGameBoard.png", 0, 0)
size = 30 ' ball size
xc = gw / 2
yc = gh / 2
x1 = xc - 6 * size
y1 = yc - 6 * size
dc = "1=1;2=0;3=-1;4=0;" ' direction coloumn
dr = "1=0;2=1;3=0;4=-1;" ' direction row
EndSub
Sub DumpBoard
For row = 1 To 7
For col = 1 To 7
If board[row][col] Then
m = "@"
ElseIf Not[board[row][col]] Then
m = "."
Else
m = " "
EndIf
TextWindow.Write(m)
EndFor
TextWindow.WriteLine("")
EndFor
TextWindow.WriteLine("")
EndSub