Attribute VB_Name = "RubberBand"

'This class represent a soft path
'It can easily be converted to a class if multiple instances are needed

Option Explicit

Const NumberOfPoints As Long = 50
Dim WantedLineLength As Single
Const NumberOfSections As Long = 8 'Lines per spline when debug drawing

Dim Path(0 To NumberOfPoints - 1) As Vector2
Dim MinLocation As Vector2
Dim MaxLocation As Vector2

Public Sub RubberBand_GeneratePath(NewMinLocation As Vector2, NewMaxLocation As Vector2, NewWantedLineLength As Single, Optimize As Boolean)
    Dim I As Long
    Dim Angle As Single
    Dim Direction As Vector2
    
    'Store the input
    MinLocation = NewMinLocation
    MaxLocation = NewMaxLocation
    WantedLineLength = NewWantedLineLength
    
    'Generate the path
    Angle = Rnd * PI * 2
    Path(0) = MakeVector2(Lerp(MinLocation.X, MaxLocation.X, 0.5), Lerp(MinLocation.Y, MaxLocation.Y, 0.5))
    For I = 1 To NumberOfPoints - 1
        Angle = Angle + ((Rnd - 0.5) * 3)
        Direction = MakeVector2(Sin(Angle), Cos(Angle))
        Path(I) = AddVector2(Path(I - 1), MulVector2(Direction, WantedLineLength))
        If Path(I).X < MinLocation.X Then
            Path(I).X = (MinLocation.X * 2) - Path(I).X
            Angle = Rnd * PI * 2
        ElseIf Path(I).X > MaxLocation.X Then
            Path(I).X = (MaxLocation.X * 2) - Path(I).X
            Angle = Rnd * PI * 2
        End If
        If Path(I).Y < MinLocation.Y Then
            Path(I).Y = (MinLocation.Y * 2) - Path(I).Y
            Angle = Rnd * PI * 2
        ElseIf Path(I).Y > MaxLocation.Y Then
            Path(I).Y = (MaxLocation.Y * 2) - Path(I).Y
            Angle = Rnd * PI * 2
        End If
    Next I
    
    'Optimize it
    If Optimize Then
        For I = 1 To 4
            RubberBand_Smooth 20, 0.2
            RubberBand_Unloop 2
            RubberBand_ClampToBorders
        Next I
    End If
End Sub

'Precondition: T >= 0
Public Function RubberBand_GetPointFromPath(T As Single) As Vector2
    Dim TM As Single
    Dim TI As Long
    Dim TR As Single
    Dim TA As Long
    Dim TB As Long
    Dim TC As Long
    Dim A As Vector2
    Dim B As Vector2
    Dim C As Vector2
    TM = T + 0.5
    TI = Int(TM)
    TR = TM - TI
    TI = TI + NumberOfPoints * 100
    TA = (TI - 1) Mod NumberOfPoints
    TB = TI Mod NumberOfPoints
    TC = (TI + 1) Mod NumberOfPoints
    A = LerpVector2(Path(TA), Path(TB), 0.5)
    B = Path(TB)
    C = LerpVector2(Path(TB), Path(TC), 0.5)
    RubberBand_GetPointFromPath = Bezier3(A, B, C, TR)
End Function

Public Function RubberBand_GetDirectionFromPath(T As Single) As Vector2
    RubberBand_GetDirectionFromPath = NormalVector2(ToVector2(RubberBand_GetPointFromPath(T - 0.01), RubberBand_GetPointFromPath(T + 0.01)))
End Function

