diff --git a/.gitignore b/.gitignore index 897d53e47..894dab556 100644 --- a/.gitignore +++ b/.gitignore @@ -12,7 +12,6 @@ # Build results [Dd]ebugPublic/ -[Dd]ebug/ [Rr]elease/ [Rr]eleases/ [Xx]64/ diff --git a/P3D/Debug/BoundingBoxRenderer.vb b/P3D/Debug/BoundingBoxRenderer.vb new file mode 100644 index 000000000..5fa93cd89 --- /dev/null +++ b/P3D/Debug/BoundingBoxRenderer.vb @@ -0,0 +1,58 @@ +Public Class BoundingBoxRenderer + +#Region "Fields" + + Shared verts(8) As VertexPositionColor + Shared indices As Int16() = New Int16() {0, 1, 1, 2, 2, 3, 3, 0, 0, 4, 1, 5, 2, 6, 3, 7, 4, 5, 5, 6, 6, 7, 7, 4} + Shared effect As BasicEffect + +#End Region + + Public Shared Sub Render(ByVal box As BoundingBox, ByVal graphicsDevice As GraphicsDevice, ByVal view As Matrix, ByVal projection As Matrix, ByVal color As Color) + If effect Is Nothing Then + effect = New BasicEffect(graphicsDevice) + effect.VertexColorEnabled = True + effect.LightingEnabled = False + End If + + Dim corners() As Vector3 = box.GetCorners() + For i = 0 To 7 + verts(i).Position = corners(i) + verts(i).Color = color + Next + + effect.View = view + effect.Projection = projection + + For Each pass As EffectPass In effect.CurrentTechnique.Passes + pass.Apply() + + graphicsDevice.DrawUserIndexedPrimitives(PrimitiveType.LineList, verts, 0, 8, indices, 0, CInt(indices.Length / 2)) + Next + End Sub + + Public Shared Sub Render(ByVal frustum As BoundingFrustum, ByVal graphicsDevice As GraphicsDevice, ByVal view As Matrix, ByVal projection As Matrix, ByVal color As Color) + If effect Is Nothing Then + effect = New BasicEffect(graphicsDevice) + effect.VertexColorEnabled = True + effect.LightingEnabled = False + End If + + Dim corners() As Vector3 = frustum.GetCorners() + For I = 0 To 7 + verts(I).Position = corners(I) + verts(I).Color = color + Next + + effect.View = view + effect.Projection = projection + + For Each pass As EffectPass In effect.CurrentTechnique.Passes + pass.Apply() + + graphicsDevice.DrawUserIndexedPrimitives(PrimitiveType.LineList, verts, 0, 8, indices, 0, CInt(indices.Length / 2)) + Next + + End Sub + +End Class \ No newline at end of file diff --git a/P3D/Debug/DebugDisplay.vb b/P3D/Debug/DebugDisplay.vb new file mode 100644 index 000000000..3a118fee0 --- /dev/null +++ b/P3D/Debug/DebugDisplay.vb @@ -0,0 +1,93 @@ +Public Class DebugDisplay + + ''' + ''' Renders the debug information. + ''' + Public Shared Sub Draw() + If Core.CurrentScreen.CanDrawDebug = True Then + Dim isDebugString As String = "" + If GameController.IS_DEBUG_ACTIVE = True Then + isDebugString = " (Debugmode / " & System.IO.File.GetLastWriteTime(System.Reflection.Assembly.GetExecutingAssembly.Location).ToString() & ")" + End If + + Dim ActionscriptActive As Boolean = True + If Core.CurrentScreen.Identification = Screen.Identifications.OverworldScreen Then + ActionscriptActive = CType(Core.CurrentScreen, OverworldScreen).ActionScript.IsReady + End If + + Dim thirdPersonString As String = "" + If Screen.Camera.Name = "Overworld" Then + Dim c As OverworldCamera = CType(Screen.Camera, OverworldCamera) + If c.ThirdPerson = True Then + thirdPersonString = " / " & c.ThirdPersonOffset.ToString() + End If + End If + + Dim s As String = GameController.GAMENAME & " " & GameController.GAMEDEVELOPMENTSTAGE & " " & GameController.GAMEVERSION & " / FPS: " & Math.Round(Core.GameInstance.FPSMonitor.Value, 0) & isDebugString & Environment.NewLine & + Screen.Camera.Position.ToString() & thirdPersonString & Environment.NewLine & Screen.Camera.Yaw & "; " & Screen.Camera.Pitch & Environment.NewLine & + "E: " & _drawnVertices.ToString() & "/" & _maxVertices.ToString() & Environment.NewLine & + "C: " & _maxDistance.ToString() & " A: " & ActionscriptActive.ToString() + + If Core.GameOptions.ContentPackNames.Count() > 0 Then + Dim contentPackString As String = "" + For Each ContentPackName As String In Core.GameOptions.ContentPackNames + If contentPackString <> "" Then + contentPackString &= ", " + End If + contentPackString &= ContentPackName + Next + contentPackString = "Loaded ContentPacks: " & contentPackString + s &= Environment.NewLine & contentPackString + End If + + Core.SpriteBatch.DrawInterfaceString(FontManager.MainFont, s, New Vector2(7, 7), Color.Black) + Core.SpriteBatch.DrawInterfaceString(FontManager.MainFont, s, New Vector2(5, 5), Color.White) + End If + End Sub + +#Region "RenderDataTracking" + + 'Values for tracking render data of the level. + Private Shared _drawnVertices As Integer = 0 + Private Shared _maxVertices As Integer = 0 + Private Shared _maxDistance As Integer = 0 + + ''' + ''' The amount of vertices rendered in the last frame. + ''' + Public Shared Property DrawnVertices() As Integer + Get + Return _drawnVertices + End Get + Set(value As Integer) + _drawnVertices = value + End Set + End Property + + ''' + ''' The maximum amount of vertices that are present in the current scene. + ''' + Public Shared Property MaxVertices() As Integer + Get + Return _maxVertices + End Get + Set(value As Integer) + _maxVertices = value + End Set + End Property + + ''' + ''' The distance of the vertex to the camera, that is the furthest away from the camera. + ''' + Public Shared Property MaxDistance() As Integer + Get + Return _maxDistance + End Get + Set(value As Integer) + _maxDistance = value + End Set + End Property + +#End Region + +End Class \ No newline at end of file diff --git a/P3D/Debug/DebugFileWatcher.vb b/P3D/Debug/DebugFileWatcher.vb new file mode 100644 index 000000000..12608f8b3 --- /dev/null +++ b/P3D/Debug/DebugFileWatcher.vb @@ -0,0 +1,82 @@ +''' +''' This class watches the maps and scripts folders of the project to automatically +''' copy changed files on map reloads to the bin directory. +''' +Public Class DebugFileWatcher + + Private Shared _changedFiles As List(Of String) + Private Shared _watchers As List(Of FileSystemWatcher) + Private Shared _isWatching As Boolean = False + + Shared Sub New() + _changedFiles = New List(Of String)() + _watchers = New List(Of FileSystemWatcher)() + End Sub + + Public Shared Sub TriggerReload() + ' copy all changed files + SyncLock _changedFiles + Dim projectPath = GetProjectPath() + Dim targetPath = AppDomain.CurrentDomain.BaseDirectory + + For Each changedFile In _changedFiles + Dim relativeFile = changedFile.Remove(0, projectPath.Length + 1) + Dim targetFile = Path.Combine(targetPath, relativeFile) + + File.Copy(changedFile, targetFile, True) + Next + + ' clear the changed files afterwards + _changedFiles.Clear() + End SyncLock + End Sub + + Private Shared Function GetProjectPath() As String + Return New DirectoryInfo(AppDomain.CurrentDomain.BaseDirectory).Parent.Parent.Parent.FullName + End Function + + Public Shared Sub StartWatching() + If Not _isWatching Then + _isWatching = True + + Dim projectPath = GetProjectPath() + + ' MAPS + Dim mapsPath = Path.Combine(projectPath, "Content\Data\maps") + Dim mapsWatcher = New FileSystemWatcher With { + .Path = mapsPath, + .NotifyFilter = NotifyFilters.LastWrite, + .IncludeSubdirectories = True + } + + AddHandler mapsWatcher.Changed, AddressOf OnChanged + mapsWatcher.EnableRaisingEvents = True + + _watchers.Add(mapsWatcher) + + ' SCRIPTS + Dim scriptsPath = Path.Combine(projectPath, "Content\Data\Scripts") + Dim scriptsWatcher = New FileSystemWatcher With { + .Path = scriptsPath, + .NotifyFilter = NotifyFilters.LastWrite, + .IncludeSubdirectories = True + } + + AddHandler scriptsWatcher.Changed, AddressOf OnChanged + scriptsWatcher.EnableRaisingEvents = True + + _watchers.Add(scriptsWatcher) + End If + End Sub + + Private Shared Sub OnChanged(source As Object, e As FileSystemEventArgs) + SyncLock _changedFiles + Dim file = e.FullPath + If Not _changedFiles.Contains(file) Then + Logger.Debug("File changed: " + file) + _changedFiles.Add(file) + End If + End SyncLock + End Sub + +End Class diff --git a/P3D/Debug/DotNetVersion.vb b/P3D/Debug/DotNetVersion.vb new file mode 100644 index 000000000..78b30ca0d --- /dev/null +++ b/P3D/Debug/DotNetVersion.vb @@ -0,0 +1,59 @@ +''' +''' A class to supply .Net installation information. +''' +Public Class DotNetVersion + + ''' + ''' Returns .Net installation information. + ''' + Public Shared Function GetInstalled() As String + Dim output As String = "" + + Try + Using ndpKey As Microsoft.Win32.RegistryKey = Microsoft.Win32.RegistryKey.OpenBaseKey(Microsoft.Win32.RegistryHive.LocalMachine, Microsoft.Win32.RegistryView.Registry32).OpenSubKey("SOFTWARE\Microsoft\NET Framework Setup\NDP\") + For Each versionKeyName As String In ndpKey.GetSubKeyNames() + If versionKeyName.StartsWith("v") Then + Dim versionKey As Microsoft.Win32.RegistryKey = ndpKey.OpenSubKey(versionKeyName) + Dim name As String = DirectCast(versionKey.GetValue("Version", ""), String) + Dim sp As String = versionKey.GetValue("SP", "").ToString() + Dim install As String = versionKey.GetValue("Install", "").ToString() + If install = "" Then + 'no install info, ust be later + output &= versionKeyName & " " & name & Environment.NewLine + Else + If sp <> "" AndAlso install = "1" Then + output &= versionKeyName & " " & name & " SP" & sp & Environment.NewLine + End If + End If + If name <> "" Then + Continue For + End If + For Each subKeyName As String In versionKey.GetSubKeyNames() + Dim subKey As Microsoft.Win32.RegistryKey = versionKey.OpenSubKey(subKeyName) + name = DirectCast(subKey.GetValue("Version", ""), String) + If name <> "" Then + sp = subKey.GetValue("SP", "").ToString() + End If + install = subKey.GetValue("Install", "").ToString() + If install = "" Then + 'no install info, ust be later + output &= versionKeyName & " " & name & Environment.NewLine + Else + If sp <> "" AndAlso install = "1" Then + output &= " " & subKeyName & " " & name & " SP" & sp & Environment.NewLine + ElseIf install = "1" Then + output &= " " & subKeyName & " " & name & Environment.NewLine + End If + End If + Next + End If + Next + End Using + Catch ex As Exception + output &= "Error getting .Net installation information." + End Try + + Return output + End Function + +End Class \ No newline at end of file diff --git a/P3D/Debug/FPSMonitor.vb b/P3D/Debug/FPSMonitor.vb new file mode 100644 index 000000000..c38fdb32b --- /dev/null +++ b/P3D/Debug/FPSMonitor.vb @@ -0,0 +1,31 @@ +Public Class FPSMonitor + + Public Value As Double + Public Sample As TimeSpan + + Private sw As Stopwatch + Private Frames As Integer + + Public Sub New() + Me.Sample = TimeSpan.FromMilliseconds(100) + + Value = 0 + Frames = 0 + sw = Stopwatch.StartNew() + End Sub + + Public Sub Update(ByVal GameTime As GameTime) + If sw.Elapsed > Sample Then + Me.Value = Frames / sw.Elapsed.TotalSeconds + + Me.sw.Reset() + Me.sw.Start() + Me.Frames = 0 + End If + End Sub + + Public Sub DrawnFrame() + Me.Frames += 1 + End Sub + +End Class \ No newline at end of file diff --git a/P3D/Debug/ForcedCrash.vb b/P3D/Debug/ForcedCrash.vb new file mode 100644 index 000000000..c4fe27c6c --- /dev/null +++ b/P3D/Debug/ForcedCrash.vb @@ -0,0 +1,32 @@ +Public Class ForcedCrash + + Shared Delay As Single = 14.0F + + Public Shared Sub Update() + If KeyBoardHandler.KeyDown(KeyBindings.DebugKey) = True And KeyBoardHandler.KeyDown(Keys.C) = True Then + Debug.Print("CRASH IN: " & Delay.ToString()) + Delay -= 0.1F + If Delay <= 0.0F Then + Crash() + End If + Else + Delay = 14.0F + End If + End Sub + + Private Shared Sub Crash() + Dim canCrash As Boolean = True + If Core.Player.loadedSave = True Then + If Core.Player.IsGamejoltSave = True Or Core.Player.SandBoxMode = False Then + canCrash = False + End If + End If + If canCrash = True Then + Dim ex As New Exception("Forced the game to crash.") + Throw ex + Else + Delay = 14.0F + End If + End Sub + +End Class \ No newline at end of file diff --git a/P3D/Debug/Logger.vb b/P3D/Debug/Logger.vb new file mode 100644 index 000000000..6dd1f3a61 --- /dev/null +++ b/P3D/Debug/Logger.vb @@ -0,0 +1,543 @@ +Imports System.Management +Imports System.Windows.Forms + +Public Class Logger + + Public Enum LogTypes + Message + Debug + ErrorMessage + Warning + Entry + End Enum + + Private Const CRASHLOGSEPARATOR As String = "---------------------------------------------------------------------------------" + + Private Shared History As New List(Of String) + Public Shared DisplayLog As Boolean = False + + Private Shared ErrorHeaders() As String = {"I AM ERROR!", + "Minecraft crashed.", + "Missingno.", + "1 ERROR", + "GET TO DA CHOPPA", + "Fire attacks might be super effective...", + "Does this help?", + "Work! Pleeeeeeeease?", + "WHAT IS THIS?", + "I find your lack of [ERROR] disturbing.", + "Blame Darkfire.", + "RTFM", + "FEZ II announced.", + "At least it's not a Blue Screen.", + "Kernel PANIC", + "I'm sorry, Dave, I'm afraid I can't do that.", + "Never gonna give you up ~", + "Wouldn't have happend with Swift.", + "Team Rocket blasting off again!", + "Snorlax just sat on your computer!", + "Wut?", + "Mojang buys Microsoft! Get your new Mojang operating system now. With more blocks and scrolls.", + "HλLF-LIFE 2 confirmed", + "(╯°□°）╯︵ ┻━┻"} + + Const LOGVERSION As String = "2.4" + + Public Shared Sub Log(ByVal LogType As LogTypes, ByVal Message As String) + Try + Dim currentTime As String = GetLogTime(Date.Now) + + Dim LogString As String + If LogType = LogTypes.Entry Then + LogString = "]" & Message + Else + LogString = LogType.ToString() & " (" & currentTime & "): " & Message + End If + + Debug("Logger: " & LogString) + + Dim Log As String = "" + + If IO.File.Exists(GameController.GamePath & "\log.dat") = True Then + Log = IO.File.ReadAllText(GameController.GamePath & "\log.dat") + End If + + If Log = "" Then + Log = LogString + Else + Log &= Environment.NewLine & LogString + End If + + IO.File.WriteAllText(GameController.GamePath & "\log.dat", Log) + Catch ex As Exception : End Try + End Sub + + Public Shared Function LogCrash(ByVal ex As Exception) As String + Try + Dim w32ErrorCode As Integer = -1 + + Dim w32 = TryCast(ex, System.ComponentModel.Win32Exception) + If w32 IsNot Nothing Then + w32ErrorCode = w32.ErrorCode + End If + + Dim logName As String = "" + With My.Computer.Clock.LocalTime + Dim month As String = .Month.ToString() + If month.Length = 1 Then + month = "0" & month + End If + Dim day As String = .Day.ToString() + If day.Length = 1 Then + day = "0" & day + End If + Dim hour As String = .Hour.ToString() + If hour.Length = 1 Then + hour = "0" & hour + End If + Dim minute As String = .Minute.ToString() + If minute.Length = 1 Then + minute = "0" & minute + End If + Dim second As String = .Second.ToString() + If second.Length = 1 Then + second = "0" & second + End If + logName = .Year & "-" & month & "-" & day & "_" & hour & "." & minute & "." & second & "_crash.dat" + End With + + Dim ContentPacks As String = "{}" + If Not Core.GameOptions Is Nothing Then + ContentPacks = Core.GameOptions.ContentPackNames.ArrayToString() + End If + + Dim GameMode As String = "[No GameMode loaded]" + If Not GameModeManager.ActiveGameMode Is Nothing Then + GameMode = GameModeManager.ActiveGameMode.Name + End If + + Dim OnlineInformation As String = "GameJolt Account: FALSE" + If Not Core.Player Is Nothing Then + OnlineInformation = "GameJolt Account: " & Core.Player.IsGameJoltSave.ToString().ToUpper() + If Core.Player.IsGameJoltSave = True Then + OnlineInformation &= " (" & GameJoltSave.GameJoltID & ")" + End If + End If + + Dim ScriptInfo As String = "Actionscript: No script running" + If Not CurrentScreen Is Nothing Then + If CurrentScreen.Identification = Screen.Identifications.OverworldScreen Then + If CType(CurrentScreen, OverworldScreen).ActionScript.IsReady = False Then + ScriptInfo = "Actionscript: " & ActionScript.CSL().ScriptName & "; Line: " & ActionScript.CSL().CurrentLine + End If + End If + End If + + Dim ServerInfo As String = "FALSE" + If ConnectScreen.Connected = True Then + ServerInfo = "TRUE (" & JoinServerScreen.SelectedServer.GetName() & "/" & JoinServerScreen.SelectedServer.GetAddressString() & ")" + End If + + Dim GameEnvironment As String = "[No Game Environment loaded]" + If Not CurrentScreen Is Nothing Then + GameEnvironment = CurrentScreen.Identification.ToString() + End If + + Dim IsSandboxMode As String = "False" + If Not Core.Player Is Nothing Then + IsSandboxMode = Core.Player.SandBoxMode.ToString() + End If + + Dim gameInformation As String = GameController.GAMENAME & " " & GameController.GAMEDEVELOPMENTSTAGE & " version: " & GameController.GAMEVERSION & " (" & GameController.RELEASEVERSION & ")" & Environment.NewLine & + "Content Packs: " & ContentPacks & Environment.NewLine & + "Active GameMode: " & GameMode & Environment.NewLine & + OnlineInformation & Environment.NewLine & + "Playing on Servers: " & ServerInfo & Environment.NewLine & + "Game Environment: " & GameEnvironment & Environment.NewLine & + ScriptInfo & Environment.NewLine & + "File Validation: " & Security.FileValidation.IsValid(True).ToString() & Environment.NewLine & + "Sandboxmode: " & IsSandboxMode + + Dim ScreenState As String = "[Screen state object not available]" + If Not CurrentScreen Is Nothing Then + ScreenState = "Screen state for the current screen (" & CurrentScreen.Identification.ToString() & ")" & Environment.NewLine & Environment.NewLine & + CurrentScreen.GetScreenStatus() + End If + + Dim architectureString As String = "32 Bit" + If Environment.Is64BitOperatingSystem = True Then + architectureString = "64 Bit" + End If + + Dim specs As String = "Operating system: " & My.Computer.Info.OSFullName & " [" & My.Computer.Info.OSVersion & "]" & Environment.NewLine & + "Core architecture: " & architectureString & Environment.NewLine & + "System time: " & My.Computer.Clock.LocalTime.ToString() & Environment.NewLine & + "System language: " & Globalization.CultureInfo.CurrentCulture.EnglishName & "(" & Globalization.CultureInfo.CurrentCulture.ThreeLetterWindowsLanguageName & ") / Loaded game language: " & Localization.LanguageSuffix & Environment.NewLine & + "Decimal separator: " & GameController.DecSeparator & Environment.NewLine & + "Available physical memory: " & Math.Round((My.Computer.Info.TotalPhysicalMemory / Math.Pow(1024, 3)), 2).ToString() & " Gigabyte" & Environment.NewLine & + "Available logical processors: " & Environment.ProcessorCount.ToString() + + Dim innerException As String = "NOTHING" + If Not ex.InnerException Is Nothing Then + innerException = ex.InnerException.Message + End If + Dim message As String = "NOTHING" + If Not ex.Message Is Nothing Then + message = ex.Message + End If + Dim source As String = "NOTHING" + If Not ex.Source Is Nothing Then + source = ex.Source + End If + Dim StackTrace As String = "NOTHING" + If Not ex.StackTrace Is Nothing Then + StackTrace = ex.StackTrace + End If + + Dim helpLink As String = "No helplink available." + If Not ex.HelpLink Is Nothing Then + helpLink = ex.HelpLink + End If + + Dim BaseException As Exception = ex.GetBaseException() + + Dim data As String = "NOTHING" + If Not ex.Data Is Nothing Then + data = "Items: " & ex.Data.Count + If ex.Data.Count > 0 Then + data = "" + For i = 0 To ex.Data.Count - 1 + If data <> "" Then + data &= Environment.NewLine + End If + data &= "[" & ex.Data.Keys(i).ToString() & ": """ & ex.Data.Values(i).ToString() & """]" + Next + End If + End If + + Dim informationItem As New ErrorInformation(ex) + + Dim objDump As New ObjectDump(Core.CurrentScreen) + Dim screenDump As String = objDump.Dump + + Dim content As String = + "Kolben Games Crash Log V " & LOGVERSION & Environment.NewLine & + GameController.GAMENAME & " has crashed!" & Environment.NewLine & + "// " & ErrorHeaders(Random.Next(0, ErrorHeaders.Length)) & Environment.NewLine & Environment.NewLine & + CRASHLOGSEPARATOR & Environment.NewLine & Environment.NewLine & + "Game information:" & Environment.NewLine & Environment.NewLine & + gameInformation & Environment.NewLine & Environment.NewLine & + CRASHLOGSEPARATOR & Environment.NewLine & Environment.NewLine & + ScreenState & Environment.NewLine & Environment.NewLine & + CRASHLOGSEPARATOR & Environment.NewLine & Environment.NewLine & + "System specifications:" & Environment.NewLine & Environment.NewLine & + specs & Environment.NewLine & Environment.NewLine & + CRASHLOGSEPARATOR & Environment.NewLine & Environment.NewLine & + ".Net installation information:" & Environment.NewLine & Environment.NewLine & + DotNetVersion.GetInstalled() & Environment.NewLine & + CRASHLOGSEPARATOR & Environment.NewLine & Environment.NewLine & + GetGraphicsCardInformation() & Environment.NewLine & Environment.NewLine & + CRASHLOGSEPARATOR & Environment.NewLine & Environment.NewLine & + "Error information:" & Environment.NewLine & + Environment.NewLine & "Message: " & message & + Environment.NewLine & "InnerException: " & innerException & + Environment.NewLine & "BaseException: " & BaseException.Message & + Environment.NewLine & "HelpLink: " & helpLink & + Environment.NewLine & "Data: " & data & + Environment.NewLine & "Source: " & source & + Environment.NewLine & "Win32 Errorcode: " & w32ErrorCode.ToString() & Environment.NewLine & Environment.NewLine & + CRASHLOGSEPARATOR & Environment.NewLine & Environment.NewLine & + informationItem.ToString() & Environment.NewLine & Environment.NewLine & + CRASHLOGSEPARATOR & Environment.NewLine & Environment.NewLine & + "CallStack: " & Environment.NewLine & Environment.NewLine & + StackTrace & Environment.NewLine & Environment.NewLine & + CRASHLOGSEPARATOR & Environment.NewLine & Environment.NewLine & + "Enviornment dump: " & Environment.NewLine & Environment.NewLine & + screenDump & Environment.NewLine & Environment.NewLine & + CRASHLOGSEPARATOR & Environment.NewLine & Environment.NewLine & + "You should report this error." & Environment.NewLine & Environment.NewLine & "Go to ""http://pokemon3d.net/forum/forums/6/create-thread"" to report this crash there." + + IO.File.WriteAllText(GameController.GamePath & "\" & logName, content) + + MessageBox.Show(GameController.GAMENAME & " has crashed!" & Environment.NewLine & "---------------------------" & Environment.NewLine & Environment.NewLine & "Here is further information:" & + Environment.NewLine & "Message: " & ex.Message & + Environment.NewLine & Environment.NewLine & "You should report this error. When you do this, please attach the crash log to the report. You can find the file in your ""Pokemon"" folder." & Environment.NewLine & Environment.NewLine & "The name of the file is: """ & logName & """.", + "Pokémon3D crashed!", MessageBoxButtons.OK, MessageBoxIcon.Error) + + + Process.Start("explorer.exe", "/select,""" & GameController.GamePath & "\" & logName & """") + + 'Returns the argument to start the launcher with: + Return """CRASHLOG_" & GameController.GamePath & "\" & logName & """ " & + """ERRORTYPE_" & informationItem.ErrorType & """ " & + """ERRORID_" & informationItem.ErrorID & """ " & + """GAMEVERSION_" & GameController.GAMEDEVELOPMENTSTAGE & " " & GameController.GAMEVERSION & """ " & + """CODESOURCE_" & ex.Source & """ " & + """TOPSTACK_" & ErrorInformation.GetStackItem(ex.StackTrace, 0) & """" + Catch exs As Exception + MessageBox.Show(exs.Message & Environment.NewLine & exs.StackTrace) + End Try + + Return "" + End Function + + Shared longestStackEntryName As String = "GameModeManager.SetGameModePointer" + + Public Shared Sub Debug(ByVal message As String) + Dim stackTraceEntry As String = Environment.StackTrace.SplitAtNewline()(3) + + While stackTraceEntry.StartsWith(" ") = True + stackTraceEntry = stackTraceEntry.Remove(0, 1) + End While + stackTraceEntry = stackTraceEntry.Remove(0, stackTraceEntry.IndexOf(" ") + 1) + stackTraceEntry = stackTraceEntry.Remove(stackTraceEntry.IndexOf("(")) + Dim pointString As String = stackTraceEntry.Remove(stackTraceEntry.LastIndexOf(".")) + stackTraceEntry = stackTraceEntry.Remove(0, pointString.LastIndexOf(".") + 1) + + Dim stackOutput As String = stackTraceEntry + + If stackOutput.Length > longestStackEntryName.Length Then + longestStackEntryName = stackOutput + Else + While stackOutput.Length < longestStackEntryName.Length + stackOutput &= " " + End While + End If + + Diagnostics.Debug.Print(stackOutput & StringHelper.Tab & "| " & message) + History.Add("(" & GetLogTime(Date.Now) & ") " & message) + End Sub + + Public Shared Sub DrawLog() + If DisplayLog = True And History.Count > 0 And Not FontManager.ChatFont Is Nothing Then + Dim items As New List(Of String) + Dim max As Integer = History.Count - 1 + + Dim itemCount As Integer = 10 + If windowSize.Height > 680 Then + itemCount += CInt(Math.Floor((windowSize.Height - 680) / 16)) + End If + + Dim min As Integer = max - itemCount + If min < 0 Then + min = 0 + End If + + Dim maxWidth As Integer = 0 + For i = min To max + Dim s As Single = FontManager.ChatFont.MeasureString(History(i)).X * 0.51F + If CInt(s) > maxWidth Then + maxWidth = CInt(s) + End If + Next + + Canvas.DrawRectangle(New Rectangle(0, 0, maxWidth + 10, (itemCount + 1) * 16 + 2), New Color(0, 0, 0, 150)) + + Dim c As Integer = 0 + For i = min To max + SpriteBatch.DrawString(FontManager.ChatFont, History(i), New Vector2(5, 2 + c * 16), Color.White, 0F, Vector2.Zero, 0.51F, SpriteEffects.None, 0F) + c += 1 + Next + End If + End Sub + + Private Shared Function GetLogTime(ByVal d As Date) As String + Dim hour As String = d.Hour.ToString() + Dim minute As String = d.Minute.ToString() + Dim second As String = d.Second.ToString() + + If hour.Length = 1 Then + hour = "0" & hour + End If + If minute.Length = 1 Then + minute = "0" & minute + End If + If second.Length = 1 Then + second = "0" & second + End If + + Return hour & ":" & minute & ":" & second + End Function + + Private Shared Function GetGraphicsCardInformation() As String + Dim CardName As String = "" + Dim CardRAM As String = "" + + Dim WmiSelect As New ManagementObjectSearcher("root\CIMV2", "SELECT * FROM Win32_VideoController") + + For Each WmiResults As ManagementObject In WmiSelect.Get() + Try + If CardName <> "" Then + CardName &= "; " + CardRAM &= "; " + End If + + CardName &= WmiResults.GetPropertyValue("Name").ToString() + CardRAM &= WmiResults.GetPropertyValue("AdapterRAM").ToString() + Catch ex As Exception + + End Try + Next + + Return "Graphics Card information:" & Environment.NewLine & Environment.NewLine & + "[CardName(s): """ & CardName & """]" & Environment.NewLine & + "[CardRAM(s) : """ & CardRAM & """]" + End Function + + Public Class ErrorInformation + + Public ErrorID As Integer = -1 + Public ErrorType As String = "" + Public ErrorDescription As String = "" + Public ErrorSolution As String = "" + + Public ErrorIDString As String = "-1" + + Public Sub New(ByVal EX As Exception) + Dim stackTrace As String = EX.StackTrace + + If Not stackTrace Is Nothing Then + Dim currentIndex As Integer = 0 + Dim callSub As String = "" + +analyzeStack: + callSub = GetStackItem(EX.StackTrace, currentIndex) + + Select Case callSub + 'asset issues (000-099): + Case "Microsoft.Xna.Framework.Content.ContentManager.OpenStream" + ErrorID = 1 + ErrorDescription = "The game was unable to load an asset (a Texture, a Sound or Music)." + ErrorSolution = "Make sure the file requested exists on your system." + Case "_2._5DHero.MusicManager.PlayMusic" + ErrorID = 2 + ErrorDescription = "The game was unable to play a music file." + ErrorSolution = "Make sure the file requested exists on your system. This might be caused by an invalid file in a ContentPack." + Case "Microsoft.Xna.Framework.Graphics.Texture.GetAndValidateRect" + ErrorID = 3 + ErrorDescription = "The game was unable to process a texture file." + ErrorSolution = "Code composed by Microsoft caused this issue. This might be caused by an invalid file in a ContentPack." + Case "Microsoft.Xna.Framework.Graphics.Texture2D.CopyData[T]" + ErrorID = 4 + ErrorDescription = "The game was unable to process a texture file." + ErrorSolution = "Code composed by Microsoft caused this issue. This might be caused by an invalid file in a ContentPack. Try to update your Graphics Card drivers." + Case "Microsoft.Xna.Framework.Media.MediaQueue.Play" + ErrorID = 5 + ErrorDescription = "The game was unable to load or play a music file." + ErrorSolution = "It is likely that the Windows Media Player is not installed on your computer or is wrongly configured. Please reinstall the Windows Media Player." + + 'GameJoltIssues (100-199) + Case "_2._5DHero.GameJolt.APICall.SetStorageData" + ErrorID = 100 + ErrorDescription = "The was unable to connect to a GameJolt server because you tried to send a command without being logged in to GameJolt." + ErrorSolution = "This happend because you got logged out from GameJolt due to connection problems. Ensure that your connection to the internet is constant." + + 'scripts (200-299) + Case "_2._5DHero.ScriptCommander.DoNPC" + ErrorID = 200 + ErrorDescription = "The game crashed trying to execute an NPC related command (starting with @npc.)" + ErrorSolution = "If this happend during your GameMode, inspect the file mentioned under ""Actionscript""." + Case "_2._5DHero.Trainer..ctor" + ErrorID = 201 + ErrorDescription = "The game was unable to initialize a new instance of a trainer class." + ErrorSolution = "If this is caused by your GameMode, make sure the syntax in the trainer file is correct." + Case "_2._5DHero.ScriptComparer.GetArgumentValue" + ErrorID = 202 + ErrorDescription = "The game crashed trying to process a script." + ErrorSolution = "If this is caused by your GameMode, make sure the syntax in the script or map file is correct." + + + 'Crashes generated by game code (300-399) + Case "_2._5DHero.ForcedCrash.Crash" + ErrorID = 300 + ErrorDescription = "The game crashed on purpose." + ErrorSolution = "Don't hold down F3 and C at the same time for a long time ;)" + Case "_2._5DHero.Security.ProcessValidation.ReportProcess" + ErrorID = 301 + ErrorDescription = "A malicious process was detected. To ensure that you are not cheating or hacking, the game closed." + ErrorSolution = "Close all processes with the details given in the Data of the crashlog." + Case "_2._5DHero.Security.FileValidation.CheckFileValid" + ErrorID = 302 + ErrorDescription = "The game detected edited or missing files." + ErrorSolution = "For online play, ensure that you are running the unmodded version of Pokémon3D. You can enable Content Packs." + + 'misc errors (900-999) + Case "Microsoft.Xna.Framework.Graphics.SpriteFont.GetIndexForCharacter" + ErrorID = 900 + ErrorDescription = "The game was unable to display a certain character which is not in the standard latin alphabet." + ErrorSolution = "Make sure the GameMode you are playing doesn't use any invalid characters in its scripts and maps." + Case "_2._5DHero.Player.LoadPlayer" + ErrorID = 901 + ErrorDescription = "The game failed to load a save state." + ErrorSolution = "There are multiple reasons for the game to fail at loading a save state. There could be a missing file in the player directory or corrupted files." + Case "Microsoft.Xna.Framework.BoundingFrustum.ComputeIntersectionLine" + ErrorID = 902 + ErrorDescription = "The game failed to set up camera mechanics." + ErrorSolution = "This error is getting produced by an internal Microsoft class. Please redownload the game if this error keeps appearing." + Case "_2._5DHero.Pokemon.Wild" + ErrorID = 903 + ErrorDescription = "The game crashed while attempting to generate a new Pokémon." + ErrorSolution = "This error could have multiple sources, so getting a solution here is difficult. If you made your own Pokémon data file for a GameMode, check it for invalid values." + + Case "-1" + 'No stack line found that applies to any error setting. + ErrorID = -1 + ErrorDescription = "The error is undocumented in the error handling system." + ErrorSolution = "NaN" + Case Else + currentIndex += 1 + GoTo analyzeStack + End Select + End If + + If ErrorID > -1 Then + ErrorIDString = ErrorID.ToString() + While ErrorIDString.Length < 3 + ErrorIDString = "0" & ErrorIDString + End While + End If + End Sub + + Public Overrides Function ToString() As String + If ErrorID > -1 And ErrorID < 100 Then + ErrorType = "Assets" + ElseIf ErrorID > 99 And ErrorID < 200 Then + ErrorType = "GameJolt" + ElseIf ErrorID > 199 And ErrorID < 300 Then + ErrorType = "Scripts" + ElseIf ErrorID > 299 And ErrorID < 400 Then + ErrorType = "Forced Crash" + ElseIf ErrorID > 899 And ErrorID < 1000 Then + ErrorType = "Misc." + Else + ErrorType = "NaN" + End If + + Dim s As String = "Error solution:" & Environment.NewLine & "(The provided solution might not work for your problem)" & Environment.NewLine & Environment.NewLine & + "Error ID: " & ErrorID & Environment.NewLine & + "Error Type: " & ErrorType & Environment.NewLine & + "Error Description: " & ErrorDescription & Environment.NewLine & + "Error Solution: " & ErrorSolution + Return s + End Function + + Public Shared Function GetStackItem(ByVal stack As String, ByVal i As Integer) As String + If i >= stack.SplitAtNewline().Count Then + Return "-1" + End If + + Dim line As String = stack.SplitAtNewline()(i) + Dim callSub As String = line + + While callSub.StartsWith(" ") = True + callSub = callSub.Remove(0, 1) + End While + callSub = callSub.Remove(0, callSub.IndexOf(" ") + 1) + callSub = callSub.Remove(callSub.IndexOf("(")) + + Return callSub + End Function + + End Class + +End Class \ No newline at end of file diff --git a/P3D/Debug/ObjectDump.vb b/P3D/Debug/ObjectDump.vb new file mode 100644 index 000000000..cc40b1471 --- /dev/null +++ b/P3D/Debug/ObjectDump.vb @@ -0,0 +1,202 @@ +Imports System.Collections +Imports System.Reflection + +''' +''' A class to access the dump of variables of an object. +''' +Public Class ObjectDump + + Public ReadOnly Property Dump As String = "" + + Public Sub New(ByVal sender As Object) + If sender Is Nothing Then + Dump = "Object reference not set to an instance of an object." + Else + Dim fields() As FieldInfo = sender.GetType().GetFields(BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.Instance Or BindingFlags.Static) + Dim properties() As PropertyInfo = sender.GetType().GetProperties(BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.Instance Or BindingFlags.Static) + + Dump = + "--------------------------------------------------" & Environment.NewLine & + "Generated Fields:" & Environment.NewLine & + "--------------------------------------------------" & Environment.NewLine + + For Each field As FieldInfo In fields + If Dump <> "" Then + Dump &= Environment.NewLine + End If + + Dim fieldAccessToken As String = "" + Dim fieldNameToken As String = "" + Dim fieldTypeToken As String = "" + Dim fieldValueToken As String = "" + + If field.IsPublic Then + fieldAccessToken = "Public " + ElseIf field.IsPrivate Then + fieldAccessToken = "Private " + ElseIf field.IsFamily Then + fieldAccessToken = "Protected " + End If + + If field.IsStatic Then + fieldAccessToken &= "Shared " + End If + + fieldNameToken = field.Name + fieldTypeToken = field.FieldType.Name + + If field.FieldType.IsArray Then + fieldValueToken = DumpArray(field.GetValue(sender)) + ElseIf field.FieldType.IsGenericType Then + If field.FieldType.Name = "List`1" Then + fieldTypeToken = $"List(Of {field.FieldType.GetGenericArguments()(0).Name})" + fieldValueToken = DumpGenericArray(field.GetValue(sender), "List`1") + ElseIf field.FieldType.Name = "Dictionary`2" Then + fieldTypeToken = $"Dictionary(Of {field.FieldType.GetGenericArguments()(0).Name}, {field.FieldType.GetGenericArguments()(1).Name})" + fieldValueToken = DumpGenericArray(field.GetValue(sender), "Dictionary`2") + End If + ElseIf field.FieldType.Name = "Texture2D" Then + fieldValueToken = DumpTexture2D(field.GetValue(sender)) + Else + fieldValueToken = DumpObject(field.GetValue(sender)) + End If + + Dump &= fieldAccessToken & fieldNameToken & " As " & fieldTypeToken & " = " & fieldValueToken + Next + + Dump &= Environment.NewLine & Environment.NewLine & + "--------------------------------------------------" & Environment.NewLine & + "Generated Property:" & Environment.NewLine & + "--------------------------------------------------" & Environment.NewLine + + For Each [property] As PropertyInfo In properties + If [property].CanRead Then + If Dump <> "" Then + Dump &= Environment.NewLine + End If + + Dim propertyNameToken As String = "" + Dim propertyTypeToken As String = "" + Dim propertyValueToken As String = "" + + propertyNameToken = [property].Name + propertyTypeToken = [property].PropertyType.Name + + If [property].PropertyType.IsArray Then + propertyValueToken = DumpArray([property].GetValue(sender)) + ElseIf [property].PropertyType.IsGenericType Then + If [property].PropertyType.Name = "List`1" Then + propertyTypeToken = $"List(Of {[property].PropertyType.GetGenericArguments()(0).Name})" + propertyValueToken = DumpGenericArray([property].GetValue(sender), "List`1") + ElseIf [property].PropertyType.Name = "Dictionary`2" Then + propertyTypeToken = $"Dictionary(Of {[property].PropertyType.GetGenericArguments()(0).Name}, {[property].PropertyType.GetGenericArguments()(1).Name})" + propertyValueToken = DumpGenericArray([property].GetValue(sender), "Dictionary`2") + End If + ElseIf [property].PropertyType.Name = "Texture2D" Then + propertyValueToken = DumpTexture2D([property].GetValue(sender)) + Else + propertyValueToken = DumpObject([property].GetValue(sender)) + End If + + Dump &= "Property " & propertyNameToken & " As " & propertyTypeToken & " = " & propertyValueToken + End If + Next + End If + End Sub + + Private Function DumpArray(ByVal obj As Object) As String + Try + If obj IsNot Nothing Then + Dim listValue As Array = CType(obj, Array) + If listValue.Length = 0 Then + Return "{}" + Else + Return "{" & String.Join(", ", listValue.Cast(Of Object).Select(Function(a) + Return a.ToString() + End Function).ToArray()) & "}" + End If + Else + Return "Nothing" + End If + Catch ex As Exception + Return "Array too complex to dump." + End Try + End Function + + Private Function DumpGenericArray(ByVal obj As Object, ByVal genericType As String) As String + Try + If obj IsNot Nothing Then + If genericType = "List`1" Then + Dim listValue As Array = CType(obj.GetType().GetMethod("ToArray").Invoke(obj, Nothing), Array) + If listValue.Length = 0 Then + Return "{}" + Else + Return "{" & String.Join(", ", listValue.Cast(Of Object).Select(Function(a) + Return a.ToString() + End Function).ToArray()) & "}" + End If + ElseIf genericType = "Dictionary`2" Then + Dim dictionaryKeys As Array = CType(obj.GetType().GetProperty("Keys").GetValue(obj), IEnumerable).Cast(Of Object).ToArray() + Dim dictonaryValues As Array = CType(obj.GetType().GetProperty("Values").GetValue(obj), IEnumerable).Cast(Of Object).ToArray() + + If dictionaryKeys.Length = 0 OrElse dictonaryValues.Length = 0 Then + Return "{}" + Else + Dim result As String = "" + For i As Integer = 0 To dictionaryKeys.Length - 1 + If i > 0 Then + result &= ", " + End If + result &= "{" & dictionaryKeys.Cast(Of Object)()(i).ToString() & ", " & dictonaryValues.Cast(Of Object)()(i).ToString() & "}" + Next + Return "{" & result & "}" + End If + Else + Return "Generic Type too complex to dump." + End If + Else + Return "Nothing" + End If + Catch ex As Exception + Return "Generic Type too complex to dump." + End Try + End Function + + Private Function DumpTexture2D(ByVal obj As Object) As String + Try + If obj IsNot Nothing Then + Dim textureName As String = "" + Dim width As Integer = Convert.ToInt32(obj.GetType().GetProperty("Width").GetValue(obj)) + Dim height As Integer = Convert.ToInt32(obj.GetType().GetProperty("Height").GetValue(obj)) + + If String.IsNullOrEmpty((obj.GetType().GetProperty("Name").GetValue(obj)?.ToString())) Then + textureName = """""" + Else + textureName = obj.GetType().GetProperty("Name").GetValue(obj)?.ToString() + End If + + Return $"{{Name = {textureName}, Width = {width}, Height = {height}}}" + Else + Return "Nothing" + End If + Catch ex As Exception + Return "Texture2D too complex to dump." + End Try + End Function + + Private Function DumpObject(ByVal obj As Object) As String + Try + If obj IsNot Nothing Then + If String.IsNullOrEmpty(obj.ToString()) Then + Return """""" + Else + Return obj.ToString() + End If + Else + Return "Nothing" + End If + Catch ex As Exception + Return "Object too complex to dump." + End Try + End Function +End Class \ No newline at end of file