The last bit of code I put up at the old place, now with free debug info, a little tester for the {code} tag there, I wasnt expecting much, lol, no syntax highlighting... Maybe one day! :)
Graphics 800,600,32,2
SetBuffer BackBuffer()
Type TSegment
Field x#, y#
Field oldX#, oldY#
Field fixed
End Type
Type TBall
Field x#, y#
Field oldX#, oldY#
Field radius#
Field attached
Field velocityX#, velocityY#
End Type
Const segmentCount = 40
Const segmentLength# = 5.0
Const gravity# = 0.1
Const updatesPerFrame = 35
Const samplesPerSegment = 5
Global ropeEndSegment.TSegment
Global ropeStartSegment.TSegment
Global debugEnabled = False
For segmentIndex = 0 To segmentCount
Local segment.TSegment = New TSegment
segment\x = 400
segment\y = 100 + segmentIndex * segmentLength
segment\oldX = segment\x
segment\oldY = segment\y
If segmentIndex = 0 Then
segment\fixed = True
ropeStartSegment = segment
End If
If segmentIndex = segmentCount Then
segment\fixed = True
ropeEndSegment = segment
End If
Next
Repeat
Cls
If KeyHit(32) Then debugEnabled = Not debugEnabled
If KeyHit(57)
If ropeStartSegment <> Null And ropeEndSegment <> Null Then
Local midX# = (ropeStartSegment\x + ropeEndSegment\x) / 2
Local spawnY# = -10
Local newBall.TBall = New TBall
newBall\x = midX
newBall\y = spawnY
newBall\oldX = newBall\x
newBall\oldY = newBall\y
newBall\radius = 8
newBall\attached = False
End If
End If
For segment.TSegment = Each TSegment
If segment\fixed = False Then
Local velocityX# = segment\x - segment\oldX
Local velocityY# = segment\y - segment\oldY
segment\oldX = segment\x
segment\oldY = segment\y
segment\x = segment\x + velocityX
segment\y = segment\y + velocityY + gravity
End If
Next
For updateCount = 1 To updatesPerFrame
Local previousSegmentConstraint.TSegment = Null
For currentSegment.TSegment = Each TSegment
If previousSegmentConstraint <> Null Then
Local deltaX# = currentSegment\x - previousSegmentConstraint\x
Local deltaY# = currentSegment\y - previousSegmentConstraint\y
Local distance# = Sqr(deltaX * deltaX + deltaY * deltaY)
Local difference# = segmentLength - distance
Local adjustRatio# = difference / distance / 2
Local offsetX# = deltaX * adjustRatio
Local offsetY# = deltaY * adjustRatio
If previousSegmentConstraint\fixed = False Then
previousSegmentConstraint\x = previousSegmentConstraint\x - offsetX
previousSegmentConstraint\y = previousSegmentConstraint\y - offsetY
End If
If currentSegment\fixed = False Then
currentSegment\x = currentSegment\x + offsetX
currentSegment\y = currentSegment\y + offsetY
End If
End If
previousSegmentConstraint = currentSegment
Next
Next
For ball.TBall = Each TBall
Local stepVelocityX# = ball\x - ball\oldX
Local stepVelocityY# = ball\y - ball\oldY
ball\oldX = ball\x
ball\oldY = ball\y
If ball\attached = False Then
ball\velocityX = stepVelocityX
ball\velocityY = stepVelocityY + gravity
End If
ball\x = ball\x + ball\velocityX
ball\y = ball\y + ball\velocityY
Local closestDistance# = 10000
Local foundCollision = False
Local closestX#, closestY#, segmentDX#, segmentDY#
Local previousSegmentBallCheck.TSegment = Null
For currentSegmentBallCheck.TSegment = Each TSegment
If previousSegmentBallCheck <> Null Then
Local segDeltaX# = currentSegmentBallCheck\x - previousSegmentBallCheck\x
Local segDeltaY# = currentSegmentBallCheck\y - previousSegmentBallCheck\y
For sampleIndex = 0 To samplesPerSegment
Local sampleRatio# = Float(sampleIndex) / samplesPerSegment
Local sampleX# = previousSegmentBallCheck\x + segDeltaX * sampleRatio
Local sampleY# = previousSegmentBallCheck\y + segDeltaY * sampleRatio
Local diffX# = ball\x - sampleX
Local diffY# = ball\y - sampleY
Local dist# = Sqr(diffX * diffX + diffY * diffY)
If dist < ball\radius * 1.5 And dist < closestDistance Then
closestDistance = dist
closestX = sampleX
closestY = sampleY
segmentDX = segDeltaX
segmentDY = segDeltaY
foundCollision = True
End If
Next
End If
previousSegmentBallCheck = currentSegmentBallCheck
Next
If foundCollision Then
ball\attached = True
Local pushX# = ball\x - closestX
Local pushY# = ball\y - closestY
Local pushDist# = Sqr(pushX * pushX + pushY * pushY)
If pushDist > 0 And pushDist < ball\radius Then
Local pushAmount# = ball\radius - pushDist
Local normX# = pushX / pushDist
Local normY# = pushY / pushDist
ball\x = ball\x + normX * pushAmount
ball\y = ball\y + normY * pushAmount
ball\velocityX = ball\velocityX + normX * pushAmount * 0.5
ball\velocityY = ball\velocityY + normY * pushAmount * 0.5
End If
Local segLength# = Sqr(segmentDX * segmentDX + segmentDY * segmentDY)
If segLength > 0 Then
Local tangentX# = segmentDX / segLength
Local tangentY# = segmentDY / segLength
Local gravityDot# = gravity * tangentY
ball\velocityX = ball\velocityX + tangentX * gravityDot# * 0.5
ball\velocityY = ball\velocityY + tangentY * gravityDot# * 0.5
Local tangentDot# = ball\velocityX * tangentX + ball\velocityY * tangentY
ball\velocityX = tangentX * tangentDot
ball\velocityY = tangentY * tangentDot
End If
ball\velocityX = ball\velocityX * 0.99
ball\velocityY = ball\velocityY * 0.99
Else
ball\attached = False
ball\velocityY = ball\velocityY + gravity
End If
If ball\y > 600 Then Delete ball
Next
If MouseDown(1)
ropeEndSegment\x = ClampEnds(MouseX(), 0, GraphicsWidth())
ropeEndSegment\y = ClampEnds(MouseY(), 0, GraphicsHeight())
End If
If MouseDown(2)
ropeStartSegment\x = ClampEnds(MouseX(), 0, GraphicsWidth())
ropeStartSegment\y = ClampEnds(MouseY(), 0, GraphicsHeight())
End If
Local ropeThickness = 2
Local previousDrawSegment.TSegment = Null
For currentDrawSegment.TSegment = Each TSegment
If previousDrawSegment <> Null Then
For offset = -ropeThickness / 2 To ropeThickness / 2
Line previousDrawSegment\x + offset, previousDrawSegment\y, currentDrawSegment\x + offset, currentDrawSegment\y
Line previousDrawSegment\x, previousDrawSegment\y + offset, currentDrawSegment\x, currentDrawSegment\y + offset
Next
End If
previousDrawSegment = currentDrawSegment
Next
If debugEnabled
For segment.TSegment = Each TSegment
If segment = ropeStartSegment Then
If segment\fixed Then Color 0,255,0 Else Color 255,255,255
ElseIf segment = ropeEndSegment Then
If segment\fixed Then Color 255,0,0 Else Color 255,255,255
Else
Color 255,255,255
End If
Rect segment\x - 4, segment\y - 4, 8, 8
Next
EndIf
Color 255,255,0
For ball.TBall = Each TBall
Oval ball\x - ball\radius, ball\y - ball\radius, ball\radius * 2, ball\radius * 2
Next
Color 255,255,255
Text 10,10,"SPACE: Drop ball"
Text 10,30,"Left Click: Drag red anchor"
Text 10,50,"Right Click: Drag green anchor"
Text 10,70,"D: Toggle Debug Rectangles"
Text 10,90,"ESC: Quit"
Flip
Until KeyDown(1)
End
Function ClampEnds(value#, minVal#, maxVal#)
If value < minVal Then Return minVal
If value > maxVal Then Return maxVal
Return value
End Function
Function Max(a, b)
If a > b Then Return a Else Return b
End Function
Function Min(a, b)
If a < b Then Return a Else Return b
End Function
Dabz
Nice slice of code Dabz!
Fanks! :)
Dabz
Is someone fixating on swinging Ball's :-X
Sausages
Dabz
Quote from: Baggey on Jun 13, 2025, 07:52 PMIs someone fixating on swinging Ball's :-X
Well at least they will be well aired.
Quote from: Jackdaw on Jun 13, 2025, 08:17 PMQuote from: Baggey on Jun 13, 2025, 07:52 PMIs someone fixating on swinging Ball's :-X
Well at least they will be well aired.
Well aired or dried out ???
interesting... but why code this ? what do you plan to do with this ?
maybe a 'whip' to hit things ?
Quoteinteresting... but why code this ? what do you plan to do with this ?
Because MidiMaster wrote a similar one in BlitzMax, and then Qube wrote a port for AGK, so for shits and giggles I did one in old Blitz!
And since it was, ahem, hanging around, I'd thought I'd shove it up.
Plans for it, not much really, it was pretty much for the exercise! :)
Dabz
Quote from: Dabzy on Jun 14, 2025, 09:08 AMQuoteinteresting... but why code this ? what do you plan to do with this ?
Because MidiMaster wrote a similar one in BlitzMax, and then Qube wrote a port for AGK, so for shits and giggles I did one in old Blitz!
And since it was, ahem, hanging around, I'd thought I'd shove it up.
Plans for it, not much really, it was pretty much for the exercise! :)
Dabz
I would love to see people releasing little Demo's on there favorite language. It Helps other's to learn in the way's of the CODER. ;)
Quoteinteresting... but why code this ?
What a strange question lol. This is primarily a game coding forum, therefore many would immediately see a games based reason why this code could be useful.
And like Dabz said, MidiMaster shared his code and several people converted the code to different languages - because it's useful code.