boid.bas

制作这个程序的目的是因为我见过了该程序的相关c、c++、delphi、java版本

                Else
                    If boid.Y > otherBoid.Y Then
                        Angle = (PI2) - Angle
                    Else
                        Angle = Angle
                    End If
                End If
                
                If (distance < SensorDist) Then
                
                    AngDiff = Abs(boid.direction - Angle)
                    
                    If AngDiff > PI Then
                        AngDiff = AngDiff - PI
                    End If
                    
                    If AngDiff < HalfTheta Then

                        'see if it is the closest
                        If distance < TmpDist Then
                            ClosestDist = distance
                            TmpDist = distance
                            Set ClosestBoid = otherBoid
                        End If
    
                        CloseBoidCount = CloseBoidCount + 1
    
                        boid.AveDir = boid.AveDir + otherBoid.direction
                        boid.AveX = boid.AveX + otherBoid.X
                        boid.AveY = boid.AveY + otherBoid.Y
                        boid.AveSpeed = boid.AveSpeed + otherBoid.speed
                        
                    End If
    
                End If

            End If
            TmpDist = SensorDist
        Next

        'Debug.Print

'averages
        boid.AveDir = boid.AveDir / CloseBoidCount
        boid.AveX = boid.AveX / CloseBoidCount
        boid.AveY = boid.AveY / CloseBoidCount
        boid.AveSpeed = boid.AveSpeed / CloseBoidCount

        If CloseBoidCount > 1 Then
'align
                boid.CentreDist = Abs(Sqr((boid.X - boid.AveX) ^ 2 + (boid.Y - boid.AveY) ^ 2))
                If boid.CentreDist = 0 Then boid.CentreDist = 1
                boid.DesireAlignTurn = boid.AveDir
                boid.DesireAlignWeight = 5
                
'centre
                boid.CentreDist = (Sqr((boid.X - boid.AveX) ^ 2 + (boid.Y - boid.AveY) ^ 2))
                If boid.CentreDist = 0 Then boid.CentreDist = 1
                
                If boid.X <> boid.AveX Then
                    boid.DesireCentreTurn = Abs(Atn((boid.Y - boid.AveY) / (boid.X - boid.AveX)))
                Else
                    boid.DesireCentreTurn = Atn(boid.Y - boid.AveY)
                End If
                
                'boid.DesireCentreWeight = (CSng(boid.CentreDist) * CSng(boid.CentreDist) * CSng(boid.CentreDist)) / 200
                boid.DesireCentreWeight = Log((CSng(boid.CentreDist) * CSng(boid.CentreDist) * CSng(boid.CentreDist)) / 200) + 5
                
                
                If boid.X > boid.AveX Then
                    If boid.Y > boid.AveY Then
                        boid.DesireCentreTurn = boid.DesireCentreTurn + PI
                    Else
                        boid.DesireCentreTurn = PI - boid.DesireCentreTurn
                    End If
                Else
                    If boid.Y > boid.AveY Then
                        boid.DesireCentreTurn = (PI2) - boid.DesireCentreTurn
                    Else
                        boid.DesireCentreTurn = boid.DesireCentreTurn
                    End If
                End If
'Separate
                boid.ClosestX = ClosestBoid.X
                boid.ClosestY = ClosestBoid.Y
                boid.ClosestDist = Abs(1 + Sqr((boid.X - ClosestBoid.X) ^ 2 + (boid.Y - ClosestBoid.Y) ^ 2))
    
                If boid.X <> ClosestBoid.X Then
                    boid.DesireSeparateTurn = Abs(Atn((boid.Y - ClosestBoid.Y) / (boid.X - ClosestBoid.X)))
                Else
                    boid.DesireSeparateTurn = Abs(Atn((boid.Y - ClosestBoid.Y)))
                End If
    
                If boid.X > boid.ClosestX Then
                    If boid.Y > boid.ClosestY Then
                        boid.DesireSeparateTurn = boid.DesireSeparateTurn + PI
                    Else
                        boid.DesireSeparateTurn = PI - boid.DesireSeparateTurn
                    End If
                Else
                    If boid.Y > boid.ClosestY Then
                        boid.DesireSeparateTurn = (PI2) - boid.DesireSeparateTurn
                    Else
                        boid.DesireSeparateTurn = boid.DesireSeparateTurn
                    End If
                End If
                boid.DesireSeparateTurn = boid.DesireSeparateTurn + PI
    
                If boid.DesireSeparateTurn > (PI2) Then boid.DesireSeparateTurn = boid.DesireSeparateTurn - (PI2)
    
                'boid.DesireSeparateWeight = (2000 / (CSng(boid.ClosestDist) * CSng(boid.ClosestDist) * CSng(boid.ClosestDist)))
                boid.DesireSeparateWeight = Log((2000 / (CSng(boid.ClosestDist) * CSng(boid.ClosestDist) * CSng(boid.ClosestDist)))) + 10
                
                                
            
