Microsoft Small Basic

Program Listing: WBH906-0

List Program

' Nodding Donkey
' Version 0.2
' Copyright © 2018 Nonki Takahashi. The MIT License.
' Last update 2018-11-27
' Program ID WBH906-0

GraphicsWindow.Title = "Nodding Donkey"
SB_Workaround()
GraphicsWindow.BackgroundColor = "SkyBlue"
switch = ""
Init()

' cage (for debug)
n = 24
da = 360 / n
If switch["cage"] Then
GraphicsWindow.DrawEllipse(sx[1] - r1, sy[1] - r1, 2 * r1, 2 * r1)
For a = -180 + da / 2 To 180 - da / 2 Step da
_a = Math.GetRadians(a)
x1 = sx[1] + r1 * Math.Cos(_a)
y1 = sy[1] + r1 * Math.Sin(_a)
x2 = sx[1] - r1 * Math.Cos(_a)
y2 = sy[1] - r1 * Math.Sin(_a)
GraphicsWindow.DrawLine(x1, y1, x2, y2)
EndFor
EndIf

' samson post
by = gh * 4 / 6 ' base
GraphicsWindow.PenWidth = 10
color = "SteelBlue"
rate = 0.4
Color_Blacken()
GraphicsWindow.PenColor = color
x1 = sx[1]
y1 = sy[1]
x2 = sx[1] - 40
y2 = by
GraphicsWindow.DrawLine(x1, y1, x2, y2)
x2 = sx[1] + 40
GraphicsWindow.DrawLine(x1, y1, x2, y2)

' walking beam
r1 = 140
r2 = 100
rb = 8
rs = 4
bw = 20 ' walking beam width
bl = r1 + r2 + rb ' walking beam length
color = "SteelBlue"
rate = 0.2
Color_Blacken()
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = color
beam = Shapes.AddRectangle(bl, bw)
Shapes.Move(beam, sx[1] - r1, sy[1] - bw)
GraphicsWindow.BrushColor = color
bearing[1] = Shapes.AddEllipse(2 * rb, 2 * rb)
Shapes.Move(bearing[1], sx[1] - rb, sy[1] - rb)
GraphicsWindow.BrushColor = "Silver"
shaft[1] = Shapes.AddEllipse(2 * rs, 2 * rs)
Shapes.Move(shaft[1], sx[1] - rs, sy[1] - rs)

' gear box
rg = 20
ww = 30 ' weight width
wh = 60 ' weight height
cl = wh / 4 ' crank length
sx[2] = sx[1] + r2 ' shaft x
sy[2] = by - cl - 26 ' shaft y
color = "SteelBlue"
rate = 0.4
Color_Blacken()
GraphicsWindow.BrushColor = color
GraphicsWindow.FillEllipse(sx[2] - rg, sy[2] - rg, 2 * rg, 2 * rg)
GraphicsWindow.FillRectangle(sx[2] - rg, sy[2], 2 * rg, by - sy[2])

' ground
GraphicsWindow.BrushColor = "DimGray"
GraphicsWindow.FillRectangle(0, by, gw, gh - by)
GraphicsWindow.BrushColor = "#442211"
GraphicsWindow.FillRectangle(0, by, gw, gh / 12)
GraphicsWindow.PenWidth = 2
GraphicsWindow.PenColor = "Black"
GraphicsWindow.DrawLine(0, by, gw, by)
GraphicsWindow.BrushColor = "Black"
py = gh * 10 / 12 ' petroleum
GraphicsWindow.FillRectangle(0, py, gw, gh / 12)

' bridle
GraphicsWindow.PenWidth = 2
GraphicsWindow.PenColor = "Gray"
x1 = sx[1] - r1 + 2
y1 = sy[1] - bw
x2 = sx[1] - r1 + 2
y2 = gh * 9.5 / 12
GraphicsWindow.DrawLine(x1, y1, x2, y2)

' counter weight
If silverlight Then
Program.Delay(msWait)
EndIf
GraphicsWindow.PenWidth = 0
color = "SteelBlue"
rate = 0.2
Color_Blacken()
GraphicsWindow.BrushColor = color
weight = Shapes.AddEllipse(ww, wh)
Shapes.Move(weight, sx[2] + cl - ww / 2, sy[2] - wh / 2)

' crank
cw = 16 ' crank width
crank = Shapes.AddRectangle(cl + cw, cw)
Shapes.Move(crank, sx[2] - cw / 2, sy[2] - cw / 2)
GraphicsWindow.BrushColor = "Silver"
shaft[2] = Shapes.AddEllipse(2 * rs, 2 * rs)
Shapes.Move(shaft[2], sx[2] - rs, sy[2] - rs)

