tyler.durden
/
P3D-Legacy
mirror of https://github.com/P3D-Legacy/P3D-Legacy.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Removed some dead code

This commit is contained in:
nilllzz 2016-09-21 02:09:50 +02:00
parent 3811f09f57
commit 4a8d249f64
13 changed files with 7 additions and 2035 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
2.5DHero/2.5DHero/2.5DHero.vbproj
View File

@ -1678,14 +1678,6 @@
<Compile Include="World\SkyDome.vb" />
<Compile Include="World\Terrain.vb" />
<Compile Include="World\World.vb" />
<Compile Include="World\XML\PropertyListeners\FacePlayerPropertyListener.vb" />
<Compile Include="World\XML\PropertyListeners\ScriptBlockPropertyListener.vb" />
<Compile Include="World\XML\PropertyListeners\StairsPropertyListener.vb" />
<Compile Include="World\XML\XmlEntity.vb" />
<Compile Include="World\XML\XmlEntityRenderer.vb" />
<Compile Include="World\XML\XmlLevelLoader.vb" />
<Compile Include="World\XML\XmlProperty.vb" />
<Compile Include="World\XML\XmlPropertyListener.vb" />
</ItemGroup>
<ItemGroup>
<Reference Include="OpenTK">
@ -1746,4 +1738,4 @@
</Target>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
<Import Project="$(MSBuildExtensionsPath)\MonoGame\v3.0\MonoGame.Content.Builder.targets" />
</Project>
</Project>

139
2.5DHero/2.5DHero/Modules/Extensions.vb
View File

