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

[bplus]

At radius 1, can use a regular Circle. To me, it's more interesting without the delay.

[SierraKen]

LOL I had no idea, I just tried it b+ and it does work better, with half the code. lol Thanks.
Here it is:

Code: (Select All)

_Title "Spring Toy"
Screen _NewImage(800, 600, 32)
xx = 200
yy = 200
length = 100
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
        Circle (cx, cy), 1, c
    Next t
    _Display
    Cls
Loop Until InKey$ = Chr$(27)

[vince]

Nice, this reminds me of this B+ mod from a while ago

Code: (Select All)

DEFINT A-Z

CONST z0 = 2500
CONST y0 = -200
CONST d = 700

CONST sw = 640
CONST sh = 480

DIM SHARED pi AS DOUBLE
pi = 4 * ATN(1)

SCREEN _NEWIMAGE(sw, sh, 32)


DIM a AS DOUBLE
DIM t AS DOUBLE
t = 0
DO
    t = t + 0.1
    h = 120 + 100 * SIN(t)

    LINE (0, 0)-(sw, sh), _RGB(0, 0, 0), BF

    ox = 500 * COS(0)
    oz = 500 * SIN(0)
    oy = -500 + 0 * h / (2 * pi)
    'PSET (sw / 2 + ox * d / (oz + z0), sh / 2 - (oy + y0) * d / (oz + z0))

    FOR a = 0.1 TO 15 * 2 * pi STEP 0.01
        x = 500 * COS(a)
        z = 500 * SIN(a)
        y = -500 + a * h / (2 * pi)

        DIM dy AS SINGLE
        FOR dy = 6 TO 0 STEP -.5
            LINE (sw / 2 + ox * d / (oz + z0), sh / 2 - (oy + y0) * d / (oz + z0) + dy)-(sw / 2 + x * d / (z + z0) + 6, sh / 2 - (y + y0) * d / (z + z0) + dy), _RGB32(185 - dy * 17), BF
        NEXT

        ox = x
        oy = y
        oz = z
    NEXT

    _DISPLAY
    _LIMIT 20
LOOP UNTIL _KEYHIT = 27
SYSTEM

[bplus]

@vince that was more your mod I think, I did do this sometime ago:

Code: (Select All)

_Title "Mouse down, drag ball, release...  Boing" 'B+ 2019-01-08 from
'boing.bas for SmallBASIC 2015-07-25 MGA/B+
'coloring mods

Const xmax = 1200
Const ymax = 700
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 80, 20

Dim s(1 To 4, 1 To 2)
s(1, 1) = 0: s(1, 2) = 50
s(2, 1) = 0: s(2, 2) = ymax - 50
s(3, 1) = xmax + 30: s(3, 2) = 50
s(4, 1) = xmax + 30: s(4, 2) = ymax - 50
oldtx = 0: oldtyty = 0: da = .03
boingx = 0: boingy = 0
While 1
    While _MouseInput: Wend
    mb = _MouseButton(1)
    If mb Then
        tx = _MouseX + 20
        ty = _MouseY
    Else
        tx = xmax / 2
        ty = ymax / 2
        If tx <> oldtx Or ty <> oldty Then
            boingx = 3 * (tx - oldtx) / 4
            boingy = 3 * (ty - oldty) / 4
        Else
            boingx = -3 * boingx / 4
            boingy = -3 * boingy / 4
        End If
        tx = tx + boingx
        ty = ty + boingy
    End If
    a = 0
    oldtx = tx
    oldty = ty
    Cls
    For corner = 1 To 4
        s1x = s(corner, 1)
        s1y = s(corner, 2)
        dx = (tx - s1x) / 2000
        dy = (ty - s1y) / 2000
        x = tx - 20
        y = ty
        For i = 1 To 2000
            sx = 20 * Cos(a) + x
            sy = 20 * Sin(a) + y
            Line (sx, sy + 5)-(sx + 4, sy + 5), _RGB32(118, 118, 118), BF
            Line (sx, sy + 4)-(sx + 4, sy + 4), _RGB32(148, 148, 148), BF
            Line (sx, sy + 3)-(sx + 4, sy + 3), _RGB32(238, 238, 238), BF
            Line (sx, sy + 2)-(sx + 4, sy + 3), _RGB32(208, 208, 208), BF
            Line (sx, sy + 1)-(sx + 4, sy + 1), _RGB32(168, 168, 168), BF
            Line (sx, sy)-(sx + 4, sy), _RGB32(108, 108, 108), BF
            Line (sx, sy - 1)-(sx + 4, sy - 1), _RGB32(68, 68, 68), BF
            x = x - dx: y = y - dy
            a = a + da
        Next
    Next
    For r = 50 To 1 Step -1
        g = (50 - r) * 5 + 5
        Color _RGB32(g, g, g)
        fcirc tx - 20, ty, r
    Next
    _Display
    _Limit 15
Wend

'Steve McNeil's  copied from his forum   note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
    Dim subRadius As Long, RadiusError As Long
    Dim X As Long, Y As Long

    subRadius = Abs(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    If subRadius = 0 Then PSet (CX, CY): Exit Sub

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    Line (CX - X, CY)-(CX + X, CY), , 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), , BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    Wend
End Sub

[Coolman]

impressive

[SierraKen]

Yep Vince, that's the one I remember.
B+ that's incredible! It takes a genius to figure that out.