' pitman arm
GraphicsWindow.BrushColor = "SteelBlue"
bearing[4] = Shapes.AddEllipse(2 * rb, 2 * rb)
Shapes.Move(bearing[4], sx[2] - rb, sy[1] - rb)
bearing[3] = Shapes.AddEllipse(2 * rb, 2 * rb)
Shapes.Move(bearing[3], sx[2] + cl - rb, sy[2] - rb)
ex34 = (sx[2] + cl) - (sx[1] + r2 - rb)
ey34 = sy[2] - sy[1]
al = Math.SquareRoot(ex34 * ex34 + ey34 * ey34)
aw = 8
ax = ((sx[2] + cl) + (sx[1] + r2)) / 2
ay = (sy[2] + sy[1]) / 2
arm = Shapes.AddRectangle(aw, al)
Shapes.Move(arm, ax - aw / 2, ay - al / 2)
aa = -18 ' angle of arm
Shapes.Rotate(arm, aa)
GraphicsWindow.BrushColor = "Silver"
shaft[4] = Shapes.AddEllipse(2 * rs, 2 * rs)
Shapes.Move(shaft[4], sx[1] + r2 - rs, sy[1] - rs)
shaft[3] = Shapes.AddEllipse(2 * rs, 2 * rs)
Shapes.Move(shaft[3], sx[2] + cl - rs, sy[2] - rs)

' horse head
GraphicsWindow.BrushColor = "Orange"
ro = 8
h[1] = Shapes.AddEllipse(2 * ro, 2 * ro)
a = -180 + da / 2 + da
_a = Math.GetRadians(a)
hx[1] = (r1 - ro) * Math.Cos(_a)
hy[1] = (r1 - ro) * Math.Sin(_a)
Shapes.Move(h[1], sx[1] + hx[1] - ro, sy[1] + hy[1] - ro)
h[2] = Shapes.AddEllipse(2 * ro, 2 * ro)
a = 180 - da / 2 - da
_a = Math.GetRadians(a)
hx[2] = (r1 - ro) * Math.Cos(_a)
hy[2] = (r1 - ro) * Math.Sin(_a)
Shapes.Move(h[2], sx[1] + hx[2] - ro, sy[1] + hy[2] - ro)
wi = 2 * ro
hi = 2 * r1 * Math.Sin(da / 2 * Math.Pi / 180)
i = 3
For a = -180 + da To -180 - da Step -da
h[i] = Shapes.AddRectangle(wi, hi)
_a = Math.GetRadians(a)
hx[i] = (r1 - wi / 2) * Math.Cos(_a)
hy[i] = (r1 - wi / 2) * Math.Sin(_a)
Shapes.Move(h[i], sx[1] + hx[i] - wi / 2, sy[1] + hy[i] - hi / 2)
ha[i] = a + 180
Shapes.Rotate(h[i], ha[i])
i = i + 1
EndFor

' down hole pump
GraphicsWindow.PenWidth = 0
GraphicsWindow.PenColor = "Gray"
GraphicsWindow.BrushColor = "Black"
vx = sx[1] - r1 - 1
vy = gh * 10 / 12
width = 6
height = gh / 24
oil = Shapes.AddRectangle(width, height)
Shapes.Move(oil, vx, vy)
GraphicsWindow.PenWidth = 1
height = gh / 48
valve = Shapes.AddRectangle(width, height)
Shapes.Move(valve, vx, vy)
GraphicsWindow.BrushColor = "Transparent"
GraphicsWindow.PenWidth = 2
x = sx[1] - r1 - 3
y = gh * 9.5 / 12
width = 9
height = gh * 1.5 / 12
barrel = Shapes.AddRectangle(width, height)
Shapes.Move(barrel, x, y)

' nodding donkey animation
While "True"
For angle = 5 To 360 Step 5
MoveDonkey()
Program.Delay(200)
EndFor
EndWhile

