Swinging rope and balls

[Dabzy]

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!

Code Select Expand

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

[3dzForMeStill]

Nice slice of code Dabz!

[Dabzy]

Fanks!

Dabz

[Baggey]

Is someone fixating on swinging Ball's 

[Dabzy]

Sausages

Dabz

[Jackdaw]

Is someone fixating on swinging Ball's 

Well at least they will be well aired.

[Baggey]

Is someone fixating on swinging Ball's 

Well at least they will be well aired.

Well aired or dried out

[RemiD]

interesting... but why code this ? what do you plan to do with this ?

maybe a 'whip' to hit things ?

[Dabzy]

interesting... 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

[Baggey]

interesting... 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. 

[Steve Elliott]

interesting... 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.