Public Sub RubberBand_DebugDraw(Window As Object)
    Dim I As Long
    Dim J As Long
    Dim K As Long
    Dim S As Long
    Dim RMin As Single
    Dim RMax As Single
    Dim LineStart As Vector2
    Dim LineEnd As Vector2
    Dim MiddleIJ As Vector2
    Dim MiddleJK As Vector2

    'Draw the path
    Window.Cls
    For I = 0 To NumberOfPoints - 1
        J = ((I + 1) Mod NumberOfPoints)
        K = ((I + 2) Mod NumberOfPoints)

        'Draw lines between control points
        Window.ForeColor = RGB(100, 100, 200)
        Window.Line (Path(I).X, Path(I).Y)-(Path(J).X, Path(J).Y)

        'Draw circles on points
        Window.ForeColor = RGB(100, 100, 200)
        Window.Circle (Path(I).X, Path(I).Y), 80

        'Draw bezier curves using 3 points at a time
        Window.ForeColor = RGB(100, 200, 100)
        MiddleIJ = LerpVector2(Path(I), Path(J), 0.5)
        MiddleJK = LerpVector2(Path(J), Path(K), 0.5)
        For S = 0 To NumberOfSections - 1
            RMin = S / NumberOfSections
            RMax = (S + 1) / NumberOfSections

            LineStart = Bezier3(MiddleIJ, Path(J), MiddleJK, RMin)
            LineEnd = Bezier3(MiddleIJ, Path(J), MiddleJK, RMax)
            Window.Line (LineStart.X, LineStart.Y)-(LineEnd.X, LineEnd.Y)
        Next S
    Next I
End Sub

Public Sub RubberBand_Smooth(IterationsPerPoint As Long, Strength As Single)
    Dim I As Long
    Dim J As Long
    Dim K As Long
    Dim KMod As Long
    
    'Rubber band physics without velocity
    For I = 1 To NumberOfPoints * IterationsPerPoint
        J = Int(Rnd * NumberOfPoints)
        If Rnd < 0.5 Then
            'Reduce stretching
            AdjustLength J, (J + 1) Mod NumberOfPoints, WantedLineLength, Strength, Strength
        Else
            'Reduce bending
            AdjustLength J, (J + 2) Mod NumberOfPoints, WantedLineLength * 2, Strength, Strength
        End If
        
        'Collide with other points
        If NumberOfPoints >= 10 Then
            For K = I + 5 To I + NumberOfPoints - 5
                KMod = K Mod NumberOfPoints
                'J - KMod collisions
                AdjustLength J, KMod, WantedLineLength, Strength * 2, 0
            Next K
        End If
    Next I
End Sub

'2 is recomended for NumberOfIterations
Public Sub RubberBand_Unloop(NumberOfIterations)
    Dim Iteration As Long
    Dim I As Long
    Dim StartA As Long
    Dim EndA As Long
    Dim StartB As Long
    Dim EndB As Long
    
    'Remove loops
    For Iteration = 1 To NumberOfIterations
        For StartA = 0 To NumberOfPoints - 1
            EndA = (StartA + 1) Mod NumberOfPoints 'EndA is after StartA
            For I = StartA + 2 To StartA + NumberOfPoints - 2
                StartB = I Mod NumberOfPoints
                EndB = (StartB + 1) Mod NumberOfPoints 'EndB is after StartB
                If LinesIntersect(MakeLine2(Path(StartA), Path(EndA)), MakeLine2(Path(StartB), Path(EndB))) Then
                    'The smaller loop have a higher probability of not crossing the end than the long loop
                    'Not swapping with a cyclic interval keeps the code clean and fast
                    If EndA < StartB Then
                        ReversePointInterval EndA, StartB
                        Exit For
                    ElseIf EndB < StartA Then
                        ReversePointInterval EndB, StartA
                        Exit For
                    End If
                End If
            Next I
        Next StartA
    Next Iteration
End Sub

