Spring Toy

[SierraKen]

A few years ago we were making Slinky toys with QB64 and today I was just goofing around with graphics and math and came across this spring that stretches and comes back. Someone probably made this before but I want to show you guys what I did myself.  It's non-stop until you end it, back and forth. You can press Esc to end. 

Code: (Select All)

_Title "Spring Toy"
Screen _NewImage(800, 600, 32)
xx = 200
yy = 200
length = 100
r = 1
c = _RGB32(0, 255, 0)
Do
    If more = 0 Then xx = xx - .5: length = length + .5
    If more = 0 Then yy = yy - .5: length = length + .5
    If more = 1 Then xx = xx + .5: length = length - .5
    If more = 1 Then yy = yy + .5: length = length - .5
    If xx < 10 Then more = 1
    If xx > 200 Then more = 0

    For t = 0 To length Step .01
        cx = (Sin(t) * xx) + xx + t
        cy = (Cos(t) * yy) + yy + t
        fillCircle cx, cy, r, c
    Next t
    _Delay .05
    _Display
    Cls

Loop Until InKey$ = Chr$(27)


'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