Public Class LevelLoader Const MULTITHREAD As Boolean = False Public Shared LoadedOffsetMapOffsets As New List(Of Vector3) Public Shared LoadedOffsetMapNames As New List(Of String) Private _reload As Boolean = False Private Enum TagTypes Entity Floor EntityField Level LevelActions NPC Shader OffsetMap [Structure] Backdrop None End Enum Dim Offset As Vector3 Dim loadOffsetMap As Boolean = True Dim offsetMapLevel As Integer = 0 Dim MapOrigin As String = "" Dim sessionMapsLoaded As New List(Of String) ' Prevents infinite loops when loading more than one offset map level. ' Store these so other classes can get them: Private Entities As New List(Of Entity) Private Floors As New List(Of Entity) ' A counter across all LevelLoader instances to count how many instances across the program are active: Shared Busy As Integer = 0 Public Shared ReadOnly Property IsBusy() As Boolean Get Return Busy > 0 End Get End Property #Region "File Loading" Dim TempParams As Object() ''' ''' Loads the level. ''' ''' Params contruction: String LevelFile, bool IsOffsetMap, Vector3 Offset, int Offsetmaplevel, Str() InstanceLoadedOffsetMaps Public Sub LoadLevel(ByVal Params As Object(), Optional Reload As Boolean = False) Busy += 1 TempParams = Params _reload = Reload If MULTITHREAD = True Then Dim t As New Threading.Thread(AddressOf InternalLoad) t.IsBackground = True t.Start() Else InternalLoad() End If End Sub Private Sub InternalLoad() Dim levelPath As String = CStr(TempParams(0)) Dim loadOffsetMap As Boolean = CBool(TempParams(1)) Dim offset As Vector3 = CType(TempParams(2), Vector3) offsetMapLevel = CInt(TempParams(3)) sessionMapsLoaded = CType(TempParams(4), List(Of String)) Dim timer As Stopwatch = New Stopwatch timer.Start() Me.loadOffsetMap = loadOffsetMap MapOrigin = levelPath If loadOffsetMap = False Then Screen.Level.LevelFile = levelPath 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 Core.OffsetMaps.Clear() Screen.Level.Entities.Clear() Screen.Level.Floors.Clear() Screen.Level.Shaders.Clear() Screen.Level.BackdropRenderer.Clear() Screen.Level.OffsetmapFloors.Clear() Screen.Level.OffsetmapEntities.Clear() Screen.Level.WildPokemonFloor = False Screen.Level.WalkedSteps = 0 LoadedOffsetMapNames.Clear() LoadedOffsetMapOffsets.Clear() Floor.ClearFloorTemp() Player.Temp.MapSteps = 0 sessionMapsLoaded.Add(levelPath) End If levelPath = GameModeManager.GetMapPath(levelPath) Logger.Debug("Loading map: " & levelPath.Remove(0, GameController.GamePath.Length)) Security.FileValidation.CheckFileValid(levelPath, False, "LevelLoader.vb") If IO.File.Exists(levelPath) = False Then Logger.Log(Logger.LogTypes.ErrorMessage, "LevelLoader.vb: Error accessing map file """ & levelPath & """. File not found.") Busy -= 1 If CurrentScreen.Identification = Screen.Identifications.OverworldScreen And loadOffsetMap = False Then CType(CurrentScreen, OverworldScreen).Titles.Add(New OverworldScreen.Title("Couldn't find map file!", 20.0F, Color.White, 6.0F, Vector2.Zero, True)) End If Exit Sub End If Dim Data As List(Of String) = IO.File.ReadAllLines(levelPath).ToList() Dim Tags As New Dictionary(Of String, Object) Me.Offset = offset For Each line As String In Data If line.Contains("{") = True Then line = line.Remove(0, line.IndexOf("{")) If line.StartsWith("{""Comment""{COM") = True Then line = line.Remove(0, line.IndexOf("[") + 1) line = line.Remove(line.IndexOf("]")) Logger.Log(Logger.LogTypes.Debug, line) End If End If Next Dim countLines As Integer = 0 For i = 0 To Integer.MaxValue If i > Data.Count - 1 Then Exit For End If Dim line As String = Data(i) Tags.Clear() If line.Contains("{") = True And line.Contains("}") = True Then Try Dim TagType As TagTypes = TagTypes.None line = line.Remove(0, line.IndexOf("{") + 2) Select Case True Case line.ToLower().StartsWith("structure""") TagType = TagTypes.Structure End Select If TagType = TagTypes.Structure Then line = line.Remove(0, line.IndexOf("[") + 1) line = line.Remove(line.Length - 3, 3) Tags = GetTags(line) Dim newLines() As String = AddStructure(Tags) Data.InsertRange(i + 1, newLines) End If Catch ex As Exception Logger.Log(Logger.LogTypes.Warning, "LevelLoader.vb: Failed to load map object! (Index: " & countLines & ") from mapfile: " & levelPath & "; Error message: " & ex.Message) End Try End If Next For Each line As String In Data Tags.Clear() Dim orgLine As String = line countLines += 1 If line.Contains("{") = True And line.Contains("}") = True Then Try Dim TagType As TagTypes = TagTypes.None line = line.Remove(0, line.IndexOf("{") + 2) Select Case True Case line.ToLower().StartsWith("entity""") TagType = TagTypes.Entity Case line.ToLower().StartsWith("floor""") TagType = TagTypes.Floor Case line.ToLower().StartsWith("entityfield""") TagType = TagTypes.EntityField Case line.ToLower().StartsWith("level""") TagType = TagTypes.Level Case line.ToLower().StartsWith("actions""") TagType = TagTypes.LevelActions Case line.ToLower().StartsWith("npc""") TagType = TagTypes.NPC Case line.ToLower().StartsWith("shader""") TagType = TagTypes.Shader Case line.ToLower().StartsWith("offsetmap""") TagType = TagTypes.OffsetMap Case line.ToLower().StartsWith("backdrop""") TagType = TagTypes.Backdrop End Select If TagType <> TagTypes.None Then line = line.Remove(0, line.IndexOf("[") + 1) line = line.Remove(line.Length - 3, 3) Tags = GetTags(line) Select Case TagType Case TagTypes.EntityField EntityField(Tags) Case TagTypes.Entity AddEntity(Tags, New Size(1, 1), 1, True, New Vector3(1, 1, 1)) Case TagTypes.Floor AddFloor(Tags) Case TagTypes.Level If loadOffsetMap = False Then SetupLevel(Tags) End If Case TagTypes.LevelActions If loadOffsetMap = False Then SetupActions(Tags) End If Case TagTypes.NPC AddNPC(Tags) Case TagTypes.Shader If loadOffsetMap = False Then AddShader(Tags) End If Case TagTypes.OffsetMap If loadOffsetMap = False Or offsetMapLevel <= Core.GameOptions.MaxOffsetLevel Then AddOffsetMap(Tags) End If Case TagTypes.Backdrop If loadOffsetMap = False Then AddBackdrop(Tags) End If End Select End If Catch ex As Exception Logger.Log(Logger.LogTypes.Warning, "LevelLoader.vb: Failed to load map object! (Index: " & countLines & ") (Line: " & orgLine & ") from mapfile: " & levelPath & "; Error message: " & ex.Message) End Try End If Next If loadOffsetMap = False Then LoadBerries() End If For Each s As Shader In Screen.Level.Shaders If s.HasBeenApplied = False Then s.ApplyShader(Screen.Level.Entities.ToArray()) s.ApplyShader(Screen.Level.Floors.ToArray()) End If Next Logger.Debug("Map loading finished: " & levelPath.Remove(0, GameController.GamePath.Length)) Logger.Debug("Loaded textures: " & TextureManager.TextureList.Count.ToString()) timer.Stop() Logger.Debug("Map loading time: " & timer.ElapsedTicks & " Ticks; " & timer.ElapsedMilliseconds & " Milliseconds.") ' Dim xmlLevelLoader As New XmlLevelLoader. ' xmlLevelLoader.Load(My.Computer.FileSystem.SpecialDirectories.Desktop & "\t.xml", _5DHero.XmlLevelLoader.LevelTypes.Default, Vector3.Zero) Busy -= 1 If Busy = 0 Then Screen.Level.StartOffsetMapUpdate() End If End Sub Private Function GetTags(ByVal line As String) As Dictionary(Of String, Object) Dim Tags As New Dictionary(Of String, Object) Dim tagList = line.Split({"}{"}, StringSplitOptions.RemoveEmptyEntries) For i = 0 To tagList.Length - 1 Dim currentTag As String = tagList(i) If currentTag.EndsWith("}}") = False Then currentTag &= "}" End If If currentTag.StartsWith("{") = False Then currentTag = "{" & currentTag End If ProcessTag(Tags, currentTag) Next Return Tags End Function Private Sub ProcessTag(ByRef Dictionary As Dictionary(Of String, Object), ByVal Tag As String) Dim TagName As String = "" Dim TagContent As String = "" Tag = Tag.Remove(0, 1) Tag = Tag.Remove(Tag.Length - 1, 1) TagName = Tag.Remove(Tag.IndexOf("{") - 1).Remove(0, 1) TagContent = Tag.Remove(0, Tag.IndexOf("{")) Dim ContentRows() As String = TagContent.Split(CChar("}")) For Each subTag As String In ContentRows If subTag.Length > 0 Then subTag = subTag.Remove(0, 1) Dim subTagType As String = subTag.Remove(subTag.IndexOf("[")) Dim subTagValue As String = subTag.Remove(0, subTag.IndexOf("[") + 1) subTagValue = subTagValue.Remove(subTagValue.Length - 1, 1) Select Case subTagType.ToLower() Case "int" Dictionary.Add(TagName, CInt(subTagValue)) Case "str" Dictionary.Add(TagName, CStr(subTagValue)) Case "sng" subTagValue = subTagValue.Replace(".", GameController.DecSeparator) Dictionary.Add(TagName, CSng(subTagValue)) Case "bool" Dictionary.Add(TagName, CBool(subTagValue)) Case "intarr" Dim values() As String = subTagValue.Split(CChar(",")) Dim arr As New List(Of Integer) For Each value As String In values arr.Add(CInt(value)) Next Dictionary.Add(TagName, arr) Case "intarr2d" Dim rows() As String = subTagValue.Split(CChar("]")) Dim arr As New List(Of List(Of Integer)) For Each row As String In rows If row.Length > 0 Then row = row.Remove(0, 1) Dim list As New List(Of Integer) For Each value In row.Split(CChar(",")) list.Add(CInt(value)) Next arr.Add(list) End If Next Dictionary.Add(TagName, arr) Case "rec" Dim content() As String = subTagValue.Split(CChar(",")) Dictionary.Add(TagName, New Rectangle(CInt(content(0)), CInt(content(1)), CInt(content(2)), CInt(content(3)))) Case "recarr" Dim values() As String = subTagValue.Split(CChar("]")) Dim arr As New List(Of Rectangle) For Each value As String In values If value.Length > 0 Then value = value.Remove(0, 1) Dim content() As String = value.Split(CChar(",")) arr.Add(New Rectangle(CInt(content(0)), CInt(content(1)), CInt(content(2)), CInt(content(3)))) End If Next Dictionary.Add(TagName, arr) Case "sngarr" Dim values() As String = subTagValue.Split(CChar(",")) Dim arr As New List(Of Single) For Each value As String In values value = value.Replace(".", GameController.DecSeparator) arr.Add(CSng(value)) Next Dictionary.Add(TagName, arr) End Select End If Next End Sub Private Function GetTag(ByVal Tags As Dictionary(Of String, Object), ByVal TagName As String) As Object If Tags.ContainsKey(TagName) = True Then Return Tags(TagName) End If For i = 0 To Tags.Count - 1 If Tags.Keys(i).ToLower() = TagName.ToLower() Then Return Tags.Values(i) End If Next Return Nothing End Function Private Function TagExists(ByVal Tags As Dictionary(Of String, Object), ByVal TagName As String) As Boolean If Tags.ContainsKey(TagName) = True Then Return True End If For i = 0 To Tags.Count - 1 If Tags.Keys(i).ToLower() = TagName.ToLower() Then Return True End If Next Return False End Function #End Region Private Sub AddOffsetMap(ByVal Tags As Dictionary(Of String, Object)) If Core.GameOptions.LoadOffsetMaps > 0 Then Dim OffsetList As List(Of Integer) = CType(GetTag(Tags, "Offset"), List(Of Integer)) Dim MapOffset As Vector3 = New Vector3(OffsetList(0), 0, OffsetList(1)) If OffsetList.Count >= 3 Then MapOffset = New Vector3(OffsetList(0), OffsetList(1), OffsetList(2)) End If Dim MapName As String = CStr(GetTag(Tags, "Map")) If loadOffsetMap = True Then If sessionMapsLoaded.Contains(MapName) = True Then Exit Sub End If End If sessionMapsLoaded.Add(MapName) LoadedOffsetMapNames.Add(MapName) LoadedOffsetMapOffsets.Add(MapOffset) Dim listName As String = Screen.Level.LevelFile & "|" & MapName & "|" & Screen.Level.World.CurrentMapWeather & "|" & World.GetCurrentRegionWeather() & "|" & World.GetTime() & "|" & World.CurrentSeason() If OffsetMaps.ContainsKey(listName) = False Then Dim mapList As New List(Of List(Of Entity)) Dim params As New List(Of Object) params.AddRange({MapName, True, MapOffset + Offset, offsetMapLevel + 1, sessionMapsLoaded}) Dim offsetEntityCount As Integer = Screen.Level.OffsetmapEntities.Count Dim offsetFloorCount As Integer = Screen.Level.OffsetmapFloors.Count Dim levelLoader As New LevelLoader() levelLoader.LoadLevel(params.ToArray()) Dim entList As New List(Of Entity) Dim floorList As New List(Of Entity) For i = offsetEntityCount To Screen.Level.OffsetmapEntities.Count - 1 entList.Add(Screen.Level.OffsetmapEntities(i)) Next For i = offsetFloorCount To Screen.Level.OffsetmapFloors.Count - 1 floorList.Add(Screen.Level.OffsetmapFloors(i)) Next mapList.AddRange({entList, floorList}) OffsetMaps.Add(listName, mapList) Else Logger.Debug("Loaded Offsetmap from store: " & MapName) For Each e As Entity In OffsetMaps(listName)(0) If e.MapOrigin = MapName Then e.IsOffsetMapContent = True Screen.Level.OffsetmapEntities.Add(e) End If Next For Each e As Entity In OffsetMaps(listName)(1) If e.MapOrigin = MapName Then e.IsOffsetMapContent = True Screen.Level.OffsetmapFloors.Add(e) End If Next End If Logger.Debug("Offset maps in store: " & OffsetMaps.Count) Screen.Level.OffsetmapEntities = (From e In Screen.Level.OffsetmapEntities Order By e.CameraDistance Descending).ToList() For Each Entity As Entity In Screen.Level.OffsetmapEntities Entity.UpdateEntity() Next For Each Floor As Entity In Screen.Level.OffsetmapFloors Floor.UpdateEntity() Next End If End Sub #Region "AddElements" Shared tempStructureList As New Dictionary(Of String, List(Of String)) Public Shared Sub ClearTempStructures() tempStructureList.Clear() End Sub Private Function AddStructure(ByVal Tags As Dictionary(Of String, Object)) As String() Dim OffsetList As List(Of Single) = CType(GetTag(Tags, "Offset"), List(Of Single)) Dim MapOffset As Vector3 = New Vector3(OffsetList(0), 0, OffsetList(1)) If OffsetList.Count >= 3 Then MapOffset = New Vector3(OffsetList(0), OffsetList(1), OffsetList(2)) End If Dim MapRotation As Integer = -1 If TagExists(Tags, "Rotation") = True Then MapRotation = CInt(GetTag(Tags, "Rotation")) End If Dim MapName As String = CStr(GetTag(Tags, "Map")) If MapName.EndsWith(".dat") = False Then MapName = MapName & ".dat" End If Dim addNPC As Boolean = False If TagExists(Tags, "AddNPC") = True Then addNPC = CBool(GetTag(Tags, "AddNPC")) End If Dim structureKey As String = MapOffset.X.ToString() & "|" & MapOffset.Y.ToString() & "|" & MapOffset.Z.ToString() & "|" & MapName If tempStructureList.ContainsKey(structureKey) = False Then Dim filepath As String = GameModeManager.GetMapPath(MapName) Security.FileValidation.CheckFileValid(filepath, False, "LevelLoader.vb/StructureSpawner") If IO.File.Exists(filepath) = False Then Logger.Log(Logger.LogTypes.ErrorMessage, "LevelLoader.vb: Error loading structure from """ & filepath & """. File not found.") Return {} End If Dim MapContent() As String = IO.File.ReadAllLines(filepath) Dim structureList As New List(Of String) For Each line As String In MapContent If line.EndsWith("}") = True Then Dim addLine As Boolean = False Select Case True Case line.Trim(" "c, StringHelper.Tab).StartsWith("{""Entity""{ENT[") addLine = True Case line.Trim(" "c, StringHelper.Tab).StartsWith("{""Floor""{ENT[") addLine = True Case line.Trim(" "c, StringHelper.Tab).StartsWith("{""EntityField""{ENT[") addLine = True Case line.Trim(" "c, StringHelper.Tab).StartsWith("{""NPC""{NPC[") If addNPC = True Then addLine = True End If Case line.Trim(" "c, StringHelper.Tab).StartsWith("{""Shader""{SHA[") addLine = True Case line.Trim(" "c, StringHelper.Tab).StartsWith("{""Structure""{STR[") addLine = True End Select If addLine = True Then line = ReplaceStructurePosition(line, MapOffset) If MapRotation > -1 Then line = ReplaceStructureRotation(line, MapRotation) End If structureList.Add(line) End If End If Next tempStructureList.Add(structureKey, structureList) End If Return tempStructureList(structureKey).ToArray() End Function Private Function ReplaceStructureRotation(ByVal line As String, ByVal MapRotation As Integer) As String Dim replaceString As String = "" If line.ToLower().Contains("{""rotation""{int[") = True Then replaceString = "{""rotation""{int[" End If If replaceString <> "" Then Dim rotationString As String = line.Remove(0, line.ToLower().IndexOf(replaceString)) rotationString = rotationString.Remove(rotationString.IndexOf("]}}") + 3) Dim rotationData As String = rotationString.Remove(0, rotationString.IndexOf("[") + 1) rotationData = rotationData.Remove(rotationData.IndexOf("]")) Dim newRotation As Integer = CInt(rotationData) + MapRotation While newRotation > 3 newRotation -= 4 End While line = line.Replace(rotationString, "{""rotation""{int[" & newRotation.ToString() & "]}}") End If Return line End Function Private Function ReplaceStructurePosition(ByVal line As String, ByVal MapOffset As Vector3) As String Dim replaceString As String = "" If line.ToLower().Contains("{""position""{sngarr[") = True Then replaceString = "{""position""{sngarr[" ElseIf line.ToLower().Contains("{""position""{intarr[") = True Then replaceString = "{""position""{intarr[" End If If replaceString <> "" Then Dim positionString As String = line.Remove(0, line.ToLower().IndexOf(replaceString)) positionString = positionString.Remove(positionString.IndexOf("]}}") + 3) Dim positionData As String = positionString.Remove(0, positionString.IndexOf("[") + 1) positionData = positionData.Remove(positionData.IndexOf("]")) Dim posArr() As String = positionData.Split(CChar(",")) Dim newPosition As New Vector3(ScriptConversion.ToSingle(posArr(0).Replace(".", GameController.DecSeparator)) + MapOffset.X, ScriptConversion.ToSingle(posArr(1).Replace(".", GameController.DecSeparator)) + MapOffset.Y, CSng(posArr(2).Replace(".", GameController.DecSeparator)) + MapOffset.Z) If line.ToLower().Contains("{""position""{sngarr[") = True Then line = line.Replace(positionString, "{""position""{sngarr[" & newPosition.X.ToString().Replace(GameController.DecSeparator, ".") & "," & newPosition.Y.ToString().Replace(GameController.DecSeparator, ".") & "," & newPosition.Z.ToString().Replace(GameController.DecSeparator, ".") & "]}}") Else line = line.Replace(positionString, "{""position""{intarr[" & CInt(newPosition.X).ToString().Replace(GameController.DecSeparator, ".") & "," & CInt(newPosition.Y).ToString().Replace(GameController.DecSeparator, ".") & "," & CInt(newPosition.Z).ToString().Replace(GameController.DecSeparator, ".") & "]}}") End If End If Return line End Function Private Sub EntityField(ByVal Tags As Dictionary(Of String, Object)) Dim SizeList As List(Of Integer) = CType(GetTag(Tags, "Size"), List(Of Integer)) Dim Fill As Boolean = True If TagExists(Tags, "Fill") = True Then Fill = CBool(GetTag(Tags, "Fill")) End If Dim Steps As New Vector3(1, 1, 1) If TagExists(Tags, "Steps") = True Then Dim StepList As List(Of Single) = CType(GetTag(Tags, "Steps"), List(Of Single)) If StepList.Count = 3 Then Steps = New Vector3(StepList(0), StepList(1), StepList(2)) Else Steps = New Vector3(StepList(0), 1, StepList(1)) End If End If If SizeList.Count = 3 Then AddEntity(Tags, New Size(SizeList(0), SizeList(2)), SizeList(1), Fill, Steps) Else AddEntity(Tags, New Size(SizeList(0), SizeList(1)), 1, Fill, Steps) End If End Sub Private Sub AddNPC(ByVal Tags As Dictionary(Of String, Object)) Dim PosList As List(Of Single) = CType(GetTag(Tags, "Position"), List(Of Single)) Dim Position As Vector3 = New Vector3(PosList(0) + Offset.X, PosList(1) + Offset.Y, PosList(2) + Offset.Z) Dim ScaleList As List(Of Single) Dim Scale As New Vector3(1) If TagExists(Tags, "Scale") = True Then ScaleList = CType(GetTag(Tags, "Scale"), List(Of Single)) Scale = New Vector3(ScaleList(0), ScaleList(1), ScaleList(2)) End If Dim TextureID As String = CStr(GetTag(Tags, "TextureID")) Dim Rotation As Integer = CInt(GetTag(Tags, "Rotation")) Dim ActionValue As Integer = CInt(GetTag(Tags, "Action")) Dim AdditionalValue As String = CStr(GetTag(Tags, "AdditionalValue")) Dim Name As String = CStr(GetTag(Tags, "Name")) Dim ID As Integer = CInt(GetTag(Tags, "ID")) Dim Movement As String = CStr(GetTag(Tags, "Movement")) Dim MoveRectangles As List(Of Rectangle) = CType(GetTag(Tags, "MoveRectangles"), List(Of Rectangle)) Dim Shader As New Vector3(1.0F) If TagExists(Tags, "Shader") = True Then Dim ShaderList As List(Of Single) = CType(GetTag(Tags, "Shader"), List(Of Single)) Shader = New Vector3(ShaderList(0), ShaderList(1), ShaderList(2)) End If Dim AnimateIdle As Boolean = False If TagExists(Tags, "AnimateIdle") = True Then AnimateIdle = CBool(GetTag(Tags, "AnimateIdle")) End If Dim NPC As NPC = CType(Entity.GetNewEntity("NPC", Position, {Nothing}, {0, 0}, True, New Vector3(0), Scale, BaseModel.BillModel, ActionValue, AdditionalValue, True, Shader, -1, MapOrigin, "", Offset, {TextureID, Rotation, Name, ID, AnimateIdle, Movement, MoveRectangles}), NPC) If loadOffsetMap = False Then Screen.Level.Entities.Add(NPC) Else Screen.Level.OffsetmapEntities.Add(NPC) End If End Sub Private Sub AddFloor(ByVal Tags As Dictionary(Of String, Object)) Dim sizeList As List(Of Integer) = CType(GetTag(Tags, "Size"), List(Of Integer)) Dim Size As Size = New Size(sizeList(0), sizeList(1)) Dim PosList As List(Of Integer) = CType(GetTag(Tags, "Position"), List(Of Integer)) Dim Position As Vector3 = New Vector3(PosList(0) + Offset.X, PosList(1) + Offset.Y, PosList(2) + Offset.Z) Dim TexturePath As String = CStr(GetTag(Tags, "TexturePath")) Dim TextureRectangle As Rectangle = CType(GetTag(Tags, "Texture"), Rectangle) Dim Texture As Texture2D = TextureManager.GetTexture(TexturePath, TextureRectangle) Dim Visible As Boolean = True If TagExists(Tags, "Visible") = True Then Visible = CBool(GetTag(Tags, "Visible")) End If Dim Shader As New Vector3(1.0F) If TagExists(Tags, "Shader") = True Then Dim ShaderList As List(Of Single) = CType(GetTag(Tags, "Shader"), List(Of Single)) Shader = New Vector3(ShaderList(0), ShaderList(1), ShaderList(2)) End If Dim RemoveFloor As Boolean = False If TagExists(Tags, "Remove") = True Then RemoveFloor = CBool(GetTag(Tags, "Remove")) End If Dim hasSnow As Boolean = True If TagExists(Tags, "hasSnow") = True Then hasSnow = CBool(GetTag(Tags, "hasSnow")) End If Dim hasSand As Boolean = True If TagExists(Tags, "hasSand") = True Then hasSand = CBool(GetTag(Tags, "hasSand")) End If Dim hasIce As Boolean = False If TagExists(Tags, "isIce") = True Then hasIce = CBool(GetTag(Tags, "isIce")) End If Dim rotation As Integer = 0 If TagExists(Tags, "Rotation") = True Then rotation = CInt(GetTag(Tags, "Rotation")) End If Dim SeasonTexture As String = "" If TagExists(Tags, "SeasonTexture") = True Then SeasonTexture = CStr(GetTag(Tags, "SeasonTexture")) End If Dim floorList As List(Of Entity) = Screen.Level.Floors If loadOffsetMap = True Then floorList = Screen.Level.OffsetmapFloors End If If RemoveFloor = False Then For x = 0 To Size.Width - 1 For z = 0 To Size.Height - 1 Dim exists As Boolean = False Dim iZ As Integer = z Dim iX As Integer = x Dim Ent As Entity = Nothing If loadOffsetMap = True Then Ent = Screen.Level.OffsetmapFloors.Find(Function(e As Entity) Return e.Position = New Vector3(Position.X + iX, Position.Y, Position.Z + iZ) End Function) Else Ent = Screen.Level.Floors.Find(Function(e As Entity) Return e.Position = New Vector3(Position.X + iX, Position.Y, Position.Z + iZ) End Function) End If If Not Ent Is Nothing Then Ent.Textures = {Texture} Ent.Visible = Visible Ent.SeasonColorTexture = SeasonTexture Ent.LoadSeasonTextures() CType(Ent, Floor).SetRotation(rotation) CType(Ent, Floor).hasSnow = hasSnow CType(Ent, Floor).IsIce = hasIce CType(Ent, Floor).hasSand = hasSand exists = True End If If exists = False Then Dim f As Floor = New Floor(Position.X + x, Position.Y, Position.Z + z, {TextureManager.GetTexture(TexturePath, TextureRectangle)}, {0, 0}, False, rotation, New Vector3(1.0F), BaseModel.FloorModel, 0, "", Visible, Shader, hasSnow, hasIce, hasSand) f.MapOrigin = MapOrigin f.SeasonColorTexture = SeasonTexture f.LoadSeasonTextures() f.IsOffsetMapContent = loadOffsetMap floorList.Add(f) End If Next Next Else For x = 0 To Size.Width - 1 For z = 0 To Size.Height - 1 For i = 0 To floorList.Count If i < floorList.Count Then Dim floor As Entity = floorList(i) If floor.Position.X = Position.X + x And floor.Position.Y = Position.Y And floor.Position.Z = Position.Z + z Then floorList.RemoveAt(i) i -= 1 End If End If Next Next Next End If End Sub Private Sub AddEntity(ByVal Tags As Dictionary(Of String, Object), ByVal Size As Size, ByVal SizeY As Integer, ByVal Fill As Boolean, ByVal Steps As Vector3) Dim EntityID As String = CStr(GetTag(Tags, "EntityID")) Dim ID As Integer = -1 If TagExists(Tags, "ID") = True Then ID = CInt(GetTag(Tags, "ID")) End If Dim PosList As List(Of Single) = CType(GetTag(Tags, "Position"), List(Of Single)) Dim Position As Vector3 = New Vector3(PosList(0) + Offset.X, PosList(1) + Offset.Y, PosList(2) + Offset.Z) Dim TexList As List(Of Rectangle) = CType(GetTag(Tags, "Textures"), List(Of Rectangle)) Dim TextureList As New List(Of Texture2D) Dim TexturePath As String = CStr(GetTag(Tags, "TexturePath")) For Each TextureRectangle As Rectangle In TexList TextureList.Add(TextureManager.GetTexture(TexturePath, TextureRectangle)) Next Dim TextureArray() As Texture2D = TextureList.ToArray() Dim TextureIndexList As List(Of Integer) = CType(GetTag(Tags, "TextureIndex"), List(Of Integer)) Dim TextureIndex() As Integer = TextureIndexList.ToArray() Dim ScaleList As List(Of Single) Dim Scale As New Vector3(1) If TagExists(Tags, "Scale") = True Then ScaleList = CType(GetTag(Tags, "Scale"), List(Of Single)) Scale = New Vector3(ScaleList(0), ScaleList(1), ScaleList(2)) End If Dim Collision As Boolean = CBool(GetTag(Tags, "Collision")) Dim ModelID As Integer = CInt(GetTag(Tags, "ModelID")) Dim ActionValue As Integer = CInt(GetTag(Tags, "Action")) Dim AdditionalValue As String = "" If TagExists(Tags, "AdditionalValue") = True Then AdditionalValue = CStr(GetTag(Tags, "AdditionalValue")) End If Dim AnimationData As List(Of List(Of Integer)) = Nothing If TagExists(Tags, "AnimationData") = True Then AnimationData = CType(GetTag(Tags, "AnimationData"), List(Of List(Of Integer))) End If Dim Rotation As Vector3 = Entity.GetRotationFromInteger(CInt(GetTag(Tags, "Rotation"))) If TagExists(Tags, "RotationXYZ") = True Then Dim rotationList As List(Of Single) = CType(GetTag(Tags, "RotationXYZ"), List(Of Single)) Rotation = New Vector3(rotationList(0), rotationList(1), rotationList(2)) End If If ModelID = 21 Then Rotation.Z += MathHelper.Pi End If Dim Visible As Boolean = True If TagExists(Tags, "Visible") = True Then Visible = CBool(GetTag(Tags, "Visible")) End If Dim Shader As New Vector3(1.0F) If TagExists(Tags, "Shader") = True Then Dim ShaderList As List(Of Single) = CType(GetTag(Tags, "Shader"), List(Of Single)) Shader = New Vector3(ShaderList(0), ShaderList(1), ShaderList(2)) End If Dim SeasonTexture As String = "" If TagExists(Tags, "SeasonTexture") = True Then SeasonTexture = CStr(GetTag(Tags, "SeasonTexture")) End If Dim SeasonToggle As String = "" If TagExists(Tags, "SeasonToggle") = True Then SeasonToggle = CStr(GetTag(Tags, "SeasonToggle")) End If Dim Opacity As Single = 1.0F If TagExists(Tags, "Opacity") = True Then Opacity = CSng(GetTag(Tags, "Opacity")) End If Dim CameraDistanceDelta As Single = 0.0F If TagExists(Tags, "CameraDistanceDelta") = True Then CameraDistanceDelta = CSng(GetTag(Tags, "CameraDistanceDelta")) End If For X = 0 To Size.Width - 1 Step Steps.X For Z = 0 To Size.Height - 1 Step Steps.Z For Y = 0 To SizeY - 1 Step Steps.Y Dim DoAdd As Boolean = False If Fill = False Then If X = 0 Or Z = 0 Or Z = Size.Height - 1 Or X = Size.Width - 1 Then DoAdd = True End If Else DoAdd = True End If If SeasonToggle <> "" Then If SeasonToggle.Contains(",") = False Then If SeasonToggle.ToLower() <> World.CurrentSeason.ToString().ToLower() Then DoAdd = False End If Else Dim seasons() As String = SeasonToggle.ToLower().Split(CChar(",")) If seasons.Contains(World.CurrentSeason.ToString().ToLower()) = False Then DoAdd = False End If End If End If If AnimationData IsNot Nothing AndAlso AnimationData.Count = 5 Then End If If DoAdd = True Then Dim newEnt As Entity = Entity.GetNewEntity(EntityID, New Vector3(Position.X + X, Position.Y + Y, Position.Z + Z), TextureArray, TextureIndex, Collision, Rotation, Scale, BaseModel.getModelbyID(ModelID), ActionValue, AdditionalValue, Visible, Shader, ID, MapOrigin, SeasonTexture, Offset, {}, Opacity, AnimationData, CameraDistanceDelta) newEnt.IsOffsetMapContent = loadOffsetMap If Not newEnt Is Nothing Then If loadOffsetMap = False Then Screen.Level.Entities.Add(newEnt) Else Screen.Level.OffsetmapEntities.Add(newEnt) End If End If End If Next Next Next End Sub Private Sub SetupLevel(ByVal Tags As Dictionary(Of String, Object)) Dim Name As String = CStr(GetTag(Tags, "Name")) Dim MusicLoop As String = CStr(GetTag(Tags, "MusicLoop")) If TagExists(Tags, "WildPokemon") = True Then Screen.Level.WildPokemonFloor = CBool(GetTag(Tags, "WildPokemon")) Else Screen.Level.WildPokemonFloor = False End If If TagExists(Tags, "OverworldPokemon") = True Then Screen.Level.ShowOverworldPokemon = CBool(GetTag(Tags, "OverworldPokemon")) Else Screen.Level.ShowOverworldPokemon = True End If If TagExists(Tags, "CurrentRegion") = True Then Screen.Level.CurrentRegion = CStr(GetTag(Tags, "CurrentRegion")) Else Screen.Level.CurrentRegion = "Johto" End If If TagExists(Tags, "RegionalForm") = True Then Screen.Level.RegionalForm = CStr(GetTag(Tags, "RegionalForm")) Else Screen.Level.RegionalForm = "" End If If TagExists(Tags, "HiddenAbility") Then Screen.Level.HiddenAbilityChance = CInt(GetTag(Tags, "HiddenAbility")) Else Screen.Level.HiddenAbilityChance = 0 End If Screen.Level.MapName = Name Screen.Level.MusicLoop = MusicLoop End Sub Public Shared MapScript As String = "" Private Sub SetupActions(ByVal Tags As Dictionary(Of String, Object)) If TagExists(Tags, "CanTeleport") = True Then Screen.Level.CanTeleport = CBool(GetTag(Tags, "CanTeleport")) Else Screen.Level.CanTeleport = False End If If TagExists(Tags, "CanDig") = True Then Screen.Level.CanDig = CBool(GetTag(Tags, "CanDig")) Else Screen.Level.CanDig = False End If If TagExists(Tags, "CanFly") = True Then Screen.Level.CanFly = CBool(GetTag(Tags, "CanFly")) Else Screen.Level.CanFly = False End If If TagExists(Tags, "RideType") = True Then Screen.Level.RideType = CInt(GetTag(Tags, "RideType")) Else Screen.Level.RideType = 0 End If If _reload = False Then If TagExists(Tags, "EnvironmentType") = True Then Screen.Level.EnvironmentType = CInt(GetTag(Tags, "EnvironmentType")) Else Screen.Level.EnvironmentType = 0 End If If TagExists(Tags, "Weather") = True Then Screen.Level.WeatherType = CInt(GetTag(Tags, "Weather")) Else Screen.Level.WeatherType = 0 End If If TagExists(Tags, "DayTime") = True Then Screen.Level.DayTime = CInt(GetTag(Tags, "DayTime")) Else Screen.Level.DayTime = 0 End If End If If TagExists(Tags, "Lighting") = True Then Screen.Level.LightingType = CInt(GetTag(Tags, "Lighting")) Else Screen.Level.LightingType = 1 End If If TagExists(Tags, "IsDark") = True Then Screen.Level.IsDark = CBool(GetTag(Tags, "IsDark")) Else Screen.Level.IsDark = False End If If Screen.Level.DayTime = World.DayTimes.Night Then If World.IsAurora = False Then Dim chance = Random.Next(0, 250) If chance = 0 Then World.IsAurora = True End If End If Else World.IsAurora = False End If If TagExists(Tags, "IsAurora") = True Then World.IsAurora = CBool(GetTag(Tags, "IsAurora")) Else World.IsAurora = False End If If TagExists(Tags, "Terrain") = True Then Screen.Level.Terrain.TerrainType = Terrain.FromString(CStr(GetTag(Tags, "Terrain"))) Else Screen.Level.Terrain.TerrainType = Terrain.TerrainTypes.Plain End If If TagExists(Tags, "IsSafariZone") = True Then Screen.Level.IsSafariZone = CBool(GetTag(Tags, "IsSafariZone")) Else Screen.Level.IsSafariZone = False End If If TagExists(Tags, "BugCatchingContest") = True Then Screen.Level.IsBugCatchingContest = True Screen.Level.BugCatchingContestData = CStr(GetTag(Tags, "BugCatchingContest")) Else Screen.Level.IsBugCatchingContest = False Screen.Level.BugCatchingContestData = "" End If If TagExists(Tags, "MapScript") = True Then Dim scriptName As String = CStr(GetTag(Tags, "MapScript")) If CurrentScreen.Identification = Screen.Identifications.OverworldScreen Then If CType(CurrentScreen, OverworldScreen).ActionScript.IsReady = True Then CType(CurrentScreen, OverworldScreen).ActionScript.reDelay = 0.0F CType(CurrentScreen, OverworldScreen).ActionScript.StartScript(scriptName, 0) Else ' A script intro is playing (such as Fly). MapScript = scriptName End If Else ' Must be a direct save load from the main menu. MapScript = scriptName End If Else MapScript = "" End If If TagExists(Tags, "RadioChannels") = True Then Dim channels() As String = CStr(GetTag(Tags, "RadioChannels")).Split(CChar(",")) For Each c As String In channels Screen.Level.AllowedRadioChannels.Add(CDec(c.Replace(".", GameController.DecSeparator))) Next Else Screen.Level.AllowedRadioChannels.Clear() End If If TagExists(Tags, "BattleMap") = True Then Screen.Level.BattleMapData = CStr(GetTag(Tags, "BattleMap")) Else Screen.Level.BattleMapData = "" End If If TagExists(Tags, "SurfingBattleMap") = True Then Screen.Level.SurfingBattleMapData = CStr(GetTag(Tags, "SurfingBattleMap")) Else Screen.Level.SurfingBattleMapData = "" End If Screen.Level.World = New World(Screen.Level.EnvironmentType, Screen.Level.WeatherType) End Sub Private Sub AddShader(ByVal Tags As Dictionary(Of String, Object)) Dim SizeList As List(Of Integer) = CType(GetTag(Tags, "Size"), List(Of Integer)) Dim Size As New Vector3(SizeList(0), 1, SizeList(1)) If SizeList.Count = 3 Then Size = New Vector3(SizeList(0), SizeList(1), SizeList(2)) End If Dim ShaderList As List(Of Single) = CType(GetTag(Tags, "Shader"), List(Of Single)) Dim Shader As Vector3 = New Vector3(ShaderList(0), ShaderList(1), ShaderList(2)) Dim StopOnContact As Boolean = CBool(GetTag(Tags, "StopOnContact")) Dim PosList As List(Of Integer) = CType(GetTag(Tags, "Position"), List(Of Integer)) Dim Position As Vector3 = New Vector3(PosList(0) + Offset.X, PosList(1) + Offset.Y, PosList(2) + Offset.Z) Dim ObjectSizeList As List(Of Integer) = CType(GetTag(Tags, "Size"), List(Of Integer)) Dim ObjectSize As New Size(ObjectSizeList(0), ObjectSizeList(1)) Dim DayTime As New List(Of Integer) If TagExists(Tags, "DayTime") = True Then DayTime = CType(GetTag(Tags, "DayTime"), List(Of Integer)) End If If DayTime.Contains(World.GetTime()) Or DayTime.Contains(-1) Or DayTime.Count = 0 Then Dim NewShader As New Shader(Position, Size, Shader, StopOnContact) Screen.Level.Shaders.Add(NewShader) End If End Sub Private Sub AddBackdrop(ByVal Tags As Dictionary(Of String, Object)) Dim SizeList As List(Of Integer) = CType(GetTag(Tags, "Size"), List(Of Integer)) Dim Width As Integer = SizeList(0) Dim Height As Integer = SizeList(1) Dim PosList As List(Of Single) = CType(GetTag(Tags, "Position"), List(Of Single)) Dim Position As Vector3 = New Vector3(PosList(0) + Offset.X, PosList(1) + Offset.Y, PosList(2) + Offset.Z) Dim Rotation As Vector3 = Vector3.Zero If TagExists(Tags, "Rotation") = True Then Dim rotationList As List(Of Single) = CType(GetTag(Tags, "Rotation"), List(Of Single)) Rotation = New Vector3(rotationList(0), rotationList(1), rotationList(2)) End If Dim BackdropType As String = CStr(GetTag(Tags, "Type")) Dim TexturePath As String = CStr(GetTag(Tags, "TexturePath")) Dim TextureRectangle As Rectangle = CType(GetTag(Tags, "Texture"), Rectangle) Dim Texture As Texture2D = TextureManager.GetTexture(TexturePath, TextureRectangle) Dim trigger As String = "" Dim isTriggered As Boolean = True If TagExists(Tags, "Trigger") = True Then trigger = CStr(GetTag(Tags, "Trigger")) End If Select Case trigger.ToLower() Case "offset" If Core.GameOptions.LoadOffsetMaps = 0 Then isTriggered = False End If Case "notoffset" If Core.GameOptions.LoadOffsetMaps > 0 Then isTriggered = False End If End Select If isTriggered = True Then Screen.Level.BackdropRenderer.AddBackdrop(New BackdropRenderer.Backdrop(BackdropType, Position, Rotation, Width, Height, Texture)) End If End Sub #End Region Private Sub LoadBerries() Dim Data() As String = Core.Player.BerryData.Replace("}" & Environment.NewLine, "}").Split(CChar("}")) For Each Berry As String In Data If Berry.Contains("{") = True Then Berry = Berry.Remove(0, Berry.IndexOf("{")) Berry = Berry.Remove(0, 1) Dim BData As List(Of String) = Berry.Split(CChar("|")).ToList() Dim PData() As String = BData(1).Split(CChar(",")) If BData.Count = 6 Then BData.Add("0") End If If BData(0).ToLower() = Screen.Level.LevelFile.ToLower() Then Dim newEnt As Entity = Entity.GetNewEntity("BerryPlant", New Vector3(CSng(PData(0)), CSng(PData(1)), CSng(PData(2))), {Nothing}, {0, 0}, True, New Vector3(0), New Vector3(1), BaseModel.BillModel, 0, "", True, New Vector3(1.0F), -1, MapOrigin, "", Offset) CType(newEnt, BerryPlant).Initialize(CInt(BData(2)), CInt(BData(3)), CStr(BData(4)), BData(5), CBool(BData(6))) Screen.Level.Entities.Add(newEnt) End If End If Next End Sub End Class