Microsoft Small Basic

Program Listing: FST624-1

List Program

' One stroke solver 0.3
' Copyright © 2012-2016 Nonki Takahashi. The MIT License.
'
' History :
' 0.3 2016-04-17 Avoided 0 devide for SB 1.2. (FST624-1)
' 0.2 2012-08-24 Renamed MAG to SCALE. (FST624-0)
' 0.1 2012-07-11 Created. (FST624)
'
' Constant definition
X0 = 100
Y0 = 70
SCALE = 50
' Main
GraphicsWindow.Title = "One stroke solver 0.3"
InitVertexes()
InitEdges()
DrawGraph() ' draw graph and count edges for each vertex
Turtle.Show()
FindOddVertex()
If error = "" Then
If found = "False" then
v1 = 1
EndIf
FindOneStrokePath()
If error = "" Then
MoveTurtle()
Else
ShowError()
EndIf
Else
ShowError()
EndIf
' End of main

Sub DrawGraph
' param v[] - vertexes of graph
' param e[][] - edges of graph
' return ne[] - number of edges for each vertex
' return emax - number of total ledges in graph
GraphicsWindow.PenColor = "LightGray"
GraphicsWindow.BrushColor = "Green"
ne = ""
emax = 0
For i = 1 To vmax
xi = X0 + SCALE * v[i]["x"]
yi = Y0 + SCALE * v[i]["y"]
For j = 1 To vmax
xj = X0 + SCALE * v[j]["x"]
yj = Y0 + SCALE * v[j]["y"]
If e[i][j] Then
GraphicsWindow.DrawLine(xi, yi, xj, yj)
ne[i] = ne[i] + 1
ne[j] = ne[j] + 1
emax = emax + 1
EndIf
EndFor
GraphicsWindow.DrawText(xi, yi, i)
EndFor
EndSub

Sub FindAdjacentVertex
' param e2[] - edges of graph
' param i - current index of vertex
' param j - start index to find adjacent vertex
' return j - adjacent vertex
' return found - "True" if found
found = "False"
For j = j To vmax
If e2[i][j] Then
e2[i][j] = ""
found = "True"
Goto fav_exit
ElseIf e2[j][i] Then
e2[j][i] = ""
found = "True"
Goto fav_exit
EndIf
EndFor
fav_exit:
EndSub

Sub FindOddVertex
' param ne[] - number of edges for each vertex
' return v1, v2 - index of vertexes which have odd number of edges
' return found - "True" if found
' return error - error message ("" if no error)
v1 = 0
v2 = 0
For i = 1 To vmax
If Math.Remainder(ne[i], 2) = 1 Then
If v1 = 0 Then
v1 = i
ElseIf v2 = 0 Then
v2 = i
Else
v1 = -1
v2 = -1
EndIf
EndIf
EndFor
If v1 > 0 And v2 > 0 Then
found = "True"
error = ""
ElseIf v1 = 0 And v2 = 0 Then
found = "False"
error = ""
ElseIf v1 < 0 And v2 < 0 Then
found = "False"
error = "Error(1): More than three odd vertexes"
Else
found = "False"
error = "Error(2): Unknown v1=" + v1 + " v2=" + v2
EndIf
EndSub

Sub FindOneStrokePath
' return p[] - one stroke path (array of vertex)
' return error - error message ("" if no error)
error = ""
e2 = e ' copy edges to check remaining
n = 1 ' number of vertex in one stroke path
i = v1 ' current index of vertex
p[n] = i
j = 1 ' start index to find adjecent vertex
While e2 <> ""
FindAdjacentVertex()
If found Then
n = n + 1
i = j
p[n] = i
j = 1 ' start index to find adjecent vertex
Else
' Backtruck
j = p[n]
i = p[n - 1]
p[n] = "" ' remove last vertex in one stroke path
n = n - 1
If n <= 0 Then
error = "Error(3): One stroke path not found " + p
Goto fosp_exit
EndIf
e2[i][j] = "True" ' restore last edge to remaining edges
j = j + 1 ' next start index to find adjecent vertex
If j > vmax Then
error = "Error(4): One stroke path not found " + p
Goto fosp_exit
EndIf
EndIf
EndWhile
fosp_exit:
EndSub

