diff --git a/Source/Delphi/Libraries/BeaEngine/BeaEngine.pas b/Libraries/Pascal/BeaEngine/BeaEngine.pas
similarity index 100%
rename from Source/Delphi/Libraries/BeaEngine/BeaEngine.pas
rename to Libraries/Pascal/BeaEngine/BeaEngine.pas
diff --git a/Source/Delphi/Libraries/BeaEngine/BeaEngineLib.obj b/Libraries/Pascal/BeaEngine/BeaEngineLib.obj
similarity index 100%
rename from Source/Delphi/Libraries/BeaEngine/BeaEngineLib.obj
rename to Libraries/Pascal/BeaEngine/BeaEngineLib.obj
diff --git a/Source/Delphi/Libraries/CxbxKrnl.dll b/Libraries/Pascal/CxbxKrnl.dll
similarity index 100%
rename from Source/Delphi/Libraries/CxbxKrnl.dll
rename to Libraries/Pascal/CxbxKrnl.dll
diff --git a/Source/Delphi/Libraries/D3DX81ab.dll b/Libraries/Pascal/D3DX81ab.dll
similarity index 100%
rename from Source/Delphi/Libraries/D3DX81ab.dll
rename to Libraries/Pascal/D3DX81ab.dll
diff --git a/Source/Delphi/Libraries/DirectX9/D3DX8.pas b/Libraries/Pascal/DirectX9/D3DX8.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/D3DX8.pas
rename to Libraries/Pascal/DirectX9/D3DX8.pas
diff --git a/Source/Delphi/Libraries/DirectX9/D3DX9.pas b/Libraries/Pascal/DirectX9/D3DX9.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/D3DX9.pas
rename to Libraries/Pascal/DirectX9/D3DX9.pas
diff --git a/Source/Delphi/Libraries/DirectX9/DX7toDX8.pas b/Libraries/Pascal/DirectX9/DX7toDX8.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DX7toDX8.pas
rename to Libraries/Pascal/DirectX9/DX7toDX8.pas
diff --git a/Source/Delphi/Libraries/DirectX9/DXErr9.pas b/Libraries/Pascal/DirectX9/DXErr9.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DXErr9.pas
rename to Libraries/Pascal/DirectX9/DXErr9.pas
diff --git a/Source/Delphi/Libraries/DirectX9/DXFile.pas b/Libraries/Pascal/DirectX9/DXFile.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DXFile.pas
rename to Libraries/Pascal/DirectX9/DXFile.pas
diff --git a/Source/Delphi/Libraries/DirectX9/DXTypes.pas b/Libraries/Pascal/DirectX9/DXTypes.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DXTypes.pas
rename to Libraries/Pascal/DirectX9/DXTypes.pas
diff --git a/Source/Delphi/Libraries/DirectX9/Direct3D.pas b/Libraries/Pascal/DirectX9/Direct3D.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/Direct3D.pas
rename to Libraries/Pascal/DirectX9/Direct3D.pas
diff --git a/Source/Delphi/Libraries/DirectX9/Direct3D8.pas b/Libraries/Pascal/DirectX9/Direct3D8.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/Direct3D8.pas
rename to Libraries/Pascal/DirectX9/Direct3D8.pas
diff --git a/Source/Delphi/Libraries/DirectX9/Direct3D9.pas b/Libraries/Pascal/DirectX9/Direct3D9.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/Direct3D9.pas
rename to Libraries/Pascal/DirectX9/Direct3D9.pas
diff --git a/Source/Delphi/Libraries/DirectX9/DirectDraw.pas b/Libraries/Pascal/DirectX9/DirectDraw.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DirectDraw.pas
rename to Libraries/Pascal/DirectX9/DirectDraw.pas
diff --git a/Source/Delphi/Libraries/DirectX9/DirectInput.pas b/Libraries/Pascal/DirectX9/DirectInput.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DirectInput.pas
rename to Libraries/Pascal/DirectX9/DirectInput.pas
diff --git a/Source/Delphi/Libraries/DirectX9/DirectMusic.pas b/Libraries/Pascal/DirectX9/DirectMusic.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DirectMusic.pas
rename to Libraries/Pascal/DirectX9/DirectMusic.pas
diff --git a/Source/Delphi/Libraries/DirectX9/DirectPlay8.pas b/Libraries/Pascal/DirectX9/DirectPlay8.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DirectPlay8.pas
rename to Libraries/Pascal/DirectX9/DirectPlay8.pas
diff --git a/Source/Delphi/Libraries/DirectX9/DirectSetup.pas b/Libraries/Pascal/DirectX9/DirectSetup.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DirectSetup.pas
rename to Libraries/Pascal/DirectX9/DirectSetup.pas
diff --git a/Source/Delphi/Libraries/DirectX9/DirectShow9.pas b/Libraries/Pascal/DirectX9/DirectShow9.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DirectShow9.pas
rename to Libraries/Pascal/DirectX9/DirectShow9.pas
diff --git a/Source/Delphi/Libraries/DirectX9/DirectSound.pas b/Libraries/Pascal/DirectX9/DirectSound.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DirectSound.pas
rename to Libraries/Pascal/DirectX9/DirectSound.pas
diff --git a/Source/Delphi/Libraries/DirectX9/DirectX.inc b/Libraries/Pascal/DirectX9/DirectX.inc
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DirectX.inc
rename to Libraries/Pascal/DirectX9/DirectX.inc
diff --git a/Source/Delphi/Libraries/DirectX9/DxDiag.pas b/Libraries/Pascal/DirectX9/DxDiag.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/DxDiag.pas
rename to Libraries/Pascal/DirectX9/DxDiag.pas
diff --git a/Source/Delphi/Libraries/DirectX9/X3DAudio.pas b/Libraries/Pascal/DirectX9/X3DAudio.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/X3DAudio.pas
rename to Libraries/Pascal/DirectX9/X3DAudio.pas
diff --git a/Source/Delphi/Libraries/DirectX9/XInput.pas b/Libraries/Pascal/DirectX9/XInput.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/XInput.pas
rename to Libraries/Pascal/DirectX9/XInput.pas
diff --git a/Source/Delphi/Libraries/DirectX9/dxerr8.pas b/Libraries/Pascal/DirectX9/dxerr8.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/dxerr8.pas
rename to Libraries/Pascal/DirectX9/dxerr8.pas
diff --git a/Source/Delphi/Libraries/DirectX9/xact.pas b/Libraries/Pascal/DirectX9/xact.pas
similarity index 100%
rename from Source/Delphi/Libraries/DirectX9/xact.pas
rename to Libraries/Pascal/DirectX9/xact.pas
diff --git a/Source/Delphi/Libraries/GLScene/GLScene.inc b/Libraries/Pascal/GLScene/GLScene.inc
similarity index 100%
rename from Source/Delphi/Libraries/GLScene/GLScene.inc
rename to Libraries/Pascal/GLScene/GLScene.inc
diff --git a/Source/Delphi/Libraries/GLScene/OpenGL1x.pas b/Libraries/Pascal/GLScene/OpenGL1x.pas
similarity index 100%
rename from Source/Delphi/Libraries/GLScene/OpenGL1x.pas
rename to Libraries/Pascal/GLScene/OpenGL1x.pas
diff --git a/Source/Delphi/Libraries/GLScene/OpenGLTokens.pas b/Libraries/Pascal/GLScene/OpenGLTokens.pas
similarity index 100%
rename from Source/Delphi/Libraries/GLScene/OpenGLTokens.pas
rename to Libraries/Pascal/GLScene/OpenGLTokens.pas
diff --git a/Source/Delphi/Libraries/GLScene/VectorTypes.pas b/Libraries/Pascal/GLScene/VectorTypes.pas
similarity index 100%
rename from Source/Delphi/Libraries/GLScene/VectorTypes.pas
rename to Libraries/Pascal/GLScene/VectorTypes.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/Jcl8087.pas b/Libraries/Pascal/Jcl/Commen/Jcl8087.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/Jcl8087.pas
rename to Libraries/Pascal/Jcl/Commen/Jcl8087.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclAnsiStrings.pas b/Libraries/Pascal/Jcl/Commen/JclAnsiStrings.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclAnsiStrings.pas
rename to Libraries/Pascal/Jcl/Commen/JclAnsiStrings.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclBase.pas b/Libraries/Pascal/Jcl/Commen/JclBase.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclBase.pas
rename to Libraries/Pascal/Jcl/Commen/JclBase.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclCharsets.pas b/Libraries/Pascal/Jcl/Commen/JclCharsets.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclCharsets.pas
rename to Libraries/Pascal/Jcl/Commen/JclCharsets.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclDateTime.pas b/Libraries/Pascal/Jcl/Commen/JclDateTime.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclDateTime.pas
rename to Libraries/Pascal/Jcl/Commen/JclDateTime.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclFileUtils.pas b/Libraries/Pascal/Jcl/Commen/JclFileUtils.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclFileUtils.pas
rename to Libraries/Pascal/Jcl/Commen/JclFileUtils.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclIniFiles-1.92.int b/Libraries/Pascal/Jcl/Commen/JclIniFiles-1.92.int
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclIniFiles-1.92.int
rename to Libraries/Pascal/Jcl/Commen/JclIniFiles-1.92.int
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclIniFiles.pas b/Libraries/Pascal/Jcl/Commen/JclIniFiles.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclIniFiles.pas
rename to Libraries/Pascal/Jcl/Commen/JclIniFiles.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclLogic.pas b/Libraries/Pascal/Jcl/Commen/JclLogic.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclLogic.pas
rename to Libraries/Pascal/Jcl/Commen/JclLogic.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclMath.pas b/Libraries/Pascal/Jcl/Commen/JclMath.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclMath.pas
rename to Libraries/Pascal/Jcl/Commen/JclMath.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclResources.pas b/Libraries/Pascal/Jcl/Commen/JclResources.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclResources.pas
rename to Libraries/Pascal/Jcl/Commen/JclResources.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclStreams.pas b/Libraries/Pascal/Jcl/Commen/JclStreams.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclStreams.pas
rename to Libraries/Pascal/Jcl/Commen/JclStreams.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclStringConversions.pas b/Libraries/Pascal/Jcl/Commen/JclStringConversions.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclStringConversions.pas
rename to Libraries/Pascal/Jcl/Commen/JclStringConversions.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclStrings.pas b/Libraries/Pascal/Jcl/Commen/JclStrings.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclStrings.pas
rename to Libraries/Pascal/Jcl/Commen/JclStrings.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclSynch.pas b/Libraries/Pascal/Jcl/Commen/JclSynch.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclSynch.pas
rename to Libraries/Pascal/Jcl/Commen/JclSynch.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclSysInfo.pas b/Libraries/Pascal/Jcl/Commen/JclSysInfo.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclSysInfo.pas
rename to Libraries/Pascal/Jcl/Commen/JclSysInfo.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclSysUtils.pas b/Libraries/Pascal/Jcl/Commen/JclSysUtils.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclSysUtils.pas
rename to Libraries/Pascal/Jcl/Commen/JclSysUtils.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclUnicode.pas b/Libraries/Pascal/Jcl/Commen/JclUnicode.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclUnicode.pas
rename to Libraries/Pascal/Jcl/Commen/JclUnicode.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclUnicode.rc b/Libraries/Pascal/Jcl/Commen/JclUnicode.rc
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclUnicode.rc
rename to Libraries/Pascal/Jcl/Commen/JclUnicode.rc
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclUnicode.res b/Libraries/Pascal/Jcl/Commen/JclUnicode.res
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclUnicode.res
rename to Libraries/Pascal/Jcl/Commen/JclUnicode.res
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclUnitVersioning.pas b/Libraries/Pascal/Jcl/Commen/JclUnitVersioning.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclUnitVersioning.pas
rename to Libraries/Pascal/Jcl/Commen/JclUnitVersioning.pas
diff --git a/Source/Delphi/Libraries/Jcl/Commen/JclWideStrings.pas b/Libraries/Pascal/Jcl/Commen/JclWideStrings.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/Commen/JclWideStrings.pas
rename to Libraries/Pascal/Jcl/Commen/JclWideStrings.pas
diff --git a/Source/Delphi/Libraries/Jcl/include/crossplatform.inc b/Libraries/Pascal/Jcl/include/crossplatform.inc
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/include/crossplatform.inc
rename to Libraries/Pascal/Jcl/include/crossplatform.inc
diff --git a/Source/Delphi/Libraries/Jcl/include/jcl.inc b/Libraries/Pascal/Jcl/include/jcl.inc
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/include/jcl.inc
rename to Libraries/Pascal/Jcl/include/jcl.inc
diff --git a/Source/Delphi/Libraries/Jcl/include/jcld11.inc b/Libraries/Pascal/Jcl/include/jcld11.inc
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/include/jcld11.inc
rename to Libraries/Pascal/Jcl/include/jcld11.inc
diff --git a/Source/Delphi/Libraries/Jcl/include/jcld12.inc b/Libraries/Pascal/Jcl/include/jcld12.inc
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/include/jcld12.inc
rename to Libraries/Pascal/Jcl/include/jcld12.inc
diff --git a/Source/Delphi/Libraries/Jcl/include/jcld14.inc b/Libraries/Pascal/Jcl/include/jcld14.inc
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/include/jcld14.inc
rename to Libraries/Pascal/Jcl/include/jcld14.inc
diff --git a/Source/Delphi/Libraries/Jcl/include/jedi.inc b/Libraries/Pascal/Jcl/include/jedi.inc
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/include/jedi.inc
rename to Libraries/Pascal/Jcl/include/jedi.inc
diff --git a/Source/Delphi/Libraries/Jcl/include/windowsonly.inc b/Libraries/Pascal/Jcl/include/windowsonly.inc
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/include/windowsonly.inc
rename to Libraries/Pascal/Jcl/include/windowsonly.inc
diff --git a/Source/Delphi/Libraries/Jcl/windows/JclConsole.pas b/Libraries/Pascal/Jcl/windows/JclConsole.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/windows/JclConsole.pas
rename to Libraries/Pascal/Jcl/windows/JclConsole.pas
diff --git a/Source/Delphi/Libraries/Jcl/windows/JclDebug.pas b/Libraries/Pascal/Jcl/windows/JclDebug.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/windows/JclDebug.pas
rename to Libraries/Pascal/Jcl/windows/JclDebug.pas
diff --git a/Source/Delphi/Libraries/Jcl/windows/JclHookExcept.pas b/Libraries/Pascal/Jcl/windows/JclHookExcept.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/windows/JclHookExcept.pas
rename to Libraries/Pascal/Jcl/windows/JclHookExcept.pas
diff --git a/Source/Delphi/Libraries/Jcl/windows/JclPeImage.pas b/Libraries/Pascal/Jcl/windows/JclPeImage.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/windows/JclPeImage.pas
rename to Libraries/Pascal/Jcl/windows/JclPeImage.pas
diff --git a/Source/Delphi/Libraries/Jcl/windows/JclRegistry.pas b/Libraries/Pascal/Jcl/windows/JclRegistry.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/windows/JclRegistry.pas
rename to Libraries/Pascal/Jcl/windows/JclRegistry.pas
diff --git a/Source/Delphi/Libraries/Jcl/windows/JclSecurity.pas b/Libraries/Pascal/Jcl/windows/JclSecurity.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/windows/JclSecurity.pas
rename to Libraries/Pascal/Jcl/windows/JclSecurity.pas
diff --git a/Source/Delphi/Libraries/Jcl/windows/JclShell.pas b/Libraries/Pascal/Jcl/windows/JclShell.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/windows/JclShell.pas
rename to Libraries/Pascal/Jcl/windows/JclShell.pas
diff --git a/Source/Delphi/Libraries/Jcl/windows/JclTD32.pas b/Libraries/Pascal/Jcl/windows/JclTD32.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/windows/JclTD32.pas
rename to Libraries/Pascal/Jcl/windows/JclTD32.pas
diff --git a/Source/Delphi/Libraries/Jcl/windows/JclWin32.pas b/Libraries/Pascal/Jcl/windows/JclWin32.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/windows/JclWin32.pas
rename to Libraries/Pascal/Jcl/windows/JclWin32.pas
diff --git a/Source/Delphi/Libraries/Jcl/windows/JclWin32Ex.pas b/Libraries/Pascal/Jcl/windows/JclWin32Ex.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/windows/JclWin32Ex.pas
rename to Libraries/Pascal/Jcl/windows/JclWin32Ex.pas
diff --git a/Source/Delphi/Libraries/Jcl/windows/Snmp.pas b/Libraries/Pascal/Jcl/windows/Snmp.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jcl/windows/Snmp.pas
rename to Libraries/Pascal/Jcl/windows/Snmp.pas
diff --git a/Source/Delphi/Libraries/Jwapi/Includes/Jedi.inc b/Libraries/Pascal/Jwapi/Includes/Jedi.inc
similarity index 100%
rename from Source/Delphi/Libraries/Jwapi/Includes/Jedi.inc
rename to Libraries/Pascal/Jwapi/Includes/Jedi.inc
diff --git a/Source/Delphi/Libraries/Jwapi/Includes/JediAPILib.inc b/Libraries/Pascal/Jwapi/Includes/JediAPILib.inc
similarity index 100%
rename from Source/Delphi/Libraries/Jwapi/Includes/JediAPILib.inc
rename to Libraries/Pascal/Jwapi/Includes/JediAPILib.inc
diff --git a/Source/Delphi/Libraries/Jwapi/Win32API/JwaBitFields.pas b/Libraries/Pascal/Jwapi/Win32API/JwaBitFields.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jwapi/Win32API/JwaBitFields.pas
rename to Libraries/Pascal/Jwapi/Win32API/JwaBitFields.pas
diff --git a/Source/Delphi/Libraries/Jwapi/Win32API/JwaNative.pas b/Libraries/Pascal/Jwapi/Win32API/JwaNative.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jwapi/Win32API/JwaNative.pas
rename to Libraries/Pascal/Jwapi/Win32API/JwaNative.pas
diff --git a/Source/Delphi/Libraries/Jwapi/Win32API/JwaNtStatus.pas b/Libraries/Pascal/Jwapi/Win32API/JwaNtStatus.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jwapi/Win32API/JwaNtStatus.pas
rename to Libraries/Pascal/Jwapi/Win32API/JwaNtStatus.pas
diff --git a/Source/Delphi/Libraries/Jwapi/Win32API/JwaWinBase.pas b/Libraries/Pascal/Jwapi/Win32API/JwaWinBase.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jwapi/Win32API/JwaWinBase.pas
rename to Libraries/Pascal/Jwapi/Win32API/JwaWinBase.pas
diff --git a/Source/Delphi/Libraries/Jwapi/Win32API/JwaWinDLLNames.pas b/Libraries/Pascal/Jwapi/Win32API/JwaWinDLLNames.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jwapi/Win32API/JwaWinDLLNames.pas
rename to Libraries/Pascal/Jwapi/Win32API/JwaWinDLLNames.pas
diff --git a/Source/Delphi/Libraries/Jwapi/Win32API/JwaWinNT.pas b/Libraries/Pascal/Jwapi/Win32API/JwaWinNT.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jwapi/Win32API/JwaWinNT.pas
rename to Libraries/Pascal/Jwapi/Win32API/JwaWinNT.pas
diff --git a/Source/Delphi/Libraries/Jwapi/Win32API/JwaWinType.pas b/Libraries/Pascal/Jwapi/Win32API/JwaWinType.pas
similarity index 100%
rename from Source/Delphi/Libraries/Jwapi/Win32API/JwaWinType.pas
rename to Libraries/Pascal/Jwapi/Win32API/JwaWinType.pas
diff --git a/Source/Delphi/Libraries/OpenXDK/include/xboxkrnl/XboxKrnl.pas b/Libraries/Pascal/OpenXDK/include/xboxkrnl/XboxKrnl.pas
similarity index 100%
rename from Source/Delphi/Libraries/OpenXDK/include/xboxkrnl/XboxKrnl.pas
rename to Libraries/Pascal/OpenXDK/include/xboxkrnl/XboxKrnl.pas
diff --git a/Source/Delphi/Libraries/msvcrtd.dll b/Libraries/Pascal/msvcrtd.dll
similarity index 100%
rename from Source/Delphi/Libraries/msvcrtd.dll
rename to Libraries/Pascal/msvcrtd.dll
diff --git a/Projects/Delphi/D14/Dxbx.dproj b/Projects/Delphi/D14/Dxbx.dproj
index ff204df1..bc4747b8 100644
--- a/Projects/Delphi/D14/Dxbx.dproj
+++ b/Projects/Delphi/D14/Dxbx.dproj
@@ -25,7 +25,7 @@
..\..\..\Source\Delphi\Bin
..\..\..\Source\Delphi\Dcu
- ..\..\..\Source\Delphi\src\Include;..\..\..\Source\Delphi\Libraries\Jcl\include;..\..\..\Source\Delphi\Libraries\Jwapi\Win32API;..\..\..\Source\Delphi\Libraries\Jwapi\Includes;..\..\..\Source\Delphi\Libraries\Jcl\windows;..\..\..\Source\Delphi\Libraries\Jcl\Commen;..\..\..\Source\Delphi\Libraries\DirectX9;$(DCC_UnitSearchPath)
+ ..\..\..\Source\Delphi\src\Include;..\..\..\Libraries\Pascal\Jcl\include;..\..\..\Libraries\Pascal\Jwapi\Win32API;..\..\..\Libraries\Pascal\Jwapi\Includes;..\..\..\Libraries\Pascal\Jcl\windows;..\..\..\Libraries\Pascal\Jcl\Commen;..\..\..\Libraries\Pascal\DirectX9;$(DCC_UnitSearchPath)
rc
true
false
diff --git a/Projects/Delphi/D14/DxbxKrnl.dpr b/Projects/Delphi/D14/DxbxKrnl.dpr
index 94ea95c9..7f1cdd60 100644
--- a/Projects/Delphi/D14/DxbxKrnl.dpr
+++ b/Projects/Delphi/D14/DxbxKrnl.dpr
@@ -38,10 +38,6 @@ library DxbxKrnl;
uses
Windows,
SysUtils,
- OpenGL1x in '..\..\..\Source\Delphi\Libraries\GLScene\OpenGL1x.pas',
- OpenGLTokens in '..\..\..\Source\Delphi\Libraries\GLScene\OpenGLTokens.pas',
- VectorTypes in '..\..\..\Source\Delphi\Libraries\GLScene\VectorTypes.pas',
- XboxKrnl in '..\..\..\Source\Delphi\Libraries\OpenXDK\include\xboxkrnl\XboxKrnl.pas',
uConvert in '..\..\..\Source\Delphi\src\DxbxKrnl\EmuD3D8\uConvert.pas',
uMiniport in '..\..\..\Source\Delphi\src\DxbxKrnl\EmuD3D8\uMiniport.pas',
uNV2A in '..\..\..\Source\Delphi\src\DxbxKrnl\EmuD3D8\uNV2A.pas',
@@ -119,7 +115,11 @@ uses
uXDVDFS in '..\..\..\Source\Delphi\src\uXDVDFS.pas',
VistaIconFix in '..\..\..\Source\Delphi\src\VistaIconFix.pas',
uData in '..\..\..\Source\Delphi\src\uData.pas',
- XbeHeaders in '..\..\..\Source\Delphi\src\Headers\XbeHeaders.pas';
+ XbeHeaders in '..\..\..\Source\Delphi\src\Headers\XbeHeaders.pas',
+ XboxKrnl in '..\..\..\Libraries\Pascal\OpenXDK\include\xboxkrnl\XboxKrnl.pas',
+ OpenGL1x in '..\..\..\Libraries\Pascal\GLScene\OpenGL1x.pas',
+ OpenGLTokens in '..\..\..\Libraries\Pascal\GLScene\OpenGLTokens.pas',
+ VectorTypes in '..\..\..\Libraries\Pascal\GLScene\VectorTypes.pas';
{$IMAGEBASE $10000000}
diff --git a/Projects/Delphi/D14/DxbxKrnl.dproj b/Projects/Delphi/D14/DxbxKrnl.dproj
index fc62a5f2..a940a45f 100644
--- a/Projects/Delphi/D14/DxbxKrnl.dproj
+++ b/Projects/Delphi/D14/DxbxKrnl.dproj
@@ -23,7 +23,7 @@
true
- ..\..\..\Source\Delphi\src\Include;..\..\..\Source\Delphi\Libraries\Jcl\include;..\..\..\Source\Delphi\Libraries\Jcl\Commen;..\..\..\Source\Delphi\Libraries\Jcl\Windows;..\..\..\Source\Delphi\Libraries\Jwapi\Win32API;..\..\..\Source\Delphi\Libraries\Jwapi\includes;..\..\..\Source\Delphi\Libraries\DirectX9;..\..\..\Source\Delphi\Libraries\BeaEngine;$(DCC_UnitSearchPath)
+ ..\..\..\Source\Delphi\src\Include;..\..\..\Libraries\Pascal\Jcl\include;..\..\..\Libraries\Pascal\Jcl\Commen;..\..\..\Libraries\Pascal\Jcl\Windows;..\..\..\Libraries\Pascal\Jwapi\Win32API;..\..\..\Libraries\Pascal\Jwapi\includes;..\..\..\Libraries\Pascal\DirectX9;..\..\..\Libraries\Pascal\BeaEngine;..\..\..\Libraries\Pascal\GlScene;$(DCC_UnitSearchPath)
..\..\..\Source\Delphi\Bin
..\..\..\Source\Delphi\Dcu
DXBX_DLL;$(DCC_Define)
@@ -32,18 +32,15 @@
true
- ..\..\bin\DxbxKrnl.dll
+ ..\..\..\Libraries\Pascal\GlScene
7.0
False
False
0
RELEASE;$(DCC_Define)
- ..\..\src\Include;..\..\Libraries\DirectX9;..\..\Libraries\Jcl\include;..\..\Libraries\Jcl\common;..\..\Libraries\Jcl\windows;..\..\Libraries\jwapi\Win32API;$(DCC_UnitSearchPath)
..\..\src\Include;..\..\Libraries\DirectX9;..\..\Libraries\Jcl\include;..\..\Libraries\Jcl\common;..\..\Libraries\Jcl\windows;..\..\Libraries\jwapi\Win32API;$(DCC_ResourcePath)
..\..\src\Include;..\..\Libraries\DirectX9;..\..\Libraries\Jcl\include;..\..\Libraries\Jcl\common;..\..\Libraries\Jcl\windows;..\..\Libraries\jwapi\Win32API;$(DCC_ObjPath)
..\..\src\Include;..\..\Libraries\DirectX9;..\..\Libraries\Jcl\include;..\..\Libraries\Jcl\common;..\..\Libraries\Jcl\windows;..\..\Libraries\jwapi\Win32API;$(DCC_IncludePath)
- ..\..\bin
- ..\..\dcu
..\..\dcu
..\..\dcu
@@ -51,11 +48,9 @@
3
7.0
DEBUG;_DEBUG_TRACE;$(DCC_Define)
- ..\..\src\Include;..\..\Libraries\DirectX9;..\..\Libraries\Jcl\include;..\..\Libraries\Jcl\common;..\..\Libraries\Jcl\windows;..\..\Libraries\jwapi\Includes;..\..\Libraries\jwapi\Win32API;..\..\Libraries\FastMM;$(DCC_UnitSearchPath)
..\..\src\Include;..\..\Libraries\DirectX9;..\..\Libraries\Jcl\include;..\..\Libraries\Jcl\common;..\..\Libraries\Jcl\windows;..\..\Libraries\jwapi\Includes;..\..\Libraries\jwapi\Win32API;$(DCC_ResourcePath)
..\..\src\Include;..\..\Libraries\DirectX9;..\..\Libraries\Jcl\include;..\..\Libraries\Jcl\common;..\..\Libraries\Jcl\windows;..\..\Libraries\jwapi\Includes;..\..\Libraries\jwapi\Win32API;$(DCC_ObjPath)
..\..\src\Include;..\..\Libraries\DirectX9;..\..\Libraries\Jcl\include;..\..\Libraries\Jcl\common;..\..\Libraries\Jcl\windows;..\..\Libraries\jwapi\Includes;..\..\Libraries\jwapi\Win32API;$(DCC_IncludePath)
- ..\..\..\Source\Delphi\Dcu
..\..\dcu\d11\
..\..\dcu\d11\
@@ -118,10 +113,6 @@
RC
-
-
-
-
@@ -211,6 +202,10 @@
+
+
+
+
Base
diff --git a/Projects/Delphi/D14/PatternTrieBuilder.dproj b/Projects/Delphi/D14/PatternTrieBuilder.dproj
index dde205c0..9af1541b 100644
--- a/Projects/Delphi/D14/PatternTrieBuilder.dproj
+++ b/Projects/Delphi/D14/PatternTrieBuilder.dproj
@@ -23,7 +23,7 @@
true
- ..\..\..\Source\Delphi\src\Include;..\..\..\Source\Delphi\Libraries\Jcl\include;..\..\..\Source\Delphi\Libraries\Jwapi\Win32API;..\..\..\Source\Delphi\Libraries\Jcl\Commen;..\..\..\Source\Delphi\Libraries\Jcl\windows;..\..\..\Source\Delphi\Libraries\Jwapi\Includes;$(DCC_UnitSearchPath)
+ ..\..\..\Source\Delphi\src\Include;..\..\..\Libraries\Pascal\Jcl\include;..\..\..\Libraries\Pascal\Jwapi\Win32API;..\..\..\Libraries\Pascal\Jcl\Commen;..\..\..\Libraries\Pascal\Jcl\windows;..\..\..\Libraries\Pascal\Jwapi\Includes;$(DCC_UnitSearchPath)
..\..\..\Source\Delphi\Bin\Tools\
..\..\..\Source\Delphi\Dcu
..\..\..\Source\Delphi\Bin\Tools\PatternTrieBuilder.exe
diff --git a/Projects/Delphi/D14/TranslationChecker.dproj b/Projects/Delphi/D14/TranslationChecker.dproj
index a2ed8fa2..8ef30abc 100644
--- a/Projects/Delphi/D14/TranslationChecker.dproj
+++ b/Projects/Delphi/D14/TranslationChecker.dproj
@@ -23,7 +23,7 @@
true
- ..\..\..\Source\Delphi\src\Include;..\..\..\Source\Delphi\Libraries\Jcl\include;..\..\..\Source\Delphi\Libraries\Jwapi\Win32API;..\..\..\Source\Delphi\Libraries\Jcl\Commen;..\..\..\Source\Delphi\Libraries\Jcl\windows;$(DCC_UnitSearchPath)
+ ..\..\..\Source\Delphi\src\Include;..\..\..\Libraries\Pascal\Jcl\include;..\..\..\Libraries\Pascal\Jwapi\Win32API;..\..\..\Libraries\Pascal\Jcl\Commen;..\..\..\Libraries\Pascal\Jcl\windows;$(DCC_UnitSearchPath)
..\..\..\Source\Delphi\Bin\Tools\
..\..\..\Source\Delphi\Dcu
..\..\..\Source\Delphi\Bin\Tools\TranslationChecker.exe
diff --git a/Projects/Delphi/D14/XBEExplorer.dpr b/Projects/Delphi/D14/XBEExplorer.dpr
index bbf354b4..5be8bfd4 100644
--- a/Projects/Delphi/D14/XBEExplorer.dpr
+++ b/Projects/Delphi/D14/XBEExplorer.dpr
@@ -5,7 +5,6 @@ program XBEExplorer;
uses
Forms,
SysUtils,
- BeaEngine in '..\..\..\Source\Delphi\Libraries\BeaEngine\BeaEngine.pas',
uDisassembleViewer in '..\..\..\Source\Delphi\src\Tools\XBEExplorer\uDisassembleViewer.pas',
uExploreFileSystem in '..\..\..\Source\Delphi\src\Tools\XBEExplorer\uExploreFileSystem.pas' {frmExploreFileSystem},
uHexViewer in '..\..\..\Source\Delphi\src\Tools\XBEExplorer\uHexViewer.pas',
@@ -26,7 +25,8 @@ uses
uXDVDFS in '..\..\..\Source\Delphi\src\uXDVDFS.pas',
uEmuD3D8Types in '..\..\..\Source\Delphi\src\DxbxKrnl\uEmuD3D8Types.pas',
VistaIconFix in '..\..\..\Source\Delphi\src\VistaIconFix.pas',
- XbeHeaders in '..\..\..\Source\Delphi\src\Headers\XbeHeaders.pas';
+ XbeHeaders in '..\..\..\Source\Delphi\src\Headers\XbeHeaders.pas',
+ BeaEngine in '..\..\..\Libraries\Pascal\BeaEngine\BeaEngine.pas';
{$R *.res}
diff --git a/Projects/Delphi/D14/XBEExplorer.dproj b/Projects/Delphi/D14/XBEExplorer.dproj
index 2827d9a4..b2e483af 100644
--- a/Projects/Delphi/D14/XBEExplorer.dproj
+++ b/Projects/Delphi/D14/XBEExplorer.dproj
@@ -24,9 +24,9 @@
vclx;vcl;vclimg;dbrtl;Rave77VCL;bdertl;rtl;vclactnband;vcldb;vcldbx;vcltouch;xmlrtl;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;inetdb;webdsnap;websnap;inetdbbde;inetdbxpress;soaprtl;vclribbon;DbxCommonDriver;DbxClientDriver;DBXInterBaseDriver;DBXMySQLDriver;dbexpress;dbxcds
- ..\..\..\Source\Delphi\src\Include;..\..\..\Source\Delphi\Libraries\Jcl\include;..\..\..\Source\Delphi\Libraries\Jwapi\Win32API;..\..\..\Source\Delphi\Libraries\Jcl\Commen;..\..\..\Source\Delphi\Libraries\Jcl\windows;..\..\..\Source\Delphi\Libraries\Jwapi\Includes;..\..\..\Source\Delphi\src;..\..\..\Source\Delphi\Libraries\DirectX9;$(DCC_UnitSearchPath)
+ ..\..\..\Source\Delphi\src\Include;..\..\..\Libraries\Pascal\Jcl\include;..\..\..\Libraries\Pascal\Jwapi\Win32API;..\..\..\Libraries\Pascal\Jcl\Commen;..\..\..\Libraries\Pascal\Jcl\windows;..\..\..\Libraries\Pascal\Jwapi\Includes;..\..\..\Source\Delphi\src;..\..\..\Libraries\Pascal\DirectX9;..\..\..\Libraries\Pascal\BeaEngine;D:\Xbox\Dxbx\Libraries\Pascal\BeaEngine;$(DCC_UnitSearchPath)
..\..\..\Source\Delphi\Bin\Tools\
- ..\..\..\Source\Delphi\Dcu
+ ..\..\..\Source\Delphi\Dcu\
rc
..\..\..\Source\Delphi\Bin\Tools\XBEExplorer.exe
@@ -103,7 +103,6 @@
RC
-
@@ -129,6 +128,7 @@
+
Base
diff --git a/Projects/Lazarus/Dxbx.lpi b/Projects/Lazarus/Dxbx.lpi
index 016249a2..677ec211 100644
--- a/Projects/Lazarus/Dxbx.lpi
+++ b/Projects/Lazarus/Dxbx.lpi
@@ -34,12 +34,12 @@
-
+
-
+
@@ -47,136 +47,161 @@
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
diff --git a/Projects/Lazarus/Dxbx.lpr b/Projects/Lazarus/Dxbx.lpr
index bdbec062..1158dd83 100644
--- a/Projects/Lazarus/Dxbx.lpr
+++ b/Projects/Lazarus/Dxbx.lpr
@@ -7,7 +7,7 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
- Forms, MainFrm
+ Forms, MainFrm, uDxbxUtils, aboutfrm
{ you can add units after this };
{$R *.res}
@@ -15,6 +15,7 @@ uses
begin
Application.Initialize;
Application.CreateForm(TMain, Main);
+ Application.CreateForm(TAboutFrm, AboutFrm);
Application.Run;
end.
diff --git a/Projects/Lazarus/backup/Dxbx.lpi.bak b/Projects/Lazarus/backup/Dxbx.lpi.bak
index 016249a2..89be69f7 100644
--- a/Projects/Lazarus/backup/Dxbx.lpi.bak
+++ b/Projects/Lazarus/backup/Dxbx.lpi.bak
@@ -34,12 +34,12 @@
-
+
-
+
@@ -51,44 +51,69 @@
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
@@ -96,87 +121,87 @@
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
diff --git a/Resources/Dxbx About Lazarus.jpg b/Resources/Dxbx About Lazarus.jpg
new file mode 100644
index 00000000..03a7ee37
Binary files /dev/null and b/Resources/Dxbx About Lazarus.jpg differ
diff --git a/Source/Delphi/src/ufrm_About.pas b/Source/Delphi/src/ufrm_About.pas
index b43a8be4..6af9852d 100644
--- a/Source/Delphi/src/ufrm_About.pas
+++ b/Source/Delphi/src/ufrm_About.pas
@@ -33,10 +33,8 @@ type
Tfrm_About = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
- private
- { Private declarations }
public
- { Public declarations }
+ class function Execute: Boolean;
end;
type
@@ -44,9 +42,6 @@ type
procedure LoadFromResourceName(Instance: THandle; const ResName: string);
end;
-var
- frm_About: Tfrm_About;
-
function GetJPEGResource(const aResourceName: string): TJPEGImage;
implementation
@@ -78,6 +73,18 @@ end;
{$R *.dfm}
+class function Tfrm_About.Execute: Boolean;
+var
+ frm_About: Tfrm_About;
+begin
+ frm_About := Tfrm_About.Create(nil);
+ try
+ Result := (frm_About.ShowModal = mrOk);
+ finally
+ FreeAndNil({var}frm_About);
+ end;
+end;
+
procedure Tfrm_About.FormCreate(Sender: TObject);
var
JPEGImage: TJPEGImage;
diff --git a/Source/Delphi/src/ufrm_Main.pas b/Source/Delphi/src/ufrm_Main.pas
index eb4f5902..4de5ca30 100644
--- a/Source/Delphi/src/ufrm_Main.pas
+++ b/Source/Delphi/src/ufrm_Main.pas
@@ -366,34 +366,12 @@ var
// Key messages can be trapped at the application level :
procedure Tfrm_Main.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
-//case Msg.message of WM_PAINT,WM_NCMOUSEMOVE..WM_NCXBUTTONDBLCLK, WM_COMMAND..WM_GESTURENOTIFY, WM_MOUSEFIRST..WM_MOUSELAST, WM_NCMOUSEHOVER..WM_MOUSELEAVE:; else
-//DbgPrintf('AppMessage() Msg.message = %d (%x) LOWORD(Msg.wParam) = %d (%x)', [Msg.message, Msg.message, LOWORD(Msg.wParam), LOWORD(Msg.wParam)]);
-//end;
-
// Dxbx : Protect against a loss of the child handle (otherwise, the GUI we would hang) :
if not IsWindow(m_hwndChild) then
m_hwndChild := HNULL;
Handled := False;
case Msg.message of
-// WM_USER_PARENTNOTIFY,
-// WM_PARENTNOTIFY:
-// case LOWORD(Msg.wParam) of
-// WM_CREATE:
-// begin
-// m_hwndChild := GetWindow(Msg.hwnd, GW_CHILD);
-// UpdateTitleInformation;
-// Handled := True;
-// end;
-//
-// WM_DESTROY:
-// begin
-// m_hwndChild := HNULL;
-// UpdateTitleInformation;
-// Handled := True;
-// end;
-// end;
-
WM_SYSKEYDOWN:
if m_hwndChild <> 0 then
begin
@@ -1565,13 +1543,7 @@ end; // actFileDebugKernelExecute
procedure Tfrm_Main.actAboutExecute(Sender: TObject);
begin
- frm_About := Tfrm_About.Create(Self);
-
- if frm_About.ShowModal = mrOk then
- begin
- end;
-
- FreeAndNil({var}frm_About);
+ Tfrm_About.Execute;
end;
procedure Tfrm_Main.actCleanSymbolCacheExecute(Sender: TObject);
diff --git a/Source/Lazarus/Src/mainfrm.pas b/Source/Lazarus/Src/mainfrm.pas
index 73d469a5..991ca816 100644
--- a/Source/Lazarus/Src/mainfrm.pas
+++ b/Source/Lazarus/Src/mainfrm.pas
@@ -5,8 +5,12 @@ unit MainFrm;
interface
uses
+ // Lazarus
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
- ActnList, StdCtrls, Grids, ExtCtrls;
+ ActnList, StdCtrls, Grids, ExtCtrls//,
+ // Dxbx
+// uDxbxUtils
+ ;
type
@@ -74,6 +78,8 @@ type
var
Main: TMain;
+ KernelDebugMode: TDebugMode = dmNone;
+ KernelDebugFilePath: string = ''; // Just the default folder
implementation
@@ -81,6 +87,43 @@ implementation
{ TMain }
+function BrowseDialogCallBack
+ (Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM):
+ integer stdcall;
+var
+ wa, rect: TRect;
+ dialogPT: TPoint;
+begin
+ //center in work area
+ if uMsg = BFFM_INITIALIZED then
+ begin
+ wa := Screen.WorkAreaRect;
+ GetWindowRect(Wnd, Rect);
+ dialogPT.X := ((wa.Right-wa.Left) div 2) -
+ ((rect.Right-rect.Left) div 2);
+ dialogPT.Y := ((wa.Bottom-wa.Top) div 2) -
+ ((rect.Bottom-rect.Top) div 2);
+ MoveWindow(Wnd,
+ dialogPT.X,
+ dialogPT.Y,
+ Rect.Right - Rect.Left,
+ Rect.Bottom - Rect.Top,
+ True);
+ SendMessage(wnd, BFFM_SETSELECTIONW, Longint(true), lpdata);
+ end;
+
+ Result := 0;
+end;
+
+function GetTitleSpecificKernelDebugFilePath: string;
+begin
+ // Was DXBX_KERNEL_DEBUG_FILENAME
+ if KernelDebugFilePath <> '' then
+ if LastChar(KernelDebugFilePath) <> '\' then
+ KernelDebugFilePath := KernelDebugFilePath + '\';
+
+ Result := KernelDebugFilePath + Format('DxbxKrnl %s (%d).txt', [TitleToNiceFilename(m_szAsciiTitle), SvnRevision])
+end;
end.
diff --git a/Source/Lazarus/Src/uDxbxUtils.pas b/Source/Lazarus/Src/uDxbxUtils.pas
new file mode 100644
index 00000000..850620b7
--- /dev/null
+++ b/Source/Lazarus/Src/uDxbxUtils.pas
@@ -0,0 +1,1851 @@
+(*
+ This file is part of Dxbx - a XBox emulator written in Delphi (ported over from cxbx)
+ Copyright (C) 2007 Shadow_tj and other members of the development team.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see .
+*)
+unit uDxbxUtils;
+
+interface
+
+uses
+ // Delphi
+ Windows,
+ SysUtils,
+ Classes,
+ Graphics,
+ ShlObj, // SHGetSpecialFolderPath
+ // Jedi
+ JwaWinType,
+ JwaNative, // NtQueryTimerResolution
+ // 3rd Party
+ JclWin32, // UNDNAME_COMPLETE
+ JclPeImage, // UndecorateSymbolName
+ // Dxbx
+ uTypes;
+
+const // instead of using uEmuD3D8Types :
+ X_D3DFMT_R5G6B5 = $05; // Swizzled 16bit ppx
+ X_D3DFMT_A8R8G8B8 = $06; // Swizzled 32bit ppx
+ X_D3DFMT_X8R8G8B8 = $07; // Swizzled 32bit ppx
+ X_D3DFMT_P8 = $0B; // 11, Swizzled, 8-bit Palletized
+ X_D3DFMT_DXT1 = $0C; // 12, Compressed, opaque/one-bit alpha
+ X_D3DFMT_DXT2 = $0E;
+ X_D3DFMT_DXT3 = $0E; // 14, Compressed, linear alpha
+ X_D3DFMT_DXT4 = $0F;
+ X_D3DFMT_DXT5 = $0F; // 15, Compressed, interpolated alpha
+
+const
+ NUMBER_OF_THUNKS = 379;
+
+ DXBX_CONSOLE_DEBUG_FILENAME = 'DxbxDebug.txt';
+ DXBX_KERNEL_DEBUG_FILENAME = 'KrnlDebug.txt';
+
+ // Thread access rights
+ THREAD_SET_CONTEXT = $0010; // See http://msdn.microsoft.com/en-us/library/ms686769(VS.85).aspx
+
+ // Trick to check validity of GetFileAttributes - this bit should be off :
+ FILE_ATTRIBUTE_INVALID = $10000000;
+
+type
+ EMU_STATE = (esNone, esFileOpen, esInvalidFile, esRunning);
+
+ TDebugInfoType = (ditConsole, ditFile);
+ EnumAutoConvert = (CONVERT_TO_MANUAL, CONVERT_TO_XBEPATH, CONVERT_TO_WINDOWSTEMP);
+
+ TDebugMode = (dmNone, dmConsole, dmFile);
+
+ TEntryProc = procedure();
+ PEntryProc = ^TEntryProc;
+
+ TSetXbePath = procedure(const Path: PAnsiChar); cdecl;
+
+ TKernelThunkTable = array [0..NUMBER_OF_THUNKS - 1] of UIntPtr;
+ PKernelThunkTable = ^TKernelThunkTable;
+
+ TGetKernelThunkTable = function: PKernelThunkTable; cdecl;
+
+ TLineCallback = function (aLinePtr: PAnsiChar; aLength: Integer; aData: Pointer): Boolean;
+
+ TGenericCompare = function (const List: Pointer; const Index: Integer; const SearchData: Pointer): Integer;
+
+ function GenericBinarySearch(const List: Pointer; const Count: Integer; const SearchData: Pointer; const Compare: TGenericCompare; out Index: Integer): Boolean;
+
+type
+ TListHelper = class helper for TList
+ public
+ function BinarySearch(const SearchData: Pointer; out Index: Integer; const Compare: TListSortCompare = nil): Boolean;
+ end;
+
+ TStreamHelper = class helper for TStream
+ public
+ procedure WriteString(const aString: AnsiString); overload;
+ procedure WriteString(const aString: string); overload;
+ end;
+
+ TCustomMemoryStreamHelper = class helper for TCustomMemoryStream
+ public
+ function DataString: AnsiString;
+ end;
+
+ TPreallocatedMemoryStream = class(TCustomMemoryStream)
+ public
+ constructor Create(const aAddress: Pointer; aSize: Integer);
+ function Write(const Buffer; Count: Longint): Longint; override;
+ end;
+
+ TDxbxBits = class(TBits)
+ public
+ procedure ClearRange(aOffset, Range: Integer);
+ procedure SetRange(aOffset, Range: Integer);
+ function IsRangeClear(aOffset, Range: Integer): Boolean;
+ end;
+
+const
+ BitsPerInt = SizeOf(Integer) * 8;
+ BitsPerIntShift = 5;
+
+type
+ TBitEnum = 0..BitsPerInt - 1;
+ TBitSet = set of TBitEnum;
+ TBitArray = array[0..(MaxInt div BitsPerInt)-1] of TBitSet;
+ PBitArray = ^TBitArray;
+
+function SvnRevision: Integer;
+
+procedure SetFS(const aNewFS: WORD);
+function GetFS(): WORD;
+function GetTIBEntry(const aOffset: DWORD): Pointer;
+function GetTIBEntryWord(const aOffset: DWORD): WORD;
+function GetTIB(): Pointer;
+
+procedure ScanPCharLines(const aPChar: PAnsiChar; const aLineCallback: TLineCallback; const aCallbackData: Pointer);
+
+function ScanHexByte(aLine: PAnsiChar; var Value: Integer): Boolean;
+function ScanHexWord(aLine: PAnsiChar; var Value: Integer): Boolean;
+function ScanHexDWord(aLine: PChar; var Value: Integer): Boolean;
+function HexToIntDef(const aLine: string; const aDefault: Integer): Integer;
+
+function Sscanf(const s: AnsiString; const fmt: AnsiString; const Pointers: array of Pointer): Integer;
+
+function BytesToString(const aSize: Integer): string;
+
+function TryReadLiteralString(const Ptr: PAnsiChar; const MaxStrLen: Integer = 260): UnicodeString;
+
+function StrLenLimit(Src: PAnsiChar; MaxLen: Cardinal): Cardinal;
+function StrLPas(const aPChar: PAnsiChar; const aMaxLength: Integer): AnsiString;
+
+function iif(aTest: Boolean; const aTrue, aFalse: Integer): Integer; overload;
+function iif(aTest: Boolean; const aTrue, aFalse: string): string; overload;
+
+function GetEnvVarValue(const VarName: string; Dequote: Boolean = False): string;
+
+function LocateExecutablePath(const aFileName: string): string;
+
+function IsFile(const aFilePath: string): Boolean;
+function IsFolder(const aFilePath: string): Boolean;
+
+function FindFiles(const aFolder, aFileMask: TFileName; aFileNames: TStrings): Integer;
+
+function StartsWithString(const aString, aPrefix: AnsiString): Boolean;
+function StartsWithText(const aString, aPrefix: AnsiString): Boolean; overload;
+function StartsWithText(const aString, aPrefix: UnicodeString): Boolean; overload;
+
+function PAnsiCharMaxLenToString(Source: PAnsiChar; MaxLen: Integer): AnsiString;
+function PWideCharMaxLenToString(Source: PWideChar; MaxLen: Integer): UnicodeString;
+
+procedure Swap(var aElement1, aElement2); overload;
+function RoundUp(dwValue, dwMult: DWord): DWord;
+
+function FixInvalidFilePath(const aFilePath: string): string;
+
+function RecapitalizeString(const aString: string): string;
+function TitleToNiceFilename(const aTitle: string): string;
+
+function DebugModeToString(const aDebugMode: TDebugMode): string;
+
+function IsValidHandle(const aHandle: LongWord): Boolean;
+function IsValidLibraryHandle(const aHandle: LongWord): Boolean;
+
+function GetLastErrorString: string;
+function GetErrorString(const aError: DWord): string;
+
+function PointerToString(const aPointer: Pointer): string;
+function FloatToString(const aValue: float): string;
+function BOOL2String(const aValue: BOOL): string;
+
+function QuadPart(const aValue: PLARGE_INTEGER): Int64;
+function Log2(aValue: DWORD): DWORD; overload;
+
+type
+ // Free interpretation of http://edn.embarcadero.com/article/29173
+ TRGB32 = packed record
+ B, G, R, A: Byte;
+ end;
+ PRGB32 = ^TRGB32;
+
+ TRGB32Array = array [0..MaxInt div SizeOf(TRGB32)-1] of TRGB32;
+ PRGB32Array = ^TRGB32Array;
+
+ RGB32Scanlines = record
+ private
+ FScanLines: array of PRGB32Array;
+ FWidth: Cardinal;
+ function GetScanline(Row: Integer): PRGB32Array;
+ function GetPixel(Col, Row: Integer): PRGB32;
+ function GetHeight: Cardinal;
+ public
+ procedure Initialize(const aBitmap: TBitmap);
+
+ property Scanlines[Row: Integer]: PRGB32Array read GetScanline; default;
+ property Pixels[Col, Row: Integer]: PRGB32 read GetPixel;
+
+ property Height: Cardinal read GetHeight;
+ property Width: Cardinal read FWidth;
+ end;
+ PRGB32Scanlines = ^RGB32Scanlines;
+
+type
+ TRGB16 = WORD;
+ PRGB16 = ^TRGB16;
+
+ TRGB16Array = array [0..MaxInt div SizeOf(TRGB16)-1] of TRGB16;
+ PRGB16Array = ^TRGB16Array;
+
+ RGB16Scanlines = record
+ private
+ FScanLines: array of PRGB16Array;
+ FWidth: Cardinal;
+ function GetScanline(Row: Integer): PRGB16Array;
+ function GetPixel(Col, Row: Integer): PRGB16;
+ function GetHeight: Cardinal;
+ public
+ procedure Initialize(const aBitmap: TBitmap);
+
+ property Scanlines[Row: Integer]: PRGB16Array read GetScanline; default;
+ property Pixels[Col, Row: Integer]: PRGB16 read GetPixel;
+
+ property Height: Cardinal read GetHeight;
+ property Width: Cardinal read FWidth;
+ end;
+ PRGB16Scanlines = ^RGB16Scanlines;
+
+
+function ReadS3TCFormatIntoBitmap(const aFormat: Byte; const aData: PBytes; const aDataSize: Cardinal; const aOutput: PRGB32Scanlines): Boolean;
+function ReadSwizzledFormatIntoBitmap(const aFormat: Byte; const aData: PBytes; const aDataSize: Cardinal; const aOutput: PRGB32Scanlines): Boolean;
+function ReadSwizzled16bitFormatIntoBitmap(const aFormat: Byte; const aData: PBytes; const aDataSize: Cardinal; const aOutput: PRGB16Scanlines): Boolean;
+function ReadD3DTextureFormatIntoBitmap(const aFormat: Byte; const aData: PBytes; const aDataSize: Cardinal; const aOutput: PRGB32Scanlines): Boolean;
+function ReadD3D16bitTextureFormatIntoBitmap(const aFormat: Byte; const aData: PBytes; const aDataSize: Cardinal; const aOutput: PRGB16Scanlines): Boolean;
+
+function GetDxbxBasePath: string;
+function SymbolCacheFolder: string;
+
+function SortObjects(List: TStringList; Index1, Index2: Integer): Integer;
+
+function DxbxUnmangleSymbolName(const aStr: string): string;
+
+type
+ // Helper type to get access to cdecl varargs, code published by Barry Kelly on :
+ // http://stackoverflow.com/questions/298373/how-can-a-function-with-varargs-retrieve-the-contents-of-the-stack\
+ // For usage, see comments in implementation.
+ RVarArgsReader = record
+ private
+ FArgPtr: IntPtr;
+ class function Align(Ptr: IntPtr; Align: Integer): IntPtr; static;
+ public
+ constructor Create(LastArg: Pointer; Size: Integer);
+ // Read bytes, signed words etc. using Int32
+ // Make an unsigned version if necessary.
+ function ReadInt32: Integer;
+ // Exact floating-point semantics depend on C compiler.
+ // Delphi compiler passes Extended as 10-byte float; most C
+ // compilers pass all floating-point values as 8-byte floats.
+ function ReadDouble: Double;
+ function ReadExtended: Extended;
+ function ReadPAnsiChar: PAnsiChar;
+ procedure ReadArg(var Arg; Size: Integer);
+ end;
+
+const
+ SymbolCacheFileExt = '.sym';
+
+var
+ DxbxBasePath: string;
+ DxbxBasePathHandle: Handle;
+
+ // Native folder for debug output files.
+ DxbxDebugFolder: string = 'C:\'; // TODO -oDxbx : Make this configurable (and put something more sane in here)
+
+const
+ // Here we define the addresses of the native Windows timers :
+ DxbxNtInterruptTime: PKSYSTEM_TIME = PKSYSTEM_TIME(MM_SHARED_USER_DATA_VA + USER_SHARED_DATA_INTERRUPT_TIME);
+ DxbxNtSystemTime: PKSYSTEM_TIME = PKSYSTEM_TIME(MM_SHARED_USER_DATA_VA + USER_SHARED_DATA_SYSTEM_TIME);
+ DxbxNtTickCountLowDeprecated: PDWORD = PDWORD(MM_SHARED_USER_DATA_VA + USER_SHARED_DATA_TICK_COUNT_LOW_DEPRECATED);
+ DxbxNtTickCount: PKSYSTEM_TIME = PKSYSTEM_TIME(MM_SHARED_USER_DATA_VA + USER_SHARED_DATA_TICK_COUNT);
+
+var
+ // These two variables should stay constant, so they are determined just once
+ // by calling DxbxGetTimerResultions() during unit initialization :
+ DxbxMinimumResolution: ULONG;
+ DxbxMaximumResolution: ULONG;
+procedure ReadSystemTimeIntoLargeInteger(const aSystemTime: PKSYSTEM_TIME; const aLargeInteger: PLARGE_INTEGER);
+
+implementation
+
+var
+ _SvnRevision: Integer = 0;
+
+function SvnRevision: Integer;
+var
+ ResourceStream: TResourceStream;
+ VerPtr: PAnsiChar;
+begin
+ Result := _SvnRevision;
+ if Result > 0 then
+ Exit;
+
+ ResourceStream := TResourceStream.Create(LibModuleList.ResInstance, 'SvnRevision', RT_RCDATA);
+ try
+ VerPtr := PAnsiChar(ResourceStream.Memory);
+ while VerPtr^ <> #0 do
+ begin
+ if VerPtr^ = #10 then
+ begin
+ Inc(Result);
+ if (Result > 3) then
+ Break;
+ end
+ else
+ if (Result = 3)
+ and (VerPtr^ in ['0'..'9'])
+ and (_SvnRevision < 100000) then
+ _SvnRevision := _SvnRevision * 10 + Ord(VerPtr^) - Ord('0');
+
+ Inc(VerPtr);
+ end;
+
+ finally
+ // Unlock the resource :
+ FreeAndNil(ResourceStream);
+ Result := _SvnRevision;
+ end;
+end;
+
+{$STACKFRAMES OFF}
+
+procedure SetFS(const aNewFS: WORD);
+asm
+ MOV FS, aNewFS
+end;
+
+function GetFS(): WORD;
+asm
+ XOR EAX, EAX
+ MOV AX, FS
+end;
+
+function GetTIBEntry(const aOffset: DWORD): Pointer;
+asm
+ MOV EAX, FS:[aOffset]
+end;
+
+function GetTIBEntryWord(const aOffset: DWORD): WORD;
+asm
+ MOV AX, FS:[aOffset]
+end;
+
+function GetTIB(): Pointer;
+begin
+ Result := GetTIBEntry({FS_Self=}$18);
+end;
+
+procedure ReadSystemTimeIntoLargeInteger(const aSystemTime: PKSYSTEM_TIME; const aLargeInteger: PLARGE_INTEGER);
+begin
+ repeat
+ aLargeInteger.HighPart := aSystemTime.High1Time;
+ aLargeInteger.LowPart := aSystemTime.LowPart;
+ until aLargeInteger.HighPart = aSystemTime.High2Time;
+end;
+
+procedure DxbxGetTimerResultions;
+// See http://www.digiater.nl/openvms/decus/vmslt97a/ntstuff/timer.txt
+var
+ CurrentResolution: ULONG;
+begin
+ NtQueryTimerResolution(@DxbxMinimumResolution, @DxbxMaximumResolution, @CurrentResolution);
+end;
+
+ {$STACKFRAMES ON}
+
+function FixInvalidFilePath(const aFilePath: string): string;
+var
+ i: Integer;
+begin
+ Result := aFilePath;
+ for i := 1 to Length(Result) do
+ begin
+ case AnsiChar(Result[i]) of
+ #0..#31, #127:
+ Result[i] := ' ';
+ '/', '\':
+ Result[i] := '_';
+ ':':
+ Result[i] := ';';
+ '*':
+ Result[i] := '•';
+ '?':
+ Result[i] := '¿';
+ '"':
+ Result[i] := '”';
+ '<':
+ Result[i] := '‹';
+ '>':
+ Result[i] := '›';
+ '|':
+ Result[i] := '¦';
+ end;
+ end;
+end;
+
+function RecapitalizeString(const aString: string): string;
+
+ procedure _ToUpper(aIndex: Integer);
+ begin
+ if CharInSet(Result[aIndex], ['a'..'z']) then
+ Result[aIndex] := Char(Ord(Result[aIndex]) - $20);
+ end;
+
+ procedure _ToLower(aIndex, aEndIndex: Integer);
+ begin
+ while aIndex <= aEndIndex do
+ begin
+ if CharInSet(Result[aIndex], ['A'..'Z']) then
+ Result[aIndex] := Char(Ord(Result[aIndex]) + $20);
+
+ Inc(aIndex);
+ end;
+ end;
+
+var
+ i, j: Integer;
+ NrOfChars: Integer;
+ NrOfUppercase: Integer;
+ DoOutput: Boolean;
+begin
+ // Start with input :
+ Result := Trim(aString);
+
+ // Insert spaces everywhere a uppercase follows a lowercase character :
+ i := Length(Result);
+ while i > 1 do
+ begin
+ if ( CharInSet(Result[i], ['A'..'Z']) and CharInSet(Result[i - 1], ['a'..'z']))
+ or ( CharInSet(Result[i], ['0'..'9']) and CharInSet(Result[i - 1], [':'..'z']))
+ or ( CharInSet(Result[i], [':'..'z']) and CharInSet(Result[i - 1], ['0'..'9'])) then
+ Insert(' ', Result, i);
+
+ Dec(i);
+ end;
+
+ // Count all characters (uppercase separately) :
+ j := 1;
+ NrOfChars := 0;
+ NrOfUppercase := 0;
+ for i := 1 to Length(Result) do
+ begin
+ DoOutput := (i = Length(Result));
+ case AnsiChar(Result[i]) of
+ '''':
+ ; // Do nothing - ' can be part of a word
+
+ 'a'..'z':
+ Inc(NrOfChars);
+
+ 'A'..'Z':
+ begin
+ Inc(NrOfChars);
+ Inc(NrOfUppercase);
+ end;
+ else
+ DoOutput := True;
+ end;
+
+ if DoOutput then
+ begin
+ while Result[j] = ' ' do
+ Inc(j);
+
+ // Very small words go to all-lowercase:
+ if NrOfChars <= 2 then
+ _ToLower(j, i)
+ else
+ // All-uppercase, up to 3 characters, stays that way :
+ if (NrOfUpperCase = NrOfChars) and (NrOfChars <= 3) then
+ // do nothing
+ else
+ begin
+ // The rest goes to Camel Caps :
+ _ToUpper(j);
+ _ToLower(j + 1, i);
+ end;
+
+ j := i + 1;
+ NrOfChars := 0;
+ NrOfUppercase := 0;
+ end;
+ end; // for
+end;
+
+function TitleToNiceFilename(const aTitle: string): string;
+begin
+ // Fixup invalid filename characters :
+ Result := FixInvalidFilePath(aTitle);
+
+ // Replace '_' with space :
+ Result := StringReplace(Result, '_', ' ', [rfReplaceAll]);
+
+ // Try to capitalize string better :
+ Result := RecapitalizeString(Result);
+end;
+
+procedure Swap(var aElement1, aElement2);
+var
+ Tmp: Pointer;
+begin
+ Tmp := Pointer(aElement1);
+ Pointer(aElement1) := Pointer(aElement2);
+ Pointer(aElement2) := Tmp;
+end;
+
+// Round dwValue to the nearest multiple of dwMult
+function RoundUp(dwValue, dwMult: DWord): DWord;
+begin
+ if dwMult = 0 then
+ Result := dwValue
+ else
+ Result := dwValue - ((dwValue - 1) mod dwMult) + (dwMult - 1);
+end;
+
+function StartsWithString(const aString, aPrefix: AnsiString): Boolean;
+begin
+ Result := strncmp(PAnsiChar(aString), PAnsiChar(aPrefix), Length(aPrefix)) = 0;
+end;
+
+function StartsWithText(const aString, aPrefix: AnsiString): Boolean; // overload
+begin
+ Result := AnsiStrLIComp(PAnsiChar(aString), PAnsiChar(aPrefix), Length(aPrefix)) = 0;
+end;
+
+function StartsWithText(const aString, aPrefix: UnicodeString): Boolean; // overload
+begin
+ Result := AnsiStrLIComp(PWideChar(aString), PWideChar(aPrefix), Length(aPrefix)) = 0;
+end;
+
+// TODO : Other solutions are PCharToString(), StrLPas(), but definately not PAnsiChar()!
+function PAnsiCharMaxLenToString(Source: PAnsiChar; MaxLen: Integer): AnsiString;
+var
+ ActualLen: Integer;
+begin
+ ActualLen := 0;
+ if Assigned(Source) then
+ while (ActualLen < MaxLen)
+ and (Source[ActualLen] > #9) do // Anything below tab will be treated as end of string
+ Inc(ActualLen);
+
+ SetLength(Result, ActualLen);
+ if ActualLen > 0 then
+ memcpy(@Result[1], Source, ActualLen * SizeOf(AnsiChar));
+end;
+
+function PWideCharMaxLenToString(Source: PWideChar; MaxLen: Integer): UnicodeString;
+var
+ ActualLen: Integer;
+begin
+ ActualLen := 0;
+ if Assigned(Source) then
+ while (ActualLen < MaxLen)
+ and (Source[ActualLen] > #9) do // Anything below tab will be treated as end of string
+ Inc(ActualLen);
+
+ SetLength(Result, ActualLen);
+ if ActualLen > 0 then
+ memcpy(@Result[1], Source, ActualLen * SizeOf(WideChar));
+end;
+
+function GetEnvVarValue(const VarName: string; Dequote: Boolean = False): string;
+var
+ BufSize: Integer;
+begin
+ // Get required buffer size (inc. terminal #0)
+ BufSize := GetEnvironmentVariable(PChar(VarName), nil, 0);
+ if BufSize > 0 then
+ begin
+ // Read env var value into result string
+ SetLength(Result, BufSize - 1);
+ GetEnvironmentVariable(PChar(VarName), PChar(Result), BufSize);
+
+ if Dequote and CharInSet(Result[1], ['''', '"']) then
+ Result := AnsiDequotedStr(Result, Result[1]);
+ end
+ else
+ Result := '';
+end;
+
+function LocateExecutablePath(const aFileName: string): string;
+var
+ BufSize: Integer;
+ FilePath: PChar;
+begin
+ // Get required buffer size (inc. terminal #0)
+ BufSize := SearchPath(nil, PChar(aFileName), nil, 0, nil, {var}FilePath);
+ if BufSize > 0 then
+ begin
+ SetLength(Result, BufSize - 1);
+ SearchPath(nil, PChar(aFileName), nil, BufSize, PChar(Result), {var}FilePath);
+ end
+ else
+ Result := '';
+end;
+
+function IsFile(const aFilePath: string): Boolean;
+begin
+ Result := (aFilePath <> '')
+ and ((GetFileAttributes(PChar(aFilePath)) and (FILE_ATTRIBUTE_ARCHIVE or FILE_ATTRIBUTE_DIRECTORY)) = FILE_ATTRIBUTE_ARCHIVE);
+end;
+
+function IsFolder(const aFilePath: string): Boolean;
+begin
+ Result := (aFilePath <> '')
+ and ((GetFileAttributes(PChar(aFilePath)) and (FILE_ATTRIBUTE_DIRECTORY or FILE_ATTRIBUTE_INVALID)) = FILE_ATTRIBUTE_DIRECTORY);
+end;
+
+function FindFiles(const aFolder, aFileMask: TFileName; aFileNames: TStrings): Integer;
+var
+ Status: Integer;
+ SearchRec: TSearchRec;
+begin
+ with aFileNames do
+ begin
+ BeginUpdate;
+ try
+ Status := FindFirst(IncludeTrailingPathDelimiter(aFolder) + aFileMask, faAnyFile, SearchRec);
+ while Status = 0 do
+ begin
+ if (SearchRec.Attr and faDirectory) = 0 then
+ Add(IncludeTrailingPathDelimiter(aFolder) + SearchRec.Name);
+
+ Status := FindNext(SearchRec);
+ end;
+
+ FindClose(SearchRec);
+ finally
+ EndUpdate;
+ end;
+
+ Result := Count;
+ end;
+end;
+
+function _ScanAndAddHexDigit(var Value: Integer; const aHexDigit: AnsiChar): Boolean; overload;
+begin
+ Result := True;
+ case aHexDigit of
+ '0'..'9':
+ Value := (Value * 16) + (Ord(aHexDigit) - Ord('0'));
+ 'A'..'F':
+ Value := (Value * 16) + (Ord(aHexDigit) - Ord('A') + 10);
+ 'a'..'f':
+ Value := (Value * 16) + (Ord(aHexDigit) - Ord('a') + 10);
+ else
+ Result := False;
+ end;
+end;
+
+function _ScanAndAddHexDigit(var Value: Integer; const aHexDigit: WideChar): Boolean; overload;
+begin
+ Result := True;
+ case aHexDigit of
+ '0'..'9':
+ Value := (Value * 16) + (Ord(aHexDigit) - Ord('0'));
+ 'A'..'F':
+ Value := (Value * 16) + (Ord(aHexDigit) - Ord('A') + 10);
+ 'a'..'f':
+ Value := (Value * 16) + (Ord(aHexDigit) - Ord('a') + 10);
+ else
+ Result := False;
+ end;
+end;
+
+function _ScanHexDigits(aLine: PAnsiChar; var Value: Integer; Digits: Integer): Boolean; overload;
+begin
+ Value := 0;
+ while (Digits > 0) and (aLine^ > #0) do
+ begin
+ Result := _ScanAndAddHexDigit(Value, aLine^);
+ if not Result then
+ Exit;
+
+ Inc(aLine);
+ Dec(Digits);
+ end;
+
+ Result := True;
+end;
+
+function _ScanHexDigits(aLine: PWideChar; var Value: Integer; Digits: Integer): Boolean; overload;
+begin
+ Value := 0;
+ while (Digits > 0) and (aLine^ > #0) do
+ begin
+ Result := _ScanAndAddHexDigit(Value, aLine^);
+ if not Result then
+ Exit;
+
+ Inc(aLine);
+ Dec(Digits);
+ end;
+
+ Result := True;
+end;
+
+function ScanHexByte(aLine: PAnsiChar; var Value: Integer): Boolean;
+begin
+ Result := _ScanHexDigits(aLine, Value, 2);
+end;
+
+function ScanHexWord(aLine: PAnsiChar; var Value: Integer): Boolean;
+begin
+ Result := _ScanHexDigits(aLine, Value, 4);
+end;
+
+function ScanHexDWord(aLine: PChar; var Value: Integer): Boolean;
+begin
+ Result := _ScanHexDigits(aLine, Value, 8);
+end;
+
+function HexToIntDef(const aLine: string; const aDefault: Integer): Integer;
+begin
+ if not ScanHexDWord(PChar(aLine), Result) then
+ Result := aDefault;
+end;
+
+procedure ScanPCharLines(const aPChar: PAnsiChar; const aLineCallback: TLineCallback; const aCallbackData: Pointer);
+var
+ p1, p2: PAnsiChar;
+begin
+ // Scan Lines:
+ p1 := aPChar;
+ while p1^ > #0 do
+ begin
+ // Scan this line until end of line (#0..#13) :
+ p2 := p1;
+ while p2^ > #13 do
+ Inc(p2);
+
+ // Handle this line :
+ if not aLineCallback(p1, {Length=}p2-p1, aCallbackData) then
+ Exit;
+
+ // Step over to the start of the next line :
+ p1 := p2 + 1;
+ while p1^ in [#10, #13] do
+ Inc(p1);
+ end;
+end;
+
+function Sscanf(const s: AnsiString; const fmt: AnsiString; const Pointers: array of Pointer): Integer;
+var
+ i, j, n, m: Integer;
+ s1: AnsiString;
+ L: LongInt;
+ X: Extended;
+
+ function GetInt: Integer;
+ begin
+ s1 := '';
+ while (n <= Length(s)) and (s[n] = ' ') do
+ Inc(n);
+
+ while (n <= Length(s))
+ and (s[n] in ['0'..'9', '+', '-']) do
+ begin
+ s1 := s1 + s[n];
+ Inc(n);
+ end;
+
+ Result := Length(s1);
+ end;
+
+ function GetFloat: Integer;
+ begin
+ s1 := '';
+ while (n <= Length(s)) and (s[n] = ' ') do
+ Inc(n);
+
+ while (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E'])
+ and (Length(s) >= n) do
+ begin
+ s1 := s1 + s[n];
+ Inc(n);
+ end;
+
+ Result := Length(s1);
+ end;
+
+ function GetString: Integer;
+ begin
+ s1 := '';
+ while (n <= Length(s)) and (s[n] = ' ') do
+ Inc(n);
+
+ while (n <= Length(s)) and (s[n] <> ' ') do
+ begin
+ s1 := s1 + s[n];
+ Inc(n);
+ end;
+
+ Result := Length(s1);
+ end;
+
+ function ScanStr(c: AnsiChar): Boolean;
+ begin
+ while (n <= Length(s)) and (s[n] <> c) do
+ Inc(n);
+
+ Inc(n);
+
+ if (n <= Length(s)) then
+ Result := True
+ else
+ Result := False;
+ end;
+
+ function GetFmt: Integer;
+ begin
+ Result := -1;
+
+ while True do
+ begin
+ while (m <= Length(fmt)) and (fmt[m] = ' ') do
+ Inc(m);
+
+ if m >= Length(fmt) then
+ break;
+
+ if fmt[m] = '%' then
+ begin
+ Inc(m);
+ case fmt[m] of
+ 'd': Result := vtInteger;
+ 'f': Result := vtExtended;
+ 's': Result := vtString;
+ end;
+
+ Inc(m);
+ break;
+ end;
+
+ if (ScanStr(fmt[m]) = False) then
+ break;
+
+ Inc(m);
+ end;
+ end;
+
+begin
+ n := 1;
+ m := 1;
+ Result := 0;
+
+ for i := 0 to High(Pointers) do
+ begin
+ j := GetFmt;
+
+ case j of
+ vtInteger:
+ begin
+ if GetInt > 0 then
+ begin
+ L := StrToInt(string(s1));
+ Move(L, Pointers[i]^, SizeOf(LongInt));
+ Inc(Result);
+ end
+ else
+ break;
+ end;
+
+ vtExtended:
+ begin
+ if GetFloat > 0 then
+ begin
+ X := StrToFloat(string(s1));
+ Move(X, Pointers[i]^, SizeOf(Extended));
+ Inc(Result);
+ end
+ else
+ break;
+ end;
+
+ vtString:
+ begin
+ if GetString > 0 then
+ begin
+ Move(s1, Pointers[i]^, Length(s1) + 1);
+ Inc(Result);
+ end
+ else
+ break;
+ end;
+ else
+ break;
+ end;
+ end;
+end;
+
+function BytesToString(const aSize: Integer): string;
+begin
+ Result := FormatFloat(',0', aSize) + ' bytes';
+end;
+
+function TryReadLiteralString(const Ptr: PAnsiChar; const MaxStrLen: Integer = 260): UnicodeString;
+const
+ // Here the (rather arbitrary) steering parameters :
+ MinStrLen = 3;
+ PrintableChars = [' '..#127];
+var
+ i: Integer;
+ NrAnsiChars: Integer;
+ NrWideZeros: Integer;
+begin
+ Result := '';
+
+ NrAnsiChars := 0;
+ NrWideZeros := 0;
+
+ // Dected as much string-contents as we can :
+ i := 0;
+ while i < MaxStrLen do
+ try
+ if Ptr[i] = #0 then
+ begin
+ // Zero's on odd position could indicate an UTF-16LE string :
+ if Odd(i) then
+ begin
+ Inc(NrWideZeros);
+ Inc(i);
+ continue;
+ end;
+
+ // The string ends on a #0 :
+ break;
+ end;
+
+ // It's no longer a string when it contains non-printable characters :
+ if not (Ptr[i] in PrintableChars) then
+ if Ptr[i-1] = #0 then
+ Break
+ else
+ Exit;
+
+ Inc(NrAnsiChars);
+ Inc(i);
+ except
+ // Save-guard against illegal memory-accesses :
+ Exit;
+ end;
+
+ // It's no string when it's too short :
+ if NrAnsiChars < MinStrLen then
+ Exit;
+
+ if Abs(NrAnsiChars - NrWideZeros) <= 1 then
+ Result := '"' + Copy(PWideChar(Ptr), 0, NrAnsiChars) + '"'
+ else
+ Result := '"' + UnicodeString(Copy(Ptr, 0, NrAnsiChars)) + '"';
+end;
+
+// Stupid Delphi has this hidden in the implementation section of SysUtils;
+// StrLenLimit: Scan Src for a null terminator up to MaxLen bytes
+function StrLenLimit(Src: PAnsiChar; MaxLen: Cardinal): Cardinal;
+begin
+ if Src = nil then
+ begin
+ Result := 0;
+ Exit;
+ end;
+ Result := MaxLen;
+ while (Src^ <> #0) and (Result > 0) do
+ begin
+ Inc(Src);
+ Dec(Result);
+ end;
+ Result := MaxLen - Result;
+end;
+
+function StrLPas(const aPChar: PAnsiChar; const aMaxLength: Integer): AnsiString;
+var
+ Len: Integer;
+begin
+ Len := StrLenLimit(aPChar, aMaxLength);
+ SetLength(Result, Len);
+ if Len > 0 then
+ Move(aPChar[0], Result[1], Len * SizeOf(AnsiChar));
+end;
+
+function iif(aTest: Boolean; const aTrue, aFalse: Integer): Integer; overload;
+begin
+ if aTest then
+ Result := aTrue
+ else
+ Result := aFalse;
+end;
+
+function iif(aTest: Boolean; const aTrue, aFalse: string): string; overload;
+begin
+ if aTest then
+ Result := aTrue
+ else
+ Result := aFalse;
+end;
+
+function PointerToString(const aPointer: Pointer): string;
+begin
+ Result := IntToHex(IntPtr(aPointer), SizeOf(IntPtr) * 2);
+end;
+
+function FloatToString(const aValue: float): string;
+begin
+ Result := FormatFloat('0.0', aValue); // TODO : Speed this up by avoiding Single>Extended cast & generic render code.
+end;
+
+function BOOL2String(const aValue: BOOL): string;
+begin
+ if aValue = BOOL_FALSE then
+ Result := 'FALSE'
+ else
+ Result := 'TRUE';
+end;
+
+function QuadPart(const aValue: PLARGE_INTEGER): Int64;
+begin
+ if Assigned(aValue) then
+ Result := aValue.QuadPart
+ else
+ Result := 0;
+end;
+
+function Log2(aValue: DWORD): DWORD;
+begin
+ Result := 1;
+ while aValue >= 2 do
+ begin
+ Inc(Result);
+ aValue := aValue div 2;
+ end;
+ Dec(Result);
+end;
+
+function SignedShr(const aValue: int; const aShift: int): int; register; // UNTESTED!
+asm
+ mov cl, [aShift]
+ sar eax, cl
+end;
+
+function DebugModeToString(const aDebugMode: TDebugMode): string;
+begin
+ case aDebugMode of
+ dmNone: Result := 'DM_NONE';
+ dmConsole: Result := 'DM_CONSOLE';
+ dmFile: Result := 'DM_FILE';
+ else
+ Result := '?Unknown?';
+ end;
+end;
+
+function IsValidHandle(const aHandle: LongWord): Boolean;
+begin
+ Result := (aHandle <> INVALID_HANDLE_VALUE);
+end;
+
+// (Safe)LoadLibrary returns 32 or greater on a succesfull call.
+// See http://support.microsoft.com/kb/142814 for details.
+function IsValidLibraryHandle(const aHandle: LongWord): Boolean;
+begin
+ Result := IsValidHandle(aHandle) and (aHandle >= 32);
+end;
+
+function GetLastErrorString: string;
+begin
+ Result := GetErrorString(GetLastError);
+end;
+
+function GetErrorString(const aError: DWord): string;
+begin
+ Result := SysErrorMessage(aError);
+ if Result = '' then
+ Result := 'No description for error #' + IntToStr(aError)
+ else
+ Result := Result + ' (#' + IntToStr(aError) + ')';
+end;
+
+// Note : This is a modified copy of TStringList.Find(), which is
+// the only binary search method in the entire Delphi RTL+VCL.
+function GenericBinarySearch(const List: Pointer; const Count: Integer; const SearchData: Pointer; const Compare: TGenericCompare; out Index: Integer): Boolean;
+var
+ L, H, I, C: Integer;
+begin
+ Result := False;
+ L := 0;
+ H := Count - 1;
+ while L <= H do
+ begin
+ I := (L + H) shr 1;
+ C := Compare(List, I, SearchData);
+ if C < 0 then
+ L := I + 1
+ else
+ begin
+ if C = 0 then
+ begin
+ Result := True;
+ L := I;
+ Break;
+ end;
+
+ H := I - 1;
+ end;
+ end;
+
+ {out}Index := L;
+end; // GenericBinarySearch
+
+{ TListHelper }
+
+function InternalListCompare(const List: TList; const Index: Integer; const SearchData: Pointer): Integer;
+begin
+ Result := IntPtr(List[Index]) - IntPtr(SearchData);
+end;
+
+type
+ PCompareList = ^RCompareList;
+ RCompareList = record
+ Compare: TListSortCompare;
+ List: TList;
+ end;
+
+function ExternalListCompare(const State: PCompareList; const Index: Integer; const SearchData: Pointer): Integer;
+begin
+ Result := State.Compare(State.List[Index], SearchData);
+end;
+
+function TListHelper.BinarySearch(const SearchData: Pointer; out Index: Integer; const Compare: TListSortCompare = nil): Boolean;
+var
+ State: RCompareList;
+begin
+ if @Compare = nil then
+ Result := GenericBinarySearch({List=}Self, Count, SearchData, @InternalListCompare, {out}Index)
+ else
+ begin
+ State.Compare := Compare;
+ State.List := Self;
+ Result := GenericBinarySearch({List=}@State, Count, SearchData, @ExternalListCompare, {out}Index);
+ end;
+end;
+
+{ TStreamHelper }
+
+procedure TStreamHelper.WriteString(const aString: AnsiString);
+begin
+ if Length(aString) > 0 then
+ Write(aString[1], Length(aString));
+end;
+
+procedure TStreamHelper.WriteString(const aString: string);
+begin
+ if Length(aString) > 0 then
+ Write(aString[1], Length(aString));
+end;
+
+{ TCustomMemoryStreamHelper }
+
+function TCustomMemoryStreamHelper.DataString: AnsiString;
+begin
+ SetLength(Result, Size);
+ Position := 0;
+ Read(Result[1], Size);
+end;
+
+{ TPreallocatedMemoryStream }
+
+constructor TPreallocatedMemoryStream.Create(const aAddress: Pointer; aSize: Integer);
+begin
+ inherited Create;
+
+ SetPointer(aAddress, aSize);
+end;
+
+function TPreallocatedMemoryStream.Write(const Buffer; Count: Integer): Longint;
+var
+ Pos: Longint;
+begin
+ if (Position >= 0) and (Count >= 0) then
+ begin
+ Pos := Position + Count;
+ if Pos > 0 then
+ begin
+ if Pos > Size then
+ begin
+ Pos := Size;
+ Count := Pos - Position;
+ end;
+ System.Move(Buffer, Pointer(Longint(Memory) + Position)^, Count);
+ Position := Pos;
+ Result := Count;
+ Exit;
+ end;
+ end;
+
+ Result := 0;
+end;
+
+{ RGB32Scanlines }
+
+procedure RGB32Scanlines.Initialize(const aBitmap: TBitmap);
+var
+ y: Integer;
+begin
+ Assert(Assigned(aBitmap) and (aBitmap.PixelFormat = pf32bit));
+
+ FWidth := aBitmap.Width;
+ SetLength(FScanLines, aBitmap.Height);
+ for y := 0 to aBitmap.Height - 1 do
+ FScanlines[y] := aBitmap.Scanline[y];
+end;
+
+function RGB32Scanlines.GetScanline(Row: Integer): PRGB32Array;
+begin
+ Result := FScanlines[Row];
+end;
+
+function RGB32Scanlines.GetPixel(Col, Row: Integer): PRGB32;
+begin
+ Result := @(FScanlines[Row][Col]);
+end;
+
+function RGB32Scanlines.GetHeight: Cardinal;
+begin
+ Result := Length(FScanlines);
+end;
+
+{ RGB16Scanlines }
+
+procedure RGB16Scanlines.Initialize(const aBitmap: TBitmap);
+var
+ y: Integer;
+begin
+ Assert(Assigned(aBitmap) and (aBitmap.PixelFormat = pf16bit));
+
+ FWidth := aBitmap.Width;
+ SetLength(FScanLines, aBitmap.Height);
+ for y := 0 to aBitmap.Height - 1 do
+ FScanlines[y] := aBitmap.Scanline[y];
+end;
+
+function RGB16Scanlines.GetScanline(Row: Integer): PRGB16Array;
+begin
+ Result := FScanlines[Row];
+end;
+
+function RGB16Scanlines.GetPixel(Col, Row: Integer): PRGB16;
+begin
+ Result := @(FScanlines[Row][Col]);
+end;
+
+function RGB16Scanlines.GetHeight: Cardinal;
+begin
+ Result := Length(FScanlines);
+end;
+
+// Unswizzle a texture. (Only works for 32bit, with power of 2 width and height.)
+// Code is loosly based on XBMC guilib\DirectXGraphics.cpp
+// Delphi translation and speed improvements by PatrickvL
+function ReadSwizzled16bitFormatIntoBitmap(
+ const aFormat: Byte;
+ const aData: PBytes;
+ const aDataSize: Cardinal;
+ const aOutput: PRGB16Scanlines): Boolean;
+
+ // Generic swizzle function, usable for both x and y dimensions.
+ // When passing x, Max should be 2*height, and Shift should be 0
+ // When passing y, Max should be width, and Shift should be 1
+ function _Swizzle(const Value, Max, Shift: Cardinal): Cardinal;
+ begin
+ if Value < Max then
+ Result := Value
+ else
+ Result := Value mod Max;
+
+ // The following is based on http://graphics.stanford.edu/~seander/bithacks.html#InterleaveBMN :
+ // --------------------------------11111111111111111111111111111111
+ Result := (Result or (Result shl 8)) and $00FF00FF; // 0000000000000000111111111111111100000000000000001111111111111111
+ Result := (Result or (Result shl 4)) and $0F0F0F0F; // 0000111100001111000011110000111100001111000011110000111100001111
+ Result := (Result or (Result shl 2)) and $33333333; // 0011001100110011001100110011001100110011001100110011001100110011
+ Result := (Result or (Result shl 1)) and $55555555; // 0101010101010101010101010101010101010101010101010101010101010101
+
+ Result := Result shl Shift; // y counts twice : 1010101010101010101010101010101010101010101010101010101010101010
+
+ if Value >= Max then
+ Inc(Result, (Value div Max) * Max * Max shr (1 - Shift)); // x halves this
+ end;
+
+var
+ height, width: Cardinal;
+ xswizzle: array of Cardinal;
+ x, y, sy: Cardinal;
+ yscanline: PRGB16Array;
+begin
+ // Sanity checks :
+ Result := (aFormat in [X_D3DFMT_R5G6B5])
+ and Assigned(aData)
+ and (aDataSize > 0)
+ and Assigned(aOutput)
+ and (aOutput.Height > 0)
+ and (aOutput.Width > 0);
+ if not Result then
+ Exit;
+
+ height := aOutput.Height;
+ width := aOutput.Width;
+
+ // Precalculate x-swizzle :
+ SetLength(xswizzle, width);
+ if width > 0 then // Dxbx addition, to prevent underflow
+ for x := 0 to width - 1 do
+ xswizzle[x] := _Swizzle(x, {Max=}(height * 2), {Shift=}0);
+
+ // Loop over all lines :
+ if height > 0 then // Dxbx addition, to prevent underflow
+ for y := 0 to height - 1 do
+ begin
+ // Calculate y-swizzle :
+ sy := _Swizzle(y, {Max=}width, {Shift=}1);
+
+ // Copy whole line in one go (using pre-calculated x-swizzle) :
+ yscanline := aOutput.Scanlines[y];
+ if width > 0 then // Dxbx addition, to prevent underflow
+ for x := 0 to width - 1 do
+ yscanline[x] := PRGB16Array(aData)[xswizzle[x] + sy];
+ end; // for y
+end; // ReadSwizzled16bitFormatIntoBitmap
+
+// Unswizzle a texture. (Only works for 32bit, with power of 2 width and height.)
+// Code is loosly based on XBMC guilib\DirectXGraphics.cpp
+// Delphi translation and speed improvements by PatrickvL
+function ReadSwizzledFormatIntoBitmap(
+ const aFormat: Byte;
+ const aData: PBytes;
+ const aDataSize: Cardinal;
+ const aOutput: PRGB32Scanlines): Boolean;
+
+ // Generic swizzle function, usable for both x and y dimensions.
+ // When passing x, Max should be 2*height, and Shift should be 0
+ // When passing y, Max should be width, and Shift should be 1
+ function _Swizzle(const Value, Max, Shift: Cardinal): Cardinal;
+ begin
+ if Value < Max then
+ Result := Value
+ else
+ Result := Value mod Max;
+
+ // The following is based on http://graphics.stanford.edu/~seander/bithacks.html#InterleaveBMN :
+ // --------------------------------11111111111111111111111111111111
+ Result := (Result or (Result shl 8)) and $00FF00FF; // 0000000000000000111111111111111100000000000000001111111111111111
+ Result := (Result or (Result shl 4)) and $0F0F0F0F; // 0000111100001111000011110000111100001111000011110000111100001111
+ Result := (Result or (Result shl 2)) and $33333333; // 0011001100110011001100110011001100110011001100110011001100110011
+ Result := (Result or (Result shl 1)) and $55555555; // 0101010101010101010101010101010101010101010101010101010101010101
+
+ Result := Result shl Shift; // y counts twice : 1010101010101010101010101010101010101010101010101010101010101010
+
+ if Value >= Max then
+ Inc(Result, (Value div Max) * Max * Max shr (1 - Shift)); // x halves this
+ end;
+
+var
+ height, width: Cardinal;
+ xswizzle: array of Cardinal;
+ x, y, sy: Cardinal;
+ yscanline: PRGB32Array;
+begin
+ // Sanity checks :
+ Result := (aFormat in [X_D3DFMT_A8R8G8B8,X_D3DFMT_X8R8G8B8])
+ and Assigned(aData)
+ and (aDataSize > 0)
+ and Assigned(aOutput)
+ and (aOutput.Height > 0)
+ and (aOutput.Width > 0);
+ if not Result then
+ Exit;
+
+ height := aOutput.Height;
+ width := aOutput.Width;
+
+ // Precalculate x-swizzle :
+ SetLength(xswizzle, width);
+ if width > 0 then // Dxbx addition, to prevent underflow
+ for x := 0 to width - 1 do
+ xswizzle[x] := _Swizzle(x, {Max=}(height * 2), {Shift=}0);
+
+ // Loop over all lines :
+ if height > 0 then // Dxbx addition, to prevent underflow
+ for y := 0 to height - 1 do
+ begin
+ // Calculate y-swizzle :
+ sy := _Swizzle(y, {Max=}width, {Shift=}1);
+
+ // Copy whole line in one go (using pre-calculated x-swizzle) :
+ yscanline := aOutput.Scanlines[y];
+ if width > 0 then // Dxbx addition, to prevent underflow
+ for x := 0 to width - 1 do
+ yscanline[x] := PRGB32Array(aData)[xswizzle[x] + sy];
+ end; // for y
+end; // ReadSwizzledFormatIntoBitmap
+
+// Official spec : http://www.opengl.org/registry/specs/EXT/texture_compression_s3tc.txt
+function ReadS3TCFormatIntoBitmap(
+ const aFormat: Byte;
+ const aData: PBytes;
+ const aDataSize: Cardinal;
+ const aOutput: PRGB32Scanlines): Boolean;
+var
+ color: array [0..3] of Word;
+ color32b: array [0..4] of TRGB32;
+ r, g, b, r1, g1, b1, pixelmap: DWord;
+ j, k, p, x, y: Cardinal;
+begin
+ // Sanity checks :
+ Result := (aFormat in [X_D3DFMT_DXT1, X_D3DFMT_DXT3, X_D3DFMT_DXT5])
+ and Assigned(aData)
+ and (aDataSize > 0)
+ and Assigned(aOutput)
+ and (aOutput.Height > 0)
+ and (aOutput.Width > 0);
+ if not Result then
+ Exit;
+
+ // Loop over all input data :
+ j := 0;
+ k := 0;
+ while j < aDataSize do
+ try
+ // Skip X_D3DFMT_DXT3 and X_D3DFMT_DXT5 alpha data for now :
+ if aFormat <> X_D3DFMT_DXT1 then
+ Inc(j, 8);
+
+ // Read two 16-bit pixels (let's call them A and B) :
+ color[0] := (aData[j + 0] shl 0)
+ + (aData[j + 1] shl 8);
+
+ color[1] := (aData[j + 2] shl 0)
+ + (aData[j + 3] shl 8);
+
+ // Read 5+6+5 bit color channels and convert them to 8+8+8 bit :
+ r := ((color[0] shr 11) and 31) * 255 div 31;
+ g := ((color[0] shr 5) and 63) * 255 div 63;
+ b := ((color[0] ) and 31) * 255 div 31;
+
+ r1 := ((color[1] shr 11) and 31) * 255 div 31;
+ g1 := ((color[1] shr 5) and 63) * 255 div 63;
+ b1 := ((color[1] ) and 31) * 255 div 31;
+
+ // Build first half of RGB32 color map :
+ color32b[0].R := r;
+ color32b[0].G := g;
+ color32b[0].B := b;
+
+ color32b[1].R := r1;
+ color32b[1].G := g1;
+ color32b[1].B := b1;
+
+ // Build second half of RGB32 color map :
+ if color[0] > color[1] then
+ begin
+ // Make up 2 new colors, 1/3 A + 2/3 B and 2/3 A + 1/3 B :
+ color32b[2].R := (r + r + r1 + 2) div 3;
+ color32b[2].G := (g + g + g1 + 2) div 3;
+ color32b[2].B := (b + b + b1 + 2) div 3;
+
+ color32b[3].R := (r + r1 + r1 + 2) div 3;
+ color32b[3].G := (g + g1 + g1 + 2) div 3;
+ color32b[3].B := (b + b1 + b1 + 2) div 3;
+ end
+ else
+ begin
+ // Make up one new color : 1/2 A + 1/2 B :
+ color32b[2].R := (r + r1) div 2;
+ color32b[2].G := (g + g1) div 2;
+ color32b[2].B := (b + b1) div 2;
+
+ color32b[3].R := 0;
+ color32b[3].G := 0;
+ color32b[3].B := 0;
+ end;
+
+ x := (k div 2) mod aOutput.Width;
+ y := (k div 2) div aOutput.Width * 4;
+
+ // Forza Motorsport needs this safety measure, as it has aDataSize=147456, while we need 16384 bytes :
+ if y >= aOutput.Height then
+ Break;
+
+ pixelmap := (aData[j + 4] shl 0)
+ + (aData[j + 5] shl 8)
+ + (aData[j + 6] shl 16)
+ + (aData[j + 7] shl 24);
+
+ for p := 0 to 16-1 do
+ begin
+ aOutput.Pixels[x + {xo=}(p and 3), y + {yo=}(p shr 2)]^ := color32b[pixelmap and 3];
+ pixelmap := pixelmap shr 2;
+ end;
+
+ Inc(j, 8);
+ Inc(k, 8); // Increase 4x4 pixel block offset
+ except
+ Exit; // ignore exception for now - has something to do with alpha-channel data being incorrectly skipped
+ end; // while
+end; // ReadS3TCFormatIntoBitmap
+
+function ReadD3DTextureFormatIntoBitmap(
+ const aFormat: Byte;
+ const aData: PBytes;
+ const aDataSize: Cardinal;
+ const aOutput: PRGB32Scanlines): Boolean;
+begin
+ case aFormat of
+ X_D3DFMT_DXT1,
+ //X_D3DFMT_DXT2,
+ X_D3DFMT_DXT3,
+ //X_D3DFMT_DXT4,
+ X_D3DFMT_DXT5:
+ // Read the compressed texture into the bitmap :
+ Result := ReadS3TCFormatIntoBitmap(aFormat, aData, aDataSize, aOutput);
+ X_D3DFMT_A8R8G8B8,
+ X_D3DFMT_X8R8G8B8:
+ // Read the swizzled texture into the bitmap :
+ Result := ReadSwizzledFormatIntoBitmap(aFormat, aData, aDataSize, aOutput);
+ else
+ Result := False;
+ end;
+end;
+
+function ReadD3D16bitTextureFormatIntoBitmap(
+ const aFormat: Byte;
+ const aData: PBytes;
+ const aDataSize: Cardinal;
+ const aOutput: PRGB16Scanlines): Boolean;
+begin
+ case aFormat of
+ X_D3DFMT_R5G6B5:
+ // Uncompressed texture :
+ Result := ReadSwizzled16bitFormatIntoBitmap(aFormat, aData, aDataSize, aOutput);
+ else
+ Result := False;
+ end;
+end;
+
+
+function GetDxbxBasePath: string;
+begin
+ SetLength(Result, MAX_PATH);
+ SHGetSpecialFolderPath(0, @(Result[1]), CSIDL_APPDATA, True);
+ SetLength(Result, StrLen(PChar(@Result[1])));
+ Result := Result + '\Dxbx';
+end;
+
+function SymbolCacheFolder: string;
+begin
+ Result := GetDxbxBasePath + '\SymbolCache\';
+end;
+
+function SortObjects(List: TStringList; Index1, Index2: Integer): Integer;
+begin
+ Result := IntPtr(List.Objects[Index1]) - IntPtr(List.Objects[Index2]);
+ if Result = 0 then
+ Result := StrComp(PChar(List.Strings[Index1]), PChar(List.Strings[Index2]));
+end;
+
+// Do our own demangling
+function DxbxUnmangleSymbolName(const aStr: string): string;
+var
+ UnmangleFlags: DWord;
+ i: Integer;
+begin
+ if aStr = '' then
+ Exit;
+
+ Result := aStr;
+
+ // Check if the symbol starts with an underscore ('_') or '@':
+ case Result[1] of
+ '?':
+ begin
+ // XP has no problem with those Flags, but Win7 have problems with these flags
+ UnmangleFlags := 0
+ // UNDNAME_COMPLETE // Enable full undecoration
+// or UNDNAME_NO_LEADING_UNDERSCORES // Remove leading underscores from MS extended keywords
+// or UNDNAME_NO_MS_KEYWORDS // Disable expansion of MS extended keywords
+// or UNDNAME_NO_FUNCTION_RETURNS // Disable expansion of return type for primary declaration
+// or UNDNAME_NO_ALLOCATION_MODEL // Disable expansion of the declaration model
+// or UNDNAME_NO_ALLOCATION_LANGUAGE // Disable expansion of the declaration language specifier
+// or UNDNAME_NO_MS_THISTYPE // NYI Disable expansion of MS keywords on the 'this' type for primary declaration
+// or UNDNAME_NO_CV_THISTYPE // NYI Disable expansion of CV modifiers on the 'this' type for primary declaration
+// or UNDNAME_NO_THISTYPE // Disable all modifiers on the 'this' type
+// or UNDNAME_NO_ACCESS_SPECIFIERS // Disable expansion of access specifiers for members
+// or UNDNAME_NO_THROW_SIGNATURES // Disable expansion of 'throw-signatures' for functions and pointers to functions
+// or UNDNAME_NO_MEMBER_TYPE // Disable expansion of 'static' or 'virtual'ness of members
+// or UNDNAME_NO_RETURN_UDT_MODEL // Disable expansion of MS model for UDT returns
+// or UNDNAME_32_BIT_DECODE // Undecorate 32-bit decorated names
+ or UNDNAME_NAME_ONLY // Crack only the name for primary declaration;
+// or UNDNAME_NO_ARGUMENTS // Don't undecorate arguments to function
+// or UNDNAME_NO_SPECIAL_SYMS // Don't undecorate special names (v-table, vcall, vector xxx, metatype, etc)
+ ;
+
+ // Do Microsoft symbol demangling :
+ if not UndecorateSymbolName(aStr, {var}Result, UnmangleFlags) then
+ Result := aStr;
+ end;
+ '_', '@':
+ begin
+ // Remove this leading character :
+ Delete(Result, 1, 1);
+ // Replace all following underscores with a dot ('.') :
+ Result := StringReplace(Result, '_', '.', [rfReplaceAll]);
+ end;
+ end;
+
+ // Remove everything from '@' onward :
+ i := Pos('@', Result);
+ if i > 1 then
+ Delete(Result, i, MaxInt);
+
+ // Replace '::' with '.' :
+ Result := StringReplace(Result, '::', '.', [rfReplaceAll]);
+end; // DxbxUnmangleSymbolName
+
+{ RVarArgsReader }
+
+constructor RVarArgsReader.Create(LastArg: Pointer; Size: Integer);
+begin
+ FArgPtr := IntPtr(LastArg);
+ // 32-bit x86 stack is generally 4-byte aligned
+ FArgPtr := Align(FArgPtr + Size, 4);
+end;
+
+class function RVarArgsReader.Align(Ptr: IntPtr; Align: Integer): IntPtr;
+begin
+ Result := (Ptr + Align - 1) and not (Align - 1);
+end;
+
+function RVarArgsReader.ReadInt32: Integer;
+begin
+ ReadArg(Result, SizeOf(Integer));
+end;
+
+function RVarArgsReader.ReadDouble: Double;
+begin
+ ReadArg(Result, SizeOf(Double));
+end;
+
+function RVarArgsReader.ReadExtended: Extended;
+begin
+ ReadArg(Result, SizeOf(Extended));
+end;
+
+function RVarArgsReader.ReadPAnsiChar: PAnsiChar;
+begin
+ ReadArg(Result, SizeOf(PAnsiChar));
+end;
+
+procedure RVarArgsReader.ReadArg(var Arg; Size: Integer);
+begin
+ Move(PByte(FArgPtr)^, Arg, Size);
+ FArgPtr := Align(FArgPtr + Size, 4);
+end;
+
+(*
+// Usage of RVarArgsReader :
+
+// Declare a function type with 'cdecl varargs' calling convention :
+type
+ PDump = procedure(const types: string) cdecl varargs;
+
+// Define a variable that points to that special function type,
+// and direct it to an actual implementation :
+var
+ MyDump: PDump = @Dump;
+
+// Implement the function without the 'varargs' directive,
+// and instead access the varargs with a 'RVarArgsReader' :
+procedure Dump(const types: string); cdecl;
+var
+ ap: RVarArgsReader;
+ cp: PChar;
+begin
+ cp := PChar(types);
+ ap := RVarArgsReader.Create(@types, SizeOf(string));
+ while True do
+ begin
+ case cp^ of
+ #0:
+ begin
+ Writeln;
+ Exit;
+ end;
+
+ 'i': Write(ap.ReadInt32, ' ');
+ 'd': Write(ap.ReadDouble, ' ');
+ 'e': Write(ap.ReadExtended, ' ');
+ 's': Write(ap.ReadPChar, ' ');
+ else
+ Writeln('Unknown format');
+ Exit;
+ end;
+ Inc(cp);
+ end;
+end;
+
+procedure ExampleVarArgCalls;
+
+ function AsDouble(e: Extended): Double;
+ begin
+ Result := e;
+ end;
+
+ function AsSingle(e: Extended): Single;
+ begin
+ Result := e;
+ end;
+
+begin
+ MyDump('iii', 10, 20, 30);
+ MyDump('sss', 'foo', 'bar', 'baz');
+
+ // Looks like Delphi passes Extended in byte-aligned
+ // stack offset, very strange; thus this doesn't work.
+ MyDump('e', 2.0);
+ // These two are more reliable.
+ MyDump('d', AsDouble(2));
+ // Singles passed as 8-byte floats.
+ MyDump('d', AsSingle(2));
+end;
+*)
+
+{ TDxbxBits }
+
+type
+ RBits_PrivateAccess = record
+ ClassType: TClass;
+ FSize: Integer;
+ FBits: PDWORDs; // Originally declared as Pointer, but used as PBitArray
+ end;
+ TBits_PrivateAccess = ^RBits_PrivateAccess;
+
+// TODO TDxbxBits : Split up our bit access in 3 stages; first handling the lead DWORD,
+// then all full DWORDs and finally the trailing DWORD, to prevent many per-bit loops.
+
+procedure TDxbxBits.ClearRange(aOffset, Range: Integer);
+begin
+ if aOffset + Range > Size then
+ Bits[Size+1]; // Triggers Error();
+
+ while Range > 0 do
+ begin
+ // Can we work with whole TBitSet's at a time?
+ if (Range >= BitsPerInt)
+ and (aOffset and (BitsPerInt - 1) = 0) then
+ begin
+ TBits_PrivateAccess(Self).FBits[aOffset shr BitsPerIntShift] := 0;
+ Dec(Range, BitsPerInt);
+ Inc(aOffset, BitsPerInt);
+ end
+ else
+ begin
+ Bits[aOffset] := False;
+ Dec(Range, 1);
+ Inc(aOffset, 1);
+ end;
+ end;
+end;
+
+procedure TDxbxBits.SetRange(aOffset, Range: Integer);
+begin
+ if aOffset + Range > Size then
+ Bits[Size+1]; // Triggers Error();
+
+ while Range > 0 do
+ begin
+ // Can we work with whole TBitSet's at a time?
+ if (Range >= BitsPerInt)
+ and (aOffset and (BitsPerInt - 1) = 0) then
+ begin
+ TBits_PrivateAccess(Self).FBits[aOffset shr BitsPerIntShift] := High(DWORD);
+ Dec(Range, BitsPerInt);
+ Inc(aOffset, BitsPerInt);
+ end
+ else
+ begin
+ Bits[aOffset] := True;
+ Dec(Range, 1);
+ Inc(aOffset, 1);
+ end;
+ end;
+end;
+
+function TDxbxBits.IsRangeClear(aOffset, Range: Integer): Boolean;
+begin
+ Result := False;
+ if aOffset + Range > Size then
+ Bits[Size+1]; // Triggers Error();
+
+ while Range > 0 do
+ begin
+ // Can we work with whole TBitSet's at a time?
+ if (Range >= BitsPerInt)
+ and (aOffset and (BitsPerInt - 1) = 0) then
+ begin
+ if TBits_PrivateAccess(Self).FBits[aOffset shr BitsPerIntShift] <> 0 then
+ Exit;
+
+ Dec(Range, BitsPerInt);
+ Inc(aOffset, BitsPerInt);
+ end
+ else
+ begin
+ if Bits[aOffset] then
+ Exit;
+
+ Dec(Range, 1);
+ Inc(aOffset, 1);
+ end;
+ end;
+
+ Result := True;
+end;
+
+initialization
+
+ DxbxGetTimerResultions;
+
+end.
+