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

📄 cellspacepartition.vb

📁 一个.Net下用VB编写的用于游戏的人工智能引擎
💻 VB
字号:
'//  Desc:   class to divide a 2D space into a grid of cells each of which
'//          may contain a number of entities. Once created and initialized 
'//          with entities, fast proximity querys can be made by calling the
'//          CalculateNeighbors method with a position and proximity radius.
'//
'//          If an entity is capable of moving, and therefore capable of moving
'//          between cells, the Update method should be called each update-cycle
'//          to sychronize the entity and the cell space it occupies

Public Class CellSpacePartition
    Private Class Cell
        '//all the entities inhabiting this cell
        Public Members As ArrayList

        '//the cell's bounding box (it's inverted because the Window's default
        '//co-ordinate system has a y axis that increases as it descends)
        Public BBox As InvertedAABBox2D

        Public Sub New(ByVal topleft As Vector2D, ByVal botright As Vector2D)
            BBox = New InvertedAABBox2D(topleft, botright)
            Members = New ArrayList
        End Sub
    End Class

    '//the required amount of cells in the space
    Dim m_Cells As New ArrayList

    '//this is used to store any valid neighbors when an agent searches
    '//its neighboring space
    Dim m_Neighbors As New ArrayList

    '//this iterator will be used by the methods next and begin to traverse
    '//through the above vector of neighbors
    Dim m_curNeighbor As Integer

    '//the width and height of the world space the entities inhabit
    Dim m_dSpaceWidth As Double
    Dim m_dSpaceHeight As Double

    '//the number of cells the space is going to be divided up into
    Dim m_iNumCellsX As Integer
    Dim m_iNumCellsY As Integer

    Dim m_dCellSizeX As Double
    Dim m_dCellSizeY As Double


    '//given a position in the game space this method determines the           
    '//relevant cell's index
    '//--------------------- PositionToIndex ----------------------------------
    '//
    '//  Given a 2D vector representing a position within the game world, this
    '//  method calculates an index into its appropriate cell
    '//------------------------------------------------------------------------
    Private Function PositionToIndex(ByVal pos As Vector2D) As Integer
        Dim idx As Integer = CInt(m_iNumCellsX * pos.x / m_dSpaceWidth) + CInt((m_iNumCellsY * pos.y / m_dSpaceHeight) * m_iNumCellsX)

        '//if the entity's position is equal to vector2d(m_dSpaceWidth, m_dSpaceHeight)
        '//then the index will overshoot. We need to check for this and adjust
        If (idx > m_Cells.Count - 1) Then idx = m_Cells.Count - 1
        Return idx
    End Function


    '  CellSpacePartition(double width,        //width of the environment
    '                    double height,       //height ...
    '                     int   cellsX,       //number of cells horizontally
    '                   int   cellsY,       //number of cells vertically
    '                  int   MaxEntitys);  //maximum number of entities to add
    Public Sub New(ByVal width As Double, ByVal height As Double, ByVal cellsX As Integer, ByVal cellsY As Integer, ByVal MaxEntitys As Integer)
        m_dSpaceWidth = width
        m_dSpaceHeight = height
        m_iNumCellsX = cellsX
        m_iNumCellsY = cellsY
        m_Neighbors = New ArrayList '(MaxEntitys, entity())
        '//calculate bounds of each cell
        m_dCellSizeX = width / cellsX
        m_dCellSizeY = height / cellsY

        '  //create the cells
        Dim x, y As Integer
        For y = 0 To m_iNumCellsY - 1
            For x = 0 To m_iNumCellsX
                Dim left As Double = x * m_dCellSizeX
                Dim right As Double = left + m_dCellSizeX
                Dim top As Double = y * m_dCellSizeY
                Dim bot As Double = top + m_dCellSizeY

                m_Cells.Add(New Cell(New Vector2D(left, top), New Vector2D(right, bot)))

            Next
        Next
    End Sub

    '//adds entities to the class by allocating them to the appropriate cell
    'inline void AddEntity(const entity& ent);
    Public Sub AddEntity(ByVal o As BaseGameEntity)
        Dim sz As Integer = m_Cells.Count
        Dim idx = PositionToIndex(o.Pos)

        CType(m_Cells(idx), Cell).Members.Add(o)
    End Sub

    '//update an entity's cell by calling this from your entity's Update method 
    'inline void UpdateEntity(const entity& ent, Vector2D OldPos);
    Public Sub UpdateEntity(ByVal ent As BaseGameEntity, ByVal OldPos As Vector2D)
        '//if the index for the old pos and the new pos are not equal then
        '//the entity has moved to another cell.
        Dim OldIdx As Integer = PositionToIndex(OldPos)
        Dim NewIdx As Integer = PositionToIndex(ent.Pos())

        If (NewIdx = OldIdx) Then Return

        '//the entity has moved into another cell so delete from current cell
        '//and add to new one
        CType(m_Cells(OldIdx), Cell).Members.Remove(ent)
        CType(m_Cells(NewIdx), Cell).Members.Add(ent)

    End Sub

    '//this method calculates all a target's neighbors and stores them in
    '//the neighbor vector. After you have called this method use the begin, 
    '//next and end methods to iterate through the vector.
    '//----------------------- CalculateNeighbors ----------------------------
    '//
    '//  This must be called to create the vector of neighbors.This method 
    '//  examines each cell within range of the target, If the 
    '//  cells contain entities then they are tested to see if they are situated
    '//  within the target's neighborhood region. If they are they are added to
    '//  neighbor list
    '//------------------------------------------------------------------------
    Public Sub CalculateNeighbors(ByVal TargetPos As Vector2D, ByVal QueryRadius As Double)
        '//create an iterator and set it to the beginning of the neighbor vector
        Dim curNbor As Integer = 0

        '//create the query box that is the bounding box of the target's query
        '//area
        Dim QueryBox As New InvertedAABBox2D(TargetPos.Minus(New Vector2D(QueryRadius, QueryRadius)), TargetPos.Plus(New Vector2D(QueryRadius, QueryRadius)))

        '//iterate through each cell and test to see if its bounding box overlaps
        '//with the query box. If it does and it also contains entities then
        '//make further proximity tests.
        Dim curCell As Integer
        Dim it As Integer
        For curCell = 0 To m_Cells.Count - 1
            '//test to see if this cell contains members and if it overlaps the
            '//query box
            If CType(m_Cells(curCell), Cell).BBox.isOverlappedWith(QueryBox) And CType(m_Cells(curCell), Cell).Members.Count > 0 Then
                '//add any entities found within query radius to the neighbor list
                For it = 0 To CType(m_Cells(curCell), Cell).Members.Count - 1
                    If Vector2D.Vec2DDistanceSQ(CType(CType(m_Cells(curCell), Cell).Members(it), BaseGameEntity).Pos, TargetPos) < QueryRadius * QueryRadius Then
                        Me.m_Neighbors.Add(CType(m_Cells(curCell), Cell).Members(it))
                    End If
                Next

            End If
        Next
    End Sub

    '//returns a reference to the entity at the front of the neighbor vector
    Public Function begin() As Object
        m_curNeighbor = 0
        Return m_Neighbors(0)
    End Function

    '//this returns the next entity in the neighbor vector
    Public Function nextNeighbor() As Object
        m_curNeighbor += 1
        Return m_Neighbors(m_curNeighbor)
    End Function

    '//returns true if the end of the vector is found (a zero value marks the end)
    Public Function IsEnd() As Boolean
        Return m_curNeighbor = m_Neighbors.Count - 1 Or m_curNeighbor = 0
    End Function

    '//empties the cells of entities
    Public Sub EmptyCells()
        Dim i As Integer
        For i = 0 To m_Cells.Count - 1
            CType(m_Cells(i), Cell).Members.Clear()
        Next
    End Sub

    '//call this to use the gdi to render the cell edges
    Public Sub RenderCells(ByVal g As Graphics)

    End Sub

    Public ReadOnly Property Neighbors() As ArrayList
        Get
            Return m_Neighbors
        End Get
    End Property
End Class

⌨️ 快捷键说明

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