Sub MoveDonkey
' param angle - shaft 2 angle
' return sx[3], sy[3] - shaft 3 position
' return sx[4], sy[4] - shaft 4 position
' move arm
_angle = Math.GetRadians(angle)
sx[3] = sx[2] + cl * Math.Cos(_angle)
sy[3] = sy[2] + cl * Math.Sin(_angle)
Shapes.Move(bearing[3], sx[3] - rb, sy[3] - rb)
Shapes.Move(shaft[3], sx[3] - rs, sy[3] - rs)
ex13 = sx[3] - sx[1]
ey13 = sy[3] - sy[1]
e13 = Math.SquareRoot(ex13 * ex13 + ey13 * ey13)
_wa = Math.ArcSin((sy[3] - sy[1]) / e13)
wa = Math.GetDegrees(_wa) ' weight angle
_a413 = Math.ArcCos((r2 * r2 + e13 * e13 - al * al) / (2 * r2 * e13))
a413 = Math.GetDegrees(_a413)
ba = wa - a413 ' beam angle
_ba = Math.GetRadians(ba)
sx[4] = sx[1] + r2 * Math.Cos(_ba)
sy[4] = sy[1] + r2 * Math.Sin(_ba)
Shapes.Move(bearing[4], sx[4] - rb, sy[4] - rb)
Shapes.Move(shaft[4], sx[4] - rs, sy[4] - rs)
x = sx[3] - sx[4]
y = sy[3] - sy[4]
ax = sx[4] + x / 2
ay = sy[4] + y / 2
Shapes.Move(arm, ax - aw / 2, ay - al / 2)
Math_CartesianToPolar()
aa = a - 90
Shapes.Rotate(arm, aa)
' move weight
Shapes.Move(weight, sx[3] - ww / 2, sy[3] - wh / 2)
Shapes.Rotate(weight, angle)
' move crank
cx = sx[2] + (sx[3] - sx[2]) / 2
cy = sy[2] + (sy[3] - sy[2]) / 2
Shapes.Move(crank, cx - (cl + cw) / 2, cy - cw / 2)
Shapes.Rotate(crank, angle)
' move beam
x = bl / 2 - r1
y = - bw / 2
xb = sx[1] + x * Math.Cos(_ba) - y * Math.Sin(_ba)
yb = sy[1] + x * Math.Sin(_ba) + y * Math.Cos(_ba)
Shapes.Move(beam, xb - bl / 2, yb - bw / 2)
Shapes.Rotate(beam, ba)
' move head
For i = 1 To 5
x = sx[1] + hx[i] * Math.Cos(_ba) - hy[i] * Math.Sin(_ba)
y = sy[1] + hx[i] * Math.Sin(_ba) + hy[i] * Math.Cos(_ba)
If i < 3 Then
Shapes.Move(h[i], x - ro, y - ro)
Else
Shapes.Move(h[i], x - wi / 2, y - hi / 2)
Shapes.Rotate(h[i], ha[i] + ba)
EndIf
EndFor
' move pump
stroke = _ba * r1
y = vy - stroke
Shapes.Move(valve, vx, y)
If 0 < stroke Then
Shapes.Move(oil, vx, y)
EndIf
EndSub

Sub Init
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
sx[1] = gw * 4 / 7
sy[1] = gh * 2 / 6
EndSub

Sub Color_Blacken
' Color | Blacken given color
' param color - given color
' param rate - 0..1
' return color - color blackened
Stack.PushValue("local", r)
rate = rate
Color_NameToColor()
Color_ColorToRGB()
r = Math.Floor(r * (1 - rate))
g = Math.Floor(g * (1 - rate))
b = Math.Floor(b * (1 - rate))
color = GraphicsWindow.GetColorFromRGB(r, g, b)
r = Stack.PopValue("local")
EndSub

Sub Color_ColorToRGB
' Color | Convert color To RGB values
' param color - "#rrggbb" (hexadecimal values)
' return r, g, b - RGB values 0..255
If Text.GetLength(color) = 9 Then
offset = 2
Else
offset = 0
EndIf
sR = Text.GetSubText(color, offset + 2, 2)
sG = Text.GetSubText(color, offset + 4, 2)
sB = Text.GetSubText(color, offset + 6, 2)
hex = sR
Math_Hex2Dec()
r = dec
hex = sG
Math_Hex2Dec()
g = dec
hex = sB
Math_Hex2Dec()
b = dec
EndSub

Sub Color_NameToColor
' Color | Convert color name To color
' param color - color name
' return color -"#rrggbb"
If Text.StartsWith(color, "#") Then
color = Text.ConvertToUpperCase(color)
Else
bc = GraphicsWindow.BrushColor
GraphicsWindow.BrushColor = color
color = GraphicsWindow.BrushColor
GraphicsWindow.BrushColor = bc
EndIf
EndSub

Sub Math_CartesianToPolar
' Math | convert cartesian coodinate To polar coordinate
' param x, y - cartesian coordinate
' return r, a - polar coordinate
r = Math.SquareRoot(x * x + y * y)
If x = 0 And y > 0 Then
a = 90 ' [degree]
ElseIf x = 0 And y < 0 Then
a = -90
ElseIf x = 0 Then
a = 0
Else
a = Math.ArcTan(y / x) * 180 / Math.Pi
EndIf
If x < 0 Then
a = a + 180
ElseIf x > 0 And y < 0 Then
a = a + 360
EndIf
EndSub

Sub Math_Hex2Dec
' Math | Convert hexadecimal To decimal
' param hex
' return dec
dec = 0
len = Text.GetLength(hex)
For ptr = 1 To len
dec = dec * 16 + Text.GetIndexOf("123456789ABCDEF", Text.GetSubText(hex, ptr, 1))
EndFor
EndSub

Sub SB_Workaround
' Small Basic | Workaround For Silverlight
' returns silverlight - "True" If in remote
color = GraphicsWindow.GetPixel(0, 0)
If Text.GetLength(color) > 7 Then
silverlight = "True"
msWait = 300
Else
silverlight = "False"
EndIf
EndSub