Sub InitVertexes
' return v[] - vertexes
' return vmax - number of vertexes
' 1 2
' 3
' 4 5
' 6 7
' 8 9
' 10
' 11 12
v[1] = "x=0;y=0;"
v[2] = "x=6;y=0;"
v[3] = "x=3;y=0.5;"
v[4] = "x=2;y=2;"
v[5] = "x=4;y=2;"
v[6] = "x=0.5;y=3;"
v[7] = "x=5.5;y=3;"
v[8] = "x=2;y=4;"
v[9] = "x=4;y=4;"
v[10] = "x=3;y=5.5;"
v[11] = "x=0;y=6;"
v[12] = "x=6;y=6;"
vmax = Array.GetItemCount(v)
EndSub

Sub InitEdges
' returns e[][] - edges as matrix
e[1][2] = "True"
e[1][3] = "True"
e[1][6] = "True"
e[1][11] = "True"
e[2][3] = "True"
e[2][7] = "True"
e[2][12] = "True"
e[3][4] = "True"
e[3][5] = "True"
e[4][5] = "True"
e[4][6] = "True"
e[4][8] = "True"
e[5][7] = "True"
e[5][9] = "True"
e[6][8] = "True"
e[6][11] = "True"
e[7][9] = "True"
e[7][12] = "True"
e[8][9] = "True"
e[8][10] = "True"
e[9][10] = "True"
e[10][11] = "True"
e[10][12] = "True"
e[11][12] = "True"
EndSub

Sub MoveTurtle
x1 = Turtle.X
y1 = Turtle.Y
a1 = Turtle.Angle
x2 = X0 + SCALE * v[p[1]]["x"]
y2 = Y0 + SCALE * v[p[1]]["y"]
If x1 = x2 Then
a2 = 0
Else
a2 = Math.ArcTan((y2 - y1)/(x2 - x1)) / Math.Pi * 180
EndIf
a = a2 - a1
If a > 180 Then
a = a - 360
ElseIf a < -180 Then
a = a + 360
EndIf
Turtle.Speed = 8
Turtle.Turn(a)
Turtle.PenUp()
Turtle.MoveTo(x2, y2)
Turtle.PenDown()
GraphicsWindow.PenColor = "Black"
For i = 2 To emax + 1
a1 = a2
x2 = X0 + SCALE * v[p[i]]["x"]
y2 = Y0 + SCALE * v[p[i]]["y"]
If x1 = x2 Then
a2 = 0
Else
a2 = Math.ArcTan((y2 - y1)/(x2 - x1)) / Math.Pi * 180
EndIf
a = a2 - a1
If a > 180 Then
a = a - 360
ElseIf a < -180 Then
a = a + 360
EndIf
Turtle.Turn(a)
Turtle.MoveTo(x2, y2)
x1 = x2
y1 = y2
EndFor
EndSub

Sub ShowError
' Draw balloon
x = Turtle.X
y = Turtle.Y
width = 150
height = 100
x1 = x + 10
y1 = y
x2 = x + 20
y2 = y - 5
x3 = x + 20
y3 = y + 5
GraphicsWindow.BrushColor = "DimGray"
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
GraphicsWindow.BrushColor = "Ivory"
GraphicsWindow.FillRectangle(x + 20, y - 10, width + 2, height)
GraphicsWindow.PenColor = "DimGray"
GraphicsWindow.DrawRectangle(x + 20, y - 10, width + 2, height)
x1 = x + 13
x2 = x + 23
x3 = x + 23
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
' Draw error message
GraphicsWindow.BrushColor = "DimGray"
GraphicsWindow.DrawBoundText(x + 22, y - 10, width, error)
EndSub