'normalise

            TmpWeight = Abs(boid.DesireAlignWeight) + Abs(boid.DesireCentreWeight) + Abs(boid.DesireSeparateWeight)

            If TmpWeight > 0 Then

                boid.DesireCentreWeight = Abs(boid.DesireCentreWeight / TmpWeight) * CentMult
                boid.DesireSeparateWeight = Abs(boid.DesireSeparateWeight / TmpWeight) * SepMult
                boid.DesireAlignWeight = Abs(boid.DesireAlignWeight / TmpWeight) * AliMult


            End If

            boid.DesireCentreX = (boid.DesireCentreWeight * Cos(boid.DesireCentreTurn) * CentMult)
            boid.DesireCentreY = (boid.DesireCentreWeight * Sin(boid.DesireCentreTurn) * CentMult)

            boid.DesireSeparateX = (boid.DesireSeparateWeight * Cos(boid.DesireSeparateTurn) * SepMult)
            boid.DesireSeparateY = (boid.DesireSeparateWeight * Sin(boid.DesireSeparateTurn) * SepMult)

            boid.DesireAlignX = (boid.DesireAlignWeight * Cos(boid.DesireAlignTurn) * AliMult)
            boid.DesireAlignY = (boid.DesireAlignWeight * Sin(boid.DesireAlignTurn) * AliMult)

            
        Else

            boid.DesireAlignTurn = 0
            boid.DesireAlignWeight = 0
            boid.DesireAlignX = 0
            boid.DesireAlignY = 0

            boid.DesireCentreTurn = 0
            boid.DesireCentreWeight = 0
            boid.DesireCentreX = 0
            boid.DesireCentreY = 0

            boid.ClosestX = 0
            boid.ClosestY = 0
            boid.ClosestDist = 0

            boid.DesireSeparateTurn = 0
            boid.DesireSeparateWeight = 0
            boid.DesireSeparateX = 0
            boid.DesireSeparateY = 0

            boid.ClosestDist = SensorDist * 2
        End If

