⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 utils.vb

📁 一个.Net下用VB编写的用于游戏的人工智能引擎
💻 VB
字号:
Public Class Utils
    Public Const Pi As Double = Math.PI
    Public Const TwoPi As Double = Pi * 2
    Public Const RAND_MAX As Integer = &H7FFF
    Public Const HalfPi As Double = Pi / 2

    Public Shared Function RandInRange(ByVal x As Double, ByVal y As Double) As Double
        Return x + RandFloat() * (y - x)
    End Function

    Public Shared Function RandFloat() As Double
        Dim r As New Random
        Return r.NextDouble / (RAND_MAX + 1.0)
    End Function

    '//returns a random double in the range -1 < n < 1
    Public Shared Function RandomClamped() As Double
        Return RandFloat() - RandFloat()
    End Function

    Public Shared Function isEqual(ByVal a As Double, ByVal b As Double) As Boolean
        If (Math.Abs(a - b) < 0.000000000001) Then
            Return True
        End If

        Return False
    End Function

    Public Shared Function RandInt(ByVal x As Integer, ByVal y As Integer) As Integer
        Dim r As New Random
        Return r.Next Mod (y - x + 1) + x
    End Function

    '//------------------------- Overlapped -----------------------------------
    '//
    '//  tests to see if an entity is overlapping any of a number of entities
    '//  stored in a std container
    '//------------------------------------------------------------------------
    Public Shared Function Overlapped(ByVal ob As BaseGameEntity, ByVal conOb As ArrayList, ByVal MinDistBetweenObstacles As Double) As Boolean
        Dim i As Integer
        For i = 0 To conOb.Count - 1
            If (Geometry.TwoCirclesOverlapped(ob.Pos(), ob.BRadius() + MinDistBetweenObstacles, CType(conOb(i), BaseGameEntity).Pos(), CType(conOb(i), BaseGameEntity).BRadius())) Then
                Return True
            End If
        Next
        Return False
    End Function

    '//----------------------- TagNeighbors ----------------------------------
    '//
    '//  tags any entities contained in a std container that are within the
    '//  radius of the single entity parameter
    '//------------------------------------------------------------------------
    Public Shared Sub TagNeighbors(ByVal entity As BaseGameEntity, ByVal ContainerOfEntities As ArrayList, ByVal radius As Double)
        '//iterate through all entities checking for range
        Dim i As Integer
        Dim curEntity As BaseGameEntity
        For i = 0 To ContainerOfEntities.Count - 1
            curEntity = ContainerOfEntities(i)
            '//first clear any current tag
            curEntity.UnTag()

            Dim to1 As Vector2D = curEntity.Pos().Minus(entity.Pos())

            '//the bounding radius of the other is taken into account by adding it 
            '//to the range
            Dim range As Double = radius + curEntity.BRadius()

            '//if entity within range, tag for further consideration. (working in
            '//distance-squared space to avoid sqrts)
            If (Not curEntity Is entity) And (to1.LengthSQ() < range * range) Then
                curEntity.Tag()
            End If
        Next
    End Sub

    '//------------------- EnforceNonPenetrationConstraint ---------------------
    '//
    '//  Given a pointer to an entity and a std container of pointers to nearby
    '//  entities, this function checks to see if there is an overlap between
    '//  entities. If there is, then the entities are moved away from each
    '//  other
    '//------------------------------------------------------------------------
    Public Shared Sub EnforceNonPenetrationConstraint(ByVal entity As BaseGameEntity, ByVal ContainerOfEntities As ArrayList)
        '//iterate through all entities checking for any overlap of bounding radii
        Dim i As Integer
        Dim curEntity As BaseGameEntity
        For i = 0 To ContainerOfEntities.Count - 1
            curEntity = ContainerOfEntities(i)
            If Not curEntity Is entity Then
                '//calculate the distance between the positions of the entities
                Dim ToEntity As Vector2D = entity.Pos().Minus(curEntity.Pos())

                Dim DistFromEachOther As Double = ToEntity.Length()

                '//if this distance is smaller than the sum of their radii then this
                '//entity must be moved away in the direction parallel to the
                '//ToEntity vector   
                Dim AmountOfOverLap As Double = curEntity.BRadius() + entity.BRadius() - DistFromEachOther

                If (AmountOfOverLap >= 0) Then
                    '//move the entity a distance away equivalent to the amount of overlap.
                    entity.Pos = entity.Pos().Plus(ToEntity.Divided(DistFromEachOther).Mutiply(AmountOfOverLap))
                End If

            End If
        Next
    End Sub

    '//-------------------- GetEntityLineSegmentIntersections ----------------------
    '//
    '//  tests a line segment AB against a container of entities. First of all
    '//  a test is made to confirm that the entity is within a specified range of 
    '//  the one_to_ignore (positioned at A). If within range the intersection test
    '//  is made.
    '//
    '//  returns a list of all the entities that tested positive for intersection
    '//-----------------------------------------------------------------------------
    Public Shared Function GetEntityLineSegmentIntersections(ByVal entities As ArrayList, ByVal the_one_to_ignore As Integer, ByVal A As Vector2D, ByVal B As Vector2D, ByVal range As Double) As ArrayList
        Dim it As BaseGameEntity

        Dim hits As New ArrayList
        Dim i As Integer
        '//iterate through all entities checking against the line segment AB
        For i = 0 To entities.Count - 1
            '//if not within range or the entity being checked is the_one_to_ignore
            '//just continue with the next entity
            it = entities(i)
            If Not ((it.ID() = the_one_to_ignore) Or (Vector2D.Vec2DDistanceSQ(it.Pos(), A) > range * range)) Then
                '//if the distance to AB is less than the entities bounding radius then
                '//there is an intersection so add it to hits
                If Geometry.DistToLineSegment(A, B, it.Pos()) < it.BRadius() Then hits.Add(it)

            End If

        Next
        Return hits

    End Function

    '//------------------------ GetClosestEntityLineSegmentIntersection ------------
    '//
    '//  tests a line segment AB against a container of entities. First of all
    '//  a test is made to confirm that the entity is within a specified range of 
    '//  the one_to_ignore (positioned at A). If within range the intersection test
    '//  is made.
    '//
    '//  returns the closest entity that tested positive for intersection or NULL
    '//  if none found
    '//-----------------------------------------------------------------------------

    Public Shared Function GetClosestEntityLineSegmentIntersection(ByVal entities As ArrayList, ByVal the_one_to_ignore As Integer, ByVal A As Vector2D, ByVal B As Vector2D, ByVal range As Double) As BaseGameEntity
        Dim it As BaseGameEntity

        Dim ClosestEntity As BaseGameEntity = Nothing

        Dim ClosestDist As Double = Double.MaxValue

        '//iterate through all entities checking against the line segment AB
        Dim i As Integer
        Dim distSq As Double
        For i = 0 To entities.Count - 1
            it = entities(i)
            distSq = Vector2D.Vec2DDistanceSQ(it.Pos(), A)

            '//if not within range or the entity being checked is the_one_to_ignore
            '//just continue with the next entity
            If Not ((it.ID() = the_one_to_ignore) Or (distSq > range * range)) Then
                '//if the distance to AB is less than the entities bounding radius then
                '//there is an intersection so add it to hits
                If (Geometry.DistToLineSegment(A, B, it.Pos()) < it.BRadius()) Then
                    If (distSq < ClosestDist) Then
                        ClosestDist = distSq

                        ClosestEntity = it

                    End If

                End If
            End If
        Next
        Return ClosestEntity

    End Function
End Class

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -