Microsoft Small Basic

Program Listing: PKG503-1

List Program

' Spirograph
' Copyright © 2015 Nonki Takahashi. The MIT License.
' Last update 2015-03-03
' Version 0.3
' Program ID PKG503-1
'
GraphicsWindow.Title = "Spirograph 0.3"
Not = "True=False;False=True;"
LF = Text.GetCharacter(10)
wheel = "True"
random = "True"
pause = "True"
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
showColor = "#CCCCCC"
GraphicsWindow.BrushColor = showColor
GraphicsWindow.FontName = "Arial"
ox = gw / 2
oy = gh / 2
If Not[random] Then
c1 = "1=18;2=18;3=18;4=18;5=18;6=18;7=18;8=18;9=18;10=18;"
c2 = "1=15;2=15;3=15;4=15;5=12;6=12;7=12;8=9;9=9;10=6;"
c3 = "1=12;2=9;3=6;4=3;5=9;6=6;7=3;8=6;9=3;10=3;"
c1 = c1 + "11=20;12=20;13=20;14=20;15=20;16=20;"
c2 = c2 + "11=16;12=16;13=16;14=12;15=12;16=8;"
c3 = c3 + "11=12;12=8;13=4;14=8;15=4;16=4;"
c1 = c1 + "17=20;18=20;19=20;"
c2 = c2 + "17=15;18=15;19=10;"
c3 = c3 + "17=10;18=5;19=5;"
c1 = c1 + "20=18;"
c2 = c2 + "20=12;"
c3 = c3 + "20=6;"
c1 = c1 + "21=20;22=19;23=19;24=19;25=19;"
c2 = c2 + "21=5;22=11;23=12;24=9;25=9;"
c3 = c3 + "21=4;22=8;23=4;24=6;25=3;"
combi = 0
nCombi = Array.GetItemCount(c1)
EndIf
While "True"
If wheel Then
DrawGrid()
EndIf
GraphicsWindow.BrushColor = "Black"
shpTxt = Shapes.AddText("")
Shapes.Move(shpTxt, 10, 10)
txt = ""
max = 1
If random Then
While (max < 5) And (2 < Math.GetRandomNumber(5))
max = max + 1
EndWhile
For j = 1 To 18
num[j] = j
EndFor
Else
combi = combi + 1
If nCombi < combi Then
combi = 1
EndIf
EndIf
For i = 1 To max
If random Then
n1 = Math.GetRandomNumber(2) + 18
r1 = n1 * 10
index = Array.GetAllIndices(num)
nn = Array.GetItemCount(num)
n2 = index[Math.GetRandomNumber(nn)]
num[n2] = ""
index = Array.GetAllIndices(num)
nn = Array.GetItemCount(num)
n3 = index[Math.GetRandomNumber(nn)]
num[n3] = ""
If n2 < n3 Then
wk = n2
n2 = n3
n3 = wk
EndIf
Else
n1 = c1[combi]
r1 = n1 * 10
n2 = c2[combi]
n3 = c3[combi]
EndIf
If wheel Then
GraphicsWindow.PenColor = showColor
GraphicsWindow.BrushColor = "#00FFFFFF"
e1 = Shapes.AddEllipse(r1 * 2, r1 * 2)
Shapes.Move(e1, ox - r1, oy - r1)
EndIf
r2 = n2 * 10
r3 = n3 * 10
txt = txt + "r1 = " + r1 + LF
txt = txt + "r2 = " + r2 + LF
txt = txt + "r3 = " + r3 + LF + LF
Shapes.SetText(shpTxt, txt)
GetRandomColor()
pc = "#99" + Text.GetSubTextToEnd(color, 2)
Spirograph()
If wheel Then
Shapes.Remove(e1)
EndIf
EndFor
If pause Then
GraphicsWindow.KeyDown = OnKeyDown
keyDown = "False"
While Not[keyDown]
Program.Delay(300)
EndWhile
Else
Program.Delay(3000)
EndIf
GraphicsWindow.Clear()
EndWhile
Sub DrawGrid
GraphicsWindow.PenColor = "#EEEEEE"
For x = gw / 2 - 300 To gw / 2 + 300 Step 10
GraphicsWindow.DrawLine(x, 0, x, gh - 1)
EndFor
For y = gh / 2 - 200 To gh / 2 + 200 Step 10
GraphicsWindow.DrawLine(0, y, gw - 1, y)
EndFor
GraphicsWindow.PenColor = "#CCCCCC"
For x = gw / 2 - 300 To gw / 2 + 300 Step 100
GraphicsWindow.DrawLine(x, 0, x, gh - 1)
EndFor
For y = gh / 2 - 200 To gh / 2 + 200 Step 100
GraphicsWindow.DrawLine(0, y, gw - 1, y)
EndFor
EndSub
Sub GetRandomColor
l = Math.GetRandomNumber(3)
For k = 1 To 3
If k = l Then
c[k] = Math.GetRandomNumber(102) ' 66
Else
c[k] = Math.GetRandomNumber(204) ' CC
EndIf
EndFor
color = GraphicsWindow.GetColorFromRGB(c[1], c[2], c[3])
EndSub
Sub Increment
a1 = a1 + da
a2 = -a1 * r1 / r2 + a1
EndSub
Sub OnKeyDown
keyDown = "True"
EndSub
Sub PenPosition
' param r1, r2
' param a1, a2
' return x, y
_a1 = Math.GetRadians(a1)
x2 = ox + (r1 - r2) * Math.Sin(_a1)
y2 = oy - (r1 - r2) * Math.Cos(_a1)
_a2 = Math.GetRadians(a2)
x = x2 + r3 * Math.Sin(_a2)
y = y2 - r3 * Math.Cos(_a2)
EndSub
Sub Spirograph
If wheel Then
GraphicsWindow.PenColor = showColor
GraphicsWindow.BrushColor = showColor
e2 = Shapes.AddEllipse(r2 * 2, r2 * 2)
Shapes.SetOpacity(e2, 50)
EndIf
a1 = 0
a2 = 0
da = 1
PenPosition()
Shapes.Move(e2, x2 - r2, y2 - r2)
xLast = x
yLast = y
xStart = x
yStart = y
Increment()
PenPosition()
GraphicsWindow.PenColor = pc
While (x <> xStart) Or (y <> yStart)
If wheel Then
Program.Delay(1)
Shapes.Move(e2, x2 - r2, y2 - r2)
EndIf
GraphicsWindow.DrawLine(xLast, yLast, x, y)
xLast = x
yLast = y
Increment()
PenPosition()
EndWhile
Shapes.Move(e2, x2 - r2, y2 - r2)
GraphicsWindow.DrawLine(xLast, yLast, x, y)
If wheel Then
Shapes.Remove(e2)
EndIf
EndSub