Public Sub RubberBand_ClampToBorders()
    Dim I As Long
    Dim MinX As Single
    Dim MaxX As Single
    Dim MinY As Single
    Dim MaxY As Single
    Dim Offset As Vector2
    
    'Get the bounding box
    MinX = Path(0).X
    MaxX = Path(0).X
    MinY = Path(0).Y
    MaxY = Path(0).Y
    For I = 1 To NumberOfPoints - 1
        MinX = Min_Float(MinX, Path(I).X)
        MaxX = Max_Float(MaxX, Path(I).X)
        MinY = Min_Float(MinY, Path(I).Y)
        MaxY = Max_Float(MaxY, Path(I).Y)
    Next I
    
    'Calculate how all points will be moved
    Offset = ToVector2(MiddleVector2(MakeVector2(MinX, MinY), MakeVector2(MaxX, MaxY)), MiddleVector2(MinLocation, MaxLocation))
    
    For I = 0 To NumberOfPoints - 1
        'Move the bounding box to the center
        Path(I) = AddVector2(Path(I), Offset)
        
        'Keep I inside of the border
        Path(I).X = Clamp(MinLocation.X, Path(I).X, MaxLocation.X)
        Path(I).Y = Clamp(MinLocation.Y, Path(I).Y, MaxLocation.Y)
    Next I
End Sub

'Precondition: A < B
Private Sub ReversePointInterval(A As Long, B As Long)
    Dim I As Long
    Dim J As Long
    I = A
    J = B
    Do Until I >= J
        SwapPoint I, J
        I = I + 1
        J = J - 1
    Loop
End Sub

Private Sub SwapPoint(A As Long, B As Long)
    Dim Swap As Vector2
    Swap = Path(A)
    Path(A) = Path(B)
    Path(B) = Swap
End Sub

Private Function LineBoundsIntersect(A As Line2, B As Line2) As Boolean
    If Min_Float(A.StartPoint.X, A.EndPoint.X) > Max_Float(B.StartPoint.X, B.EndPoint.X) Then
        'A is right of B
        LineBoundsIntersect = False
    ElseIf Max_Float(A.StartPoint.X, A.EndPoint.X) < Min_Float(B.StartPoint.X, B.EndPoint.X) Then
        'A is left of B
        LineBoundsIntersect = False
    ElseIf Min_Float(A.StartPoint.Y, A.EndPoint.Y) > Max_Float(B.StartPoint.Y, B.EndPoint.Y) Then
        'A is below B
        LineBoundsIntersect = False
    ElseIf Max_Float(A.StartPoint.Y, A.EndPoint.Y) < Min_Float(B.StartPoint.Y, B.EndPoint.Y) Then
        'A is above B
        LineBoundsIntersect = False
    Else
        'The lines can intersect
        LineBoundsIntersect = True
    End If
End Function