'================================================================================
'================================================================================
'================================================================================
 
 'obstacle avoidance
 
        distance = 0
        TmpDist = 2 * SensorDist
        
        For Each obs In objects
        
            distance = Abs(1 + Sqr((boid.X - obs.X) ^ 2 + (boid.Y - obs.Y) ^ 2))
            
            If distance < obs.Radius Then
                'Debug.Print boid.id, distance
                'Stop
            End If
            
            If distance < SensorDist + obs.Radius Then
                
                'box to the right
                X1 = boid.X + (5 * Cos(boid.direction + PI / 2))
                Y1 = boid.Y + (5 * Sin(boid.direction + PI / 2))
                X2 = X1 + (SensorDist * Cos(boid.direction))
                Y2 = Y1 + (SensorDist * Sin(boid.direction))
                
                RightDist = SegCirInt(X1, Y1, X2, Y2, obs.X, obs.Y, obs.Radius)
                'Debug.Print X1, Y1, X2, Y2, obs.X, obs.Y, obs.Radius, blnResult
                
                'box to the left
                X1 = boid.X - (5 * Cos(boid.direction + PI / 2))
                Y1 = boid.Y - (5 * Sin(boid.direction + PI / 2))
                X2 = X1 + (SensorDist * Cos(boid.direction))
                Y2 = Y1 + (SensorDist * Sin(boid.direction))
            
                LeftDist = SegCirInt(X1, Y1, X2, Y2, obs.X, obs.Y, obs.Radius)
                'Debug.Print X1, Y1, X2, Y2, obs.X, obs.Y, obs.Radius, blnResult
            
                If LeftDist <> 0 Or RightDist <> 0 Then
                    
                    If LeftDist <> 0 And RightDist <> 0 Then
                        Select Case LeftDist - RightDist
                        Case Is < 0
                            'Debug.Print LeftDist, RightDist, "TURN RIGHT"
                            'Need to move right
                            boid.DesireAvoidTurn = boid.direction + PI / 4
                            boid.DesireAvoidLeft = True
                            
                            boid.Colour = vbRed
                        Case Is > 0
                            'Debug.Print LeftDist, RightDist, "TURN LEFT"
                            'Need to move left
                            boid.DesireAvoidTurn = boid.direction - PI / 4
                            boid.DesireAvoidRight = True
    
                            boid.Colour = vbBlue
                        Case Else
                            'Debug.Print LeftDist, RightDist, "RANDOM TURN"
                            i% = Int(2 * Rnd)
                            If i% = 0 Then
                                boid.DesireAvoidTurn = boid.direction - PI / 4
                                boid.Colour = vbYellow
                            Else
                                boid.DesireAvoidTurn = boid.direction + PI / 4
                                boid.Colour = vbRed
                            End If
                            
                            boid.DesireAvoidRight = True
                            boid.DesireAvoidLeft = True
                        End Select
                        
                    Else
                        If LeftDist <> 0 Then
                            boid.DesireAvoidTurn = boid.direction + PI / 4
                            boid.DesireAvoidLeft = True
                            
                            boid.Colour = vbMagenta
                        End If
                        If RightDist <> 0 Then
                            boid.DesireAvoidTurn = boid.direction - PI / 4
                            boid.DesireAvoidRight = True
    
                            boid.Colour = vbCyan
                        End If
                    End If
                    
                If boid.DesireAvoidTurn > PI2 Then
                    boid.DesireAvoidTurn = boid.DesireAvoidTurn - PI2
                End If
                If boid.DesireAvoidTurn < 0 Then
                    boid.DesireAvoidTurn = boid.DesireAvoidTurn + PI2
                End If
                
                boid.DesireAvoidX = 10 * Cos(boid.DesireAvoidTurn)
                boid.DesireAvoidY = 10 * Sin(boid.DesireAvoidTurn)
                boid.DesireAvoidWeight = 5

                End If
            End If
        
        Next
    Next

'================================================================================
'================================================================================
'================================================================================

    Set boid = Nothing
    Set obs = Nothing
    Set ClosestBoid = Nothing
    Set otherBoid = Nothing
    
End Sub

Sub MoveBoid(flock As Collection, MaxTurn As Single, iHeight As Integer, iWidth As Integer, SensorDist As Integer, Enclosed As Boolean)

    Dim boid As BoidClass
    Dim NewX As Integer
    Dim NewY As Integer
    
'================================================================================
'================================================================================
'================================================================================
Dim NewDir As Single
 Dim Diff As Single
 
    For Each boid In flock

'store starting pos
            boid.Y = boid.Y + (boid.speed * Sin(boid.direction))
            boid.X = boid.X + (boid.speed * Cos(boid.direction))
            
'select action
            If boid.DesireAvoidWeight = 0 Then
                Select Case boid.ClosestDist
                Case 0 To 5
                    boid.DesireSeparateY = boid.DesireSeparateY + Int(Rnd(1) * 10)
                    boid.DesireSeparateX = boid.DesireSeparateX + Int(Rnd(1) * 10)
                Case 6 To 20
                    boid.DesireAlignWeight = 0
                    boid.DesireCentreWeight = 0
                    boid.DesireSeparateY = boid.DesireSeparateY * 5
                    boid.DesireSeparateX = boid.DesireSeparateX * 5
                Case Is > SensorDist
    '                Stop
                Case Else
                End Select
    
    'start from last finish point
                NewY = boid.Y
                NewX = boid.X