Microsoft Small Basic

Program Listing: FST624-0
' One stroke solver 0.2
' Copyright (c) 2012 Nonki Takahashi. All rights reserved.
'
' History :
' 0.2 2012/08/24 Renamed MAG to SCALE.
' 0.1 2012/07/11 Created.
'
' Constant definition
X0 = 100
Y0 = 100
SCALE = 50
' Main
GraphicsWindow.Title = "One stroke solver 0.2"
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 13
' 14 15 16
v[1] = "x=0;y=0;"
v[2] = "x=2;y=0;"
v[3] = "x=4;y=0;"
v[4] = "x=1;y=1;"
v[5] = "x=2;y=1;"
v[6] = "x=3;y=1;"
v[7] = "x=0;y=2;"
v[8] = "x=1;y=2;"
v[9] = "x=3;y=2;"
v[10] = "x=4;y=2;"
v[11] = "x=1;y=3;"
v[12] = "x=2;y=3;"
v[13] = "x=3;y=3;"
v[14] = "x=0;y=4;"
v[15] = "x=2;y=4;"
v[16] = "x=4;y=4;"
vmax = Array.GetItemCount(v)
EndSub

Sub InitEdges
' returns e[][] - edges as matrix
e[1][2] = "True"
e[1][7] = "True"
e[2][3] = "True"
e[2][4] = "True"
e[2][6] = "True"
e[3][10] = "True"
e[4][5] = "True"
e[4][7] = "True"
e[4][8] = "True"
e[5][6] = "True"
e[5][8] = "True"
e[5][9] = "True"
e[6][9] = "True"
e[6][10] = "True"
e[7][11] = "True"
e[7][14] = "True"
e[8][11] = "True"
e[8][12] = "True"
e[9][12] = "True"
e[9][13] = "True"
e[10][13] = "True"
e[10][16] = "True"
e[11][12] = "True"
e[11][15] = "True"
e[12][13] = "True"
e[13][15] = "True"
e[14][15] = "True"
e[15][16] = "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"]
a2 = Math.ArcTan((y2 - y1)/(x2 - x1)) / Math.Pi * 180
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"]
a2 = Math.ArcTan((y2 - y1)/(x2 - x1)) / Math.Pi * 180
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