10 hours ago
I added a little face to him. 
Code: (Select All)
_Title "Glow Bug - by SierraKen"
Screen _NewImage(800, 600, 32)
Randomize Timer
oldx = 400
oldy = 300
Do
bugs xx, yy, oldx, oldy
Loop Until InKey$ = Chr$(27)
Sub bugs (xx, yy, oldx, oldy)
Do
If d1 > d2 Then s = s + .1
If d2 > d1 Then s = s - .1
d = d + 1
If d > t Then
oldx = oldx + x
oldy = oldy + y
morebugs d1, d2, d, t
End If
x = Cos(s * _Pi / 180) * d
y = Sin(s * _Pi / 180) * d
xx = x + oldx
yy = y + oldy
If xx > 750 Then oldx = 50: Cls: morebugs d1, d2, d, t
If xx < 50 Then oldx = 750: Cls: morebugs d1, d2, d, t
If yy > 550 Then oldy = 50: Cls: morebugs d1, d2, d, t
If yy < 50 Then oldy = 550: Cls: morebugs d1, d2, d, t
fillCircle xx, yy, 10, _RGB32(255, 255, 0)
fillCircle xx - 3, yy - 3, 2, _RGB32(255, 0, 0)
fillCircle xx + 3, yy - 3, 2, _RGB32(255, 0, 0)
For sz = .1 To 5 Step .1
Circle (xx, yy + 4), sz, _RGB32(255, 0, 0), , , .5
Next sz
_Delay .001
Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 10), BF
_Display
Loop Until InKey$ = Chr$(27)
End
End Sub
Sub morebugs (d1, d2, d, t)
d1 = Rnd * 360
d2 = Rnd * 360
d = 0
t = Int(Rnd * 360) + 1
End Sub
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub