+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Spring Toy (/showthread.php?tid=514)
Spring Toy - SierraKen - 06-03-2022
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 SubRE: Spring Toy - bplus - 06-03-2022
At radius 1, can use a regular Circle. To me, it's more interesting without the delay.
RE: Spring Toy - SierraKen - 06-03-2022
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)RE: Spring Toy - vince - 06-07-2022
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
SYSTEMRE: Spring Toy - bplus - 06-07-2022
@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 SubRE: Spring Toy - Coolman - 06-07-2022
impressive
RE: Spring Toy - SierraKen - 06-07-2022
Yep Vince, that's the one I remember.
B+ that's incredible! It takes a genius to figure that out.