Microsoft Small Basic

Program Listing: PKG503

List Program

' Spirograph
' Copyright © 2015 Nonki Takahashi. The MIT License.
' Last update 2015-03-02
'
GraphicsWindow.Title = "Spirograph"
LF = Text.GetCharacter(10)
show = "True"
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
showColor = "#CCCCCC"
GraphicsWindow.BrushColor = showColor
ox = gw / 2
oy = gh / 2
n1 = 19
r1 = n1 * 10
While "True"
GraphicsWindow.BrushColor = "Black"
shpTxt = Shapes.AddText("")
Shapes.Move(shpTxt, 10, 10)
If show Then
GraphicsWindow.PenColor = showColor
GraphicsWindow.BrushColor = "#00FFFFFF"
e1 = Shapes.AddEllipse(r1 * 2, r1 * 2)
Shapes.Move(e1, ox - r1, oy - r1)
EndIf
txt = ""
max = 1
While (max < 5) And (2 < Math.GetRandomNumber(5))
max = max + 1
EndWhile
For j = 1 To n1 - 1
num[j] = j
EndFor
For i = 1 To max
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
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()
EndFor
If show Then
Shapes.Remove(e1)
EndIf
Program.Delay(3000)
GraphicsWindow.Clear()
EndWhile
Sub GetRandomColor
r = Math.GetRandomNumber(204)
g = Math.GetRandomNumber(204)
b = Math.GetRandomNumber(204)
color = GraphicsWindow.GetColorFromRGB(r, g, b)
EndSub
Sub Spirograph
If show 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 show 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 show Then
Shapes.Remove(e2)
EndIf
EndSub
Sub Increment
a1 = a1 + da
a2 = -a1 * r1 / r2
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