@ -2,47 +2,6 @@ Imports System.Runtime.CompilerServices
Module Extensions
<Extension()>
Public Function IsNumericList(Of T)(ByVal l As List(Of T)) As Boolean
For Each O As T In l
If IsNumeric(O.ToString().Replace(".", GameController.DecSeparator)) = False Then
Return False
End If
Next
Return True
End Function
<Extension()>
Public Function IsBooleanicList(Of T)(ByVal l As List(Of T)) As Boolean
For Each O As T In l
If O.ToString() <> "0" And O.ToString() <> "1" And O.ToString().ToLower() <> "true" And O.ToString().ToLower() <> "false" And GetType(Boolean) <> O.GetType Then
Return False
End If
Next
Return True
End Function
<Extension()>
Public Function DeleteDuplicates(Of T)(ByVal l As List(Of T)) As List(Of T)
Dim copyList As New List(Of T)
For Each lI As T In l
If copyList.Contains(lI) = False Then
copyList.Add(lI)
End If
Next
Return copyList
End Function
<Extension()>
Public Function ContainsToLower(Of T)(ByVal l As List(Of T), ByVal s As String) As Boolean
For Each Item As T In l
If Item.ToString().ToLower() = s.ToLower() Then
Return True
End If
Next
Return False
End Function
<Extension()>
Public Sub Move(Of T)(ByRef l As List(Of T), ByVal moveItemIndex As Integer, ByVal destinationIndex As Integer)
Dim i As T = l(moveItemIndex)
@ -106,44 +65,6 @@ Module Extensions
Return fullString
End Function
<Extension()>
Public Function SetSplit(ByVal fullString As String, ByVal valueIndex As Integer, ByVal newValue As String, ByVal replace As Boolean) As String
Return SetSplit(fullString, valueIndex, newValue, ",", replace)
End Function
<Extension()>
Public Function SetSplit(ByVal fullString As String, ByVal valueIndex As Integer, ByVal newValue As String, ByVal seperator As String) As String
Return SetSplit(fullString, valueIndex, newValue, seperator, True)
End Function
<Extension()>
Public Function SetSplit(ByVal fullString As String, ByVal valueIndex As Integer, ByVal newValue As String) As String
Return SetSplit(fullString, valueIndex, newValue, ",", True)
End Function
<Extension()>
Public Function RemoveSplit(ByVal fullString As String, ByVal valueIndex As Integer, ByVal separator As String) As String
If fullString.Contains(separator) = False Then
Return ""
End If
Dim s() As String = fullString.Split(CChar(separator))
Dim rString As String = ""
For x = 0 To s.Count - 1
If x <> valueIndex Then
If rString <> "" Then
rString &= separator
End If
rString &= s(x)
End If
Next
Return rString
End Function
<Extension()>
Public Function CountSplits(ByVal fullString As String, ByVal seperator As String) As Integer
Dim i As Integer = 0
@ -175,45 +96,6 @@ Module Extensions
Return i
End Function
<Extension()>
Public Function CountSeperators(ByVal fullstring As String) As Integer
Return CountSeperators(fullstring, ",")
End Function
<Extension()>
Public Sub Print(ByVal s As String)
Logger.Debug(s)
End Sub
<Extension()>
Public Sub Print(ByVal i As Integer)
Logger.Debug(i.ToString())
End Sub
<Extension()>
Public Sub Print(ByVal l As Long)
Logger.Debug(l.ToString())
End Sub
<Extension()>
Public Sub Print(ByVal s As Single)
Logger.Debug(s.ToString())
End Sub
<Extension()>
Public Sub Print(Of T)(ByVal Array() As T)
Dim s As String = "{"
For i = 0 To Array.Length - 1
If i <> 0 Then
s &= ", "
End If
s &= Array(i).ToString()
Next
s &= "}"
Logger.Debug(s)
End Sub
<Extension()>
Public Function ArrayToString(Of T)(ByVal Array() As T, Optional ByVal NewLine As Boolean = False) As String
If NewLine = True Then
@ -254,11 +136,6 @@ Module Extensions
Return s.Replace(vbNewLine, Seperator).Split(CChar(Seperator))
End Function
<Extension()>
Public Function ToList(ByVal s As String, ByVal Seperator As String) As List(Of String)
Return s.Replace(vbNewLine, Seperator).Split(CChar(Seperator)).ToList()
End Function
<Extension()>
Public Function ToPositive(ByVal i As Integer) As Integer
If i < 0 Then
@ -267,14 +144,6 @@ Module Extensions
Return i
End Function
<Extension()>
Public Function ToNegative(ByVal i As Integer) As Integer
If i > 0 Then
i *= -1
End If
Return i
End Function
<Extension()>
Public Function Clamp(ByVal i As Integer, ByVal min As Integer, ByVal max As Integer) As Integer
If i > max Then
@ -554,12 +423,4 @@ Module Extensions
Return New Color(c.R, c.G, c.B, c.A)
End Function
''' <summary>
''' Converts a Xna.Framework.Color into a System.Drawing.Color.
''' </summary>
<Extension()>
Public Function ToDrawing(ByVal c As Color) As Drawing.Color
Return Drawing.Color.FromArgb(c.R, c.G, c.B, c.A)
End Function
End Module

5
2.5DHero/2.5DHero/Pokemon/Monster/PokemonInteractions.vb
View File

@ -819,8 +819,11 @@
Public Function Match(ByVal p As Pokemon) As Boolean
If MapFiles.Count > 0 Then
If MapFiles.ContainsToLower(Screen.Level.LevelFile) = False Then
If MapFiles.Any(Function(m As String)
Return m.ToLowerInvariant() = Screen.Level.LevelFile.ToLowerInvariant()
End Function) Then
Return False
End If
End If

4
2.5DHero/2.5DHero/World/Badge.vb
View File

@ -164,7 +164,7 @@ Public Class Badge
Public Shared Function GetRegion(ByVal index As Integer) As String
Dim regions As New List(Of String)
For Each b As BadgeDeclaration In Badges
If regions.ContainsToLower(b.Region) = False Then
If regions.Any(Function(m As String) m.ToLowerInvariant() = b.Region.ToLowerInvariant()) Then
regions.Add(b.Region)
End If
Next
@ -195,7 +195,7 @@ Public Class Badge
Public Shared Function GetRegionCount() As Integer
Dim regions As New List(Of String)
For Each b As BadgeDeclaration In Badges
If regions.ContainsToLower(b.Region) = False Then
If regions.Any(Function(m As String) m.ToLowerInvariant() = b.Region.ToLowerInvariant()) Then
regions.Add(b.Region)
End If
Next

31
2.5DHero/2.5DHero/World/BaseEntity.vb
View File

@ -10,15 +10,6 @@ Public MustInherit Class BaseEntity
Private _entityType As EntityTypes
''' <summary>
''' The type of entity.
''' </summary>
Public ReadOnly Property EntityType() As EntityTypes
Get
Return Me._entityType
End Get
End Property
''' <summary>
''' Creates a new instance of the BaseEntity class.
''' </summary>
@ -27,26 +18,4 @@ Public MustInherit Class BaseEntity
Me._entityType = EntityType
End Sub
''' <summary>
''' Converts the BaseEntity into an XmlEntity.
''' </summary>
Public Function ToXmlEntity() As XmlLevel.XmlEntity
If Me._entityType = EntityTypes.Entity Then
Throw New Exceptions.InvalidEntityTypeException("Entity", "XmlEntity")
End If
Return CType(Me, XmlLevel.XmlEntity)
End Function
''' <summary>
''' Converts the BaseEntity into an Entity.
''' </summary>
Public Function ToEntity() As Entity
If Me._entityType = EntityTypes.XmlEntity Then
Throw New Exceptions.InvalidEntityTypeException("XmlEntity", "Entity")
End If
Return CType(Me, Entity)
End Function
End Class

21
2.5DHero/2.5DHero/World/XML/PropertyListeners/FacePlayerPropertyListener.vb
View File

@ -1,21 +0,0 @@
Namespace XmlLevel
Public Class FacePlayerPropertyListener
Inherits XmlPropertyListener
Public Sub New(ByVal XmlEntityReference As XmlEntity)
MyBase.New(XmlEntityReference, "faceplayer")
End Sub
Public Overrides Sub UpdateEntity()
If XmlEntity.Rotation.Y <> Screen.Camera.Yaw Then
Dim v As Vector3 = XmlEntity.Rotation
XmlEntity.Rotation = New Vector3(v.X, Screen.Camera.Yaw, v.Z)
XmlEntity.CreatedWorld = False
End If
End Sub
End Class
End Namespace

83
2.5DHero/2.5DHero/World/XML/PropertyListeners/ScriptBlockPropertyListener.vb
View File

@ -1,83 +0,0 @@
Namespace XmlLevel
Public Class ScriptBlockPropertyListener
Inherits XmlPropertyListener
Dim TriggerID As Integer = 0
Dim ScriptID As String = "0"
Dim AcceptedRotations As New List(Of Integer)
Dim ActivateScript As Boolean = False
Public Sub New(ByVal XmlEntityReference As XmlEntity)
MyBase.New(XmlEntityReference, "isscriptblock")
Me.TriggerID = Me.XmlEntity.GetPropertyValue(Of Integer)("scripttrigger")
Me.ScriptID = Me.XmlEntity.GetPropertyValue(Of String)("script")
Me.AcceptedRotations = Me.XmlEntity.GetPropertyValue(Of List(Of Integer))("acceptedscriptrotations")
Me.ImplementWalkInto = True
Me.XmlEntity.EnableUpdate()
End Sub
Public Overrides Function WalkInto() As Boolean
If Me.TriggerID = 0 Or Me.TriggerID = 4 Then
Me.ActivateScript = True
Screen.Level.WalkedSteps = 0
Screen.Level.PokemonEncounterData.EncounteredPokemon = False
End If
Return False
End Function
Public Overrides Sub PlayerInteraction()
If Me.TriggerID = 1 Then
TriggerScript(False)
End If
End Sub
Public Overrides Sub Update()
If Me.ActivateScript = True And Screen.Camera.Position.X = XmlEntity.Position.X And Screen.Camera.Position.Z = XmlEntity.Position.Z Then
Screen.Camera.StopMovement()
ActivateScript = False
TriggerScript(False)
End If
End Sub
Public Sub TriggerScript(ByVal canAttach As Boolean)
If Core.CurrentScreen.Identification = Screen.Identifications.OverworldScreen Then
Dim oS As OverworldScreen = CType(Core.CurrentScreen, OverworldScreen)
If oS.ActionScript.IsReady = True Or canAttach = True Then
Dim activate As Boolean = False
If Me.AcceptedRotations.Count > 0 Then
If Me.AcceptedRotations.Contains(Screen.Camera.GetPlayerFacingDirection()) Then
activate = True
End If
Else
activate = True
End If
If activate = True Then
Dim activationID As Integer = 0
Select Case Me.TriggerID
Case 0, 1, 4
activationID = 0
Case 2
activationID = 1
Case 3
activationID = 2
End Select
oS.ActionScript.StartScript(Me.ScriptID, activationID)
ActionScript.TempSpin = True
End If
End If
End If
End Sub
End Class
End Namespace

128
2.5DHero/2.5DHero/World/XML/PropertyListeners/StairsPropertyListener.vb
View File

@ -1,128 +0,0 @@
Namespace XmlLevel
Public Class StairsPropertyListener
Inherits XmlPropertyListener
Public Sub New(ByVal XmlEntityReference As XmlEntity)
MyBase.New(XmlEntityReference, "isstairs")
Me.ImplementWalkAgainst = True
End Sub
'Public Overrides Function WalkAgainst() As Boolean
' Dim facing As Integer = CInt(Me.XmlEntity.Rotation.Y / MathHelper.PiOver2)
' facing -= 2
' If facing < 0 Then
' facing += 4
' End If
' Screen.Camera.moveDirectionY = 0.0F
' If Screen.Camera.GetPlayerFacingDirection() = facing And Screen.Camera.moved = 0.0F Then
' Dim Steps As Integer = 0
' Dim checkPosition As New Vector3(Me.XmlEntity.Position.X + Screen.Camera.moveDirectionX, Me.XmlEntity.Position.Y + 1, Me.XmlEntity.Position.Z + Screen.Camera.moveDirectionZ)
' Dim foundSteps As Boolean = True
' While foundSteps = True
' Dim e As XmlEntity = Nothing 'TODO: Implement the correct entity list: GetEntity(Screen.Level.Entities, checkPosition)
' If Not e Is Nothing Then
' If e.GetPropertyValue(Of Boolean)("isstairs") = True Then
' Steps += 1
' checkPosition.X += Screen.Camera.moveDirectionX
' checkPosition.Z += Screen.Camera.moveDirectionZ
' checkPosition.Y += 1
' Else
' If e.GetPropertyValue(Of Boolean)("isscripttrigger") = True Then
' 'TODO: Convert the temp entity to be a XmlEntity: Player.Temp.ScriptEntity = e
' ElseIf e.GetPropertyValue(Of Boolean)("iswarp") = True Then
' e.WalkAgainst()
' End If
' foundSteps = False
' End If
' Else
' foundSteps = False
' End If
' End While
' Screen.Level.OverworldPokemon.Visible = False
' Screen.Level.OverworldPokemon.warped = True
' Dim s As String = "@Player:SetMovement(" & Screen.Camera.moveDirectionX & ",1," & Screen.Camera.moveDirectionZ & ")" & vbNewLine &
' "@Player:Move(" & Steps & ")" & vbNewLine &
' "@Player:SetMovement(" & Screen.Camera.moveDirectionX & ",0," & Screen.Camera.moveDirectionZ & ")" & vbNewLine &
' "@Pokemon:Hide" & vbNewLine &
' "@Player:Move(1)" & vbNewLine &
' "@Pokemon:Hide" & vbNewLine &
' ":end"
' CType(Core.CurrentScreen, OverworldScreen).ActionScript.StartScript(s, 2, False)
' Return False
' End If
' facing = CInt(Me.XmlEntity.Rotation.Y / MathHelper.PiOver2)
' If facing < 0 Then
' facing += 4
' End If
' If Screen.Camera.GetPlayerFacingDirection() = facing Then
' Return False
' End If
' Return True
'End Function
'Private Function GetEntity(ByVal List As List(Of XmlEntity), ByVal Position As Vector3) As XmlEntity
' For Each e As XmlEntity In List
' If e.Position.X = Position.X And e.Position.Y = Position.Y And e.Position.Z = Position.Z Then
' Return e
' End If
' Next
' Return Nothing
'End Function
'Public Overrides Sub WalkOnto()
' Dim facing As Integer = CInt(Me.XmlEntity.Rotation.Y / MathHelper.PiOver2)
' Screen.Camera.moveDirectionY = 0.0F
' If Screen.Camera.GetPlayerFacingDirection() = facing Then
' Dim Steps As Integer = 1
' Dim checkPosition As New Vector3(Me.XmlEntity.Position.X + Screen.Camera.moveDirectionX, Me.XmlEntity.Position.Y - 1, Me.XmlEntity.Position.Z + Screen.Camera.moveDirectionZ)
' Dim foundSteps As Boolean = True
' While foundSteps = True
' Dim e As XmlEntity = Nothing 'TODO: Implement the correct entity list: GetEntity(Screen.Level.Entities, checkPosition)
' If Not e Is Nothing Then
' If e.GetPropertyValue(Of Boolean)("isstairs") = True Then
' Steps += 1
' checkPosition.X += Screen.Camera.moveDirectionX
' checkPosition.Z += Screen.Camera.moveDirectionZ
' checkPosition.Y -= 1
' Else
' If e.GetPropertyValue(Of Boolean)("isscripttrigger") = True Then
' 'TODO: Convert the temp entity to be a XmlEntity: Player.Temp.ScriptEntity = e
' ElseIf e.GetPropertyValue(Of Boolean)("iswarp") = True Then
' e.WalkAgainst()
' End If
' foundSteps = False
' End If
' Else
' foundSteps = False
' End If
' End While
' Screen.Level.OverworldPokemon.Visible = False
' Screen.Level.OverworldPokemon.warped = True
' Dim s As String = "@Player:Move(1)" & vbNewLine &
' "@Player:SetMovement(" & Screen.Camera.moveDirectionX & ",-1," & Screen.Camera.moveDirectionZ & ")" & vbNewLine &
' "@Player:Move(" & Steps & ")" & vbNewLine &
' "@Pokemon:Hide" & vbNewLine &
' "@Player:SetMovement(" & Screen.Camera.moveDirectionX & ",0," & Screen.Camera.moveDirectionZ & ")" & vbNewLine &
' ":end"
' CType(Core.CurrentScreen, OverworldScreen).ActionScript.StartScript(s, 2, False)
' End If
'End Sub
End Class
End Namespace

495
2.5DHero/2.5DHero/World/XML/XmlEntity.vb
View File

@ -1,495 +0,0 @@
Namespace XmlLevel
Public Class XmlEntity
Inherits BaseEntity
#Region "PropertyShenanigans"
Private _properties As New List(Of XmlProperty) 'The list of properties. The values of the properties represent the spawned or added property values. If they change, they get changed in the stored property list.
Private _storedProperties As New Dictionary(Of String, Object) 'This efficiently stores all currently active property values.
Private _propertyListeners As New List(Of XmlPropertyListener) 'The list of property listeners. A property listener provides functionality for an entity.
''' <summary>
''' Returns the value of a property.
''' </summary>
''' <typeparam name="T">The type of the property value.</typeparam>
''' <param name="Name">The name of the property.</param>
Public Function GetPropertyValue(Of T)(ByVal Name As String) As T
If _storedProperties.ContainsKey(Name.ToLower()) = True Then
Return CType(_storedProperties(Name.ToLower()), T)
End If
'If the property isn't stored already, add it to the store.
Dim newPropertyValue As Object = XmlProperty.ConvertFromString(GetProperty(Name))
_storedProperties.Add(Name.ToLower(), newPropertyValue)
Return CType(newPropertyValue, T)
End Function
''' <summary>
''' Returns a property of this entity based on its name.
''' </summary>
''' <param name="Name">The name of the property.</param>
Private Function GetProperty(ByVal Name As String) As XmlProperty
For i = 0 To Me._properties.Count - 1
If Me._properties(i).Name.ToLower() = Name.ToLower() Then
Return Me._properties(i)
End If
Next
'If this entity doesn't have the property, add the default property.
Dim newProperty As XmlProperty = XmlProperty.GetDefaultProperty(Name)
Me._properties.Add(newProperty)
Return newProperty
End Function
''' <summary>
''' Sets the value of a property.
''' </summary>
''' <typeparam name="T">The type of the propertie's value</typeparam>
''' <param name="Name">The name of the property.</param>
''' <param name="Value">The new value of the property.</param>
Public Sub SetPropertyValue(Of T)(ByVal Name As String, ByVal Value As T)
If _storedProperties.ContainsKey(Name.ToLower()) = True Then
_storedProperties(Name.ToLower()) = Value
Else
'Add a new store property if it doesn't exist already.
_storedProperties.Add(Name.ToLower(), Value)
End If
End Sub
''' <summary>
''' Adds a new property to the list of properties.
''' </summary>
''' <param name="Name">The name of the property.</param>
''' <param name="Value">The value of the property.</param>
Public Sub AddProperty(ByVal Name As String, ByVal Value As String)
Dim defaultProperty As XmlProperty = XmlProperty.GetDefaultProperty(Name)
Me._properties.Add(New XmlProperty(Name, Value, defaultProperty.Type))
End Sub
Public Function GetPropertyListener(ByVal AssociatedPropertyName As String) As XmlPropertyListener
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
If PropertyListener.AssociatedPropertyName.ToLower() = AssociatedPropertyName.ToLower() Then
Return PropertyListener
End If
Next
Return Nothing
End Function
Public Function GetPropertyListener(Of T)(ByVal AssociatedPropertyName As String) As T
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
If PropertyListener.AssociatedPropertyName.ToLower() = AssociatedPropertyName.ToLower() Then
Return CType(CObj(PropertyListener), T)
End If
Next
Return Nothing
End Function
''' <summary>
''' Checks if this entity has the requested PropertyListener.
''' </summary>
''' <param name="AssociatedPropertyName">The name of the PropertyListener.</param>
Public Function HasPropertyListener(ByVal AssociatedPropertyName As String) As Boolean
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
If PropertyListener.AssociatedPropertyName.ToLower() = AssociatedPropertyName.ToLower() Then
Return True
End If
Next
Return False
End Function
''' <summary>
''' Adds a PropertyListener to the list of PropertyListeners.
''' </summary>
''' <param name="PropertyListener">The PropertyListener to add.</param>
Public Sub AddPropertyListener(ByVal PropertyListener As XmlPropertyListener)
Me._propertyListeners.Add(PropertyListener)
End Sub
''' <summary>
''' Returns if a property with a specific name exists for this entity.
''' </summary>
''' <param name="PropertyName">The name of the property.</param>
Public ReadOnly Property PropertyExists(ByVal PropertyName As String) As Boolean
Get
For Each p As XmlProperty In Me._properties
If p.Name.ToLower() = propertyName.ToLower() Then
Return True
End If
Next
Return False
End Get
End Property
''' <summary>
''' Returns a list of names of the properties of this entity.
''' </summary>
Public Function GetPropertyNameList() As List(Of String)
Dim ll As New List(Of String)
For Each p As XmlProperty In Me._properties
ll.Add(p.Name)
Next
Return ll
End Function
#End Region
#Region "QuickAccessProperties"
Public Property Scale() As Vector3
Get
Return GetPropertyValue(Of Vector3)("scale")
End Get
Set(value As Vector3)
SetPropertyValue(Of Vector3)("scale", value)
End Set
End Property
Public Property Rotation() As Vector3
Get
Return GetPropertyValue(Of Vector3)("rotation")
End Get
Set(value As Vector3)
SetPropertyValue(Of Vector3)("rotation", value)
End Set
End Property
Public Property Position() As Vector3
Get
Return GetPropertyValue(Of Vector3)("position")
End Get
Set(value As Vector3)
SetPropertyValue(Of Vector3)("position", value)
End Set
End Property
Public Property Visible() As Boolean
Get
Return GetPropertyValue(Of Boolean)("visible")
End Get
Set(value As Boolean)
SetPropertyValue(Of Boolean)("visible", value)
End Set
End Property
Public Property RenderType() As String
Get
Dim s As String = GetPropertyValue(Of String)("rendertype")
Dim validRenderTypes() As String = {"model", "basemodel"}
If validRenderTypes.Contains(s.ToLower()) = True Then
Return s
Else
Return "basemodel"
End If
End Get
Set(value As String)
SetPropertyValue(Of String)("rendertype", value)
End Set
End Property
Public Property TextureIndex() As Integer()
Get
Return Me.GetPropertyValue(Of List(Of Integer))("textureindex").ToArray()
End Get
Set(value As Integer())
Me.SetPropertyValue(Of List(Of Integer))("textureindex", value.ToList())
End Set
End Property
Public Property Shader() As Vector3
Get
Return GetPropertyValue(Of Vector3)("shader")
End Get
Set(value As Vector3)
SetPropertyValue(Of Vector3)("shader", value)
End Set
End Property
Public Property Opacity() As Single
Get
Return GetPropertyValue(Of Single)("opacity")
End Get
Set(value As Single)
Me.SetPropertyValue(Of Single)("opacity", value)
End Set
End Property
#End Region
Public CreatedWorld As Boolean = False
Public CreateWorldEveryFrame As Boolean = False
Public CameraDistance As Single = 0.0F
Public Textures As New List(Of Texture2D)
Public World As Matrix = Nothing
Public Shaders As New List(Of Vector3)
Public IsOffsetMapContent As Boolean = False
Public Viewbox As BoundingBox
Public BoundingBox As BoundingBox
Dim ViewBoxScale As Vector3 = Vector3.One
Dim BoundingBoxScale As Vector3 = New Vector3(1.5F)
Dim BoundingBoxCreated As Vector3 = New Vector3(-999)
Private _needsUpdate As Boolean = False 'Can only be set to true by PropertyListeners
Private EntityRenderer As XmlEntityRenderer
#Region "Initialize"
Public Sub New()
MyBase.New(EntityTypes.XmlEntity)
Me.EntityRenderer = New XmlEntityRenderer(Me)
End Sub
Public Sub Initialize()
Me._propertyListeners = XmlPropertyListener.GetPropertyListeners(Me)
Me.CreateBoundingBoxes()
Me.LoadTextures()
Me.LoadSeasonTextures()
Me.UpdateEntity()
End Sub
Private Sub LoadTextures()
Me.Textures.Clear()
Dim TexturePath As String = Me.GetPropertyValue(Of String)("texturepath")
For Each TextureRectangle As Rectangle In GetPropertyValue(Of List(Of Rectangle))("textures")
Me.Textures.Add(net.Pokemon3D.Game.TextureManager.GetTexture(TexturePath, TextureRectangle))
Next
End Sub
Private Sub LoadSeasonTextures()
Dim seasonTexture As String = GetPropertyValue(Of String)("seasontexture")
If seasonTexture <> "" Then
Dim newTextures As New List(Of Texture2D)
For Each t As Texture2D In Textures
newTextures.Add(net.Pokemon3D.Game.World.GetSeasonTexture(net.Pokemon3D.Game.TextureManager.GetTexture("Textures\Seasons\" & seasonTexture), t))
Next
Me.Textures = newTextures
End If
End Sub
Private Sub CreateBoundingBoxes()
Viewbox = New BoundingBox(
Vector3.Transform(New Vector3(-(Me.Scale.X / 2), -(Me.Scale.Y / 2), -(Me.Scale.Z / 2)), Matrix.CreateScale(ViewBoxScale) * Matrix.CreateTranslation(Position)),
Vector3.Transform(New Vector3((Me.Scale.X / 2), (Me.Scale.Y / 2), (Me.Scale.Z / 2)), Matrix.CreateScale(ViewBoxScale) * Matrix.CreateTranslation(Position)))
BoundingBox = New BoundingBox(
Vector3.Transform(New Vector3(-0.5F), Matrix.CreateScale(BoundingBoxScale) * Matrix.CreateTranslation(Position)),
Vector3.Transform(New Vector3(0.5F), Matrix.CreateScale(BoundingBoxScale) * Matrix.CreateTranslation(Position)))
Me.BoundingBoxCreated = Me.Position
End Sub
#End Region
#Region "Interactions"
Public Sub PlayerInteraction()
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
PropertyListener.PlayerInteraction()
Next
End Sub
Public Function WalkAgainst() As Boolean
Dim b As Boolean = True
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
If PropertyListener.ImplementWalkAgainst = True Then
b = PropertyListener.WalkAgainst()
End If
Next
Return b
End Function
Public Function WalkInto() As Boolean
Dim b As Boolean = True
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
If PropertyListener.ImplementWalkInto = True Then
b = PropertyListener.WalkInto()
End If
Next
Return b
End Function
Public Sub WalkOnto()
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
PropertyListener.WalkOnto()
Next
End Sub
Public Sub ResultFunction(ByVal Result As Integer)
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
PropertyListener.ResultFunction(Result)
Next
End Sub
Public Function LetPlayerMove() As Boolean
Dim b As Boolean = True
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
If PropertyListener.ImplementLetPlayerMove = True Then
b = PropertyListener.LetPlayerMove()
End If
Next
Return b
End Function
#End Region
#Region "Update/Render"
Public Sub UpdateEntity()
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
PropertyListener.UpdateEntity()
Next
'Do normal entity update stuff:
Me.CalculateCameraDistance()
Me.OpacityCheck()
Me.CreateWorldMatrix()
Me.UpdateBoundingBoxes()
Me.SetShader()
End Sub
Public Sub Update()
If Me._needsUpdate = True Then
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
PropertyListener.Update()
Next
End If
End Sub
Public Sub Draw()
If Visible = True Then
'Draw everything on screen like weird stuff an entity might need. Is empty right now.
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
PropertyListener.Draw()
Next
End If
End Sub
Public Sub Render()
If Visible = True Then
If IsInFieldOfView() = True Then
For Each PropertyListener As XmlPropertyListener In Me._propertyListeners
PropertyListener.Render()
Next
Me.EntityRenderer.Render()
End If
End If
End Sub
#End Region
Public Sub EnableUpdate()
Me._needsUpdate = True
End Sub
Public Function IsInFieldOfView() As Boolean
If Not Screen.Camera.BoundingFrustum.Contains(Me.Viewbox) = ContainmentType.Disjoint Then
Return True
Else
Return False
End If
End Function
Private Function GetCenter() As Vector3
If Not Me.EntityRenderer.BaseModel Is Nothing Then
Select Case Me.EntityRenderer.BaseModel.ID
Case 0, 9, 10, 11
Return New Vector3(0.0F, -0.5F, 0.0F)
End Select
End If
'Default:
Return Vector3.Zero
End Function
Private Sub CalculateCameraDistance()
'Get camera position:
Dim CPosition As Vector3 = Screen.Camera.Position
If Not Core.CurrentScreen Is Nothing Then
If Screen.Camera.Name.ToLower() = "overworld" Then
CPosition = CType(Screen.Camera, OverworldCamera).CPosition
End If
End If
'Calculate camera distance:
Me.CameraDistance = Vector3.Distance(Me.Position + Me.GetCenter(), CPosition)
End Sub
Private Sub OpacityCheck()
'Do opacity check:
If Me.IsOffsetMapContent = False Then
'Me.OpacityCheck()
End If
End Sub
Private Sub CreateWorldMatrix()
'Create the world matrix, if required:
If Me.CreatedWorld = False Or Me.CreateWorldEveryFrame = True Then
World = Matrix.CreateScale(Me.Scale) * Matrix.CreateFromYawPitchRoll(Me.Rotation.Y, Me.Rotation.X, Me.Rotation.Z) * Matrix.CreateTranslation(Me.Position)
CreatedWorld = True
End If
End Sub
Private Sub UpdateBoundingBoxes()
'Create view and bounding boxes, if required:
If CameraDistance < Screen.Camera.FarPlane * 2 Then
If Me.Position <> Me.BoundingBoxCreated Then
Dim diff As New List(Of Single)
diff.AddRange({Me.BoundingBoxCreated.X - Me.Position.X, Me.BoundingBoxCreated.Y - Me.Position.Y, Me.BoundingBoxCreated.Z - Me.Position.Z})
Viewbox.Min.X -= diff(0)
Viewbox.Min.Y -= diff(1)
Viewbox.Min.Z -= diff(2)
Viewbox.Max.X -= diff(0)
Viewbox.Max.Y -= diff(1)
Viewbox.Max.Z -= diff(2)
BoundingBox.Min.X -= diff(0)
BoundingBox.Min.Y -= diff(1)
BoundingBox.Min.Z -= diff(2)
BoundingBox.Max.X -= diff(0)
BoundingBox.Max.Y -= diff(1)
BoundingBox.Max.Z -= diff(2)
Me.BoundingBoxCreated = Me.Position
End If
End If
End Sub
Private Sub SetShader()
Select Case Screen.Level.World.EnvironmentType
Case net.Pokemon3D.Game.World.EnvironmentTypes.Outside
Me.Shader = SkyDome.GetDaytimeColor(True).ToVector3()
Case net.Pokemon3D.Game.World.EnvironmentTypes.Dark
Me.Shader = New Vector3(0.5F, 0.5F, 0.6F)
Case Else
Me.Shader = New Vector3(1.0F)
End Select
For Each s As Vector3 In Me.Shaders
Me.Shader *= s
Next
End Sub
End Class
End Namespace

199
2.5DHero/2.5DHero/World/XML/XmlEntityRenderer.vb
View File

@ -1,199 +0,0 @@
Namespace XmlLevel
Public Class XmlEntityRenderer
Public XmlEntity As XmlEntity
Private Shared newRasterizerState As RasterizerState
Private Shared oldRasterizerState As RasterizerState
Public Shared drawBoudingBox As Boolean = False
Public Shared drawViewBox As Boolean = False
Private _baseModel As BaseModel = Nothing
Private _renderModel As Model = Nothing
Public Sub New(ByVal XmlEntityReference As XmlEntity)
Me.XmlEntity = XmlEntityReference
'Load shared rasterizer states, if not done already:
If newRasterizerState Is Nothing Then
newRasterizerState = New RasterizerState()
oldRasterizerState = New RasterizerState()
newRasterizerState.CullMode = CullMode.None
oldRasterizerState.CullMode = CullMode.CullCounterClockwiseFace
End If
End Sub
Public Sub Render()
Me.LoadModel(Me.XmlEntity.RenderType)
Select Case Me.XmlEntity.RenderType.ToLower()
Case "basemodel"
If Not Me._baseModel Is Nothing Then
If Me.XmlEntity.GetPropertyValue(Of Boolean)("culling") = True Then
Core.GraphicsDevice.RasterizerState = newRasterizerState
End If
Me.RenderBaseModel()
If Me.XmlEntity.GetPropertyValue(Of Boolean)("culling") = True Then
Core.GraphicsDevice.RasterizerState = oldRasterizerState
End If
End If
Case "model"
If Not Me._renderModel Is Nothing Then
Me.ApplyRenderModelEffect()
Me.RenderRenderModel()
End If
End Select
Me.RenderBoundingBoxes()
End Sub
Private Sub RenderBoundingBoxes()
If drawBoudingBox = True Then
BoundingBoxRenderer.Render(XmlEntity.BoundingBox, Core.GraphicsDevice, Screen.Camera.View, Screen.Camera.Projection, Color.White)
End If
If drawViewBox = True Then
BoundingBoxRenderer.Render(XmlEntity.ViewBox, Core.GraphicsDevice, Screen.Camera.View, Screen.Camera.Projection, Color.LightCoral)
End If
End Sub
Private Sub RenderBaseModel()
Dim effectDiffuseColor As Vector3 = Screen.Effect.DiffuseColor
Screen.Effect.World = Me.XmlEntity.World
Screen.Effect.TextureEnabled = True
Screen.Effect.Alpha = Me.XmlEntity.Opacity
Screen.Effect.DiffuseColor = effectDiffuseColor * Me.XmlEntity.Shader
If Screen.Level.IsDark = True Then
Screen.Effect.DiffuseColor *= New Vector3(0.5, 0.5, 0.5)
End If
Core.GraphicsDevice.SetVertexBuffer(Me._baseModel.vertexBuffer)
If CInt(Me._baseModel.vertexBuffer.VertexCount / 3) > Me.XmlEntity.TextureIndex.Count Then
Dim newTextureIndex(CInt(Me._baseModel.vertexBuffer.VertexCount / 3)) As Integer
For i = 0 To CInt(Me._baseModel.vertexBuffer.VertexCount / 3)
If Me.XmlEntity.TextureIndex.Count - 1 >= i Then
newTextureIndex(i) = Me.XmlEntity.TextureIndex(i)
Else
newTextureIndex(i) = 0
End If
Next
Me.XmlEntity.TextureIndex = newTextureIndex
End If
Dim isEqual As Boolean = True
Dim contains As Integer = Me.XmlEntity.TextureIndex(0)
For index = 1 To Me.XmlEntity.TextureIndex.Length - 1
If contains <> Me.XmlEntity.TextureIndex(index) Then
isEqual = False
Exit For
End If
Next
If isEqual = True Then
If Me.XmlEntity.TextureIndex(0) > -1 Then
Screen.Effect.Texture = Me.XmlEntity.Textures(Me.XmlEntity.TextureIndex(0))
Screen.Effect.CurrentTechnique.Passes(0).Apply()
Core.GraphicsDevice.DrawPrimitives(PrimitiveType.TriangleList, 0, CInt(Me._baseModel.vertexBuffer.VertexCount / 3))
DebugDisplay.DrawnVertices += CInt(Me._baseModel.vertexBuffer.VertexCount / 3)
End If
Else
For i = 0 To Me._baseModel.vertexBuffer.VertexCount - 1 Step 3
If Me.XmlEntity.TextureIndex(CInt(i / 3)) > -1 Then
Screen.Effect.Texture = Me.XmlEntity.Textures(Me.XmlEntity.TextureIndex(CInt(i / 3)))
Screen.Effect.CurrentTechnique.Passes(0).Apply()
Core.GraphicsDevice.DrawPrimitives(PrimitiveType.TriangleList, i, 1)
DebugDisplay.DrawnVertices += 1
End If
Next
End If
Screen.Effect.DiffuseColor = effectDiffuseColor
If DebugDisplay.MaxDistance < Me.XmlEntity.CameraDistance Then DebugDisplay.MaxDistance = CInt(Me.XmlEntity.CameraDistance)
End Sub
Private Sub RenderRenderModel()
If Not Me._renderModel Is Nothing Then
Me._renderModel.Draw(Me.XmlEntity.World, Screen.Camera.View, Screen.Camera.Projection)
End If
End Sub
Private loadedBaseModel As Boolean = False
Private loadedRenderModel As Boolean = False
Private Sub LoadModel(ByVal RenderType As String)
Select Case RenderType.ToLower()
Case "basemodel"
If Me.loadedBaseModel = False Then
Me._baseModel = net.Pokemon3D.Game.BaseModel.getModelbyID(Me.XmlEntity.GetPropertyValue(Of Integer)("basemodel"))
Me.loadedBaseModel = True
End If
Case "model"
If loadedRenderModel = False Then
Dim modelPath As String = Me.XmlEntity.GetPropertyValue(Of String)("model")
If ModelManager.ModelExist(modelPath) = True Then
Me._renderModel = ModelManager.GetModel(modelPath)
Me.loadedRenderModel = True
End If
End If
End Select
End Sub
Dim defaultDiffuseColor As Vector3 = Nothing 'Stores the default diffuse color for the model.
Dim setDefaultDiffuseColor As Boolean = False 'checks if the default diffuse color has been set already.
''' <summary>
''' This sub applies all the shading effects done by weather and daytime to the model, if rendered.
''' </summary>
Private Sub ApplyRenderModelEffect() 'Call this function before the model gets rendered.
For Each mesh As ModelMesh In Me._renderModel.Meshes
For Each part As ModelMeshPart In mesh.MeshParts
If part.Effect.GetType().Name.ToLower() = Screen.Effect.GetType().Name.ToLower() Then
Lighting.UpdateLighting(CType(part.Effect, BasicEffect), True)
If setDefaultDiffuseColor = False Then
setDefaultDiffuseColor = True
defaultDiffuseColor = CType(part.Effect, BasicEffect).DiffuseColor
End If
CType(part.Effect, BasicEffect).DiffuseColor = Screen.Effect.DiffuseColor * defaultDiffuseColor
If Screen.Level.IsDark = True Then
CType(part.Effect, BasicEffect).DiffuseColor = New Vector3(0.5, 0.5, 0.5) * defaultDiffuseColor
End If
CType(part.Effect, BasicEffect).FogEnabled = True
CType(part.Effect, BasicEffect).FogColor = Screen.Effect.FogColor
CType(part.Effect, BasicEffect).FogEnd = Screen.Effect.FogEnd
CType(part.Effect, BasicEffect).FogStart = Screen.Effect.FogStart
End If
Next
Next
End Sub
Public ReadOnly Property BaseModel() As BaseModel
Get
Return Me._baseModel
End Get
End Property
Public ReadOnly Property RenderModel() As Model
Get
Return Me._renderModel
End Get
End Property
End Class
End Namespace

436
2.5DHero/2.5DHero/World/XML/XmlLevelLoader.vb
View File

@ -1,436 +0,0 @@
Imports System.Xml
Namespace XmlLevel
Public Class XmlLevelLoader
Public Enum NameSpaces
None
Settings
Entities
Structures
Shaders
Offsetmaps
End Enum
Public Enum LevelTypes
[Default]
Offset
[Structure]
End Enum
Dim CurrentNamespace As NameSpaces = NameSpaces.None 'The current namespace the reader is in.
Dim LevelOpen As Boolean = False 'Checks if the reader is inside the <level> tag.
Dim Offset As Vector3 'The offset for offset and structure maps.
Dim LevelType As LevelTypes = LevelTypes.Default 'The leveltype for the current instance of the XMLLevelLoader
Dim MapOrigin As String = "" 'The map origin of the offset or structure map.
Dim CurrentFieldSize As Vector3 = Vector3.One
Dim CurrentFieldStep As Vector3 = Vector3.One
Public Sub Load(ByVal path As String, ByVal levelType As LevelTypes, ByVal offset As Vector3)
If IsValidXML(path) = False Then
'Report invalid XML file
Exit Sub
End If
Me.LevelType = levelType
Me.Offset = offset
Me.MapOrigin = path
Dim reader As New XmlTextReader(path)
Me.CleanLevel()
Do While reader.Read()
Select Case reader.NodeType
Case XmlNodeType.Element
If reader.Name.ToLower() = "level" Then
LevelOpen = True
Else
If LevelOpen = True Then
Select Case reader.Name.ToLower()
Case "settings"
Me.CurrentNamespace = NameSpaces.Settings
Case "shaders"
Me.CurrentNamespace = NameSpaces.Shaders
Case "entities"
Me.CurrentNamespace = NameSpaces.Entities
Case "structures"
Me.CurrentNamespace = NameSpaces.Structures
Case "offsetmaps"
Me.CurrentNamespace = NameSpaces.Offsetmaps
Case "field"
Me.ReadField(reader)
Case "setting"
If Me.CurrentNamespace = NameSpaces.Settings Then
If Me.LevelType = LevelTypes.Default Then
Me.ReadSetting(reader)
End If
Else
Me.ReportInvalidNamespace(reader.Name)
End If
Case "entity"
If Me.CurrentNamespace = NameSpaces.Entities Then
Me.AddEntity(reader)
Else
Me.ReportInvalidNamespace(reader.Name)
End If
Case "structure"
If Me.CurrentNamespace = NameSpaces.Structures Then
If Me.LevelType <> LevelTypes.Structure Then
Me.ReadStructure(reader)
End If
Else
Me.ReportInvalidNamespace(reader.Name)
End If
Case "shader"
If Me.CurrentNamespace = NameSpaces.Shaders Then
'TODO: Read shader
Else
Me.ReportInvalidNamespace(reader.Name)
End If
Case "offset"
If Me.CurrentNamespace = NameSpaces.Offsetmaps Then
If Me.LevelType = LevelTypes.Default Then
'TODO: Read offset map
End If
Else
Me.ReportInvalidNamespace(reader.Name)
End If
End Select
End If
End If
Case XmlNodeType.EndElement
Select Case reader.Name.ToLower()
Case "settings", "shaders", "entities", "offsetmaps", "structures"
CurrentNamespace = NameSpaces.None
Case "level"
LevelOpen = False
Case "field"
Me.CurrentFieldSize = Vector3.One
Me.CurrentFieldStep = Vector3.One
End Select
End Select
Loop
End Sub
#Region "Entity"
Private Sub AddEntity(ByVal reader As XmlTextReader)
Dim e As XmlEntity = ReadEntity(reader)
MsgBox(e.ToString())
Dim Entities As New List(Of XmlEntity)
For x = 0 To CInt(Me.CurrentFieldSize.X) - 1 Step CInt(CurrentFieldStep.X)
For z = 0 To CInt(Me.CurrentFieldSize.Z) - 1 Step CInt(CurrentFieldStep.Z)
For y = 0 To CInt(Me.CurrentFieldSize.Y) - 1 Step CInt(CurrentFieldStep.Y)
'Dim newEntity As XmlEntity = CType(e.Clone(), XmlEntity)
'newEntity.Position += New Vector3(x, y, z)
'Entities.Add(newEntity)
Next
Next
Next
'TODO: add entities to level.
End Sub
Private Function ReadEntity(ByVal reader As XmlTextReader) As XmlEntity
Dim attributes As Dictionary(Of String, String) = GetAttributes(reader)
Dim e As New XmlEntity()
For i = 0 To attributes.Count - 1
Dim name As String = attributes.Keys(i)
Dim value As String = attributes.Values(i)
e.AddProperty(name, value)
Next
Return e
End Function
#End Region
Private Sub ReadStructure(ByVal reader As XmlTextReader)
Dim attributes As Dictionary(Of String, String) = GetAttributes(reader)
Dim Map As String = GetAttribute(Of String)("map", attributes, "")
Dim Position As Vector3 = GetAttribute(Of Vector3)("position", attributes, Vector3.Zero)
If Map <> "" Then
Dim levelLoader As New XmlLevelLoader()
levelLoader.Load(Map, LevelTypes.Structure, Position)
End If
End Sub
Private Sub ReadOffsetMap(ByVal reader As XmlTextReader)
Dim attributes As Dictionary(Of String, String) = GetAttributes(reader)
Dim Map As String = GetAttribute(Of String)("map", attributes, "")
Dim Position As Vector3 = GetAttribute(Of Vector3)("position", attributes, Vector3.Zero)
If Map <> "" Then
Dim levelLoader As New XmlLevelLoader()
levelLoader.Load(Map, LevelTypes.Offset, Position)
End If
End Sub
Private Sub ReadField(ByVal reader As XmlTextReader)
Dim attributes As Dictionary(Of String, String) = GetAttributes(reader)
Dim Size As Vector3 = GetAttribute(Of Vector3)("size", attributes, Vector3.One)
Dim Steps As Vector3 = GetAttribute(Of Vector3)("step", attributes, Vector3.One)
Me.CurrentFieldSize = Size
Me.CurrentFieldStep = Steps
End Sub
Private Sub ReadSetting(ByVal reader As XmlTextReader)
Dim attributes As Dictionary(Of String, String) = GetAttributes(reader)
Dim name As String = ""
Dim content As String = ""
For i = 0 To attributes.Count - 1
Dim attName As String = attributes.Keys(i)
Dim attValue As String = attributes.Values(i).ToString()
Select Case attName.ToLower()
Case "name"
name = attValue
Case "content"
content = attValue
End Select
Next
If name <> "" And content <> "" Then
Select Case name.ToLower()
Case "name"
Screen.Level.MapName = content
Case "music"
Screen.Level.MusicLoop = content
Case "canteleport"
Screen.Level.CanTeleport = GetBool(content)
Case "candig"
Screen.Level.CanDig = GetBool(content)
Case "canfly"
Screen.Level.CanFly = GetBool(content)
Case "environmenttype"
Screen.Level.EnvironmentType = GetInt(content)
Case "weather"
Screen.Level.WeatherType = GetInt(content)
Case "lightning"
Screen.Level.LightingType = GetInt(content)
End Select
End If
End Sub
#Region "HelperFunctions"
Private Sub CleanLevel()
If Me.LevelType = LevelTypes.Default Then
Screen.Level.LevelFile = Me.MapOrigin
Core.Player.LastSavePlace = Screen.Level.LevelFile
Core.Player.LastSavePlacePosition = Player.Temp.LastPosition.X & "," & Player.Temp.LastPosition.Y.ToString().Replace(GameController.DecSeparator, ".") & "," & Player.Temp.LastPosition.Z
Screen.Level.Entities.Clear()
Screen.Level.Floors.Clear()
Screen.Level.Shaders.Clear()
Screen.Level.OffsetmapFloors.Clear()
Screen.Level.OffsetmapEntities.Clear()
Screen.Level.WildPokemonFloor = False
Screen.Level.WalkedSteps = 0
LevelLoader.LoadedOffsetMapNames.Clear()
LevelLoader.LoadedOffsetMapOffsets.Clear()
Player.Temp.MapSteps = 0
End If
End Sub
Private Function GetAttributes(ByVal reader As XmlTextReader) As Dictionary(Of String, String)
Dim d As New Dictionary(Of String, String)
If reader.HasAttributes = True Then
While reader.MoveToNextAttribute()
d.Add(reader.Name, reader.Value)
End While
End If
Return d
End Function
Private Function GetAttribute(Of T)(ByVal Name As String, ByVal Attributes As Dictionary(Of String, String), ByVal Separator As Char, ByVal DefaultValue As T) As T
For i = 0 To Attributes.Count - 1
If Attributes.Keys(i).ToLower() = Name.ToLower() Then
Dim s As String = Attributes.Values(i)
Select Case GetType(T)
Case GetType(String)
Return CType(CObj(s), T)
Case GetType(System.Collections.Generic.List(Of String))
Return CType(CObj(s.Split(Separator).ToList()), T)
Case GetType(Boolean)
Return CType(CObj(GetBool(s)), T)
Case GetType(System.Collections.Generic.List(Of Boolean))
Dim values() As String = s.Split(Separator)
Dim arr As New List(Of Boolean)
For Each v As String In values
arr.Add(GetBool(v))
Next
Return CType(CObj(arr), T)
Case GetType(Integer)
Return CType(CObj(GetInt(s)), T)
Case GetType(System.Collections.Generic.List(Of Integer))
Dim values() As String = s.Split(Separator)
Dim arr As New List(Of Integer)
For Each v As String In values
arr.Add(GetInt(v))
Next
Return CType(CObj(arr), T)
Case GetType(Single)
Return CType(CObj(GetSng(s)), T)
Case GetType(System.Collections.Generic.List(Of Single))
Dim values() As String = s.Split(Separator)
Dim arr As New List(Of Single)
For Each v As String In values
arr.Add(GetSng(v))
Next
Return CType(CObj(arr), T)
Case GetType(Rectangle)
Dim content() As String = s.Split(Separator)
If content.Length >= 4 Then
Dim rec As New Rectangle(CInt(content(0)), CInt(content(1)), CInt(content(2)), CInt(content(3)))
Else
Return DefaultValue
End If
Case GetType(System.Collections.Generic.List(Of Rectangle))
Dim values() As String = s.Split(CChar("]"))
Dim arr As New List(Of Rectangle)
For Each v As String In values
If v.Length > 0 Then
v = v.Remove(0, 1)
Dim content() As String = v.Split(Separator)
If content.Length >= 4 Then
arr.Add(New Rectangle(CInt(content(0)), CInt(content(1)), CInt(content(2)), CInt(content(3))))
End If
End If
Next
Return CType(CObj(arr), T)
Case GetType(Vector2)
Dim values() As String = s.Split(Separator)
Dim arr As New List(Of Single)
For Each v As String In values
arr.Add(GetSng(v))
Next
If arr.Count >= 2 Then
Dim vector As New Vector2(arr(0), arr(1))
Return CType(CObj(vector), T)
ElseIf arr.Count = 1 Then
Dim vector As New Vector2(arr(0))
Return CType(CObj(vector), T)
Else
Return DefaultValue
End If
Case GetType(Vector3)
Dim values() As String = s.Split(Separator)
Dim arr As New List(Of Single)
For Each v As String In values
arr.Add(GetSng(v))
Next
If arr.Count >= 3 Then
Dim vector As New Vector3(arr(0), arr(1), arr(2))
Return CType(CObj(vector), T)
ElseIf arr.Count = 1 Then
Dim vector As New Vector3(arr(0))
Return CType(CObj(vector), T)
Else
Return DefaultValue
End If
Case GetType(Vector4)
Dim values() As String = s.Split(Separator)
Dim arr As New List(Of Single)
For Each v As String In values
arr.Add(GetSng(v))
Next
If arr.Count >= 4 Then
Dim vector As New Vector4(arr(0), arr(1), arr(2), arr(3))
Return CType(CObj(vector), T)
ElseIf arr.Count = 1 Then
Dim vector As New Vector4(arr(0))
Return CType(CObj(vector), T)
Else
Return DefaultValue
End If
End Select
End If
Next
Return DefaultValue
End Function
Private Function GetAttribute(Of T)(ByVal Name As String, ByVal Attributes As Dictionary(Of String, String), ByVal DefaultValue As T) As T
Return GetAttribute(Of T)(Name, Attributes, CChar(","), DefaultValue)
End Function
Private Function IsValidXML(ByVal xmlPath As String) As Boolean
If System.IO.File.Exists(xmlPath) = True Then
Dim xmlString As String = System.IO.File.ReadAllText(xmlPath)
'Crash validation check:
Try
Dim xmlDocument As XmlDocument = New XmlDocument()
xmlDocument.LoadXml(xmlString)
Return True
Catch ex As Exception
Return False
End Try
Else
Return False
End If
End Function
Private Sub ReportInvalidNamespace(ByVal tag As String)
Logger.Log(Logger.LogTypes.Warning, "The tag """ & tag & """ was used in the wrong namespace (" & CurrentNamespace.ToString() & ")")
End Sub
#End Region
#Region "ConverterFunctions"
Private Function GetBool(ByVal expression As Object) As Boolean
If ScriptConversion.IsBoolean(expression) = True Then
Return CBool(expression)
Else
Return False
End If
End Function
Private Function GetInt(ByVal expression As Object) As Integer
If ScriptConversion.IsArithmeticExpression(expression) = True Then
Return ScriptConversion.ToInteger(expression)
Else
Return 0
End If
End Function
Private Function GetSng(ByVal expression As Object) As Single
If ScriptConversion.IsArithmeticExpression(expression) = True Then
Return ScriptConversion.ToSingle(expression)
Else
Return 0.0F
End If
End Function
#End Region
End Class
End Namespace

392
2.5DHero/2.5DHero/World/XML/XmlProperty.vb
View File

@ -1,392 +0,0 @@
Namespace XmlLevel
Public Class XmlProperty
Shared InitializedDefaults As Boolean = False
Shared DefaultProperties As New Dictionary(Of String, XmlProperty)
Public Shared ReadOnly Property GetDefaultProperty(ByVal Name As String) As XmlProperty
Get
If InitializedDefaults = False Then
InitializeDefault()
End If
If DefaultProperties.ContainsKey(Name.ToLower()) = True Then
Return DefaultProperties(Name.ToLower())
End If
Return Nothing
End Get
End Property
Private Shared Sub InitializeDefault()
InitializedDefaults = True
DefaultProperties.Clear()
'Standard stuff:
DefaultProperties.Add("position", New XmlProperty("position", "0,0,0", Types.Vector3))
DefaultProperties.Add("scale", New XmlProperty("scale", "1,1,1", Types.Vector3))
DefaultProperties.Add("seasontexture", New XmlProperty("seasontexture", "", Types.String))
DefaultProperties.Add("texturepath", New XmlProperty("texturepath", "Village", Types.String))
DefaultProperties.Add("textures", New XmlProperty("textures", "[0,0,16,16]", Types.RectangleList))
DefaultProperties.Add("textureindex", New XmlProperty("textureindex", "0,0,0,0,0,0,0,0,0,0", Types.IntegerList))
DefaultProperties.Add("collision", New XmlProperty("collision", "1", Types.Boolean))
DefaultProperties.Add("basemodel", New XmlProperty("basemodel", "1", Types.Integer))
DefaultProperties.Add("rotation", New XmlProperty("rotation", "0", Types.Integer))
DefaultProperties.Add("xyzrotation", New XmlProperty("xyzrotation", "0,0,0", Types.Vector3))
DefaultProperties.Add("model", New XmlProperty("model", "", Types.String))
DefaultProperties.Add("rendertype", New XmlProperty("rendertype", "basemodel", Types.String))
DefaultProperties.Add("visible", New XmlProperty("visible", "1", Types.Boolean))
DefaultProperties.Add("id", New XmlProperty("id", "-1", Types.Integer))
DefaultProperties.Add("culling", New XmlProperty("culling", "0,0,0", Types.Vector3))
DefaultProperties.Add("seethrough", New XmlProperty("seethrough", "1", Types.Boolean))
DefaultProperties.Add("shader", New XmlProperty("shader", "1,1,1", Types.Vector3))
DefaultProperties.Add("opacity", New XmlProperty("opacity", "1", Types.Single))
'StairBlock:
DefaultProperties.Add("isstairs", New XmlProperty("isstairs", "0", Types.Boolean))
'WallBill:
DefaultProperties.Add("faceplayer", New XmlProperty("faceplayer", "0", Types.Boolean))
'SignBlock:
DefaultProperties.Add("issign", New XmlProperty("issign", "0", Types.Boolean))
DefaultProperties.Add("signtext", New XmlProperty("signtext", "", Types.String))
DefaultProperties.Add("signcontenttype", New XmlProperty("signcontenttype", "0", Types.Integer))
'WarpBlock:
DefaultProperties.Add("iswarp", New XmlProperty("iswarp", "0", Types.Boolean))
DefaultProperties.Add("warpmap", New XmlProperty("warpmap", "", Types.String))
DefaultProperties.Add("warpturns", New XmlProperty("warpturns", "0", Types.Integer))
DefaultProperties.Add("warpposition", New XmlProperty("warpposition", "0,0,0", Types.Vector3))
DefaultProperties.Add("validwarprotations", New XmlProperty("validwarprotations", "0,1,2,3", Types.IntegerList))
'Floor:
DefaultProperties.Add("isfloor", New XmlProperty("isfloor", "0", Types.Boolean))
DefaultProperties.Add("hassnow", New XmlProperty("hassnow", "0", Types.Boolean))
DefaultProperties.Add("hassand", New XmlProperty("hassand", "0", Types.Boolean))
DefaultProperties.Add("isice", New XmlProperty("isice", "0", Types.Boolean))
DefaultProperties.Add("isledge", New XmlProperty("isledge", "0", Types.Boolean))
'CutTree:
DefaultProperties.Add("iscuttree", New XmlProperty("iscuttree", "0", Types.Boolean))
'Water:
DefaultProperties.Add("iswater", New XmlProperty("iswater", "0", Types.Boolean))
DefaultProperties.Add("animatewater", New XmlProperty("animatewater", "0", Types.Boolean))
DefaultProperties.Add("wateranimationdata", New XmlProperty("wateranimationdata", "", Types.String))
'Grass:
DefaultProperties.Add("isgrass", New XmlProperty("isgrass", "0", Types.Boolean))
DefaultProperties.Add("pokefile", New XmlProperty("pokefile", "", Types.String))
'BerryPlant:
DefaultProperties.Add("isberry", New XmlProperty("isberry", "0", Types.Boolean))
DefaultProperties.Add("berryindex", New XmlProperty("berryindex", "0", Types.Integer))
DefaultProperties.Add("berriesyield", New XmlProperty("berriesyield", "0", Types.Integer))
DefaultProperties.Add("berrywatered", New XmlProperty("berrywatered", "0,0,0,0", Types.String))
'LoamySoil:
DefaultProperties.Add("isloamysoil", New XmlProperty("isloamysoil", "0", Types.Boolean))
'ItemObject:
DefaultProperties.Add("isloamysoil", New XmlProperty("isitem", "0", Types.Boolean))
DefaultProperties.Add("isloamysoil", New XmlProperty("itemid", "0", Types.Integer))
DefaultProperties.Add("isloamysoil", New XmlProperty("mapitemid", "0", Types.Integer))
DefaultProperties.Add("isloamysoil", New XmlProperty("itemhidden", "0", Types.Boolean))
'ScriptBlock:
DefaultProperties.Add("isscripttrigger", New XmlProperty("isscripttrigger", "0", Types.Boolean))
DefaultProperties.Add("scripttrigger", New XmlProperty("scripttrigger", "0", Types.Integer))
DefaultProperties.Add("script", New XmlProperty("script", "", Types.String))
DefaultProperties.Add("acceptedscriptrotations", New XmlProperty("acceptedscriptrotations", "0,1,2,3", Types.IntegerList))
'TurningSign:
DefaultProperties.Add("turnx", New XmlProperty("turnx", "0", Types.Boolean))
DefaultProperties.Add("turny", New XmlProperty("turny", "0", Types.Boolean))
DefaultProperties.Add("turnz", New XmlProperty("turnz", "0", Types.Boolean))
DefaultProperties.Add("turnspeed", New XmlProperty("turnspeed", "0", Types.Single))
DefaultProperties.Add("invertturn", New XmlProperty("invertturn", "0", Types.Boolean))
'ApricornTree:
DefaultProperties.Add("isapricorn", New XmlProperty("isapricorn", "0", Types.Boolean))
DefaultProperties.Add("apricorncolor", New XmlProperty("apricorncolor", "white", Types.String))
'HeadButtTree:
DefaultProperties.Add("isheadbutttree", New XmlProperty("isheadbutttree", "0", Types.Boolean))
'SmashRock:
DefaultProperties.Add("canbesmashed", New XmlProperty("canbesmashed", "0", Types.Boolean))
'StrengthMove:
DefaultProperties.Add("canbemoved", New XmlProperty("canbemoved", "0", Types.Boolean))
DefaultProperties.Add("isstrengthmove", New XmlProperty("isstrengthmove", "0", Types.Boolean))
'Waterfall:
DefaultProperties.Add("iswaterfall", New XmlProperty("iswaterfall", "0", Types.Boolean))
DefaultProperties.Add("animatewaterfall", New XmlProperty("animatewaterfall", "0", Types.Boolean))
DefaultProperties.Add("waterfallanimationdata", New XmlProperty("waterfallanimationdata", "", Types.String))
'Whirlpool:
DefaultProperties.Add("iswhirlpool", New XmlProperty("iswhirlpool", "0", Types.Boolean))
'StrengthTriggers:
DefaultProperties.Add("isstrengthtrigger", New XmlProperty("isstrengthtrigger", "0", Types.Boolean))
DefaultProperties.Add("strengthtriggerdata", New XmlProperty("strengthtriggerdata", "0,0,", Types.String))
'SpinTiles:
DefaultProperties.Add("isspintile", New XmlProperty("isspintile", "0", Types.Boolean))
DefaultProperties.Add("spinrotation", New XmlProperty("spinrotation", "0", Types.Integer))
DefaultProperties.Add("spintype", New XmlProperty("spintype", "0", Types.Integer))
'Dive:
DefaultProperties.Add("isdivetile", New XmlProperty("isdivetile", "0", Types.Boolean))
DefaultProperties.Add("diveup", New XmlProperty("diveup", "0", Types.Boolean))
'NPC:
DefaultProperties.Add("npcname", New XmlProperty("npcname", "", Types.String))
DefaultProperties.Add("npcid", New XmlProperty("npcid", "-1", Types.Integer))
DefaultProperties.Add("npctexture", New XmlProperty("npctexture", "0", Types.String))
DefaultProperties.Add("istrainer", New XmlProperty("istrainer", "0", Types.Boolean))
DefaultProperties.Add("npcsightdistance", New XmlProperty("npcsightdistance", "0", Types.Integer))
DefaultProperties.Add("npcscript", New XmlProperty("npcscript", "", Types.String))
End Sub
Public Enum Types
[String]
[Integer]
[Boolean]
[Vector3]
[Vector2]
[Rectangle]
RectangleList
IntegerList
[Single]
End Enum
Private _name As String = ""
Private _value As String = ""
Private _type As Types = Types.String
Public Sub New(ByVal Name As String, ByVal Value As String, ByVal Type As Types)
Me._name = Name
Me._value = Value
Me._type = Type
End Sub
Public Property Value() As String
Get
Return Me._value
End Get
Set(value As String)
Me._value = value
End Set
End Property
Public ReadOnly Property Name() As String
Get
Return Me._name
End Get
End Property
Public ReadOnly Property Type() As Types
Get
Return Me._type
End Get
End Property
Public Shared Function ConvertFromString(ByVal cProperty As XmlProperty) As Object
If cProperty Is Nothing Then
Return Nothing
End If
Dim v As String = cProperty.Value
Select Case cProperty.Type
Case Types.String
Return v
Case Types.Integer
v = v.Replace(".", GameController.DecSeparator)
If IsNumeric(v) = True Then
Return CInt(v)
Else
If v.ToLower() = "true" Then
Return CInt(1)
End If
If v.ToLower() = "false" Then
Return CInt(0)
End If
End If
Return CInt(-1)
Case Types.Boolean
Select Case v.ToLower()
Case "0"
Return False
Case "false"
Return False
Case "1"
Return True
Case "true"
Return True
End Select
Return False
Case Types.Vector3
v = v.Replace(".", GameController.DecSeparator)
If IsNumeric(v.Replace(".", GameController.DecSeparator)) = True Then
Dim vN As Single = CSng(v.Replace(".", GameController.DecSeparator))
Return New Vector3(vN)
Else
Dim parts() As String = v.Split(CChar(","))
If parts.ToList().IsNumericList() = True Then
If parts.Length = 2 Then
Return New Vector3(CSng(parts(0).Replace(".", GameController.DecSeparator)), 0.0F, CSng(parts(1).Replace(".", GameController.DecSeparator)))
ElseIf parts.Length >= 3 Then
Return New Vector3(CSng(parts(0).Replace(".", GameController.DecSeparator)), CSng(parts(1).Replace(".", GameController.DecSeparator)), CSng(parts(2).Replace(".", GameController.DecSeparator)))
End If
End If
End If
Return Vector3.Zero
Case Types.Vector2
v = v.Replace(".", GameController.DecSeparator)
If IsNumeric(v.Replace(".", GameController.DecSeparator)) = True Then
Dim vN As Single = CSng(v.Replace(".", GameController.DecSeparator))
Return New Vector2(vN)
Else
Dim parts() As String = v.Split(CChar(","))
If parts.ToList().IsNumericList() = True Then
If parts.Length >= 2 Then
Return New Vector2(CSng(parts(0).Replace(".", GameController.DecSeparator)), CSng(parts(1).Replace(".", GameController.DecSeparator)))
End If
End If
End If
Return Vector2.Zero
Case Types.Rectangle
'[x,y,width,height]
If v.StartsWith("[") = True And v.EndsWith("]") = True Then
v = v.Remove(v.Length - 1, 1).Remove(0, 1)
Dim parts() As String = v.Split(CChar(","))
If parts.Length = 4 Then
If parts.ToList().IsNumericList() = True Then
Return New Rectangle(CInt(parts(0).Replace(".", GameController.DecSeparator)),
CInt(parts(1).Replace(".", GameController.DecSeparator)),
CInt(parts(2).Replace(".", GameController.DecSeparator)),
CInt(parts(3).Replace(".", GameController.DecSeparator)))
End If
End If
End If
v = v.Replace(".", GameController.DecSeparator)
Return New Rectangle(0, 0, 1, 1)
Case Types.RectangleList
'[x,y,width,height][x,y,width,height]..
Dim l As New List(Of Rectangle)
v = v.Remove(v.Length - 1, 1).Remove(0, 1)
v = v.Replace("][", "|")
Dim rectangles() As String = v.Split(CChar("|"))
For Each r As String In rectangles
Dim parts() As String = r.Split(CChar(","))
l.Add(New Rectangle(CInt(parts(0).Replace(".", GameController.DecSeparator)),
CInt(parts(1).Replace(".", GameController.DecSeparator)),
CInt(parts(2).Replace(".", GameController.DecSeparator)),
CInt(parts(3).Replace(".", GameController.DecSeparator))))
Next
Return l
Case Types.IntegerList
Dim l As New List(Of Integer)
Dim parts() As String = v.Split(CChar(","))
For Each i As String In parts
i = i.Replace(".", GameController.DecSeparator)
If IsNumeric(i) = True Then
l.Add(CInt(i))
End If
Next
Return l
Case Types.Single
v = v.Replace(".", GameController.DecSeparator)
If IsNumeric(v) = True Then
Return CSng(v)
End If
Return CSng(-1)
End Select
Return Nothing
End Function
Public Shared Function ConvertToString(Of T)(ByVal Value As T) As String
Select Case Value.GetType()
Case GetType(String)
Return CType(CObj(Value), String)
Case GetType(Integer)
Dim i As Integer = CType(CObj(Value), Integer)
Return i.ToString()
Case GetType(Boolean)
Dim b As Boolean = CType(CObj(Value), Boolean)
If b = True Then
Return "1"
Else
Return "0"
End If
Case GetType(Vector3)
Dim v As Vector3 = CType(CObj(Value), Vector3)
Return v.X.ToString() & "," & v.Y.ToString() & "," & v.Z.ToString()
Case GetType(Vector2)
Dim v As Vector2 = CType(CObj(Value), Vector2)
Return v.X.ToString() & "," & v.Y.ToString()
Case GetType(Rectangle)
Dim r As Rectangle = CType(CObj(Value), Rectangle)
Return "[" & r.X & "," & r.Y & "," & r.Width & "," & r.Height & "]"
Case GetType(Single)
Dim s As Single = CType(CObj(Value), Single)
Return s.ToString()
Case GetType(List(Of Rectangle))
Dim l As List(Of Rectangle) = CType(CObj(Value), List(Of Rectangle))
Dim s As String = ""
For Each r As Rectangle In l
s &= "[" & r.X & "," & r.Y & "," & r.Width & "," & r.Height & "]"
Next
Return s
Case GetType(List(Of Integer))
Dim l As List(Of Integer) = CType(CObj(Value), List(Of Integer))
Dim s As String = ""
For Each i As Integer In l
If s <> "" Then
s &= ","
End If
s &= i.ToString()
Next
Return s
End Select
Return ""
End Function
End Class
End Namespace

99
2.5DHero/2.5DHero/World/XML/XmlPropertyListener.vb
View File

@ -1,99 +0,0 @@
Namespace XmlLevel
Public MustInherit Class XmlPropertyListener
Public XmlEntity As XmlEntity
Private _associatedPropertyName As String = ""
Private _implementWalkAgainst As Boolean = False
Private _implementWalkInto As Boolean = False
Private _implementLetPlayerMove As Boolean = False
Public Sub New(ByVal XmlEntityReference As XmlEntity, ByVal AssociatedPropertyName As String)
Me.XmlEntity = XmlEntityReference
Me._associatedPropertyName = AssociatedPropertyName
End Sub
Public Overridable Sub UpdateEntity()
End Sub
Public Overridable Sub Update()
End Sub
Public Overridable Sub Draw()
End Sub
Public Overridable Sub Render()
End Sub
Public Overridable Sub PlayerInteraction()
End Sub
Public Overridable Function WalkAgainst() As Boolean
Return True
End Function
Public Overridable Function WalkInto() As Boolean
Return False
End Function
Public Overridable Sub WalkOnto()
End Sub
Public Overridable Sub ResultFunction(ByVal Result As Integer)
End Sub
Public Overridable Function LetPlayerMove() As Boolean
Return True
End Function
Public Shared Function GetPropertyListeners(ByVal XmlEntity As XmlEntity) As List(Of XmlPropertyListener)
Dim l As New List(Of XmlPropertyListener)
For Each n As String In XmlEntity.GetPropertyNameList()
Select Case n.ToLower()
Case "isscripttrigger"
If XmlEntity.GetPropertyValue(Of Boolean)("isscripttrigger") = True Then
l.Add(New ScriptBlockPropertyListener(XmlEntity))
End If
Case "faceplayer"
If XmlEntity.GetPropertyValue(Of Boolean)("faceplayer") = True Then
l.Add(New FacePlayerPropertyListener(XmlEntity))
End If
Case "isstairs"
If XmlEntity.GetPropertyValue(Of Boolean)("isstairs") = True Then
l.Add(New StairsPropertyListener(XmlEntity))
End If
End Select
Next
Return l
End Function
Public ReadOnly Property AssociatedPropertyName() As String
Get
Return Me._associatedPropertyName
End Get
End Property
Public Property ImplementWalkAgainst() As Boolean
Get
Return Me._implementWalkAgainst
End Get
Set(value As Boolean)
Me._implementWalkAgainst = value
End Set
End Property
Public Property ImplementWalkInto() As Boolean
Get
Return Me._implementWalkInto
End Get
Set(value As Boolean)
Me._implementWalkInto = value
End Set
End Property
Public Property ImplementLetPlayerMove() As Boolean
Get
Return Me._implementLetPlayerMove
End Get
Set(value As Boolean)
Me._implementLetPlayerMove = value
End Set
End Property
End Class
End Namespace