Microsoft Small Basic

Program Listing: WPV159-0
' Knight's Tour 0.4
' Copyright © 2012-2016 Nonki Takahashi. The MIT License.
'
' History :
' 0.4 2016-04-16 Solution supported. (WPV159-0)
' 0.3 2016-04-01 Rewrote for knight's tour. (WPV159)
' 0.2 2013-03-22 Enabled to move chessmen with mouse. (CLP327-0)
' 0.1 2012-08-04 Code for chessmen written in hexadecimal.
' 0.0 2012-08-04 25-line version created. (CLP327)
'
t0 = Clock.ElapsedMilliseconds
title = "Knight's Tour 0.4"
GraphicsWindow.Title = title
Not = "False=True;True=False;"
CRLF = Text.GetCharacter(13) + Text.GetCharacter(10)
GraphicsWindow.BackgroundColor = "#003300"
width = 5
Form()
nm = 0 ' number of moves
Move()
RemovePieces()
Sub Move
If nm = 0 Then
hex = pieces["N"]
Math_Hex2Dec()
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FontSize = size
knight = Shapes.AddText(Text.GetCharacter(dec))
Else
GetNextCandidates()
' draw a cross
y = pos["y0"] + (width - nRow) * size
x = pos["x0"] + (nCol - 1) * size
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FontSize = size
cross[(nRow - 1) * width + nCol] = Shapes.AddText(charX)
Shapes.Move(cross[(nRow - 1) * width + nCol], x + size * 0.12, y - size * 0.12)
EndIf
Stack.PushValue("local", nRow)
Stack.PushValue("local", nCol)
For iCan = 1 To nMoves
nRow = Text.GetSubText(next[iCan], 2, 1)
nCol = aton[Text.GetSubText(next[iCan], 1, 1)]
visited[(nRow - 1) * width + nCol] = "True"
y = pos["y0"] + (width - nRow) * size
x = pos["x0"] + (nCol - 1) * size
If nm = 0 Then
rec = ntoa[nCol] + nRow
Else
rec = rec + ","
If Math.Remainder(nm, 5) = 0 Then
rec = rec + CRLF
EndIf
rec = rec + ntoa[nCol] + nRow
EndIf
nm = nm + 1 ' number of moves
Shapes.Move(knight, x, y - size * 0.12)
Controls.SetTextBoxText(tbox, rec)
Stack.PushValue("local", next)
Stack.PushValue("local", iCan)
Stack.PushValue("local", nMoves)
If Array.GetItemCount(visited) < width * width Then
Move()
Else
t = Clock.ElapsedMilliseconds - t0
GraphicsWindow.Title = title + " - " + (t / 1000) + "[sec]"
buttonClicked = "False"
While Not[buttonClicked]
Program.Delay(300)
EndWhile
t0 = Clock.ElapsedMilliseconds
EndIf
visited[(nRow - 1) * width + nCol] = ""
nm = nm - 1 ' number of moves
rec = Text.GetSubText(rec, 1, Text.GetLength(rec) - 2)
If Text.EndsWith(rec, CRLF) Then
rec = Text.GetSubText(rec, 1, Text.GetLength(rec) - 2)
EndIf
If Text.EndsWith(rec, ",") Then
rec = Text.GetSubText(rec, 1, Text.GetLength(rec) - 1)
EndIf
Controls.SetTextBoxText(tbox, rec)
nMoves = Stack.PopValue("local")
iCan = Stack.PopValue("local")
next = Stack.PopValue("local")
EndFor
nCol = Stack.PopValue("local")
nRow = Stack.PopValue("local")
If nm = 0 Then
Shapes.Remove(knight)
Else
Shapes.Remove(cross[(nRow - 1) * width + nCol])
cross[(nRow - 1) * width + nCol] = ""
y = pos["y0"] + (width - nRow) * size
x = pos["x0"] + (nCol - 1) * size
Shapes.Move(knight, x, y - size * 0.12)
EndIf
EndSub
Sub GetNextCandidates
' param nRow - current knight's row
' param nCol - current knight's column
' return next - array of the next move candidates
next = ""
nMoves = 0
iFrom = (nRow - 1) * width + nCol
For d = 1 To 8
r = nRow + nDir[d]["row"] ' candidate
c = nCol + nDir[d]["col"]
i = (r - 1) * width + c ' index for visited array
If 1 <= r And r <= width And 1 <= c And c <= width And visited[i] = "" Then
nMoves = nMoves + 1
next[nMoves] = ntoa[c] + r
EndIf
EndFor
movable[iFrom] = nMoves
EndSub
Sub Form
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
InitBoard()
InitChessmen()
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FontSize = 12
tbox = Controls.AddMultiLineTextBox(pos["x0"] + size * width + 20, pos["y0"])
Controls.SetSize(tbox, 140, gh - 60)
Controls.AddButton("Next", gw - 54, gh - 40)
Controls.ButtonClicked = OnButtonClicked
EndSub
Sub OnButtonClicked
buttonClicked = "True"
EndSub
Sub RemovePieces
Shapes.Remove(knight)
n = Array.GetItemCount(cross)
index = Array.GetAllIndices(cross)
For i = 1 To n
Shapes.Remove(cross[index[i]])
EndFor
visited = ""
Controls.SetTextBoxText(tbox, "")
EndSub
Sub InitBoard
pos = "x0=40;y0=10;" ' left, top position of the board
color = "W=White;B=Black;0=SaddleBrown;1=BurlyWood;"
nDir[1] = "row=+2;col=+1;" ' movable directions for a knight
nDir[2] = "row=+2;col=-1;"
nDir[3] = "row=+1;col=+2;"
nDir[4] = "row=+1;col=-2;"
nDir[5] = "row=-1;col=+2;"
nDir[6] = "row=-1;col=-2;"
nDir[7] = "row=-2;col=+1;"
nDir[8] = "row=-2;col=-1;"
aton = "a=1;b=2;c=3;d=4;e=5;f=6;g=7;h=8;"
ntoa = "1=a;2=b;3=c;4=d;5=e;6=f;7=g;8=h;"
next = "1=a1;2=b1;3=b2;4=c1;5=c2;6=c3;7=d1;8=d2;9=d3;10=d4;"
nMoves = 10
size = 48 ' font height and square size
visited = ""
GraphicsWindow.FontSize = size / 2
For i = 1 To width
x = pos["x0"] + (i - 1) * size
GraphicsWindow.BrushColor = color["W"]
GraphicsWindow.DrawText(x + size * 0.3, pos["y0"] + size * width, ntoa[i])
EndFor
For j = width To 1 Step - 1
y = pos["y0"] + (width - j) * size
GraphicsWindow.BrushColor = color["W"]
GraphicsWindow.DrawText(pos["x0"] - size / 2, y + size * 0.2, j)
For i = 1 To width
x = pos["x0"] + (i - 1) * size
GraphicsWindow.BrushColor = color[Math.Remainder((i + j), 2)]
GraphicsWindow.FillRectangle(x, y, size, size)
EndFor
EndFor
EndSub
Sub InitChessmen
' param size - font height and square size
pieces = "P=265F;N=265E;B=265D;R=265C;Q=265B;K=265A;X=2716;"
hex = pieces["X"]
Math_Hex2Dec()
charX = Text.GetCharacter(dec)
EndSub
Sub Math_Hex2Dec
' Math | Convert hex to dec
dec = 0
len = Text.GetLength(hex)
For ptr = 1 To len
dec = dec * 16 + Text.GetIndexOf("0123456789ABCDEF", Text.GetSubText(hex, ptr, 1)) - 1
EndFor
EndSub