gameworld.vb

一个.Net下用VB编写的用于游戏的人工智能引擎

Imports SteeringVB.ParamLoader

Public Class GameWorld

    '//a container of all the moving entities
    Dim m_Vehicles As New ArrayList

    '//any obstacles
    Dim m_Obstacles As New ArrayList

    '//container containing any walls in the environment
    Dim m_Walls As New ArrayList

    Dim m_pCellSpace As CellSpacePartition ' New ArrayList

    '//any path we may create for the vehicles to follow
    Dim m_pPath As _Path

    '//set true to pause the motion
    Dim m_bPaused As Boolean

    '//local copy of client window dimensions
    Dim m_cxClient As Integer
    Dim m_cyClient As Integer
    '//the position of the crosshair
    Dim m_vCrosshair As Vector2D

    '//keeps track of the average FPS
    Dim m_dAvFrameTime As Double


    '//flags to turn aids and obstacles etc on/off
    Dim m_bShowWalls As Boolean
    Dim m_bShowObstacles As Boolean
    Dim m_bShowPath As Boolean
    Dim m_bShowDetectionBox As Boolean
    Dim m_bShowWanderCircle As Boolean
    Dim m_bShowFeelers As Boolean
    Dim m_bShowSteeringForce As Boolean
    Dim m_bShowFPS As Boolean
    Dim m_bRenderNeighbors As Boolean
    Dim m_bViewKeys As Boolean
    Dim m_bShowCellSpaceInfo As Boolean

    '//--------------------------- CreateObstacles -----------------------------
    '//
    '//  Sets up the vector of obstacles with random positions and sizes. Makes
    '//  sure the obstacles do not overlap
    '//------------------------------------------------------------------------
    Private Sub CreateObstacles()
        '//create a number of randomly sized tiddlywinks
        Dim o As Integer
        For o = 0 To Prm.NumObstacles - 1
            Dim bOverlapped As Boolean = True

            '//keep creating tiddlywinks until we find one that doesn't overlap
            '//any others.Sometimes this can get into an endless loop because the
            '//obstacle has nowhere to fit. We test for this case and exit accordingly

            Dim NumTrys As Integer = 0
            Dim NumAllowableTrys As Integer = 2000
            Dim radius As Integer

            Do While (bOverlapped)
                NumTrys += 1

                If (NumTrys > NumAllowableTrys) Then Return

                radius = Utils.RandInt(Prm.MinObstacleRadius, Prm.MaxObstacleRadius)

                Dim border As Integer = 10
                Dim MinGapBetweenObstacles As Integer = 20

                Dim ob As Obstacle = New Obstacle(Utils.RandInt(radius + border, m_cxClient - radius - border), Utils.RandInt(radius + border, m_cyClient - radius - 30 - border), radius)
                If Not Utils.Overlapped(ob, m_Obstacles, MinGapBetweenObstacles) Then
                    '//its not overlapped so we can add it
                    m_Obstacles.Add(ob)

                    bOverlapped = False

                End If

            Loop

        Next

    End Sub

    '//--------------------------- CreateWalls --------------------------------
    '//
    '//  creates some walls that form an enclosure for the steering agents.
    '//  used to demonstrate several of the steering behaviors
    '//------------------------------------------------------------------------
    Private Sub CreateWalls()
        '//create the walls  
        Dim bordersize As Double = 20.0
        Dim CornerSize As Double = 0.2
        Dim vDist As Double = m_cyClient - 2 * bordersize
        Dim hDist As Double = m_cxClient - 2 * bordersize

        Dim NumWallVerts As Integer = 8

        Dim walls() As Vector2D = {New Vector2D(hDist * CornerSize + bordersize, bordersize), _
        New Vector2D(m_cxClient - bordersize - hDist * CornerSize, bordersize), _
        New Vector2D(m_cxClient - bordersize, bordersize + vDist * CornerSize), _
        New Vector2D(m_cxClient - bordersize, m_cyClient - bordersize - vDist * CornerSize), _
        New Vector2D(m_cxClient - bordersize - hDist * CornerSize, m_cyClient - bordersize), _
        New Vector2D(hDist * CornerSize + bordersize, m_cyClient - bordersize), _
        New Vector2D(bordersize, m_cyClient - bordersize - vDist * CornerSize), _
        New Vector2D(bordersize, bordersize + vDist * CornerSize)}

        Dim w As Integer

        For w = 0 To NumWallVerts - 2
            m_Walls.Add(New Wall2D(walls(w), walls(w + 1)))
        Next

        m_Walls.Add(New Wall2D(walls(NumWallVerts - 1), walls(0)))

    End Sub


    Public Sub New(ByVal cx As Integer, ByVal cy As Integer)

        m_cxClient = cx
        m_cyClient = cy
        m_bPaused = False
        m_vCrosshair = New Vector2D(cxClient() / 2.0, cxClient() / 2.0)
        m_bShowWalls = False
        m_bShowObstacles = False
        m_bShowPath = False
        m_bShowWanderCircle = False
        m_bShowSteeringForce = False
        m_bShowFeelers = False
        m_bShowDetectionBox = False
        m_bShowFPS = True
        m_dAvFrameTime = 0
        m_pPath = Nothing
        m_bRenderNeighbors = False
        m_bViewKeys = False
        m_bShowCellSpaceInfo = False

        '//setup the spatial subdivision class
        m_pCellSpace = New CellSpacePartition(cx, cy, Prm.NumCellsX, Prm.NumCellsY, Prm.NumAgents)

        Dim border As Double = 30
        m_pPath = New _Path(5, border, border, cx - border, cy - border, True)

        '//setup the agents
        Dim a As Integer
        Dim pVehicle As Vehicle
        For a = 0 To Prm.NumAgents - 1
            '//determine a random starting position
            Dim SpawnPos As Vector2D = New Vector2D(cx / 2.0 + Utils.RandomClamped() * cx / 2.0, cy / 2.0 + Utils.RandomClamped() * cy / 2.0)


            pVehicle = New Vehicle(Me, SpawnPos, Utils.RandFloat() * Utils.TwoPi, New Vector2D(0, 0), Prm.VehicleMass, Prm.MaxSteeringForce, Prm.MaxSpeed, Prm.MaxTurnRatePerSecond, Prm.VehicleScale)

            pVehicle.Steering().FlockingOn()

            m_Vehicles.Add(pVehicle)

            '//add it to the cell subdivision
            m_pCellSpace.AddEntity(pVehicle)

        Next


        '#define SHOAL
        '#ifdef SHOAL
        CType(m_Vehicles(Prm.NumAgents - 1), Vehicle).Steering().FlockingOff()
        CType(m_Vehicles(Prm.NumAgents - 1), Vehicle).SetScale(New Vector2D(10, 10))
        CType(m_Vehicles(Prm.NumAgents - 1), Vehicle).Steering().WanderOn()
        CType(m_Vehicles(Prm.NumAgents - 1), Vehicle).MaxSpeed = 70

        Dim i As Integer
        For i = 0 To Prm.NumAgents - 1
            CType(m_Vehicles(Prm.NumAgents - 1), Vehicle).Steering().EvadeOn(m_Vehicles(Prm.NumAgents - 1))

        Next
        '#End If

        '//create any obstacles or walls
        CreateObstacles()
        CreateWalls()

    End Sub

    Shared FrameRateSmoother As New Smoother(10, 0.0)
    Public Sub Update(ByVal time_elapsed As Double)
        If (m_bPaused) Then Return

        '//create a smoother to smooth the framerate
        Dim SampleRate As Integer = 10

        'm_dAvFrameTime = FrameRateSmoother.Update(time_elapsed)


        '//update the vehicles
        Dim i As Integer
        For i = 0 To m_Vehicles.Count - 1
            CType(m_Vehicles(i), Vehicle).Update(time_elapsed)
        Next

    End Sub

    Public Sub Render(ByVal g As Graphics)
        'gdi->TransparentText();

        '//render any walls
        Dim p As Pen
        p = Pens.Black
        'gdi->BlackPen();
        Dim i As Integer
        Dim w As Wall2D
        For i = 0 To m_Walls.Count - 1
            w = m_Walls(i)
            w.Render(g, True)
        Next

        '//render any obstacles
        'gdi->BlackPen();
        Dim ob As Obstacle
        For i = 0 To m_Obstacles.Count - 1
            ob = m_Obstacles(i)
            Gdi.Circle(g, p, ob.Pos, ob.BRadius)
        Next

        '//render the agents
        Dim v As Vehicle
        Dim br As Brush
        Dim box As InvertedAABBox2D
        Dim j As Integer
        Dim pv As BaseGameEntity
        i = 0
        For i = 0 To m_Vehicles.Count - 1
            v = m_Vehicles(i)
            v.Render(g)
            '//render cell partitioning stuff
            If (m_bShowCellSpaceInfo And i = 0) Then
                br = Brushes.Indigo
                'gdi->HollowBrush();
                box = New InvertedAABBox2D(v.Pos().Minus(New Vector2D(Prm.ViewDistance, Prm.ViewDistance)), v.Pos().Plus(New Vector2D(Prm.ViewDistance, Prm.ViewDistance)))
                box.Render(g, False)

                p = Pens.Red
                CellSpace.CalculateNeighbors(v.Pos(), Prm.ViewDistance)
                For j = 0 To CellSpace.Neighbors.Count - 1
                    pv = CellSpace.Neighbors(i)
                    Gdi.Circle(g, p, pv.Pos, pv.BRadius)
                Next

                p = Pens.Green
                Gdi.Circle(g, p, v.Pos(), Prm.ViewDistance)
            End If
        Next

        '//#define CROSSHAIR
        '#ifdef CROSSHAIR
        '//and finally the crosshair
        'gdi->RedPen();
        'gdi->Circle(m_vCrosshair, 4);
        'gdi->Line(m_vCrosshair.x - 8, m_vCrosshair.y, m_vCrosshair.x + 8, m_vCrosshair.y);
        'gdi->Line(m_vCrosshair.x, m_vCrosshair.y - 8, m_vCrosshair.x, m_vCrosshair.y + 8);
        'gdi->TextAtPos(5, cyClient() - 20, "Click to move crosshair");
        '#End If


        '//gdi->TextAtPos(cxClient() -120, cyClient() - 20, "Press R to reset");

        p = Pens.Gray
        If (RenderPath()) Then
            g.DrawString("Press 'U' for random path", New Font("宋体", 9), Brushes.Gray, (cxClient() / 2.0F - 80), cyClient() - 20)

            m_pPath.Render(g)
        End If

        If (RenderFPS()) Then
            'gdi->TextColor(Cgdi::grey);
            'gdi->TextAtPos(5, cyClient() - 20, ttos(1.0 / m_dAvFrameTime));

        End If

        If (m_bShowCellSpaceInfo) Then
            m_pCellSpace.RenderCells(g)

        End If

    End Sub


    Public Sub NonPenetrationContraint(ByVal v As Vehicle)
        Utils.EnforceNonPenetrationConstraint(v, m_Vehicles)
    End Sub

    Public Sub TagVehiclesWithinViewRange(ByVal pVehicle As BaseGameEntity, ByVal range As Double)
        Utils.TagNeighbors(pVehicle, m_Vehicles, range)
    End Sub

    Public Sub TagObstaclesWithinViewRange(ByVal pVehicle As BaseGameEntity, ByVal range As Double)
        Utils.TagNeighbors(pVehicle, m_Obstacles, range)
    End Sub

    Public ReadOnly Property Walls() As ArrayList
        Get
            Return m_Walls
        End Get
    End Property

    Public ReadOnly Property CellSpace() As CellSpacePartition ' ArrayList
        Get
            Return m_pCellSpace
        End Get
    End Property

    Public ReadOnly Property Obstacles() As ArrayList
        Get
            Return m_Obstacles
        End Get
    End Property

    Public ReadOnly Property Agents()
        Get
            Return m_Vehicles
        End Get
    End Property

    '//handle WM_COMMAND messages
    '  public sub        HandleKeyPresses(WPARAM wParam);
    'void        HandleMenuItems(WPARAM wParam, HWND hwnd);

    Public Sub TogglePause()
        m_bPaused = Not m_bPaused
    End Sub
    Public ReadOnly Property Paused() As Boolean
        Get
            Return m_bPaused
        End Get
    End Property

    Public Property Crosshair() As Vector2D
        Get
            Return m_vCrosshair
        End Get
        Set(ByVal Value As Vector2D)
            m_vCrosshair = Value
        End Set
    End Property

    '//------------------------- Set Crosshair ------------------------------------
    '//
    '//  The user can set the position of the crosshair by right clicking the
    '//  mouse. This method makes sure the click is not inside any enabled
    '//  Obstacles and sets the position appropriately
    '//------------------------------------------------------------------------
    Public Sub SetCrosshair(ByVal p As PointF)
        Dim ProposedPosition As Vector2D = New Vector2D(p.X, p.Y)

        '//make sure it's not inside an obstacle
        Dim i As Integer
        Dim curOb As Obstacle
        For i = 0 To m_Obstacles.Count - 1
            curOb = m_Obstacles(i)
            If Geometry.PointInCircle(curOb.Pos(), curOb.BRadius(), ProposedPosition) Then Return
        Next
        m_vCrosshair.x = p.X
        m_vCrosshair.y = p.Y

    End Sub

    Public ReadOnly Property cxClient() As Integer
        Get
            Return m_cxClient
        End Get
    End Property

    Public ReadOnly Property cyClient() As Integer
        Get
            Return m_cyClient
        End Get
    End Property

    Public ReadOnly Property RenderWalls() As Boolean
        Get
            Return m_bShowWalls
        End Get
    End Property

    Public ReadOnly Property RenderObstacles() As Boolean
        Get
            Return m_bShowObstacles
        End Get
    End Property

    Public ReadOnly Property RenderPath() As Boolean
        Get
            Return m_bShowPath
        End Get
    End Property

    Public ReadOnly Property RenderDetectionBox() As Boolean
        Get
            Return m_bShowDetectionBox
        End Get
    End Property

    Public ReadOnly Property RenderWanderCircle() As Boolean
        Get
            Return m_bShowWanderCircle
        End Get
    End Property
    Public ReadOnly Property RenderFeelers() As Boolean
        Get
            Return m_bShowFeelers
        End Get
    End Property

    Public ReadOnly Property RenderSteeringForce() As Boolean
        Get
            Return m_bShowSteeringForce
        End Get
    End Property

    Public ReadOnly Property RenderFPS() As Boolean
        Get
            Return m_bShowFPS
        End Get
    End Property

    Public Sub ToggleShowFPS()
        m_bShowFPS = Not m_bShowFPS
    End Sub

    Public Sub ToggleRenderNeighbors()
        m_bRenderNeighbors = Not m_bRenderNeighbors
    End Sub

    Public ReadOnly Property RenderNeighbors() As Boolean
        Get
            Return m_bRenderNeighbors
        End Get
    End Property

    Public Sub ToggleViewKeys()
        m_bViewKeys = Not m_bViewKeys
    End Sub

    Public ReadOnly Property ViewKeys() As Boolean
        Get
            Return m_bViewKeys
        End Get
    End Property

End Class