All pastes #276017 Raw Edit

Unnamed

public text v1 · immutable
·published 2006-12-11 23:21 UTC
rendered paste body
Public Class CWorldMgr

#Region " Declares "
    ' private truevision objects
    Private tvTextures As MTV3D65.TVTextureFactory = Nothing
    Private tvAtmosphere As MTV3D65.TVAtmosphere = Nothing
    Private tvPhysics As MTV3D65.TVPhysics = Nothing

    ' private user objects
    Private objTextures As Collection = Nothing
    Private objAreas As Collection = Nothing
#End Region

#Region " Initialize "
    Public Sub Initialize()
        ' initialize tvtexture factory
        Me.tvTextures = New MTV3D65.TVTextureFactory

        ' initialize tvatmosphere
        Me.tvAtmosphere = New MTV3D65.TVAtmosphere()

        ' initialize texture collection
        Me.objTextures = New Collection()

        ' initialize landscape collection 
        Me.objAreas = New Collection()

        ' load textures
        Me.LoadTextures()

        ' load world
        Me.LoadWorld()

        ' initialize physics
        Me.tvPhysics = New MTV3D65.TVPhysics()
        Me.tvPhysics.Initialize()
        Me.tvPhysics.SetGlobalGravity(New MTV3D65.TV_3DVECTOR(0.0!, -9.8!, 0.0!))

        ' build world
        Me.BuildWorld()
    End Sub
#End Region

#Region " Uninitialize "
    Public Sub Uninitialize()
        ' uninitialize landscapes
        For Each cArea As CArea In Me.objAreas
            If (cArea.Landscape IsNot Nothing) Then
                cArea.Landscape.DeleteAll()
                cArea.Landscape = Nothing
            End If
        Next

        Me.objAreas.Clear()
        Me.objAreas = Nothing

        Me.tvTextures.DeleteAllTextures()
        Me.tvTextures = Nothing

        Me.tvPhysics = Nothing

        ' uninitialize atmosphere
        Me.tvAtmosphere = Nothing
    End Sub
#End Region

#Region " LoadTextures "
    Private Sub LoadTextures()
        Try
            ' load xml config file for world
            Dim xmlDoc As New System.Xml.XmlDocument()
            xmlDoc.Load(Application.StartupPath$ & "\World\Default.wld")

            ' retrieve the node list 
            Dim xmlNodeList As System.Xml.XmlNodeList = xmlDoc.GetElementsByTagName("Texture")

            ' build list of textures
            For Each xmlNode As System.Xml.XmlNode In xmlNodeList
                ' initialize texture object
                Dim cTexture As New CTexture()

                ' get list of texture attributes
                For Each xmlAttri As System.Xml.XmlAttribute In xmlNode.Attributes
                    If (xmlAttri.Name$.ToLower$.Equals("name")) Then
                        cTexture.Name$ = xmlAttri.Value.ToString$
                    ElseIf (xmlAttri.Name$.ToLower$.Equals("image")) Then
                        cTexture.Image$ = xmlAttri.Value.ToString$
                    End If
                Next

                Me.objTextures.Add(cTexture)

                cTexture = Nothing
            Next
        Catch ex As Exception
            MessageBox.Show(ex.Message$, "Exception")

            Exit Sub
        End Try
    End Sub
#End Region

#Region " LoadWorld "
    Public Sub LoadWorld()
        Try
            ' load xml config file for world
            Dim xmlDoc As New System.Xml.XmlDocument()
            xmlDoc.Load(Application.StartupPath$ & "\World\Default.wld")

            ' retrieve the node list 
            Dim xmlNodeList As System.Xml.XmlNodeList = xmlDoc.GetElementsByTagName("Area")

            ' build list of areas
            For Each xmlNode As System.Xml.XmlNode In xmlNodeList
                ' initialize area object
                Dim cArea As New CArea()

                ' get list of area attributes
                For Each xmlAttri As System.Xml.XmlAttribute In xmlNode.Attributes
                    If (xmlAttri.Name$.ToLower$.Equals("name")) Then
                        cArea.Name$ = xmlAttri.Value.ToString$
                    ElseIf (xmlAttri.Name$.ToLower$.Equals("mapdata")) Then
                        cArea.MapData$ = xmlAttri.Value.ToString$
                    ElseIf (xmlAttri.Name$.ToLower$.Equals("basetexture")) Then
                        cArea.BaseTexture$ = xmlAttri.Value.ToString$
                    ElseIf (xmlAttri.Name$.ToLower$.Equals("posx")) Then
                        cArea.PositionX! = Convert.ToSingle!(xmlAttri.Value)
                    ElseIf (xmlAttri.Name$.ToLower$.Equals("posy")) Then
                        cArea.PositionY! = Convert.ToSingle!(xmlAttri.Value)
                    ElseIf (xmlAttri.Name$.ToLower$.Equals("posz")) Then
                        cArea.PositionZ! = Convert.ToSingle!(xmlAttri.Value)
                    End If
                Next

                ' add area to collection
                Me.objAreas.Add(cArea)

                'clear temp object
                cArea = Nothing
            Next
        Catch ex As Exception
            MessageBox.Show(ex.Message$, "Exception")

            Exit Sub
        End Try
    End Sub
#End Region

#Region " BuildWorld "
    Public Sub BuildWorld()
        ' load textures
        For Each cTexture As CTexture In Me.objTextures
            cTexture.ID = Me.tvTextures.LoadTexture("World\" & cTexture.Image$, cTexture.Name$, -1, -1, MTV3D65.CONST_TV_COLORKEY.TV_COLORKEY_NO, False)
        Next

        ' retrieve area list
        For Each cArea As CArea In Me.objAreas
            ' initialize tv landscape object
            cArea.Landscape = New MTV3D65.TVLandscape

            ' build terrain based on type of file
            If (cArea.MapData$.EndsWith("jpg")) Then
                cArea.Landscape.GenerateTerrain("World\" & cArea.MapData$, MTV3D65.CONST_TV_LANDSCAPE_PRECISION.TV_PRECISION_AVERAGE, 10, 10, cArea.PositionX!, cArea.PositionY!, cArea.PositionZ!, False)
            Else
                cArea.Landscape.LoadTerrainData("World\" & cArea.MapData$)
            End If

            ' set terrain texture
            cArea.Landscape.SetTexture(GetTexture(cArea.BaseTexture$))

            ' initialize terrain physics
            Me.tvPhysics.CreateStaticTerrainBody(cArea.Landscape)
        Next
    End Sub
#End Region

#Region " GetTexture "
    Private Function GetTexture(ByRef strTexture As String) As Integer
        For Each cTexture As CTexture In Me.objTextures
            If (cTexture.Name$.ToLower$ = strTexture$.ToLower$) Then
                Return cTexture.ID
            End If
        Next

        Return -1
    End Function
#End Region

End Class