Private Function LinesIntersect(A As Line2, B As Line2) As Boolean
    Dim OffsetA As Vector2
    Dim OffsetB As Vector2
    Dim DirA As Vector2
    Dim DirB As Vector2
    Dim VertA As Boolean
    Dim VertB As Boolean
    Dim HoriA As Boolean
    Dim HoriB As Boolean
    
    If Not (LineBoundsIntersect(A, B)) Then
        LinesIntersect = False
        Exit Function
    End If
    
    OffsetA = ToVector2(A.StartPoint, A.EndPoint)
    OffsetB = ToVector2(B.StartPoint, B.EndPoint)
    VertA = (Abs(OffsetA.X) < 0.0001)
    VertB = (Abs(OffsetB.X) < 0.0001)
    HoriA = (Abs(OffsetA.Y) < 0.0001)
    HoriB = (Abs(OffsetB.Y) < 0.0001)
    DirA = NormalVector2(OffsetA)
    DirB = NormalVector2(OffsetB)
    If ((VertA And HoriA) Or (VertB And HoriB)) Or DistVector2(DirA, DirB) < 0.001 Or DistVector2(DirA, NegVector2(DirB)) < 0.001 Then
        LinesIntersect = False
        Exit Function
    End If
    
    Dim IntersectionPoint As Vector2
    If VertA Then
        'A is vertical
        IntersectionPoint = LerpVector2(B.StartPoint, B.EndPoint, InverseLerp(B.StartPoint.X, B.EndPoint.X, A.StartPoint.X))
    ElseIf HoriA Then
        'A is horizontal
        IntersectionPoint = LerpVector2(B.StartPoint, B.EndPoint, InverseLerp(B.StartPoint.Y, B.EndPoint.Y, A.StartPoint.Y))
    ElseIf VertB Then
        'B is vertical
        IntersectionPoint = LerpVector2(A.StartPoint, A.EndPoint, InverseLerp(A.StartPoint.X, A.EndPoint.X, B.StartPoint.X))
    ElseIf HoriB Then
        'B is horizontal
        IntersectionPoint = LerpVector2(A.StartPoint, A.EndPoint, InverseLerp(A.StartPoint.Y, A.EndPoint.Y, B.StartPoint.Y))
    Else
        Dim YSA As Single 'Y at X = 0 for line A
        Dim YSB As Single 'Y at X = 0 for line B
        Dim YSC As Single 'Y at X = 0 for line A - B
        Dim YKA As Single 'Y coefficient for line A
        Dim YKB As Single 'Y coefficient for line B
        Dim YKC As Single 'Y coefficient for line A - B
        Dim X As Single
        YKA = (A.EndPoint.Y - A.StartPoint.Y) / (A.EndPoint.X - A.StartPoint.X)
        YKB = (B.EndPoint.Y - B.StartPoint.Y) / (B.EndPoint.X - B.StartPoint.X)
        YSA = A.StartPoint.Y - (YKA * A.StartPoint.X)
        YSB = B.StartPoint.Y - (YKB * B.StartPoint.X)
        'Find X and calculate Y from one of the line X->Y functions
        'C = A - B
        YSC = YSA - YSB
        YKC = YKA - YKB
        'C = 0 gives X for A = B
        X = YSC / -YKC
        'X gives Y
        IntersectionPoint = MakeVector2(X, YSA + (YKA * X))
    End If
    
    'Check where IntersectionPoint is relative to A.StartPoint in the direction DirA and B.StartPoint in the direction DirB
    Dim RelA As Single
    Dim RelB As Single
    RelA = DotProduct2(SubVector2(IntersectionPoint, A.StartPoint), DirA)
    RelB = DotProduct2(SubVector2(IntersectionPoint, B.StartPoint), DirB)
    LinesIntersect = (RelA >= 0 And RelA <= DistVector2(A.StartPoint, A.EndPoint) And RelB >= 0 And RelB <= DistVector2(B.StartPoint, B.EndPoint))
End Function

Private Sub AdjustLength(A As Long, B As Long, WantedLength As Single, PushStrength As Single, PullStrength As Single)
    Dim CurrentLineLength As Single
    Dim Offset As Vector2
    Dim LineDirection As Vector2
    Dim PushForce As Vector2
    Dim Diff As Single
    Offset = ToVector2(Path(A), Path(B))
    LineDirection = NormalVector2(Offset)
    CurrentLineLength = AbsVector2(Offset)
    Diff = WantedLength - CurrentLineLength
    If Diff > 0 Then
        PushPoints A, B, Diff * PushStrength
    ElseIf Diff < 0 Then
        PushPoints A, B, Diff * PullStrength
    End If
End Sub

'A positive force pushes A and B away from each other and a negative force pulls them closer
Private Sub PushPoints(A As Long, B As Long, Force As Single)
    Dim PushForce As Vector2
    PushForce = MulVector2(NormalVector2(ToVector2(Path(A), Path(B))), Force)
    Path(A) = SubVector2(Path(A), PushForce)
    Path(B) = AddVector2(Path(B), PushForce)
End Sub

'3 point bezier interpolation
Private Function Bezier3(A As Vector2, B As Vector2, C As Vector2, Ratio As Single) As Vector2
    Bezier3 = LerpVector2(LerpVector2(A, B, Ratio), LerpVector2(B, C, Ratio), Ratio)
End Function
