diff --git a/Examples/AdvDemos/Archipelago/fArchipelagoC.h b/Examples/AdvDemos/Archipelago/fArchipelagoC.h index b9e213a1..2a5f6e62 100644 --- a/Examples/AdvDemos/Archipelago/fArchipelagoC.h +++ b/Examples/AdvDemos/Archipelago/fArchipelagoC.h @@ -45,7 +45,7 @@ #include "GLS.Keyboard.hpp" #include "GLS.Context.hpp" #include "GLS.State.hpp" -#include "GLS.TextureFormat.hpp" +#include "GLScene.TextureFormat.hpp" #include "GLS.File3DS.hpp" //--------------------------------------------------------------------------- diff --git a/Examples/AdvDemos/Archipelago/fArchipelagoD.pas b/Examples/AdvDemos/Archipelago/fArchipelagoD.pas index aa42df4e..652c9670 100644 --- a/Examples/AdvDemos/Archipelago/fArchipelagoD.pas +++ b/Examples/AdvDemos/Archipelago/fArchipelagoD.pas @@ -41,7 +41,7 @@ interface GLS.Keyboard, GLS.Context, GLS.State, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.File3DS, GLScene.Utils, GLS.Navigator; diff --git a/Examples/AdvDemos/Earth/fEarthD.pas b/Examples/AdvDemos/Earth/fEarthD.pas index 06bbec83..cc61ec08 100644 --- a/Examples/AdvDemos/Earth/fEarthD.pas +++ b/Examples/AdvDemos/Earth/fEarthD.pas @@ -36,7 +36,7 @@ interface GLS.State, GLScene.Utils, GLS.Context, - GLS.TextureFormat, + GLScene.TextureFormat, GLSL.TextureShaders, GLScene.BaseClasses, GLScene.PersistentClasses, diff --git a/Examples/AdvDemos/Forest/fForestD.pas b/Examples/AdvDemos/Forest/fForestD.pas index ed5979ab..65b65884 100644 --- a/Examples/AdvDemos/Forest/fForestD.pas +++ b/Examples/AdvDemos/Forest/fForestD.pas @@ -40,7 +40,7 @@ interface GLS.XOpenGL, GLScene.BaseClasses, GLS.TextureCombiners, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Material, GLScene.Coordinates, GLS.TerrainRenderer, diff --git a/Examples/AdvDemos/GLSViewer/Source/fGLSViewer.pas b/Examples/AdvDemos/GLSViewer/Source/fGLSViewer.pas index 62abe58e..b49406ad 100644 --- a/Examples/AdvDemos/GLSViewer/Source/fGLSViewer.pas +++ b/Examples/AdvDemos/GLSViewer/Source/fGLSViewer.pas @@ -50,7 +50,7 @@ interface GLScene.BaseClasses, GLS.State, GLS.RenderContextInfo, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Color, GLS.Keyboard, GLS.Graphics, diff --git a/Examples/AdvDemos/IntensityMesh/fIntensityMeshC.h b/Examples/AdvDemos/IntensityMesh/fIntensityMeshC.h index 7015403d..9e541c03 100644 --- a/Examples/AdvDemos/IntensityMesh/fIntensityMeshC.h +++ b/Examples/AdvDemos/IntensityMesh/fIntensityMeshC.h @@ -29,7 +29,7 @@ #include "GLS.RenderContextInfo.hpp" #include "GLS.Graphics.hpp" #include "GLS.State.hpp" -#include "GLS.TextureFormat.hpp" +#include "GLScene.TextureFormat.hpp" #include "GLSL.UserShader.hpp" //--------------------------------------------------------------------------- diff --git a/Examples/AdvDemos/IntensityMesh/fIntensityMeshD.pas b/Examples/AdvDemos/IntensityMesh/fIntensityMeshD.pas index f645679a..b8416f56 100644 --- a/Examples/AdvDemos/IntensityMesh/fIntensityMeshD.pas +++ b/Examples/AdvDemos/IntensityMesh/fIntensityMeshD.pas @@ -36,7 +36,7 @@ interface GLS.RenderContextInfo, GLS.Graphics, GLS.State, - GLS.TextureFormat; + GLScene.TextureFormat; type TFormIntensutyMesh = class(TForm) diff --git a/Examples/Demos/cgshaders/BumpMap/fBumpMapD.pas b/Examples/Demos/cgshaders/BumpMap/fBumpMapD.pas index 8abe9986..0f0de5d8 100644 --- a/Examples/Demos/cgshaders/BumpMap/fBumpMapD.pas +++ b/Examples/Demos/cgshaders/BumpMap/fBumpMapD.pas @@ -28,7 +28,7 @@ interface GLS.Material, GLScene.Coordinates, GLScene.BaseClasses, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.Utils, GLS.SimpleNavigation; diff --git a/Examples/Demos/cgshaders/DistTex/fDisttexD.pas b/Examples/Demos/cgshaders/DistTex/fDisttexD.pas index d119e236..8409d2a5 100644 --- a/Examples/Demos/cgshaders/DistTex/fDisttexD.pas +++ b/Examples/Demos/cgshaders/DistTex/fDisttexD.pas @@ -13,7 +13,7 @@ interface Vcl.ExtCtrls, Vcl.StdCtrls, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Cadencer, GLS.Texture, GLS.SceneViewer, diff --git a/Examples/Demos/computing/PostProcessing/fPostProcessingD.pas b/Examples/Demos/computing/PostProcessing/fPostProcessingD.pas index 2a801e4b..966f360e 100644 --- a/Examples/Demos/computing/PostProcessing/fPostProcessingD.pas +++ b/Examples/Demos/computing/PostProcessing/fPostProcessingD.pas @@ -14,7 +14,7 @@ interface Vcl.Dialogs, Vcl.ComCtrls, - GLS.TextureFormat + GLScene.TextureFormat GLS.Scene, GLScene.Coordinates, GLS.Objects, diff --git a/Examples/Demos/computing/SimpleCUDA/fSimpleTexD.pas b/Examples/Demos/computing/SimpleCUDA/fSimpleTexD.pas index b8d47652..77b1196b 100644 --- a/Examples/Demos/computing/SimpleCUDA/fSimpleTexD.pas +++ b/Examples/Demos/computing/SimpleCUDA/fSimpleTexD.pas @@ -23,7 +23,7 @@ interface CUDA.Utility, GLS.Graphics, - GLS.TextureFormat; + GLScene.TextureFormat; type TForm1 = class(TForm) diff --git a/Examples/Demos/glslshaders/FurShader/fFurShaderD.pas b/Examples/Demos/glslshaders/FurShader/fFurShaderD.pas index 166f92ad..a7a5903e 100644 --- a/Examples/Demos/glslshaders/FurShader/fFurShaderD.pas +++ b/Examples/Demos/glslshaders/FurShader/fFurShaderD.pas @@ -26,7 +26,7 @@ interface GLS.Context, GLS.FileOBJ, GLScene.VectorGeometry, - GLS.TextureFormat + GLScene.TextureFormat GLS.XOpenGL, GLS.Graphics, GLScene.BaseClasses, diff --git a/Examples/Demos/glslshaders/Ocean/fOceanC.h b/Examples/Demos/glslshaders/Ocean/fOceanC.h index 6cd3a335..3858eccf 100644 --- a/Examples/Demos/glslshaders/Ocean/fOceanC.h +++ b/Examples/Demos/glslshaders/Ocean/fOceanC.h @@ -20,7 +20,7 @@ #include "GLS.SkyDome.hpp" #include "GLSL.UserShader.hpp" #include "GLS.SceneViewer.hpp" -#include "GLS.TextureFormat.hpp" +#include "GLScene.TextureFormat.hpp" #include "GLS.Color.hpp" #include "GLScene.OpenGLTokens.hpp" #include "GLS.OpenGLAdapter.hpp" diff --git a/Examples/Demos/glslshaders/Ocean/fOceanD.pas b/Examples/Demos/glslshaders/Ocean/fOceanD.pas index bfc9967c..d948748c 100644 --- a/Examples/Demos/glslshaders/Ocean/fOceanD.pas +++ b/Examples/Demos/glslshaders/Ocean/fOceanD.pas @@ -35,7 +35,7 @@ interface GLScene.BaseClasses, GLS.RenderContextInfo, GLS.SimpleNavigation, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Color; type diff --git a/Examples/Demos/glslshaders/ShadersLab/fShaderLabD.pas b/Examples/Demos/glslshaders/ShadersLab/fShaderLabD.pas index eae809bc..244e94ed 100644 --- a/Examples/Demos/glslshaders/ShadersLab/fShaderLabD.pas +++ b/Examples/Demos/glslshaders/ShadersLab/fShaderLabD.pas @@ -41,7 +41,7 @@ interface GLS.State, GLS.RenderContextInfo, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Color, GLS.Graphics, GLS.MeshUtils, diff --git a/Examples/Demos/glslshaders/Shadertoy/fShadertoyD.pas b/Examples/Demos/glslshaders/Shadertoy/fShadertoyD.pas index 1ca0eb1d..05be1370 100644 --- a/Examples/Demos/glslshaders/Shadertoy/fShadertoyD.pas +++ b/Examples/Demos/glslshaders/Shadertoy/fShadertoyD.pas @@ -20,7 +20,7 @@ interface GLS.Keyboard, GLS.RenderContextInfo, GLS.OpenGLAdapter, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorGeometry, GLS.AsyncTimer, diff --git a/Examples/Demos/glslshaders/SkyboxShader/fSkyboxShaderD.pas b/Examples/Demos/glslshaders/SkyboxShader/fSkyboxShaderD.pas index 252ce9de..da5c39de 100644 --- a/Examples/Demos/glslshaders/SkyboxShader/fSkyboxShaderD.pas +++ b/Examples/Demos/glslshaders/SkyboxShader/fSkyboxShaderD.pas @@ -17,7 +17,7 @@ interface GLS.Objects, GLS.GeomObjects, GLS.Texture, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.CompositeImage, GLS.Material, GLScene.Coordinates, diff --git a/Examples/Demos/materials/TransparAdv/fTransparAdvD.pas b/Examples/Demos/materials/TransparAdv/fTransparAdvD.pas index 59db27f0..cc0973a2 100644 --- a/Examples/Demos/materials/TransparAdv/fTransparAdvD.pas +++ b/Examples/Demos/materials/TransparAdv/fTransparAdvD.pas @@ -13,7 +13,7 @@ interface Vcl.Dialogs, Vcl.Imaging.Jpeg, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorGeometry, GLScene.VectorTypes, GLS.Context, diff --git a/Examples/Demos/materials/fdMaterials.dfm b/Examples/Demos/materials/fdMaterials.dfm index 2a42ae91..e9f42fa4 100644 --- a/Examples/Demos/materials/fdMaterials.dfm +++ b/Examples/Demos/materials/fdMaterials.dfm @@ -7,7 +7,7 @@ object FormMaterials: TFormMaterials Margins.Bottom = 5 Caption = 'Materials' ClientHeight = 776 - ClientWidth = 1096 + ClientWidth = 1309 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText diff --git a/Examples/Demos/materials/proceduralclouds/fProcCloudsD.pas b/Examples/Demos/materials/proceduralclouds/fProcCloudsD.pas index 4ca20fe9..65ceaa26 100644 --- a/Examples/Demos/materials/proceduralclouds/fProcCloudsD.pas +++ b/Examples/Demos/materials/proceduralclouds/fProcCloudsD.pas @@ -24,7 +24,7 @@ interface GLS.Cadencer, GLS.SceneViewer, GLS.ProcTextures, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.Coordinates, GLScene.BaseClasses, diff --git a/Examples/Demos/materials/texformat/fTexFormatD.pas b/Examples/Demos/materials/texformat/fTexFormatD.pas index fc370296..2a555d8c 100644 --- a/Examples/Demos/materials/texformat/fTexFormatD.pas +++ b/Examples/Demos/materials/texformat/fTexFormatD.pas @@ -64,7 +64,7 @@ implementation {$R *.DFM} uses - GLS.TextureFormat, GLScene.Utils; + GLScene.TextureFormat, GLScene.Utils; procedure TFormTexFormat.FormCreate(Sender: TObject); var diff --git a/Examples/Demos/meshes/tiles/fTilesD.pas b/Examples/Demos/meshes/tiles/fTilesD.pas index 977b007b..9965c5ce 100644 --- a/Examples/Demos/meshes/tiles/fTilesD.pas +++ b/Examples/Demos/meshes/tiles/fTilesD.pas @@ -31,7 +31,7 @@ interface GLScene.Coordinates, GLScene.BaseClasses, GLS.RenderContextInfo, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Keyboard, GLScene.Utils, GLS.SimpleNavigation; diff --git a/Examples/Demos/rendering/Grass/fGrassD.pas b/Examples/Demos/rendering/Grass/fGrassD.pas index 3eadaef0..ede8ab52 100644 --- a/Examples/Demos/rendering/Grass/fGrassD.pas +++ b/Examples/Demos/rendering/Grass/fGrassD.pas @@ -32,7 +32,7 @@ interface GLS.Keyboard, GLScene.BaseClasses, GLS.RenderContextInfo, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.Utils ; diff --git a/Examples/Demos/specialsFX/ShadowFBO/fShadowFBOD.pas b/Examples/Demos/specialsFX/ShadowFBO/fShadowFBOD.pas index cbd1de28..a52bd245 100644 --- a/Examples/Demos/specialsFX/ShadowFBO/fShadowFBOD.pas +++ b/Examples/Demos/specialsFX/ShadowFBO/fShadowFBOD.pas @@ -16,7 +16,7 @@ interface Vcl.ExtCtrls, Vcl.Imaging.Jpeg, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Scene, GLScene.VectorTypes, GLS.Context, diff --git a/Examples/Demos/specialsFX/waterplane/fWaterPlaneD.pas b/Examples/Demos/specialsFX/waterplane/fWaterPlaneD.pas index 0f131770..9133a010 100644 --- a/Examples/Demos/specialsFX/waterplane/fWaterPlaneD.pas +++ b/Examples/Demos/specialsFX/waterplane/fWaterPlaneD.pas @@ -15,7 +15,7 @@ interface Vcl.Imaging.Jpeg, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Scene, GLS.Objects, diff --git a/Examples/Demos/utilities/GLInfos/fGLInfosD.pas b/Examples/Demos/utilities/GLInfos/fGLInfosD.pas index 8453ccf1..7be21ea4 100644 --- a/Examples/Demos/utilities/GLInfos/fGLInfosD.pas +++ b/Examples/Demos/utilities/GLInfos/fGLInfosD.pas @@ -19,7 +19,7 @@ interface GLScene.BaseClasses, GLS.Scene, GLS.SceneViewer, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.OpenGLAdapter, GLS.Context, GLS.Material, diff --git a/Packages/GLScene_RT.dpk b/Packages/GLScene_RT.dpk index 90958569..79b0704d 100644 --- a/Packages/GLScene_RT.dpk +++ b/Packages/GLScene_RT.dpk @@ -254,19 +254,21 @@ contains GLScene.Spline in '..\Source\GLScene.Spline.pas', GLScene.Strings in '..\Source\GLScene.Strings.pas', GLScene.RandomLib in '..\Source\GLScene.RandomLib.pas', - GLS.TextureFormat in '..\Source\GLS.TextureFormat.pas', + GLScene.TextureFormat in '..\Source\GLScene.TextureFormat.pas', GLScene.VectorLists in '..\Source\GLScene.VectorLists.pas', GLScene.VectorGeometry in '..\Source\GLScene.VectorGeometry.pas', GLScene.VectorTypes in '..\Source\GLScene.VectorTypes.pas', + GLScene.VectorTypesExt in '..\Source\GLScene.VectorTypesExt.pas', + GLScene.Utils in '..\Source\GLScene.Utils.pas', GLS.VectorFileObjects in '..\Source\GLS.VectorFileObjects.pas', GLS.VerletTypes in '..\Source\GLS.VerletTypes.pas', GLS.VerletClothify in '..\Source\GLS.VerletClothify.pas', - GLScene.VectorTypesExt in '..\Source\GLScene.VectorTypesExt.pas', PasDblStrUtils in '..\Source\PasDblStrUtils.pas', PasGLTF in '..\Source\PasGLTF.pas', PasJSON in '..\Source\PasJSON.pas', - GLScene.Utils in '..\Source\GLScene.Utils.pas', - GLS.OpenGLAdapter in '..\Source\GLS.OpenGLAdapter.pas'; + GLS.OpenGLAdapter in '..\Source\GLS.OpenGLAdapter.pas', + gnuGettext in '..\Source\gnuGettext.pas', + gnuGettextInit in '..\Source\gnuGettextInit.pas'; end. diff --git a/Packages/GLScene_RT.dproj b/Packages/GLScene_RT.dproj index c3bf6ad0..e1369072 100644 --- a/Packages/GLScene_RT.dproj +++ b/Packages/GLScene_RT.dproj @@ -379,19 +379,21 @@ - + + + - - + + Base diff --git a/Packages/GXScene_RT.dpk b/Packages/GXScene_RT.dpk index 510eeabf..bf4d5e46 100644 --- a/Packages/GXScene_RT.dpk +++ b/Packages/GXScene_RT.dpk @@ -37,26 +37,9 @@ requires fmx; contains - Formatx.m3DS in '..\SourceX\Formatx.m3DS.pas', - Formatx.m3DSConst in '..\SourceX\Formatx.m3DSConst.pas', - Formatx.m3DSTypes in '..\SourceX\Formatx.m3DSTypes.pas', - Formatx.m3DSUtils in '..\SourceX\Formatx.m3DSUtils.pas', - Formatx.B3D in '..\SourceX\Formatx.B3D.pas', - Formatx.MD2 in '..\SourceX\Formatx.MD2.pas', - Formatx.MD3 in '..\SourceX\Formatx.MD3.pas', - Formatx.DXTC in '..\SourceX\Formatx.DXTC.pas', - Formatx.GL2 in '..\SourceX\Formatx.GL2.pas', - Formatx.LWO in '..\SourceX\Formatx.LWO.pas', - Formatx.VFW in '..\SourceX\Formatx.VFW.pas', - Formatx.Q3BSP in '..\SourceX\Formatx.Q3BSP.pas', Formatx.DDSImage in '..\SourceX\Formatx.DDSImage.pas', Formatx.HDRImage in '..\SourceX\Formatx.HDRImage.pas', - Formatx.Q3MD3 in '..\SourceX\Formatx.Q3MD3.pas', - Formatx.OCT in '..\SourceX\Formatx.OCT.pas', - Formatx.X in '..\SourceX\Formatx.X.pas', Formatx.TGA in '..\SourceX\Formatx.TGA.pas', - Formatx.VRML in '..\SourceX\Formatx.VRML.pas', - Formatx.VfsPAK in '..\SourceX\Formatx.VfsPAK.pas', GXS.AnimatedSprite in '..\SourceX\GXS.AnimatedSprite.pas', GXS.ApplicationFileIO in '..\SourceX\GXS.ApplicationFileIO.pas', GXS.ArchiveManager in '..\SourceX\GXS.ArchiveManager.pas', @@ -254,7 +237,6 @@ contains GLScene.VectorTypesExt in '..\Source\GLScene.VectorTypesExt.pas', GLScene.VectorGeometry in '..\Source\GLScene.VectorGeometry.pas', GLScene.OpenGLTokens in '..\Source\GLScene.OpenGLTokens.pas', - GXS.TextureFormat in '..\Sourcex\GXS.TextureFormat.pas', GXS.OpenGLAdapter in '..\Sourcex\GXS.OpenGLAdapter.pas', GLScene.Logger in '..\Source\GLScene.Logger.pas', GLScene.Spline in '..\Source\GLScene.Spline.pas', @@ -269,6 +251,25 @@ contains GLScene.CurvesAndSurfaces in '..\Source\GLScene.CurvesAndSurfaces.pas', GLScene.Coordinates in '..\Source\GLScene.Coordinates.pas', GLScene.BaseClasses in '..\Source\GLScene.BaseClasses.pas', - GLScene.AnimationUtils in '..\Source\GLScene.AnimationUtils.pas'; + GLScene.AnimationUtils in '..\Source\GLScene.AnimationUtils.pas', + Formats.X in '..\Source\Formats.X.pas', + GLScene.TextureFormat in '..\Source\GLScene.TextureFormat.pas', + Formats.DXTC in '..\Source\Formats.DXTC.pas', + Formats.GL2 in '..\Source\Formats.GL2.pas', + Formats.m3DS in '..\Source\Formats.m3DS.pas', + Formats.m3DSConst in '..\Source\Formats.m3DSConst.pas', + Formats.m3DSTypes in '..\Source\Formats.m3DSTypes.pas', + Formats.m3DSUtils in '..\Source\Formats.m3DSUtils.pas', + Formats.MD2 in '..\Source\Formats.MD2.pas', + Formats.MD3 in '..\Source\Formats.MD3.pas', + Formats.OCT in '..\Source\Formats.OCT.pas', + Formats.Q3BSP in '..\Source\Formats.Q3BSP.pas', + Formats.VFW in '..\Source\Formats.VFW.pas', + Formats.VRML in '..\Source\Formats.VRML.pas', + Formatx.Q3MD3 in '..\Sourcex\Formatx.Q3MD3.pas', + Formats.B3D in '..\Source\Formats.B3D.pas', + Formats.LWO in '..\Source\Formats.LWO.pas', + gnuGettext in '..\Source\gnuGettext.pas', + gnuGettextInit in '..\Source\gnuGettextInit.pas'; end. diff --git a/Packages/GXScene_RT.dproj b/Packages/GXScene_RT.dproj index 7de0a755..dce4f183 100644 --- a/Packages/GXScene_RT.dproj +++ b/Packages/GXScene_RT.dproj @@ -186,26 +186,9 @@ - - - - - - - - - - - - - - - - - @@ -403,7 +386,6 @@ - @@ -419,6 +401,25 @@ + + + + + + + + + + + + + + + + + + + diff --git a/Source/FRTextureEdit.pas b/Source/FRTextureEdit.pas index 72ce6478..98c7f825 100644 --- a/Source/FRTextureEdit.pas +++ b/Source/FRTextureEdit.pas @@ -19,7 +19,7 @@ interface VCL.Buttons, VCL.Controls, GLS.Graphics, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Texture, GLS.State, GLS.TextureImageEditors; diff --git a/Source/FmShaderUniformEditor.pas b/Source/FmShaderUniformEditor.pas index b59c7791..ab624e23 100644 --- a/Source/FmShaderUniformEditor.pas +++ b/Source/FmShaderUniformEditor.pas @@ -22,7 +22,7 @@ interface VCL.Buttons, GLScene.Strings, GLSL.ShaderParameter, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorGeometry; type diff --git a/Source/Formats.DDSImage.pas b/Source/Formats.DDSImage.pas index 7d4a7897..63c02aeb 100644 --- a/Source/Formats.DDSImage.pas +++ b/Source/Formats.DDSImage.pas @@ -28,7 +28,7 @@ interface GLS.Graphics, GLS.Context, GLS.FileDDS, - GLS.TextureFormat; + GLScene.TextureFormat; type TDDSImage = class(TBitmap) diff --git a/Source/Formats.DXTC.pas b/Source/Formats.DXTC.pas index 4a7211e5..8d1afbf3 100644 --- a/Source/Formats.DXTC.pas +++ b/Source/Formats.DXTC.pas @@ -11,6 +11,7 @@ interface {.$I GLScene.Defines.inc} + {$Z4} // Minimum enum size = dword uses @@ -18,7 +19,7 @@ interface Winapi.OpenGLext, System.SysUtils, - GLS.TextureFormat; + GLScene.TextureFormat; const DDSD_CAPS = $00000001; diff --git a/Source/Formats.GL2.pas b/Source/Formats.GL2.pas index 1fc1cef3..af7c3c99 100644 --- a/Source/Formats.GL2.pas +++ b/Source/Formats.GL2.pas @@ -2,12 +2,10 @@ // The graphics engine GLScene https://github.com/glscene // unit Formats.GL2; - (* Ghoul2 (GLM/GLA) file format loading structures Note: Also referred to as MDX (MDXM/MDXA) format in C source. *) - interface uses @@ -122,9 +120,8 @@ function G2_GetVertBoneWeight(const vert: TGLMVertex; iWeightNum: Cardinal; procedure MC_UnCompressQuat(var mat: TGLMatrix; const comp: TGLACompQuatBone); -// ------------------------------------------------------------------ -implementation -// ------------------------------------------------------------------ + +implementation // ----------------------------------------------------------- // ------------------ // ------------------ Misc routines ------------------ diff --git a/Source/Formats.HDRImage.pas b/Source/Formats.HDRImage.pas index d53f734d..71567777 100644 --- a/Source/Formats.HDRImage.pas +++ b/Source/Formats.HDRImage.pas @@ -22,23 +22,18 @@ interface GLScene.VectorTypes, GLScene.OpenGLTokens, GLScene.VectorGeometry, - GLS.TextureFormat, - GLS.Graphics; + GLScene.TextureFormat, -type + GLS.FileHDR; +type THDRImage = class(TBitmap) public procedure LoadFromStream(stream: TStream); override; procedure SaveToStream(stream: TStream); override; end; - -//-------------------------------------------------------------------- -implementation -//-------------------------------------------------------------------- -uses - GLS.FileHDR; +implementation //------------------------------------------------------------ // ------------------ // ------------------ THDRImage ------------------ @@ -80,15 +75,11 @@ procedure THDRImage.SaveToStream(stream: TStream); Assert(False, 'Not supported'); end; -// ------------------------------------------------------------------ -initialization -// ------------------------------------------------------------------ +initialization // ------------------------------------------------------------ TPicture.RegisterFileFormat('HDR', 'High Dynamic Range Image', THDRImage); -// ------------------------------------------------------------------ -finalization -// ------------------------------------------------------------------ +finalization // -------------------------------------------------------------- TPicture.UnregisterGraphicClass(THDRImage); diff --git a/Source/Formats.LWO.pas b/Source/Formats.LWO.pas index bb64ca6a..42836ab5 100644 --- a/Source/Formats.LWO.pas +++ b/Source/Formats.LWO.pas @@ -2,8 +2,7 @@ // The graphics engine GLScene https://github.com/glscene // unit Formats.LWO; - -(* ============================================================= +(* This unit provides functions, constants and now classes for use in working with Lightwave3D Object files. @@ -811,9 +810,7 @@ procedure FindClipByClipIndex(AChunk: TLWChunk; AIndex: Pointer; function GetContentDir: TLWContentDir; -// -------------------------------------------------------------------- -implementation -// -------------------------------------------------------------------- +implementation // ------------------------------------------------------------ type PWord = ^Word; diff --git a/Source/Formats.MD2.pas b/Source/Formats.MD2.pas index acef1efa..1ff65966 100644 --- a/Source/Formats.MD2.pas +++ b/Source/Formats.MD2.pas @@ -99,9 +99,7 @@ TFileMD2 = class property VertexList: TGLVertexList read fVertexList; end; -// ------------------------------------------------------------------ -implementation -// ------------------------------------------------------------------ +implementation // ------------------------------------------------------------ // ------------------ // ------------------ TFileMD2 ------------------ @@ -189,4 +187,6 @@ procedure TFileMD2.LoadFromStream(aStream : TStream); end; end; +//--------------------------------------------------------------------------- + end. diff --git a/Source/Formats.MD3.pas b/Source/Formats.MD3.pas index 4d6eb310..62a39df5 100644 --- a/Source/Formats.MD3.pas +++ b/Source/Formats.MD3.pas @@ -8,13 +8,13 @@ interface uses - System.Classes, + System.Classes, GLScene.VectorTypes; type // Quake3 MD3 structure types TMD3Tag = record - strName: array[0..63] of AnsiChar; + strName: array [0 .. 63] of AnsiChar; vPosition: TVector3f; rotation: TMatrix3f; end; @@ -27,18 +27,17 @@ TMD3Frame = record local_origin : TVector3f; radius : single; name : array[0..15] of char; - end; + end; *) TMD3Bone = record - mins,maxs, - position: TVector3f; + mins, maxs, position: TVector3f; scale: single; - creator: array[0..15] of AnsiChar; + creator: array [0 .. 15] of AnsiChar; end; TMD3Triangle = record vertex: TVector3s; // value/64 to get real number position - normal: TVector2b; // Latitude,Longitude + normal: TVector2b; // Latitude,Longitude end; TMD3Face = record @@ -50,115 +49,104 @@ TMD3TexCoord = record end; TMD3Skin = record - strName : array[0..63] of AnsiChar; + strName: array [0 .. 63] of AnsiChar; shaderIndex: Integer; end; TMD3Header = record - fileID : array[0..3] of AnsiChar; - version : integer; - strFile : array[0..63] of AnsiChar; - flags, - numFrames, - numTags, - numMeshes, - numMaxSkins, - headerSize, - tagStart, - tagEnd, - fileSize : integer; + fileID: array [0 .. 3] of AnsiChar; + version: Integer; + strFile: array [0 .. 63] of AnsiChar; + flags, numFrames, numTags, numMeshes, numMaxSkins, headerSize, tagStart, + tagEnd, fileSize: Integer; end; TMD3MeshHeader = record - meshID : array[0..3] of AnsiChar; - strName : array[0..63] of AnsiChar; - flags, - numMeshFrames, - numSkins, - numVertices, - numTriangles, - triStart, - headerSize, - uvStart, - vertexStart, - meshSize : integer; + meshID: array [0 .. 3] of AnsiChar; + strName: array [0 .. 63] of AnsiChar; + flags, numMeshFrames, numSkins, numVertices, numTriangles, triStart, + headerSize, uvStart, vertexStart, meshSize: Integer; end; TMD3MeshData = record - MeshHeader : TMD3MeshHeader; - Skins : array of TMD3Skin; - Triangles : array of TMD3Face; - TexCoords : array of TMD3TexCoord; - Vertices : array of TMD3Triangle; + MeshHeader: TMD3MeshHeader; + Skins: array of TMD3Skin; + Triangles: array of TMD3Face; + TexCoords: array of TMD3TexCoord; + Vertices: array of TMD3Triangle; end; // MD3 Main file class TFileMD3 = class - public - ModelHeader: TMD3Header; - Bones : array of TMD3Bone; - Tags : array of TMD3Tag; - MeshData : array of TMD3MeshData; + public + ModelHeader: TMD3Header; + Bones: array of TMD3Bone; + Tags: array of TMD3Tag; + MeshData: array of TMD3MeshData; - procedure LoadFromStream(aStream : TStream); + procedure LoadFromStream(aStream: TStream); end; -// ------------------------------------------------------------------ -implementation -// ------------------------------------------------------------------ +implementation // ------------------------------------------------------------ // ------------------ // ------------------ TFileMD3 ------------------ // ------------------ -procedure TFileMD3.LoadFromStream(aStream : TStream); +procedure TFileMD3.LoadFromStream(aStream: TStream); var - i : Integer; - meshOffset : LongInt; + i: Integer; + meshOffset: LongInt; begin aStream.Read(ModelHeader, sizeof(ModelHeader)); // Test for correct file ID and version - Assert(ModelHeader.fileID='IDP3','Incorrect MD3 file ID'); - Assert(ModelHeader.version=15,'Incorrect MD3 version number'); + Assert(ModelHeader.fileID = 'IDP3', 'Incorrect MD3 file ID'); + Assert(ModelHeader.version = 15, 'Incorrect MD3 version number'); // Read in the bones - SetLength(Bones,ModelHeader.numFrames); - aStream.Read(Bones[0],sizeof(TMD3Bone)*ModelHeader.numFrames); + SetLength(Bones, ModelHeader.numFrames); + aStream.Read(Bones[0], sizeof(TMD3Bone) * ModelHeader.numFrames); // Read in the Tags - SetLength(Tags,ModelHeader.numFrames*ModelHeader.numTags); + SetLength(Tags, ModelHeader.numFrames * ModelHeader.numTags); if ModelHeader.numTags > 0 then - aStream.Read(Tags[0],sizeof(TMD3Tag)*ModelHeader.numFrames*ModelHeader.numTags); + aStream.Read(Tags[0], sizeof(TMD3Tag) * ModelHeader.numFrames * + ModelHeader.numTags); // Read in the Mesh data - meshOffset:=aStream.Position; - SetLength(MeshData,ModelHeader.numMeshes); - for i:=0 to ModelHeader.numMeshes-1 do begin - with MeshData[i] do begin - aStream.Position:=meshOffset; - aStream.Read(MeshHeader,sizeof(MeshHeader)); + meshOffset := aStream.position; + SetLength(MeshData, ModelHeader.numMeshes); + for i := 0 to ModelHeader.numMeshes - 1 do + begin + with MeshData[i] do + begin + aStream.position := meshOffset; + aStream.Read(MeshHeader, sizeof(MeshHeader)); // Set up the dynamic arrays - SetLength(Skins,MeshHeader.numSkins); - SetLength(Triangles,MeshHeader.numTriangles); - SetLength(TexCoords,MeshHeader.numVertices); - SetLength(Vertices,MeshHeader.numVertices*MeshHeader.numMeshFrames); + SetLength(Skins, MeshHeader.numSkins); + SetLength(Triangles, MeshHeader.numTriangles); + SetLength(TexCoords, MeshHeader.numVertices); + SetLength(Vertices, MeshHeader.numVertices * MeshHeader.numMeshFrames); // Skins - aStream.read(Skins[0],sizeof(TMD3Skin)*MeshHeader.numSkins); + aStream.Read(Skins[0], sizeof(TMD3Skin) * MeshHeader.numSkins); // Face data - aStream.Position:=meshOffset+MeshHeader.triStart; - aStream.read(Triangles[0],sizeof(TMD3Face)*MeshHeader.numTriangles); + aStream.position := meshOffset + MeshHeader.triStart; + aStream.Read(Triangles[0], sizeof(TMD3Face) * MeshHeader.numTriangles); // Texture coordinates - aStream.Position:=meshOffset+meshHeader.uvStart; - aStream.read(TexCoords[0],sizeof(TMD3TexCoord)*meshHeader.numVertices); + aStream.position := meshOffset + MeshHeader.uvStart; + aStream.Read(TexCoords[0], sizeof(TMD3TexCoord) * MeshHeader.numVertices); // Vertices - aStream.Position:=meshOffset+meshHeader.vertexStart; - aStream.read(Vertices[0],sizeof(TMD3Triangle)*MeshHeader.numMeshFrames*MeshHeader.numVertices); + aStream.position := meshOffset + MeshHeader.vertexStart; + aStream.Read(Vertices[0], sizeof(TMD3Triangle) * MeshHeader.numMeshFrames + * MeshHeader.numVertices); // Increase the offset - meshOffset:=meshOffset+MeshHeader.meshSize; + meshOffset := meshOffset + MeshHeader.meshSize; end; end; end; -end. \ No newline at end of file +// ------------------------------------------------------------------ + +end. diff --git a/Source/Formats.OCT.pas b/Source/Formats.OCT.pas index ccae4df2..187b100c 100644 --- a/Source/Formats.OCT.pas +++ b/Source/Formats.OCT.pas @@ -81,12 +81,7 @@ TOCTFile = class(TObject) lightIntensity: Integer); end; -// ------------------------------------------------------------------ -implementation -// ------------------------------------------------------------------ - -uses - GLS.MeshUtils; +implementation // ------------------------------------------------------------ // ------------------ // ------------------ TOCTFile ------------------ @@ -191,4 +186,6 @@ procedure TOCTFile.AddLight(const lightPos: TAffineVector; end; end; +//--------------------------------------------------------------------------- + end. diff --git a/Source/Formats.Q3BSP.pas b/Source/Formats.Q3BSP.pas index 04a69abe..e9651373 100644 --- a/Source/Formats.Q3BSP.pas +++ b/Source/Formats.Q3BSP.pas @@ -148,9 +148,7 @@ TQ3BSP = class(TObject) kVisData = 16; // Stores PVS and cluster info (visibility) kMaxLumps = 17; // A constant to store the number of lumps -// ------------------------------------------------------------------ -implementation -// ------------------------------------------------------------------ +implementation // ----------------------------------------------------------- // ------------------ // ------------------ TQ3BSP ------------------ diff --git a/Source/Formats.TGA.pas b/Source/Formats.TGA.pas index 6c183e63..003237f9 100644 --- a/Source/Formats.TGA.pas +++ b/Source/Formats.TGA.pas @@ -18,7 +18,7 @@ interface GLS.Context, GLS.Graphics, GLS.ApplicationFileIO, - GLS.TextureFormat; + GLScene.TextureFormat; type @@ -35,9 +35,7 @@ TGLTGAImage = class(TGLBaseImage) reintroduce; end; -//=============================================================== -implementation -//=============================================================== +implementation //-------------------------------------------------------------- type @@ -275,9 +273,7 @@ class function TGLTGAImage.Capabilities: TGLDataFileCapabilities; Result := [dfcRead {, dfcWrite}]; end; -//------------------------------------------- -initialization -//------------------------------------------- +initialization //-------------------------------------------------------------- RegisterRasterFormat('tga', 'TARGA Image File', TGLTGAImage); diff --git a/Source/Formats.VFW.pas b/Source/Formats.VFW.pas index 0b0a75f4..10baf618 100644 --- a/Source/Formats.VFW.pas +++ b/Source/Formats.VFW.pas @@ -2873,7 +2873,7 @@ function GetSaveFileNamePreviewW(lpofn: POPENFILENAMEW): BOOL; stdcall; function GetOpenFileNamePreview(lpofn: POPENFILENAMEA): BOOL; stdcall; // GetOpenFileNamePreviewA function GetSaveFileNamePreview(lpofn: POPENFILENAMEA): BOOL; stdcall; // GetSaveFileNamePreviewA -implementation +implementation //------------------------------------------------------------- function MKFOURCC( ch0, ch1, ch2, ch3: AnsiChar ): FOURCC; begin diff --git a/Source/Formats.VRML.pas b/Source/Formats.VRML.pas index 08e51aea..5dff8590 100644 --- a/Source/Formats.VRML.pas +++ b/Source/Formats.VRML.pas @@ -148,9 +148,7 @@ TVRMLParser = class write FAllowUnknownNodes; end; -// --------------------------------------------------------------------------- -implementation -// --------------------------------------------------------------------------- +implementation // ------------------------------------------------------------ function CreateVRMLTokenList(Text: String): TStringList; const diff --git a/Source/Formats.X.pas b/Source/Formats.X.pas index 20d59775..73d4fe7c 100644 --- a/Source/Formats.X.pas +++ b/Source/Formats.X.pas @@ -116,9 +116,7 @@ TDXFile = class end; -// ---------------------------------------------------------------------- -implementation -// ---------------------------------------------------------------------- +implementation // ------------------------------------------------------- // ---------------------------------------------------------------------- // Text parsing functions @@ -691,4 +689,6 @@ constructor TDXMaterial.CreateOwned(AOwner: TDXMaterialList); AOwner.Add(Self); end; +// ---------------------------------------------------------------------- + end. diff --git a/Source/Formats.m3DS.pas b/Source/Formats.m3DS.pas index 41206c2e..ffd85274 100644 --- a/Source/Formats.m3DS.pas +++ b/Source/Formats.m3DS.pas @@ -18,6 +18,7 @@ interface {$I GLScene.Defines.inc} + {$ALIGN ON} {$MINENUMSIZE 4} {$RANGECHECKS OFF} diff --git a/Source/GLS.BitmapFont.pas b/Source/GLS.BitmapFont.pas index 410889c9..66e3afec 100644 --- a/Source/GLS.BitmapFont.pas +++ b/Source/GLS.BitmapFont.pas @@ -18,7 +18,7 @@ interface Vcl.StdCtrls, GLScene.OpenGLTokens, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorTypes, GLScene.VectorGeometry, diff --git a/Source/GLS.Blur.pas b/Source/GLS.Blur.pas index 5835f117..47e47b77 100644 --- a/Source/GLS.Blur.pas +++ b/Source/GLS.Blur.pas @@ -19,7 +19,7 @@ interface GLScene.OpenGLTokens, GLScene.VectorTypes, GLScene.VectorGeometry, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.BaseClasses, GLS.Scene, diff --git a/Source/GLS.CUDA.Graphics.pas b/Source/GLS.CUDA.Graphics.pas index d3687afd..915530c1 100644 --- a/Source/GLS.CUDA.Graphics.pas +++ b/Source/GLS.CUDA.Graphics.pas @@ -24,7 +24,7 @@ interface GLS.Graphics, GLS.Material, GLScene.Strings, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Texture, GLSL.Shader, GLSL.ShaderParameter, diff --git a/Source/GLS.CgBombShader.pas b/Source/GLS.CgBombShader.pas index 752bbc86..1f18c88b 100644 --- a/Source/GLS.CgBombShader.pas +++ b/Source/GLS.CgBombShader.pas @@ -17,7 +17,7 @@ interface GLScene.Strings, GLS.Material, GLS.RenderContextInfo, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.State, Cg.GL, diff --git a/Source/GLS.CgPostTransformationShader.pas b/Source/GLS.CgPostTransformationShader.pas index a6bba0ce..e72bc576 100644 --- a/Source/GLS.CgPostTransformationShader.pas +++ b/Source/GLS.CgPostTransformationShader.pas @@ -20,7 +20,7 @@ interface GLS.Context, GLS.Scene, GLS.RenderContextInfo, - GLS.TextureFormat, + GLScene.TextureFormat, Cg.Import, Cg.GL, diff --git a/Source/GLS.CgShader.pas b/Source/GLS.CgShader.pas index 0f7fe0c1..22d686c0 100644 --- a/Source/GLS.CgShader.pas +++ b/Source/GLS.CgShader.pas @@ -23,7 +23,7 @@ interface GLScene.BaseClasses, GLS.RenderContextInfo, GLS.Material, - GLS.TextureFormat, + GLScene.TextureFormat, Cg.Import, Cg.GL; diff --git a/Source/GLS.CompositeImage.pas b/Source/GLS.CompositeImage.pas index 705ef5fe..fd2ebaee 100644 --- a/Source/GLS.CompositeImage.pas +++ b/Source/GLS.CompositeImage.pas @@ -17,7 +17,7 @@ interface GLScene.OpenGLTokens, GLS.Graphics, GLS.Texture, - GLS.TextureFormat; + GLScene.TextureFormat; type diff --git a/Source/GLS.Context.pas b/Source/GLS.Context.pas index 655cc09c..b169bb87 100644 --- a/Source/GLS.Context.pas +++ b/Source/GLS.Context.pas @@ -30,7 +30,7 @@ interface GLScene.Strings, GLScene.VectorTypes, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.OpenGLAdapter, GLS.PipelineTransformation, GLS.State, diff --git a/Source/GLS.DynamicTexture.pas b/Source/GLS.DynamicTexture.pas index ada6aa2e..6f9532b3 100644 --- a/Source/GLS.DynamicTexture.pas +++ b/Source/GLS.DynamicTexture.pas @@ -20,7 +20,7 @@ interface System.SysUtils, GLScene.OpenGLTokens, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.Utils, GLS.Context, GLS.Texture, diff --git a/Source/GLS.FBORenderer.pas b/Source/GLS.FBORenderer.pas index 438aa8cd..56ce96b1 100644 --- a/Source/GLS.FBORenderer.pas +++ b/Source/GLS.FBORenderer.pas @@ -16,7 +16,7 @@ interface System.SysUtils, GLScene.OpenGLTokens, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorTypes, GLScene.VectorGeometry, diff --git a/Source/GLS.FileB3D.pas b/Source/GLS.FileB3D.pas index 69321306..7a00575b 100644 --- a/Source/GLS.FileB3D.pas +++ b/Source/GLS.FileB3D.pas @@ -13,7 +13,7 @@ interface GLScene.VectorTypes, GLScene.VectorGeometry, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.VectorFileObjects, GLS.ApplicationFileIO, diff --git a/Source/GLS.FileBMP.pas b/Source/GLS.FileBMP.pas index 9cfa896c..b91a07fc 100644 --- a/Source/GLS.FileBMP.pas +++ b/Source/GLS.FileBMP.pas @@ -16,7 +16,7 @@ interface System.SysUtils, GLScene.OpenGLTokens, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Context, GLS.Graphics, @@ -54,9 +54,7 @@ TGLBMPImage = class(TGLBaseImage) const intFormat: TGLInternalFormat); reintroduce; end; -//======================================================== -implementation -//======================================================== +implementation //------------------------------------------------------------- const @@ -553,9 +551,7 @@ class function TGLBMPImage.Capabilities: TGLDataFileCapabilities; Result := [dfcRead (*, dfcWrite*)]; end; -//============================================================= -initialization -//============================================================= +initialization //------------------------------------------------------------- RegisterRasterFormat('bmp', 'Bitmap Image File', TGLBMPImage); diff --git a/Source/GLS.FileDDS.pas b/Source/GLS.FileDDS.pas index eb160701..2d017a5d 100644 --- a/Source/GLS.FileDDS.pas +++ b/Source/GLS.FileDDS.pas @@ -20,10 +20,10 @@ interface GLS.Graphics, GLS.Texture, GLScene.VectorGeometry, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.CompositeImage, GLS.MultiSampleImage, -// GLScene.RGBE, + GLScene.RGBE, GLS.ApplicationFileIO, GLS.Material, GLScene.Strings; @@ -48,7 +48,6 @@ TGLDDSImage = class(TGLBaseImage) const IntFormat: TGLInternalFormat); reintroduce; end; - // get or create material in material library function GetOrCreateLibMaterial(aMaterialLibrary: TGLMaterialLibrary; aMaterialName: string): TGLLibMaterial; @@ -77,9 +76,7 @@ function DDStex(aTextureEx: TGLTextureExItem; aDDSFileName: string; low - skipped the first two levels. *) vDDSDetailLevel: TGLDDSDetailLevels = ddsHighDet; -//---------------------------------------------------------------------- -implementation -//---------------------------------------------------------------------- +implementation //------------------------------------------------------------ uses Formats.DXTC; diff --git a/Source/GLS.FileHDR.pas b/Source/GLS.FileHDR.pas index 35a33809..d0dc6829 100644 --- a/Source/GLS.FileHDR.pas +++ b/Source/GLS.FileHDR.pas @@ -16,7 +16,7 @@ interface System.SysUtils, GLScene.OpenGLTokens, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.RGBE, GLScene.VectorTypes, GLScene.VectorGeometry, diff --git a/Source/GLS.FileJPEG.pas b/Source/GLS.FileJPEG.pas index 9658e003..86414bb8 100644 --- a/Source/GLS.FileJPEG.pas +++ b/Source/GLS.FileJPEG.pas @@ -20,7 +20,7 @@ interface GLScene.OpenGLTokens, GLS.Context, GLS.Graphics, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.ApplicationFileIO, GLScene.VectorGeometry; diff --git a/Source/GLS.FileLMTS.pas b/Source/GLS.FileLMTS.pas index 7dee22d0..b408f735 100644 --- a/Source/GLS.FileLMTS.pas +++ b/Source/GLS.FileLMTS.pas @@ -107,7 +107,7 @@ implementation //--------------------------------------------------- uses - GLS.TextureFormat; + GLScene.TextureFormat; // ------------------ // ------------------ TGLLMTSVectorFile ------------------ diff --git a/Source/GLS.FileOCT.pas b/Source/GLS.FileOCT.pas index 713d94fd..e98ebd53 100644 --- a/Source/GLS.FileOCT.pas +++ b/Source/GLS.FileOCT.pas @@ -21,7 +21,7 @@ interface GLS.Material, GLS.Graphics, GLS.State, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.VectorFileObjects, GLScene.VectorGeometry, GLS.ApplicationFileIO, diff --git a/Source/GLS.FilePGM.pas b/Source/GLS.FilePGM.pas index 0aeaf810..c06aad80 100644 --- a/Source/GLS.FilePGM.pas +++ b/Source/GLS.FilePGM.pas @@ -16,7 +16,7 @@ interface GLS.Context, GLS.Graphics, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.Strings, GLS.ApplicationFileIO, diff --git a/Source/GLS.FilePNG.pas b/Source/GLS.FilePNG.pas index 317825f8..26d3a19b 100644 --- a/Source/GLS.FilePNG.pas +++ b/Source/GLS.FilePNG.pas @@ -20,7 +20,7 @@ interface GLS.Context, GLS.Graphics, GLS.ApplicationFileIO, - GLS.TextureFormat; + GLScene.TextureFormat; type diff --git a/Source/GLS.FileQ3BSP.pas b/Source/GLS.FileQ3BSP.pas index da9fdc35..1a19ecac 100644 --- a/Source/GLS.FileQ3BSP.pas +++ b/Source/GLS.FileQ3BSP.pas @@ -30,7 +30,7 @@ interface GLS.State, GLScene.Utils, GLS.Material, - GLS.TextureFormat; + GLScene.TextureFormat; type diff --git a/Source/GLS.FileX.pas b/Source/GLS.FileX.pas index 0bbacd9f..60bea243 100644 --- a/Source/GLS.FileX.pas +++ b/Source/GLS.FileX.pas @@ -14,11 +14,12 @@ interface System.SysUtils, GLScene.VectorTypes, + GLScene.VectorLists, + GLScene.VectorGeometry, + GLS.VectorFileObjects, GLS.ApplicationFileIO, - GLScene.VectorGeometry, GLS.Texture, - GLScene.VectorLists, GLS.Material, Formats.X; @@ -30,9 +31,7 @@ TGLXVectorFile = class(TGLVectorFile) procedure LoadFromStream(aStream: TStream); override; end; -// ------------------------------------------------------------- -implementation -// ------------------------------------------------------------- +implementation // ------------------------------------------------------------- class function TGLXVectorFile.Capabilities: TGLDataFileCapabilities; begin @@ -151,10 +150,10 @@ procedure TGLXVectorFile.LoadFromStream(aStream: TStream); end; end; -//-------------------------------------------------------- -initialization -//-------------------------------------------------------- +initialization //-------------------------------------------------------- RegisterVectorFileFormat('x', 'DirectX Model files', TGLXVectorFile); +finalization //---------------------------------------------------------- + end. diff --git a/Source/GLS.FileZLIB.pas b/Source/GLS.FileZLIB.pas index a9a9a7a0..0552d6a4 100644 --- a/Source/GLS.FileZLIB.pas +++ b/Source/GLS.FileZLIB.pas @@ -329,10 +329,10 @@ procedure TZLibArchive.Extract(ContentName, NewName: string); Extract(FContentList.IndexOf(ContentName), NewName); end; -//----------------------------- -initialization -//----------------------------- +initialization //-------------------------------------------------------- + + RegisterArchiveFormat('zlib', 'Using the zlib compression algorithm', TZLibArchive); - RegisterArchiveFormat('zlib', 'GLScene file uses the zlib compression algorithm', TZLibArchive); +finalization //---------------------------------------------------------- end. diff --git a/Source/GLS.FireFX.pas b/Source/GLS.FireFX.pas index 594961e3..8fcf5fcb 100644 --- a/Source/GLS.FireFX.pas +++ b/Source/GLS.FireFX.pas @@ -30,7 +30,7 @@ interface GLScene.Manager, GLS.RenderContextInfo, GLS.State, - GLS.TextureFormat; + GLScene.TextureFormat; type PGLFireParticle = ^TGLFireParticle; diff --git a/Source/GLS.Graphics.pas b/Source/GLS.Graphics.pas index 6c59a06e..7a03f39f 100644 --- a/Source/GLS.Graphics.pas +++ b/Source/GLS.Graphics.pas @@ -30,7 +30,7 @@ interface GLScene.OpenGLTokens, GLScene.VectorTypes, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorGeometry, GLScene.Strings, diff --git a/Source/GLS.ImageUtils.pas b/Source/GLS.ImageUtils.pas index 6196d14f..b8a40b6a 100644 --- a/Source/GLS.ImageUtils.pas +++ b/Source/GLS.ImageUtils.pas @@ -33,7 +33,7 @@ interface GLScene.Strings, GLScene.VectorGeometry, GLScene.Utils, - GLS.TextureFormat; + GLScene.TextureFormat; var vImageScaleFilterWidth: Integer = 5; // Relative sample radius for filtering diff --git a/Source/GLS.Imposter.pas b/Source/GLS.Imposter.pas index 35bfceac..7f7d7c5f 100644 --- a/Source/GLS.Imposter.pas +++ b/Source/GLS.Imposter.pas @@ -30,7 +30,7 @@ interface GLScene.Coordinates, GLScene.BaseClasses, GLS.State, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.Utils; type diff --git a/Source/GLS.LensFlare.pas b/Source/GLS.LensFlare.pas index affe38d2..4966d04b 100644 --- a/Source/GLS.LensFlare.pas +++ b/Source/GLS.LensFlare.pas @@ -29,7 +29,7 @@ interface GLS.State, GLScene.VectorTypes, GLScene.Utils, - GLS.TextureFormat; + GLScene.TextureFormat; type diff --git a/Source/GLS.Material.pas b/Source/GLS.Material.pas index e89e848f..0def8f93 100644 --- a/Source/GLS.Material.pas +++ b/Source/GLS.Material.pas @@ -18,7 +18,7 @@ interface GLScene.OpenGLTokens, GLScene.VectorTypes, GLScene.VectorGeometry, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.Strings, GLS.RenderContextInfo, diff --git a/Source/GLS.MaterialEx.pas b/Source/GLS.MaterialEx.pas index 78283794..48231939 100644 --- a/Source/GLS.MaterialEx.pas +++ b/Source/GLS.MaterialEx.pas @@ -42,7 +42,7 @@ interface GLS.Graphics, GLScene.PersistentClasses, GLS.State, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.XCollection, GLS.TextureCombiners, GLSL.ShaderParameter, diff --git a/Source/GLS.MaterialScript.pas b/Source/GLS.MaterialScript.pas index dece954d..f68df14f 100644 --- a/Source/GLS.MaterialScript.pas +++ b/Source/GLS.MaterialScript.pas @@ -17,7 +17,7 @@ interface GLScene.VectorTypes, GLS.Texture, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Graphics, GLScene.Utils, GLS.Color, diff --git a/Source/GLS.MultiSampleImage.pas b/Source/GLS.MultiSampleImage.pas index f6e14c86..fbf5f9e6 100644 --- a/Source/GLS.MultiSampleImage.pas +++ b/Source/GLS.MultiSampleImage.pas @@ -21,7 +21,7 @@ interface GLScene.OpenGLTokens, GLScene.VectorTypes, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Context, GLS.Texture, GLS.Graphics; diff --git a/Source/GLS.Navigator.pas b/Source/GLS.Navigator.pas index c719784f..4ace9608 100644 --- a/Source/GLS.Navigator.pas +++ b/Source/GLS.Navigator.pas @@ -34,7 +34,7 @@ interface GLS.Screen, GLS.Material, GLS.Texture, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.RenderContextInfo; type diff --git a/Source/GLS.ParticleFX.pas b/Source/GLS.ParticleFX.pas index 8be689e3..01b3dbb4 100644 --- a/Source/GLS.ParticleFX.pas +++ b/Source/GLS.ParticleFX.pas @@ -41,7 +41,7 @@ interface GLScene.Coordinates, GLS.RenderContextInfo, GLScene.Manager, - GLS.TextureFormat; + GLScene.TextureFormat; const cPFXNbRegions = 128; // number of distance regions diff --git a/Source/GLS.Polyhedra.pas b/Source/GLS.Polyhedra.pas index 3b0c2630..da2d01be 100644 --- a/Source/GLS.Polyhedra.pas +++ b/Source/GLS.Polyhedra.pas @@ -26,7 +26,7 @@ interface GLScene.OpenGLTokens, GLScene.VectorTypes, GLScene.VectorTypesExt, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorGeometry, GLS.Scene, diff --git a/Source/GLS.ProcTextures.pas b/Source/GLS.ProcTextures.pas index 6f7a0580..b95fab5e 100644 --- a/Source/GLS.ProcTextures.pas +++ b/Source/GLS.ProcTextures.pas @@ -15,7 +15,7 @@ interface GLS.Texture, GLS.Graphics, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorGeometry; const diff --git a/Source/GLS.Scene.pas b/Source/GLS.Scene.pas index dcaa7912..9bef7066 100644 --- a/Source/GLS.Scene.pas +++ b/Source/GLS.Scene.pas @@ -43,7 +43,7 @@ interface GLScene.Coordinates, GLS.RenderContextInfo, GLS.Material, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Selection, GLScene.VectorTypes, GLS.ApplicationFileIO, diff --git a/Source/GLS.ShadowPlane.pas b/Source/GLS.ShadowPlane.pas index 770a4cc1..22bb666e 100644 --- a/Source/GLS.ShadowPlane.pas +++ b/Source/GLS.ShadowPlane.pas @@ -29,7 +29,7 @@ interface GLS.Color, GLS.RenderContextInfo, GLS.State, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Context, GLS.Material, GLS.Texture, diff --git a/Source/GLS.State.pas b/Source/GLS.State.pas index 34ad2639..a8e3022a 100644 --- a/Source/GLS.State.pas +++ b/Source/GLS.State.pas @@ -35,7 +35,7 @@ interface GLScene.OpenGLTokens, GLScene.VectorTypes, GLScene.VectorGeometry, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.Utils; const diff --git a/Source/GLS.Texture.pas b/Source/GLS.Texture.pas index 87a7db5d..bd792a94 100644 --- a/Source/GLS.Texture.pas +++ b/Source/GLS.Texture.pas @@ -31,7 +31,7 @@ interface GLScene.PersistentClasses, GLS.PipelineTransformation, GLS.ImageUtils, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.ApplicationFileIO, GLScene.Utils, GLScene.Strings; diff --git a/Source/GLS.ThorFX.pas b/Source/GLS.ThorFX.pas index 2dd1967d..7d5436a0 100644 --- a/Source/GLS.ThorFX.pas +++ b/Source/GLS.ThorFX.pas @@ -31,7 +31,7 @@ interface GLS.PipelineTransformation, GLScene.Manager, GLS.State, - GLS.TextureFormat; + GLScene.TextureFormat; type PThorpoint = ^TThorpoint; diff --git a/Source/GLS.VectorFileObjects.pas b/Source/GLS.VectorFileObjects.pas index 4817a73e..f8302726 100644 --- a/Source/GLS.VectorFileObjects.pas +++ b/Source/GLS.VectorFileObjects.pas @@ -32,28 +32,31 @@ interface GLScene.OpenGLTokens, GLScene.VectorTypes, GLScene.VectorTypesExt, - GLS.TextureFormat, - + GLScene.TextureFormat, GLScene.VectorGeometry, - GLS.Scene, GLScene.VectorLists, GLScene.PersistentClasses, + GLScene.Coordinates, + GLScene.BaseClasses, + GLScene.GeometryBB, + GLScene.Utils, + + GLS.Scene, GLS.Silhouette, GLScene.Strings, GLS.Texture, GLS.Material, GLS.Mesh, - GLScene.Logger, GLS.Octree, - GLScene.GeometryBB, GLS.ApplicationFileIO, GLS.Context, GLS.Color, GLS.PipelineTransformation, GLS.Selection, - GLS.RenderContextInfo, - GLScene.Coordinates, - GLScene.BaseClasses; + GLS.XOpenGL, + GLS.MeshUtils, + GLS.State, + GLS.RenderContextInfo; type TGLMeshObjectList = class; @@ -1342,15 +1345,9 @@ procedure UnregisterVectorFileClass(AClass: TGLVectorFileClass); // Flag to avoid loading materials (useful for IDE Extentions or scene editors) vGLVectorFileObjectsEnableVBOByDefault: Boolean = True; -// ------------------------------------------------------------------ -implementation -// ------------------------------------------------------------------ +implementation // ------------------------------------------------------------ uses - GLS.XOpenGL, - GLS.MeshUtils, - GLS.State, - GLScene.Utils, GLS.BaseMeshSilhouette; var @@ -7532,9 +7529,7 @@ function TGLActor.isSwitchingAnimation: boolean; result := FTargetSmoothAnimation <> nil; end; -// ------------------------------------------------------------------ -initialization -// ------------------------------------------------------------------ +initialization // ------------------------------------------------------------ RegisterVectorFileFormat('glsm', 'GLScene Mesh', TGLSMVectorFile); @@ -7545,7 +7540,7 @@ initialization TFGVertexNormalTexIndexList, TGLAnimationControler, TFGIndexTexCoordList, TGLSkeletonCollider, TGLSkeletonColliderList]); -finalization +finalization // -------------------------------------------------------------- FreeAndNil(vVectorFileFormats); diff --git a/Source/GLS.zBuffer.pas b/Source/GLS.zBuffer.pas index 588a8d14..d3f203bc 100644 --- a/Source/GLS.zBuffer.pas +++ b/Source/GLS.zBuffer.pas @@ -34,7 +34,7 @@ interface GLScene.OpenGLTokens, GLScene.VectorGeometry, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorTypes, GLS.XOpenGL, diff --git a/Source/GLSL.BumpShaders.pas b/Source/GLSL.BumpShaders.pas index 6fe0c0d5..9bdfb690 100644 --- a/Source/GLSL.BumpShaders.pas +++ b/Source/GLSL.BumpShaders.pas @@ -44,7 +44,7 @@ interface GLS.Color, GLS.RenderContextInfo, GLS.State, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Texture, GLS.Scene, diff --git a/Source/GLSL.CustomShader.pas b/Source/GLSL.CustomShader.pas index cd87f582..c3480084 100644 --- a/Source/GLSL.CustomShader.pas +++ b/Source/GLSL.CustomShader.pas @@ -21,7 +21,7 @@ interface GLScene.VectorGeometry, GLScene.VectorTypes, GLScene.OpenGLTokens, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.Strings, GLS.Texture, diff --git a/Source/GLSL.LineShaders.pas b/Source/GLSL.LineShaders.pas index 168ec8eb..dfbae1df 100644 --- a/Source/GLSL.LineShaders.pas +++ b/Source/GLSL.LineShaders.pas @@ -120,7 +120,7 @@ implementation // ------------------------------------------------------------------ uses - GLS.TextureFormat; + GLScene.TextureFormat; // ------------------ // ------------------ TGLLineSettings ------------------ diff --git a/Source/GLSL.PostEffects.pas b/Source/GLSL.PostEffects.pas index 8074ffaa..202d4d10 100644 --- a/Source/GLSL.PostEffects.pas +++ b/Source/GLSL.PostEffects.pas @@ -27,7 +27,7 @@ interface GLScene.VectorGeometry, GLS.RenderContextInfo, GLS.Material, - GLS.TextureFormat; + GLScene.TextureFormat; type EGLPostShaderHolderException = class(Exception); diff --git a/Source/GLSL.PostShaders.pas b/Source/GLSL.PostShaders.pas index b7fd1d3a..0dfea18f 100644 --- a/Source/GLSL.PostShaders.pas +++ b/Source/GLSL.PostShaders.pas @@ -29,7 +29,7 @@ interface GLS.State, GLScene.VectorGeometry, GLS.RenderContextInfo, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Context, GLS.Material, GLSL.Shader, diff --git a/Source/GLSL.ProjectedTextures.pas b/Source/GLSL.ProjectedTextures.pas index 1075a674..0abd831f 100644 --- a/Source/GLSL.ProjectedTextures.pas +++ b/Source/GLSL.ProjectedTextures.pas @@ -35,7 +35,7 @@ interface GLS.Context, GLS.Color, GLS.RenderContextInfo, - GLS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorTypes; type diff --git a/Source/GLSL.Shader.pas b/Source/GLSL.Shader.pas index dcbf1587..3e177dce 100644 --- a/Source/GLSL.Shader.pas +++ b/Source/GLSL.Shader.pas @@ -22,7 +22,7 @@ interface GLS.Context, GLSL.CustomShader, GLS.RenderContextInfo, - GLS.TextureFormat, + GLScene.TextureFormat, GLSL.ShaderParameter, GLS.Material, GLS.State; diff --git a/Source/GLSL.ShaderParameter.pas b/Source/GLSL.ShaderParameter.pas index 0b9ddd80..e80e5351 100644 --- a/Source/GLSL.ShaderParameter.pas +++ b/Source/GLSL.ShaderParameter.pas @@ -18,7 +18,7 @@ interface GLScene.Strings, GLScene.OpenGLTokens, GLScene.VectorTypes, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.RenderContextInfo; type diff --git a/Source/GLSL.ShapeShaders.pas b/Source/GLSL.ShapeShaders.pas index 3a5f374a..35c25846 100644 --- a/Source/GLSL.ShapeShaders.pas +++ b/Source/GLSL.ShapeShaders.pas @@ -29,7 +29,7 @@ interface GLScene.Coordinates, GLScene.VectorGeometry, GLScene.VectorTypes, - GLS.TextureFormat, + GLScene.TextureFormat, GLS.Color, GLS.Texture, GLS.Material, diff --git a/Source/GLS.TextureFormat.pas b/Source/GLScene.TextureFormat.pas similarity index 98% rename from Source/GLS.TextureFormat.pas rename to Source/GLScene.TextureFormat.pas index 6cf266dc..12329710 100644 --- a/Source/GLS.TextureFormat.pas +++ b/Source/GLScene.TextureFormat.pas @@ -1,7 +1,7 @@ // // The graphics engine GLScene https://github.com/glscene // -unit GLS.TextureFormat; +unit GLScene.TextureFormat; (* Texture formats and functions *) @@ -253,15 +253,9 @@ function EncodeGLTextureTarget(const glTarget: Cardinal): TGLTextureTarget; function IsTargetSupportMipmap(const TextureTarget: TGLTextureTarget): Boolean; overload; function IsTargetSupportMipmap(const glTarget: Cardinal): Boolean; overload; -//--------------------------------------------------------------------------- -implementation -//--------------------------------------------------------------------------- - -uses - GLS.Context; +implementation //------------------------------------------------------------- type - TFormatDesc = record IntFmt: Cardinal; ClrFmt: Cardinal; @@ -576,6 +570,8 @@ function IsTargetSupported(target: TglTextureTarget): Boolean; function IsTargetSupported(glTarget: Cardinal): Boolean; begin + Result := True; // All OpenGL versions! +(* case glTarget of GL_TEXTURE_1D: Result := GL.VERSION_1_1 or GL.EXT_texture_object; GL_TEXTURE_2D: Result := GL.VERSION_1_1 or GL.EXT_texture_object; @@ -600,105 +596,108 @@ function IsTargetSupported(glTarget: Cardinal): Boolean; // Assert(False, strErrorEx + strUnknownType); end; end; +*) end; function IsFormatSupported(intFormat: TGLInternalFormat): Boolean; begin + Result := True; // All OpenGL versions! +(* Result := false; if ((intFormat >= tfALPHA4) and (intFormat <= tfALPHA16)) or ((intFormat >= tfLUMINANCE4) and (intFormat <= tfR16G16B16A16)) then begin - Result := GL.VERSION_1_1; + // Result := GL.VERSION_1_1; EXIT; end; if ((intFormat >= tfDEPTH_COMPONENT16) and (intFormat <= tfDEPTH_COMPONENT32)) then begin - Result := GL.ARB_depth_texture; + // Result := GL.ARB_depth_texture; EXIT; end; if ((intFormat >= tfCOMPRESSED_RGB_S3TC_DXT1) and (intFormat <= tfCOMPRESSED_RGBA_S3TC_DXT5)) then begin - Result := GL.EXT_texture_compression_s3tc; + // Result := GL.EXT_texture_compression_s3tc; EXIT; end; if ((intFormat >= tfSIGNED_LUMINANCE8) and (intFormat <= tfDSDT8_MAG8_INTENSITY8)) then begin - Result := GL.NV_texture_shader; + // Result := GL.NV_texture_shader; EXIT; end; if ((intFormat = tfHILO8) or (intFormat = tfSIGNED_HILO8)) then begin - Result := GL.NV_texture_shader3; + // Result := GL.NV_texture_shader3; EXIT; end; if ((intFormat >= tfFLOAT_R16) and (intFormat <= tfFLOAT_RGBA32)) then begin - Result := GL.NV_float_buffer; + // Result := GL.NV_float_buffer; EXIT; end; if ((intFormat >= tfRGBA_FLOAT32) and (intFormat <= tfLUMINANCE_ALPHA_FLOAT16)) then begin - Result := GL.ARB_texture_float or GL.ATI_texture_float; + // Result := GL.ARB_texture_float or GL.ATI_texture_float; EXIT; end; if intFormat = tfDEPTH24_STENCIL8 then begin - Result := GL.EXT_packed_depth_stencil; + // Result := GL.EXT_packed_depth_stencil; EXIT; end; if ((intFormat = tfDEPTH_COMPONENT32F) or (intFormat = tfDEPTH32F_STENCIL8)) then begin - Result := GL.NV_depth_buffer_float; + // Result := GL.NV_depth_buffer_float; EXIT; end; if ((intFormat >= tfSRGB8) and (intFormat <= tfCOMPRESSED_SRGB_ALPHA_S3TC_DXT5)) then begin - Result := GL.EXT_texture_sRGB; + // Result := GL.EXT_texture_sRGB; EXIT; end; if intFormat = tfRGB9_E5 then begin - Result := GL.EXT_texture_shared_exponent; + // Result := GL.EXT_texture_shared_exponent; EXIT; end; if intFormat = tfR11F_G11F_B10F then begin - Result := GL.EXT_packed_float; + // Result := GL.EXT_packed_float; EXIT; end; if ((intFormat >= tfCOMPRESSED_LUMINANCE_LATC1) and (intFormat <= tfCOMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2)) then begin - Result := GL.EXT_texture_compression_latc; + // Result := GL.EXT_texture_compression_latc; EXIT; end; if intFormat = tfCOMPRESSED_LUMINANCE_ALPHA_3DC then begin - Result := GL.ATI_texture_compression_3dc; + // Result := GL.ATI_texture_compression_3dc; EXIT; end; if ((intFormat >= tfRGBA32UI) and (intFormat <= tfLUMINANCE_ALPHA8I)) then begin - Result := GL.EXT_texture_integer; + // Result := GL.EXT_texture_integer; EXIT; end; @@ -708,15 +707,16 @@ function IsFormatSupported(intFormat: TGLInternalFormat): Boolean; if ((intFormat >= tfCOMPRESSED_RED_RGTC1) and (intFormat <= tfCOMPRESSED_SIGNED_RG_RGTC2)) then begin - Result := GL.ARB_texture_compression_rgtc; + // Result := GL.ARB_texture_compression_rgtc; EXIT; end; if ((intFormat >= tfR8_SNORM) and (intFormat <= tfRGBA16_SNORM)) then begin - Result := GL.VERSION_3_1; + // Result := GL.VERSION_3_1; EXIT; end +*) end; function IsFloatFormat(intFormat: TglInternalFormat): boolean; diff --git a/Source/gnuGettext.pas b/Source/gnuGettext.pas new file mode 100644 index 00000000..79f45583 --- /dev/null +++ b/Source/gnuGettext.pas @@ -0,0 +1,3910 @@ +{ *------------------------------------------------------------------------------ + GNU gettext translation system for Delphi, Kylix, C++ Builder and others. + All parts of the translation system are kept in this unit. + + @author Lars B. Dybdahl and others + ------------------------------------------------------------------------------- } +unit gnugettext; +(* ************************************************************ *) +(* *) +(* (C) Copyright by Lars B. Dybdahl and others *) +(* E-mail: Lars@dybdahl.dk, phone +45 70201241 *) +(* *) +(* Contributors: Peter Thornqvist, Troy Wolbrink, *) +(* Frank Andreas de Groot, Igor Siticov, *) +(* Jacques Garcia Vazquez, Igor Gitman, *) +(* Arvid Winkelsdorf *) +(* *) +(* See http://dybdahl.dk/dxgettext/ for more information *) +(* *) +(* ************************************************************ *) + +// Changes J. Rathlev (kontakt(a)rathlev-home.de) +// see: JR - 2011-07-29 / 2012-09-10 +// All Delphi version related compiler switches removed - needs at least Delphi XE2 +// GetWindowsLanguage uses GetUserPreferredUILanguages (Sept. 2023) + +// Information about this file: +// $LastChangedDate: 2024-08-24 $ + +// Redistribution and use in source and binary forms, with or without +// modification, are permitted provided that the following conditions are met: +// +// The names of any contributor may not be used to endorse or promote +// products derived from this software without specific prior written permission. +// +// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +// SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +// CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +// OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +// OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +interface + +// If the conditional define DXGETTEXTDEBUG is defined, debugging log is activated. +// Use DefaultInstance.DebugLogToFile() to write the log to a file. +{ $define DXGETTEXTDEBUG } + +uses +{$IFDEF MSWINDOWS} + Winapi.Windows, +{$ELSE} + Libc, +{$IFDEF FPC} + CWString, +{$ENDIF} +{$ENDIF} + System.Classes, System.StrUtils, System.SysUtils, System.TypInfo; + +(* *************************************************************************** *) +(* *) +(* MAIN API *) +(* *) +(* *************************************************************************** *) + +type +{$IFNDEF UNICODE} + UnicodeString = WideString; + RawUtf8String = AnsiString; + RawByteString = AnsiString; +{$ELSE} + RawUtf8String = RawByteString; +{$ENDIF} + DomainString = string; + LanguageString = string; + ComponentNameString = string; + FilenameString = string; + MsgIdString = UnicodeString; + TranslatedUnicodeString = UnicodeString; + + // Main GNU gettext functions. See documentation for instructions on how to use them. +function _(const szMsgId: MsgIdString): TranslatedUnicodeString; +function gettext(const szMsgId: MsgIdString): TranslatedUnicodeString; +function gettext_NoExtract(const szMsgId: MsgIdString): TranslatedUnicodeString; +function gettext_NoOp(const szMsgId: MsgIdString): TranslatedUnicodeString; +function dgettext(const szDomain: DomainString; const szMsgId: MsgIdString) + : TranslatedUnicodeString; +function dgettext_NoExtract(const szDomain: DomainString; + const szMsgId: MsgIdString): TranslatedUnicodeString; +function dngettext(const szDomain: DomainString; + const singular, plural: MsgIdString; Number: longint) + : TranslatedUnicodeString; +function ngettext(const singular, plural: MsgIdString; Number: longint) + : TranslatedUnicodeString; +function ngettext_NoExtract(const singular, plural: MsgIdString; + Number: longint): TranslatedUnicodeString; +procedure textdomain(const szDomain: DomainString); +function getcurrenttextdomain: DomainString; +procedure bindtextdomain(const szDomain: DomainString; + const szDirectory: FilenameString); + +// Set language to use +procedure UseLanguage(LanguageCode: LanguageString); +function GetCurrentLanguage: LanguageString; + +// Translates a component (form, frame etc.) to the currently selected language. +// Put TranslateComponent(self) in the OnCreate event of all your forms. +// See the manual for documentation on these functions +type + TTranslator = procedure(obj: TObject) of object; + +procedure TP_Ignore(AnObject: TObject; const name: ComponentNameString); +procedure TP_IgnoreClass(IgnClass: TClass); +procedure TP_IgnoreClassProperty(IgnClass: TClass; + const propertyname: ComponentNameString); +procedure TP_GlobalIgnoreClass(IgnClass: TClass); +procedure TP_GlobalIgnoreClassProperty(IgnClass: TClass; + const propertyname: ComponentNameString); +procedure TP_GlobalHandleClass(HClass: TClass; Handler: TTranslator); +procedure TranslateComponent(AnObject: TComponent; + const textdomain: DomainString = ''); +procedure RetranslateComponent(AnObject: TComponent; + const textdomain: DomainString = ''); + +// Add more domains that resourcestrings can be extracted from. If a translation +// is not found in the default domain, this domain will be searched, too. +// This is useful for adding mo files for certain runtime libraries and 3rd +// party component libraries +procedure AddDomainForResourceString(const domain: DomainString); +procedure RemoveDomainForResourceString(const domain: DomainString); +procedure AddDomains(const Domains: array of DomainString); + +// Add more domains that component strings can be extracted from. If a translation +// is not found in the default domain, this domain will be searched, too. +// This is useful when an application inherits components from a 3rd +// party component libraries +procedure AddDomainForComponent(const domain: DomainString); +procedure RemoveDomainForComponent(const domain: DomainString); + +// Unicode-enabled way to get resourcestrings, automatically translated +// Use like this: ws:=LoadResStringW(@NameOfResourceString); +function LoadResString(ResStringRec: PResStringRec): WideString; +function LoadResStringW(ResStringRec: PResStringRec): UnicodeString; + +// This returns an empty string if not translated or translator name is not specified. +function GetTranslatorNameAndEmail: TranslatedUnicodeString; + +(* *************************************************************************** *) +(* *) +(* ADVANCED FUNCTIONALITY *) +(* *) +(* *************************************************************************** *) + +const + DefaultTextDomain = 'default'; + +var + ExecutableFilename: FilenameString; + // This is set to paramstr(0) or the name of the DLL you are creating. + +const + PreferExternal = True; + // Set to true, to prefer external *.mo over embedded translation + UseMemoryMappedFiles = True; + // Set to False, to use the mo-file as independent copy in memory (you can update the file while it is in use) + ReReadMoFileOnSameLanguage = True; + // Set to True, to reread mo-file if the current language is selected again + +const + // Subversion source code version control version information + VCSVersion = '$LastChangedRevision: 220 $'; + +type + EGnuGettext = class(Exception); + EGGProgrammingError = class(EGnuGettext); + EGGComponentError = class(EGnuGettext); + EGGIOError = class(EGnuGettext); + EGGAnsi2WideConvError = class(EGnuGettext); + + // This function will turn resourcestring hooks on or off, eventually with BPL file support. + // Please do not activate BPL file support when the package is in design mode. +const + AutoCreateHooks = True; +procedure HookIntoResourceStrings(enabled: boolean = True; + SupportPackages: boolean = false); + +(* *************************************************************************** *) +(* *) +(* CLASS based implementation. *) +(* Use TGnuGettextInstance to have more than one language *) +(* in your application at the same time *) +(* *) +(* *************************************************************************** *) + +type + TOnDebugLine = Procedure(Sender: TObject; const Line: String; + var Discard: boolean) of Object; + // Set Discard to false if output should still go to ordinary debug log + TGetPluralForm = function(Number: longint): Integer; + TDebugLogger = procedure(Line: AnsiString) of object; + + { *------------------------------------------------------------------------------ + Handles .mo files, in separate files or inside the exe file. + Don't use this class. It's for internal use. + ------------------------------------------------------------------------------- } + TMoFile = class + /// Threadsafe. Only constructor and destructor are writing to memory + private + doswap: boolean; + public + Users: Integer; + /// Reference count. If it reaches zero, this object should be destroyed. + constructor Create(const filename: FilenameString; const Offset: int64; + Size: int64; const xUseMemoryMappedFiles: boolean); + destructor Destroy; override; + function gettext(const msgid: RawUtf8String; var found: boolean) + : RawUtf8String; // uses mo file and utf-8 + property isSwappedArchitecture: boolean read doswap; + private + N, O, T: Cardinal; + /// Values defined at http://www.linuxselfhelp.com/gnu/gettext/html_chapter/gettext_6.html + startindex, startstep: Integer; + FUseMemoryMappedFiles: boolean; + mo: THandle; + momapping: THandle; + momemoryHandle: PAnsiChar; + momemory: PAnsiChar; + function autoswap32(i: Cardinal): Cardinal; + function CardinalInMem(baseptr: PAnsiChar; Offset: Cardinal): Cardinal; + end; + + { *------------------------------------------------------------------------------ + Handles all issues regarding a specific domain. + Don't use this class. It's for internal use. + ------------------------------------------------------------------------------- } + TDomain = class + private + enabled: boolean; + vDirectory: FilenameString; + procedure setDirectory(const dir: FilenameString); + public + DebugLogger: TDebugLogger; + domain: DomainString; + property Directory: FilenameString read vDirectory write setDirectory; + constructor Create; + destructor Destroy; override; + // Set parameters + procedure SetLanguageCode(const langcode: LanguageString); + procedure SetFilename(const filename: FilenameString); + // Bind this domain to a specific file + // Get information + procedure GetListOfLanguages(list: TStrings); + function GetTranslationProperty(propertyname: ComponentNameString) + : TranslatedUnicodeString; + function gettext(const msgid: RawUtf8String): RawUtf8String; + // uses mo file and utf-8 + private + mofile: TMoFile; + SpecificFilename: FilenameString; + curlang: LanguageString; + OpenHasFailedBefore: boolean; + procedure OpenMoFile; + procedure CloseMoFile; + end; + + { *------------------------------------------------------------------------------ + Helper class for invoking events. + ------------------------------------------------------------------------------- } + TExecutable = class + procedure Execute; virtual; abstract; + end; + + { *------------------------------------------------------------------------------ + Interface to implement if you want to register as a language change listener + ------------------------------------------------------------------------------- } + IGnuGettextInstanceWhenNewLanguageListener = interface + procedure WhenNewLanguage(const LanguageID: LanguageString); + end; + + { *------------------------------------------------------------------------------ + The main translation engine. + ------------------------------------------------------------------------------- } + TGnuGettextInstance = class + private + fOnDebugLine: TOnDebugLine; + public + enabled: boolean; + /// Set this to false to disable translations + DesignTimeCodePage: Integer; + /// See MultiByteToWideChar() in Win32 API for documentation + constructor Create; + destructor Destroy; override; + procedure UseLanguage(LanguageCode: LanguageString); + procedure GetListOfLanguages(const domain: DomainString; list: TStrings); + // Puts list of language codes, for which there are translations in the specified domain, into list +{$IFNDEF UNICODE} + function gettext(const szMsgId: AnsiString): TranslatedUnicodeString; + overload; virtual; + function ngettext(const singular, plural: AnsiString; Number: longint) + : TranslatedUnicodeString; overload; virtual; +{$ENDIF} + function gettext(const szMsgId: MsgIdString): TranslatedUnicodeString; + overload; virtual; + function gettext_NoExtract(const szMsgId: MsgIdString) + : TranslatedUnicodeString; + function gettext_NoOp(const szMsgId: MsgIdString): TranslatedUnicodeString; + function ngettext(const singular, plural: MsgIdString; Number: longint) + : TranslatedUnicodeString; overload; virtual; + function ngettext_NoExtract(const singular, plural: MsgIdString; + Number: longint): TranslatedUnicodeString; + function GetCurrentLanguage: LanguageString; + function GetTranslationProperty(const propertyname: ComponentNameString) + : TranslatedUnicodeString; + function GetTranslatorNameAndEmail: TranslatedUnicodeString; + + // Form translation tools, these are not threadsafe. All TP_ procs must be called just before TranslateProperites() + procedure TP_Ignore(AnObject: TObject; const name: ComponentNameString); + procedure TP_IgnoreClass(IgnClass: TClass); + procedure TP_IgnoreClassProperty(IgnClass: TClass; + propertyname: ComponentNameString); + procedure TP_GlobalIgnoreClass(IgnClass: TClass); + procedure TP_GlobalIgnoreClassProperty(IgnClass: TClass; + propertyname: ComponentNameString); + procedure TP_GlobalHandleClass(HClass: TClass; Handler: TTranslator); + procedure TranslateProperties(AnObject: TObject; + textdomain: DomainString = ''); + procedure TranslateComponent(AnObject: TComponent; + const textdomain: DomainString = ''); + procedure RetranslateComponent(AnObject: TComponent; + const textdomain: DomainString = ''); + + // Multi-domain functions +{$IFNDEF UNICODE} + function dgettext(const szDomain: DomainString; const szMsgId: AnsiString) + : TranslatedUnicodeString; overload; virtual; + function dngettext(const szDomain: DomainString; + const singular, plural: AnsiString; Number: longint) + : TranslatedUnicodeString; overload; virtual; +{$ENDIF} + function dgettext(const szDomain: DomainString; const szMsgId: MsgIdString) + : TranslatedUnicodeString; overload; virtual; + function dgettext_NoExtract(const szDomain: DomainString; + const szMsgId: MsgIdString): TranslatedUnicodeString; + function dngettext(const szDomain: DomainString; + const singular, plural: MsgIdString; Number: longint) + : TranslatedUnicodeString; overload; virtual; + function dngettext_NoExtract(const szDomain: DomainString; + const singular, plural: MsgIdString; Number: longint) + : TranslatedUnicodeString; + procedure textdomain(const szDomain: DomainString); + function getcurrenttextdomain: DomainString; + procedure bindtextdomain(const szDomain: DomainString; + const szDirectory: FilenameString); + procedure bindtextdomainToFile(const szDomain: DomainString; + const filename: FilenameString); + // Also works with files embedded in exe file + + // Windows API functions + function LoadResString(ResStringRec: PResStringRec): UnicodeString; + + // Output all log info to this file. This may only be called once. + procedure DebugLogToFile(const filename: FilenameString; + append: boolean = false); + procedure DebugLogPause(PauseEnabled: boolean); + property OnDebugLine: TOnDebugLine read fOnDebugLine write fOnDebugLine; + // If set, all debug output goes here +{$IFNDEF UNICODE} + // Conversion according to design-time character set + function ansi2wideDTCP(const s: AnsiString): MsgIdString; + // Convert using Design Time Code Page +{$ENDIF} + procedure RegisterWhenNewLanguageListener + (Listener: IGnuGettextInstanceWhenNewLanguageListener); + procedure UnregisterWhenNewLanguageListener + (Listener: IGnuGettextInstanceWhenNewLanguageListener); + protected + procedure TranslateStrings(sl: TStrings; const textdomain: DomainString); + + // Override these three, if you want to inherited from this class + // to create a new class that handles other domain and language dependent + // issues + procedure WhenNewLanguage(const LanguageID: LanguageString); virtual; + // Override to know when language changes + procedure WhenNewDomain(const textdomain: DomainString); virtual; + // Override to know when text domain changes. Directory is purely informational + procedure WhenNewDomainDirectory(const textdomain: DomainString; + const Directory: FilenameString); virtual; + // Override to know when any text domain's directory changes. It won't be called if a domain is fixed to a specific file. + private + curlang: LanguageString; + curGetPluralForm: TGetPluralForm; + curmsgdomain: DomainString; + savefileCS: TMultiReadExclusiveWriteSynchronizer; + savefile: TextFile; + savememory: TStringList; + DefaultDomainDirectory: FilenameString; + domainlist: TStringList; + /// List of domain names. Objects are TDomain. + TP_IgnoreList: TStringList; + /// Temporary list, reset each time TranslateProperties is called + TP_ClassHandling: TList; + /// Items are TClassMode. If a is derived from b, a comes first + TP_GlobalClassHandling: TList; + /// Items are TClassMode. If a is derived from b, a comes first + TP_Retranslator: TExecutable; + /// Cast this to TTP_Retranslator + fWhenNewLanguageListeners: TInterfaceList; + /// List of all registered WhenNewLanguage listeners +{$IFDEF DXGETTEXTDEBUG} + DebugLogCS: TMultiReadExclusiveWriteSynchronizer; + DebugLog: TStream; + DebugLogOutputPaused: boolean; +{$ENDIF} + function TP_CreateRetranslator: TExecutable; // Must be freed by caller! + procedure FreeTP_ClassHandlingItems; +{$IFDEF DXGETTEXTDEBUG} + procedure DebugWriteln(Line: AnsiString); +{$ENDIF} + procedure TranslateProperty(AnObject: TObject; PropInfo: PPropInfo; + TodoList: TStrings; const textdomain: DomainString); + function Getdomain(const domain: DomainString; + const DefaultDomainDirectory: FilenameString; + const curlang: LanguageString): TDomain; + // Translates a single property of an object + end; + +var + DefaultInstance: TGnuGettextInstance; + /// Default instance of the main API for singlethreaded applications. + +implementation + +{$IFNDEF MSWINDOWS} +{$IFNDEF LINUX} + 'This version of gnugettext.pas is only meant to be compiled with Kylix 3,' + 'Delphi 6, Delphi 7 and later versions. If you use other versions, please' + 'get the gnugettext.pas version from the Delphi 5 directory.' +{$ENDIF} +{$ENDIF} +(* ************************************************************************ *) +// Some comments on the implementation: +// This unit should be independent of other units where possible. +// It should have a small footprint in any way. +(* ************************************************************************ *) +// TMultiReadExclusiveWriteSynchronizer is used instead of TCriticalSection +// because it makes this unit independent of the SyncObjs unit +(* ************************************************************************ *) + +{$B-,R+,I+,Q+} + type TTP_RetranslatorItem = class obj: TObject; +Propname: +ComponentNameString; +OldValue: +TranslatedUnicodeString; +end; +TTP_Retranslator = class(TExecutable)textdomain: DomainString; +Instance: +TGnuGettextInstance; + +constructor Create; + destructor Destroy; override; + procedure Remember(obj: TObject; Propname: ComponentNameString; + OldValue: TranslatedUnicodeString); + procedure Execute; override; + private + list: TList; + end; + TEmbeddedFileInfo = class Offset, Size: int64; + end; + TFileLocator = class + // This class finds files even when embedded inside executable + constructor Create; + destructor Destroy; + override; + function FindSignaturePos(const signature: RawByteString; + str: TFileStream): int64; + procedure Analyze; // List files embedded inside executable + function FileExists(filename: FilenameString): boolean; + function GetMoFile(filename: FilenameString; + DebugLogger: TDebugLogger): TMoFile; + procedure ReleaseMoFile(mofile: TMoFile); + private + basedirectory: FilenameString; + filelist: TStringList; + // Objects are TEmbeddedFileInfo. Filenames are relative to .exe file + MoFilesCS: TMultiReadExclusiveWriteSynchronizer; + MoFiles: TStringList; + // Objects are filenames+offset, objects are TMoFile + function ReadInt64(str: TStream): int64; + end; + TGnuGettextComponentMarker = class(TComponent)public LastLanguage + : LanguageString; + Retranslator: TExecutable; + destructor Destroy; + override; + end; + TClassMode = class HClass: TClass; + SpecialHandler: TTranslator; + PropertiesToIgnore: TStringList; // This is ignored if Handler is set + constructor Create; + destructor Destroy; + override; + end; + TRStrinfo = record strlength, stroffset: Cardinal; + end; + TStrInfoArr = array [0 .. 10000000] of TRStrinfo; + PStrInfoArr = ^TStrInfoArr; + TCharArray5 = array [0 .. 4] of ansichar; + THook = // Replaces a runtime library procedure with a custom procedure + class public constructor Create(OldProcedure, NewProcedure: pointer; + FollowJump: boolean = false); + destructor Destroy; + override; // Restores unhooked state + procedure Reset(FollowJump: boolean = false); + // Disables and picks up patch points again + procedure Disable; + procedure Enable; + private + oldproc, newproc: pointer; + Patch: TCharArray5; + Original: TCharArray5; + PatchPosition: PAnsiChar; + procedure Shutdown; + // Same as destroy, except that object is not destroyed + end; + + var + // System information + Win32PlatformIsUnicode: boolean = false; + + // Information about files embedded inside .exe file + FileLocator: TFileLocator; + + // Hooks into runtime library functions + ResourceStringDomainListCS: TMultiReadExclusiveWriteSynchronizer; + ResourceStringDomainList: TStringList; + ComponentDomainListCS: TMultiReadExclusiveWriteSynchronizer; + ComponentDomainList: TStringList; + HookLoadResString: THook; + HookLoadStr: THook; + HookFmtLoadStr: THook; + + function GGGetEnvironmentVariable(const name: WideString): WideString; + var + Len: Integer; + W: WideString; + begin + Result := ''; + SetLength(W, 1); + Len := GetEnvironmentVariableW(PWideChar(Name), PWideChar(W), 1); + if Len > 0 then + begin + SetLength(Result, Len - 1); + GetEnvironmentVariableW(PWideChar(Name), PWideChar(Result), Len); + end; + end; + + function StripCRRawMsgId(s: RawUtf8String): RawUtf8String; + var + i: Integer; + begin + i := 1; + while i <= length(s) do + begin + if s[i] = #13 then + delete(s, i, 1) + else + inc(i); + end; + Result := s; + end; + + function EnsureLineBreakInTranslatedString(s: RawUtf8String) + : RawUtf8String; +{$IFDEF MSWINDOWS} + var + i: Integer; +{$ENDIF} + begin +{$IFDEF MSWINDOWS} + Assert(sLinebreak = AnsiString(#13#10)); + i := 1; + while i <= length(s) do + begin + if (s[i] = #10) and (MidStr(s, i - 1, 1) <> #13) then + begin + insert(#13, s, i); + inc(i, 2); + end + else + inc(i); + end; +{$ENDIF} + Result := s; + end; + + function IsWriteProp(Info: PPropInfo): boolean; + begin + Result := Assigned(Info) and (Info^.SetProc <> nil); + end; + + function ResourceStringGettext(msgid: MsgIdString) + : TranslatedUnicodeString; + var + i: Integer; + begin + if (msgid = '') or (ResourceStringDomainListCS = nil) then + begin + // This only happens during very complicated program startups that fail, + // or when Msgid='' + Result := msgid; + exit; + end; + ResourceStringDomainListCS.BeginRead; + try + for i := 0 to ResourceStringDomainList.Count - 1 do + begin + Result := dgettext(ResourceStringDomainList.Strings[i], msgid); + if Result <> msgid then + break; + end; + finally + ResourceStringDomainListCS.EndRead; + end; + end; + + function ComponentGettext(msgid: MsgIdString; + Instance: TGnuGettextInstance = nil): TranslatedUnicodeString; + var + i: Integer; + begin + if (msgid = '') or (ComponentDomainListCS = nil) then + begin + // This only happens during very complicated program startups that fail, + // or when Msgid='' + Result := msgid; + exit; + end; + ComponentDomainListCS.BeginRead; + try + for i := 0 to ComponentDomainList.Count - 1 do + begin + if Assigned(Instance) then + Result := Instance.dgettext + (ComponentDomainList.Strings[i], msgid) + else + Result := dgettext(ComponentDomainList.Strings[i], msgid); + if Result <> msgid then + break; + end; + finally + ComponentDomainListCS.EndRead; + end; + end; + + function gettext(const szMsgId: MsgIdString): TranslatedUnicodeString; + begin + Result := DefaultInstance.gettext(szMsgId); + end; + + function gettext_NoExtract(const szMsgId: MsgIdString) + : TranslatedUnicodeString; + begin + // This one is very useful for translating text in variables. + // This can sometimes be necessary, and by using this function, + // the source code scanner will not trigger warnings. + Result := gettext(szMsgId); + end; + + function gettext_NoOp(const szMsgId: MsgIdString) + : TranslatedUnicodeString; + begin + // *** With this function Strings can be added to the po-file without beeing + // ResourceStrings (dxgettext will add the string and this function will + // return it without a change) + // see gettext manual + // 4.7 - Special Cases of Translatable Strings + // http://www.gnu.org/software/hello/manual/gettext/Special-cases.html#Special-cases + Result := DefaultInstance.gettext_NoOp(szMsgId); + end; + + { *------------------------------------------------------------------------------ + This is the main translation procedure used in programs. It takes a parameter, + looks it up in the translation dictionary, and returns the translation. + If no translation is found, the parameter is returned. + + @param szMsgId The text, that should be displayed if no translation is found. + ------------------------------------------------------------------------------- } + function _(const szMsgId: MsgIdString): TranslatedUnicodeString; + begin + Result := DefaultInstance.gettext(szMsgId); + end; + + { *------------------------------------------------------------------------------ + Translates a text, using a specified translation domain. + If no translation is found, the parameter is returned. + + @param szDomain Which translation domain that should be searched for a translation. + @param szMsgId The text, that should be displayed if no translation is found. + ------------------------------------------------------------------------------- } + function dgettext(const szDomain: DomainString; + const szMsgId: MsgIdString): TranslatedUnicodeString; + begin + Result := DefaultInstance.dgettext(szDomain, szMsgId); + end; + + function dgettext_NoExtract(const szDomain: DomainString; + const szMsgId: MsgIdString): TranslatedUnicodeString; + begin + // This one is very useful for translating text in variables. + // This can sometimes be necessary, and by using this function, + // the source code scanner will not trigger warnings. + Result := dgettext(szDomain, szMsgId); + end; + + function dngettext(const szDomain: DomainString; + const singular, plural: MsgIdString; Number: longint) + : TranslatedUnicodeString; + begin + Result := DefaultInstance.dngettext(szDomain, singular, + plural, Number); + end; + + function ngettext(const singular, plural: MsgIdString; Number: longint) + : TranslatedUnicodeString; + begin + Result := DefaultInstance.ngettext(singular, plural, Number); + end; + + function ngettext_NoExtract(const singular, plural: MsgIdString; + Number: longint): TranslatedUnicodeString; + begin + // This one is very useful for translating text in variables. + // This can sometimes be necessary, and by using this function, + // the source code scanner will not trigger warnings. + Result := ngettext(singular, plural, Number); + end; + + procedure textdomain(const szDomain: DomainString); + begin + DefaultInstance.textdomain(szDomain); + end; + + procedure SetGettextEnabled(enabled: boolean); + begin + DefaultInstance.enabled := enabled; + end; + + function getcurrenttextdomain: DomainString; + begin + Result := DefaultInstance.getcurrenttextdomain; + end; + + procedure bindtextdomain(const szDomain: DomainString; + const szDirectory: FilenameString); + begin + DefaultInstance.bindtextdomain(szDomain, szDirectory); + end; + + procedure TP_Ignore(AnObject: TObject; const name: FilenameString); + begin + DefaultInstance.TP_Ignore(AnObject, name); + end; + + procedure TP_GlobalIgnoreClass(IgnClass: TClass); + begin + DefaultInstance.TP_GlobalIgnoreClass(IgnClass); + end; + + procedure TP_IgnoreClass(IgnClass: TClass); + begin + DefaultInstance.TP_IgnoreClass(IgnClass); + end; + + procedure TP_IgnoreClassProperty(IgnClass: TClass; + const propertyname: ComponentNameString); + begin + DefaultInstance.TP_IgnoreClassProperty(IgnClass, propertyname); + end; + + procedure TP_GlobalIgnoreClassProperty(IgnClass: TClass; + const propertyname: ComponentNameString); + begin + DefaultInstance.TP_GlobalIgnoreClassProperty(IgnClass, propertyname); + end; + + procedure TP_GlobalHandleClass(HClass: TClass; Handler: TTranslator); + begin + DefaultInstance.TP_GlobalHandleClass(HClass, Handler); + end; + + procedure TranslateComponent(AnObject: TComponent; + const textdomain: DomainString = ''); + begin + DefaultInstance.TranslateComponent(AnObject, textdomain); + end; + + procedure RetranslateComponent(AnObject: TComponent; + const textdomain: DomainString = ''); + begin + DefaultInstance.RetranslateComponent(AnObject, textdomain); + end; + +{$IFDEF MSWINDOWS} + + // These constants are only used in Windows 95 + // Thanks to Frank Andreas de Groot for this table + const + IDAfrikaans = $0436; + IDAlbanian = $041C; + IDArabicAlgeria = $1401; + IDArabicBahrain = $3C01; + IDArabicEgypt = $0C01; + IDArabicIraq = $0801; + IDArabicJordan = $2C01; + IDArabicKuwait = $3401; + IDArabicLebanon = $3001; + IDArabicLibya = $1001; + IDArabicMorocco = $1801; + IDArabicOman = $2001; + IDArabicQatar = $4001; + IDArabic = $0401; + IDArabicSyria = $2801; + IDArabicTunisia = $1C01; + IDArabicUAE = $3801; + IDArabicYemen = $2401; + IDArmenian = $042B; + IDAssamese = $044D; + IDAzeriCyrillic = $082C; + IDAzeriLatin = $042C; + IDBasque = $042D; + IDByelorussian = $0423; + IDBengali = $0445; + IDBulgarian = $0402; + IDBurmese = $0455; + IDCatalan = $0403; + IDChineseHongKong = $0C04; + IDChineseMacao = $1404; + IDSimplifiedChinese = $0804; + IDChineseSingapore = $1004; + IDTraditionalChinese = $0404; + IDCroatian = $041A; + IDCzech = $0405; + IDDanish = $0406; + IDBelgianDutch = $0813; + IDDutch = $0413; + IDEnglishAUS = $0C09; + IDEnglishBelize = $2809; + IDEnglishCanadian = $1009; + IDEnglishCaribbean = $2409; + IDEnglishIreland = $1809; + IDEnglishJamaica = $2009; + IDEnglishNewZealand = $1409; + IDEnglishPhilippines = $3409; + IDEnglishSouthAfrica = $1C09; + IDEnglishTrinidad = $2C09; + IDEnglishUK = $0809; + IDEnglishUS = $0409; + IDEnglishZimbabwe = $3009; + IDEstonian = $0425; + IDFaeroese = $0438; + IDFarsi = $0429; + IDFinnish = $040B; + IDBelgianFrench = $080C; + IDFrenchCameroon = $2C0C; + IDFrenchCanadian = $0C0C; + IDFrenchCotedIvoire = $300C; + IDFrench = $040C; + IDFrenchLuxembourg = $140C; + IDFrenchMali = $340C; + IDFrenchMonaco = $180C; + IDFrenchReunion = $200C; + IDFrenchSenegal = $280C; + IDSwissFrench = $100C; + IDFrenchWestIndies = $1C0C; + IDFrenchZaire = $240C; + IDFrisianNetherlands = $0462; + IDGaelicIreland = $083C; + IDGaelicScotland = $043C; + IDGalician = $0456; + IDGeorgian = $0437; + IDGermanAustria = $0C07; + IDGerman = $0407; + IDGermanLiechtenstein = $1407; + IDGermanLuxembourg = $1007; + IDSwissGerman = $0807; + IDGreek = $0408; + IDGujarati = $0447; + IDHebrew = $040D; + IDHindi = $0439; + IDHungarian = $040E; + IDIcelandic = $040F; + IDIndonesian = $0421; + IDItalian = $0410; + IDSwissItalian = $0810; + IDJapanese = $0411; + IDKannada = $044B; + IDKashmiri = $0460; + IDKazakh = $043F; + IDKhmer = $0453; + IDKirghiz = $0440; + IDKonkani = $0457; + IDKorean = $0412; + IDLao = $0454; + IDLatvian = $0426; + IDLithuanian = $0427; + IDMacedonian = $042F; + IDMalaysian = $043E; + IDMalayBruneiDarussalam = $083E; + IDMalayalam = $044C; + IDMaltese = $043A; + IDManipuri = $0458; + IDMarathi = $044E; + IDMongolian = $0450; + IDNepali = $0461; + IDNorwegianBokmol = $0414; + IDNorwegianNynorsk = $0814; + IDOriya = $0448; + IDPolish = $0415; + IDBrazilianPortuguese = $0416; + IDPortuguese = $0816; + IDPunjabi = $0446; + IDRhaetoRomanic = $0417; + IDRomanianMoldova = $0818; + IDRomanian = $0418; + IDRussianMoldova = $0819; + IDRussian = $0419; + IDSamiLappish = $043B; + IDSanskrit = $044F; + IDSerbianCyrillic = $0C1A; + IDSerbianLatin = $081A; + IDSesotho = $0430; + IDSindhi = $0459; + IDSlovak = $041B; + IDSlovenian = $0424; + IDSorbian = $042E; + IDSpanishArgentina = $2C0A; + IDSpanishBolivia = $400A; + IDSpanishChile = $340A; + IDSpanishColombia = $240A; + IDSpanishCostaRica = $140A; + IDSpanishDominicanRepublic = $1C0A; + IDSpanishEcuador = $300A; + IDSpanishElSalvador = $440A; + IDSpanishGuatemala = $100A; + IDSpanishHonduras = $480A; + IDMexicanSpanish = $080A; + IDSpanishNicaragua = $4C0A; + IDSpanishPanama = $180A; + IDSpanishParaguay = $3C0A; + IDSpanishPeru = $280A; + IDSpanishPuertoRico = $500A; + IDSpanishModernSort = $0C0A; + IDSpanish = $040A; + IDSpanishUruguay = $380A; + IDSpanishVenezuela = $200A; + IDSutu = $0430; + IDSwahili = $0441; + IDSwedishFinland = $081D; + IDSwedish = $041D; + IDTajik = $0428; + IDTamil = $0449; + IDTatar = $0444; + IDTelugu = $044A; + IDThai = $041E; + IDTibetan = $0451; + IDTsonga = $0431; + IDTswana = $0432; + IDTurkish = $041F; + IDTurkmen = $0442; + IDUkrainian = $0422; + IDUrdu = $0420; + IDUzbekCyrillic = $0843; + IDUzbekLatin = $0443; + IDVenda = $0433; + IDVietnamese = $042A; + IDWelsh = $0452; + IDXhosa = $0434; + IDZulu = $0435; + + function GetWindowsLanguage: WideString; + var + langid, N, pc: Cardinal; + buf: array of Char; + langcode: WideString; + CountryName: array [0 .. 4] of widechar; + LanguageName: array [0 .. 4] of widechar; + works: boolean; + begin + if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 6) + then + begin + pc := 0; // Retrieve the UI language (not the localeinfo) JR - Sept. 2023 + works := GetUserPreferredUILanguages(MUI_LANGUAGE_NAME, @N, nil, + @pc); // available since Vista + if works then + begin + SetLength(buf, pc); + works := GetUserPreferredUILanguages(MUI_LANGUAGE_NAME, @N, + @buf[0], @pc); + if works then + langcode := ReplaceStr(PChar(@buf[0]), '-', '_'); + buf := nil; + end; + end + else + begin // XP and older + // The return value of GetLocaleInfo is compared with 3 = 2 characters and a zero + works := 3 = GetLocaleInfoW(LOCALE_USER_DEFAULT, + LOCALE_SISO639LANGNAME, LanguageName, SizeOf(LanguageName)); + works := works and + (3 = GetLocaleInfoW(LOCALE_USER_DEFAULT, LOCALE_SISO3166CTRYNAME, + CountryName, SizeOf(CountryName))); + if works then + begin + // Windows 98, Me, NT4, 2000, XP and newer + langcode := PWideChar(@(LanguageName[0])); + if lowercase(langcode) = 'no' then + langcode := 'nb'; + langcode := langcode + '_' + PWideChar(@CountryName[0]); + end; + end; + if not works then + begin + // This part should only happen on Windows 95. + langid := GetThreadLocale; + case langid of + IDBelgianDutch: + langcode := 'nl_BE'; + IDBelgianFrench: + langcode := 'fr_BE'; + IDBrazilianPortuguese: + langcode := 'pt_BR'; + IDDanish: + langcode := 'da_DK'; + IDDutch: + langcode := 'nl_NL'; + IDEnglishUK: + langcode := 'en_GB'; + IDEnglishUS: + langcode := 'en_US'; + IDFinnish: + langcode := 'fi_FI'; + IDFrench: + langcode := 'fr_FR'; + IDFrenchCanadian: + langcode := 'fr_CA'; + IDGerman: + langcode := 'de_DE'; + IDGermanLuxembourg: + langcode := 'de_LU'; + IDGreek: + langcode := 'el_GR'; + IDIcelandic: + langcode := 'is_IS'; + IDItalian: + langcode := 'it_IT'; + IDKorean: + langcode := 'ko_KO'; + IDNorwegianBokmol: + langcode := 'nb_NO'; + IDNorwegianNynorsk: + langcode := 'nn_NO'; + IDPolish: + langcode := 'pl_PL'; + IDPortuguese: + langcode := 'pt_PT'; + IDRussian: + langcode := 'ru_RU'; + IDSpanish, IDSpanishModernSort: + langcode := 'es_ES'; + IDSwedish: + langcode := 'sv_SE'; + IDSwedishFinland: + langcode := 'sv_FI'; + else + langcode := 'C'; + end; + end; + Result := langcode; + end; +{$ENDIF} +{$IFNDEF UNICODE} + function LoadResStringA(ResStringRec: PResStringRec): AnsiString; + begin + Result := DefaultInstance.LoadResString(ResStringRec); + end; +{$ENDIF} + function GetTranslatorNameAndEmail: TranslatedUnicodeString; + begin + Result := DefaultInstance.GetTranslatorNameAndEmail; + end; + + procedure UseLanguage(LanguageCode: LanguageString); + begin + DefaultInstance.UseLanguage(LanguageCode); + end; + + type + PStrData = ^TStrData; + + TStrData = record + Ident: Integer; + str: String; + end; + + function SysUtilsEnumStringModules(Instance: HINST; + Data: pointer): boolean; +{$IFDEF MSWINDOWS} + var + Buffer: array [0 .. 1023] of Char; + // WideChar in Delphi 2008, AnsiChar before that + begin + with PStrData(Data)^ do + begin + SetString(str, Buffer, LoadString(Instance, Ident, @Buffer[0], + SizeOf(Buffer))); + Result := str = ''; + end; + end; +{$ENDIF} +{$IFDEF LINUX} + + var + rs: TResStringRec; + Module: HModule; + begin + Module := Instance; + rs.Module := @Module; + with PStrData(Data)^ do + begin + rs.Identifier := Ident; + str := System.LoadResString(@rs); + Result := str = ''; + end; + end; +{$ENDIF} + function SysUtilsFindStringResource(Ident: NativeInt): string; + var + StrData: TStrData; + begin + StrData.Ident := Ident; + StrData.str := ''; + EnumResourceModules(SysUtilsEnumStringModules, @StrData); + Result := StrData.str; + end; + + function SysUtilsLoadStr(Ident: Integer): string; + begin +{$IFDEF DXGETTEXTDEBUG} + DefaultInstance.DebugWriteln('Sysutils.LoadRes(' + IntToStr(Ident) + + ') called'); +{$ENDIF} + Result := ResourceStringGettext(SysUtilsFindStringResource(Ident)); + end; + + function SysUtilsFmtLoadStr(Ident: Integer; + const Args: array of const): string; + begin +{$IFDEF DXGETTEXTDEBUG} + DefaultInstance.DebugWriteln('Sysutils.FmtLoadRes(' + IntToStr(Ident) + + ',Args) called'); +{$ENDIF} + FmtStr(Result, ResourceStringGettext(SysUtilsFindStringResource + (Ident)), Args); + end; + + function LoadResString(ResStringRec: PResStringRec): WideString; + begin + Result := DefaultInstance.LoadResString(ResStringRec); + end; + + function LoadResStringW(ResStringRec: PResStringRec): UnicodeString; + begin + Result := DefaultInstance.LoadResString(ResStringRec); + end; + + function GetCurrentLanguage: LanguageString; + begin + Result := DefaultInstance.GetCurrentLanguage; + end; + + { TDomain } + + procedure TDomain.CloseMoFile; + begin + if mofile <> nil then + begin + FileLocator.ReleaseMoFile(mofile); + mofile := nil; + end; + OpenHasFailedBefore := false; + end; + + destructor TDomain.Destroy; + begin + CloseMoFile; + inherited; + end; + +{$IFDEF mswindows} + function GetLastWinError: WideString; + var + errcode: Cardinal; + begin + SetLength(Result, 2000); + errcode := GetLastError(); + FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM, nil, errcode, 0, + PWideChar(Result), 2000, nil); + Result := PWideChar(Result); + end; +{$ENDIF} + procedure TDomain.OpenMoFile; + var + filename: FilenameString; + begin + // Check if it is already open + if mofile <> nil then + exit; + + // Check if it has been attempted to open the file before + if OpenHasFailedBefore then + exit; + + if SpecificFilename <> '' then + begin + filename := SpecificFilename; +{$IFDEF DXGETTEXTDEBUG} + DebugLogger('Domain ' + domain + ' is bound to specific file ' + + filename); +{$ENDIF} + end + else + begin + filename := Directory + curlang + PathDelim + 'LC_MESSAGES' + + PathDelim + domain + '.mo'; + if (not FileLocator.FileExists(filename)) and + (not FileExists(filename)) then + begin +{$IFDEF DXGETTEXTDEBUG} + DebugLogger('Domain ' + domain + + ': File does not exist, neither embedded or in file system: ' + + filename); +{$ENDIF} + filename := Directory + MidStr(curlang, 1, 2) + PathDelim + + 'LC_MESSAGES' + PathDelim + domain + '.mo'; +{$IFDEF DXGETTEXTDEBUG} + DebugLogger('Domain ' + domain + ' will attempt to use this file: ' + + filename); +{$ENDIF} + end + else + begin +{$IFDEF DXGETTEXTDEBUG} + if FileLocator.FileExists(filename) then + DebugLogger('Domain ' + domain + + ' will attempt to use this embedded file: ' + filename) + else + DebugLogger('Domain ' + domain + + ' will attempt to use this file that was found on the file system: ' + + filename); +{$ENDIF} + end; + end; + if (not FileLocator.FileExists(filename)) and (not FileExists(filename)) + then + begin +{$IFDEF DXGETTEXTDEBUG} + DebugLogger('Domain ' + domain + ' failed to locate the file: ' + + filename); +{$ENDIF} + OpenHasFailedBefore := True; + exit; + end; +{$IFDEF DXGETTEXTDEBUG} + DebugLogger('Domain ' + domain + ' now accesses the file.'); +{$ENDIF} + mofile := FileLocator.GetMoFile(filename, DebugLogger); + +{$IFDEF DXGETTEXTDEBUG} + if mofile.isSwappedArchitecture then + DebugLogger + ('.mo file is swapped (comes from another CPU architecture)'); +{$ENDIF} + // Check, that the contents of the file is utf-8 + if pos('CHARSET=UTF-8', + uppercase(GetTranslationProperty('Content-Type'))) = 0 then + begin + CloseMoFile; +{$IFDEF DXGETTEXTDEBUG} + DebugLogger('The translation for the language code ' + curlang + + ' (in ' + filename + + ') does not have charset=utf-8 in its Content-Type. Translations are turned off.'); +{$ENDIF} +{$IFDEF MSWINDOWS} + MessageBoxW(0, + PWideChar(WideString('The translation for the language code ' + + curlang + ' (in ' + filename + + ') does not have charset=utf-8 in its Content-Type. Translations are turned off.') + ), 'Localization problem', MB_OK); +{$ELSE} + writeln(stderr, 'The translation for the language code ' + curlang + + ' (in ' + filename + + ') does not have charset=utf-8 in its Content-Type. Translations are turned off.'); +{$ENDIF} + enabled := false; + end; + end; + +{$IFDEF UNICODE} + function utf8decode(s: RawByteString): UnicodeString; inline; + begin + Result := UTF8ToWideString(s); + end; +{$ENDIF} + function TDomain.GetTranslationProperty(propertyname: ComponentNameString) + : TranslatedUnicodeString; + var + sl: TStringList; + i: Integer; + s: string; + begin + propertyname := uppercase(propertyname) + ': '; + sl := TStringList.Create; + try + sl.Text := utf8decode(gettext('')); + for i := 0 to sl.Count - 1 do + begin + s := sl.Strings[i]; + if uppercase(MidStr(s, 1, length(propertyname))) = propertyname then + begin + Result := trim(MidStr(s, length(propertyname) + 1, maxint)); + +{$IFDEF DXGETTEXTDEBUG} + DebugLogger('GetTranslationProperty(' + propertyname + + ') returns ''' + Result + '''.'); +{$ENDIF} + exit; + end; + end; + finally + FreeAndNil(sl); + end; + Result := ''; +{$IFDEF DXGETTEXTDEBUG} + DebugLogger('GetTranslationProperty(' + propertyname + + ') did not find any value. An empty string is returned.'); +{$ENDIF} + end; + + procedure TDomain.setDirectory(const dir: FilenameString); + begin + vDirectory := IncludeTrailingPathDelimiter(dir); + SpecificFilename := ''; + CloseMoFile; + end; + + procedure AddDomainForResourceString(const domain: DomainString); + begin +{$IFDEF DXGETTEXTDEBUG} + DefaultInstance.DebugWriteln('Extra domain for resourcestring: ' + + domain); +{$ENDIF} + ResourceStringDomainListCS.BeginWrite; + try + if ResourceStringDomainList.IndexOf(domain) = -1 then + ResourceStringDomainList.Add(domain); + finally + ResourceStringDomainListCS.EndWrite; + end; + end; + + procedure RemoveDomainForResourceString(const domain: DomainString); + var + i: Integer; + begin +{$IFDEF DXGETTEXTDEBUG} + DefaultInstance.DebugWriteln('Remove domain for resourcestring: ' + + domain); +{$ENDIF} + ResourceStringDomainListCS.BeginWrite; + try + i := ResourceStringDomainList.IndexOf(domain); + if i <> -1 then + ResourceStringDomainList.delete(i); + finally + ResourceStringDomainListCS.EndWrite; + end; + end; + + procedure AddDomains(const Domains: array of DomainString); + var + i: Integer; + begin + for i := 0 to High(Domains) do + AddDomainForResourceString(Domains[i]); + end; + + procedure AddDomainForComponent(const domain: DomainString); + begin +{$IFDEF DXGETTEXTDEBUG} + DefaultInstance.DebugWriteln('Extra domain for component: ' + domain); +{$ENDIF} + ComponentDomainListCS.BeginWrite; + try + if ComponentDomainList.IndexOf(domain) = -1 then + ComponentDomainList.Add(domain); + finally + ComponentDomainListCS.EndWrite; + end; + end; + + procedure RemoveDomainForComponent(const domain: DomainString); + var + i: Integer; + begin +{$IFDEF DXGETTEXTDEBUG} + DefaultInstance.DebugWriteln('Remove domain for component: ' + domain); +{$ENDIF} + ComponentDomainListCS.BeginWrite; + try + i := ComponentDomainList.IndexOf(domain); + if i <> -1 then + ComponentDomainList.delete(i); + finally + ComponentDomainListCS.EndWrite; + end; + end; + + procedure TDomain.SetLanguageCode(const langcode: LanguageString); + begin + CloseMoFile; + curlang := langcode; + end; + + function GetPluralForm2EN(Number: Integer): Integer; + begin + Number := abs(Number); + if Number = 1 then + Result := 0 + else + Result := 1; + end; + + function GetPluralForm1(Number: Integer): Integer; + begin + Result := 0; + end; + + function GetPluralForm2FR(Number: Integer): Integer; + begin + Number := abs(Number); + if (Number = 1) or (Number = 0) then + Result := 0 + else + Result := 1; + end; + + function GetPluralForm3LV(Number: Integer): Integer; + begin + Number := abs(Number); + if (Number mod 10 = 1) and (Number mod 100 <> 11) then + Result := 0 + else if Number <> 0 then + Result := 1 + else + Result := 2; + end; + + function GetPluralForm3GA(Number: Integer): Integer; + begin + Number := abs(Number); + if Number = 1 then + Result := 0 + else if Number = 2 then + Result := 1 + else + Result := 2; + end; + + function GetPluralForm3LT(Number: Integer): Integer; + var + n1, n2: byte; + begin + Number := abs(Number); + n1 := Number mod 10; + n2 := Number mod 100; + if (n1 = 1) and (n2 <> 11) then + Result := 0 + else if (n1 >= 2) and ((n2 < 10) or (n2 >= 20)) then + Result := 1 + else + Result := 2; + end; + + function GetPluralForm3PL(Number: Integer): Integer; + var + n1, n2: byte; + begin + Number := abs(Number); + n1 := Number mod 10; + n2 := Number mod 100; + + if Number = 1 then + Result := 0 + else if (n1 >= 2) and (n1 <= 4) and ((n2 < 10) or (n2 >= 20)) then + Result := 1 + else + Result := 2; + end; + + function GetPluralForm3RU(Number: Integer): Integer; + var + n1, n2: byte; + begin + Number := abs(Number); + n1 := Number mod 10; + n2 := Number mod 100; + if (n1 = 1) and (n2 <> 11) then + Result := 0 + else if (n1 >= 2) and (n1 <= 4) and ((n2 < 10) or (n2 >= 20)) then + Result := 1 + else + Result := 2; + end; + + function GetPluralForm3SK(Number: Integer): Integer; + begin + Number := abs(Number); + if Number = 1 then + Result := 0 + else if (Number < 5) and (Number <> 0) then + Result := 1 + else + Result := 2; + end; + + function GetPluralForm4SL(Number: Integer): Integer; + var + n2: byte; + begin + Number := abs(Number); + n2 := Number mod 100; + if n2 = 1 then + Result := 0 + else if n2 = 2 then + Result := 1 + else if (n2 = 3) or (n2 = 4) then + Result := 2 + else + Result := 3; + end; + + procedure TDomain.GetListOfLanguages(list: TStrings); + var + sr: TSearchRec; + more: boolean; + filename, path: FilenameString; + langcode: LanguageString; + i, j: Integer; + begin + list.Clear; + + // Iterate through filesystem + more := FindFirst(Directory + '*', faAnyFile, sr) = 0; + try + while more do + begin + if (sr.Attr and faDirectory <> 0) and (sr.name <> '.') and + (sr.name <> '..') then + begin + filename := Directory + sr.name + PathDelim + 'LC_MESSAGES' + + PathDelim + domain + '.mo'; + if FileExists(filename) then + begin + langcode := lowercase(sr.name); + if list.IndexOf(langcode) = -1 then + list.Add(langcode); + end; + end; + more := FindNext(sr) = 0; + end; + finally + FindClose(sr); + end; + + // Iterate through embedded files + for i := 0 to FileLocator.filelist.Count - 1 do + begin + filename := FileLocator.basedirectory + + FileLocator.filelist.Strings[i]; + path := Directory; +{$IFDEF MSWINDOWS} + path := uppercase(path); + filename := uppercase(filename); +{$ENDIF} + j := length(path); + if MidStr(filename, 1, j) = path then + begin + path := PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo'; +{$IFDEF MSWINDOWS} + path := uppercase(path); +{$ENDIF} + if MidStr(filename, length(filename) - length(path) + 1, + length(path)) = path then + begin + langcode := + lowercase(MidStr(filename, j + 1, + length(filename) - length(path) - j)); + langcode := LeftStr(langcode, 3) + + uppercase(MidStr(langcode, 4, maxint)); + if list.IndexOf(langcode) = -1 then + list.Add(langcode); + end; + end; + end; + end; + + procedure TDomain.SetFilename(const filename: FilenameString); + begin + CloseMoFile; + vDirectory := ''; + SpecificFilename := filename; + end; + + function TDomain.gettext(const msgid: RawUtf8String): RawUtf8String; + var + found: boolean; + begin + if not enabled then + begin + Result := msgid; + exit; + end; + if (mofile = nil) and (not OpenHasFailedBefore) then + OpenMoFile; + if mofile = nil then + begin +{$IFDEF DXGETTEXTDEBUG} + DebugLogger('.mo file is not open. Not translating "' + msgid + '"'); +{$ENDIF} + Result := msgid; + end + else + begin + Result := mofile.gettext(msgid, found); +{$IFDEF DXGETTEXTDEBUG} + if found then + DebugLogger('Found in .mo (' + domain + '): "' + utf8encode(msgid) + + '"->"' + utf8encode(Result) + '"') + else + DebugLogger('Translation not found in .mo file (' + domain + ') : "' + + utf8encode(msgid) + '"'); +{$ENDIF} + end; + end; + + constructor TDomain.Create; + begin + inherited Create; + enabled := True; + end; + + { TGnuGettextInstance } + + procedure TGnuGettextInstance.bindtextdomain(const szDomain: DomainString; + const szDirectory: FilenameString); + var + dir: FilenameString; + begin + dir := IncludeTrailingPathDelimiter(szDirectory); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Text domain "' + szDomain + '" is now located at "' + + dir + '"'); +{$ENDIF} + Getdomain(szDomain, DefaultDomainDirectory, curlang).Directory := dir; + WhenNewDomainDirectory(szDomain, szDirectory); + end; + + constructor TGnuGettextInstance.Create; + begin +{$IFDEF MSWindows} + DesignTimeCodePage := CP_ACP; +{$ENDIF} +{$IFDEF DXGETTEXTDEBUG} + DebugLogCS := TMultiReadExclusiveWriteSynchronizer.Create; + DebugLog := TMemoryStream.Create; + DebugWriteln('Debug log started ' + DateTimeToStr(Now)); + DebugWriteln('GNU gettext module version: ' + VCSVersion); + DebugWriteln(''); +{$ENDIF} + curGetPluralForm := GetPluralForm2EN; + enabled := True; + curmsgdomain := DefaultTextDomain; + savefileCS := TMultiReadExclusiveWriteSynchronizer.Create; + domainlist := TStringList.Create; + TP_IgnoreList := TStringList.Create; + TP_IgnoreList.Sorted := True; + TP_GlobalClassHandling := TList.Create; + TP_ClassHandling := TList.Create; + fWhenNewLanguageListeners := TInterfaceList.Create; + + // Set some settings + DefaultDomainDirectory := IncludeTrailingPathDelimiter + (extractfilepath(ExecutableFilename)) + 'locale'; + + UseLanguage(''); + + bindtextdomain(DefaultTextDomain, DefaultDomainDirectory); + textdomain(DefaultTextDomain); + + // Add default properties to ignore + TP_GlobalIgnoreClassProperty(TComponent, 'Name'); + TP_GlobalIgnoreClassProperty(TCollection, 'PropName'); + end; + + destructor TGnuGettextInstance.Destroy; + begin + if savememory <> nil then + begin + savefileCS.BeginWrite; + try + CloseFile(savefile); + finally + savefileCS.EndWrite; + end; + FreeAndNil(savememory); + end; + FreeAndNil(savefileCS); + FreeAndNil(TP_IgnoreList); + while TP_GlobalClassHandling.Count <> 0 do + begin + TObject(TP_GlobalClassHandling.Items[0]).Free; + TP_GlobalClassHandling.delete(0); + end; + FreeAndNil(TP_GlobalClassHandling); + FreeTP_ClassHandlingItems; + FreeAndNil(TP_ClassHandling); + while domainlist.Count <> 0 do + begin + domainlist.Objects[0].Free; + domainlist.delete(0); + end; + FreeAndNil(domainlist); + fWhenNewLanguageListeners.Free; +{$IFDEF DXGETTEXTDEBUG} + FreeAndNil(DebugLog); + FreeAndNil(DebugLogCS); +{$ENDIF} + inherited; + end; + +{$IFNDEF UNICODE} + function TGnuGettextInstance.dgettext(const szDomain: DomainString; + const szMsgId: AnsiString): TranslatedUnicodeString; + begin + Result := dgettext(szDomain, ansi2wideDTCP(szMsgId)); + end; +{$ENDIF} + function TGnuGettextInstance.dgettext(const szDomain: DomainString; + const szMsgId: MsgIdString): TranslatedUnicodeString; + begin + if not enabled then + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('Translation has been disabled. Text is not being translated: ' + + szMsgId); +{$ENDIF} + Result := szMsgId; + end + else + begin + Result := utf8decode(EnsureLineBreakInTranslatedString + (Getdomain(szDomain, DefaultDomainDirectory, curlang) + .gettext(StripCRRawMsgId(utf8encode(szMsgId))))); + +{$IFDEF DXGETTEXTDEBUG} + if (szMsgId <> '') and (Result = '') then + DebugWriteln + (Format('Error: Translation of %s was an empty string. This may never occur.', + [szMsgId])); +{$ENDIF} + end; + end; + + function TGnuGettextInstance.dgettext_NoExtract(const szDomain + : DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString; + begin + // This one is very useful for translating text in variables. + // This can sometimes be necessary, and by using this function, + // the source code scanner will not trigger warnings. + Result := dgettext(szDomain, szMsgId); + end; + + function TGnuGettextInstance.GetCurrentLanguage: LanguageString; + begin + Result := curlang; + end; + + function TGnuGettextInstance.getcurrenttextdomain: DomainString; + begin + Result := curmsgdomain; + end; + +{$IFNDEF UNICODE} + function TGnuGettextInstance.gettext(const szMsgId: AnsiString) + : TranslatedUnicodeString; + begin + Result := dgettext(curmsgdomain, szMsgId); + end; +{$ENDIF} + function TGnuGettextInstance.gettext(const szMsgId: MsgIdString) + : TranslatedUnicodeString; + begin + Result := dgettext(curmsgdomain, szMsgId); + end; + + function TGnuGettextInstance.gettext_NoExtract(const szMsgId: MsgIdString) + : TranslatedUnicodeString; + begin + // This one is very useful for translating text in variables. + // This can sometimes be necessary, and by using this function, + // the source code scanner will not trigger warnings. + Result := gettext(szMsgId); + end; + + function TGnuGettextInstance.gettext_NoOp(const szMsgId: MsgIdString) + : TranslatedUnicodeString; + begin + // *** With this function Strings can be added to the po-file without beeing + // ResourceStrings (dxgettext will add the string and this function will + // return it without a change) + // see gettext manual + // 4.7 - Special Cases of Translatable Strings + // http://www.gnu.org/software/hello/manual/gettext/Special-cases.html#Special-cases + Result := TranslatedUnicodeString(szMsgId); + end; + + procedure TGnuGettextInstance.textdomain(const szDomain: DomainString); + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Changed text domain to "' + szDomain + '"'); +{$ENDIF} + curmsgdomain := szDomain; + WhenNewDomain(szDomain); + end; + + function TGnuGettextInstance.TP_CreateRetranslator: TExecutable; + var + ttpr: TTP_Retranslator; + begin + ttpr := TTP_Retranslator.Create; + ttpr.Instance := self; + TP_Retranslator := ttpr; + Result := ttpr; +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('A retranslator was created.'); +{$ENDIF} + end; + + procedure TGnuGettextInstance.TP_GlobalHandleClass(HClass: TClass; + Handler: TTranslator); + var + cm: TClassMode; + i: Integer; + begin + for i := 0 to TP_GlobalClassHandling.Count - 1 do + begin + cm := TObject(TP_GlobalClassHandling.Items[i]) as TClassMode; + if cm.HClass = HClass then + raise EGGProgrammingError.Create + ('You cannot set a handler for a class that has already been assigned otherwise.'); + if HClass.InheritsFrom(cm.HClass) then + begin + // This is the place to insert this class + cm := TClassMode.Create; + cm.HClass := HClass; + cm.SpecialHandler := Handler; + TP_GlobalClassHandling.insert(i, cm); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('A handler was set for class ' + + HClass.ClassName + '.'); +{$ENDIF} + exit; + end; + end; + cm := TClassMode.Create; + cm.HClass := HClass; + cm.SpecialHandler := Handler; + TP_GlobalClassHandling.Add(cm); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('A handler was set for class ' + HClass.ClassName + '.'); +{$ENDIF} + end; + + procedure TGnuGettextInstance.TP_GlobalIgnoreClass(IgnClass: TClass); + var + cm: TClassMode; + i: Integer; + begin + for i := 0 to TP_GlobalClassHandling.Count - 1 do + begin + cm := TObject(TP_GlobalClassHandling.Items[i]) as TClassMode; + if cm.HClass = IgnClass then + raise EGGProgrammingError.Create + ('You cannot add a class to the ignore list that is already on that list: ' + + IgnClass.ClassName + + '. You should keep all TP_Global functions in one place in your source code.'); + if IgnClass.InheritsFrom(cm.HClass) then + begin + // This is the place to insert this class + cm := TClassMode.Create; + cm.HClass := IgnClass; + TP_GlobalClassHandling.insert(i, cm); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Globally, class ' + IgnClass.ClassName + + ' is being ignored.'); +{$ENDIF} + exit; + end; + end; + cm := TClassMode.Create; + cm.HClass := IgnClass; + TP_GlobalClassHandling.Add(cm); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Globally, class ' + IgnClass.ClassName + + ' is being ignored.'); +{$ENDIF} + end; + + procedure TGnuGettextInstance.TP_GlobalIgnoreClassProperty + (IgnClass: TClass; propertyname: ComponentNameString); + var + cm: TClassMode; + i, idx: Integer; + begin + propertyname := uppercase(propertyname); + for i := 0 to TP_GlobalClassHandling.Count - 1 do + begin + cm := TObject(TP_GlobalClassHandling.Items[i]) as TClassMode; + if cm.HClass = IgnClass then + begin + if Assigned(cm.SpecialHandler) then + raise EGGProgrammingError.Create + ('You cannot ignore a class property for a class that has a handler set.'); + if not cm.PropertiesToIgnore.Find(propertyname, idx) then + cm.PropertiesToIgnore.Add(propertyname); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Globally, the ' + propertyname + ' property of class ' + + IgnClass.ClassName + ' is being ignored.'); +{$ENDIF} + exit; + end; + if IgnClass.InheritsFrom(cm.HClass) then + begin + // This is the place to insert this class + cm := TClassMode.Create; + cm.HClass := IgnClass; + cm.PropertiesToIgnore.Add(propertyname); + TP_GlobalClassHandling.insert(i, cm); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Globally, the ' + propertyname + ' property of class ' + + IgnClass.ClassName + ' is being ignored.'); +{$ENDIF} + exit; + end; + end; + cm := TClassMode.Create; + cm.HClass := IgnClass; + cm.PropertiesToIgnore.Add(propertyname); + TP_GlobalClassHandling.Add(cm); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Globally, the ' + propertyname + ' property of class ' + + IgnClass.ClassName + ' is being ignored.'); +{$ENDIF} + end; + + procedure TGnuGettextInstance.TP_Ignore(AnObject: TObject; + const name: ComponentNameString); + begin + TP_IgnoreList.Add(uppercase(name)); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('On object with class name ' + AnObject.ClassName + + ', ignore is set on ' + name); +{$ENDIF} + end; + + procedure TGnuGettextInstance.TranslateComponent(AnObject: TComponent; + const textdomain: DomainString); + var + comp: TGnuGettextComponentMarker; + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('======================================================================'); + DebugWriteln + ('TranslateComponent() was called for a component with name ' + + AnObject.name + '.'); +{$ENDIF} + comp := AnObject.FindComponent('GNUgettextMarker') + as TGnuGettextComponentMarker; + if comp = nil then + begin + comp := TGnuGettextComponentMarker.Create(nil); + comp.name := 'GNUgettextMarker'; + comp.Retranslator := TP_CreateRetranslator; + TranslateProperties(AnObject, textdomain); + AnObject.InsertComponent(comp); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('This is the first time, that this component has been translated. A retranslator component has been created for this component.'); +{$ENDIF} + end + else + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('This is not the first time, that this component has been translated.'); +{$ENDIF} + if comp.LastLanguage <> curlang then + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('ERROR: TranslateComponent() was called twice with different languages. This indicates an attempt to switch language at runtime, but by using TranslateComponent every time. This API has changed - please use RetranslateComponent() instead.'); +{$ENDIF} +{$IFDEF mswindows} + MessageBox(0, + 'This application tried to switch the language, but in an incorrect way. The programmer needs to replace a call to TranslateComponent with a call to RetranslateComponent(). The programmer should see the changelog of gnugettext.pas for more information.', + 'Error', MB_OK); +{$ELSE} + writeln(stderr, + 'This application tried to switch the language, but in an incorrect way. The programmer needs to replace a call to TranslateComponent with a call to RetranslateComponent(). The programmer should see the changelog of gnugettext.pas for more information.'); +{$ENDIF} + end + else + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('ERROR: TranslateComponent has been called twice, but with the same language chosen. This is a mistake, but in order to prevent that the application breaks, no exception is raised.'); +{$ENDIF} + end; + end; + comp.LastLanguage := curlang; +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('======================================================================'); +{$ENDIF} + end; + + procedure TGnuGettextInstance.TranslateProperty(AnObject: TObject; + PropInfo: PPropInfo; TodoList: TStrings; + const textdomain: DomainString); + var + ppi: PPropInfo; + ws: TranslatedUnicodeString; + old: TranslatedUnicodeString; + compmarker: TComponent; + obj: TObject; + Propname: ComponentNameString; + begin + Propname := string(PropInfo^.name); + try + // Translate certain types of properties + case PropInfo^.PropType^.Kind of +{$IFDEF UNICODE} + // All dfm files returning tkUString + tkString, tkLString, tkWString, tkUString: +{$ELSE} + tkString, tkLString, tkWString: +{$ENDIF} + begin + // prevent items in RadioGroup from duplicate translation - JR - 2011-07-29 + if AnObject.ClassName = 'TGroupButton' then + exit; +{$IFDEF DXGETTEXTDEBUG} + if AnObject is TComponent then + DebugWriteln('Translating ' + AnObject.ClassName + '.' + + Propname + ' (' + TComponent(AnObject).name + ')') + else + DebugWriteln('Translating ' + AnObject.ClassName + '.' + + Propname);; +{$ENDIF} + case PropInfo^.PropType^.Kind of + tkString, tkLString: + old := GetStrProp(AnObject, Propname); + tkWString: + old := GetWideStrProp(AnObject, Propname); +{$IFDEF UNICODE} + tkUString: + old := GetUnicodeStrProp(AnObject, Propname); +{$ENDIF} + else + raise Exception.Create + ('Internal error: Illegal property type. This problem needs to be solved by a programmer, try to find a workaround.'); + end; +{$IFDEF DXGETTEXTDEBUG} + if old = '' then + DebugWriteln('(Empty, not translated)') + else + DebugWriteln('Old value: "' + old + '"'); +{$ENDIF} + if (old <> '') and (IsWriteProp(PropInfo)) then + begin + if TP_Retranslator <> nil then + (TP_Retranslator as TTP_Retranslator) + .Remember(AnObject, Propname, old); + if textdomain = '' then + ws := ComponentGettext(old) + else + ws := dgettext(textdomain, old); + if ws <> old then + begin + ppi := GetPropInfo(AnObject, Propname); + if ppi <> nil then + begin + SetWideStrProp(AnObject, ppi, ws); + end + else + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('ERROR: Property disappeared: ' + Propname + + ' for object of type ' + AnObject.ClassName); +{$ENDIF} + end; + end; + end; + end { case item }; + tkClass: + begin + obj := GetObjectProp(AnObject, Propname); + if obj <> nil then + begin + if obj is TComponent then + begin + compmarker := TComponent(obj) + .FindComponent('GNUgettextMarker'); + if Assigned(compmarker) then + exit; + end; + TodoList.AddObject('', obj); + end; + end { case item }; + end { case }; + except + on E: Exception do + raise EGGComponentError.Create('Property cannot be translated.' + + sLinebreak + 'Add TP_GlobalIgnoreClassProperty(' + + AnObject.ClassName + ',''' + Propname + + ''') to your source code or use' + sLinebreak + + 'TP_Ignore (self,''.' + Propname + ''') to prevent this message.' + + sLinebreak + 'Reason: ' + E.Message); + end; + end; + + procedure TGnuGettextInstance.TranslateProperties(AnObject: TObject; + textdomain: DomainString = ''); + var + TodoList: TStringList; // List of Name/TObject's that is to be processed + DoneList: TStringList; + // List of hex codes representing pointers to objects that have been done + i, j, Count: Integer; + PropList: PPropList; + UPropName: ComponentNameString; + PropInfo: PPropInfo; + compmarker, comp: TComponent; + cm, currentcm: TClassMode; + // currentcm is nil or contains special information about how to handle the current object + ObjectPropertyIgnoreList: TStringList; + objid: string; + name: ComponentNameString; + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('----------------------------------------------------------------------'); + DebugWriteln('TranslateProperties() was called for an object of class ' + + AnObject.ClassName + ' with domain "' + textdomain + '".'); +{$ENDIF} + if TP_Retranslator <> nil then + if textdomain = '' then + (TP_Retranslator as TTP_Retranslator).textdomain := curmsgdomain + else + (TP_Retranslator as TTP_Retranslator).textdomain := textdomain; +{$IFDEF FPC} + DoneList := TCSStringList.Create; + TodoList := TCSStringList.Create; + ObjectPropertyIgnoreList := TCSStringList.Create; +{$ELSE} + DoneList := TStringList.Create; + TodoList := TStringList.Create; + ObjectPropertyIgnoreList := TStringList.Create; +{$ENDIF} + try + TodoList.AddObject('', AnObject); + DoneList.Sorted := True; + ObjectPropertyIgnoreList.Sorted := True; + ObjectPropertyIgnoreList.Duplicates := dupIgnore; + ObjectPropertyIgnoreList.CaseSensitive := false; + DoneList.Duplicates := dupError; + DoneList.CaseSensitive := True; + + while TodoList.Count <> 0 do + begin + AnObject := TodoList.Objects[0]; + Name := TodoList.Strings[0]; + TodoList.delete(0); + if (AnObject <> nil) and (AnObject is TPersistent) then + begin + // Make sure each object is only translated once + Assert(SizeOf({$IFDEF CPUx64}NativeInt{$ELSE}Integer{$ENDIF CPUx64}) = SizeOf(TObject)); + objid := IntToHex + ({$IFDEF CPUx64}NativeInt{$ELSE}Integer{$ENDIF CPUx64}(AnObject), 8); + if DoneList.Find(objid, i) then + begin + continue; + end + else + begin + DoneList.Add(objid); + end; + + ObjectPropertyIgnoreList.Clear; + + // Find out if there is special handling of this object + currentcm := nil; + // First check the local handling instructions + for j := 0 to TP_ClassHandling.Count - 1 do + begin + cm := TObject(TP_ClassHandling.Items[j]) as TClassMode; + if AnObject.InheritsFrom(cm.HClass) then + begin + if cm.PropertiesToIgnore.Count <> 0 then + begin + ObjectPropertyIgnoreList.AddStrings(cm.PropertiesToIgnore); + end + else + begin + // Ignore the entire class + currentcm := cm; + break; + end; + end; + end; + // Then check the global handling instructions + if currentcm = nil then + for j := 0 to TP_GlobalClassHandling.Count - 1 do + begin + cm := TObject(TP_GlobalClassHandling.Items[j]) as TClassMode; + if AnObject.InheritsFrom(cm.HClass) then + begin + if cm.PropertiesToIgnore.Count <> 0 then + begin + ObjectPropertyIgnoreList.AddStrings + (cm.PropertiesToIgnore); + end + else + begin + // Ignore the entire class + currentcm := cm; + break; + end; + end; + end; + if currentcm <> nil then + begin + ObjectPropertyIgnoreList.Clear; + // Ignore or use special handler + if Assigned(currentcm.SpecialHandler) then + begin + currentcm.SpecialHandler(AnObject); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Special handler activated for ' + + AnObject.ClassName); +{$ENDIF} + end + else + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Ignoring object ' + AnObject.ClassName); +{$ENDIF} + end; + continue; + end; + + Count := GetPropList(AnObject, PropList); + try + for j := 0 to Count - 1 do + begin + PropInfo := PropList[j]; +{$IFDEF UNICODE} + if not(PropInfo^.PropType^.Kind in [tkString, tkLString, + tkWString, tkClass, tkUString]) then +{$ELSE} + if not(PropInfo^.PropType^.Kind in [tkString, tkLString, + tkWString, tkClass]) then +{$ENDIF} + continue; + UPropName := uppercase(string(PropInfo^.name)); + // Ignore properties that are meant to be ignored + if ((currentcm = nil) or + (not currentcm.PropertiesToIgnore.Find(UPropName, i))) and + (not TP_IgnoreList.Find(Name + '.' + UPropName, i)) and + (not ObjectPropertyIgnoreList.Find(UPropName, i)) then + begin + TranslateProperty(AnObject, PropInfo, TodoList, textdomain); + end; // if + end; // for + finally + if Count <> 0 then + FreeMem(PropList); + end; + if AnObject is TStrings then + begin + if ((AnObject as TStrings).Text <> '') and + (TP_Retranslator <> nil) then + (TP_Retranslator as TTP_Retranslator) + .Remember(AnObject, 'Text', (AnObject as TStrings).Text); + TranslateStrings(AnObject as TStrings, textdomain); + end; + // Check for TCollection + if AnObject is TCollection then + begin + for i := 0 to (AnObject as TCollection).Count - 1 do + begin + // Only add the object if it's not totally ignored already + if not Assigned(currentcm) or + not AnObject.InheritsFrom(currentcm.HClass) then + TodoList.AddObject('', (AnObject as TCollection).Items[i]); + end; + end; + if AnObject is TComponent then + begin + for i := 0 to TComponent(AnObject).ComponentCount - 1 do + begin + comp := TComponent(AnObject).Components[i]; + if (not TP_IgnoreList.Find(uppercase(comp.name), j)) then + begin + // Only add the object if it's not totally ignored or translated already + if not Assigned(currentcm) or + not AnObject.InheritsFrom(currentcm.HClass) then + begin + compmarker := comp.FindComponent('GNUgettextMarker'); + if not Assigned(compmarker) then + TodoList.AddObject(uppercase(comp.name), comp); + end; + end; + end; + end; + end { if AnObject<>nil }; + end { while todolist.count<>0 }; + finally + FreeAndNil(TodoList); + FreeAndNil(ObjectPropertyIgnoreList); + FreeAndNil(DoneList); + end; + FreeTP_ClassHandlingItems; + TP_IgnoreList.Clear; + TP_Retranslator := nil; +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('----------------------------------------------------------------------'); +{$ENDIF} + end; + + procedure TGnuGettextInstance.UnregisterWhenNewLanguageListener + (Listener: IGnuGettextInstanceWhenNewLanguageListener); + begin + fWhenNewLanguageListeners.Remove(Listener); + end; + + procedure TGnuGettextInstance.UseLanguage(LanguageCode: LanguageString); + var + i, p: Integer; + dom: TDomain; + l2: string; + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('UseLanguage(''' + LanguageCode + '''); called'); +{$ENDIF} + if LanguageCode = '' then + begin + LanguageCode := GGGetEnvironmentVariable('LANG'); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('LANG env variable is ''' + LanguageCode + '''.'); +{$ENDIF} +{$IFDEF MSWINDOWS} + if LanguageCode = '' then + begin + LanguageCode := GetWindowsLanguage; +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Found Windows language code to be ''' + + LanguageCode + '''.'); +{$ENDIF} + end; +{$ENDIF} + p := pos('.', LanguageCode); + if p <> 0 then + LanguageCode := LeftStr(LanguageCode, p - 1); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Language code that will be set is ''' + + LanguageCode + '''.'); +{$ENDIF} + end; + + curlang := LanguageCode; + for i := 0 to domainlist.Count - 1 do + begin + dom := domainlist.Objects[i] as TDomain; + dom.SetLanguageCode(curlang); + end; + + l2 := lowercase(LeftStr(curlang, 2)); + if (l2 = 'en') or (l2 = 'de') then + curGetPluralForm := GetPluralForm2EN + else if (l2 = 'hu') or (l2 = 'ko') or (l2 = 'zh') or (l2 = 'ja') or + (l2 = 'tr') then + curGetPluralForm := GetPluralForm1 + else if (l2 = 'fr') or (l2 = 'fa') or (lowercase(curlang) = 'pt_br') + then + curGetPluralForm := GetPluralForm2FR + else if (l2 = 'lv') then + curGetPluralForm := GetPluralForm3LV + else if (l2 = 'ga') then + curGetPluralForm := GetPluralForm3GA + else if (l2 = 'lt') then + curGetPluralForm := GetPluralForm3LT + else if (l2 = 'ru') or (l2 = 'uk') or (l2 = 'hr') then + curGetPluralForm := GetPluralForm3RU + else if (l2 = 'cs') or (l2 = 'sk') then + curGetPluralForm := GetPluralForm3SK + else if (l2 = 'pl') then + curGetPluralForm := GetPluralForm3PL + else if (l2 = 'sl') then + curGetPluralForm := GetPluralForm4SL + else + begin + curGetPluralForm := GetPluralForm2EN; +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('Plural form for the language was not found. English plurality system assumed.'); +{$ENDIF} + end; + + WhenNewLanguage(curlang); + +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln(''); +{$ENDIF} + end; + + procedure TGnuGettextInstance.TranslateStrings(sl: TStrings; + const textdomain: DomainString); + var + Line: string; + i: Integer; + s: TStringList; + slAsTStringList: TStringList; + originalOwnsObjects: boolean; + begin + if sl.Count > 0 then + begin + // From D2009 onward, the TStringList class has a OwnsObjects property, just like + // TObjectList has. This means that when we will be calling Clear on the given + // list in the sl parameter, we could destroy the objects it contains. + // To avoid this we must disable OwnsObjects while we replace the strings, but + // only if sl is a TStringList instance and if using Delphi 2009 or upper. + originalOwnsObjects := false; // avoid warning + if sl is TStringList then + slAsTStringList := TStringList(sl) + else + slAsTStringList := nil; + + sl.BeginUpdate; + try + s := TStringList.Create; + try + // don't use Assign here as it will propagate the Sorted property (among others) + // in versions of Delphi from Delphi XE ownard + s.AddStrings(sl); + + for i := 0 to s.Count - 1 do + begin + Line := s.Strings[i]; + if Line <> '' then + if textdomain = '' then + s.Strings[i] := ComponentGettext(Line) + else + s.Strings[i] := dgettext(textdomain, Line); + end; + + if Assigned(slAsTStringList) then + begin + originalOwnsObjects := slAsTStringList.OwnsObjects; + slAsTStringList.OwnsObjects := false; + end; + try + // same here, we don't want to modify the properties of the orignal string list + sl.Clear; + sl.AddStrings(s); + finally + if Assigned(slAsTStringList) then + slAsTStringList.OwnsObjects := originalOwnsObjects; + end; + finally + FreeAndNil(s); + end; + finally + sl.EndUpdate; + end; + end; + end; + + function TGnuGettextInstance.GetTranslatorNameAndEmail + : TranslatedUnicodeString; + begin + Result := GetTranslationProperty('LAST-TRANSLATOR'); + end; + + function TGnuGettextInstance.GetTranslationProperty(const propertyname + : ComponentNameString): TranslatedUnicodeString; + begin + Result := Getdomain(curmsgdomain, DefaultDomainDirectory, curlang) + .GetTranslationProperty(propertyname); + end; + + function TGnuGettextInstance.dngettext(const szDomain: DomainString; + const singular, plural: MsgIdString; Number: Integer) + : TranslatedUnicodeString; + var + org: MsgIdString; + trans: TranslatedUnicodeString; + idx: Integer; + p: Integer; + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('dngettext translation (domain ' + szDomain + + ', number is ' + IntToStr(Number) + ') of ' + singular + '/' + + plural); +{$ENDIF} + org := singular + #0 + plural; + trans := dgettext(szDomain, org); + if org = trans then + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('Translation was equal to english version. English plural forms assumed.'); +{$ENDIF} + idx := GetPluralForm2EN(Number) + end + else + idx := curGetPluralForm(Number); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Index ' + IntToStr(idx) + ' will be used'); +{$ENDIF} + while True do + begin + p := pos(#0, trans); + if p = 0 then + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Last translation used: ' + utf8encode(trans)); +{$ENDIF} + Result := trans; + exit; + end; + if idx = 0 then + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Translation found: ' + utf8encode(trans)); +{$ENDIF} + Result := LeftStr(trans, p - 1); + exit; + end; + delete(trans, 1, p); + dec(idx); + end; + end; + + function TGnuGettextInstance.dngettext_NoExtract(const szDomain + : DomainString; const singular, plural: MsgIdString; Number: Integer) + : TranslatedUnicodeString; + begin + // This one is very useful for translating text in variables. + // This can sometimes be necessary, and by using this function, + // the source code scanner will not trigger warnings. + Result := dngettext(szDomain, singular, plural, Number); + end; + +{$IFNDEF UNICODE} + function TGnuGettextInstance.ngettext(const singular, plural: AnsiString; + Number: Integer): TranslatedUnicodeString; + begin + Result := dngettext(curmsgdomain, singular, plural, Number); + end; +{$ENDIF} + function TGnuGettextInstance.ngettext(const singular, plural: MsgIdString; + Number: Integer): TranslatedUnicodeString; + begin + Result := dngettext(curmsgdomain, singular, plural, Number); + end; + + function TGnuGettextInstance.ngettext_NoExtract(const singular, + plural: MsgIdString; Number: Integer): TranslatedUnicodeString; + begin + // This one is very useful for translating text in variables. + // This can sometimes be necessary, and by using this function, + // the source code scanner will not trigger warnings. + Result := ngettext(singular, plural, Number); + end; + + procedure TGnuGettextInstance.WhenNewDomain(const textdomain + : DomainString); + begin + // This is meant to be empty. + end; + + procedure TGnuGettextInstance.WhenNewLanguage(const LanguageID + : LanguageString); + var + i: Integer; + begin + for i := 0 to fWhenNewLanguageListeners.Count - 1 do + IGnuGettextInstanceWhenNewLanguageListener + (fWhenNewLanguageListeners[i]).WhenNewLanguage(LanguageID); + end; + + procedure TGnuGettextInstance.WhenNewDomainDirectory(const textdomain + : DomainString; const Directory: FilenameString); + begin + // This is meant to be empty. + end; + + procedure TGnuGettextInstance.GetListOfLanguages + (const domain: DomainString; list: TStrings); + begin + Getdomain(domain, DefaultDomainDirectory, curlang) + .GetListOfLanguages(list); + end; + + procedure TGnuGettextInstance.bindtextdomainToFile(const szDomain + : DomainString; const filename: FilenameString); + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Text domain "' + szDomain + + '" is now bound to file named "' + filename + '"'); +{$ENDIF} + Getdomain(szDomain, DefaultDomainDirectory, curlang) + .SetFilename(filename); + end; + + procedure TGnuGettextInstance.DebugLogPause(PauseEnabled: boolean); + begin +{$IFDEF DXGETTEXTDEBUG} + DebugLogOutputPaused := PauseEnabled; +{$ENDIF} + end; + + procedure TGnuGettextInstance.DebugLogToFile(const filename + : FilenameString; append: boolean = false); +{$IFDEF DXGETTEXTDEBUG} + var + fs: TFileStream; + marker: AnsiString; +{$ENDIF} + begin +{$IFDEF DXGETTEXTDEBUG} + // Create the file if needed + if (not FileExists(filename)) or (not append) then + fileclose(filecreate(filename)); + + // Open file + fs := TFileStream.Create(filename, fmOpenWrite or fmShareDenyWrite); + if append then + fs.Seek(0, soFromEnd); + + // Write header if appending + if fs.Position <> 0 then + begin + marker := sLinebreak + + '===========================================================================' + + sLinebreak; + fs.WriteBuffer(marker[1], length(marker)); + end; + + // Copy the memorystream contents to the file + if DebugLog <> nil then + begin + DebugLog.Seek(0, soFromBeginning); + fs.CopyFrom(DebugLog, 0); + end; + + // Make DebugLog point to the filestream + FreeAndNil(DebugLog); + DebugLog := fs; +{$ENDIF} + end; + +{$IFDEF DXGETTEXTDEBUG} + procedure TGnuGettextInstance.DebugWriteln(Line: AnsiString); + Var + Discard: boolean; + begin + Assert(DebugLogCS <> nil); + Assert(DebugLog <> nil); + + DebugLogCS.BeginWrite; + try + if DebugLogOutputPaused then + exit; + + if Assigned(fOnDebugLine) then + begin + Discard := True; + fOnDebugLine(self, Line, Discard); + If Discard then + exit; + end; + + Line := Line + sLinebreak; + + // Ensure that memory usage doesn't get too big. + if (DebugLog is TMemoryStream) and (DebugLog.Position > 1000000) then + begin + Line := sLinebreak + sLinebreak + sLinebreak + sLinebreak + + sLinebreak + + 'Debug log halted because memory usage grew too much.' + + sLinebreak + + 'Specify a filename to store the debug log in or disable debug loggin in gnugettext.pas.' + + sLinebreak + sLinebreak + sLinebreak + sLinebreak + sLinebreak; + DebugLogOutputPaused := True; + end; + DebugLog.WriteBuffer(Line[1], length(Line)); + finally + DebugLogCS.EndWrite; + end; + end; +{$ENDIF} + function TGnuGettextInstance.Getdomain(const domain: DomainString; + const DefaultDomainDirectory: FilenameString; + const curlang: LanguageString): TDomain; + // Retrieves the TDomain object for the specified domain. + // Creates one, if none there, yet. + var + idx: Integer; + begin + idx := domainlist.IndexOf(domain); + if idx = -1 then + begin + Result := TDomain.Create; +{$IFDEF DXGETTEXTDEBUG} + Result.DebugLogger := DebugWriteln; +{$ENDIF} + Result.domain := domain; + Result.Directory := DefaultDomainDirectory; + Result.SetLanguageCode(curlang); + domainlist.AddObject(domain, Result); + end + else + begin + Result := domainlist.Objects[idx] as TDomain; + end; + end; + + function TGnuGettextInstance.LoadResString(ResStringRec: PResStringRec) + : UnicodeString; +{$IFDEF MSWINDOWS} + var + Len: Integer; +{$IFDEF UNICODE} + Buffer: array [0 .. 1023] of widechar; +{$ELSE} + Buffer: array [0 .. 1023] of ansichar; +{$ENDIF} +{$ENDIF} +{$IFDEF LINUX } + const + ResStringTableLen = 16; + type + ResStringTable = array [0 .. ResStringTableLen - 1] of LongWord; + var + Handle: TResourceHandle; + Tab: ^ResStringTable; + ResMod: HModule; +{$ENDIF } + begin + if ResStringRec = nil then + exit; + if ResStringRec.Identifier >= 64 * 1024 then + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('LoadResString was given an invalid ResStringRec.Identifier'); +{$ENDIF} + Result := 'ERROR'; + exit; + end + else + begin +{$IFDEF LINUX} + // This works with Unicode if the Linux has utf-8 character set + // Result:=System.LoadResString(ResStringRec); + ResMod := FindResourceHInstance(ResStringRec^.Module^); + Handle := FindResource(ResMod, + PAnsiChar(ResStringRec^.Identifier div ResStringTableLen), + PAnsiChar(6)); // RT_STRING + Tab := pointer(LoadResource(ResMod, Handle)); + if Tab = nil then + Result := '' + else + Result := PWideChar(PAnsiChar(Tab) + + Tab[ResStringRec^.Identifier mod ResStringTableLen]); +{$ENDIF} +{$IFDEF MSWINDOWS} + if not Win32PlatformIsUnicode then + begin + SetString(Result, Buffer, + LoadString(FindResourceHInstance(ResStringRec.Module^), + ResStringRec.Identifier, Buffer, SizeOf(Buffer))) + end + else + begin + Result := ''; + Len := 0; + While length(Result) <= Len + 1 do + begin + if length(Result) = 0 then + SetLength(Result, 1024) + else + SetLength(Result, length(Result) * 2); + Len := LoadStringW(FindResourceHInstance(ResStringRec.Module^), + ResStringRec.Identifier, PWideChar(Result), length(Result)); + end; + SetLength(Result, Len); + end; +{$ENDIF} + end; +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Loaded resourcestring: ' + utf8encode(Result)); +{$ENDIF} + Result := ResourceStringGettext(Result); + end; + + procedure TGnuGettextInstance.RegisterWhenNewLanguageListener + (Listener: IGnuGettextInstanceWhenNewLanguageListener); + begin + fWhenNewLanguageListeners.Add(Listener); + end; + + procedure TGnuGettextInstance.RetranslateComponent(AnObject: TComponent; + const textdomain: DomainString); + var + comp: TGnuGettextComponentMarker; + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('======================================================================'); + DebugWriteln + ('RetranslateComponent() was called for a component with name ' + + AnObject.name + '.'); +{$ENDIF} + comp := AnObject.FindComponent('GNUgettextMarker') + as TGnuGettextComponentMarker; + if comp = nil then + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('Retranslate was called on an object that has not been translated before. An Exception is being raised.'); +{$ENDIF} + raise EGGProgrammingError.Create + ('Retranslate was called on an object that has not been translated before. Please use TranslateComponent() before RetranslateComponent().'); + end + else + begin + // *** if param ReReadMoFileOnSameLanguage is set, use the ReTranslate + // function nevertheless if the current language is the same like the + // new (-> reread the current .mo-file from the file system). + if ReReadMoFileOnSameLanguage or (comp.LastLanguage <> curlang) then + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('The retranslator is being executed.'); +{$ENDIF} + comp.Retranslator.Execute; + end + else + begin +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('The language has not changed. The retranslator is not executed.'); +{$ENDIF} + end; + end; + comp.LastLanguage := curlang; + +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln + ('======================================================================'); +{$ENDIF} + end; + + procedure TGnuGettextInstance.TP_IgnoreClass(IgnClass: TClass); + var + cm: TClassMode; + i: Integer; + begin + for i := 0 to TP_ClassHandling.Count - 1 do + begin + cm := TObject(TP_ClassHandling.Items[i]) as TClassMode; + if cm.HClass = IgnClass then + raise EGGProgrammingError.Create + ('You cannot add a class to the ignore list that is already on that list: ' + + IgnClass.ClassName + '.'); + if IgnClass.InheritsFrom(cm.HClass) then + begin + // This is the place to insert this class + cm := TClassMode.Create; + cm.HClass := IgnClass; + TP_ClassHandling.insert(i, cm); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Locally, class ' + IgnClass.ClassName + + ' is being ignored.'); +{$ENDIF} + exit; + end; + end; + cm := TClassMode.Create; + cm.HClass := IgnClass; + TP_ClassHandling.Add(cm); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Locally, class ' + IgnClass.ClassName + + ' is being ignored.'); +{$ENDIF} + end; + + procedure TGnuGettextInstance.TP_IgnoreClassProperty(IgnClass: TClass; + propertyname: ComponentNameString); + var + cm: TClassMode; + i: Integer; + begin + propertyname := uppercase(propertyname); + for i := 0 to TP_ClassHandling.Count - 1 do + begin + cm := TObject(TP_ClassHandling.Items[i]) as TClassMode; + if cm.HClass = IgnClass then + begin + if Assigned(cm.SpecialHandler) then + raise EGGProgrammingError.Create + ('You cannot ignore a class property for a class that has a handler set.'); + cm.PropertiesToIgnore.Add(propertyname); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Globally, the ' + propertyname + ' property of class ' + + IgnClass.ClassName + ' is being ignored.'); +{$ENDIF} + exit; + end; + if IgnClass.InheritsFrom(cm.HClass) then + begin + // This is the place to insert this class + cm := TClassMode.Create; + cm.HClass := IgnClass; + cm.PropertiesToIgnore.Add(propertyname); + TP_ClassHandling.insert(i, cm); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Locally, the ' + propertyname + ' property of class ' + + IgnClass.ClassName + ' is being ignored.'); +{$ENDIF} + exit; + end; + end; + cm := TClassMode.Create; + cm.HClass := IgnClass; + cm.PropertiesToIgnore.Add(propertyname); + TP_GlobalClassHandling.Add(cm); +{$IFDEF DXGETTEXTDEBUG} + DebugWriteln('Locally, the ' + propertyname + ' property of class ' + + IgnClass.ClassName + ' is being ignored.'); +{$ENDIF} + end; + + procedure TGnuGettextInstance.FreeTP_ClassHandlingItems; + begin + while TP_ClassHandling.Count <> 0 do + begin + TObject(TP_ClassHandling.Items[0]).Free; + TP_ClassHandling.delete(0); + end; + end; + +{$IFNDEF UNICODE} + function TGnuGettextInstance.ansi2wideDTCP(const s: AnsiString) + : MsgIdString; +{$IFDEF MSWindows} + var + Len: Integer; +{$ENDIF} + begin +{$IFDEF MSWindows} + if DesignTimeCodePage = CP_ACP then + begin + // No design-time codepage specified. Using runtime codepage instead. +{$ENDIF} + Result := s; +{$IFDEF MSWindows} + end + else + begin + Len := length(s); + if Len = 0 then + Result := '' + else + begin + SetLength(Result, Len); + Len := MultiByteToWideChar(DesignTimeCodePage, 0, PAnsiChar(s), Len, + PWideChar(Result), Len); + if Len = 0 then + raise EGGAnsi2WideConvError.Create + ('Cannot convert string to widestring:' + sLinebreak + s); + SetLength(Result, Len); + end; + end; +{$ENDIF} + end; +{$ENDIF} +{$IFNDEF UNICODE} + function TGnuGettextInstance.dngettext(const szDomain: DomainString; + const singular, plural: AnsiString; Number: Integer) + : TranslatedUnicodeString; + begin + Result := dngettext(szDomain, ansi2wideDTCP(singular), + ansi2wideDTCP(plural), Number); + end; +{$ENDIF} + { TClassMode } + + constructor TClassMode.Create; + begin + PropertiesToIgnore := TStringList.Create; + PropertiesToIgnore.Sorted := True; + PropertiesToIgnore.Duplicates := dupError; + PropertiesToIgnore.CaseSensitive := false; + end; + + destructor TClassMode.Destroy; + begin + FreeAndNil(PropertiesToIgnore); + inherited; + end; + + { TFileLocator } + + function TFileLocator.FindSignaturePos(const signature: RawByteString; + str: TFileStream): int64; + // Finds the position of signature in the file. + const + bufsize = 100000; + var + a: RawByteString; + b: RawByteString; + Offset: Integer; + rd, p: Integer; + begin + if signature = '' then + begin + Result := 0; + exit; + end; + + Offset := 0; + str.Seek(0, soFromBeginning); + + SetLength(a, bufsize); + SetLength(b, bufsize); + str.Read(a[1], bufsize); + + while True do + begin + rd := str.Read(b[1], bufsize); + p := pos(signature, a + b); + if (p <> 0) then + begin // do not check p < bufsize+100 here! + Result := Offset + p - 1; + exit; + end; + if rd <> bufsize then + begin + // Prematurely ended without finding anything + Result := 0; + exit; + end; + a := b; + Offset := Offset + bufsize; + end; + Result := 0; + end; + + // Changed to "Analyze" with old signature to be compatible to older programs + // and to the assemble routine in GgtTranslate + // JR - 2012-09-10 + procedure TFileLocator.Analyze; + var + s: AnsiString; + i: Integer; + Offset: int64; + fs: TFileStream; + fi: TEmbeddedFileInfo; + filename: AnsiString; + // change from FilenameString to AnsiString, JR - 2010-04-10 + begin + // "ggassemble" will search for this GUI and replace the trailing #0s by a pointer + // to the begin of the embedded mo files + s := '6637DB2E-62E1-4A60-AC19-C23867046A89'#0#0#0#0#0#0#0#0; // constant + s := MidStr(s, length(s) - 7, 8); + Offset := 0; + for i := 8 downto 1 do + Offset := Offset shl 8 + ord(s[i]); + if Offset = 0 then + exit; + basedirectory := extractfilepath(ExecutableFilename); + try + fs := TFileStream.Create(ExecutableFilename, fmOpenRead or + fmShareDenyNone); + try + while True do + begin + fs.Seek(Offset, soFromBeginning); + Offset := ReadInt64(fs); + if Offset = 0 then + exit; + fi := TEmbeddedFileInfo.Create; + try + fi.Offset := ReadInt64(fs); + fi.Size := ReadInt64(fs); + SetLength(filename, Offset - fs.Position); + fs.ReadBuffer(filename[1], Offset - fs.Position); + filename := trim(filename); + if PreferExternal and System.SysUtils.FileExists + (basedirectory + filename) then + begin + // Disregard the internal version and use the external version instead + FreeAndNil(fi); + end + else + filelist.AddObject(filename, fi); + except + FreeAndNil(fi); + raise; + end; + end; + finally + FreeAndNil(fs); + end; + except +{$IFDEF DXGETTEXTDEBUG} + raise; +{$ENDIF} + end; + end; + + (* procedure TFileLocator.Analyze; + var + HeaderSize, + PrefixSize: Integer; + dummysig, + headerpre, + headerbeg, + headerend:RawByteString; + i:integer; + headerbeginpos, + headerendpos:integer; + offset, + tableoffset:int64; + fs:TFileStream; + fi:TEmbeddedFileInfo; + filename:FilenameString; + filename8bit:RawByteString; + const + // DetectionSignature: used solely to detect gnugettext usage by assemble + DetectionSignature: array[0..35] of AnsiChar='2E23E563-31FA-4C24-B7B3-90BE720C6B1A'; + // Embedded Header Begin Signature (without dynamic prefix written by assemble) + BeginHeaderSignature: array[0..35] of AnsiChar='BD7F1BE4-9FCF-4E3A-ABA7-3443D11AB362'; + // Embedded Header End Signature (without dynamic prefix written by assemble) + EndHeaderSignature: array[0..35] of AnsiChar='1C58841C-D8A0-4457-BF54-D8315D4CF49D'; + // Assemble Prefix (do not put before the Header Signatures!) + SignaturePrefix: array[0..2] of AnsiChar='DXG'; // written from assemble + begin + // Attn: Ensure all Signatures have the same size! + HeaderSize := High(BeginHeaderSignature) - Low(BeginHeaderSignature) + 1; + PrefixSize := High(SignaturePrefix) - Low(SignaturePrefix) + 1; + + // dummy usage of DetectionSignature (otherwise not compiled into exe) + SetLength(dummysig, HeaderSize); + for i := 0 to HeaderSize-1 do + dummysig[i+1] := DetectionSignature[i]; + + // copy byte by byte (D2009+ compatible) + SetLength(headerpre, PrefixSize); + for i:= 0 to PrefixSize-1 do + headerpre[i+1] := SignaturePrefix[i]; + + SetLength(headerbeg, HeaderSize); + for i:= 0 to HeaderSize-1 do + headerbeg[i+1] := BeginHeaderSignature[i]; + + SetLength(headerend, HeaderSize); + for i:= 0 to HeaderSize-1 do + headerend[i+1] := EndHeaderSignature[i]; + + BaseDirectory:=ExtractFilePath(ExecutableFilename); + try + fs:=TFileStream.Create(ExecutableFilename,fmOpenRead or fmShareDenyNone); + try + // try to find new header begin and end signatures + headerbeginpos := FindSignaturePos(headerpre+headerbeg, fs); + headerendpos := FindSignaturePos(headerpre+headerend, fs); + + if (headerbeginpos > 0) and (headerendpos > 0) then + begin + // adjust positions (to the end of each signature) + headerbeginpos := headerbeginpos + HeaderSize + PrefixSize; + + // get file table offset (8 byte, stored directly before the end header) + fs.Seek(headerendpos - 8, soFromBeginning); + // get relative offset and convert to absolute offset during runtime + tableoffset := headerbeginpos + ReadInt64(fs); + + // go to beginning of embedded block + fs.Seek(headerbeginpos, soFromBeginning); + + offset := tableoffset; + Assert(sizeof(offset)=8); + while (true) and (fs.Position 0 do + begin + filelist.Objects[0].Free; + filelist.delete(0); + end; + FreeAndNil(filelist); + FreeAndNil(MoFiles); + FreeAndNil(MoFilesCS); + inherited; + end; + + function TFileLocator.FileExists(filename: FilenameString): boolean; + var + idx: Integer; + begin + if LeftStr(filename, length(basedirectory)) = basedirectory then + begin + // Cut off basedirectory if the file is located beneath that base directory + filename := MidStr(filename, length(basedirectory) + 1, maxint); + end; + Result := filelist.Find(filename, idx); + end; + + function TFileLocator.GetMoFile(filename: FilenameString; + DebugLogger: TDebugLogger): TMoFile; + var + fi: TEmbeddedFileInfo; + idx: Integer; + idxname: FilenameString; + Offset, Size: int64; + realfilename: FilenameString; + begin + // Find real filename + Offset := 0; + Size := 0; + realfilename := filename; + if LeftStr(filename, length(basedirectory)) = basedirectory then + begin + filename := MidStr(filename, length(basedirectory) + 1, maxint); + idx := filelist.IndexOf(filename); + if idx <> -1 then + begin + fi := filelist.Objects[idx] as TEmbeddedFileInfo; + realfilename := ExecutableFilename; + Offset := fi.Offset; + Size := fi.Size; +{$IFDEF DXGETTEXTDEBUG} + DebugLogger('Instead of ' + filename + ', using ' + realfilename + + ' from offset ' + IntToStr(Offset) + ', size ' + IntToStr(Size)); +{$ENDIF} + end; + end; + +{$IFDEF DXGETTEXTDEBUG} + DebugLogger('Reading .mo data from file ''' + filename + ''''); +{$ENDIF} + // Find TMoFile object + MoFilesCS.BeginWrite; + try + idxname := realfilename + ' //\\ ' + IntToStr(Offset); + if MoFiles.Find(idxname, idx) then + begin + Result := MoFiles.Objects[idx] as TMoFile; + end + else + begin + Result := TMoFile.Create(realfilename, Offset, Size, + UseMemoryMappedFiles); + MoFiles.AddObject(idxname, Result); + end; + inc(Result.Users); + finally + MoFilesCS.EndWrite; + end; + end; + + function TFileLocator.ReadInt64(str: TStream): int64; + begin + Assert(SizeOf(Result) = 8); + str.ReadBuffer(Result, 8); + end; + + procedure TFileLocator.ReleaseMoFile(mofile: TMoFile); + var + i: Integer; + begin + Assert(mofile <> nil); + + MoFilesCS.BeginWrite; + try + dec(mofile.Users); + if mofile.Users <= 0 then + begin + i := MoFiles.Count - 1; + while i >= 0 do + begin + if MoFiles.Objects[i] = mofile then + begin + MoFiles.delete(i); + FreeAndNil(mofile); + break; + end; + dec(i); + end; + end; + finally + MoFilesCS.EndWrite; + end; + end; + + { TTP_Retranslator } + + constructor TTP_Retranslator.Create; + begin + list := TList.Create; + end; + + destructor TTP_Retranslator.Destroy; + var + i: Integer; + begin + for i := 0 to list.Count - 1 do + TObject(list.Items[i]).Free; + FreeAndNil(list); + inherited; + end; + + procedure TTP_Retranslator.Execute; + var + i: Integer; + sl: TStrings; + item: TTP_RetranslatorItem; + newvalue: TranslatedUnicodeString; + comp: TGnuGettextComponentMarker; + ppi: PPropInfo; + begin + for i := 0 to list.Count - 1 do + begin + item := TObject(list.Items[i]) as TTP_RetranslatorItem; + if not Assigned(item.obj) then + continue; // JR 20223-04-18 to avoid protection faults + if item.obj is TComponent then + begin + comp := TComponent(item.obj).FindComponent('GNUgettextMarker') + as TGnuGettextComponentMarker; + if Assigned(comp) and (self <> comp.Retranslator) then + begin + comp.Retranslator.Execute; + continue; + end; + end; + if item.obj is TStrings then + begin + // Since we don't know the order of items in sl, and don't have + // the original .Objects[] anywhere, we cannot anticipate anything + // about the current sl.Strings[] and sl.Objects[] values. We therefore + // have to discard both values. We can, however, set the original .Strings[] + // value into the list and retranslate that. + sl := TStringList.Create; + try + sl.Text := item.OldValue; + Instance.TranslateStrings(sl, textdomain); + (item.obj as TStrings).BeginUpdate; + try + (item.obj as TStrings).Text := sl.Text; + finally + (item.obj as TStrings).EndUpdate; + end; + finally + FreeAndNil(sl); + end; + end + else + begin + if (textdomain = '') or (textdomain = DefaultTextDomain) then + newvalue := ComponentGettext(item.OldValue, Instance) + else + newvalue := Instance.dgettext(textdomain, item.OldValue); + ppi := GetPropInfo(item.obj, item.Propname); + if ppi <> nil then + begin + SetWideStrProp(item.obj, ppi, newvalue); + end + else + begin +{$IFDEF DXGETTEXTDEBUG} + Instance.DebugWriteln + ('ERROR: On retranslation, property disappeared: ' + + item.Propname + ' for object of type ' + item.obj.ClassName); +{$ENDIF} + end; + end; + end; + end; + + procedure TTP_Retranslator.Remember(obj: TObject; + Propname: ComponentNameString; OldValue: TranslatedUnicodeString); + var + item: TTP_RetranslatorItem; + begin + item := TTP_RetranslatorItem.Create; + item.obj := obj; + item.Propname := Propname; + item.OldValue := OldValue; + list.Add(item); + end; + + { TGnuGettextComponentMarker } + + destructor TGnuGettextComponentMarker.Destroy; + begin + FreeAndNil(Retranslator); + inherited; + end; + + { THook } + + constructor THook.Create(OldProcedure, NewProcedure: pointer; + FollowJump: boolean = false); + { Idea and original code from Igor Siticov } + { Modified by Jacques Garcia Vazquez and Lars Dybdahl } + begin +{$IFNDEF CPU386} +{$IFNDEF CPUx64} + raise Exception.Create + ('This procedure only works on Intel i386 or x64 compatible processors.'); +{$ENDIF} +{$ENDIF} + oldproc := OldProcedure; + newproc := NewProcedure; + + Reset(FollowJump); + end; + + destructor THook.Destroy; + begin + Shutdown; + inherited; + end; + + procedure THook.Disable; + begin + Assert(PatchPosition <> nil, + 'Patch position in THook was nil when Disable was called'); + PatchPosition[0] := Original[0]; + PatchPosition[1] := Original[1]; + PatchPosition[2] := Original[2]; + PatchPosition[3] := Original[3]; + PatchPosition[4] := Original[4]; + end; + + procedure THook.Enable; + begin + Assert(PatchPosition <> nil, + 'Patch position in THook was nil when Enable was called'); + PatchPosition[0] := Patch[0]; + PatchPosition[1] := Patch[1]; + PatchPosition[2] := Patch[2]; + PatchPosition[3] := Patch[3]; + PatchPosition[4] := Patch[4]; + end; + + procedure THook.Reset(FollowJump: boolean); + var + Offset: Integer; +{$IFDEF LINUX} + p: pointer; + pagesize: Integer; +{$ENDIF} +{$IFDEF MSWindows} + ov: Cardinal; +{$ENDIF} + begin + if PatchPosition <> nil then + Shutdown; + + PatchPosition := oldproc; + if FollowJump and (Word(oldproc^) = $25FF) then + begin + // This finds the correct procedure if a virtual jump has been inserted + // at the procedure address + inc(PatchPosition, 2); // skip the jump + PatchPosition := PAnsiChar(pointer(pointer(PatchPosition)^)^); + end; + Offset := Integer(newproc) - Integer(pointer(PatchPosition)) - 5; + + Patch[0] := ansichar($E9); + Patch[1] := ansichar(Offset and 255); + Patch[2] := ansichar((Offset shr 8) and 255); + Patch[3] := ansichar((Offset shr 16) and 255); + Patch[4] := ansichar((Offset shr 24) and 255); + + Original[0] := PatchPosition[0]; + Original[1] := PatchPosition[1]; + Original[2] := PatchPosition[2]; + Original[3] := PatchPosition[3]; + Original[4] := PatchPosition[4]; + +{$IFDEF MSWINDOWS} + if not VirtualProtect(pointer(PatchPosition), 5, + PAGE_EXECUTE_READWRITE, @ov) then + RaiseLastOSError; +{$ENDIF} +{$IFDEF LINUX} + pagesize := sysconf(_SC_PAGE_SIZE); + p := pointer(PatchPosition); + p := pointer((Integer(p) + pagesize - 1) and not(pagesize - 1) - + pagesize); + if mprotect(p, pagesize, PROT_READ + PROT_WRITE + PROT_EXEC) <> 0 then + RaiseLastOSError; +{$ENDIF} + end; + + procedure THook.Shutdown; + begin + Disable; + PatchPosition := nil; + end; + + procedure HookIntoResourceStrings(enabled: boolean = True; + SupportPackages: boolean = false); + begin + HookLoadResString.Reset(SupportPackages); + HookLoadStr.Reset(SupportPackages); + HookFmtLoadStr.Reset(SupportPackages); + if enabled then + begin + HookLoadResString.Enable; + HookLoadStr.Enable; + HookFmtLoadStr.Enable; + end; + end; + + { TMoFile } + + function TMoFile.autoswap32(i: Cardinal): Cardinal; + var + cnv1, cnv2: record case Integer of 0: (arr: array [0 .. 3] of byte); + 1: (int: Cardinal); + end; + + begin + if doswap then + begin + cnv1.int := i; + cnv2.arr[0] := cnv1.arr[3]; + cnv2.arr[1] := cnv1.arr[2]; + cnv2.arr[2] := cnv1.arr[1]; + cnv2.arr[3] := cnv1.arr[0]; + Result := cnv2.int; + end + else + Result := i; + end; + + function TMoFile.CardinalInMem(baseptr: PAnsiChar; Offset: Cardinal) + : Cardinal; + var + pc: ^Cardinal; + begin + inc(baseptr, Offset); + pc := pointer(baseptr); + Result := pc^; + if doswap then + autoswap32(Result); + end; + + constructor TMoFile.Create(const filename: FilenameString; + const Offset: int64; Size: int64; const xUseMemoryMappedFiles: boolean); + var + i: Cardinal; + nn: Integer; + mofile: TFileStream; + begin + if SizeOf(i) <> 4 then + raise EGGProgrammingError.Create + ('TDomain in gnugettext is written for an architecture that has 32 bit integers.'); + +{$IFDEF mswindows} + FUseMemoryMappedFiles := xUseMemoryMappedFiles; +{$ENDIF} +{$IFDEF linux} + FUseMemoryMappedFiles := false; +{$ENDIF} + if FUseMemoryMappedFiles then + begin + // Map the mo file into memory and let the operating system decide how to cache + mo := createfile(PChar(filename), GENERIC_READ, FILE_SHARE_READ, nil, + OPEN_EXISTING, 0, 0); + if mo = INVALID_HANDLE_VALUE then + raise EGGIOError.Create('Cannot open file ' + filename); + momapping := CreateFileMapping(mo, nil, PAGE_READONLY, 0, 0, nil); + if momapping = 0 then + raise EGGIOError.Create('Cannot create memory map on file ' + filename); + momemoryHandle := MapViewOfFile(momapping, FILE_MAP_READ, 0, 0, 0); + if momemoryHandle = nil then + begin + raise EGGIOError.Create('Cannot map file ' + filename + + ' into memory. Reason: ' + GetLastWinError); + end; + momemory := momemoryHandle + Offset; + end + else + begin + // Read the whole file into memory + mofile := TFileStream.Create(filename, fmOpenRead or fmShareDenyNone); + try + if (Size = 0) then + Size := mofile.Size; + Getmem(momemoryHandle, Size); + momemory := momemoryHandle; + mofile.Seek(Offset, soFromBeginning); + mofile.ReadBuffer(momemory^, Size); + finally + FreeAndNil(mofile); + end; + end; + + // Check the magic number + doswap := false; + i := CardinalInMem(momemory, 0); + if (i <> $950412DE) and (i <> $DE120495) then + raise EGGIOError.Create('This file is not a valid GNU gettext mo file: ' + + filename); + doswap := (i = $DE120495); + + // Find the positions in the file according to the file format spec + CardinalInMem(momemory, 4); + // Read the version number, but don't use it for anything. + N := CardinalInMem(momemory, 8); // Get string count + O := CardinalInMem(momemory, 12); // Get offset of original strings + T := CardinalInMem(momemory, 16); // Get offset of translated strings + + // Calculate start conditions for a binary search + nn := N; + startindex := 1; + while nn <> 0 do + begin + nn := nn shr 1; + startindex := startindex shl 1; + end; + startindex := startindex shr 1; + startstep := startindex shr 1; + end; + + destructor TMoFile.Destroy; + begin + if FUseMemoryMappedFiles then + begin + UnMapViewOfFile(momemoryHandle); + try + CloseHandle(momapping); + except + end; + try + CloseHandle(mo); + except + end; + end + else + begin + FreeMem(momemoryHandle); + end; + + inherited; + end; + + function TMoFile.gettext(const msgid: RawUtf8String; var found: boolean) + : RawUtf8String; + var + i, step: Cardinal; + Offset, pos: Cardinal; + CompareResult: Integer; + msgidptr, a, b: PAnsiChar; + abidx: Integer; + Size, msgidsize: Integer; + begin + found := false; + msgidptr := PAnsiChar(msgid); + msgidsize := length(msgid); + + // Do binary search + i := startindex; + step := startstep; + while True do + begin + // Get string for index i + pos := O + 8 * (i - 1); + Offset := CardinalInMem(momemory, pos + 4); + Size := CardinalInMem(momemory, pos); + a := msgidptr; + b := momemory + Offset; + abidx := Size; + if msgidsize < abidx then + abidx := msgidsize; + CompareResult := 0; + while abidx <> 0 do + begin + CompareResult := Integer(byte(a^)) - Integer(byte(b^)); + if CompareResult <> 0 then + break; + dec(abidx); + inc(a); + inc(b); + end; + if CompareResult = 0 then + CompareResult := msgidsize - Size; + if CompareResult = 0 then + begin // msgid=s + // Found the msgid + pos := T + 8 * (i - 1); + Offset := CardinalInMem(momemory, pos + 4); + Size := CardinalInMem(momemory, pos); + SetString(Result, momemory + Offset, Size); + found := True; + break; + end; + if step = 0 then + begin + // Not found + Result := msgid; + break; + end; + if CompareResult < 0 then + begin // msgids + i := i + step; + if i > N then + i := N; + step := step shr 1; + end; + end; + end; + +var + param0: string; + +initialization + +{$IFDEF DXGETTEXTDEBUG} +{$IFDEF MSWINDOWS} + MessageBox(0, + 'gnugettext.pas debugging is enabled. Turn it off before releasing this piece of software.', + 'Information', MB_OK); +{$ENDIF} +{$IFDEF LINUX} +writeln(stderr, + 'gnugettext.pas debugging is enabled. Turn it off before releasing this piece of software.'); +{$ENDIF} +{$ENDIF} +{$IFDEF FPC} +{$IFDEF LINUX} +SetLocale(LC_ALL, ''); +SetCWidestringManager; +{$ENDIF LINUX} +{$ENDIF FPC} +// Get DLL/shared object filename +SetLength(ExecutableFilename, 300); // MAX_PATH ? +{$IFDEF MSWINDOWS} +SetLength(ExecutableFilename, GetModuleFileName(HInstance, + PChar(ExecutableFilename), length(ExecutableFilename))); +{$ENDIF} +{$IFDEF LINUX} +if ModuleIsLib or ModuleIsPackage then +begin + // This line has not been tested on Linux, yet, but should work. + SetLength(ExecutableFilename, GetModuleFileName(0, PChar(ExecutableFilename), + length(ExecutableFilename))); +end +else + ExecutableFilename := Paramstr(0); +{$ENDIF} +FileLocator := TFileLocator.Create; +FileLocator.Analyze; +ResourceStringDomainList := TStringList.Create; +ResourceStringDomainList.Add(DefaultTextDomain); +ResourceStringDomainListCS := TMultiReadExclusiveWriteSynchronizer.Create; +ComponentDomainList := TStringList.Create; +ComponentDomainList.Add(DefaultTextDomain); +ComponentDomainListCS := TMultiReadExclusiveWriteSynchronizer.Create; +DefaultInstance := TGnuGettextInstance.Create; +{$IFDEF MSWINDOWS} +Win32PlatformIsUnicode := (Win32Platform = VER_PLATFORM_WIN32_NT); +{$ENDIF} + +// replace Borlands LoadResString with gettext enabled version: +{$IFDEF UNICODE} +HookLoadResString := THook.Create(@System.LoadResString, @LoadResStringW); +{$ELSE} +HookLoadResString := THook.Create(@System.LoadResString, @LoadResStringA); +{$ENDIF} +HookLoadStr := THook.Create(@System.SysUtils.LoadStr, @SysUtilsLoadStr); +HookFmtLoadStr := THook.Create(@System.SysUtils.FmtLoadStr, + @SysUtilsFmtLoadStr); +param0 := lowercase(extractfilename(Paramstr(0))); +if (param0 <> 'delphi32.exe') and (param0 <> 'kylix') and (param0 <> 'bds.exe') +then + HookIntoResourceStrings(AutoCreateHooks, false); +param0 := ''; + +finalization + +FreeAndNil(DefaultInstance); +FreeAndNil(ResourceStringDomainListCS); +FreeAndNil(ResourceStringDomainList); +FreeAndNil(ComponentDomainListCS); +FreeAndNil(ComponentDomainList); +FreeAndNil(HookFmtLoadStr); +FreeAndNil(HookLoadStr); +FreeAndNil(HookLoadResString); +FreeAndNil(FileLocator); + +end. diff --git a/Source/gnuGettextInit.pas b/Source/gnuGettextInit.pas new file mode 100644 index 00000000..33ce9fd7 --- /dev/null +++ b/Source/gnuGettextInit.pas @@ -0,0 +1,41 @@ +(* Delphi-Unit - + Initialization for GnuGetText + ============================= + + © Dr. J. Rathlev, D-24222 Schwentinental (kontakt(a)rathlev-home.de) + + The contents of this file may be used under the terms of the + Mozilla Public License ("MPL") or + GNU Lesser General Public License Version 2 or later (the "LGPL") + + Software distributed under this License is distributed on an "AS IS" basis, + WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for + the specific language governing rights and limitations under the License. + + Vers. 1 - July 2023 + last mdified: July 2023 + *) + +unit GnuGetTextInit; + +interface + +// InitTranslation has to be placed in the project file before "Application.Initialize" +// "Domains" is a list of all po/mo files needed by the application +// Calling sample: InitTranslation(['delphi10','indy10']); +procedure InitTranslation (const Domains : array of string); + +implementation + +uses GnuGetText; + +{ ------------------------------------------------------------------- } +// InitTranslation has to be placed in the project file before "Application.Initialize" +procedure InitTranslation (const Domains : array of string); +var + i : integer; +begin + for i:=0 to High(Domains) do AddDomainForResourceString(Domains[i]); + end; + +end. diff --git a/Sourcex/FMxShaderUniformEditor.pas b/Sourcex/FMxShaderUniformEditor.pas index 59977220..e367a437 100644 --- a/Sourcex/FMxShaderUniformEditor.pas +++ b/Sourcex/FMxShaderUniformEditor.pas @@ -22,7 +22,7 @@ interface FMX.Controls.Presentation, GXSL.Parameter, - GXS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorGeometry, GLScene.Strings; diff --git a/Sourcex/FRxTextureEdit.pas b/Sourcex/FRxTextureEdit.pas index c9c2c6b4..3200c2e3 100644 --- a/Sourcex/FRxTextureEdit.pas +++ b/Sourcex/FRxTextureEdit.pas @@ -25,7 +25,7 @@ interface FMX.ListBox, FMX.Controls.Presentation, GXS.Graphics, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.Texture, GXS.TextureImageEditors; diff --git a/Sourcex/Formatx.B3D.pas b/Sourcex/Formatx.B3D.pas deleted file mode 100644 index 8954d7ed..00000000 --- a/Sourcex/Formatx.B3D.pas +++ /dev/null @@ -1,684 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.B3D; - -(* File streaming class for the B3D loader *) - -interface - -{$I GLScene.Defines.inc} - -{$R-} - -uses - System.Classes, - System.SysUtils, - - GLScene.VectorGeometry, - GLScene.VectorTypes, - GLScene.VectorLists; - - -type - TB3DChunkType = (bctUnknown, bctHeader, bctTexture, bctBrush, bctNode, bctVertex, bctTriangle, - bctMesh, bctBone, bctKeyFrame, bctAnimation); - - PB3DChunk = ^TB3DChunk; - TB3DChunk = record - chunk: array[0..3] of char; - length: Integer; - end; - - PBB3DChunk = ^TBB3DChunk; - TBB3DChunk = record - Version: Integer; - end; - - PTEXSChunk = ^TTEXSChunk; - TTEXSChunk = record - fileName: array[0..255] of char; //texture file name this is the filename of the texture, ie "wall.bmp" Has to be in the local Directory - flags, blend: Integer; //blitz3D TextureFLags and TextureBlend: default=1,2 - //these are the same as far as I know as the flags for a texture in Blitz3D - x_pos, y_pos: Single; //x and y position of texture: default=0,0 - x_scale, y_scale: Single; //x and y scale of texture: default=1,1 - rotation: Single; //rotation of texture (in radians): default=0 radian = 180/pi degrees - end; - - PBRUSChunk = ^TBRUSChunk; - TBRUSChunk = record - n_texs: Integer; - name: array[0..255] of Char; //eg "WATER" - just use texture name by default - red, green, blue, alpha: Single; //Blitz3D Brushcolor and Brushalpha: default=1,1,1,1 - shininess: Single; //Blitz3D BrushShininess: default=0 - blend, fx: Integer; //Blitz3D Brushblend and BrushFX: default=1,0 - texture_id: array of Integer; //textures used in brush, ie if there is more then one texture used, ie Alphamaps, colour maps etc, - //you put all ID's here as ints. - end; - - PVertexData = ^TVertexData; - TVertexData = record - next: PVertexData; - x, y, z: Single; //always present - nx, ny, nz: Single; //vertex normal: present if (flags&1) - red, green, blue, alpha: Single; //vertex color: present if (flags&2) - tex_coords: array of Single; //tex coords - end; - - PVRTSChunk = ^TVRTSChunk; - TVRTSChunk = record - flags: Integer; //1=normal values present, 2=rgba values present - tex_coord_sets: Integer; //texture coords per vertex (eg: 1 for simple U/V) max=8 - tex_coord_set_size: Integer; //components per set (eg: 2 for simple U/V) max=4 - vertices: PVertexData; - end; - - PTRISChunk = ^TTRISChunk; - TTRISChunk = record - next: PTRISChunk; - brush_id: Integer; //brush applied to these TRIs: default=-1 - vertex_id: array of Integer; //vertex indices - end; - - PMESHChunk = ^TMESHChunk; - TMESHChunk = record - brush_id: Integer; //'master' brush: default=-1 - vertices: TVRTSChunk; //vertices - triangles: PTRISChunk; //1 or more sets of triangles - end; - - PBONEChunk = ^TBONEChunk; - TBONEChunk = record - vertex_id: Integer; //vertex affected by this bone - weight: Single; //;how much the vertex is affected - end; - - PKEYSChunk = ^TKEYSChunk; - TKEYSChunk = record - next: PKEYSChunk; - flags: Integer; //1=position, 2=scale, 4=rotation - frame: Integer; //where key occurs - position: TAffineVector; //present if (flags&1) - scale: TAffineVector; //present if (flags&2) - rotation: TVector4f; //present if (flags&4) - end; - - PANIMChunk = ^TANIMChunk; - TANIMChunk = record - flags: Integer; //unused: default=0 - frames: Integer; //how many frames in anim - fps: Single; //default=60 - end; - - PNODEChunk = ^TNODEChunk; - TNODEChunk = record - name: array[0..255] of char; //name of node - position: TAffineVector; //local... - scale: TAffineVector; //coord... - rotation: TVector4f; //system... - //array of node elements - //should be one of meshes or bones, support meshes only for now - meshes: PMESHChunk; //what 'kind' of node this is - if unrecognized, just use a Blitz3D pivot. - (* - not supprot yet - bones: PBONEChunk; - *) - keys: PKEYSChunk; //optional animation keys - nodes: PNODEChunk; //optional child nodes - animation: TANIMChunk; //optional animation - next: PNODEChunk; //point to the next node - level: Integer; - end; - -type - TB3DMaterial = class - public - MaterialData: TBRUSChunk; - constructor Create; - destructor Destroy; override; - function GetMaterialName: string; - end; - - TB3DTexture = class - public - TextureData: TTEXSChunk; - constructor Create; - destructor Destroy; override; - function GetTextureName: string; - end; - - TB3DNode = class - public - NodeData: PNODEChunk; - constructor Create; - destructor Destroy; override; - function GetNodeName: string; - procedure DestroyNodeData(Node: PNODEChunk); - end; - - TFileB3D = class - private - fTextures: TStringList; - fMaterials: TStringList; - fNodes: TB3DNode; - procedure FreeLists; - function GetChunkType(const aChunk: TB3DChunk): TB3DChunkType; - function SkipChunk(aStream: TStream; const aChunk: TB3DChunk): Integer; - function ReadTextureChunk(aStream: TStream; const aChunk: TB3DChunk): Integer; - function ReadMaterialChunk(aStream: TStream; const aChunk: TB3DChunk): Integer; - function ReadNodeChunk(aStream: TStream; const aChunk: TB3DChunk; Node: PNODEChunk; level: Integer): Integer; - function ReadMeshChunk(aStream: TStream; const aChunk: TB3DChunk; Mesh: PMESHChunk): Integer; - function ReadVerticesChunk(aStream: TStream; const aChunk: TB3DChunk; Vertices: PVRTSChunk): Integer; - function ReadTrianglesChunk(aStream: TStream; const aChunk: TB3DChunk; Triangle: PTRISChunk): Integer; - public - constructor Create; virtual; - destructor Destroy; override; - procedure LoadFromStream(aStream : TStream); - //for test only - procedure Check; - - property Textures: TStringList read fTextures; - property Materials: TStringList read fMaterials; - property Nodes: TB3DNode read fNodes; - end; - -//----------------------------------------------------------------------- -implementation -//----------------------------------------------------------------------- - -constructor TB3DMaterial.Create; -begin - inherited Create; - fillChar(MaterialData, sizeof(TBRUSChunk), 0); -end; - -destructor TB3DMaterial.Destroy; -begin - SetLength(MaterialData.texture_id, 0); - inherited Destroy; -end; - -function TB3DMaterial.GetMaterialName: string; -begin - SetString(Result, MaterialData.name, strlen(MaterialData.name)); -end; - -constructor TB3DTexture.Create; -begin - inherited Create; - fillChar(TextureData, sizeof(TTEXSChunk), 0); -end; - -destructor TB3DTexture.Destroy; -begin - inherited Destroy; -end; - -function TB3DTexture.GetTextureName: string; -begin - SetString(Result, TextureData.fileName, strlen(TextureData.fileName)); -end; - -constructor TB3DNode.Create; -begin - inherited Create; - NodeData := nil; -end; - -destructor TB3DNode.Destroy; -begin - DestroyNodeData(NodeData); - inherited Destroy; -end; - -function TB3DNode.GetNodeName: string; -begin - SetString(Result, NodeData^.name, strlen(NodeData^.name)); -end; - -procedure DeleteVertices(var aVertex: PVertexData); -var - V: PVertexData; -begin - while aVertex<>nil do - begin - SetLength(aVertex^.tex_coords, 0); - V := aVertex^.next; - freeMem(aVertex); - aVertex := nil; - DeleteVertices(V); - end; -end; - -procedure DeleteTriangles(var aTriangle: PTRISChunk); -var - T: PTRISChunk; -begin - while aTriangle<>nil do - begin - SetLength(aTriangle^.vertex_id, 0); - T := aTriangle^.next; - freeMem(aTriangle); - aTriangle := nil; - DeleteTriangles(T); - end; -end; - -procedure TB3DNode.DestroyNodeData(Node: PNODEChunk); -var - oldNode, PNode: PNODEChunk; -begin - PNode := Node; - while PNode<>nil do - begin - if PNode^.meshes<>nil then - begin - DeleteTriangles(PNode^.meshes^.triangles); - DeleteVertices(PNode^.meshes^.vertices.vertices); - freeMem(PNode^.meshes); - PNode^.meshes := nil; - end; - if PNode^.keys<>nil then - freeMem(PNode^.keys); - DestroyNodeData(PNode^.nodes); - oldNode := PNode; - PNode := PNode^.next; - freeMem(oldNode); - end; -end; - -//------------------------------------------------------------------------------ -constructor TFileB3D.Create; -begin - inherited Create; - fTextures := TStringList.Create; - fMaterials := TStringList.Create; - fNodes := TB3DNode.Create; -end; - -destructor TFileB3D.Destroy; -begin - FreeLists; - fTextures.free; - fMaterials.free; - fNodes.free; - inherited Destroy; -end; - -function TFileB3D.GetChunkType(const aChunk: TB3DChunk): TB3DChunkType; -begin - Result := bctUnKnown; - if StrLIComp(aChunk.chunk, 'BB3D', 4)=0 then - Result := bctHeader; - if StrLIComp(aChunk.chunk, 'TEXS', 4)=0 then - Result := bctTexture; - if StrLIComp(aChunk.chunk, 'BRUS', 4)=0 then - Result := bctBrush; - if StrLIComp(aChunk.chunk, 'NODE', 4)=0 then - Result := bctNode; - if StrLIComp(aChunk.chunk, 'VRTS', 4)=0 then - Result := bctVertex; - if StrLIComp(aChunk.chunk, 'BONE', 4)=0 then - Result := bctBone; - if StrLIComp(aChunk.chunk, 'KEYS', 4)=0 then - Result := bctKeyFrame; - if StrLIComp(aChunk.chunk, 'ANIM', 4)=0 then - Result := bctAnimation; - if StrLIComp(aChunk.chunk, 'MESH', 4)=0 then - Result := bctMesh; - if StrLIComp(aChunk.chunk, 'TRIS', 4)=0 then - Result := bctTriangle; -end; - -function TFileB3D.SkipChunk(aStream: TStream; const aChunk: TB3DChunk): Integer; -begin - aStream.Seek(aChunk.length, soFromCurrent); - Result := aChunk.length; -end; - -function ReadString(aStream: TStream; buffer: PChar; MaxCount: Integer): Integer; -begin - Result := 0; - while Result0 then begin - Inc(Result, aStream.Read(v1^.nx, sizeof(single))); - Inc(Result, aStream.Read(v1^.ny, sizeof(single))); - Inc(Result, aStream.Read(v1^.nz, sizeof(single))); - end; - if (Vertices^.flags and 2)>0 then begin - Inc(Result, aStream.Read(v1^.red, sizeof(single))); - Inc(Result, aStream.Read(v1^.green, sizeof(single))); - Inc(Result, aStream.Read(v1^.blue, sizeof(single))); - Inc(Result, aStream.Read(v1^.alpha, sizeof(single))); - end; - //W3D END - SetLength(v1^.tex_coords, size); - Inc(Result, aStream.Read(v1^.tex_coords[0], size*sizeof(single))); - end; -end; - -function TFileB3D.ReadTrianglesChunk(aStream: TStream; const aChunk: TB3DChunk; Triangle: PTRISChunk): Integer; -begin - Result := 0; - if Triangle=nil then - begin - GetMem(Triangle, sizeof(TTRISChunk)); - fillChar(Triangle^, sizeof(TTRISChunk), 0); - Triangle^.brush_id := -1; - end; - Inc(Result, aStream.Read(Triangle^.brush_id, sizeof(Integer))); - SetLength(Triangle^.vertex_id, (aChunk.length-Result) div sizeof(Integer)); - Inc(Result, aStream.Read(Triangle^.vertex_id[0], (aChunk.length-Result))); -end; - -//read in only the mesh data, the keyframes and animation had been dropped -function TFileB3D.ReadNodeChunk(aStream: TStream; const aChunk: TB3DChunk; Node: PNODEChunk; level: Integer): Integer; -var - Count: Integer; - C: TB3DChunk; - N: PNODEChunk; -begin - N := nil; - fillChar(Node^, sizeof(TNODEChunk), 0); - Node^.level := level; - Count := 0; - Inc(Count, ReadString(aStream, Node^.name, 255)); - Inc(Count, aStream.Read(Node^.position.X, sizeof(TAffineVector))); - Inc(Count, aStream.Read(Node^.scale.X, sizeof(TAffineVector))); - Inc(Count, aStream.Read(Node^.rotation.X, sizeof(TVector4f))); - while Count0 do - begin - fTextures.Objects[0].free; - ftextures.Delete(0); - end; - while fMaterials.Count>0 do - begin - fMaterials.Objects[0].free; - fMaterials.Delete(0); - end; -end; - -//for test only -procedure TFileB3D.Check; -var - NodeLevel: Integer; -// NodeCount: Integer; - Node: PNODEChunk; -// VerticesCount: Integer; -// FaceCount: Integer; - Face: PTRISChunk; - Vertex: PVertexData; -begin - NodeLevel := 0; -// NodeCount := 0; -// VerticesCount := 0; -// FaceCount := 0; - Node := fNodes.NodeData; - while Node<>nil do - begin - if Node^.meshes<>nil then -// Inc(NodeCount); - if Node^.level>NodeLevel then - NodeLevel := Node^.level; - if Node^.meshes<>nil then - begin - Vertex := Node^.meshes.vertices.vertices; - while Vertex<>nil do - begin -// Inc(VerticesCount); - Vertex := Vertex.next; - end; - Face := Node^.meshes.triangles; - while Face<>nil do - begin -// Inc(FaceCount); - Face := Face.next; - end; - end; - Node := Node^.next; - end; - - //MessageBeep(FaceCount); - //MessageBeep(VerticesCount); - //MessageBeep(NodeLevel); - //MessageBeep(NodeCount); -end; - -end. diff --git a/Sourcex/Formatx.DDSImage.pas b/Sourcex/Formatx.DDSImage.pas index 87a8182c..b01dac9d 100644 --- a/Sourcex/Formatx.DDSImage.pas +++ b/Sourcex/Formatx.DDSImage.pas @@ -27,13 +27,13 @@ interface GLScene.VectorGeometry, GXS.Graphics, GXS.Context, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.FileDDS, - Formatx.DXTC; + Formats.DXTC; -type +type TDDSImage = class(TBitmap) public procedure LoadFromStream(stream: TStream); //override; -> E2170 Cannot override a non-virtual method override; @@ -42,9 +42,7 @@ TDDSImage = class(TBitmap) EDDSException = class(Exception); -//----------------------------------------------------------------------- -implementation -//----------------------------------------------------------------------- +implementation //------------------------------------------------------------- // ------------------ // ------------------ TDDSImage ------------------ @@ -141,24 +139,20 @@ procedure TDDSImage.SaveToStream(stream: TStream); dwCaps := DDSCAPS_TEXTURE; stream.Write(header, SizeOf(TDDSHeader)); for i := 0 to Height - 1 do - // TODO : E2003 Undeclared identifier: 'ScanLine' + // TODO : E2003 Undeclared identifier: 'ScanLine' (* stream.Write(ScanLine[i]^, rowSize);*) end; end; -// ------------------------------------------------------------------ -initialization -// ------------------------------------------------------------------ +initialization // ------------------------------------------------------------- - // TODO : E2003 Undeclared identifier: 'RegisterFileFormat' + // TODO : E2003 Undeclared identifier: 'RegisterFileFormat' (* TPicture.RegisterFileFormat( 'dds', 'Microsoft DirectDraw Surface', TDDSImage); *) -// ------------------------------------------------------------------ -finalization -// ------------------------------------------------------------------ +finalization // -------------------------------------------------------------- // TODO : E2003 Undeclared identifier: 'UnregisterGraphicClass' (* diff --git a/Sourcex/Formatx.DXTC.pas b/Sourcex/Formatx.DXTC.pas deleted file mode 100644 index 22554396..00000000 --- a/Sourcex/Formatx.DXTC.pas +++ /dev/null @@ -1,1263 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.DXTC; -(* - DXTC (also S3TC) decoding. - Adapted from DevIL image library (http://openil.sourceforge.net) -*) -interface - -{.$I GLScene.Defines.inc} -{$Z4} // Minimum enum size = dword - -uses - Winapi.OpenGL, - Winapi.OpenGLext, - System.SysUtils, - - GXS.TextureFormat; - -const - DDSD_CAPS = $00000001; - DDSD_HEIGHT = $00000002; - DDSD_WIDTH = $00000004; - DDSD_PITCH = $00000008; - DDSD_PIXELFORMAT = $00001000; - DDSD_MIPMAPCOUNT = $00020000; - DDSD_LINEARSIZE = $00080000; - DDSD_DEPTH = $00800000; - - DDPF_ALPHAPIXELS = $00000001; - DDPF_A = $00000002; - DDPF_FOURCC = $00000004; - DDPF_RGB = $00000040; - DDPF_RGBA = $00000041; - DDPF_L = $00020000; - DDPF_LA = $00020001; - - DDSCAPS_COMPLEX = $00000008; - DDSCAPS_TEXTURE = $00001000; - DDSCAPS_MIPMAP = $00400000; - - DDSCAPS2_CUBEMAP = $00000200; - DDSCAPS2_CUBEMAP_POSITIVEX = $00000400; - DDSCAPS2_CUBEMAP_NEGATIVEX = $00000800; - DDSCAPS2_CUBEMAP_POSITIVEY = $00001000; - DDSCAPS2_CUBEMAP_NEGATIVEY = $00002000; - DDSCAPS2_CUBEMAP_POSITIVEZ = $00004000; - DDSCAPS2_CUBEMAP_NEGATIVEZ = $00008000; - DDSCAPS2_VOLUME = $00200000; - -type - TDDPIXELFORMAT = record - dwSize, dwFlags, dwFourCC, dwRGBBitCount, dwRBitMask, dwGBitMask, dwBBitMask, - dwRGBAlphaBitMask: Cardinal; - end; - - TDDSURFACEDESC2 = record - dwSize, dwFlags, dwHeight, dwWidth, dwPitchOrLinearSize, - (* The number of bytes per scan line in an - uncompressed texture; the total number of bytes - in the top level texture for a compressed texture. *) - dwDepth, dwMipMapCount: Cardinal; - dwReserved1: array [0 .. 10] of Cardinal; - ddpf: TDDPIXELFORMAT; - dwCaps, dwCaps2, dwCaps3, dwCaps4: Cardinal; - dwReserved2: Cardinal; - end; - - TDDSHeader = record - Magic: Cardinal; - SurfaceFormat: TDDSURFACEDESC2; - end; - - DXTColBlock = record - col0: Word; - col1: Word; - row: array [0 .. 3] of Byte; - end; - - PDXTColBlock = ^DXTColBlock; - - DXT3AlphaBlock = record - row: array [0 .. 3] of Word; - end; - - PDXT3AlphaBlock = ^DXT3AlphaBlock; - - DXT5AlphaBlock = record - alpha0: Byte; - alpha1: Byte; - row: array [0 .. 5] of Byte; - end; - - PDXT5AlphaBlock = ^DXT5AlphaBlock; - -const - // TDXGI_FORMAT = - // ( - DXGI_FORMAT_FORCE_UINT = -1; - DXGI_FORMAT_UNKNOWN = 0; - DXGI_FORMAT_R32G32B32A32_TYPELESS = 1; - DXGI_FORMAT_R32G32B32A32_FLOAT = 2; - DXGI_FORMAT_R32G32B32A32_UINT = 3; - DXGI_FORMAT_R32G32B32A32_SINT = 4; - DXGI_FORMAT_R32G32B32_TYPELESS = 5; - DXGI_FORMAT_R32G32B32_FLOAT = 6; - DXGI_FORMAT_R32G32B32_UINT = 7; - DXGI_FORMAT_R32G32B32_SINT = 8; - DXGI_FORMAT_R16G16B16A16_TYPELESS = 9; - DXGI_FORMAT_R16G16B16A16_FLOAT = 10; - DXGI_FORMAT_R16G16B16A16_UNORM = 11; - DXGI_FORMAT_R16G16B16A16_UINT = 12; - DXGI_FORMAT_R16G16B16A16_SNORM = 13; - DXGI_FORMAT_R16G16B16A16_SINT = 14; - DXGI_FORMAT_R32G32_TYPELESS = 15; - DXGI_FORMAT_R32G32_FLOAT = 16; - DXGI_FORMAT_R32G32_UINT = 17; - DXGI_FORMAT_R32G32_SINT = 18; - DXGI_FORMAT_R32G8X24_TYPELESS = 19; - DXGI_FORMAT_D32_FLOAT_S8X24_UINT = 20; - DXGI_FORMAT_R32_FLOAT_X8X24_TYPELESS = 21; - DXGI_FORMAT_X32_TYPELESS_G8X24_UINT = 22; - DXGI_FORMAT_R10G10B10A2_TYPELESS = 23; - DXGI_FORMAT_R10G10B10A2_UNORM = 24; - DXGI_FORMAT_R10G10B10A2_UINT = 25; - DXGI_FORMAT_R11G11B10_FLOAT = 26; - DXGI_FORMAT_R8G8B8A8_TYPELESS = 27; - DXGI_FORMAT_R8G8B8A8_UNORM = 28; - DXGI_FORMAT_R8G8B8A8_UNORM_SRGB = 29; - DXGI_FORMAT_R8G8B8A8_UINT = 30; - DXGI_FORMAT_R8G8B8A8_SNORM = 31; - DXGI_FORMAT_R8G8B8A8_SINT = 32; - DXGI_FORMAT_R16G16_TYPELESS = 33; - DXGI_FORMAT_R16G16_FLOAT = 34; - DXGI_FORMAT_R16G16_UNORM = 35; - DXGI_FORMAT_R16G16_UINT = 36; - DXGI_FORMAT_R16G16_SNORM = 37; - DXGI_FORMAT_R16G16_SINT = 38; - DXGI_FORMAT_R32_TYPELESS = 39; - DXGI_FORMAT_D32_FLOAT = 40; - DXGI_FORMAT_R32_FLOAT = 41; - DXGI_FORMAT_R32_UINT = 42; - DXGI_FORMAT_R32_SINT = 43; - DXGI_FORMAT_R24G8_TYPELESS = 44; - DXGI_FORMAT_D24_UNORM_S8_UINT = 45; - DXGI_FORMAT_R24_UNORM_X8_TYPELESS = 46; - DXGI_FORMAT_X24_TYPELESS_G8_UINT = 47; - DXGI_FORMAT_R8G8_TYPELESS = 48; - DXGI_FORMAT_R8G8_UNORM = 49; - DXGI_FORMAT_R8G8_UINT = 50; - DXGI_FORMAT_R8G8_SNORM = 51; - DXGI_FORMAT_R8G8_SINT = 52; - DXGI_FORMAT_R16_TYPELESS = 53; - DXGI_FORMAT_R16_FLOAT = 54; - DXGI_FORMAT_D16_UNORM = 55; - DXGI_FORMAT_R16_UNORM = 56; - DXGI_FORMAT_R16_UINT = 57; - DXGI_FORMAT_R16_SNORM = 58; - DXGI_FORMAT_R16_SINT = 59; - DXGI_FORMAT_R8_TYPELESS = 60; - DXGI_FORMAT_R8_UNORM = 61; - DXGI_FORMAT_R8_UINT = 62; - DXGI_FORMAT_R8_SNORM = 63; - DXGI_FORMAT_R8_SINT = 64; - DXGI_FORMAT_A8_UNORM = 65; - DXGI_FORMAT_R1_UNORM = 66; - DXGI_FORMAT_R9G9B9E5_SHAREDEXP = 67; - DXGI_FORMAT_R8G8_B8G8_UNORM = 68; - DXGI_FORMAT_G8R8_G8B8_UNORM = 69; - DXGI_FORMAT_BC1_TYPELESS = 70; - DXGI_FORMAT_BC1_UNORM = 71; - DXGI_FORMAT_BC1_UNORM_SRGB = 72; - DXGI_FORMAT_BC2_TYPELESS = 73; - DXGI_FORMAT_BC2_UNORM = 74; - DXGI_FORMAT_BC2_UNORM_SRGB = 75; - DXGI_FORMAT_BC3_TYPELESS = 76; - DXGI_FORMAT_BC3_UNORM = 77; - DXGI_FORMAT_BC3_UNORM_SRGB = 78; - DXGI_FORMAT_BC4_TYPELESS = 79; - DXGI_FORMAT_BC4_UNORM = 80; - DXGI_FORMAT_BC4_SNORM = 81; - DXGI_FORMAT_BC5_TYPELESS = 82; - DXGI_FORMAT_BC5_UNORM = 83; - DXGI_FORMAT_BC5_SNORM = 84; - DXGI_FORMAT_B5G6R5_UNORM = 85; - DXGI_FORMAT_B5G5R5A1_UNORM = 86; - DXGI_FORMAT_B8G8R8A8_UNORM = 87; - DXGI_FORMAT_B8G8R8X8_UNORM = 88; - DXGI_FORMAT_R10G10B10_XR_BIAS_A2_UNORM = 89; - DXGI_FORMAT_B8G8R8A8_TYPELESS = 90; - DXGI_FORMAT_B8G8R8A8_UNORM_SRGB = 91; - DXGI_FORMAT_B8G8R8X8_TYPELESS = 92; - DXGI_FORMAT_B8G8R8X8_UNORM_SRGB = 93; - DXGI_FORMAT_BC6H_TYPELESS = 94; - DXGI_FORMAT_BC6H_UF16 = 95; - DXGI_FORMAT_BC6H_SF16 = 96; - DXGI_FORMAT_BC7_TYPELESS = 97; - DXGI_FORMAT_BC7_UNORM = 98; - DXGI_FORMAT_BC7_UNORM_SRGB = 99; - // ); - - // TD3D11_RESOURCE_DIMENSION = - // ( - D3D11_RESOURCE_DIMENSION_UNKNOWN = 0; - D3D11_RESOURCE_DIMENSION_BUFFER = 1; - D3D11_RESOURCE_DIMENSION_TEXTURE1D = 2; - D3D11_RESOURCE_DIMENSION_TEXTURE2D = 3; - D3D11_RESOURCE_DIMENSION_TEXTURE3D = 4; - // ); - -type - TDDS_HEADER_DXT10 = record - dxgiFormat: Integer; // TDXGI_FORMAT; - resourceDimension: Integer; // TD3D11_RESOURCE_DIMENSION; - miscFlag: Cardinal; - arraySize: Cardinal; - reserved: Cardinal; - end; - - TFOURCC = array [0 .. 3] of AnsiChar; - -const - FOURCC_UNKNOWN = 0; - FOURCC_R8G8B8 = 20; - FOURCC_A8R8G8B8 = 21; - FOURCC_X8R8G8B8 = 22; - FOURCC_R5G6B5 = 23; - FOURCC_X1R5G5B5 = 24; - FOURCC_A1R5G5B5 = 25; - FOURCC_A4R4G4B4 = 26; - FOURCC_R3G3B2 = 27; - FOURCC_A8 = 28; - FOURCC_A8R3G3B2 = 29; - FOURCC_X4R4G4B4 = 30; - FOURCC_A2B10G10R10 = 31; - FOURCC_A8B8G8R8 = 32; - FOURCC_X8B8G8R8 = 33; - FOURCC_G16R16 = 34; - FOURCC_A2R10G10B10 = 35; - FOURCC_A16B16G16R16 = 36; - - FOURCC_L8 = 50; - FOURCC_A8L8 = 51; - FOURCC_A4L4 = 52; - FOURCC_DXT1 = $31545844; - FOURCC_DXT2 = $32545844; - FOURCC_DXT3 = $33545844; - FOURCC_DXT4 = $34545844; - FOURCC_DXT5 = $35545844; - FOURCC_ATI1 = $31495441; - FOURCC_ATI2 = $32495441; - - FOURCC_D16_LOCKABLE = 70; - FOURCC_D32 = 71; - FOURCC_D24X8 = 77; - FOURCC_D16 = 80; - - FOURCC_D32F_LOCKABLE = 82; - - FOURCC_L16 = 81; - - // Floating point surface formats - - // s10e5 formats (16-bits per channel) - FOURCC_R16F = 111; - FOURCC_G16R16F = 112; - FOURCC_A16B16G16R16F = 113; - - // IEEE s23e8 formats (32-bits per channel) - FOURCC_R32F = 114; - FOURCC_G32R32F = 115; - FOURCC_A32B32G32R32F = 116; - - // DX10 header indicator - FOURCC_DX10 = $47495844; - -type - TGLImageDataFormat = record - ColorFlag: Cardinal; - RBits, GBits, BBits, ABits: Cardinal; - colorFormat: Cardinal; - TexFormat: TglInternalFormat; - dType: Cardinal; - end; - -const - cImageDataFormat8bits: array [0 .. 3] of TglImageDataFormat = ((ColorFlag: DDPF_RGB; RBits: $E0; - GBits: $1C; BBits: $03; ABits: $00; colorFormat: GL_RGB; TexFormat: tfR3_G3_B2; - dType: GL_UNSIGNED_BYTE_3_3_2), - - (ColorFlag: DDPF_LA; RBits: $0F; GBits: $00; BBits: $00; ABits: $F0; - colorFormat: GL_LUMINANCE_ALPHA; TexFormat: tfLUMINANCE4_ALPHA4; dType: GL_UNSIGNED_BYTE), - - (ColorFlag: DDPF_A; RBits: $00; GBits: $00; BBits: $00; ABits: $FF; colorFormat: GL_ALPHA; - TexFormat: tfALPHA8; dType: GL_UNSIGNED_BYTE), - - (ColorFlag: DDPF_L; RBits: $FF; GBits: $00; BBits: $00; ABits: $00; colorFormat: GL_LUMINANCE; - TexFormat: tfLUMINANCE8; dType: GL_UNSIGNED_BYTE)); - - cImageDataFormat16bits: array [0 .. 4] of TGLImageDataFormat = ((ColorFlag: DDPF_RGBA; - RBits: $0F00; GBits: $F0; BBits: $0F; ABits: $F000; colorFormat: GL_BGRA; TexFormat: tfRGBA4; - dType: GL_UNSIGNED_SHORT_4_4_4_4_REV), - - (ColorFlag: DDPF_RGB; RBits: $F800; GBits: $07E0; BBits: $1F; ABits: $00; colorFormat: GL_RGB; - TexFormat: tfRGB5; dType: GL_UNSIGNED_SHORT_5_6_5), - - (ColorFlag: DDPF_L; RBits: $FFFF; GBits: $00; BBits: $00; ABits: $00; colorFormat: GL_LUMINANCE; - TexFormat: tfLUMINANCE16; dType: GL_UNSIGNED_SHORT), - - (ColorFlag: DDPF_LA; RBits: $FF; GBits: $00; BBits: $00; ABits: $FF00; - colorFormat: GL_LUMINANCE_ALPHA; TexFormat: tfLUMINANCE8_ALPHA8; dType: GL_UNSIGNED_BYTE), - - (ColorFlag: DDPF_RGBA; RBits: $7C00; GBits: $03E0; BBits: $1F; ABits: $8000; - colorFormat: GL_BGRA; TexFormat: tfRGB5_A1; dType: GL_UNSIGNED_SHORT_1_5_5_5_REV)); - - cImageDataFormat24bits: array [0 .. 0] of TGLImageDataFormat = ((ColorFlag: DDPF_RGB; - RBits: $FF0000; GBits: $FF00; BBits: $FF; ABits: $00; colorFormat: GL_BGR; TexFormat: tfRGB8; - dType: GL_UNSIGNED_BYTE)); - - cImageDataFormat32bits: array [0 .. 6] of TGLImageDataFormat = ((ColorFlag: DDPF_RGBA; RBits: $FF; - GBits: $FF00; BBits: $FF0000; ABits: $FF000000; colorFormat: GL_RGBA; TexFormat: tfRGBA8; - dType: GL_UNSIGNED_BYTE), - - (ColorFlag: DDPF_RGBA; RBits: $FF0000; GBits: $FF00; BBits: $FF; ABits: $FF000000; - colorFormat: GL_BGRA; TexFormat: tfRGBA8; dType: GL_UNSIGNED_BYTE), - - (ColorFlag: DDPF_RGBA; RBits: $3FF00000; GBits: $0FFC00; BBits: $03FF; ABits: $0C0000000; - colorFormat: GL_RGBA; TexFormat: tfRGB10_A2; dType: GL_UNSIGNED_INT_2_10_10_10_REV), - - (ColorFlag: DDPF_RGBA; RBits: $03FF; GBits: $FFC00; BBits: $3FF00000; ABits: $C0000000; - colorFormat: GL_BGRA; TexFormat: tfRGB10_A2; dType: GL_UNSIGNED_INT_2_10_10_10_REV), - - (ColorFlag: DDPF_RGBA; RBits: $FF0000; GBits: $FF00; BBits: $FF; ABits: $FF000000; - colorFormat: GL_BGRA; TexFormat: tfRGB8; dType: GL_UNSIGNED_INT_8_8_8_8), - - (ColorFlag: DDPF_RGBA; RBits: $FF; GBits: $FF00; BBits: $FF0000; ABits: $FF000000; - colorFormat: GL_RGBA; TexFormat: tfRGB8; dType: GL_UNSIGNED_INT_8_8_8_8), - - (ColorFlag: DDPF_RGB; RBits: $FFFF; GBits: $FFFF0000; BBits: $00; ABits: $00; - colorFormat: GL_RG; TexFormat: tfRG16; dType: GL_UNSIGNED_SHORT)); - -procedure DecodeDXT1toBitmap32(encData, decData: PByteArray; w, h: Integer; var trans: Boolean); -procedure DecodeDXT3toBitmap32(encData, decData: PByteArray; w, h: Integer); -procedure DecodeDXT5toBitmap32(encData, decData: PByteArray; w, h: Integer); -procedure flip_blocks_dxtc1(data: PGLubyte; numBlocks: Integer); -procedure flip_blocks_dxtc3(data: PGLubyte; numBlocks: Integer); -procedure flip_blocks_dxtc5(data: PGLubyte; numBlocks: Integer); -procedure flip_dxt5_alpha(block: PDXT5AlphaBlock); - -function DDSHeaderToGLEnum(const DX9header: TDDSHeader; const DX11header: TDDS_HEADER_DXT10; - const useDX11: Boolean; out iFormat: TglInternalFormat; out colorFormat: Cardinal; - out dataType: Cardinal; out bpe: Integer): Boolean; - -function GLEnumToDDSHeader(var DX9header: TDDSHeader; var DX11header: TDDS_HEADER_DXT10; - const useDX11: Boolean; const iFormat: TglInternalFormat; const colorFormat: Cardinal; - const dataType: Cardinal; const bpe: Integer): Boolean; - -function FindDDSCompatibleDataFormat(const iFormat: TglInternalFormat; out colorFormat: Cardinal; - out dataType: Cardinal): Boolean; - -// -------------------------------------------------- -implementation -// -------------------------------------------------- - -procedure DecodeColor565(col: Word; out r, g, b: Byte); -begin - r := col and $1F; - g := (col shr 5) and $3F; - b := (col shr 11) and $1F; -end; - -procedure DecodeDXT1toBitmap32(encData, decData: PByteArray; w, h: Integer; var trans: Boolean); -var - x, y, i, j, k, select: Integer; - col0, col1: Word; - colors: array [0 .. 3] of array [0 .. 3] of Byte; - bitmask: Cardinal; - temp: PGLubyte; - r0, g0, b0, r1, g1, b1: Byte; -begin - trans := False; - - if not(Assigned(encData) and Assigned(decData)) then - exit; - - temp := PGLubyte(encData); - for y := 0 to (h div 4) - 1 do - begin - for x := 0 to (w div 4) - 1 do - begin - col0 := PWord(temp)^; - Inc(temp, 2); - col1 := PWord(temp)^; - Inc(temp, 2); - bitmask := PCardinal(temp)^; - Inc(temp, 4); - - DecodeColor565(col0, r0, g0, b0); - DecodeColor565(col1, r1, g1, b1); - - colors[0][0] := r0 shl 3; - colors[0][1] := g0 shl 2; - colors[0][2] := b0 shl 3; - colors[0][3] := $FF; - colors[1][0] := r1 shl 3; - colors[1][1] := g1 shl 2; - colors[1][2] := b1 shl 3; - colors[1][3] := $FF; - - if col0 > col1 then - begin - colors[2][0] := (2 * colors[0][0] + colors[1][0] + 1) div 3; - colors[2][1] := (2 * colors[0][1] + colors[1][1] + 1) div 3; - colors[2][2] := (2 * colors[0][2] + colors[1][2] + 1) div 3; - colors[2][3] := $FF; - colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3; - colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3; - colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3; - colors[3][3] := $FF; - end - else - begin - trans := True; - colors[2][0] := (colors[0][0] + colors[1][0]) div 2; - colors[2][1] := (colors[0][1] + colors[1][1]) div 2; - colors[2][2] := (colors[0][2] + colors[1][2]) div 2; - colors[2][3] := $FF; - colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3; - colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3; - colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3; - colors[3][3] := 0; - end; - - k := 0; - for j := 0 to 3 do - begin - for i := 0 to 3 do - begin - select := (bitmask and (3 shl (k * 2))) shr (k * 2); - if ((4 * x + i) < w) and ((4 * y + j) < h) then - PCardinal(@decData[((4 * y + j) * w + (4 * x + i)) * 4])^ := Cardinal(colors[select]); - Inc(k); - end; - end; - - end; - end; -end; - -procedure DecodeDXT3toBitmap32(encData, decData: PByteArray; w, h: Integer); -var - x, y, i, j, k, select: Integer; - col0, col1, wrd: Word; - colors: array [0 .. 3] of array [0 .. 3] of Byte; - bitmask, offset: Cardinal; - temp: PGLubyte; - r0, g0, b0, r1, g1, b1: Byte; - alpha: array [0 .. 3] of Word; -begin - if not(Assigned(encData) and Assigned(decData)) then - exit; - - temp := PGLubyte(encData); - for y := 0 to (h div 4) - 1 do - begin - for x := 0 to (w div 4) - 1 do - begin - alpha[0] := PWord(temp)^; - Inc(temp, 2); - alpha[1] := PWord(temp)^; - Inc(temp, 2); - alpha[2] := PWord(temp)^; - Inc(temp, 2); - alpha[3] := PWord(temp)^; - Inc(temp, 2); - col0 := PWord(temp)^; - Inc(temp, 2); - col1 := PWord(temp)^; - Inc(temp, 2); - bitmask := PCardinal(temp)^; - Inc(temp, 4); - - DecodeColor565(col0, r0, g0, b0); - DecodeColor565(col1, r1, g1, b1); - - colors[0][0] := r0 shl 3; - colors[0][1] := g0 shl 2; - colors[0][2] := b0 shl 3; - colors[0][3] := $FF; - colors[1][0] := r1 shl 3; - colors[1][1] := g1 shl 2; - colors[1][2] := b1 shl 3; - colors[1][3] := $FF; - colors[2][0] := (2 * colors[0][0] + colors[1][0] + 1) div 3; - colors[2][1] := (2 * colors[0][1] + colors[1][1] + 1) div 3; - colors[2][2] := (2 * colors[0][2] + colors[1][2] + 1) div 3; - colors[2][3] := $FF; - colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3; - colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3; - colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3; - colors[3][3] := $FF; - - k := 0; - for j := 0 to 3 do - begin - for i := 0 to 3 do - begin - select := (bitmask and (3 shl (k * 2))) shr (k * 2); - if ((4 * x + i) < w) and ((4 * y + j) < h) then - PCardinal(@decData[((4 * y + j) * w + (4 * x + i)) * 4])^ := Cardinal(colors[select]); - Inc(k); - end; - end; - - for j := 0 to 3 do - begin - wrd := alpha[j]; - for i := 0 to 3 do - begin - if (((4 * x + i) < w) and ((4 * y + j) < h)) then - begin - offset := ((4 * y + j) * w + (4 * x + i)) * 4 + 3; - decData[offset] := wrd and $0F; - decData[offset] := decData[offset] or (decData[offset] shl 4); - end; - wrd := wrd shr 4; - end; - end; - - end; - end; -end; - -procedure DecodeDXT5toBitmap32(encData, decData: PByteArray; w, h: Integer); -var - x, y, i, j, k, select: Integer; - col0, col1: Word; - colors: array [0 .. 3] of array [0 .. 3] of Byte; - bits, bitmask, offset: Cardinal; - temp, alphamask: PGLubyte; - r0, g0, b0, r1, g1, b1: Byte; - alphas: array [0 .. 7] of Byte; -begin - if not(Assigned(encData) and Assigned(decData)) then - exit; - - temp := PGLubyte(encData); - for y := 0 to (h div 4) - 1 do - begin - for x := 0 to (w div 4) - 1 do - begin - alphas[0] := temp^; - Inc(temp); - alphas[1] := temp^; - Inc(temp); - alphamask := temp; - Inc(temp, 6); - col0 := PWord(temp)^; - Inc(temp, 2); - col1 := PWord(temp)^; - Inc(temp, 2); - bitmask := PCardinal(temp)^; - Inc(temp, 4); - - DecodeColor565(col0, r0, g0, b0); - DecodeColor565(col1, r1, g1, b1); - - colors[0][0] := r0 shl 3; - colors[0][1] := g0 shl 2; - colors[0][2] := b0 shl 3; - colors[0][3] := $FF; - colors[1][0] := r1 shl 3; - colors[1][1] := g1 shl 2; - colors[1][2] := b1 shl 3; - colors[1][3] := $FF; - colors[2][0] := (2 * colors[0][0] + colors[1][0] + 1) div 3; - colors[2][1] := (2 * colors[0][1] + colors[1][1] + 1) div 3; - colors[2][2] := (2 * colors[0][2] + colors[1][2] + 1) div 3; - colors[2][3] := $FF; - colors[3][0] := (colors[0][0] + 2 * colors[1][0] + 1) div 3; - colors[3][1] := (colors[0][1] + 2 * colors[1][1] + 1) div 3; - colors[3][2] := (colors[0][2] + 2 * colors[1][2] + 1) div 3; - colors[3][3] := $FF; - - k := 0; - for j := 0 to 3 do - begin - for i := 0 to 3 do - begin - select := (bitmask and (3 shl (k * 2))) shr (k * 2); - if ((4 * x + i) < w) and ((4 * y + j) < h) then - PCardinal(@decData[((4 * y + j) * w + (4 * x + i)) * 4])^ := Cardinal(colors[select]); - Inc(k); - end; - end; - - if (alphas[0] > alphas[1]) then - begin - alphas[2] := (6 * alphas[0] + 1 * alphas[1] + 3) div 7; - alphas[3] := (5 * alphas[0] + 2 * alphas[1] + 3) div 7; - alphas[4] := (4 * alphas[0] + 3 * alphas[1] + 3) div 7; - alphas[5] := (3 * alphas[0] + 4 * alphas[1] + 3) div 7; - alphas[6] := (2 * alphas[0] + 5 * alphas[1] + 3) div 7; - alphas[7] := (1 * alphas[0] + 6 * alphas[1] + 3) div 7; - end - else - begin - alphas[2] := (4 * alphas[0] + 1 * alphas[1] + 2) div 5; - alphas[3] := (3 * alphas[0] + 2 * alphas[1] + 2) div 5; - alphas[4] := (2 * alphas[0] + 3 * alphas[1] + 2) div 5; - alphas[5] := (1 * alphas[0] + 4 * alphas[1] + 2) div 5; - alphas[6] := 0; - alphas[7] := $FF; - end; - - bits := PCardinal(alphamask)^; - for j := 0 to 1 do - begin - for i := 0 to 3 do - begin - if (((4 * x + i) < w) and ((4 * y + j) < h)) then - begin - offset := ((4 * y + j) * w + (4 * x + i)) * 4 + 3; - decData[offset] := alphas[bits and 7]; - end; - bits := bits shr 3; - end; - end; - - Inc(alphamask, 3); - bits := PCardinal(alphamask)^; - for j := 2 to 3 do - begin - for i := 0 to 3 do - begin - if (((4 * x + i) < w) and ((4 * y + j) < h)) then - begin - offset := ((4 * y + j) * w + (4 * x + i)) * 4 + 3; - decData[offset] := alphas[bits and 7]; - end; - bits := bits shr 3; - end; - end; - - end; - end; -end; - -//============================================================== -procedure flip_blocks_dxtc1(data: PGLubyte; numBlocks: Integer); -var - curblock: PDXTColBlock; - temp: Byte; - i: Integer; -begin - curblock := PDXTColBlock(data); - for i := 0 to numBlocks - 1 do - begin - temp := curblock.row[0]; - curblock.row[0] := curblock.row[3]; - curblock.row[3] := temp; - temp := curblock.row[1]; - curblock.row[1] := curblock.row[2]; - curblock.row[2] := temp; - - Inc(curblock); - end; -end; - -// flip a DXT3 color block -//=============================================================== -procedure flip_blocks_dxtc3(data: PGLubyte; numBlocks: Integer); -var - curblock: PDXTColBlock; - alphablock: PDXT3AlphaBlock; - tempS: Word; - tempB: Byte; - i: Integer; -begin - curblock := PDXTColBlock(data); - for i := 0 to numBlocks - 1 do - begin - alphablock := PDXT3AlphaBlock(curblock); - - tempS := alphablock.row[0]; - alphablock.row[0] := alphablock.row[3]; - alphablock.row[3] := tempS; - tempS := alphablock.row[1]; - alphablock.row[1] := alphablock.row[2]; - alphablock.row[2] := tempS; - - Inc(curblock); - - tempB := curblock.row[0]; - curblock.row[0] := curblock.row[3]; - curblock.row[3] := tempB; - tempB := curblock.row[1]; - curblock.row[1] := curblock.row[2]; - curblock.row[2] := tempB; - - Inc(curblock); - end; -end; - -//================================================= -procedure flip_dxt5_alpha(block: PDXT5AlphaBlock); -const - mask = $00000007; // bits = 00 00 01 11 -var - GBits: array [0 .. 3, 0 .. 3] of Byte; - bits: Integer; -begin - bits := 0; - Move(block.row[0], bits, sizeof(Byte) * 3); - - GBits[0][0] := Byte(bits and mask); - bits := bits shr 3; - GBits[0][1] := Byte(bits and mask); - bits := bits shr 3; - GBits[0][2] := Byte(bits and mask); - bits := bits shr 3; - GBits[0][3] := Byte(bits and mask); - bits := bits shr 3; - GBits[1][0] := Byte(bits and mask); - bits := bits shr 3; - GBits[1][1] := Byte(bits and mask); - bits := bits shr 3; - GBits[1][2] := Byte(bits and mask); - bits := bits shr 3; - GBits[1][3] := Byte(bits and mask); - - bits := 0; - Move(block.row[3], bits, sizeof(Byte) * 3); - - GBits[2][0] := Byte(bits and mask); - bits := bits shr 3; - GBits[2][1] := Byte(bits and mask); - bits := bits shr 3; - GBits[2][2] := Byte(bits and mask); - bits := bits shr 3; - GBits[2][3] := Byte(bits and mask); - bits := bits shr 3; - GBits[3][0] := Byte(bits and mask); - bits := bits shr 3; - GBits[3][1] := Byte(bits and mask); - bits := bits shr 3; - GBits[3][2] := Byte(bits and mask); - bits := bits shr 3; - GBits[3][3] := Byte(bits and mask); - - // clear existing alpha bits - FillChar(block.row, sizeof(Byte) * 6, 0); - - bits := block.row[0] + block.row[1] * $100 + block.row[2] * $10000; - - bits := bits or (GBits[3][0] shl 0); - bits := bits or (GBits[3][1] shl 3); - bits := bits or (GBits[3][2] shl 6); - bits := bits or (GBits[3][3] shl 9); - - bits := bits or (GBits[2][0] shl 12); - bits := bits or (GBits[2][1] shl 15); - bits := bits or (GBits[2][2] shl 18); - bits := bits or (GBits[2][3] shl 21); - - block.row[0] := bits and $FF; - block.row[1] := (bits shr 8) and $FF; - block.row[2] := (bits shr 16) and $FF; - - bits := block.row[3] + block.row[4] * $100 + block.row[5] * $10000; - - bits := bits or (GBits[1][0] shl 0); - bits := bits or (GBits[1][1] shl 3); - bits := bits or (GBits[1][2] shl 6); - bits := bits or (GBits[1][3] shl 9); - - bits := bits or (GBits[0][0] shl 12); - bits := bits or (GBits[0][1] shl 15); - bits := bits or (GBits[0][2] shl 18); - bits := bits or (GBits[0][3] shl 21); - - block.row[3] := bits and $FF; - block.row[4] := (bits shr 8) and $FF; - block.row[5] := (bits shr 16) and $FF; -end; - -//============================================================== -procedure flip_blocks_dxtc5(data: PGLubyte; numBlocks: Integer); -var - curblock: PDXTColBlock; - temp: Byte; - i: Integer; -begin - curblock := PDXTColBlock(data); - for i := 0 to numBlocks - 1 do - begin - flip_dxt5_alpha(PDXT5AlphaBlock(curblock)); - Inc(curblock); - temp := curblock.row[0]; - curblock.row[0] := curblock.row[3]; - curblock.row[3] := temp; - temp := curblock.row[1]; - curblock.row[1] := curblock.row[2]; - curblock.row[2] := temp; - Inc(curblock); - end; -end; - -function DDSHeaderToGLEnum(const DX9header: TDDSHeader; const DX11header: TDDS_HEADER_DXT10; - const useDX11: Boolean; out iFormat: TglInternalFormat; out colorFormat: Cardinal; - out dataType: Cardinal; out bpe: Integer): Boolean; -var - i: Integer; -begin - Result := True; - if useDX11 then - begin - Assert(False, 'DXGI images not supported.'); - end - // Use DX9 formats - else - begin - // figure out what the image format is - if (DX9header.SurfaceFormat.ddpf.dwFlags and DDPF_FOURCC) <> 0 then - begin - case DX9header.SurfaceFormat.ddpf.dwFourCC of - FOURCC_DXT1: - begin - colorFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; - iFormat := tfCOMPRESSED_RGBA_S3TC_DXT1; - dataType := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; - bpe := 8; - end; - FOURCC_DXT2, FOURCC_DXT3: - begin - colorFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; - iFormat := tfCOMPRESSED_RGBA_S3TC_DXT3; - dataType := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; - bpe := 16; - end; - FOURCC_DXT4, FOURCC_DXT5: - begin - colorFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; - iFormat := tfCOMPRESSED_RGBA_S3TC_DXT5; - dataType := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; - bpe := 16; - end; - FOURCC_ATI1: - begin - colorFormat := GL_COMPRESSED_RED_RGTC1; - iFormat := tfCOMPRESSED_RED_RGTC1; - dataType := GL_COMPRESSED_RED_RGTC1; - bpe := 8; - end; - FOURCC_ATI2: - begin - colorFormat := GL_COMPRESSED_RG_RGTC2; - iFormat := tfCOMPRESSED_RG_RGTC2; - dataType := GL_COMPRESSED_RG_RGTC2; - bpe := 16; - end; - FOURCC_R8G8B8: - begin - colorFormat := GL_BGR; - iFormat := tfRGB8; - dataType := GL_UNSIGNED_BYTE; - bpe := 3; - end; - FOURCC_A8R8G8B8: - begin - colorFormat := GL_BGRA; - iFormat := tfRGBA8; - dataType := GL_UNSIGNED_BYTE; - bpe := 4; - end; - FOURCC_X8R8G8B8: - begin - colorFormat := GL_BGRA; - iFormat := tfRGB8; - dataType := GL_UNSIGNED_INT_8_8_8_8; - bpe := 4; - end; - FOURCC_R5G6B5: - begin - colorFormat := GL_RGB; - iFormat := tfRGB5; - dataType := GL_UNSIGNED_SHORT_5_6_5; - bpe := 2; - end; - FOURCC_A8: - begin - colorFormat := GL_ALPHA; - iFormat := tfALPHA8; - dataType := GL_UNSIGNED_BYTE; - bpe := 1; - end; - FOURCC_A2B10G10R10: - begin - colorFormat := GL_RGBA; - iFormat := tfRGB10_A2; - dataType := GL_UNSIGNED_INT_10_10_10_2; - bpe := 4; - end; - FOURCC_A8B8G8R8: - begin - colorFormat := GL_RGBA; - iFormat := tfRGBA8; - dataType := GL_UNSIGNED_BYTE; - bpe := 4; - end; - FOURCC_X8B8G8R8: - begin - colorFormat := GL_RGBA; - iFormat := tfRGB8; - dataType := GL_UNSIGNED_INT_8_8_8_8; - bpe := 4; - end; - FOURCC_A2R10G10B10: - begin - colorFormat := GL_BGRA; - iFormat := tfRGB10_A2; - dataType := GL_UNSIGNED_INT_10_10_10_2; - bpe := 4; - end; - FOURCC_A16B16G16R16: - begin - colorFormat := GL_RGBA; - iFormat := tfR16G16B16A16; - dataType := GL_UNSIGNED_SHORT; - bpe := 8; - end; - FOURCC_L8: - begin - colorFormat := GL_LUMINANCE; - iFormat := tfLUMINANCE8; - dataType := GL_UNSIGNED_BYTE; - bpe := 1; - end; - FOURCC_A8L8: - begin - colorFormat := GL_LUMINANCE_ALPHA; - iFormat := tfLUMINANCE8_ALPHA8; - dataType := GL_UNSIGNED_BYTE; - bpe := 2; - end; - FOURCC_L16: - begin - colorFormat := GL_LUMINANCE; - iFormat := tfLUMINANCE16; - dataType := GL_UNSIGNED_SHORT; - bpe := 2; - end; - FOURCC_R16F: - begin - colorFormat := GL_RED; - iFormat := tfLUMINANCE_FLOAT16; - dataType := GL_HALF_FLOAT_ARB; - bpe := 2; - end; - FOURCC_A16B16G16R16F: - begin - colorFormat := GL_RGBA; - iFormat := tfRGBA_FLOAT16; - dataType := GL_HALF_FLOAT_ARB; - bpe := 8; - end; - FOURCC_R32F: - begin - colorFormat := GL_RED; - iFormat := tfLUMINANCE_FLOAT32; - dataType := GL_FLOAT; - bpe := 4; - end; - FOURCC_G16R16: - begin - colorFormat := GL_RG; - iFormat := tfRG16; - dataType := GL_UNSIGNED_SHORT; - bpe := 4; - end; - FOURCC_G16R16F: - begin - colorFormat := GL_RG; - iFormat := tfRG16F; - dataType := GL_HALF_FLOAT; - bpe := 4; - end; - FOURCC_G32R32F: - begin - colorFormat := GL_RG; - iFormat := tfRG32F; - dataType := GL_FLOAT; - bpe := 8; - end; - FOURCC_UNKNOWN, FOURCC_X1R5G5B5, FOURCC_A1R5G5B5, FOURCC_A4R4G4B4, FOURCC_R3G3B2, - FOURCC_A8R3G3B2, FOURCC_X4R4G4B4, FOURCC_A4L4, FOURCC_D16_LOCKABLE, FOURCC_D32, - FOURCC_D24X8, FOURCC_D16, FOURCC_D32F_LOCKABLE: - Result := False; // these are unsupported for now - end; // of case - end // not FOURCC - - else - with DX9header.SurfaceFormat.ddpf do - case dwRGBBitCount of - 8: - begin - for i := 0 to High(cImageDataFormat8bits) do - if (cImageDataFormat8bits[i].ColorFlag = dwFlags) and - (cImageDataFormat8bits[i].RBits = dwRBitMask) and - (cImageDataFormat8bits[i].GBits = dwGBitMask) and - (cImageDataFormat8bits[i].BBits = dwBBitMask) and - (cImageDataFormat8bits[i].ABits = dwRGBAlphaBitMask) then - begin - colorFormat := cImageDataFormat8bits[i].colorFormat; - iFormat := cImageDataFormat8bits[i].TexFormat; - dataType := cImageDataFormat8bits[i].dType; - Result := True; - Break; - end; - bpe := 1; - end; - 16: - begin - for i := 0 to High(cImageDataFormat16bits) do - if (cImageDataFormat16bits[i].ColorFlag = dwFlags) and - (cImageDataFormat16bits[i].RBits = dwRBitMask) and - (cImageDataFormat16bits[i].GBits = dwGBitMask) and - (cImageDataFormat16bits[i].BBits = dwBBitMask) and - (cImageDataFormat16bits[i].ABits = dwRGBAlphaBitMask) then - begin - colorFormat := cImageDataFormat16bits[i].colorFormat; - iFormat := cImageDataFormat16bits[i].TexFormat; - dataType := cImageDataFormat16bits[i].dType; - Result := True; - Break; - end; - bpe := 2; - end; - 24: - begin - for i := 0 to High(cImageDataFormat24bits) do - if (cImageDataFormat24bits[i].ColorFlag = dwFlags) and - (cImageDataFormat24bits[i].RBits = dwRBitMask) and - (cImageDataFormat24bits[i].GBits = dwGBitMask) and - (cImageDataFormat24bits[i].BBits = dwBBitMask) and - (cImageDataFormat24bits[i].ABits = dwRGBAlphaBitMask) then - begin - colorFormat := cImageDataFormat24bits[i].colorFormat; - iFormat := cImageDataFormat24bits[i].TexFormat; - dataType := cImageDataFormat24bits[i].dType; - Result := True; - Break; - end; - bpe := 3; - end; - 32: - begin - for i := 0 to High(cImageDataFormat32bits) do - if (cImageDataFormat32bits[i].ColorFlag = dwFlags) and - (cImageDataFormat32bits[i].RBits = dwRBitMask) and - (cImageDataFormat32bits[i].GBits = dwGBitMask) and - (cImageDataFormat32bits[i].BBits = dwBBitMask) and - (cImageDataFormat32bits[i].ABits = dwRGBAlphaBitMask) then - begin - colorFormat := cImageDataFormat32bits[i].colorFormat; - iFormat := cImageDataFormat32bits[i].TexFormat; - dataType := cImageDataFormat32bits[i].dType; - Result := True; - Break; - end; - bpe := 4; - end; - else - Result := False; - end; // of case - end; -end; - -//------------------------------------------------------------------------------------- - -function GLEnumToDDSHeader(var DX9header: TDDSHeader; var DX11header: TDDS_HEADER_DXT10; - const useDX11: Boolean; const iFormat: TglInternalFormat; const colorFormat: Cardinal; - const dataType: Cardinal; const bpe: Integer): Boolean; -var - i: Integer; -begin - Result := True; - if useDX11 then - begin - Assert(False, 'DXGI images not supported.'); - end; - - if IsCompressedFormat(iFormat) then - begin - with DX9header.SurfaceFormat.ddpf do - begin - dwFlags := DDPF_FOURCC; - case iFormat of - tfCOMPRESSED_RGB_S3TC_DXT1: - dwFourCC := FOURCC_DXT1; - tfCOMPRESSED_RGBA_S3TC_DXT1: - dwFourCC := FOURCC_DXT1; - tfCOMPRESSED_RGBA_S3TC_DXT3: - dwFourCC := FOURCC_DXT3; - tfCOMPRESSED_RGBA_S3TC_DXT5: - dwFourCC := FOURCC_DXT5; - tfCOMPRESSED_LUMINANCE_LATC1: - dwFourCC := FOURCC_ATI1; - tfCOMPRESSED_LUMINANCE_ALPHA_LATC2: - dwFourCC := FOURCC_ATI2; - else - Result := False; - end; - end; - end - else if IsFloatFormat(iFormat) then - begin - with DX9header.SurfaceFormat.ddpf do - begin - dwFlags := DDPF_FOURCC; - case iFormat of - tfINTENSITY_FLOAT16, tfLUMINANCE_FLOAT16, tfR16F: - dwFourCC := FOURCC_R16F; - tfRGBA_FLOAT16: - dwFourCC := FOURCC_A16B16G16R16F; - tfINTENSITY_FLOAT32, tfLUMINANCE_FLOAT32, tfR32F: - dwFourCC := FOURCC_R32F; - tfLUMINANCE_ALPHA_FLOAT16, tfRG16F: - dwFourCC := FOURCC_G16R16F; - tfLUMINANCE_ALPHA_FLOAT32, tfRG32F: - dwFourCC := FOURCC_G32R32F; - tfRGBA_FLOAT32: - dwFourCC := FOURCC_A32B32G32R32F - else - Result := False; - end; - end; - end - else - with DX9header.SurfaceFormat.ddpf do - begin - dwFourCC := 0; - dwRGBBitCount := bpe * 8; - case bpe of - 1: - begin - for i := 0 to High(cImageDataFormat8bits) do - if (cImageDataFormat8bits[i].colorFormat = colorFormat) and - (cImageDataFormat8bits[i].TexFormat = iFormat) and - (cImageDataFormat8bits[i].dType = dataType) then - begin - dwFlags := cImageDataFormat8bits[i].ColorFlag; - dwRBitMask := cImageDataFormat8bits[i].RBits; - dwGBitMask := cImageDataFormat8bits[i].GBits; - dwBBitMask := cImageDataFormat8bits[i].BBits; - dwRGBAlphaBitMask := cImageDataFormat8bits[i].ABits; - Break; - end; - end; - - 2: - begin - for i := 0 to High(cImageDataFormat16bits) do - if (cImageDataFormat16bits[i].colorFormat = colorFormat) and - (cImageDataFormat16bits[i].TexFormat = iFormat) and - (cImageDataFormat16bits[i].dType = dataType) then - begin - dwFlags := cImageDataFormat16bits[i].ColorFlag; - dwRBitMask := cImageDataFormat16bits[i].RBits; - dwGBitMask := cImageDataFormat16bits[i].GBits; - dwBBitMask := cImageDataFormat16bits[i].BBits; - dwRGBAlphaBitMask := cImageDataFormat16bits[i].ABits; - Break; - end; - end; - - 3: - begin - for i := 0 to High(cImageDataFormat24bits) do - if (cImageDataFormat24bits[i].colorFormat = colorFormat) and - (cImageDataFormat24bits[i].TexFormat = iFormat) and - (cImageDataFormat24bits[i].dType = dataType) then - begin - dwFlags := cImageDataFormat24bits[i].ColorFlag; - dwRBitMask := cImageDataFormat24bits[i].RBits; - dwGBitMask := cImageDataFormat24bits[i].GBits; - dwBBitMask := cImageDataFormat24bits[i].BBits; - dwRGBAlphaBitMask := cImageDataFormat24bits[i].ABits; - Break; - end; - end; - - 4: - begin - for i := 0 to High(cImageDataFormat32bits) do - if (cImageDataFormat32bits[i].colorFormat = colorFormat) and - (cImageDataFormat32bits[i].TexFormat = iFormat) and - (cImageDataFormat32bits[i].dType = dataType) then - begin - dwFlags := cImageDataFormat32bits[i].ColorFlag; - dwRBitMask := cImageDataFormat32bits[i].RBits; - dwGBitMask := cImageDataFormat32bits[i].GBits; - dwBBitMask := cImageDataFormat32bits[i].BBits; - dwRGBAlphaBitMask := cImageDataFormat32bits[i].ABits; - Break; - end; - end; - - else - Result := False; - end; // of case - end; - -end; - -//--------------------------------------------------------------------------------------------- - -function FindDDSCompatibleDataFormat(const iFormat: TglInternalFormat; out colorFormat: Cardinal; - out dataType: Cardinal): Boolean; -var - i: Integer; -begin - Result := False; - // 32 bits data format - for i := 0 to High(cImageDataFormat32bits) do - if cImageDataFormat32bits[i].TexFormat = iFormat then - begin - colorFormat := cImageDataFormat32bits[i].colorFormat; - dataType := cImageDataFormat32bits[i].dType; - Result := True; - exit; - end; - // 24 bits data format - for i := 0 to High(cImageDataFormat24bits) do - if cImageDataFormat24bits[i].TexFormat = iFormat then - begin - colorFormat := cImageDataFormat24bits[i].colorFormat; - dataType := cImageDataFormat24bits[i].dType; - Result := True; - exit; - end; - // 16 bits data format - for i := 0 to High(cImageDataFormat16bits) do - if cImageDataFormat16bits[i].TexFormat = iFormat then - begin - colorFormat := cImageDataFormat16bits[i].colorFormat; - dataType := cImageDataFormat16bits[i].dType; - Result := True; - exit; - end; - // 8 bits data format - for i := 0 to High(cImageDataFormat8bits) do - if cImageDataFormat8bits[i].TexFormat = iFormat then - begin - colorFormat := cImageDataFormat8bits[i].colorFormat; - dataType := cImageDataFormat8bits[i].dType; - Result := True; - exit; - end; -end; - -end. diff --git a/Sourcex/Formatx.GL2.pas b/Sourcex/Formatx.GL2.pas deleted file mode 100644 index 27ce8016..00000000 --- a/Sourcex/Formatx.GL2.pas +++ /dev/null @@ -1,340 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.GL2; - -(* - Ghoul2 (GLM/GLA) file format loading structures - Note: Also referred to as MDX (MDXM/MDXA) format in C source. -*) - -interface - -uses - System.Classes, - System.SysUtils, - - GLScene.VectorGeometry, - GLScene.VectorTypes; - -type - TGLMHeader = record - fileID: array [0 .. 3] of char; - version: integer; - strFile, animName: array [0 .. 63] of char; - animIndex, numBones, numLODs, ofsLODs, numSurfaces, ofsSurfHierarchy, ofsEnd: integer; - end; - - TGLMSurfaceHeirachyOffsets = array of integer; - - TGLMSurfaceHeirachy = record - name: array [0 .. 63] of char; - flags: LongWord; - shader: array [0 .. 63] of char; - shaderIndex, parentIndex, numChildren: integer; - childIndices: array of integer; - end; - - TGLMSurfaceHeader = record - ident, thisSurfaceIndex, ofsHeader, numVerts, ofsVerts, numTriangles, ofsTriangles, - numBoneReferences, ofsBoneReferences, ofsEnd: integer; - end; - - TGLMTriangle = record - indices: array [0 .. 2] of integer; - end; - - TGLMVertex = record - normal, vertex: TVector3f; - uiNumWeightsAndBoneIndices: Cardinal; // packed int - BoneWeightings: array [0 .. 3] of Byte; - end; - - TGLMSurface = record - SurfaceHeader: TGLMSurfaceHeader; - Triangles: array of TGLMTriangle; - Vertices: array of TGLMVertex; - TexCoords: array of TVector2f; - BoneReferences: array of integer; - end; - - TGLMLODInfo = record - ofsEnd: integer; - end; - - TGLMLODSurfaceOffsets = array of integer; - - TGLMLODs = record - LODInfo: TGLMLODInfo; - LODSurfaceOffsets: TGLMLODSurfaceOffsets; - Surfaces: array of TGLMSurface; - end; - - TGLAHeader = record - fileID: array [0 .. 3] of char; - version: integer; - name: array [0 .. 63] of char; - fScale: single; - numFrames, ofsFrames, numBones, ofsCompBonePool, ofsSkel, ofsEnd: integer; - end; - - TGLABone = array [0 .. 2] of TVector4f; - TGLACompQuatBone = array [0 .. 6] of Word; { 14 bytes } - - TGLASkeletonOffsets = array of integer; - - TGLASkeleton = record - name: array [0 .. 63] of char; - flags: LongWord; - parent: integer; - BasePoseMat, BasePoseMatInv: TGLABone; - numChildren: integer; - children: array of integer; - end; - - // Ghoul2 Model structure - TFileGLM = class - public - ModelHeader: TGLMHeader; - SurfaceHeirachyOffsets: TGLMSurfaceHeirachyOffsets; - SurfaceHeirachy: array of TGLMSurfaceHeirachy; - LODs: array of TGLMLODs; - procedure LoadFromStream(aStream: TStream); - end; - - // Ghoul2 Animation structure - TFileGLA = class - public - AnimHeader: TGLAHeader; - SkeletonOffsets: TGLASkeletonOffsets; - Skeleton: array of TGLASkeleton; - BoneIndices: array of integer; - CompBonePool: array of TGLACompQuatBone; - function GetCompressedMatrix(Frame, Bone: integer): TGLACompQuatBone; - function GetUnCompressedMatrix(Frame, Bone: integer): TGLMatrix; - procedure LoadFromStream(aStream: TStream); - end; - -function G2_GetVertWeights(const vert: TGLMVertex): integer; -function G2_GetVertBoneIndex(const vert: TGLMVertex; iWeightNum: integer): integer; -function G2_GetVertBoneWeight(const vert: TGLMVertex; iWeightNum: Cardinal; - var fTotalWeight: single; const iNumWeights: Cardinal): single; - -procedure MC_UnCompressQuat(var mat: TGLMatrix; const comp: TGLACompQuatBone); - -// ------------------------------------------------------------------ -implementation -// ------------------------------------------------------------------ - -// ------------------ -// ------------------ Misc routines ------------------ -// ------------------ - -// Adapted from mdx_format.h -// static inline int G2_GetVertWeights( const mdxmVertex_t *pVert ) -// static inline int G2_GetVertBoneIndex( const mdxmVertex_t *pVert, const int iWeightNum) -// static inline float G2_GetVertBoneWeight( const mdxmVertex_t *pVert, const int iWeightNum, float &fTotalWeight, int iNumWeights ) - -function G2_GetVertWeights(const vert: TGLMVertex): integer; -begin - // Get number of bones per vertex (0..3)+1 = (1..4) - result := (vert.uiNumWeightsAndBoneIndices shr 30) + 1; -end; - -function G2_GetVertBoneIndex(const vert: TGLMVertex; iWeightNum: integer): integer; -begin - // Extract the bone reference array index, a 5-bit integer - result := (vert.uiNumWeightsAndBoneIndices shr (5 * iWeightNum)) and 31; -end; - -function G2_GetVertBoneWeight(const vert: TGLMVertex; iWeightNum: Cardinal; - var fTotalWeight: single; const iNumWeights: Cardinal): single; -var - fBoneWeight: single; - iTemp: Cardinal; -begin - if (iWeightNum = iNumWeights - 1) then - begin - // No need to calculate final weight value, return the - // weight left over out of 1 - fBoneWeight := 1 - fTotalWeight; - end - else - begin - // Get the initial 8-bit bone weight - iTemp := vert.BoneWeightings[iWeightNum]; - // Get the 2-bit overflow and 'or' it to the front of the - // weight to get 10-bit integer weight (0..1023) - iTemp := iTemp or ((vert.uiNumWeightsAndBoneIndices shr (12 + (iWeightNum * 2))) and $300); - // Convert to floating point weight (0..1) - fBoneWeight := iTemp / 1023; - // Accumulate total weight - fTotalWeight := fTotalWeight + fBoneWeight; - end; - result := fBoneWeight; -end; - -// Adapted from matcomp.c -// void MC_UnCompressQuat(float mat[3][4],const unsigned char * comp) - -procedure MC_UnCompressQuat(var mat: TGLMatrix; const comp: TGLACompQuatBone); -begin - mat := QuaternionToMatrix(QuaternionMake([comp[1] - 32726, comp[2] - 32726, comp[3] - 32726], - comp[0] - 32726)); - mat.V[3] := VectorMake(comp[4] / 64 - 512, comp[5] / 64 - 512, comp[6] / 64 - 512, 1); -end; - - -// ------------------ -// ------------------ TFileGLM ------------------ -// ------------------ - -procedure TFileGLM.LoadFromStream(aStream: TStream); -var - idstr: array [0 .. 3] of char; - i, j: integer; - ofs, LODofs: int64; -begin - aStream.Read(idstr, sizeof(idstr)); - aStream.Position := 0; - - if not(idstr = '2LGM') then - begin - raise Exception.Create(Format('Unknown or incorrect identity tag: [%s]', [idstr])); - exit; - end; - - aStream.Read(ModelHeader, sizeof(ModelHeader)); - - if ModelHeader.version <> 6 then - raise Exception.Create(Format('Only GLM (MDXM) version 6 is supported. File is version %d.', - [ModelHeader.version])); - - SetLength(SurfaceHeirachyOffsets, ModelHeader.numSurfaces); - aStream.Read(SurfaceHeirachyOffsets[0], sizeof(integer) * ModelHeader.numSurfaces); - - SetLength(SurfaceHeirachy, ModelHeader.numSurfaces); - for i := 0 to ModelHeader.numSurfaces - 1 do - with SurfaceHeirachy[i] do - begin - aStream.Read(name, Length(name)); - aStream.Read(flags, sizeof(LongWord)); - aStream.Read(shader, Length(shader)); - aStream.Read(shaderIndex, sizeof(integer)); - aStream.Read(parentIndex, sizeof(integer)); - aStream.Read(numChildren, sizeof(integer)); - if numChildren > 0 then - begin - SetLength(childIndices, numChildren); - aStream.Read(childIndices[0], numChildren * sizeof(integer)); - end - else - SetLength(childIndices, 0); - end; - - SetLength(LODs, ModelHeader.numLODs); - for i := 0 to ModelHeader.numLODs - 1 do - with LODs[i] do - begin - LODofs := aStream.Position; - aStream.Read(LODInfo, sizeof(LODInfo)); - SetLength(LODSurfaceOffsets, ModelHeader.numSurfaces); - aStream.Read(LODSurfaceOffsets[0], sizeof(integer) * ModelHeader.numSurfaces); - SetLength(Surfaces, ModelHeader.numSurfaces); - for j := 0 to ModelHeader.numSurfaces - 1 do - with Surfaces[j] do - begin - ofs := aStream.Position; - aStream.Read(SurfaceHeader, sizeof(TGLMSurfaceHeader)); - SetLength(Triangles, SurfaceHeader.numTriangles); - SetLength(Vertices, SurfaceHeader.numVerts); - SetLength(TexCoords, SurfaceHeader.numVerts); - SetLength(BoneReferences, SurfaceHeader.numBoneReferences); - aStream.Position := ofs + SurfaceHeader.ofsTriangles; - aStream.Read(Triangles[0], SurfaceHeader.numTriangles * sizeof(TGLMTriangle)); - aStream.Position := ofs + SurfaceHeader.ofsVerts; - aStream.Read(Vertices[0], SurfaceHeader.numVerts * sizeof(TGLMVertex)); - aStream.Read(TexCoords[0], SurfaceHeader.numVerts * sizeof(TVector2f)); - aStream.Position := ofs + SurfaceHeader.ofsBoneReferences; - aStream.Read(BoneReferences[0], SurfaceHeader.numBoneReferences * sizeof(integer)); - aStream.Position := ofs + SurfaceHeader.ofsEnd; - end; - aStream.Position := LODofs + LODInfo.ofsEnd; - end; -end; - - -// ------------------ -// ------------------ TFileGLA ------------------ -// ------------------ - -function TFileGLA.GetCompressedMatrix(Frame, Bone: integer): TGLACompQuatBone; -begin - result := CompBonePool[BoneIndices[Frame * AnimHeader.numBones + Bone]]; -end; - -// GetUnCompressedMatrix -// -function TFileGLA.GetUnCompressedMatrix(Frame, Bone: integer): TGLMatrix; -begin - MC_UnCompressQuat(result, CompBonePool[BoneIndices[Frame * AnimHeader.numBones + Bone]]); -end; - -procedure TFileGLA.LoadFromStream(aStream: TStream); -var - idstr: array [0 .. 3] of char; - i, temp: integer; - buf: array of array [0 .. 2] of Byte; -begin - aStream.Read(idstr, sizeof(idstr)); - aStream.Position := 0; - - if not(idstr = '2LGA') then - begin - raise Exception.Create(Format('Unknown or incorrect identity tag: [%s]', [idstr])); - exit; - end; - - aStream.Read(AnimHeader, sizeof(AnimHeader)); - - if AnimHeader.version <> 6 then - raise Exception.Create(Format('Only GLA (MDXA) version 6 is supported. File is version %d.', - [AnimHeader.version])); - - SetLength(SkeletonOffsets, AnimHeader.numBones); - aStream.Read(SkeletonOffsets[0], sizeof(integer) * AnimHeader.numBones); - - SetLength(Skeleton, AnimHeader.numBones); - for i := 0 to AnimHeader.numBones - 1 do - with Skeleton[i] do - begin - aStream.Read(name, Length(name)); - aStream.Read(flags, sizeof(LongWord)); - aStream.Read(parent, sizeof(integer)); - aStream.Read(BasePoseMat, sizeof(TGLABone)); - aStream.Read(BasePoseMatInv, sizeof(TGLABone)); - aStream.Read(numChildren, sizeof(integer)); - if numChildren > 0 then - begin - SetLength(children, numChildren); - aStream.Read(children[0], numChildren * sizeof(integer)); - end - else - SetLength(children, 0); - end; - - aStream.Position := AnimHeader.ofsFrames; - SetLength(BoneIndices, AnimHeader.numFrames * AnimHeader.numBones); - SetLength(buf, AnimHeader.numFrames * AnimHeader.numBones * 3); - aStream.Read(buf[0], AnimHeader.numFrames * AnimHeader.numBones * 3); - for i := 0 to AnimHeader.numFrames * AnimHeader.numBones - 1 do - BoneIndices[i] := (buf[i][2] shl 16) or (buf[i][1] shl 8) or buf[i][0]; - SetLength(buf, 0); - - aStream.Position := AnimHeader.ofsCompBonePool; - temp := AnimHeader.ofsEnd - AnimHeader.ofsCompBonePool; - SetLength(CompBonePool, temp div sizeof(TGLACompQuatBone)); - aStream.Read(CompBonePool[0], temp); -end; - -end. diff --git a/Sourcex/Formatx.HDRImage.pas b/Sourcex/Formatx.HDRImage.pas index 4da5f698..828b4868 100644 --- a/Sourcex/Formatx.HDRImage.pas +++ b/Sourcex/Formatx.HDRImage.pas @@ -35,7 +35,7 @@ implementation uses GXS.FileHDR, - GXS.TextureFormat; + GLScene.TextureFormat; // ------------------ // ------------------ THDRImage ------------------ diff --git a/Sourcex/Formatx.LWO.pas b/Sourcex/Formatx.LWO.pas deleted file mode 100644 index ee13ee13..00000000 --- a/Sourcex/Formatx.LWO.pas +++ /dev/null @@ -1,2468 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.LWO; - -(* ============================================================= - -This unit provides functions, constants and now classes for use in -working with Lightwave3D Object files. - -Chunk ID constants are defined for all of the Chunk IDs listed -in the Lightwave 7.5 sdk. -It is important to note that this is a constant work-in-progress -and as such there are omissions and may be errors. Feedback and -suggestions would be appreciated. -There are two ways of using this unit. The first uses user-defines -callbacks to handle parsing lwo chunk data. The second way uses -object orientation. - -Loading LWO chunk data via callbacks -A function is provided for loading a Lightwave object from a file. -The Loader itself uses a callback mechanism for the loading of -Lightwave object chunks. The callback is called for every chunk -(with the exception of the FORM and LWOB or LWO2 chunks). - -The Chunk struct passed in the callback contains members for the -chunk ID, chunk size and pointer to chunk data. This data is -untouched internally so any parsing and numeric formatting -is up to you. This provides maximum flexibility and allows you to -handle the data that you need without loading the entire object -into ram first. - -The chunk data memory is freed upon the return of the callback -so do not keep a reference to the chunk data. Copy it to your own -storage. - -function LoadLW0(const Filename: string; ReadProc: TLWOReadProc; - UserData: Pointer): LongWord; cdecl; - - Filename: The fully qualified filename of the file to be - loaded. - - ReadCallback: The address of a TLWOReadCallback procedure - defined as: - TLWOReadCallback = procedure(Chunk: TLWChunk; - UserData: Pointer); cdecl; - This procedure will be called for every chunk - encountered in the Lightwave object file. The - Chunk parameter is the chunk struct of the chunk - being loaded. UserData is the pointer supplied - in the original call to LoadLWO (see below). - - UserData: A pointer to user supplied data to be passed - in the ReadCallback. - -A non-zero results indicates that the object file was parsed -successfully. - -Loading LWO chunks via objects -============================ -To load data from a lightwave object file, create an instance of -TLWObjectFile and call its LoadFromFile method. - -The data can then be accessed with the Chunks array property and -iterated in combination with the ChunkCount property. - -Chunk data is parsed and interfaced by descendents of the TLWChunk -class. I have made handlers for the following chunk types: - -TLWLayr Modeler Layer chunk -TLWPnts Points chunk -TLWPols Polygons chunk -TLWPTag Polygon tag mapping -TLWSurf Surface subchunk container -TLWTags Tags (Name tag strings for named items) -TLWVMap Vertex Mapping - -The data for chunks without handlers can be gotten at with the -Data and Size properties of the TLWChunk. Data is a pointer to -the start of the chunk data. This data is unparsed. -Data is nil for descendents. - - -This should provide enough to move geometry into your favourite -delphi-based 3d engine. - - -Making chunk handler objects -============================ - -All chunk types are derived from TLWChunk in the following manner: - -TLWChunk - -ex: - -TLWPTag <- PTAG chunk type. polygon tag map. - -TLWParentChunk <- A base class for chunks that can contain other chunks. - This is not necessarily how the data is stored in - the file but more for ease of access to data. - ex: - TLWPnts <- PNTS chunk type (points) - TLWLayr <- LAYR chunk type (modeler layer) - TLWSurf <- SURF chunk type (constains surface attributes as sub chunks) - TLWSubChunk <- A base class for chunks whose max data len is 65536 bytes. - TLWDiff <- DIFF subchunk type (diffuse surface parameter) - TLWSpec <- SPEC subchunk type (specularity surface parameter)... - etc. - -Each descendent of TLWChunk or TLWSubChunk is required to override -the GetID class function, the LoadData method and the Clear method -to provide custom handling for chunktype data. - -ex: -... -type - TLWPnts = class (TLWParentChunk) - private - FPoints: TVEC12DynArray; - function GetCount: LongWord; - protected - procedure Clear; override; - procedure LoadData(AStream: TStream; DataStart, DataSize: LongWord); override; - public - class function GetID: TID4; override; - function GetVMap(VMapID: TID4; out VMap: TLWVMap): boolean; - property Count: LongWord read GetCount; - property Points: TVEC12DynArray read FPoints; - end; -... - -// Return the the chunk id that is the target of this handler - -class function TLWPnts.GetID: TID4; -begin - result := ID_PNTS; -end; - -// Load the point data - the stream is already positioned at the start of the chunk data - -procedure TLWPnts.LoadData(AStream: TStream; DataStart, DataSize: LongWord); -begin - SetLength(FPoints,DataSize div 12); // allocate storage for DataSize div 12 points - ReadMotorolaNumber(AStream,@FPoints[0],4,DataSize div 4); // read the point data -end; - - -// Cleanup - Free any memory that you've allocated - -procedure TLWPnts.Clear; -begin - SetLength(FPoints,0); -end; - - -Utility Functions -================= -A function is provided for converting an array of numbers between -Motorola and Intel format (big endian <-> little endian). Converting -only needs to be done for numeric types that are of 2 or 4 byte -lengths. - -procedure ReverseByteOrder(ValueIn: Pointer; Size: integer; Count: integer = 1); - - ValueIn: The address of a number or array of numbers to have their - bytes swapped. - Size: The size in bytes of each numeric type. - Count: The count of numbers in the numbers array. The default - value is 1. - -Two routines are provided for reading and writing big endian -(Motorola and misc other processor vendors ) numbers to and from a -stream. These routines handle 2 and 4 byte numeric types and can -also handle arrays. - -procedure ReadMotorolaNumber(Stream: TStream; Data: Pointer; - ElementSize: integer; Count: integer = 1); - -function WriteMotorolaNumber(Stream: TStream; Data: Pointer; - ElementSize: integer; Count: integer = 1): Integer; - -Each take a valid TStream descendent, a pointer to the numeric data, -the element size of the data elements (either 2 or 4) and the array -element count if sending an array. The default count is 1. - -Notes for improvement of this unit: - -- A version ID tag should be visible to all chunks in order to - provide handling for Lightwave pre 6.0 object files. - -- Chunk type handlers should leave memory allocation to - the base class (TLWChunk) and act more as an interface - to the data pointed to by Data in TLWChunk. This would - keep memory allocation very efficient and make implementing - chunk handlers even easier. - - Author: Brian Johns brianjohns1@hotmail.com - Purpose: Lightwave object support unit for Delphi. - Notes: For the Lightwave Object File Format documentation please refer to - http://www.lightwave3d.com/developer. - Lightwave3D is a registered trademark of Newtek Incorporated. - -===================================================================== *) - -interface - - -uses - System.Classes, - System.SysUtils, - System.IOUtils, - System.Math, - GLScene.VectorGeometry; - -type - - TID4 = array [0 .. 3] of AnsiChar; - PID4 = ^TID4; - TID4DynArray = array of TID4; - -const - ID_NULL = '#0#0#0#0'; // NULL ID - - ID_LWSC: TID4 = 'LWSC'; // Lightwave scene file - ID_FORM: TID4 = 'FORM'; // IFF Form - ID_LWOB: TID4 = 'LWOB'; // Lightwave Object version 1.0 - 5.x - ID_LWLO: TID4 = 'LWLO'; // Lightwave Layered Object - ID_LAYR: TID4 = 'LAYR'; // LAYER - ID_PNTS: TID4 = 'PNTS'; // Points chunk - ID_SRFS: TID4 = 'SRFS'; // Surface Names chunk - ID_POLS: TID4 = 'POLS'; // Polygons chunk - ID_CRVS: TID4 = 'CRVS'; // Curves chunk - ID_PCHS: TID4 = 'PCHS'; // Patches chunk - ID_SURF: TID4 = 'SURF'; // Surfaces chunk - ID_COLR: TID4 = 'COLR'; // Color chunk - - ID_FLAG: TID4 = 'FLAG'; // Surface Flags - - ID_LUMI: TID4 = 'LUMI'; // Luminosity - ID_DIFF: TID4 = 'DIFF'; // Diffuse - ID_SPEC: TID4 = 'SPEC'; // Specular - ID_REFL: TID4 = 'REFL'; // Reflective - ID_TRAN: TID4 = 'TRAN'; // Transparency - - ID_VLUM: TID4 = 'VLUM'; // Luminosity - ID_VDIF: TID4 = 'VDIF'; // Diffuse - ID_VSPC: TID4 = 'VSPC'; // Specularity - ID_VRFL: TID4 = 'VRFL'; // Reflective - ID_VTRN: TID4 = 'VTRN'; // Transparency - - ID_GLOS: TID4 = 'GLOS'; // Glossiness SmallInt - - ID_SIDE: TID4 = 'SIDE'; // Sidedness - - ID_RFLT: TID4 = 'RFLT'; // REFLECTION MODE (PRE 6.0) - - ID_RFOP: TID4 = 'RFOP'; // REFLECTION OPTIONS - ID_RIMG: TID4 = 'RIMG'; // REFLECTION IMAGE - ID_RSAN: TID4 = 'RSAN'; // REFLECTION MAP SEAM ANGLE - ID_RIND: TID4 = 'RIND'; // REFRACTIVE INDEX - ID_EDGE: TID4 = 'EDGE'; // EDGE TRANSPARENCY THRESHOLD - ID_SMAN: TID4 = 'SMAN'; // SMOOTHING ANGLE RADIANS - ID_ALPH: TID4 = 'ALPH'; // ALPHA MODE - ID_CTEX: TID4 = 'CTEX'; // COLOR TEXTURE - ID_DTEX: TID4 = 'DTEX'; // DIFFUSE TEXTURE - ID_STEX: TID4 = 'STEX'; // SPECULAR TEXTURE - ID_RTEX: TID4 = 'RTEX'; // REFLECTIION TEXTURE - ID_TTEX: TID4 = 'TTEX'; // TRANSPARENCY TEXTURE - ID_LTEX: TID4 = 'LTEX'; // LUMINANCE TEXTURE - ID_BTEX: TID4 = 'BTEX'; // BUMP TEXTURE - ID_TFLG: TID4 = 'TFLG'; // TEXTURE FLAGS - ID_TSIZ: TID4 = 'TSIZ'; // TEXTURE SIZE - ID_TCTR: TID4 = 'TCTR'; // TEXTURE CENTER - ID_TFAL: TID4 = 'TFAL'; // TEXTURE FALLOFF - ID_TVEL: TID4 = 'TVAL'; // TEXTURE VALUE - ID_TREF: TID4 = 'TREF'; // TEXTURE REFERENCE - ID_TCLR: TID4 = 'TCLR'; // TEXTURE COLOR - ID_TVAL: TID4 = 'TVAL'; // TEXTURE VALUE - ID_TAMP: TID4 = 'TAMP'; // TEXTURE AMPLITUDE - ID_TFP0: TID4 = 'TFP0'; // TEXTURE PARAMETERS - ID_TFP1: TID4 = 'TFP1'; // - ID_TFP2: TID4 = 'TFP2'; // - ID_TIP0: TID4 = 'TIP0'; // - ID_TIP1: TID4 = 'TIP1'; // - ID_TIP2: TID4 = 'TIP2'; // - ID_TSP0: TID4 = 'TSP0'; // - ID_TSP1: TID4 = 'TSP1'; // - ID_TSP2: TID4 = 'TSP2'; // - ID_TFRQ: TID4 = 'TFRQ'; // - ID_TIMG: TID4 = 'TIMG'; // TEXTURE IMG - ID_TALP: TID4 = 'TALP'; // - ID_TWRP: TID4 = 'TWRP'; // TEXTURE WRAP - ID_TAAS: TID4 = 'TAAS'; // - ID_TOPC: TID4 = 'TOPC'; // - ID_SHDR: TID4 = 'SHDR'; // - ID_SDAT: TID4 = 'SDAT'; // - ID_IMSQ: TID4 = 'IMSQ'; // IMAGE SEQUENCE - ID_FLYR: TID4 = 'FLYR'; // FLYER SEQUENCE - ID_IMCC: TID4 = 'IMCC'; // - - SURF_FLAG_LUMINOUS = 1; - SURF_FLAG_OUTLINE = 2; - SURF_FLAG_SMOOTHING = 4; - SURF_FLAG_COLORHIGHLIGHTS = 8; - SURF_FLAG_COLORFILTER = 16; - SURF_FLAG_OPAQUEEDGE = 32; - SURF_FLAG_TRANSPARENTEDGE = 64; - SURF_FLAG_SHARPTERMINATOR = 128; - SURF_FLAG_DOUBLESIDED = 256; - SURF_FLAG_ADDITIVE = 512; - SURF_FLAG_SHADOWALPHA = 1024; - - CURV_CONTINUITY_FIRST = 1; - CURV_CONTINUITY_LAST = 2; - - IMSQ_FLAG_LOOP = 1; - IMSQ_FLAG_INTERLACE = 2; - - ID_LWO2: TID4 = 'LWO2'; // OBJECT - ID_VMAP: TID4 = 'VMAP'; // VERTEX MAP - ID_TAGS: TID4 = 'TAGS'; // TAGS? - ID_PTAG: TID4 = 'PTAG'; // POLYGON TAG MAP - ID_VMAD: TID4 = 'VMAD'; // DISCONTINUOUS VERTEX MAP - ID_ENVL: TID4 = 'ENVL'; // ENVELOPE - ID_CLIP: TID4 = 'CLIP'; // CLIP - ID_BBOX: TID4 = 'BBOX'; // BOUNDING BOX - ID_DESC: TID4 = 'DESC'; // DESCRIPTION - ID_TEXT: TID4 = 'TEXT'; // TEXT - ID_ICON: TID4 = 'ICON'; // ICON - - ENVL_PRE: TID4 = 'PRE'#0; // PRE-BEHAVIOUR - ENVL_POST: TID4 = 'POST'; // POST - ENVL_KEY: TID4 = 'KEY'#0; // KEY - ENVL_SPAN: TID4 = 'SPAN'; // SPAN - ENVL_CHAN: TID4 = 'CHAN'; // CHAN - ENVL_NAME: TID4 = 'NAME'; // NAME - - ID_STIL: TID4 = 'STIL'; // STILL IMAGE FILENAME - ID_ISEQ: TID4 = 'ISEQ'; // IMAGE SEQUENCE - ID_ANIM: TID4 = 'ANIM'; // PLUGIN ANIMATION - ID_STCC: TID4 = 'STCC'; // COLOR CYCLING STILL - ID_CONT: TID4 = 'CONT'; // CONTRAST - ID_BRIT: TID4 = 'BRIT'; // BRIGHTNESS - ID_SATR: TID4 = 'SATR'; // SATURATION - ID_HUE: TID4 = 'HUE'#0; // HUE - ID_GAMMA: TID4 = 'GAMM'; // GAMMA - ID_NEGA: TID4 = 'NEGA'; // NEGATIVE IMAGE - ID_IFLT: TID4 = 'IFLT'; // IMAGE PLUG-IN FILTER - ID_PFLT: TID4 = 'PFLT'; // PIXEL PLUG-IN FILTER - - POLS_TYPE_FACE: TID4 = 'FACE'; // FACES - POLS_TYPE_CURV: TID4 = 'CURV'; // CURVE - POLS_TYPE_PTCH: TID4 = 'PTCH'; // PATCH - POLS_TYPE_MBAL: TID4 = 'MBAL'; // METABALL - POLS_TYPE_BONE: TID4 = 'BONE'; // SKELEGON? - - VMAP_TYPE_PICK: TID4 = 'PICK'; // SELECTION SET - VMAP_TYPE_WGHT: TID4 = 'WGHT'; // WEIGHT MAP - VMAP_TYPE_MNVW: TID4 = 'MNVW'; // SUBPATCH WEIGHT MAP - VMAP_TYPE_TXUV: TID4 = 'TXUV'; // UV MAP - VMAP_TYPE_RGB: TID4 = 'RGB'#0; // RGB MAP - VMAP_TYPE_RGBA: TID4 = 'RGBA'; // RGBA MAP - VMAP_TYPE_MORF: TID4 = 'MORF'; // MORPH MAP: RELATIVE VERTEX DISPLACEMENT - VMAP_TYPE_SPOT: TID4 = 'SPOT'; // SPOT MAP: ABSOLUTE VERTEX POSITIONS - - PTAG_TYPE_SURF: TID4 = 'SURF'; // SURFACE - PTAG_TYPE_PART: TID4 = 'PART'; // PARENT PART - PTAG_TYPE_SMGP: TID4 = 'SMGP'; // SMOOTH GROUP - - PRE_POST_RESET = 0; // RESET - PRE_POST_CONSTANT = 1; // CONSTANT - PRE_POST_REPEAT = 2; // REPEAT - PRE_POST_OSCILLATE = 3; // OSCILLATE - PRE_POST_OFFSET = 4; // OFFSET REPEAT - PRE_POST_LINEAR = 5; // LINEAR - - POLS_VCOUNT_MASK = $3FF; - POLS_FLAGS_MASK = $FC00; - - SIDE_FRONT = 1; - SIDE_BACK = 2; - SIDE_FRONT_AND_BACK = SIDE_FRONT and SIDE_BACK; - - RFOP_BACKDROP = 0; - RFOP_RAYTRACEANDBACKDROP = 1; - RFOP_SPHERICALMAP = 2; - RFOP_RAYTRACEANDSPHERICALMAP = 3; - -type - TI1 = ShortInt; - PI1 = ^TI1; - - TI2 = SmallInt; - PI2 = ^TI2; - - TI4 = LongInt; - PI4 = ^TI4; - - TU1 = Byte; - PU1 = ^TU1; - TU1DynArray = array of TU1; - - TU2 = Word; - PU2 = ^TU2; - TU2Array = array [0 .. 65534] of TU2; - PU2Array = ^TU2Array; - TU2DynArray = array of TU2; - - TU4 = LongWord; - PU4 = ^TU4; - TU4Array = array [0 .. 65534] of TU4; - PU4Array = ^TU4Array; - TU4DynArray = array of TU4; - - TF4 = Single; - PF4 = ^TF4; - TF4Array = array [0 .. 65534] of TF4; - PF4Array = ^TF4Array; - TF4DynArray = array of TF4; - - TANG4 = TF4; - PANG4 = ^TANG4; - - // TS0 = PAnsiChar; - - TVec12 = array [0 .. 2] of TF4; - PVec12 = ^TVec12; - - TVec12Array = array [0 .. 65534] of TVec12; - PVec12Array = ^TVec12Array; - TVec12DynArray = array of TVec12; - - TColr12 = TVec12; - PColr12 = ^TColr12; - - TColr12DynArray = array of TColr12; - - TColr4 = array [0 .. 3] of TU1; - PColr4 = ^TColr4; - - // Lightwave Chunk Struct - Used in TLWOReadCallback - PLWChunkRec = ^TLWChunkRec; - - TLWChunkRec = record - id: TID4; - size: TU4; - data: Pointer; - end; - - // Lightwave SubChunk Struct - Used in TLWOReadCallback - PLWSubChunkRec = ^TLWSubChunkRec; - - TLWSubChunkRec = record - id: TID4; - size: TU2; - data: Pointer; - end; - - TLWPolsInfo = record - norm: TVec12; - vnorms: TVec12DynArray; - surfid: TU2; - end; - - TLWPolsInfoDynArray = array of TLWPolsInfo; - - TLWPntsInfo = record - npols: TU2; - pols: TU2DynArray; - end; - - TLWPntsInfoDynArray = array of TLWPntsInfo; - - TLWPolsDynArray = TU2DynArray; - - TLWPolyTagMapDynArray = TU2DynArray; - - TLWPolyTagMap = record - poly: TU2; - tag: TU2; - end; - - PLWPolyTagMap = ^TLWPolyTagMap; - - // Value Map - TLWVertexMap = record - vert: TU2; - values: TF4DynArray; - end; - - TLWVertexMapDynArray = array of TLWVertexMap; - - TLWChunkList = class; - TLWParentChunk = class; - - TLWChunk = class(TPersistent) - private - FData: Pointer; - FID: TID4; - FSize: TU4; - FParentChunk: TLWParentChunk; - FOwner: TLWChunkList; - function GetRootChunks: TLWChunkList; - function GetIndex: Integer; - protected - procedure Clear; virtual; - procedure LoadData(AStream: TStream; - DataStart, DataSize: LongWord); virtual; - procedure Loaded; virtual; - public - destructor Destroy; override; - class function GetID: TID4; virtual; - procedure LoadFromStream(AStream: TStream); virtual; - property data: Pointer read FData; - property id: TID4 read FID; - property size: TU4 read FSize; - // ParentChunk may be nil indicating this is a root chunk. ie. TLWLayr - property ParentChunk: TLWParentChunk read FParentChunk; - property RootChunks: TLWChunkList read GetRootChunks; - property Index: Integer read GetIndex; - property Owner: TLWChunkList read FOwner; - end; - - TLWChunkClass = class of TLWChunk; - - TLWSubChunk = class(TLWChunk) - public - procedure LoadFromStream(AStream: TStream); override; - end; - - TLWChunkFind = procedure(AChunk: TLWChunk; Criteria: Pointer; - var Found: boolean); - - TLWChunkList = class(TList) - private - FOwnsItems: boolean; - FOwner: TObject; - function GetItem(Index: Integer): TLWChunk; - protected - procedure Loaded; virtual; - public - constructor Create(AOwnsItems: boolean; AOwner: TObject); - destructor Destroy; override; - function Add(AChunk: TLWChunk): Integer; - procedure Clear; override; - procedure Delete(Index: Integer); - function FindChunk(ChunkFind: TLWChunkFind; Criteria: Pointer; - StartIndex: Integer = 0): Integer; - property Items[Index: Integer]: TLWChunk read GetItem; default; - property OwnsItems: boolean read FOwnsItems; - property Owner: TObject read FOwner; - end; - - TLWParentChunk = class(TLWChunk) - private - FItems: TLWChunkList; - function GetItems: TLWChunkList; - function GetFloatParam(Param: TID4): Single; - function GetWordParam(Param: TID4): Word; - function GetVec3Param(Param: TID4): TVec12; - function GetLongParam(Param: TID4): LongWord; - function GetVXParam(Param: TID4): Word; - protected - function GetParamAddr(Param: TID4): Pointer; virtual; - procedure Clear; override; - procedure Loaded; override; - public - property Items: TLWChunkList read GetItems; - property ParamAddr[Param: TID4]: Pointer read GetParamAddr; - property FloatParam[Param: TID4]: Single read GetFloatParam; - property WordParam[Param: TID4]: Word read GetWordParam; - property LongParam[Param: TID4]: LongWord read GetLongParam; - property Vec3Param[Param: TID4]: TVec12 read GetVec3Param; - property VXParam[Param: TID4]: Word read GetVXParam; - end; - - TLWVMap = class; - - TLWPnts = class(TLWParentChunk) - private - FPnts: TVec12DynArray; - FPntsInfo: TLWPntsInfoDynArray; - function GetPntsCount: LongWord; - function AddPoly(PntIdx, PolyIdx: Integer): Integer; - protected - procedure Clear; override; - procedure LoadData(AStream: TStream; - DataStart, DataSize: LongWord); override; - public - class function GetID: TID4; override; - function GetVMap(VMapID: TID4; out VMap: TLWVMap): boolean; - property PntsCount: LongWord read GetPntsCount; - property Pnts: TVec12DynArray read FPnts; - property PntsInfo: TLWPntsInfoDynArray read FPntsInfo; - end; - - TLWPols = class(TLWParentChunk) - private - FPolsType: TID4; - FPols: TLWPolsDynArray; - FPolsInfo: TLWPolsInfoDynArray; - FPolsCount: Integer; - function GetPolsByIndex(AIndex: TU2): Integer; - function GetIndiceCount: TU4; - function GetIndice(AIndex: Integer): TU2; - function GetPolsCount: Integer; - procedure CalcPolsNormals; - procedure CalcPntsNormals; - protected - procedure Clear; override; - procedure LoadData(AStream: TStream; - DataStart, DataSize: LongWord); override; - procedure Loaded; override; - public - class function GetID: TID4; override; - function GetPolsByPntIdx(VertIdx: TU2; var VertPolys: TU2DynArray): Integer; - property PolsByIndex[AIndex: TU2]: Integer read GetPolsByIndex; - property IndiceCount: TU4 read GetIndiceCount; - property Indices[AIndex: Integer]: TU2 read GetIndice; - property PolsType: TID4 read FPolsType; - property PolsCount: Integer read GetPolsCount; - property PolsInfo: TLWPolsInfoDynArray read FPolsInfo; - end; - - TLWVMap = class(TLWChunk) - private - FDimensions: TU2; - FName: string; - FValues: TLWVertexMapDynArray; - FVMapType: TID4; - function GetValue(AIndex: TU2): TLWVertexMap; - function GetValueCount: Integer; - protected - procedure Clear; override; - procedure LoadData(AStream: TStream; - DataStart, DataSize: LongWord); override; - public - class function GetID: TID4; override; - property Dimensions: TU2 read FDimensions; - property Name: string read FName; - property Value[AIndex: TU2]: TLWVertexMap read GetValue; - property ValueCount: Integer read GetValueCount; - property VMapType: TID4 read FVMapType; - end; - - TLWTags = class(TLWChunk) - private - FTags: TStrings; - function GetTags: TStrings; - protected - procedure Clear; override; - procedure LoadData(AStream: TStream; - DataStart, DataSize: LongWord); override; - public - destructor Destroy; override; - class function GetID: TID4; override; - function TagToName(tag: TU2): string; - property Tags: TStrings read GetTags; - end; - - TLWSurf = class(TLWParentChunk) - private - FName: string; - FSource: string; - function GetSurfId: Integer; - protected - function GetParamAddr(Param: TID4): Pointer; override; - procedure LoadData(AStream: TStream; - DataStart, DataSize: LongWord); override; - public - destructor Destroy; override; - class function GetID: TID4; override; - property surfid: Integer read GetSurfId; - property Name: string read FName; - property Source: string read FSource; - end; - - TLWLayr = class(TLWParentChunk) - private - FFlags: TU2; - FName: string; - FNumber: TU2; - FParent: TU2; - FPivot: TVec12; - protected - procedure LoadData(AStream: TStream; - DataStart, DataSize: LongWord); override; - public - destructor Destroy; override; - class function GetID: TID4; override; - property Flags: TU2 read FFlags; - property Name: string read FName; - property Number: TU2 read FNumber; - property Parent: TU2 read FParent; - property Pivot: TVec12 read FPivot; - end; - - TLWPTag = class(TLWChunk) - private - FMapType: TID4; - FTagMaps: TLWPolyTagMapDynArray; - FTags: TU2DynArray; - function AddTag(Value: TU2): Integer; - function GetTag(AIndex: Integer): TU2; - function GetTagCount: Integer; - function GetTagMapCount: Integer; - function GetTagMaps(AIndex: Integer): TLWPolyTagMap; - procedure ValidateTagInfo; - protected - procedure Clear; override; - procedure LoadData(AStream: TStream; - DataStart, DataSize: LongWord); override; - public - constructor Create; - function GetPolsByTag(tag: TU2; var PolyIndices: TU2DynArray): Integer; - class function GetID: TID4; override; - property MapType: TID4 read FMapType; - property TagCount: Integer read GetTagCount; - property TagMapCount: Integer read GetTagMapCount; - property TagMaps[AIndex: Integer]: TLWPolyTagMap read GetTagMaps; default; - property Tags[AIndex: Integer]: TU2 read GetTag; - end; - - TLWObjectFile = class(TObject) - private - FChunks: TLWChunkList; - FFileName: string; - function GetChunks: TLWChunkList; - function GetCount: Integer; - function GetSurfaceByName(Index: string): TLWSurf; - function GetSurfaceByTag(Index: TU2): TLWSurf; - public - constructor Create; - destructor Destroy; override; - function TagToName(tag: TU2): string; - procedure LoadFromFile(const AFilename: string); - procedure LoadFromStream(AStream: TStream); - property ChunkCount: Integer read GetCount; - property Chunks: TLWChunkList read GetChunks; - property FileName: string read FFileName; - property SurfaceByName[Index: string]: TLWSurf read GetSurfaceByName; - property SurfaceByTag[Index: TU2]: TLWSurf read GetSurfaceByTag; - end; - - TLWClip = class(TLWParentChunk) - private - FClipIndex: TU4; - protected - procedure LoadData(AStream: TStream; - DataStart, DataSize: LongWord); override; - public - class function GetID: TID4; override; - property ClipIndex: TU4 read FClipIndex; - end; - - TLWContentNotify = procedure(Sender: TObject; var Content: string) of object; - - TLWContentDir = class - private - FSubDirs: TStrings; - FRoot: string; - function GetSubDirs: TStrings; - procedure SetRoot(const Value: string); - procedure SetSubDirs(const Value: TStrings); - // function ContentSearch(AFilename: string): string; - public - destructor Destroy; override; - function FindContent(AFilename: string): string; - property Root: string read FRoot write SetRoot; - property SubDirs: TStrings read GetSubDirs write SetSubDirs; - end; - - TLWOReadCallback = procedure(Chunk: TLWChunkRec; data: Pointer); cdecl; - -procedure RegisterChunkClass(ChunkClass: TLWChunkClass); - -function LoadLW0FromStream(Stream: TStream; ReadCallback: TLWOReadCallback; - UserData: Pointer): LongWord; cdecl; -function LoadLWOFromFile(const AFilename: string; - ReadCallback: TLWOReadCallback; UserData: Pointer): LongWord; - -procedure ReadMotorolaNumber(Stream: TStream; data: Pointer; - ElementSize: Integer; Count: Integer = 1); -function WriteMotorolaNumber(Stream: TStream; data: Pointer; - ElementSize: Integer; Count: Integer = 1): Integer; - -function ReadS0(Stream: TStream; out Str: string): Integer; -procedure WriteS0(Stream: TStream; data: string); - -procedure WriteU4AsVX(Stream: TStream; data: Pointer; Count: Integer); -function ReadVXAsU4(Stream: TStream; data: Pointer; Count: Integer = 1) - : Integer; - -procedure ReverseByteOrder(ValueIn: Pointer; size: Integer; Count: Integer = 1); - -function ToDosPath(const Path: string): string; -function ToUnixPath(const Path: string): string; - -function ID4ToInt(const id: TID4): Integer; - -// ChunkFind procedures -procedure FindChunkById(AChunk: TLWChunk; data: Pointer; var Found: boolean); -procedure FindSurfaceByName(AChunk: TLWChunk; AName: Pointer; - var Found: boolean); -procedure FindSurfaceByTag(AChunk: TLWChunk; ATag: Pointer; var Found: boolean); - -procedure FindVMapByName(AChunk: TLWChunk; AName: Pointer; var Found: boolean); -procedure FindClipByClipIndex(AChunk: TLWChunk; AIndex: Pointer; - var Found: boolean); - -function GetContentDir: TLWContentDir; - -// -------------------------------------------------------------------- -implementation -// -------------------------------------------------------------------- - -type - PWord = ^Word; - PLongWord = ^LongWord; - -var - ChunkClasses: TList; - ContentDir: TLWContentDir; - -function ToDosPath(const Path: string): string; -var - i: Integer; -begin - result := Path; - for i := 1 to Length(result) do - if result[i] = '/' then - result[i] := '\'; -end; - -function ToUnixPath(const Path: string): string; -var - i: Integer; -begin - result := Path; - for i := 1 to Length(result) do - if result[i] = '\' then - result[i] := '/'; -end; - -function GetContentDir: TLWContentDir; -begin - if ContentDir = nil then - ContentDir := TLWContentDir.Create; - result := ContentDir; -end; - -procedure FindChunkById(AChunk: TLWChunk; data: Pointer; var Found: boolean); -begin - if AChunk.FID = PID4(data)^ then - Found := true - else - Found := false; -end; - -procedure FindClipByClipIndex(AChunk: TLWChunk; AIndex: Pointer; - var Found: boolean); -begin - if (AChunk is TLWClip) and (TLWClip(AChunk).ClipIndex = PU2(AIndex)^) then - Found := true; -end; - -procedure FindSurfaceByName(AChunk: TLWChunk; AName: Pointer; - var Found: boolean); -begin - if (AChunk is TLWSurf) and (TLWSurf(AChunk).Name = PString(AName)^) then - Found := true; -end; - -procedure FindSurfaceByTag(AChunk: TLWChunk; ATag: Pointer; var Found: boolean); -begin - if (AChunk is TLWSurf) and (TLWSurf(AChunk).surfid = PU2(ATag)^) then - Found := true; -end; - -procedure FindVMapByName(AChunk: TLWChunk; AName: Pointer; var Found: boolean); -begin - if (AChunk is TLWVMap) and (TLWVMap(AChunk).Name = PString(AName)^) then - Found := true; -end; - -function VecAdd(v1, v2: TVec12): TVec12; -begin - result[0] := v1[0] + v2[0]; - result[1] := v1[1] + v2[1]; - result[2] := v1[2] + v2[2]; -end; - -function VecSub(v1, v2: TVec12): TVec12; -begin - result[0] := v1[0] - v2[0]; - result[1] := v1[1] - v2[1]; - result[2] := v1[2] - v2[2]; -end; - -function VecCross(v1, v2: TVec12): TVec12; -begin - result[0] := v1[1] * v2[2] - v1[2] * v2[1]; - result[1] := v1[2] * v2[0] - v1[0] * v2[2]; - result[2] := v1[0] * v2[1] - v1[1] * v2[0]; -end; - -function VecDot(v1, v2: TVec12): TF4; -begin - result := v1[0] * v2[0] + v1[1] * v2[1] + v1[2] * v2[2]; -end; - -function VecNorm(v: TVec12): TVec12; -var - mag: TF4; -begin - mag := Sqrt(VecDot(v, v)); - - if mag > 0 then - mag := 1 / mag; - - result[0] := v[0] * mag; - result[1] := v[1] * mag; - result[2] := v[2] * mag; -end; - -function CalcPlaneNormal(v1, v2, v3: TVec12): TVec12; -var - e1, e2: TVec12; -begin - e1 := VecSub(v2, v1); - e2 := VecSub(v3, v1); - result := VecCross(e1, e2); - result := VecNorm(result); -end; - -procedure FindSurfByName(Chunk: TLWChunk; var Found: boolean); -begin - -end; - -(*----------------------------------------------------------------------------- - Procedure: GetChunkClasses - Date: 08-Aug-2002 - Arguments: None - Result: TClassList - - Singleton access for the chunk class list. - -----------------------------------------------------------------------------*) -function GetChunkClasses: TList; -begin - if ChunkClasses = nil then - ChunkClasses := TList.Create; - result := ChunkClasses; -end; - -procedure UnRegisterChunkClasses; -var - i: Integer; -begin - with GetChunkClasses do - for i := 0 to Count - 1 do - UnregisterClass(TPersistentClass(Items[i])); -end; - -(*----------------------------------------------------------------------------- - Procedure: RegisterChunkClass - Date: 08-Aug-2002 - Arguments: ChunkClass: TLWChunkClass - Result: None - - Adds a user defined chunk class to the chunk class list. - -----------------------------------------------------------------------------*) -procedure RegisterChunkClass(ChunkClass: TLWChunkClass); -begin - GetChunkClasses.Add(ChunkClass); - // if FindClass(ChunkClass.ClassName) <> nil then - // UnRegisterClass(ChunkClass); - // RegisterClass(ChunkClass); -end; - -(*----------------------------------------------------------------------------- - Procedure: GetChunkClass - Date: 08-Aug-2002 - Arguments: ChunkID: TID4 - Result: TLWChunkClass - - Returns the chunk class associated with ChunkID. - -----------------------------------------------------------------------------*) -function GetChunkClass(ChunkID: TID4; ADefault: TLWChunkClass): TLWChunkClass; -var - i: Integer; -begin - - if ADefault = nil then - result := TLWChunk - else - result := ADefault; - - for i := 0 to ChunkClasses.Count - 1 do - begin - - if TLWChunkClass(ChunkClasses.Items[i]).GetID = ChunkID then - begin - - result := TLWChunkClass(ChunkClasses.Items[i]); - Exit; - - end; - - end; - -end; - -(*----------------------------------------------------------------------------- - Procedure: Tokenize - Date: 08-Aug-2002 - Arguments: const Src: string; Delimiter: Char; Dst: TStrings - Result: None - - Breaks up a string into TStrings items when the Delimiter character is - encountered. - -----------------------------------------------------------------------------*) -procedure Tokenize(const Src: string; Delimiter: Char; Dst: TStrings); -var - i, L, SL: Integer; - SubStr: string; -begin - if Dst = nil then - Exit; - - L := Length(Src); - if (L = 0) or (Dst = nil) then - Exit; - SubStr := ''; - for i := 1 to L do - begin - if (Src[i] <> Delimiter) then - SubStr := SubStr + Src[i] - else - begin - SL := Length(SubStr); - if SL > 0 then - begin - Dst.Add(SubStr); - SubStr := ''; - end; - end; - end; - if Length(SubStr) > 0 then - Dst.Add(SubStr); -end; - -(*----------------------------------------------------------------------------- - Procedure: LoadLW0FromStream - Date: 08-Aug-2002 - Arguments: Stream: TStream; ReadCallback: TLWOReadCallback; UserData: Pointer - Result: LongWord - -----------------------------------------------------------------------------*) -function LoadLW0FromStream(Stream: TStream; ReadCallback: TLWOReadCallback; - UserData: Pointer): LongWord; -var - Chunk: TLWChunkRec; - CurId: TID4; - StartPos, CurSize: TU4; - -begin - try - Stream.Read(CurId, 4); - - ReadMotorolaNumber(Stream, @CurSize, 4); - - if UpperCase(string(CurId)) = 'FORM' then - begin - Stream.Read(CurId, 4); - end - else - raise Exception.Create - ('Invalid magic number. Not a valid Lightwave Object'); - with Stream do - while Position < size do - begin - Read(Chunk, 8); - ReverseByteOrder(@Chunk.size, 4); - StartPos := Position; - GetMem(Chunk.data, Chunk.size); - Stream.Read(Chunk.data^, Chunk.size); - if Assigned(ReadCallback) then - ReadCallback(Chunk, UserData); - FreeMem(Chunk.data, Chunk.size); - Position := StartPos + Chunk.size + (StartPos + Chunk.size) mod 2; - end; - Stream.Free; - result := High(LongWord); - except - On E: Exception do - begin - Stream.Free; - result := 0; - end; - end; -end; - -function LoadLWOFromFile(const AFilename: String; - ReadCallback: TLWOReadCallback; UserData: Pointer): LongWord; -var - Stream: TStream; -begin - Stream := TFileStream.Create(AFilename, fmOpenRead); - try - result := LoadLW0FromStream(Stream, ReadCallback, UserData); - finally - Stream.Free; - end; -end; - -procedure ReverseByteOrder(ValueIn: Pointer; size: Integer; Count: Integer = 1); -var - W: Word; - pB: PByte; - Blo, Bhi: Byte; - L: LongWord; - i: Integer; -begin - i := 0; - - case size of - 2: - begin - - while i < Count do - begin - W := PU2Array(ValueIn)^[i]; - - pB := @W; - Blo := pB^; - Inc(pB); - Bhi := pB^; - pB^ := Blo; - Dec(pB); - pB^ := Bhi; - PU2Array(ValueIn)^[i] := W; - - Inc(i); - end; - end; - - 4: - begin - while i < Count do - begin - L := PU4Array(ValueIn)^[i]; - pB := @W; - Blo := pB^; - Inc(pB); - Bhi := pB^; - pB^ := Blo; - Dec(pB); - pB^ := Bhi; - PU4Array(ValueIn)^[i] := L; - - Inc(i); - end; - end; - else - raise Exception.Create('Lightwave.ReverseByteOrder: Invalid Size = ' + - IntToStr(size)); - end; -end; - -procedure ReadMotorolaNumber(Stream: TStream; data: Pointer; - ElementSize: Integer; Count: Integer = 1); -begin - Stream.Read(data^, Count * ElementSize); - - if (ElementSize = 2) or (ElementSize = 4) then - ReverseByteOrder(data, ElementSize, Count); -end; - -function WriteMotorolaNumber(Stream: TStream; data: Pointer; - ElementSize: Integer; Count: Integer = 1): Integer; -var - TempData: Pointer; -begin - result := 0; - if data <> nil then - begin - TempData := AllocMem(ElementSize * Count); - try - if (ElementSize = 2) or (ElementSize = 4) then - ReverseByteOrder(TempData, ElementSize, Count); - result := Stream.Write(data, Count * ElementSize); - except - on E: Exception do - begin - FreeMem(TempData, Count * ElementSize); - raise; - end; - end; - end; -end; - -function ReadS0(Stream: TStream; out Str: string): Integer; -var - Buf: array [0 .. 1] of AnsiChar; - StrBuf: string; -begin - Stream.Read(Buf, 2); - StrBuf := ''; - while Buf[1] <> #0 do - begin - StrBuf := StrBuf + string(Buf); - Stream.Read(Buf, 2); - end; - - if Buf[0] <> #0 then - StrBuf := StrBuf + Char(Buf[0]); - - Str := Copy(StrBuf, 1, Length(StrBuf)); - result := Length(Str) + 1; - result := result + (result mod 2); -end; - -function ValueOfVX(VX: Pointer): TU4; -var - TmpU2: TU2; - TmpU4: TU4; -begin - if PU1(VX)^ = $FF then - begin - TmpU4 := TU4(PU1(VX)^) and $FFFFFFF0; - ReverseByteOrder(@TmpU4, 4); - end - else - begin - TmpU2 := TU2(PU2(VX)^); - ReverseByteOrder(@TmpU2, 2); - TmpU4 := TmpU2; - end; - result := TmpU4; -end; - -function ReadVXAsU4(Stream: TStream; data: Pointer; Count: Integer = 1) - : Integer; -var - i, ReadCount: Integer; - BufByte: Byte; - TempU2: TU2; -begin - ReadCount := 0; - for i := 0 to Count - 1 do - begin - - Stream.Read(BufByte, 1); - Stream.Position := Stream.Position - 1; - - if BufByte = 255 then - begin - Stream.Read(data^, SizeOf(TU4)); - PU4Array(data)^[i] := PU4Array(data)^[i] and $FFFFFFF0; - ReverseByteOrder(data, SizeOf(TU4)); - Inc(ReadCount, 4); - end - else - begin - Stream.Read(TempU2, SizeOf(TU2)); - ReverseByteOrder(@TempU2, SizeOf(TU2)); - PU4Array(data)^[i] := TempU2; - Inc(ReadCount, 2); - end; - - end; - result := ReadCount; -end; - -function ReadVXAsU2(Stream: TStream; data: Pointer; Count: Integer = 1) - : Integer; -var - i, ReadCount: Integer; - BufByte: Byte; - TempU2: TU2; -begin - ReadCount := 0; - for i := 0 to Count - 1 do - begin - Stream.Read(BufByte, 1); - Stream.Position := Stream.Position - 1; - if BufByte = 255 then - begin - Stream.Position := Stream.Position + 4; - PU2Array(data)^[i] := 0; - Inc(ReadCount, 4); - end - else - begin - Stream.Read(TempU2, SizeOf(TU2)); - ReverseByteOrder(@TempU2, SizeOf(TU2)); - PU2Array(data)^[i] := TempU2; - Inc(ReadCount, 2); - end; - end; - result := ReadCount; -end; - -procedure WriteS0(Stream: TStream; data: string); -begin - // ToDo: WriteS0 -end; - -procedure WriteU4AsVX(Stream: TStream; data: Pointer; Count: Integer); -var - i: Integer; - TempU2: TU2; -begin - for i := 0 to Count - 1 do - begin - if PU4Array(data)^[i] < 65280 then - begin - TempU2 := PU4Array(data)^[i]; - WriteMotorolaNumber(Stream, @TempU2, SizeOf(TU2)); - end - else - WriteMotorolaNumber(Stream, data, SizeOf(TU4)); - end; -end; - -type - PInteger = ^Integer; - -function ID4ToInt(const id: TID4): Integer; -var - TmpId: AnsiString; -begin - - TmpId := id; - - TmpId := AnsiString(UpperCase(string(id))); - - result := PInteger(@TmpId)^; - -end; - -(*********************************** TLWChunk ********************************) - -destructor TLWChunk.Destroy; -begin - Clear; - inherited; -end; - -procedure TLWChunk.Clear; -begin - FreeMem(FData, FSize); - FSize := 0; - FData := nil; -end; - -class function TLWChunk.GetID: TID4; -begin - result := #0#0#0#0; -end; - -procedure TLWChunk.LoadData(AStream: TStream; DataStart, DataSize: LongWord); -begin - GetMem(FData, DataSize); - AStream.Read(PByteArray(FData)^[0], DataSize); -end; - -procedure TLWChunk.LoadFromStream(AStream: TStream); -var - DataStart: Integer; - DataSize: TU4; -begin - with AStream do - begin - - ReadMotorolaNumber(AStream, @DataSize, 4); - - DataStart := Position; - - FSize := DataSize; - - LoadData(AStream, DataStart, DataSize); - - Position := Cardinal(DataStart) + DataSize + - (Cardinal(DataStart) + DataSize) mod 2; - - end; -end; - - -(********************************* TLWChunkList *******************************) - -constructor TLWChunkList.Create(AOwnsItems: boolean; AOwner: TObject); -begin - inherited Create; - FOwnsItems := AOwnsItems; - FOwner := AOwner; -end; - -destructor TLWChunkList.Destroy; -begin - Clear; - inherited; -end; - -procedure TLWChunkList.Clear; -begin - while Count > 0 do - Delete(Count - 1); - inherited; -end; - -procedure TLWChunkList.Delete(Index: Integer); -begin - if FOwnsItems then - Items[Index].Free; - inherited Delete(Index); -end; - -function TLWChunkList.GetItem(Index: Integer): TLWChunk; -begin - result := TLWChunk(inherited Items[Index]); -end; - -(******************************** TLWObjectFile *******************************) - -constructor TLWObjectFile.Create; -begin - - inherited; - -end; - -destructor TLWObjectFile.Destroy; -begin - - FreeAndNil(FChunks); - - inherited; - -end; - -function TLWObjectFile.GetChunks: TLWChunkList; -begin - if FChunks = nil then - FChunks := TLWChunkList.Create(true, Self); - result := FChunks; -end; - -function TLWObjectFile.GetCount: Integer; -begin - result := Chunks.Count; -end; - -function TLWObjectFile.GetSurfaceByName(Index: string): TLWSurf; -var - SurfIdx: Integer; -begin - SurfIdx := Chunks.FindChunk(@FindSurfaceByName, @Index, 0); - if SurfIdx <> -1 then - result := TLWSurf(Chunks[SurfIdx]) - else - result := nil; -end; - -function TLWObjectFile.GetSurfaceByTag(Index: TU2): TLWSurf; -var - TagName: string; -begin - TagName := TagToName(Index); - result := SurfaceByName[TagName]; -end; - -procedure TLWObjectFile.LoadFromFile(const AFilename: string); -var - Stream: TMemoryStream; -begin - - Stream := TMemoryStream.Create; - try - Stream.LoadFromFile(AFilename); - - LoadFromStream(Stream); - Stream.Free; - FFileName := AFilename; - except - on E: Exception do - begin - Stream.Free; - raise; - end; - end; - -end; - -procedure TLWObjectFile.LoadFromStream(AStream: TStream); -var - CurId: TID4; - CurSize: LongWord; - CurPnts, CurPols, CurItems: TLWChunkList; -begin - CurPols := nil; - CurPnts := nil; - - AStream.Read(CurId, 4); - - ReadMotorolaNumber(AStream, @CurSize, 4); - - if UpperCase(string(CurId)) = 'FORM' then - begin - - AStream.Read(CurId, 4); - - if CurId <> 'LWO2' then - raise Exception.Create - ('Only Version 6.0+ version objects are supported.'); - - end - else - raise Exception.Create - ('Invalid magic number. Not a valid Lightwave Object'); - - CurItems := Chunks; - - while AStream.Position < AStream.size do - begin - AStream.Read(CurId, 4); - - if (CurId = ID_PTAG) then - begin - CurPols.Add(GetChunkClass(CurId, TLWChunk).Create); - -{$IFDEF WIN32} - CurPols[CurPols.Count - 1].FID := CurId; -{$ELSE} -// CurPols[CurPols.Count - 1].FID := CurId; -{$ENDIF} - LoadFromStream(AStream); - end - else if (CurId = ID_VMAP) or (CurId = ID_VMAD) then - begin - CurPnts.Add(GetChunkClass(CurId, TLWChunk).Create); -{$IFDEF WIN32} - CurPnts[CurPnts.Count - 1].FID := CurId; -{$ELSE} -// CurPnts[CurPnts.Count - 1].FID := CurId; -{$ENDIF} - LoadFromStream(AStream); - end - else - begin - if (CurId = ID_LAYR) or (CurId = ID_SURF) or (CurId = ID_TAGS) or - (CurId = ID_CLIP) then - CurItems := Chunks; - CurItems.Add(GetChunkClass(CurId, TLWChunk).Create); -{$IFDEF WIN32} - CurItems[CurItems.Count - 1].FID := CurId; -{$ELSE} -// CurItems[CurItems.Count - 1].FID := CurId; -{$ENDIF} - LoadFromStream(AStream); - end; - - if CurId = ID_LAYR then - CurItems := TLWParentChunk(CurItems[CurItems.Count - 1]).Items - else if CurId = ID_POLS then - CurPols := TLWParentChunk(CurItems[CurItems.Count - 1]).Items - else if CurId = ID_PNTS then - CurPnts := TLWParentChunk(CurItems[CurItems.Count - 1]).Items; - end; - Chunks.Loaded; -end; - -(*********************************** TLWPnts **********************************) - -function TLWPnts.AddPoly(PntIdx, PolyIdx: Integer): Integer; -var - i, L: Integer; -begin - // DONE: Pnts.AddPoly - - for i := 0 to FPntsInfo[PntIdx].npols - 1 do - begin - if FPntsInfo[PntIdx].pols[i] = PolyIdx then - begin - result := i; - Exit; - end; - end; - - L := Length(FPntsInfo[PntIdx].pols); - SetLength(FPntsInfo[PntIdx].pols, L + 1); - FPntsInfo[PntIdx].npols := L + 1; - FPntsInfo[PntIdx].pols[L] := PolyIdx; - result := L; -end; - -procedure TLWPnts.Clear; -var - i: Integer; -begin - for i := 0 to PntsCount - 1 do - SetLength(FPntsInfo[i].pols, 0); - SetLength(FPntsInfo, 0); - SetLength(FPnts, 0); -end; - -function TLWPnts.GetPntsCount: LongWord; -begin - result := Length(FPnts); -end; - -class function TLWPnts.GetID: TID4; -begin - result := ID_PNTS; -end; - -function TLWPnts.GetVMap(VMapID: TID4; out VMap: TLWVMap): boolean; -var - i: Integer; -begin - result := false; - for i := 0 to Items.Count - 1 do - begin - if (Items[i] is TLWVMap) and (TLWVMap(Items[i]).VMapType = VMapID) then - begin - - result := true; - VMap := TLWVMap(Items[i]); - Exit; - end; - - end; - -end; - -procedure TLWPnts.LoadData(AStream: TStream; DataStart, DataSize: LongWord); -begin - SetLength(FPnts, DataSize div 12); - // allocate storage for DataSize div 12 points - SetLength(FPntsInfo, DataSize div 12); // Point info - ReadMotorolaNumber(AStream, @FPnts[0], 4, DataSize div 4); - // read the point data -end; - -(*********************************** TLWPols **********************************) - -procedure TLWPols.CalcPolsNormals; -var - i, j, PolyIdx: Integer; - Pnts: TLWPnts; -begin - if IndiceCount = 0 then - Exit; - - with ParentChunk as TLWLayr do - Pnts := TLWPnts(Items[Items.FindChunk(@FindChunkById, @ID_PNTS, 0)]); - - for PolyIdx := 0 to FPolsCount - 1 do - begin - // DONE: call Pnts.AddPoly - i := PolsByIndex[PolyIdx]; - with Pnts do - begin - for j := 1 to Indices[i] do - AddPoly(Indices[i + j], PolyIdx); - SetLength(FPolsInfo[PolyIdx].vnorms, Indices[i]); - if Indices[PolyIdx] > 2 then - FPolsInfo[PolyIdx].norm := CalcPlaneNormal(Pnts[Indices[i + 1]], - Pnts[Indices[i + 2]], Pnts[Indices[i + 3]]) - else - FPolsInfo[PolyIdx].norm := VecNorm(Pnts[Indices[i + 1]]); - end; - end; -end; - -procedure TLWPols.Clear; -var - i: Integer; -begin - for i := 0 to FPolsCount - 1 do - SetLength(FPolsInfo[i].vnorms, 0); - SetLength(FPolsInfo, 0); - SetLength(FPols, 0); -end; - -function TLWPols.GetPolsByIndex(AIndex: TU2): Integer; -var - i, cnt: Cardinal; -begin - result := -1; - i := 0; - cnt := 0; - - if AIndex = 0 then - begin - result := 0; - Exit; - end; - - while (i < IndiceCount - 1) and (cnt <> AIndex) do - begin - Inc(i, Indices[i] + 1); - Inc(cnt); - end; - if cnt = AIndex then - result := i; -end; - -class function TLWPols.GetID: TID4; -begin - result := ID_POLS; -end; - -function TLWPols.GetIndiceCount: TU4; -begin - result := Length(FPols); -end; - -function TLWPols.GetIndice(AIndex: Integer): TU2; -begin - result := FPols[AIndex]; -end; - -function TLWPols.GetPolsCount: Integer; -begin - result := FPolsCount; -end; - -procedure TLWPols.LoadData(AStream: TStream; DataStart, DataSize: LongWord); -var - EndPos: Integer; - Idx: TU4; - TmpU2: TU2; -begin - - Idx := 0; - EndPos := DataStart + DataSize; - - with AStream do - begin - - Read(FPolsType, 4); - - // To avoid memory manager hits, set an estimate length of indices - SetLength(FPols, (DataSize - 4) div 2); - - while Position < EndPos do - begin - - ReadMotorolaNumber(AStream, @FPols[Idx], 2); - TmpU2 := FPols[Idx] and POLS_VCOUNT_MASK; - - ReadVXAsU2(AStream, @FPols[Idx + 1], TmpU2); - Inc(Idx, FPols[Idx] + 1); - Inc(FPolsCount); - end; - // correct length estimate errors if any - if (Idx + 1) < Cardinal(Length(FPols)) then - SetLength(FPols, Idx + 1); - end; - SetLength(FPolsInfo, FPolsCount); - CalcPolsNormals; -end; - -(*********************************** TLWVMap **********************************) - -procedure TLWVMap.Clear; -var - i: Integer; -begin - for i := 0 to Length(FValues) - 1 do - SetLength(FValues[i].values, 0); - SetLength(FValues, 0); -end; - -class function TLWVMap.GetID: TID4; -begin - result := ID_VMAP; -end; - -function TLWVMap.GetValue(AIndex: TU2): TLWVertexMap; -begin - result := FValues[AIndex]; -end; - -function TLWVMap.GetValueCount: Integer; -begin - result := Length(FValues); -end; - -procedure TLWVMap.LoadData(AStream: TStream; DataStart, DataSize: LongWord); -var - Idx: TU4; -begin - Idx := 0; - with AStream do - begin - Read(FVMapType, 4); - ReadMotorolaNumber(AStream, @FDimensions, 2); - ReadS0(AStream, FName); - if FDimensions > 0 then - begin - while Cardinal(Position) < (DataStart + DataSize) do - begin - SetLength(FValues, Length(FValues) + 1); - ReadVXAsU2(AStream, @FValues[Idx].vert, 1); - SetLength(FValues[Idx].values, Dimensions * 4); - ReadMotorolaNumber(AStream, @FValues[Idx].values[0], 4, Dimensions); - Inc(Idx); - end; - end; - end; -end; - -(*********************************** TLWTags **********************************) - -destructor TLWTags.Destroy; -begin - inherited; -end; - -procedure TLWTags.Clear; -begin - FreeAndNil(FTags); -end; - -class function TLWTags.GetID: TID4; -begin - result := ID_TAGS; -end; - -function TLWTags.GetTags: TStrings; -begin - if FTags = nil then - FTags := TStringList.Create; - result := FTags; -end; - -procedure TLWTags.LoadData(AStream: TStream; DataStart, DataSize: LongWord); -var - EndPos: TU4; - TmpStr: string; -begin - EndPos := DataStart + DataSize; - while Cardinal(AStream.Position) < Cardinal(EndPos) do - begin - ReadS0(AStream, TmpStr); - Tags.Add(TmpStr); - TmpStr := ''; - end; -end; - -function TLWTags.TagToName(tag: TU2): string; -begin - result := Tags[tag]; -end; - -(********************************* TLWSubChunk ********************************) - -procedure TLWSubChunk.LoadFromStream(AStream: TStream); -var - DataStart: Integer; - DataSize: TU2; -begin - with AStream do - begin - ReadMotorolaNumber(AStream, @DataSize, 2); - DataStart := Position; - FSize := DataSize; - LoadData(AStream, DataStart, DataSize); - Position := DataStart + DataSize + (DataStart + DataSize) mod 2; - end; -end; - -(*********************************** TLWLayr **********************************) - -destructor TLWLayr.Destroy; -begin - inherited; -end; - -class function TLWLayr.GetID: TID4; -begin - result := ID_LAYR; -end; - -procedure TLWLayr.LoadData(AStream: TStream; DataStart, DataSize: LongWord); -begin - ReadMotorolaNumber(AStream, @FNumber, 2); - ReadMotorolaNumber(AStream, @FFlags, 2); - ReadMotorolaNumber(AStream, @FPivot, 4, 3); - ReadS0(AStream, FName); - if ((DataStart + DataSize) - Cardinal(AStream.Position)) > 2 then - ReadMotorolaNumber(AStream, @FParent, 2); -end; - -(*********************************** TLWSurf **********************************) - -destructor TLWSurf.Destroy; -begin - inherited; -end; - -class function TLWSurf.GetID: TID4; -begin - result := ID_SURF; -end; - -function TLWSurf.GetParamAddr(Param: TID4): Pointer; -var - Idx: Integer; - sParam: string; -begin - result := inherited GetParamAddr(Param); - if (result = nil) and (Source <> '') then - begin - sParam := string(Param); - Idx := RootChunks.FindChunk(@FindSurfaceByName, @sParam, 0); - if Idx <> -1 then - result := TLWSurf(RootChunks[Idx]).ParamAddr[Param]; - end; -end; - -function TLWSurf.GetSurfId: Integer; -var - c, SurfIdx: Integer; -begin - c := 0; - SurfIdx := Owner.FindChunk(@FindChunkById, @ID_SURF); - - while (SurfIdx <> -1) and (Owner[SurfIdx] <> Self) do - begin - SurfIdx := Owner.FindChunk(@FindChunkById, @ID_SURF, SurfIdx + 1); - Inc(c); - end; - result := c; -end; - -procedure TLWSurf.LoadData(AStream: TStream; DataStart, DataSize: LongWord); -var - CurId: TID4; -begin - ReadS0(AStream, FName); - ReadS0(AStream, FSource); - while Cardinal(AStream.Position) < (DataStart + DataSize) do - begin - AStream.Read(CurId, 4); - Items.Add(GetChunkClass(CurId, TLWSubChunk).Create); -{$IFDEF WIN32} - with Items[Items.Count - 1] do -{$ELSE} -/// with Items[Items.Count - 1] do -{$ENDIF} - begin - FID := CurId; - LoadFromStream(AStream); - end; - end; -end; - -(*********************************** TLWPTag **********************************) - -constructor TLWPTag.Create; -begin - inherited; -end; - -function TLWPTag.AddTag(Value: TU2): Integer; -var - i, L: Integer; -begin - result := -1; - L := Length(FTags); - for i := 0 to L - 1 do - if Value = FTags[i] then - begin - result := i; - Exit; - end; - if result = -1 then - begin - SetLength(FTags, L + 1); - FTags[L] := Value; - result := L; - end; -end; - -procedure TLWPTag.Clear; -begin - SetLength(FTagMaps, 0); - SetLength(FTags, 0); -end; - -function TLWPTag.GetPolsByTag(tag: TU2; var PolyIndices: TU2DynArray): Integer; -var - i: Integer; - - procedure AddPoly(Value: TU2); - var - L: Integer; - begin - L := Length(PolyIndices); - SetLength(PolyIndices, L + 1); - PolyIndices[L] := Value; - end; -begin - for i := 0 to TagMapCount - 1 do - if TagMaps[i].tag = tag then - AddPoly(TagMaps[i].poly); - result := Length(PolyIndices); -end; - -class function TLWPTag.GetID: TID4; -begin - result := ID_PTAG; -end; - -function TLWPTag.GetTag(AIndex: Integer): TU2; -begin - ValidateTagInfo; - result := FTags[AIndex]; -end; - -function TLWPTag.GetTagCount: Integer; -begin - ValidateTagInfo; - result := Length(FTags); -end; - -function TLWPTag.GetTagMapCount: Integer; -begin - result := Length(FTagMaps) div 2; -end; - -function TLWPTag.GetTagMaps(AIndex: Integer): TLWPolyTagMap; -begin - result := PLWPolyTagMap(@FTagMaps[AIndex * 2])^; -end; - -procedure TLWPTag.LoadData(AStream: TStream; DataStart, DataSize: LongWord); -var - Idx: Integer; -begin - Idx := 0; - with AStream do - begin - Read(FMapType, 4); - SetLength(FTagMaps, (DataSize - 4) div 2); - while Cardinal(Position) < (DataStart + DataSize) do - begin - ReadVXAsU2(AStream, @FTagMaps[Idx]); - ReadMotorolaNumber(AStream, @FTagMaps[Idx + 1], 2); - Inc(Idx, 2); - end; - // correct length guestimate errors if any - if (Idx + 1) < Length(FTagMaps) then - SetLength(FTagMaps, Idx + 1); - end; -end; - -procedure TLWPTag.ValidateTagInfo; -var - i: Integer; -begin - if Length(FTags) > 0 then - Exit; - for i := 0 to TagMapCount - 1 do - AddTag(TagMaps[i].tag); -end; - -(******************************** TLWParentChunk ******************************) - -procedure TLWParentChunk.Clear; -begin - FreeAndNil(FItems); - inherited; -end; - -function TLWParentChunk.GetFloatParam(Param: TID4): Single; -var - pdata: Pointer; -begin - pdata := ParamAddr[Param]; - if pdata <> nil then - begin - - result := PF4(pdata)^; - ReverseByteOrder(@result, 4); - - end - else - result := 0.0; -end; - -function TLWParentChunk.GetItems: TLWChunkList; -begin - if FItems = nil then - FItems := TLWChunkList.Create(true, Self); - result := FItems; -end; - -function TLWParentChunk.GetLongParam(Param: TID4): LongWord; -var - pdata: Pointer; -begin - pdata := ParamAddr[Param]; - if pdata <> nil then - begin - - result := PU4(pdata)^; - ReverseByteOrder(@result, 4); - end - else - result := 0; -end; - -function TLWParentChunk.GetParamAddr(Param: TID4): Pointer; -var - Idx: Integer; -begin - result := nil; - Idx := Items.FindChunk(@FindChunkById, @Param, 0); - if Idx <> -1 then - result := Items[Idx].data; -end; - -function TLWPols.GetPolsByPntIdx(VertIdx: TU2; - var VertPolys: TU2DynArray): Integer; -var - i, j, L: Integer; -begin - L := 0; - if Length(VertPolys) > 0 then - SetLength(VertPolys, 0); - for i := 0 to PolsCount - 1 do - begin - for j := 1 to Indices[PolsByIndex[i]] do - begin - if Indices[PolsByIndex[i] + j] = VertIdx then - begin - L := Length(VertPolys); - SetLength(VertPolys, L + 1); - VertPolys[L] := i; - end; - end; - end; - result := L; -end; - -function TLWChunkList.Add(AChunk: TLWChunk): Integer; -begin - if (FOwner <> nil) and (FOwner is TLWParentChunk) then - AChunk.FParentChunk := TLWParentChunk(FOwner); - - AChunk.FOwner := Self; - result := inherited Add(AChunk); -end; - -procedure TLWPols.CalcPntsNormals; -var - i, j, k, PntIdx, PolyIdx, SurfIdx: Integer; - Pnts: TLWPnts; - // PTags: TLWPTag; - TmpAddr: Pointer; - sman: TF4; -begin - // Todo: CalcPntsNormals - if IndiceCount = 0 then - Exit; - with ParentChunk as TLWLayr do - Pnts := TLWPnts(Items[Items.FindChunk(@FindChunkById, @ID_PNTS, 0)]); - for PolyIdx := 0 to PolsCount - 1 do - begin - i := PolsByIndex[PolyIdx]; - SurfIdx := RootChunks.FindChunk(@FindSurfaceByTag, - @FPolsInfo[PolyIdx].surfid); - TmpAddr := TLWSurf(RootChunks[SurfIdx]).ParamAddr[ID_SMAN]; - if TmpAddr <> nil then - begin - sman := PF4(TmpAddr)^; - ReverseByteOrder(@sman, 4); - end - else - sman := 0; - for j := 1 to Indices[i] do - begin - FPolsInfo[PolyIdx].vnorms[j - 1] := FPolsInfo[PolyIdx].norm; - if sman <= 0 then - continue; - PntIdx := Indices[i + j]; - for k := 0 to Pnts.PntsInfo[PntIdx].npols - 1 do - begin - if Pnts.PntsInfo[PntIdx].pols[k] = PolyIdx then - continue; - if ArcCos(VecDot(FPolsInfo[PolyIdx].norm, - FPolsInfo[Pnts.PntsInfo[PntIdx].pols[k]].norm)) > sman then - continue; - FPolsInfo[PolyIdx].vnorms[j - 1] := - VecAdd(FPolsInfo[PolyIdx].vnorms[j - 1], - FPolsInfo[Pnts.PntsInfo[PntIdx].pols[k]].norm); - end; - FPolsInfo[PolyIdx].vnorms[j - 1] := - VecNorm(FPolsInfo[PolyIdx].vnorms[j - 1]); - end; - end; -end; - -function TLWChunk.GetRootChunks: TLWChunkList; -var - Parent: TLWParentChunk; -begin - result := nil; - if (FParentChunk = nil) then - begin - - if (FOwner is TLWChunkList) then - begin - result := FOwner; - Exit; - end; - - end - else - begin - Parent := FParentChunk; - while not(Parent.ParentChunk = nil) do - Parent := Parent.ParentChunk; - result := Parent.Owner; - end; -end; - -function TLWChunkList.FindChunk(ChunkFind: TLWChunkFind; Criteria: Pointer; - StartIndex: Integer): Integer; -var - Found: boolean; -begin - Found := false; - result := -1; - while (StartIndex < Count) and (not Found) do - begin - ChunkFind(Items[StartIndex], Criteria, Found); - if Found then - begin - result := StartIndex; - Exit; - end; - Inc(StartIndex); - end; -end; - -function TLWChunk.GetIndex: Integer; -begin - result := Owner.IndexOf(Self); -end; - -procedure TLWChunk.Loaded; -begin - // do nothing -end; - -procedure TLWChunkList.Loaded; -var - i: Integer; -begin - for i := 0 to Count - 1 do - begin - Items[i].Loaded; - end; -end; - -function TLWParentChunk.GetVec3Param(Param: TID4): TVec12; -var - pdata: Pointer; -begin - pdata := ParamAddr[Param]; - if pdata <> nil then - begin - - result := PVec12(pdata)^; - ReverseByteOrder(@result, 4, 3); - - end - else - begin - result[0] := 0; - result[1] := 1; - result[2] := 2; - end; -end; - -function TLWParentChunk.GetVXParam(Param: TID4): Word; -var - pdata: Pointer; -begin - pdata := ParamAddr[Param]; - if pdata <> nil then - result := ValueOfVX(pdata) - else - result := 0; -end; - -function TLWParentChunk.GetWordParam(Param: TID4): Word; -var - pdata: Pointer; -begin - pdata := ParamAddr[Param]; - if pdata <> nil then - begin - result := PU4(pdata)^; - ReverseByteOrder(@result, 2); - end - else - result := 0; -end; - -procedure TLWParentChunk.Loaded; -begin - Items.Loaded; -end; - -procedure TLWPols.Loaded; -begin - inherited; - CalcPntsNormals; -end; - -function TLWObjectFile.TagToName(tag: TU2): string; -var - TagsIdx: Integer; -begin - TagsIdx := Chunks.FindChunk(@FindChunkById, @ID_TAGS); - if TagsIdx <> -1 then - result := TLWTags(Chunks[TagsIdx]).TagToName(tag); -end; - - -(******************** TLWClip ********************) - -class function TLWClip.GetID: TID4; -begin - result := ID_CLIP; -end; - -procedure TLWClip.LoadData(AStream: TStream; DataStart, DataSize: LongWord); -var - CurId: TID4; -begin - ReadMotorolaNumber(AStream, @FClipIndex, 4); - while Cardinal(AStream.Position) < (DataStart + DataSize) do - begin - - AStream.Read(CurId, 4); - - Items.Add(GetChunkClass(CurId, TLWSubChunk).Create); - -{$IFDEF WIN32} - with Items[Items.Count - 1] do -{$ELSE} -/// with Items[Items.Count - 1] do -{$ENDIF} - begin - FID := CurId; - LoadFromStream(AStream); - end; - end; -end; - -// TLWContentDir - -(* function TLWContentDir.ContentSearch(AFilename: string): string; - var - i: Integer; - begin - if not FileExists(AFilename) then - begin - result := ExtractFileName(AFilename); - if not FileExists(result) then - begin - for i := 0 to SubDirs.Count - 1 do - begin - if FileExists(Root+'\'+SubDirs[i]+'\'+result) then - begin - result:=Root+'\'+SubDirs[i]+'\'+result; - Exit; - end; - - end; - result := ''; - end; - end; - end; -*) - -destructor TLWContentDir.Destroy; -begin - FreeAndNil(FSubDirs); - inherited; -end; - -function TLWContentDir.FindContent(AFilename: string): string; -var - i: Integer; -begin - if not FileExists(AFilename) then - begin - result := ExtractFileName(AFilename); - if not FileExists(result) then - begin - for i := 0 to SubDirs.Count - 1 do - begin - if FileExists(Root + '\' + SubDirs[i] + '\' + result) then - begin - result := Root + '\' + SubDirs[i] + '\' + result; - Exit; - end; - end; - result := ''; - end; - end; -end; - -function TLWContentDir.GetSubDirs: TStrings; -begin - if FSubDirs = nil then - FSubDirs := TStringList.Create; - result := FSubDirs; -end; - -procedure TLWContentDir.SetRoot(const Value: string); -begin - FRoot := Value; -end; - -procedure TLWContentDir.SetSubDirs(const Value: TStrings); -begin - SubDirs.Assign(Value); -end; - -//-------------------------------------------------------------------------- -initialization -//-------------------------------------------------------------------------- - -// Pnts -RegisterChunkClass(TLWPnts); -// Pols -RegisterChunkClass(TLWPols); -// VMap -RegisterChunkClass(TLWVMap); -// Tags -RegisterChunkClass(TLWTags); -// PTAG -RegisterChunkClass(TLWPTag); -// SURF -RegisterChunkClass(TLWSurf); -// LAYR -RegisterChunkClass(TLWLayr); -// CLIP -RegisterChunkClass(TLWClip); - -finalization - - // UnRegisterChunkClasses; - FreeAndNil(ChunkClasses); - FreeAndNil(ContentDir); - -end. diff --git a/Sourcex/Formatx.MD2.pas b/Sourcex/Formatx.MD2.pas deleted file mode 100644 index 233e87cc..00000000 --- a/Sourcex/Formatx.MD2.pas +++ /dev/null @@ -1,193 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.MD2; - -(* Loading methods for MD2 file format *) - -interface - -{$I GLScene.Defines.inc} - -{$R-} - -uses - System.Classes, - System.SysUtils, - - GLScene.VectorTypes; - -const - MAX_MD2_TRIANGLES = 4096; - MAX_MD2_VERTICES = 2048; - MAX_MD2_FRAMES = 512; - MAX_MD2_SKINS = 32; - MAX_MD2_SKINNAME = 64; - -type - PMD2VertexIndex = ^TMD2VertexIndex; - TMD2VertexIndex = record - A, B, C: integer; - A_S, A_T, - B_S, B_T, - C_S, C_T: single; - end; - - TMD2Triangle = record - VertexIndex: TVector3s; - TextureCoordIndex: TVector3s; - end; - - TMD2TriangleVertex = record - Vert: array[0..2] of byte; - LightnormalIndex: byte; - end; - - PMD2AliasFrame = ^TMD2AliasFrame; - TMD2AliasFrame = record - Scale: TVector3f; - Translate: TVector3f; - Name: array[0..15] of AnsiChar; - Vertices: array[0..0] of TMD2TriangleVertex; - end; - - TMD2Header = record - Ident: integer; - Version: integer; - - SkinWidth: integer; - SkinHeight: integer; - FrameSize: integer; - - Num_Skins: integer; - Num_Vertices: integer; - Num_TextureCoords: integer; - Num_VertexIndices: integer; - Num_GLCommdands: integer; - Num_Frames: integer; - - Offset_skins: integer; - Offset_st: integer; - Offset_tris: integer; - Offset_frames: integer; - Offset_glcmds: integer; - Offset_end: integer; - end; - - TIndexList = array of TMD2VertexIndex; - TGLVertexList = array of array of TVector3f; - - -type - TFileMD2 = class - private - FiFrames: longint; - FiVertices: longint; - FiTriangles: longint; - procedure FreeLists; - public - fIndexList : TIndexList; - fVertexList : TGLVertexList; - FrameNames : TStrings; - constructor Create; virtual; - destructor Destroy; override; - procedure LoadFromStream(aStream : TStream); - property iFrames: longInt read FiFrames; - property iVertices: longInt read FiVertices; - property iTriangles: longInt read FiTriangles; - - property IndexList: TIndexList read fIndexList; - property VertexList: TGLVertexList read fVertexList; - end; - -// ------------------------------------------------------------------ -implementation -// ------------------------------------------------------------------ - -// ------------------ -// ------------------ TFileMD2 ------------------ -// ------------------ - -constructor TFileMD2.Create; -begin - inherited; - FreeLists; - FrameNames := TStringList.Create; -end; - -destructor TFileMD2.Destroy; -begin - FreeLists; - FrameNames.Free; - inherited; -end; - -procedure TFileMD2.FreeLists; -begin - SetLength(fIndexList,0); - SetLength(fVertexList,0,0); - FiFrames := 0; - FiVertices := 0; - FiTriangles := 0; -end; - -procedure TFileMD2.LoadFromStream(aStream : TStream); -var - Skins: array[0..MAX_MD2_SKINS - 1, 0..63] of AnsiChar; - TextureCoords: array[0..MAX_MD2_VERTICES - 1] of TVector2s; - Buffer: array[0..MAX_MD2_VERTICES * 4 + 127] of byte; - Header: TMD2Header; - Triangle: TMD2Triangle; - I: integer; - J: integer; - Frame: PMD2AliasFrame; - FrameName : String; - -begin - FreeLists; - // read the modelinfo - aStream.Read(Header, SizeOf(Header)); - FiFrames := Header.Num_Frames; - FiVertices := Header.Num_Vertices; - FiTriangles := Header.Num_VertexIndices; - SetLength(fIndexList, FiTriangles); - SetLength(fVertexList, FiFrames, FiVertices); - // get the skins... - aStream.Read(Skins, Header.Num_Skins * MAX_MD2_SKINNAME); - // ...and the texcoords - aStream.Read(TextureCoords, Header.Num_TextureCoords * SizeOf(TVector2s)); - for I := 0 to Header.Num_VertexIndices - 1 do begin - aStream.Read(Triangle, SizeOf(TMD2Triangle)); - with fIndexList[I] do begin - A := Triangle.VertexIndex.Z; - B := Triangle.VertexIndex.Y; - C := Triangle.VertexIndex.X; - A_S := TextureCoords[Triangle.TextureCoordIndex.Z].X / Header.SkinWidth; - A_T := TextureCoords[Triangle.TextureCoordIndex.Z].Y / Header.SkinHeight; - B_S := TextureCoords[Triangle.TextureCoordIndex.Y].X / Header.SkinWidth; - B_T := TextureCoords[Triangle.TextureCoordIndex.Y].Y / Header.SkinHeight; - C_S := TextureCoords[Triangle.TextureCoordIndex.X].X / Header.SkinWidth; - C_T := TextureCoords[Triangle.TextureCoordIndex.X].Y / Header.SkinHeight; - end; - end; - for I := 0 to Header.Num_Frames - 1 do begin - Frame := PMD2AliasFrame(@Buffer); - // read animation / frame info - aStream.Read(Frame^, Header.FrameSize); - FrameName := Trim(String(Frame^.Name)); - if CharInSet(Copy(FrameName, Length(FrameName) - 1, 1)[1], ['0'..'9']) then - FrameName := Copy(FrameName, 1, Length(FrameName) - 2) - else - FrameName := Copy(FrameName, 1, Length(FrameName) - 1); - if FrameNames.IndexOf(FrameName) < 0 then - FrameNames.AddObject(FrameName, TObject(Cardinal(I))); - // fill the vertices list - for J := 0 to FiVertices - 1 do begin - fVertexList[i][J].X := Frame^.Vertices[J].Vert[0] * Frame^.Scale.X + Frame^.Translate.X; - fVertexList[i][J].Y := Frame^.Vertices[J].Vert[1] * Frame^.Scale.Y + Frame^.Translate.Y; - fVertexList[i][J].Z := Frame^.Vertices[J].Vert[2] * Frame^.Scale.Z + Frame^.Translate.Z; - end; - end; -end; - -end. diff --git a/Sourcex/Formatx.MD3.pas b/Sourcex/Formatx.MD3.pas deleted file mode 100644 index ffa45209..00000000 --- a/Sourcex/Formatx.MD3.pas +++ /dev/null @@ -1,147 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.MD3; - -(* FileMD3 - File loading methods for the MD3 file format *) - -interface - -uses - System.Classes, - GLScene.VectorTypes; - -type - // Quake3 MD3 structure types - TMD3Tag = record - strName: array [0 .. 63] of AnsiChar; - vPosition: TVector3f; - rotation: TMatrix3f; - end; - - // This part of the MD3 structure calls 2 things: - // A frame and a bone. It doesn't matter because we don't use it - (* TMD3Frame = record - min_bound,max_bounds, - local_origin : TVector3f; - radius : single; - name : array[0..15] of char; - end; *) - TMD3Bone = record - mins, maxs, position: TVector3f; - scale: single; - creator: array [0 .. 15] of AnsiChar; - end; - - TMD3Triangle = record - vertex: TVector3s; // value/64 to get real number position - normal: TVector2b; // Latitude, Longitude - end; - - TMD3Face = record - vertexIndices: TVector3i; - end; - - TMD3TexCoord = record - textureCoord: TVector2f; - end; - - TMD3Skin = record - strName: array [0 .. 63] of AnsiChar; - shaderIndex: Integer; - end; - - TMD3Header = record - fileID: array [0 .. 3] of AnsiChar; - version: Integer; - strFile: array [0 .. 63] of AnsiChar; - flags, numFrames, numTags, numMeshes, numMaxSkins, headerSize, tagStart, - tagEnd, fileSize: Integer; - end; - - TMD3MeshHeader = record - meshID: array [0 .. 3] of AnsiChar; - strName: array [0 .. 63] of AnsiChar; - flags, numMeshFrames, numSkins, numVertices, numTriangles, triStart, - headerSize, uvStart, vertexStart, meshSize: Integer; - end; - - TMD3MeshData = record - MeshHeader: TMD3MeshHeader; - Skins: array of TMD3Skin; - Triangles: array of TMD3Face; - TexCoords: array of TMD3TexCoord; - Vertices: array of TMD3Triangle; - end; - - TFileMD3 = class - public - ModelHeader: TMD3Header; - Bones: array of TMD3Bone; - Tags: array of TMD3Tag; - MeshData: array of TMD3MeshData; - procedure LoadFromStream(aStream: TStream); - end; - -// =================================================================== -implementation -// =================================================================== - -// ------------------ -// ------------------ TFileMD3 ------------------ -// ------------------ - -procedure TFileMD3.LoadFromStream(aStream: TStream); -var - i: Integer; - meshOffset: LongInt; -begin - aStream.Read(ModelHeader, sizeof(ModelHeader)); - - // Test for correct file ID and version - Assert(ModelHeader.fileID = 'IDP3', 'Incorrect MD3 file ID'); - Assert(ModelHeader.version = 15, 'Incorrect MD3 version number'); - - // Read in the bones - SetLength(Bones, ModelHeader.numFrames); - aStream.Read(Bones[0], sizeof(TMD3Bone) * ModelHeader.numFrames); - - // Read in the Tags - SetLength(Tags, ModelHeader.numFrames * ModelHeader.numTags); - if ModelHeader.numTags > 0 then - aStream.Read(Tags[0], sizeof(TMD3Tag) * ModelHeader.numFrames * - ModelHeader.numTags); - - // Read in the Mesh data - meshOffset := aStream.position; - SetLength(MeshData, ModelHeader.numMeshes); - for i := 0 to ModelHeader.numMeshes - 1 do - begin - with MeshData[i] do - begin - aStream.position := meshOffset; - aStream.Read(MeshHeader, sizeof(MeshHeader)); - // Set up the dynamic arrays - SetLength(Skins, MeshHeader.numSkins); - SetLength(Triangles, MeshHeader.numTriangles); - SetLength(TexCoords, MeshHeader.numVertices); - SetLength(Vertices, MeshHeader.numVertices * MeshHeader.numMeshFrames); - // Skins - aStream.Read(Skins[0], sizeof(TMD3Skin) * MeshHeader.numSkins); - // Face data - aStream.position := meshOffset + MeshHeader.triStart; - aStream.Read(Triangles[0], sizeof(TMD3Face) * MeshHeader.numTriangles); - // Texture coordinates - aStream.position := meshOffset + MeshHeader.uvStart; - aStream.Read(TexCoords[0], sizeof(TMD3TexCoord) * MeshHeader.numVertices); - // Vertices - aStream.position := meshOffset + MeshHeader.vertexStart; - aStream.Read(Vertices[0], sizeof(TMD3Triangle) * MeshHeader.numMeshFrames - * MeshHeader.numVertices); - // Increase the offset - meshOffset := meshOffset + MeshHeader.meshSize; - end; - end; -end; - -end. diff --git a/Sourcex/Formatx.OCT.pas b/Sourcex/Formatx.OCT.pas deleted file mode 100644 index e3845e70..00000000 --- a/Sourcex/Formatx.OCT.pas +++ /dev/null @@ -1,194 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.OCT; - -(* Loader for FSRad OCT files *) - -interface - -{$I GLScene.Defines.inc} - -uses - System.Classes, - System.SysUtils, - - GLScene.VectorTypes, - GLScene.VectorGeometry, - GLScene.VectorLists, - GXS.MeshUtils; - -type - - TOCTHeader = record - numVerts: Integer; - numFaces: Integer; - numTextures: Integer; - numLightmaps: Integer; - numLights: Integer; - end; - - TOCTVertex = record - tv: TTexPoint; // texture coordinates - lv: TTexPoint; // lightmap coordinates - pos: TAffineVector; // vertex position - end; - - TOCTFace = record - start: Integer; // first face vert in vertex array - num: Integer; // number of verts in the face - id: Integer; // texture index into the texture array - lid: Integer; // lightmap index into the lightmap array - p: THmgPlane; - end; - - POCTFace = ^TOCTFace; - - TOCTTexture = record - id: Integer; // texture id - Name: array [0 .. 63] of AnsiChar; // texture name - end; - - TOCTLightmap = record - id: Integer; // lightmaps id - map: array [0 .. 49151] of Byte; // 128 x 128 raw RGB data - end; - - POCTLightmap = ^TOCTLightmap; - - TOCTLight = record - pos: TAffineVector; // Position - color: TAffineVector; // Color (RGB) - intensity: Integer; // Intensity - end; - - TOCTFile = class(TObject) - public - Header: TOCTHeader; - Vertices: array of TOCTVertex; - Faces: array of TOCTFace; - Textures: array of TOCTTexture; - Lightmaps: array of TOCTLightmap; - Lights: array of TOCTLight; - PlayerPos: TAffineVector; - constructor Create; overload; - constructor Create(octStream: TStream); overload; - (* Saves content to stream in OCT format. - The Header is automatically prepared before streaming. *) - procedure SaveToStream(aStream: TStream); - procedure AddTriangles(vertexCoords: TGAffineVectorList; - texMapCoords: TGAffineVectorList; const textureName: String); - procedure AddLight(const lightPos: TAffineVector; const lightColor: TVector4f; - lightIntensity: Integer); - end; - -// ------------------------------------------------------------------ -implementation -// ------------------------------------------------------------------ - -// ------------------ -// ------------------ TOCTFile ------------------ -// ------------------ - -constructor TOCTFile.Create; -begin - inherited Create; -end; - -constructor TOCTFile.Create(octStream: TStream); -begin - inherited Create; - - // Read in the header - octStream.Read(Header, SizeOf(Header)); - - // then the rest of the stuff - SetLength(Vertices, Header.numVerts); - octStream.Read(Vertices[0], Header.numVerts * SizeOf(TOCTVertex)); - SetLength(Faces, Header.numFaces); - octStream.Read(Faces[0], Header.numFaces * SizeOf(TOCTFace)); - SetLength(Textures, Header.numTextures); - octStream.Read(Textures[0], Header.numTextures * SizeOf(TOCTTexture)); - SetLength(Lightmaps, Header.numLightmaps); - octStream.Read(Lightmaps[0], Header.numLightmaps * SizeOf(TOCTLightmap)); - SetLength(Lights, Header.numLights); - octStream.Read(Lights[0], Header.numLights * SizeOf(TOCTLight)); - octStream.Read(PlayerPos, SizeOf(PlayerPos)) -end; - -procedure TOCTFile.SaveToStream(aStream: TStream); -begin - with Header, aStream do - begin - numVerts := Length(Vertices); - numFaces := Length(Faces); - numTextures := Length(Textures); - numLightmaps := Length(Lightmaps); - numLights := Length(Lights); - - Write(Header, SizeOf(Header)); - Write(Vertices[0], numVerts * SizeOf(TOCTVertex)); - Write(Faces[0], numFaces * SizeOf(TOCTFace)); - Write(Textures[0], numTextures * SizeOf(TOCTTexture)); - Write(Lightmaps[0], numLightmaps * SizeOf(TOCTLightmap)); - Write(Lights[0], numLights * SizeOf(TOCTLight)); - Write(PlayerPos, SizeOf(PlayerPos)) - end; -end; - -procedure TOCTFile.AddTriangles(vertexCoords: TGAffineVectorList; - texMapCoords: TGAffineVectorList; const textureName: String); -var - i: Integer; - baseIdx, texIdx: Integer; -begin - Assert((texMapCoords = nil) or (texMapCoords.Count = vertexCoords.Count)); - - texIdx := Length(Textures); - SetLength(Textures, texIdx + 1); - Move(textureName[1], Textures[texIdx].Name[0], Length(textureName)); - SetLength(Lightmaps, 1); - FillChar(Lightmaps[0].map[0], 128 * 3, 255); - - baseIdx := Length(Vertices); - SetLength(Vertices, baseIdx + vertexCoords.Count); - for i := 0 to vertexCoords.Count - 1 do - with Vertices[baseIdx + i] do - begin - pos := vertexCoords.List[i]; - if Assigned(texMapCoords) then - tv := PTexPoint(@texMapCoords.List[i])^; - end; - - SetLength(Faces, vertexCoords.Count div 3); - i := 0; - while i < vertexCoords.Count do - begin - with Faces[i div 3] do - begin - start := baseIdx + i; - num := 3; - id := texIdx; - p := PlaneMake(vertexCoords[i], CalcPlaneNormal(vertexCoords[i + 0], - vertexCoords[i + 1], vertexCoords[i + 0])); - end; - Inc(i, 3); - end; -end; - -procedure TOCTFile.AddLight(const lightPos: TAffineVector; - const lightColor: TVector4f; lightIntensity: Integer); -var - n: Integer; -begin - n := Length(Lights); - SetLength(Lights, n + 1); - with Lights[n] do - begin - pos := lightPos; - color := PAffineVector(@lightColor)^; - intensity := lightIntensity; - end; -end; - -end. diff --git a/Sourcex/Formatx.Q3BSP.pas b/Sourcex/Formatx.Q3BSP.pas deleted file mode 100644 index e68f5dee..00000000 --- a/Sourcex/Formatx.Q3BSP.pas +++ /dev/null @@ -1,213 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.Q3BSP; - -(* Simple Quake III BSP file loader. *) - -interface - -uses - System.Classes, - System.SysUtils, - GLScene.VectorTypes; - -const - FACE_POLYGON = 1; - -const - MAX_TEXTURES = 1000; - -type - - TBSPHeader = record - StrID: array [0 .. 3] of AnsiChar; // This should always be 'IBSP' - Version: Integer; // This should be 0x2e for Quake 3 files - end; - - TBSPLump = record - Offset: Integer; // The offset into the file for the start of this lump - Length: Integer; // The length in bytes for this lump - end; - - TBSPBBox = array [0 .. 5] of Integer; - - TBSPNode = record - Plane: Integer; // Space partitioning plane - Children: array [0 .. 1] of Integer; // Back and front child nodes - BBox: TBSPBBox; // Bounding box of node - end; - - TBSPLeaf = record - Cluster: Integer; // Visibility cluster number - Area: Integer; // Volume of the leaf - BBox: TBSPBBox; // Bounding box of leaf - FirstFace, NumFaces: Integer; - // Lookup for the face list (indexes are for faces) - FirstBrush, NumBrushes: Integer; - // Lookup for the brush list (indexes are for brushes) - end; - - TBSPModel = record - BBox: TBSPBBox; // Bounding box of model - FirstFace, NumFaces: Integer; - // Lookup for the face list (indexes are for faces) - FirstBrush, NumBrushes: Integer; - // Lookup for the brush list (indexes are for brushes) - end; - - TBSPVertex = record - Position: TVector3f; // (x, y, z) position. - TextureCoord: TVector2f; // (u, v) texture coordinate - LightmapCoord: TVector2f; // (u, v) lightmap coordinate - Normal: TVector3f; // (x, y, z) normal vector - Color: array [0 .. 3] of Byte // RGBA color for the vertex - end; - PBSPVertex = ^TBSPVertex; - - TBSPFace = record textureID: Integer; // The index into the texture array - effect: Integer; // The index for the effects (or -1 = n/a) - FaceType: Integer; // 1=polygon, 2=patch, 3=mesh, 4=billboard - startVertIndex: Integer; // The starting index into this face's first vertex - numOfVerts: Integer; // The number of vertices for this face - meshVertIndex: Integer; // The index into the first meshvertex - numMeshVerts: Integer; // The number of mesh vertices - lightmapID: Integer; // The texture index for the lightmap - lMapCorner: array [0 .. 1] of Integer; - // The face's lightmap corner in the image - lMapSize: array [0 .. 1] of Integer; // The size of the lightmap section - lMapPos: TVector3f; // The 3D origin of lightmap. - lMapVecs: array [0 .. 1] of TVector3f; - // The 3D space for s and t unit vectors. - vNormal: TVector3f; // The face normal. - Size: array [0 .. 1] of Integer; // The bezier patch dimensions. - end; - - PBSPFace = ^TBSPFace; - - TBSPTexture = record - TextureName: array [0 .. 63] of WideChar; - // The name of the texture w/o the extension - flags: Integer; // The surface flags (unknown) - contents: Integer; // The content flags (unknown) - end; - - PBSPTexture = ^TBSPTexture; - - TBSPLightmap = record - imageBits: array [0 .. 49151] of Byte; // The RGB data in a 128x128 image - end; - - PBSPLightmap = ^TBSPLightmap; - - TBSPVisData = record - numOfClusters: Integer; - bytesPerCluster: Integer; - bitSets: array of Byte; - end; - - TQ3BSP = class(TObject) - public - Header: TBSPHeader; - Lumps: array of TBSPLump; - numOfVerts: Integer; - NumOfNodes: Integer; - NumOfPlanes: Integer; - NumOfLeaves: Integer; - NumOfFaces: Integer; - NumOfTextures: Integer; - NumOfLightmaps: Integer; - Vertices: array of TBSPVertex; - Nodes: array of TBSPNode; - Planes: array of TVector4f; - Leaves: array of TBSPLeaf; - Faces: array of TBSPFace; - Textures: array of TBSPTexture; // texture names (without extension) - Lightmaps: array of TBSPLightmap; - VisData: TBSPVisData; - constructor Create(bspStream: TStream); - end; - -const - kEntities = 0; // Stores player/object positions, etc... - kTextures = 1; // Stores texture information - kPlanes = 2; // Stores the splitting planes - kNodes = 3; // Stores the BSP nodes - kLeafs = 4; // Stores the leafs of the nodes - kLeafFaces = 5; // Stores the leaf's indices into the faces - kLeafBrushes = 6; // Stores the leaf's indices into the brushes - kModels = 7; // Stores the info of world models - kBrushes = 8; // Stores the brushes info (for collision) - kBrushSides = 9; // Stores the brush surfaces info - kVertices = 10; // Stores the level vertices - kMeshVerts = 11; // Stores the model vertices offsets - kShaders = 12; // Stores the shader files (blending, anims..) - kFaces = 13; // Stores the faces for the level - kLightmaps = 14; // Stores the lightmaps for the level - kLightVolumes = 15; // Stores extra world lighting information - kVisData = 16; // Stores PVS and cluster info (visibility) - kMaxLumps = 17; // A constant to store the number of lumps - -// ------------------------------------------------------------------ -implementation -// ------------------------------------------------------------------ - -// ------------------ -// ------------------ TQ3BSP ------------------ -// ------------------ - -constructor TQ3BSP.Create(bspStream: TStream); -begin - SetLength(Lumps, kMaxLumps); - - // Read in the header and lump data - bspStream.Read(Header, SizeOf(Header)); - bspStream.Read(Lumps[0], kMaxLumps * SizeOf(TBSPLump)); - - NumOfNodes := Round(Lumps[kNodes].Length / SizeOf(TBSPNode)); - SetLength(Nodes, NumOfNodes); - bspStream.Position := Lumps[kNodes].Offset; - bspStream.Read(Nodes[0], NumOfNodes * SizeOf(TBSPNode)); - - NumOfPlanes := Round(Lumps[kPlanes].Length / SizeOf(TVector4f)); - SetLength(Planes, NumOfPlanes); - bspStream.Position := Lumps[kPlanes].Offset; - bspStream.Read(Planes[0], NumOfPlanes * SizeOf(TVector4f)); - - NumOfLeaves := Round(Lumps[kLeafs].Length / SizeOf(TBSPLeaf)); - SetLength(Leaves, NumOfLeaves); - bspStream.Position := Lumps[kLeafs].Offset; - bspStream.Read(Leaves[0], NumOfLeaves * SizeOf(TBSPLeaf)); - - numOfVerts := Round(Lumps[kVertices].Length / SizeOf(TBSPVertex)); - SetLength(Vertices, numOfVerts); - bspStream.Position := Lumps[kVertices].Offset; - bspStream.Read(Vertices[0], numOfVerts * SizeOf(TBSPVertex)); - - NumOfFaces := Round(Lumps[kFaces].Length / SizeOf(TBSPFace)); - SetLength(Faces, NumOfFaces); - bspStream.Position := Lumps[kFaces].Offset; - bspStream.Read(Faces[0], NumOfFaces * SizeOf(TBSPFace)); - - NumOfTextures := Round(Lumps[kTextures].Length / SizeOf(TBSPTexture)); - SetLength(Textures, NumOfTextures); - bspStream.Position := Lumps[kTextures].Offset; - bspStream.Read(Textures[0], NumOfTextures * SizeOf(TBSPTexture)); - - NumOfLightmaps := Round(Lumps[kLightmaps].Length / SizeOf(TBSPLightmap)); - SetLength(Lightmaps, NumOfLightmaps); - bspStream.Position := Lumps[kLightmaps].Offset; - bspStream.Read(Lightmaps[0], NumOfLightmaps * SizeOf(TBSPLightmap)); - - bspStream.Position := Lumps[kVisData].Offset; - bspStream.Read(VisData.numOfClusters, SizeOf(Integer)); - bspStream.Read(VisData.bytesPerCluster, SizeOf(Integer)); - if VisData.numOfClusters * VisData.bytesPerCluster > 0 then - begin - SetLength(VisData.bitSets, VisData.numOfClusters * VisData.bytesPerCluster); - bspStream.Read(VisData.bitSets[0], VisData.numOfClusters * - VisData.bytesPerCluster); - end; -end; - -end. diff --git a/Sourcex/Formatx.Q3MD3.pas b/Sourcex/Formatx.Q3MD3.pas index 35bdaf25..3e8fd94f 100644 --- a/Sourcex/Formatx.Q3MD3.pas +++ b/Sourcex/Formatx.Q3MD3.pas @@ -20,7 +20,7 @@ interface GXS.VectorFileObjects, GXS.Material, - Formatx.MD3; + Formats.MD3; type (* This class is used to extract the tag transform information @@ -44,22 +44,20 @@ TMD3TagList = class into an animation list. The NamePrefix parameter is used to determine which class of animation is extracted. eg NamePrefix='TORSO' will load all animations starting with 'TORSO_' like 'TORSO_STAND' *) -procedure LoadQ3Anims(Animations: TgxActorAnimations; FileName: string; +procedure LoadQ3Anims(Animations: TGXActorAnimations; FileName: string; NamePrefix: string); overload; -procedure LoadQ3Anims(Animations: TgxActorAnimations; Strings: TStrings; +procedure LoadQ3Anims(Animations: TGXActorAnimations; Strings: TStrings; NamePrefix: string); overload; (* Quake3 Skin loading procedure. Use this procedure to apply textures to a GLActor. This doens't use the actors original preloaded materials so it may be a good idea to clear the actors material library before running this to keep everything nice and clean. *) -procedure LoadQ3Skin(FileName: string; Actor: TgxActor); +procedure LoadQ3Skin(FileName: string; Actor: TGXActor); -// --------------------------------------------------------------------------- -implementation -// --------------------------------------------------------------------------- +implementation // ------------------------------------------------------------- -procedure LoadQ3Anims(Animations: TgxActorAnimations; FileName: string; +procedure LoadQ3Anims(Animations: TGXActorAnimations; FileName: string; NamePrefix: string); var AnimStrings: TStrings; @@ -70,7 +68,7 @@ procedure LoadQ3Anims(Animations: TgxActorAnimations; FileName: string; AnimStrings.Free; end; -procedure LoadQ3Anims(Animations: TgxActorAnimations; Strings: TStrings; +procedure LoadQ3Anims(Animations: TGXActorAnimations; Strings: TStrings; NamePrefix: string); var anim: TStringList; @@ -160,7 +158,7 @@ procedure LoadQ3Anims(Animations: TgxActorAnimations; Strings: TStrings; StartFrame := val[0]; EndFrame := val[0] + val[1] - 1; Reference := aarMorph; - // Need a way in TgxActorAnimation to tell whether it is + // Need a way in TGXActorAnimation to tell whether it is // a looping type animation or a play once type and // the framerate (interval) it uses. Both of these can // be determined here and loaded. @@ -170,7 +168,7 @@ procedure LoadQ3Anims(Animations: TgxActorAnimations; Strings: TStrings; anim.Free; end; -procedure LoadQ3Skin(FileName: string; Actor: TgxActor); +procedure LoadQ3Skin(FileName: string; Actor: TGXActor); const // This list can be expanded if necessary ExtList: array [0 .. 3] of string = ('.jpg', '.jpeg', '.tga', '.bmp'); @@ -178,12 +176,12 @@ procedure LoadQ3Skin(FileName: string; Actor: TgxActor); SkinStrings, temp: TStrings; i, j: Integer; libmat: TgxLibMaterial; - mesh: TgxMeshObject; + mesh: TGXMeshObject; texture, textureNoDir: string; textureFound, meshFound: Boolean; - function GetMeshObjectByName(MeshObjects: TgxMeshObjectList; Name: string; - var mesh: TgxMeshObject): Boolean; + function GetMeshObjectByName(MeshObjects: TGXMeshObjectList; Name: string; + var mesh: TGXMeshObject): Boolean; var i: Integer; begin @@ -330,4 +328,6 @@ function TMD3TagList.GetTransform(TagName: string; Frame: Integer): TMatrix4f; result.W.V[i] := Tag.vPosition.V[i]; end; +//--------------------------------------------------------------------------- + end. diff --git a/Sourcex/Formatx.TGA.pas b/Sourcex/Formatx.TGA.pas index 09aa0c3a..f519918e 100644 --- a/Sourcex/Formatx.TGA.pas +++ b/Sourcex/Formatx.TGA.pas @@ -20,7 +20,7 @@ interface GXS.Context, GXS.Graphics, - GXS.TextureFormat; + GLScene.TextureFormat; type diff --git a/Sourcex/Formatx.VFW.pas b/Sourcex/Formatx.VFW.pas deleted file mode 100644 index 04b59fa6..00000000 --- a/Sourcex/Formatx.VFW.pas +++ /dev/null @@ -1,4641 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.VFW; - -(**************************************************************************** - * - * VfW.H - Video for windows include file for WIN32 - * - * Copyright (c) 1991-1999, Microsoft Corp. All rights reserved. - * - * This include files defines interfaces to the following - * video components - * - * COMPMAN - Installable Compression Manager. - * DRAWDIB - Routines for drawing to the display. - * VIDEO - Video Capture Driver Interface - * - * AVIFMT - AVI File Format structure definitions. - * MMREG - FOURCC and other things - * - * AVIFile - Interface for reading AVI Files and AVI Streams - * MCIWND - MCI/AVI window class - * AVICAP - AVI Capture Window class - * - * MSACM - Audio compression manager. - * - * The following symbols control inclusion of various parts of this file: - * - * NOCOMPMAN - dont include COMPMAN - * NODRAWDIB - dont include DRAWDIB - * NOVIDEO - dont include video capture interface - * - * NOAVIFMT - dont include AVI file format structs - * NOMMREG - dont include MMREG - * - * NOAVIFILE - dont include AVIFile interface - * NOMCIWND - dont include AVIWnd class. - * NOAVICAP - dont include AVICap class. - * - * NOMSACM - dont include ACM stuff. - * - ****************************************************************************) - -(******************************************************************************) -(* *) -(* VFW.PAS Conversion by Ronald Dittrich *) -(* *) -(* E-Mail: info@swiftsoft.de *) -(* http://www.swiftsoft.de *) -(* *) -(******************************************************************************) - -(******************************************************************************) -(* *) -(* Modyfied: 25.April.2000 *) -(* *) -(* E-Mail: *) -(* Ivo Steinmann: isteinmann@bluewin.ch *) -(* *) -(* Please send all messages regarding specific errors and lacks of this unit *) -(* to Ivo Steinmann *) -(* *) -(******************************************************************************) - -(******************************************************************************) -(* *) -(* Modyfied: 2000-12-07 *) -(* *) -(* E-Mail: *) -(* Peter Haas: PeterJHaas@t-online.de *) -(* *) -(* Only modified line 1380 ( TAVIPALCHANGE.peNew ) *) -(* *) -(******************************************************************************) - -interface - -{.$UNDEF UNICODE} - -{$I GLScene.Defines.inc} - -uses - Winapi.Windows, - Winapi.MMSystem, - Winapi.Messages, - Winapi.CommDlg, - Winapi.ActiveX; - -(**************************************************************************** - * - * types - * - ***************************************************************************) - -type - PVOID = pointer; - LONG = longint; - PLONG = ^LONG; - int = integer; - -(**************************************************************************** - * - * VideoForWindowsVersion() - returns version of VfW - * - ***************************************************************************) - -function VideoForWindowsVersion: DWORD; pascal; - -(**************************************************************************** - * - * call these to start stop using VfW from your app. - * - ***************************************************************************) - { -function InitVFW: LONG; stdcall; -function TermVFW: LONG; stdcall; } - -(****************************************************************************/ -/* */ -/* Macros */ -/* */ -/* should we define this?? */ -/* */ -/****************************************************************************) - -function MKFOURCC(ch0, ch1, ch2, ch3: AnsiChar): FOURCC; - -(**************************************************************************** - * - * COMPMAN - Installable Compression Manager. - * - ****************************************************************************) - -const - ICVERSION = $0104 ; - -type - HIC = THandle; // Handle to an Installable Compressor - -// -// this code in biCompression means the DIB must be accesed via -// 48 bit pointers! using *ONLY* the selector given. -// -const - BI_1632 = $32333631; // '1632' - -function mmioFOURCC(ch0, ch1, ch2, ch3: AnsiChar): FOURCC; - -type - TWOCC = word; - -function aviTWOCC(ch0, ch1: AnsiChar): TWOCC; - -const - ICTYPE_VIDEO = $63646976; {vidc} - ICTYPE_AUDIO = $63647561; {audc} - -const - ICERR_OK = 0 ; - ICERR_DONTDRAW = 1 ; - ICERR_NEWPALETTE = 2 ; - ICERR_GOTOKEYFRAME = 3 ; - ICERR_STOPDRAWING = 4 ; - - ICERR_UNSUPPORTED = -1 ; - ICERR_BADFORMAT = -2 ; - ICERR_MEMORY = -3 ; - ICERR_INTERNAL = -4 ; - ICERR_BADFLAGS = -5 ; - ICERR_BADPARAM = -6 ; - ICERR_BADSIZE = -7 ; - ICERR_BADHANDLE = -8 ; - ICERR_CANTUPDATE = -9 ; - ICERR_ABORT = -10 ; - ICERR_ERROR = -100 ; - ICERR_BADBITDEPTH = -200 ; - ICERR_BADIMAGESIZE = -201 ; - - ICERR_CUSTOM = -400 ; // errors less than ICERR_CUSTOM... - -{-- Values for dwFlags of ICOpen() -------------------------------------------} - - ICMODE_COMPRESS = 1 ; - ICMODE_DECOMPRESS = 2 ; - ICMODE_FASTDECOMPRESS = 3 ; - ICMODE_QUERY = 4 ; - ICMODE_FASTCOMPRESS = 5 ; - ICMODE_DRAW = 8 ; - -{-- Flags for AVI file index -------------------------------------------------} - - AVIIF_LIST = $00000001 ; - AVIIF_TWOCC = $00000002 ; - AVIIF_KEYFRAME = $00000010 ; - -{-- quality flags ------------------------------------------------------------} - - ICQUALITY_LOW = 0 ; - ICQUALITY_HIGH = 10000 ; - ICQUALITY_DEFAULT = -1 ; - -(************************************************************************ -************************************************************************) - - ICM_USER = (DRV_USER+$0000) ; - - ICM_RESERVED_LOW = (DRV_USER+$1000) ; - ICM_RESERVED_HIGH = (DRV_USER+$2000) ; - ICM_RESERVED = ICM_RESERVED_LOW ; - -(************************************************************************ - - messages. - -************************************************************************) - - ICM_GETSTATE = (ICM_RESERVED+0) ; // Get compressor state - ICM_SETSTATE = (ICM_RESERVED+1) ; // Set compressor state - ICM_GETINFO = (ICM_RESERVED+2) ; // Query info about the compressor - - ICM_CONFIGURE = (ICM_RESERVED+10); // show the configure dialog - ICM_ABOUT = (ICM_RESERVED+11); // show the about box - - ICM_GETDEFAULTQUALITY = (ICM_RESERVED+30); // get the default value for quality - ICM_GETQUALITY = (ICM_RESERVED+31); // get the current value for quality - ICM_SETQUALITY = (ICM_RESERVED+32); // set the default value for quality - - ICM_SET = (ICM_RESERVED+40); // Tell the driver something - ICM_GET = (ICM_RESERVED+41); // Ask the driver something - -{-- Constants for ICM_SET: ---------------------------------------------------} - - ICM_FRAMERATE = $526D7246; {FrmR} - ICM_KEYFRAMERATE = $5279654B; {KeyR} - -(************************************************************************ - - ICM specific messages. - -************************************************************************) - - ICM_COMPRESS_GET_FORMAT = (ICM_USER+4) ; // get compress format or size - ICM_COMPRESS_GET_SIZE = (ICM_USER+5) ; // get output size - ICM_COMPRESS_QUERY = (ICM_USER+6) ; // query support for compress - ICM_COMPRESS_BEGIN = (ICM_USER+7) ; // begin a series of compress calls. - ICM_COMPRESS = (ICM_USER+8) ; // compress a frame - ICM_COMPRESS_END = (ICM_USER+9) ; // end of a series of compress calls. - - ICM_DECOMPRESS_GET_FORMAT = (ICM_USER+10) ; // get decompress format or size - ICM_DECOMPRESS_QUERY = (ICM_USER+11) ; // query support for dempress - ICM_DECOMPRESS_BEGIN = (ICM_USER+12) ; // start a series of decompress calls - ICM_DECOMPRESS = (ICM_USER+13) ; // decompress a frame - ICM_DECOMPRESS_END = (ICM_USER+14) ; // end a series of decompress calls - ICM_DECOMPRESS_SET_PALETTE = (ICM_USER+29) ; // fill in the DIB color table - ICM_DECOMPRESS_GET_PALETTE = (ICM_USER+30) ; // fill in the DIB color table - - ICM_DRAW_QUERY = (ICM_USER+31) ; // query support for dempress - ICM_DRAW_BEGIN = (ICM_USER+15) ; // start a series of draw calls - ICM_DRAW_GET_PALETTE = (ICM_USER+16) ; // get the palette needed for drawing - ICM_DRAW_START = (ICM_USER+18) ; // start decompress clock - ICM_DRAW_STOP = (ICM_USER+19) ; // stop decompress clock - ICM_DRAW_END = (ICM_USER+21) ; // end a series of draw calls - ICM_DRAW_GETTIME = (ICM_USER+32) ; // get value of decompress clock - ICM_DRAW = (ICM_USER+33) ; // generalized "render" message - ICM_DRAW_WINDOW = (ICM_USER+34) ; // drawing window has moved or hidden - ICM_DRAW_SETTIME = (ICM_USER+35) ; // set correct value for decompress clock - ICM_DRAW_REALIZE = (ICM_USER+36) ; // realize palette for drawing - ICM_DRAW_FLUSH = (ICM_USER+37) ; // clear out buffered frames - ICM_DRAW_RENDERBUFFER = (ICM_USER+38) ; // draw undrawn things in queue - - ICM_DRAW_START_PLAY = (ICM_USER+39) ; // start of a play - ICM_DRAW_STOP_PLAY = (ICM_USER+40) ; // end of a play - - ICM_DRAW_SUGGESTFORMAT = (ICM_USER+50) ; // Like ICGetDisplayFormat - ICM_DRAW_CHANGEPALETTE = (ICM_USER+51) ; // for animating palette - - ICM_GETBUFFERSWANTED = (ICM_USER+41) ; // ask about prebuffering - - ICM_GETDEFAULTKEYFRAMERATE = (ICM_USER+42) ; // get the default value for key frames - - ICM_DECOMPRESSEX_BEGIN = (ICM_USER+60) ; // start a series of decompress calls - ICM_DECOMPRESSEX_QUERY = (ICM_USER+61) ; // start a series of decompress calls - ICM_DECOMPRESSEX = (ICM_USER+62) ; // decompress a frame - ICM_DECOMPRESSEX_END = (ICM_USER+63) ; // end a series of decompress calls - - ICM_COMPRESS_FRAMES_INFO = (ICM_USER+70) ; // tell about compress to come - ICM_SET_STATUS_PROC = (ICM_USER+72) ; // set status callback - -(************************************************************************ -************************************************************************) - -type - PICOPEN = ^TICOPEN; - TICOPEN = packed record - dwSize : DWORD ; // sizeof(ICOPEN) - fccType : DWORD ; // 'vidc' - fccHandler : DWORD ; // - dwVersion : DWORD ; // version of compman opening you - dwFlags : DWORD ; // LOWORD is type specific - dwError : DWORD ; // error return. - pV1Reserved : PVOID ; // Reserved - pV2Reserved : PVOID ; // Reserved - dnDevNode : DWORD ; // Devnode for PnP devices - end; - -(************************************************************************ -************************************************************************) - - PICINFO = ^TICINFO; - TICINFO = packed record - dwSize : DWORD; // sizeof(ICINFO) - fccType : DWORD; // compressor type 'vidc' 'audc' - fccHandler : DWORD; // compressor sub-type 'rle ' 'jpeg' 'pcm ' - dwFlags : DWORD; // flags LOWORD is type specific - dwVersion : DWORD; // version of the driver - dwVersionICM : DWORD; // version of the ICM used - // - // under Win32, the driver always returns UNICODE strings. - // - szName : array[0..15] of WChar ; // short name - szDescription : array[0..127] of WChar ; // DWORD name - szDriver : array[0..127] of WChar ; // driver that contains compressor - end; - -{-- Flags for the field of the structure. ------------} - -const - VIDCF_QUALITY = $0001 ; // supports quality - VIDCF_CRUNCH = $0002 ; // supports crunching to a frame size - VIDCF_TEMPORAL = $0004 ; // supports inter-frame compress - VIDCF_COMPRESSFRAMES = $0008 ; // wants the compress all frames message - VIDCF_DRAW = $0010 ; // supports drawing - VIDCF_FASTTEMPORALC = $0020 ; // does not need prev frame on compress - VIDCF_FASTTEMPORALD = $0080 ; // does not need prev frame on decompress - //VIDCF_QUALITYTIME = $0040 ; // supports temporal quality - - //VIDCF_FASTTEMPORAL = (VIDCF_FASTTEMPORALC or VIDCF_FASTTEMPORALD) - -(************************************************************************ -************************************************************************) - - ICCOMPRESS_KEYFRAME = $00000001; - -type - PICCOMPRESS = ^TICCOMPRESS; - TICCOMPRESS = packed record - dwFlags : DWORD; // flags - - lpbiOutput : PBITMAPINFOHEADER ; // output format - lpOutput : PVOID ; // output data - - lpbiInput : PBITMAPINFOHEADER ; // format of frame to compress - lpInput : PVOID ; // frame data to compress - - lpckid : PDWORD ; // ckid for data in AVI file - lpdwFlags : PDWORD; // flags in the AVI index. - lFrameNum : LONG ; // frame number of seq. - dwFrameSize : DWORD ; // reqested size in bytes. (if non zero) - - dwQuality : DWORD ; // quality - - // these are new fields - - lpbiPrev : PBITMAPINFOHEADER ; // format of previous frame - lpPrev : PVOID ; // previous frame - end; - -(************************************************************************ -************************************************************************) - -const - ICCOMPRESSFRAMES_PADDING = $00000001 ; - -type - TICCompressProc = function(lInputOutput: LPARAM; lFrame: DWORD; lpBits: PVOID; len: LONG): LONG; stdcall; - - PICCOMPRESSFRAMES = ^TICCOMPRESSFRAMES; - TICCOMPRESSFRAMES = packed record - dwFlags : DWORD ; // flags - - lpbiOutput : PBITMAPINFOHEADER ; // output format - lOutput : LPARAM ; // output identifier - - lpbiInput : PBITMAPINFOHEADER ; // format of frame to compress - lInput : LPARAM ; // input identifier - - lStartFrame : LONG ; // start frame - lFrameCount : LONG ; // # of frames - - lQuality : LONG ; // quality - lDataRate : LONG ; // data rate - lKeyRate : LONG ; // key frame rate - - dwRate : DWORD ; // frame rate, as always - dwScale : DWORD ; - - dwOverheadPerFrame : DWORD ; - dwReserved2 : DWORD ; - - GetData : TICCompressProc; - PutData : TICCompressProc; - end; - -{-- Messages for Status callback ---------------------------------------------} - -const - ICSTATUS_START = 0 ; - ICSTATUS_STATUS = 1 ; // l = % done - ICSTATUS_END = 2 ; - ICSTATUS_ERROR = 3 ; // l = error string (LPSTR) - ICSTATUS_YIELD = 4 ; - -type - // return nonzero means abort operation in progress - TICStatusProc = function(lParam: LPARAM; message: UINT; l: LONG): LONG; stdcall; - - PICSETSTATUSPROC = ^TICSETSTATUSPROC; - TICSETSTATUSPROC = packed record - dwFlags : DWORD ; - lParam : LPARAM ; - Status : TICStatusProc; - end; - -(************************************************************************ -************************************************************************) - -const - ICDECOMPRESS_HURRYUP = $80000000 ; // don't draw just buffer (hurry up!) - ICDECOMPRESS_UPDATE = $40000000 ; // don't draw just update screen - ICDECOMPRESS_PREROLL = $20000000 ; // this frame is before real start - ICDECOMPRESS_NULLFRAME = $10000000 ; // repeat last frame - ICDECOMPRESS_NOTKEYFRAME = $08000000 ; // this frame is not a key frame - -type - PICDECOMPRESS = ^TICDECOMPRESS; - TICDECOMPRESS = packed record - dwFlags : DWORD ; // flags (from AVI index...) - lpbiInput : PBITMAPINFOHEADER ; // BITMAPINFO of compressed data - // biSizeImage has the chunk size - lpInput : PVOID ; // compressed data - lpbiOutput : PBITMAPINFOHEADER ; // DIB to decompress to - lpOutput : PVOID ; - ckid : DWORD ; // ckid from AVI file - end; - - PICDECOMPRESSEX = ^TICDECOMPRESSEX; - TICDECOMPRESSEX = packed record - - // - // same as ICM_DECOMPRESS - // - - dwFlags : DWORD; - lpbiSrc : PBITMAPINFOHEADER; // BITMAPINFO of compressed data - lpSrc : PVOID; // compressed data - lpbiDst : PBITMAPINFOHEADER; // DIB to decompress to - lpDst : PVOID; // output data - - // - // new for ICM_DECOMPRESSEX - // - - xDst : int; // destination rectangle - yDst : int; - dxDst : int; - dyDst : int; - - xSrc : int; // source rectangle - ySrc : int; - dxSrc : int; - dySrc : int; - end; - -(************************************************************************ -************************************************************************) - -const - ICDRAW_QUERY = $00000001 ; // test for support - ICDRAW_FULLSCREEN = $00000002 ; // draw to full screen - ICDRAW_HDC = $00000004 ; // draw to a HDC/HWND - ICDRAW_ANIMATE = $00000008 ; // expect palette animation - ICDRAW_CONTINUE = $00000010 ; // draw is a continuation of previous draw - ICDRAW_MEMORYDC = $00000020 ; // DC is offscreen, by the way - ICDRAW_UPDATING = $00000040 ; // We're updating, as opposed to playing - ICDRAW_RENDER = $00000080 ; // used to render data not draw it - ICDRAW_BUFFER = $00000100 ; // please buffer this data offscreen, we will need to update it - -type - PICDRAWBEGIN = ^TICDRAWBEGIN; - TICDRAWBEGIN = packed record - dwFlags : DWORD ; // flags - - hpal : HPALETTE ; // palette to draw with - hwnd : HWND ; // window to draw to - hdc : HDC ; // HDC to draw to - - xDst : int ; // destination rectangle - yDst : int ; - dxDst : int ; - dyDst : int ; - - lpbi : PBITMAPINFOHEADER ; - // format of frame to draw - - xSrc : int ; // source rectangle - ySrc : int ; - dxSrc : int ; - dySrc : int ; - - dwRate : DWORD ; // frames/second = (dwRate/dwScale) - dwScale : DWORD ; - end; - -(************************************************************************ -************************************************************************) - -const - ICDRAW_HURRYUP = $80000000 ; // don't draw just buffer (hurry up!) - ICDRAW_UPDATE = $40000000 ; // don't draw just update screen - ICDRAW_PREROLL = $20000000 ; // this frame is before real start - ICDRAW_NULLFRAME = $10000000 ; // repeat last frame - ICDRAW_NOTKEYFRAME = $08000000 ; // this frame is not a key frame - -type - PICDRAW = ^TICDRAW; - TICDRAW = packed record - dwFlags : DWORD ; // flags - lpFormat : PVOID ; // format of frame to decompress - lpData : PVOID ; // frame data to decompress - cbData : DWORD ; - lTime : LONG ; // time in drawbegin units (see dwRate and dwScale) - end; - - PICDRAWSUGGEST = ^TICDRAWSUGGEST; - TICDRAWSUGGEST = packed record - lpbiIn : PBITMAPINFOHEADER ; // format to be drawn - lpbiSuggest : PBITMAPINFOHEADER ; // location for suggested format (or NULL to get size) - dxSrc : int ; // source extent or 0 - dySrc : int ; - dxDst : int ; // dest extent or 0 - dyDst : int ; - hicDecompressor : HIC ; // decompressor you can talk to - end; - -(************************************************************************ -************************************************************************) - - PICPALETTE = ^TICPALETTE; - TICPALETTE = packed record - dwFlags : DWORD ; // flags (from AVI index...) - iStart : int ; // first palette to change - iLen : int ; // count of entries to change. - lppe : PPALETTEENTRY ; // palette - end; - -(************************************************************************ - - ICM function declarations - -************************************************************************) - -function ICInfo(fccType, fccHandler: DWORD; lpicinfo: PICINFO) : BOOL ; stdcall ; -function ICInstall(fccType, fccHandler: DWORD; lParam: LPARAM; szDesc: LPSTR; wFlags: UINT) : BOOL ; stdcall ; -function ICRemove(fccType, fccHandler: DWORD; wFlags: UINT) : BOOL ; stdcall ; -function ICGetInfo(hic: HIC; picinfo: PICINFO; cb: DWORD) : DWORD ; stdcall ; - -function ICOpen(fccType, fccHandler: DWORD; wMode: UINT) : HIC ; stdcall ; -function ICOpenFunction(fccType, fccHandler: DWORD; wMode: UINT; lpfnHandler: TFarProc) : HIC ; stdcall ; -function ICClose(hic: HIC) : DWORD; stdcall ; - -function ICSendMessage(hic: HIC; msg: UINT; dw1, dw2: DWORD) : DWORD ; stdcall ; - -{-- Values for wFlags of ICInstall -------------------------------------------} - -const - ICINSTALL_UNICODE = $8000 ; - - ICINSTALL_FUNCTION = $0001 ; // lParam is a DriverProc (function ptr) - ICINSTALL_DRIVER = $0002 ; // lParam is a driver name (string) - ICINSTALL_HDRV = $0004 ; // lParam is a HDRVR (driver handle) - - ICINSTALL_DRIVERW = $8002 ; // lParam is a unicode driver name - -{-- Query macros -------------------------------------------------------------} - - ICMF_CONFIGURE_QUERY = $00000001 ; - ICMF_ABOUT_QUERY = $00000001 ; - -function ICQueryAbout(hic: HIC): BOOL; -function ICAbout(hic: HIC; hwnd: HWND): DWORD; -function ICQueryConfigure(hic: HIC): BOOL; -function ICConfigure(hic: HIC; hwnd: HWND): DWORD; - -{-- Get/Set state macros -----------------------------------------------------} - -function ICGetState(hic: HIC; pv: PVOID; cb: DWORD): DWORD; -function ICSetState(hic: HIC; pv: PVOID; cb: DWORD): DWORD; -function ICGetStateSize(hic: HIC): DWORD; - -{-- Get value macros ---------------------------------------------------------} - -function ICGetDefaultQuality(hic: HIC): DWORD; -function ICGetDefaultKeyFrameRate(hic: HIC): DWORD; - -{-- Draw window macro --------------------------------------------------------} - -function ICDrawWindow(hic: HIC; prc: PRECT): DWORD; - -(************************************************************************ - - compression functions - -************************************************************************/ -/* - * ICCompress() - * - * compress a single frame - * - *) -function ICCompress( - hic : HIC; - dwFlags : DWORD; // flags - lpbiOutput : PBITMAPINFOHEADER; // output format - lpData : PVOID; // output data - lpbiInput : PBITMAPINFOHEADER; // format of frame to compress - lpBits : PVOID; // frame data to compress - lpckid : PDWORD; // ckid for data in AVI file - lpdwFlags : PDWORD; // flags in the AVI index. - lFrameNum : DWORD; // frame number of seq. - dwFrameSize : DWORD; // reqested size in bytes. (if non zero) - dwQuality : DWORD; // quality within one frame - lpbiPrev : PBITMAPINFOHEADER; // format of previous frame - lpPrev : PVOID // previous frame - ): DWORD; cdecl; - -(* - * ICCompressBegin() - * - * start compression from a source format (lpbiInput) to a dest - * format (lpbiOuput) is supported. - * - *) - -function ICCompressBegin(hic: HIC; lpbiInput: PBITMAPINFOHEADER; lpbiOutput: PBITMAPINFOHEADER): DWORD; - -(* - * ICCompressQuery() - * - * determines if compression from a source format (lpbiInput) to a dest - * format (lpbiOuput) is supported. - * - *) - -function ICCompressQuery(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; - -(* - * ICCompressGetFormat() - * - * get the output format, (format of compressed data) - * if lpbiOutput is NULL return the size in bytes needed for format. - * - *) - -function ICCompressGetFormat(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; -function ICCompressGetFormatSize(hic: HIC; lpbi: PBITMAPINFOHEADER): DWORD; - -(* - * ICCompressSize() - * - * return the maximal size of a compressed frame - * - *) - -function ICCompressGetSize(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; -function ICCompressEnd(hic: HIC): DWORD; - -(************************************************************************ - - decompression functions - -************************************************************************) - -(* - * ICDecompress() - * - * decompress a single frame - * - *) - -function ICDecompress( - hic : HIC; - dwFlags : DWORD; // flags (from AVI index...) - lpbiFormat : PBITMAPINFOHEADER; // BITMAPINFO of compressed data - // biSizeImage has the chunk size - lpData : PVOID; // data - lpbi : PBITMAPINFOHEADER; // DIB to decompress to - lpBits : PVOID - ): DWORD; cdecl; - -(* - * ICDecompressBegin() - * - * start compression from a source format (lpbiInput) to a dest - * format (lpbiOutput) is supported. - * - *) - -function ICDecompressBegin(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; - -(* - * ICDecompressQuery() - * - * determines if compression from a source format (lpbiInput) to a dest - * format (lpbiOutput) is supported. - * - *) - -function ICDecompressQuery(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; - -(* - * ICDecompressGetFormat() - * - * get the output format, (format of un-compressed data) - * if lpbiOutput is NULL return the size in bytes needed for format. - * - *) - -function ICDecompressGetFormat(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; -function ICDecompressGetFormatSize(hic: HIC; lpbi: PBITMAPINFOHEADER): DWORD; - -(* - * ICDecompressGetPalette() - * - * get the output palette - * - *) - -function ICDecompressGetPalette(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; -function ICDecompressSetPalette(hic: HIC; lpbiPalette: PBITMAPINFOHEADER): DWORD; - -function ICDecompressEnd(hic: HIC): DWORD; - -(************************************************************************ - - decompression (ex) functions - -************************************************************************) - -// -// on Win16 these functions are macros that call ICMessage. ICMessage will -// not work on NT. rather than add new entrypoints we have given -// them as static inline functions -// - -(* - * ICDecompressEx() - * - * decompress a single frame - * - *) - -function ICDecompressEx( - hic : HIC; - dwFlags : DWORD; - lpbiSrc : PBITMAPINFOHEADER; - lpSrc : PVOID; - xSrc : int; - ySrc : int; - dxSrc : int; - dySrc : int; - lpbiDst : PBITMAPINFOHEADER; - lpDst : PVOID; - xDst : int; - yDst : int; - dxDst : int; - dyDst : int - ): DWORD; stdcall; - -(* - * ICDecompressExBegin() - * - * start compression from a source format (lpbiInput) to a dest - * format (lpbiOutput) is supported. - * - *) - -function ICDecompressExBegin( - hic : HIC; - dwFlags : DWORD; - lpbiSrc : PBITMAPINFOHEADER; - lpSrc : PVOID; - xSrc : int; - ySrc : int; - dxSrc : int; - dySrc : int; - lpbiDst : PBITMAPINFOHEADER; - lpDst : PVOID; - xDst : int; - yDst : int; - dxDst : int; - dyDst : int - ): DWORD; stdcall; - -(* - * ICDecompressExQuery() - * - *) - -function ICDecompressExQuery( - hic : HIC; - dwFlags : DWORD; - lpbiSrc : PBITMAPINFOHEADER; - lpSrc : PVOID; - xSrc : int; - ySrc : int; - dxSrc : int; - dySrc : int; - lpbiDst : PBITMAPINFOHEADER; - lpDst : PVOID; - xDst : int; - yDst : int; - dxDst : int; - dyDst : int - ): DWORD; stdcall; - -function ICDecompressExEnd(hic: HIC): DWORD; - -(************************************************************************ - - drawing functions - -************************************************************************) - -(* - * ICDrawBegin() - * - * start decompressing data with format (lpbiInput) directly to the screen - * - * return zero if the decompressor supports drawing. - * - *) - -function ICDrawBegin( - hic : HIC; - dwFlags : DWORD; // flags - hpal : HPALETTE; // palette to draw with - hwnd : HWND; // window to draw to - hdc : HDC; // HDC to draw to - xDst : int; // destination rectangle - yDst : int; - dxDst : int; - dyDst : int; - lpbi : PBITMAPINFOHEADER; // format of frame to draw - xSrc : int; // source rectangle - ySrc : int; - dxSrc : int; - dySrc : int; - dwRate : DWORD; // frames/second = (dwRate/dwScale) - dwScale : DWORD - ): DWORD; cdecl; - -(* - * ICDraw() - * - * decompress data directly to the screen - * - *) - -function ICDraw( - hic : HIC; - dwFlags : DWORD; // flags - lpFormat : PVOID; // format of frame to decompress - lpData : PVOID; // frame data to decompress - cbData : DWORD; // size of data - lTime : DWORD // time to draw this frame - ): DWORD; cdecl; - -// ICMessage is not supported on Win32, so provide a static inline function -// to do the same job -function ICDrawSuggestFormat( - hic : HIC; - lpbiIn : PBITMAPINFOHEADER; - lpbiOut : PBITMAPINFOHEADER; - dxSrc : int; - dySrc : int; - dxDst : int; - dyDst : int; - hicDecomp : HIC - ): DWORD; stdcall; - -(* - * ICDrawQuery() - * - * determines if the compressor is willing to render the specified format. - * - *) - -function ICDrawQuery(hic: HIC; lpbiInput: PBITMAPINFOHEADER): DWORD; -function ICDrawChangePalette(hic: HIC; lpbiInput: PBITMAPINFOHEADER): DWORD; -function ICGetBuffersWanted(hic: HIC; lpdwBuffers: PDWORD): DWORD; -function ICDrawEnd(hic: HIC): DWORD; -function ICDrawStart(hic: HIC): DWORD; -function ICDrawStartPlay(hic: HIC; lFrom, lTo: DWORD): DWORD; -function ICDrawStop(hic: HIC): DWORD; -function ICDrawStopPlay(hic: HIC): DWORD; -function ICDrawGetTime(hic: HIC; lplTime: PDWORD): DWORD; -function ICDrawSetTime(hic: HIC; lTime: DWORD): DWORD; -function ICDrawRealize(hic: HIC; hdc: HDC; fBackground: BOOL): DWORD; -function ICDrawFlush(hic: HIC): DWORD; -function ICDrawRenderBuffer(hic: HIC): DWORD; - -(************************************************************************ - - Status callback functions - -************************************************************************/ - -/* - * ICSetStatusProc() - * - * Set the status callback function - * - *) - - -// ICMessage is not supported on NT -function ICSetStatusProc( - hic : HIC; - dwFlags : DWORD; - lParam : DWORD; - fpfnStatus : TICStatusProc - ): DWORD; stdcall; - -(************************************************************************ - -helper routines for DrawDib and MCIAVI... - -************************************************************************) - -function ICLocate(fccType, fccHandler: DWORD; lpbiIn, lpbiOut: PBITMAPINFOHEADER; wFlags: WORD): HIC; stdcall; -function ICGetDisplayFormat(hic: HIC; lpbiIn, lpbiOut: PBITMAPINFOHEADER; BitDepth: int; dx, dy: int): HIC; stdcall; - -function ICDecompressOpen(fccType, fccHandler: DWORD; lpbiIn, lpbiOut: PBITMAPINFOHEADER): HIC; -function ICDrawOpen(fccType, fccHandler: DWORD; lpbiIn: PBITMAPINFOHEADER): HIC; - -(************************************************************************ -Higher level functions -************************************************************************) - -function ICImageCompress( - hic : HIC; // compressor to use - uiFlags : UINT; // flags (none yet) - lpbiIn : PBITMAPINFO; // format to compress from - lpBits : PVOID; // data to compress - lpbiOut : PBITMAPINFO; // compress to this (NULL ==> default) - lQuality : LONG; // quality to use - plSize : PDWORD // compress to this size (0=whatever) - ): THANDLE; stdcall; - -function ICImageDecompress( - hic : HIC; // compressor to use - uiFlags : UINT; // flags (none yet) - lpbiIn : PBITMAPINFO; // format to decompress from - lpBits : PVOID; // data to decompress - lpbiOut : PBITMAPINFO // decompress to this (NULL ==> default) - ): THANDLE; stdcall; - -{-- TCompVars ----------------------------------------------------------------} - -// -// Structure used by ICSeqCompressFrame and ICCompressorChoose routines -// Make sure this matches the autodoc in icm.c! -// - -type - PCOMPVARS = ^TCOMPVARS; - TCOMPVARS = packed record - cbSize : DWORD; // set to sizeof(COMPVARS) before - // calling ICCompressorChoose - dwFlags : DWORD; // see below... - hic : HIC; // HIC of chosen compressor - fccType : DWORD; // basically ICTYPE_VIDEO - fccHandler : DWORD; // handler of chosen compressor or - // "" or "DIB " - lpbiIn : PBITMAPINFO; // input format - lpbiOut : PBITMAPINFO; // output format - will compress to this - lpBitsOut : PVOID; - lpBitsPrev : PVOID; - lFrame : LONG; - lKey : LONG; // key frames how often? - lDataRate : LONG; // desired data rate KB/Sec - lQ : LONG; // desired quality - lKeyCount : LONG; - lpState : PVOID; // state of compressor - cbState : LONG; // size of the state - end; - -// FLAGS for dwFlags element of COMPVARS structure: -// set this flag if you initialize COMPVARS before calling ICCompressorChoose - -const - ICMF_COMPVARS_VALID = $00000001; // COMPVARS contains valid data - -// -// allows user to choose compressor, quality etc... -// -function ICCompressorChoose( - hwnd : HWND; // parent window for dialog - uiFlags : UINT; // flags - pvIn : PVOID; // input format (optional) - lpData : PVOID; // input data (optional) - pc : PCOMPVARS; // data about the compressor/dlg - lpszTitle : LPSTR // dialog title (optional) - ): BOOL; stdcall; - -// defines for uiFlags - -const - ICMF_CHOOSE_KEYFRAME = $0001; // show KeyFrame Every box - ICMF_CHOOSE_DATARATE = $0002; // show DataRate box - ICMF_CHOOSE_PREVIEW = $0004; // allow expanded preview dialog - ICMF_CHOOSE_ALLCOMPRESSORS = $0008; // don't only show those that - // can handle the input format - // or input data - -function ICSeqCompressFrameStart(pc: PCOMPVARS; lpbiIn: PBITMAPINFO): BOOL; stdcall; -procedure ICSeqCompressFrameEnd(pc: PCOMPVARS); stdcall; - -function ICSeqCompressFrame( - pc : PCOMPVARS; // set by ICCompressorChoose - uiFlags : UINT; // flags - lpBits : PVOID; // input DIB bits - pfKey : PBOOL; // did it end up being a key frame? - plSize : PDWORD // size to compress to/of returned image - ): PVOID; stdcall; - -procedure ICCompressorFree(pc: PCOMPVARS); stdcall; - - -(************************************************************************** - * - * DRAWDIB - Routines for drawing to the display. - * - *************************************************************************) - -type - HDRAWDIB = THandle; // hdd - -(********************************************************************* - - DrawDib Flags - -**********************************************************************) - -const - DDF_UPDATE = $0002; // re-draw the last DIB - DDF_SAME_HDC = $0004; // HDC same as last call (all setup) - DDF_SAME_DRAW = $0008; // draw params are the same - DDF_DONTDRAW = $0010; // dont draw frame, just decompress - DDF_ANIMATE = $0020; // allow palette animation - DDF_BUFFER = $0040; // always buffer image - DDF_JUSTDRAWIT = $0080; // just draw it with GDI - DDF_FULLSCREEN = $0100; // use DisplayDib - DDF_BACKGROUNDPAL = $0200; // Realize palette in background - DDF_NOTKEYFRAME = $0400; // this is a partial frame update, hint - DDF_HURRYUP = $0800; // hurry up please! - DDF_HALFTONE = $1000; // always halftone - - DDF_PREROLL = DDF_DONTDRAW; // Builing up a non-keyframe - DDF_SAME_DIB = DDF_SAME_DRAW; - DDF_SAME_SIZE = DDF_SAME_DRAW; - -(********************************************************************* - - DrawDib functions - -*********************************************************************) - -{-- DrawDibOpen() ------------------------------------------------------------} - -function DrawDibOpen: HDRAWDIB; stdcall; - -{-- DrawDibClose() -----------------------------------------------------------} - -function DrawDibClose(hdd: HDRAWDIB): BOOL; stdcall; - -{-- DrawDibGetBuffer() -------------------------------------------------------} - -function DrawDibGetBuffer(hdd: HDRAWDIB; lpbi: PBITMAPINFOHEADER; dwSize: DWORD; dwFlags: DWORD): PVOID; stdcall; - -{-- DrawDibGetPalette() - get the palette used for drawing DIBs --------------} - -function DrawDibGetPalette(hdd: HDRAWDIB): HPALETTE; stdcall; - -{-- DrawDibSetPalette() - set the palette used for drawing DIBs --------------} - -function DrawDibSetPalette(hdd: HDRAWDIB; hpal: HPALETTE): BOOL; stdcall; - -{-- DrawDibChangePalette() ---------------------------------------------------} - -function DrawDibChangePalette(hdd: HDRAWDIB; iStart, iLen: int; lppe: PPALETTEENTRY): BOOL; stdcall; - -{-- DrawDibRealize() - realize the palette in a HDD --------------------------} - -function DrawDibRealize(hdd: HDRAWDIB; hdc: HDC; fBackground: BOOL): UINT; stdcall; - -{-- DrawDibStart() - start of streaming playback -----------------------------} - -function DrawDibStart(hdd: HDRAWDIB; rate: DWORD): BOOL; stdcall; - -{-- DrawDibStop() - start of streaming playback ------------------------------} - -function DrawDibStop(hdd: HDRAWDIB): BOOL; stdcall; - -{-- DrawDibBegin() - prepare to draw -----------------------------------------} - -function DrawDibBegin( - hdd : HDRAWDIB; - hdc : HDC; - dxDst : int; - dyDst : int; - lpbi : PBITMAPINFOHEADER; - dxSrc : int; - dySrc : int; - wFlags : UINT - ): BOOL; stdcall; - -{-- DrawDibDraw() - actually draw a DIB to the screen ------------------------} - -function DrawDibDraw( - hdd : HDRAWDIB; - hdc : HDC; - xDst : int; - yDst : int; - dxDst : int; - dyDst : int; - lpbi : PBITMAPINFOHEADER; - lpBits : PVOID; - xSrc : int; - ySrc : int; - dxSrc : int; - dySrc : int; - wFlags : UINT - ): BOOL; stdcall; - -{-- DrawDibUpdate() - redraw last image (may only be valid with DDF_BUFFER) --} - -function DrawDibUpdate(hdd: HDRAWDIB; hdc: HDC; x, y: int): BOOL; - -{-- DrawDibEnd() -------------------------------------------------------------} - -function DrawDibEnd(hdd: HDRAWDIB): BOOL; stdcall; - -{-- DrawDibTime() - for debugging purposes only ------------------------------} - -type - PDRAWDIBTIME = ^TDRAWDIBTIME; - TDRAWDIBTIME = packed record - timeCount : LONG; - timeDraw : LONG; - timeDecompress : LONG; - timeDither : LONG; - timeStretch : LONG; - timeBlt : LONG; - timeSetDIBits : LONG; - end; - -function DrawDibTime(hdd: HDRAWDIB; lpddtime: PDRAWDIBTIME): BOOL; stdcall; - -{-- Display profiling --------------------------------------------------------} - -const - PD_CAN_DRAW_DIB = $0001; // if you can draw at all - PD_CAN_STRETCHDIB = $0002; // basicly RC_STRETCHDIB - PD_STRETCHDIB_1_1_OK = $0004; // is it fast? - PD_STRETCHDIB_1_2_OK = $0008; // ... - PD_STRETCHDIB_1_N_OK = $0010; // ... - -function DrawDibProfileDisplay(lpbi: PBITMAPINFOHEADER): DWORD; stdcall; - -(**************************************************************************** - * - * AVIFMT - AVI file format definitions - * - ****************************************************************************) - -// -// The following is a short description of the AVI file format. Please -// see the accompanying documentation for a full explanation. -// -// An AVI file is the following RIFF form: -// -// RIFF('AVI' -// LIST('hdrl' -// avih() -// LIST ('strl' -// strh() -// strf() -// ... additional header data -// LIST('movi' -// { LIST('rec' -// SubChunk... -// ) -// | SubChunk } .... -// ) -// [ ] -// ) -// -// The main file header specifies how many streams are present. For -// each one, there must be a stream header chunk and a stream format -// chunk, enlosed in a 'strl' LIST chunk. The 'strf' chunk contains -// type-specific format information; for a video stream, this should -// be a BITMAPINFO structure, including palette. For an audio stream, -// this should be a WAVEFORMAT (or PCMWAVEFORMAT) structure. -// -// The actual data is contained in subchunks within the 'movi' LIST -// chunk. The first two characters of each data chunk are the -// stream number with which that data is associated. -// -// Some defined chunk types: -// Video Streams: -// ##db: RGB DIB bits -// ##dc: RLE8 compressed DIB bits -// ##pc: Palette Change -// -// Audio Streams: -// ##wb: waveform audio bytes -// -// The grouping into LIST 'rec' chunks implies only that the contents of -// the chunk should be read into memory at the same time. This -// grouping is used for files specifically intended to be played from -// CD-ROM. -// -// The index chunk at the end of the file should contain one entry for -// each data chunk in the file. -// -// Limitations for the current software: -// Only one video stream and one audio stream are allowed. -// The streams must start at the beginning of the file. -// -// -// To register codec types please obtain a copy of the Multimedia -// Developer Registration Kit from: -// -// Microsoft Corporation -// Multimedia Systems Group -// Product Marketing -// One Microsoft Way -// Redmond, WA 98052-6399 -// - -{-- form types, list types and chunk types -----------------------------------} - -const - formtypeAVI = $20495641; // mmioFOURCC('A', 'V', 'I', ' ') - listtypeAVIHEADER = $6C726468; // mmioFOURCC('h', 'd', 'r', 'l') - ckidAVIMAINHDR = $68697661; // mmioFOURCC('a', 'v', 'i', 'h') - listtypeSTREAMHEADER = $6C727473; // mmioFOURCC('s', 't', 'r', 'l') - ckidSTREAMHEADER = $68727473; // mmioFOURCC('s', 't', 'r', 'h') - ckidSTREAMFORMAT = $66727473; // mmioFOURCC('s', 't', 'r', 'f') - ckidSTREAMHANDLERDATA = $64727473; // mmioFOURCC('s', 't', 'r', 'd') - ckidSTREAMNAME = $6E727473; // mmioFOURCC('s', 't', 'r', 'n') - - listtypeAVIMOVIE = $69766F6D; // mmioFOURCC('m', 'o', 'v', 'i') - listtypeAVIRECORD = $20636572; // mmioFOURCC('r', 'e', 'c', ' ') - - ckidAVINEWINDEX = $31786469; // mmioFOURCC('i', 'd', 'x', '1') - -{-- Stream types for the field of the stream header ----------------} - - streamtypeVIDEO = $73646976; // mmioFOURCC('v', 'i', 'd', 's') - streamtypeAUDIO = $73647561; // mmioFOURCC('a', 'u', 'd', 's') - streamtypeMIDI = $7364696D; // mmioFOURCC('m', 'i', 'd', 's') - streamtypeTEXT = $73747874; // mmioFOURCC('t', 'x', 't', 's') - -{-- Basic chunk types --------------------------------------------------------} - - cktypeDIBbits = $6264; // aviTWOCC('d', 'b') - cktypeDIBcompressed = $6364; // aviTWOCC('d', 'c') - cktypePALchange = $6370; // aviTWOCC('p', 'c') - cktypeWAVEbytes = $6277; // aviTWOCC('w', 'b') - -{-- Chunk id to use for extra chunks for padding -----------------------------} - - ckidAVIPADDING = $4B4E554A; // mmioFOURCC('J', 'U', 'N', 'K') - -(* -** Useful macros -** -** Warning: These are nasty macro, and MS C 6.0 compiles some of them -** incorrectly if optimizations are on. Ack. -*) - -{-- Macro to get stream number out of a FOURCC ckid --------------------------} - -function FromHex(n: BYTE): BYTE; -function StreamFromFOURCC(fcc: DWORD): BYTE; - -{-- Macro to get TWOCC chunk type out of a FOURCC ckid -----------------------} - -function TWOCCFromFOURCC(fcc: DWORD): WORD; - -{-- Macro to make a ckid for a chunk out of a TWOCC and a stream num (0-255) -} - -function ToHex(n: BYTE): BYTE; -function MAKEAVICKID(tcc: WORD; stream: BYTE): DWORD; - -{-- Main AVI file header -----------------------------------------------------} - -{-- flags for use in in AVIFileHdr ---------------------------------} - -const - AVIF_HASINDEX = $00000010; // Index at end of file? - AVIF_MUSTUSEINDEX = $00000020; - AVIF_ISINTERLEAVED = $00000100; - AVIF_TRUSTCKTYPE = $00000800; // Use CKType to find key frames? - AVIF_WASCAPTUREFILE = $00010000; - AVIF_COPYRIGHTED = $00020000; - -{-- The AVI File Header LIST chunk should be padded to this size -------------} - -const - AVI_HEADERSIZE = 2048; // size of AVI header list - -type - PMainAVIHeader = ^TMainAVIHeader; - TMainAVIHeader = packed record - dwMicroSecPerFrame : DWORD; // frame display rate (or 0L) - dwMaxBytesPerSec : DWORD; // max. transfer rate - dwPaddingGranularity : DWORD; // pad to multiples of this - // size; normally 2K. - dwFlags : DWORD; // the ever-present flags - dwTotalFrames : DWORD; // # frames in file - dwInitialFrames : DWORD; - dwStreams : DWORD; - dwSuggestedBufferSize : DWORD; - - dwWidth : DWORD; - dwHeight : DWORD; - - dwReserved : array[0..3] of DWORD; - end; - -{-- Stream header ------------------------------------------------------------} - -const - AVISF_DISABLED = $00000001; - - AVISF_VIDEO_PALCHANGES = $00010000; - -type - PAVIStreamHeader = ^TAVIStreamHeader; - TAVIStreamHeader = packed record - fccType : FOURCC; - fccHandler : FOURCC; - dwFlags : DWORD; // Contains AVITF_* flags - wPriority : WORD; - wLanguage : WORD; - dwInitialFrames : DWORD; - dwScale : DWORD; - dwRate : DWORD; // dwRate / dwScale == samples/second - dwStart : DWORD; - dwLength : DWORD; // In units above... - dwSuggestedBufferSize : DWORD; - dwQuality : DWORD; - dwSampleSize : DWORD; - rcFrame : TRECT; - end; - -{-- Flags for index ----------------------------------------------------------} - -const - AVIIF_NOTIME = $00000100; // this frame doesn't take any time - AVIIF_COMPUSE = $0FFF0000; // these bits are for compressor use - -type - PAVIINDEXENTRY = ^TAVIINDEXENTRY; - TAVIINDEXENTRY = packed record - ckid : DWORD; - dwFlags : DWORD; - dwChunkOffset : DWORD; // Position of chunk - dwChunkLength : DWORD; // Length of chunk - end; - -{-- Palette change chunk (used in video streams) -----------------------------} - - PAVIPALCHANGE = ^TAVIPALCHANGE; - TAVIPALCHANGE = packed record - bFirstEntry : BYTE; // first entry to change - bNumEntries : BYTE; // # entries to change (0 if 256) - wFlags : WORD; // Mostly to preserve alignment... - peNew : array[0..0] of TPALETTEENTRY; // New color specifications - end; - -(**************************************************************************** - * - * AVIFile - routines for reading/writing standard AVI files - * - ***************************************************************************) - -// -// Ansi - Unicode thunking. -// -// Unicode or Ansi-only apps can call the avifile APIs. -// any Win32 app who wants to use -// any of the AVI COM interfaces must be UNICODE - the AVISTREAMINFO and -// AVIFILEINFO structures used in the Info methods of these interfaces are -// the unicode variants, and no thunking to or from ansi takes place -// except in the AVIFILE api entrypoints. -// -// For Ansi/Unicode thunking: for each entrypoint or structure that -// uses chars or strings, two versions are declared in the Win32 version, -// ApiNameW and ApiNameA. The default name ApiName is #defined to one or -// other of these depending on whether UNICODE is defined (during -// compilation of the app that is including this header). The source will -// contain ApiName and ApiNameA (with ApiName being the Win16 implementation, -// and also #defined to ApiNameW, and ApiNameA being the thunk entrypoint). -// - -// For GetFrame::SetFormat - use the best format for the display - -const - AVIGETFRAMEF_BESTDISPLAYFMT = 1; - -// -// Structures used by AVIStreamInfo & AVIFileInfo. -// -// These are related to, but not identical to, the header chunks -// in an AVI file. -// - -{-- AVISTREAMINFO ------------------------------------------------------------} - -// for Unicode/Ansi thunking we need to declare three versions of this! - -type - PAVIStreamInfoW = ^TAVIStreamInfoW; - TAVIStreamInfoW = packed record - fccType : DWORD; - fccHandler : DWORD; - dwFlags : DWORD; // Contains AVITF_* flags - dwCaps : DWORD; - wPriority : WORD; - wLanguage : WORD; - dwScale : DWORD; - dwRate : DWORD; // dwRate / dwScale == samples/second - dwStart : DWORD; - dwLength : DWORD; // In units above... - dwInitialFrames : DWORD; - dwSuggestedBufferSize : DWORD; - dwQuality : DWORD; - dwSampleSize : DWORD; - rcFrame : TRECT; - dwEditCount : DWORD; - dwFormatChangeCount : DWORD; - szName : array[0..63] of WideChar; - end; - - PAVIStreamInfoA = ^TAVIStreamInfoA; - TAVIStreamInfoA = packed record - fccType : DWORD; - fccHandler : DWORD; - dwFlags : DWORD; // Contains AVITF_* flags - dwCaps : DWORD; - wPriority : WORD; - wLanguage : WORD; - dwScale : DWORD; - dwRate : DWORD; // dwRate / dwScale == samples/second - dwStart : DWORD; - dwLength : DWORD; // In units above... - dwInitialFrames : DWORD; - dwSuggestedBufferSize : DWORD; - dwQuality : DWORD; - dwSampleSize : DWORD; - rcFrame : TRECT; - dwEditCount : DWORD; - dwFormatChangeCount : DWORD; - szName : array[0..63] of AnsiChar; - end; - - PAVIStreamInfo = ^TAVIStreamInfo; -{$IFDEF UNICODE} - TAVIStreamInfo = TAVIStreamInfoW; -{$ELSE} - TAVIStreamInfo = TAVIStreamInfoA; -{$ENDIF} - -const - AVISTREAMINFO_DISABLED = $00000001; - AVISTREAMINFO_FORMATCHANGES = $00010000; - -{-- AVIFILEINFO --------------------------------------------------------------} - -type - PAVIFileInfoW = ^TAVIFileInfoW; - TAVIFileInfoW = packed record - dwMaxBytesPerSec : DWORD; // max. transfer rate - dwFlags : DWORD; // the ever-present flags - dwCaps : DWORD; - dwStreams : DWORD; - dwSuggestedBufferSize : DWORD; - - dwWidth : DWORD; - dwHeight : DWORD; - - dwScale : DWORD; - dwRate : DWORD; // dwRate / dwScale == samples/second - dwLength : DWORD; - - dwEditCount : DWORD; - - szFileType : array[0..63] of WideChar; - // descriptive string for file type? - end; - - PAVIFileInfoA = ^TAVIFileInfoA; - TAVIFileInfoA = packed record - dwMaxBytesPerSec : DWORD; // max. transfer rate - dwFlags : DWORD; // the ever-present flags - dwCaps : DWORD; - dwStreams : DWORD; - dwSuggestedBufferSize : DWORD; - - dwWidth : DWORD; - dwHeight : DWORD; - - dwScale : DWORD; - dwRate : DWORD; // dwRate / dwScale == samples/second - dwLength : DWORD; - - dwEditCount : DWORD; - - szFileType : array[0..63] of AnsiChar; - // descriptive string for file type? - end; - - PAVIFileInfo = ^TAVIFileInfo; -{$IFDEF UNICODE} - TAVIFileInfo = TAVIFileInfoW; -{$ELSE} - TAVIFileInfo = TAVIFileInfoA; -{$ENDIF} - -{-- Flags for dwFlags --------------------------------------------------------} - -const - AVIFILEINFO_HASINDEX = $00000010; - AVIFILEINFO_MUSTUSEINDEX = $00000020; - AVIFILEINFO_ISINTERLEAVED = $00000100; - AVIFILEINFO_WASCAPTUREFILE = $00010000; - AVIFILEINFO_COPYRIGHTED = $00020000; - -{-- Flags for dwCaps ---------------------------------------------------------} - - AVIFILECAPS_CANREAD = $00000001; - AVIFILECAPS_CANWRITE = $00000002; - AVIFILECAPS_ALLKEYFRAMES = $00000010; - AVIFILECAPS_NOCOMPRESSION = $00000020; - -type - TAVISAVECALLBACK = function(i: int): BOOL; pascal; - -{-- AVICOMPRESSOPTIONS -------------------------------------------------------} - -// Make sure it matches the AutoDoc in avisave.c !!! - -type - PAVICOMPRESSOPTIONS = ^TAVICOMPRESSOPTIONS; - TAVICOMPRESSOPTIONS = packed record - fccType : DWORD; // stream type, for consistency - fccHandler : DWORD; // compressor - dwKeyFrameEvery : DWORD; // keyframe rate - dwQuality : DWORD; // compress quality 0-10,000 - dwBytesPerSecond : DWORD; // bytes per second - dwFlags : DWORD; // flags... see below - lpFormat : PVOID; // save format - cbFormat : DWORD; - lpParms : PVOID; // compressor options - cbParms : DWORD; - dwInterleaveEvery : DWORD; // for non-video streams only - end; - -// -// Defines for the dwFlags field of the AVICOMPRESSOPTIONS struct -// Each of these flags determines if the appropriate field in the structure -// (dwInterleaveEvery, dwBytesPerSecond, and dwKeyFrameEvery) is payed -// attention to. See the autodoc in avisave.c for details. -// - -const - AVICOMPRESSF_INTERLEAVE = $00000001; // interleave - AVICOMPRESSF_DATARATE = $00000002; // use a data rate - AVICOMPRESSF_KEYFRAMES = $00000004; // use keyframes - AVICOMPRESSF_VALID = $00000008; // has valid data? - -(* - - - - - - - - */ - - -/****** AVI Stream Interface *******************************************) - -type - IAVIStream = interface(IUnknown) - function Create(lParam1, lParam2: LPARAM): HResult; stdcall; - function Info(var psi: TAVIStreamInfoW; lSize: LONG): HResult; stdcall; - function FindSample(lPos: LONG; lFlags: LONG): LONG; stdcall; - function ReadFormat(lPos: LONG; lpFormat: PVOID; var lpcbFormat: LONG): HResult; stdcall; - function SetFormat(lPos: LONG; lpFormat: PVOID; cbFormat: LONG): HResult; stdcall; - function Read(lStart: LONG; lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; var plBytes, plSamples: LONG): HResult; stdcall; - function Write(lStart: LONG; lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten, plBytesWritten: LONG): HResult; stdcall; - function Delete(lStart: LONG; lSamples: LONG): HResult; stdcall; - function ReadData(fcc: DWORD; lp: PVOID; var lpcb: LONG): HResult; stdcall; - function WriteData(fcc: DWORD; lp: PVOID; cb: LONG): HResult; stdcall; - function SetInfo(var lpInfo: TAVIStreamInfoW; cbInfo: LONG): HResult; stdcall; - end; - - IAVIStreaming = interface(IUnknown) - function _Begin(lStart, lEnd : LONG; lRate : LONG): HResult; stdcall; - function _End: HResult; stdcall; - end; - - IAVIEditStream = interface(IUnknown) - function Cut(var plStart, plLength: LONG; var ppResult: IAVIStream): HResult; stdcall; - function Copy(var plStart, plLength: LONG; var ppResult: IAVIStream): HResult; stdcall; - function Paste(var plPos: LONG; var plLength: LONG; pstream: IAVIStream; lStart, lEnd: LONG): HResult; stdcall; - function Clone(var ppResult: IAVIStream): HResult; stdcall; - function SetInfo(var lpInfo: TAVIStreamInfoW; cbInfo: LONG): HResult; stdcall; - end; - -{-- AVIFile ------------------------------------------------------------------} - - IAVIFile = interface(IUnknown) - function Info(var pfi: TAVIFileInfoW; iSize: LONG): HResult; stdcall; - function GetStream(var ppStream: IAVISTREAM; fccType: DWORD; lParam: LONG): HResult; stdcall; - function CreateStream(var ppStream: IAVISTREAM; var psi: TAVIStreamInfoW): HResult; stdcall; - function WriteData(ckid: DWORD; lpData: PVOID; cbData: LONG): HResult; stdcall; - function ReadData(ckid: DWORD; lpData: PVOID; lpcbData: PLONG): HResult; stdcall; - function EndRecord: HResult; stdcall; - function DeleteStream(fccType: DWORD; lParam: LONG): HResult; stdcall; - end; - -{-- GetFrame -----------------------------------------------------------------} - - // The functions 'BeginExtraction' and 'EndExtraction' have actually - // the names 'Begin' and 'End', but we cannot use that identifiers for - // obvious reasons. - - IGetFrame = interface(IUnknown) - function GetFrame(lPos: LONG): PBitmapInfoHeader; stdcall; - function BeginExtraction(lStart, lEnd, lRate: LONG): HResult; stdcall; - function EndExtraction: HResult; stdcall; - function SetFormat(var lpbi: TBitmapInfoHeader; lpBits: Pointer; x, y, dx, dy: Integer): HResult; stdcall; - end; - -{-- GUIDs --------------------------------------------------------------------} - -const - IID_IAVIFile : TGUID = (D1: $00020020; D2: $0; D3: $0; D4:($C0,$0,$0,$0,$0,$0,$0,$46)); - IID_IAVIStream : TGUID = (D1: $00020021; D2: $0; D3: $0; D4:($C0,$0,$0,$0,$0,$0,$0,$46)); - IID_IAVIStreaming : TGUID = (D1: $00020022; D2: $0; D3: $0; D4:($C0,$0,$0,$0,$0,$0,$0,$46)); - IID_IGetFrame : TGUID = (D1: $00020023; D2: $0; D3: $0; D4:($C0,$0,$0,$0,$0,$0,$0,$46)); - IID_IAVIEditStream: TGUID = (D1: $00020024; D2: $0; D3: $0; D4:($C0,$0,$0,$0,$0,$0,$0,$46)); - - CLSID_AVISimpleUnMarshal : TGUID = (D1: $00020009; D2: $0; D3: $0; D4:($C0,$0,$0,$0,$0,$0,$0,$46)); - CLSID_AVIFile : TGUID = (D1: $00020000; D2: $0; D3: $0; D4:($C0,$0,$0,$0,$0,$0,$0,$46)); - - AVIFILEHANDLER_CANREAD = $0001; - AVIFILEHANDLER_CANWRITE = $0002; - AVIFILEHANDLER_CANACCEPTNONRGB = $0004; - -{-- Functions ----------------------------------------------------------------} -procedure AVIFileInit; stdcall; // Call this first! -procedure AVIFileExit; stdcall; -function AVIFileAddRef(pfile: IAVIFile): ULONG; stdcall; -function AVIFileRelease(pfile: IAVIFile): ULONG; stdcall; -function AVIFileOpenA(var ppfile: IAVIFile; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID): HResult; stdcall; -function AVIFileOpenW(var ppfile: IAVIFile; szFile: LPCWSTR; uMode: UINT; lpHandler: PCLSID): HResult; stdcall; - -{$IFDEF UNICODE} -function AVIFileOpen(var ppfile: IAVIFile; szFile: LPCWSTR; uMode: UINT; lpHandler: PCLSID): HResult; stdcall; -{$ELSE} -function AVIFileOpen(var ppfile: IAVIFile; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID): HResult; stdcall; -{$ENDIF} - -function AVIFileInfoW(pfile: IAVIFile; var pfi: TAVIFILEINFOW; lSize: LONG): HResult; stdcall; -function AVIFileInfoA(pfile: IAVIFile; var pfi: TAVIFILEINFOA; lSize: LONG): HResult; stdcall; -function AVIFileInfo(pfile: IAVIFile; var pfi: TAVIFILEINFO; lSize: LONG): HResult; stdcall; -function AVIFileGetStream(pfile: IAVIFile; var ppavi: IAVISTREAM; fccType: DWORD; lParam: LONG): HResult; stdcall; -function AVIFileCreateStreamW(pfile: IAVIFile; var ppavi: IAVISTREAM; var psi: TAVISTREAMINFOW): HResult; stdcall; -function AVIFileCreateStreamA(pfile: IAVIFile; var ppavi: IAVISTREAM; var psi: TAVISTREAMINFOA): HResult; stdcall; -function AVIFileCreateStream(pfile: IAVIFile; var ppavi: IAVISTREAM; var psi: TAVISTREAMINFO): HResult; stdcall; -function AVIFileWriteData(pfile: IAVIFile; ckid: DWORD; lpData: PVOID; cbData: LONG): HResult; stdcall; -function AVIFileReadData(pfile: IAVIFile; ckid: DWORD; lpData: PVOID; var lpcbData: LONG): HResult; stdcall; -function AVIFileEndRecord(pfile: IAVIFile): HResult; stdcall; -function AVIStreamAddRef(pavi: IAVIStream): ULONG; stdcall; -function AVIStreamRelease(pavi: IAVIStream): ULONG; stdcall; -function AVIStreamInfoW (pavi: IAVIStream; var psi: TAVISTREAMINFOW; lSize: LONG): HResult; stdcall; -function AVIStreamInfoA (pavi: IAVIStream; var psi: TAVISTREAMINFOA; lSize: LONG): HResult; stdcall; -function AVIStreamInfo(pavi: IAVIStream; var psi: TAVISTREAMINFO; lSize: LONG): HResult; stdcall; -function AVIStreamFindSample(pavi: IAVIStream; lPos: LONG; lFlags: LONG): LONG; stdcall; -function AVIStreamReadFormat(pavi: IAVIStream; lPos: LONG; lpFormat: PVOID; lpcbFormat: PLONG): HResult; stdcall; -function AVIStreamSetFormat(pavi: IAVIStream; lPos: LONG; lpFormat: PVOID; cbFormat: LONG): HResult; stdcall; -function AVIStreamReadData(pavi: IAVIStream; fcc: DWORD; lp: PVOID; lpcb: PLONG): HResult; stdcall; -function AVIStreamWriteData(pavi: IAVIStream; fcc: DWORD; lp: PVOID; cb: LONG): HResult; stdcall; -function AVIStreamRead( - pavi : IAVISTREAM; - lStart : LONG; - lSamples : LONG; - lpBuffer : PVOID; - cbBuffer : LONG; - plBytes : PLONG; - plSamples : PLONG - ): HResult; stdcall; - -const - AVISTREAMREAD_CONVENIENT = -1; - -function AVIStreamWrite( - pavi : IAVISTREAM; - lStart : LONG; - lSamples : LONG; - lpBuffer : PVOID; - cbBuffer : LONG; - dwFlags : DWORD; - plSampWritten : PLONG; - plBytesWritten : PLONG - ): HResult; stdcall; - -// Right now, these just use AVIStreamInfo() to get information, then -// return some of it. Can they be more efficient? - -function AVIStreamStart(pavi: IAVIStream): LONG; stdcall; -function AVIStreamLength(pavi: IAVIStream): LONG; stdcall; -function AVIStreamTimeToSample(pavi: IAVIStream; lTime: LONG): LONG; stdcall; -function AVIStreamSampleToTime(pavi: IAVIStream; lSample: LONG): LONG; stdcall; -function AVIStreamBeginStreaming(pavi: IAVIStream; lStart, lEnd: LONG; lRate: LONG): HResult; stdcall; -function AVIStreamEndStreaming(pavi: IAVIStream): HResult; stdcall; - -{-- Helper functions for using IGetFrame -------------------------------------} - -function AVIStreamGetFrameOpen(pavi: IAVIStream; lpbiWanted: PBitmapInfoHeader): IGetFrame; stdcall; -function AVIStreamGetFrame(pg: IGetFrame; lPos: LONG): PBitmapInfoHeader; stdcall; -function AVIStreamGetFrameClose(pg: IGetFrame): HResult; stdcall; - -// !!! We need some way to place an advise on a stream.... -// STDAPI AVIStreamHasChanged (PAVISTREAM pavi); - -{-- Shortcut function --------------------------------------------------------} - -function AVIStreamOpenFromFileA(var ppavi: IAVISTREAM; szFile: LPCSTR; fccType: DWORD; - lParam: LONG; mode: UINT; pclsidHandler: PCLSID): HResult; stdcall; -function AVIStreamOpenFromFileW(var ppavi: IAVISTREAM; szFile: LPCWSTR; fccType: DWORD; - lParam: LONG; mode: UINT; pclsidHandler: PCLSID): HResult; stdcall; - -{$IFDEF UNICODE} - function AVIStreamOpenFromFile(var ppavi: IAVISTREAM; szFile: LPCWSTR; fccType: DWORD; - lParam: LONG; mode: UINT; pclsidHandler: PCLSID): HResult; stdcall; -{$ELSE} - function AVIStreamOpenFromFile(var ppavi: IAVISTREAM; szFile: LPCSTR; fccType: DWORD; - lParam: LONG; mode: UINT; pclsidHandler: PCLSID): HResult; stdcall; -{$ENDIF} - -{-- Use to create disembodied streams ----------------------------------------} - -function AVIStreamCreate(var ppavi: IAVISTREAM; lParam1, lParam2: LONG; pclsidHandler: PCLSID): HResult; stdcall; - -// PHANDLER AVIAPI AVIGetHandler (PAVISTREAM pavi, PAVISTREAMHANDLER psh); -// PAVISTREAM AVIAPI AVIGetStream (PHANDLER p); - -{-- Flags for AVIStreamFindSample --------------------------------------------} - -const - FIND_DIR = $0000000F; // direction - FIND_NEXT = $00000001; // go forward - FIND_PREV = $00000004; // go backward - FIND_FROM_START = $00000008; // start at the logical beginning - - FIND_TYPE = $000000F0; // type mask - FIND_KEY = $00000010; // find key frame. - FIND_ANY = $00000020; // find any (non-empty) sample - FIND_FORMAT = $00000040; // find format change - - FIND_RET = $0000F000; // return mask - FIND_POS = $00000000; // return logical position - FIND_LENGTH = $00001000; // return logical size - FIND_OFFSET = $00002000; // return physical position - FIND_SIZE = $00003000; // return physical size - FIND_INDEX = $00004000; // return physical index position - -{-- Stuff to support backward compat. ----------------------------------------} - -function AVIStreamFindKeyFrame(var pavi: IAVISTREAM; lPos: LONG; lFlags: LONG): DWORD; stdcall; // AVIStreamFindSample - -// Non-portable: this is alias for method name -// FindKeyFrame FindSample - -function AVIStreamClose(pavi: IAVISTREAM): ULONG; stdcall; // AVIStreamRelease -function AVIFileClose(pfile: IAVIFILE): ULONG; stdcall; // AVIFileRelease -procedure AVIStreamInit; stdcall; // AVIFileInit -procedure AVIStreamExit; stdcall; // AVIFileExit - -const - SEARCH_NEAREST = FIND_PREV; - SEARCH_BACKWARD = FIND_PREV; - SEARCH_FORWARD = FIND_NEXT; - SEARCH_KEY = FIND_KEY; - SEARCH_ANY = FIND_ANY; - -{-- Helper macros ------------------------------------------------------------} - -function AVIStreamSampleToSample(pavi1, pavi2: IAVISTREAM; l: LONG): LONG; -function AVIStreamNextSample(pavi: IAVISTREAM; l: LONG): LONG; -function AVIStreamPrevSample(pavi: IAVISTREAM; l: LONG): LONG; -function AVIStreamNearestSample(pavi: IAVISTREAM; l: LONG): LONG; -function AVIStreamNextKeyFrame(pavi: IAVISTREAM; l: LONG): LONG; -function AVIStreamPrevKeyFrame(pavi: IAVISTREAM; l: LONG): LONG; -function AVIStreamNearestKeyFrame(pavi: IAVISTREAM; l: LONG): LONG; -function AVIStreamIsKeyFrame(pavi: IAVISTREAM; l: LONG): BOOL; -function AVIStreamPrevSampleTime(pavi: IAVISTREAM; t: LONG): LONG; -function AVIStreamNextSampleTime(pavi: IAVISTREAM; t: LONG): LONG; -function AVIStreamNearestSampleTime(pavi: IAVISTREAM; t: LONG): LONG; -function AVIStreamNextKeyFrameTime(pavi: IAVISTREAM; t: LONG): LONG; -function AVIStreamPrevKeyFrameTime(pavi: IAVISTREAM; t: LONG): LONG; -function AVIStreamNearestKeyFrameTime(pavi: IAVISTREAM; t: LONG): LONG; -function AVIStreamStartTime(pavi: IAVISTREAM): LONG; -function AVIStreamLengthTime(pavi: IAVISTREAM): LONG; -function AVIStreamEnd(pavi: IAVISTREAM): LONG; -function AVIStreamEndTime(pavi: IAVISTREAM): LONG; -function AVIStreamSampleSize(pavi: IAVISTREAM; lPos: LONG; plSize: PLONG): LONG; -function AVIStreamFormatSize(pavi: IAVISTREAM; lPos: LONG; plSize: PLONG): HResult; -function AVIStreamDataSize(pavi: IAVISTREAM; fcc: DWORD; plSize: PLONG): HResult; - -{== AVISave routines and structures ==========================================} - -const - comptypeDIB = $20424944; // mmioFOURCC('D', 'I', 'B', ' ') - -function AVIMakeCompressedStream( - var ppsCompressed : IAVISTREAM; - ppsSource : IAVISTREAM; - lpOptions : PAVICOMPRESSOPTIONS; - pclsidHandler : PCLSID - ): HResult; stdcall; - -// Non-portable: uses variable number of params -// EXTERN_C HRESULT CDECL AVISaveA (LPCSTR szFile, -// CLSID FAR *pclsidHandler, -// AVISAVECALLBACK lpfnCallback, -// int nStreams, -// PAVISTREAM pfile, -// LPAVICOMPRESSOPTIONS lpOptions, -// ...); - -function AVISaveVA( - szFile : LPCSTR; - pclsidHandler : PCLSID; - lpfnCallback : TAVISAVECALLBACK; - nStreams : int; - var ppavi : IAVISTREAM; - var plpOptions : PAVICOMPRESSOPTIONS - ): HResult; stdcall; - -// Non-portable: uses variable number of params -// EXTERN_C HRESULT CDECL AVISaveW (LPCWSTR szFile, -// CLSID FAR *pclsidHandler, -// AVISAVECALLBACK lpfnCallback, -// int nStreams, -// PAVISTREAM pfile, -// LPAVICOMPRESSOPTIONS lpOptions, -// ...); - -function AVISaveVW( - szFile : LPCWSTR; - pclsidHandler : PCLSID; - lpfnCallback : TAVISAVECALLBACK; - nStreams : int; - var ppavi : IAVISTREAM; - var plpOptions : PAVICOMPRESSOPTIONS - ): HResult; stdcall; - -// #define AVISave AVISaveA - -function AVISaveV( - szFile : LPCSTR; - pclsidHandler : PCLSID; - lpfnCallback : TAVISAVECALLBACK; - nStreams : int; - var ppavi : IAVISTREAM; - var plpOptions : PAVICOMPRESSOPTIONS - ): HResult; stdcall; // AVISaveVA - -function AVISaveOptions( - hwnd : HWND; - uiFlags : UINT; - nStreams : int; - var ppavi : IAVISTREAM; - var plpOptions : PAVICOMPRESSOPTIONS - ): BOOL; stdcall; - -function AVISaveOptionsFree(nStreams: int; var plpOptions: PAVICOMPRESSOPTIONS): HResult; stdcall; - -{-- FLAGS FOR uiFlags --------------------------------------------------------} - -// Same as the flags for ICCompressorChoose (see compman.h) -// These determine what the compression options dialog for video streams -// will look like. - -function AVIBuildFilterW(lpszFilter: LPWSTR; cbFilter: LONG; fSaving: BOOL): HResult; stdcall; -function AVIBuildFilterA(lpszFilter: LPSTR; cbFilter: LONG; fSaving: BOOL): HResult; stdcall; - -function AVIBuildFilter(lpszFilter: LPSTR; cbFilter: LONG; fSaving: BOOL): HResult; stdcall; // AVIBuildFilterA - -function AVIMakeFileFromStreams(var ppfile: IAVIFILE; nStreams: int; var papStreams: IAVISTREAM): HResult; stdcall; - -function AVIMakeStreamFromClipboard(cfFormat: UINT; hGlobal: THANDLE; var ppstream: IAVISTREAM): HResult; stdcall; - -{-- Clipboard routines -------------------------------------------------------} - -function AVIPutFileOnClipboard(pf: IAVIFILE): HResult; stdcall; -function AVIGetFromClipboard(var lppf: IAVIFILE): HResult; stdcall; -function AVIClearClipboard: HResult; stdcall; - -{-- Editing routines ---------------------------------------------------------} - -function CreateEditableStream(var ppsEditable: IAVISTREAM; psSource: IAVISTREAM): HResult; stdcall; -function EditStreamCut(pavi: IAVISTREAM; var plStart, plLength: LONG; var ppResult: IAVISTREAM): HResult; stdcall; -function EditStreamCopy(pavi: IAVISTREAM; var plStart, plLength: LONG; var ppResult: IAVISTREAM): HResult; stdcall; -function EditStreamPaste(pavi: IAVISTREAM; var plPos, plLength: LONG; pstream: IAVISTREAM; lStart, lEnd: LONG): HResult; stdcall; -function EditStreamClone(pavi: IAVISTREAM; var ppResult: IAVISTREAM): HResult; stdcall; -function EditStreamSetNameA(pavi: IAVISTREAM; lpszName: LPCSTR): HResult; stdcall; -function EditStreamSetNameW(pavi: IAVISTREAM; lpszName: LPCWSTR): HResult; stdcall; -function EditStreamSetInfoW(pavi: IAVISTREAM; lpInfo: PAVISTREAMINFOW; cbInfo: LONG): HResult; stdcall; -function EditStreamSetInfoA(pavi: IAVISTREAM; lpInfo: PAVISTREAMINFOA; cbInfo: LONG): HResult; stdcall; -function EditStreamSetInfo(pavi: IAVISTREAM; lpInfo: PAVISTREAMINFOA; cbInfo: LONG): HResult; stdcall; // EditStreamSetInfoA -function EditStreamSetName(pavi: IAVISTREAM; lpszName: LPCSTR): HResult; stdcall; // EditStreamSetNameA - -{-- Error handling -----------------------------------------------------------} - -const - AVIERR_OK = 0; - -// !!! Questions to be answered: -// How can you get a string form of these errors? -// Which of these errors should be replaced by errors in SCODE.H? - -const - AVIERR_UNSUPPORTED = $80044065; // MAKE_AVIERR(101) - AVIERR_BADFORMAT = $80044066; // MAKE_AVIERR(102) - AVIERR_MEMORY = $80044067; // MAKE_AVIERR(103) - AVIERR_INTERNAL = $80044068; // MAKE_AVIERR(104) - AVIERR_BADFLAGS = $80044069; // MAKE_AVIERR(105) - AVIERR_BADPARAM = $8004406A; // MAKE_AVIERR(106) - AVIERR_BADSIZE = $8004406B; // MAKE_AVIERR(107) - AVIERR_BADHANDLE = $8004406C; // MAKE_AVIERR(108) - AVIERR_FILEREAD = $8004406D; // MAKE_AVIERR(109) - AVIERR_FILEWRITE = $8004406E; // MAKE_AVIERR(110) - AVIERR_FILEOPEN = $8004406F; // MAKE_AVIERR(111) - AVIERR_COMPRESSOR = $80044070; // MAKE_AVIERR(112) - AVIERR_NOCOMPRESSOR = $80044071; // MAKE_AVIERR(113) - AVIERR_READONLY = $80044072; // MAKE_AVIERR(114) - AVIERR_NODATA = $80044073; // MAKE_AVIERR(115) - AVIERR_BUFFERTOOSMALL = $80044074; // MAKE_AVIERR(116) - AVIERR_CANTCOMPRESS = $80044075; // MAKE_AVIERR(117) - AVIERR_USERABORT = $800440C6; // MAKE_AVIERR(198) - AVIERR_ERROR = $800440C7; // MAKE_AVIERR(199) - -{== MCIWnd - Window class for MCI objects ====================================} - -// -// MCIWnd -// -// MCIWnd window class header file. -// -// the MCIWnd window class is a window class for controling MCI devices -// MCI devices include, wave files, midi files, AVI Video, cd audio, -// vcr, video disc, and others.. -// -// to learn more about MCI and mci command sets see the -// "Microsoft Multimedia Programmers's guide" in the Win31 SDK -// -// the easiest use of the MCIWnd class is like so: -// -// hwnd = MCIWndCreate(hwndParent, hInstance, 0, "chimes.wav"); -// ... -// MCIWndPlay(hwnd); -// MCIWndStop(hwnd); -// MCIWndPause(hwnd); -// .... -// MCIWndDestroy(hwnd); -// -// this will create a window with a play/pause, stop and a playbar -// and start the wave file playing. -// -// mciwnd.h defines macros for all the most common MCI commands, but -// any string command can be used if needed. -// -// Note: unlike the mciSendString() API, no alias or file name needs -// to be specifed, since the device to use is implied by the window handle. -// -// MCIWndSendString(hwnd, "setaudio stream to 2"); -// -// (C) Copyright Microsoft Corp. 1991-1995. All rights reserved. -// -// WIN32: -// -// MCIWnd supports both ansi and unicode interfaces. For any message that -// takes or returns a text string, two versions of the message are defined, -// appended with A or W for Ansi or Wide Char. The message or api itself -// is defined to be one or other of these depending on whether you have -// UNICODE defined in your application. -// Thus for the api MCIWndCreate, there are in fact two apis, -// MCIWndCreateA and MCIWndCreateW. If you call MCIWndCreate, this will be -// re-routed to MCIWndCreateA unless UNICODE is defined when building your -// application. In any one application, you can mix calls to the -// Ansi and Unicode entrypoints. -// -// If you use SendMessage instead of the macros below such as MCIWndOpen(), -// you will see that the messages have changed for WIN32, to support Ansi -// and Unicode entrypoints. In particular, MCI_OPEN has been replaced by -// MCWNDM_OPENA, or MCIWNDM_OPENW (MCIWNDM_OPEN is defined to be one or -// other of these). -// -// Also, note that the WIN32 implementation of MCIWnd uses UNICODE -// so all apis and messages supporting ANSI strings do so by mapping them -// UNICODE strings and then calling the corresponding UNICODE entrypoint. -// - -function MCIWndSM(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): DWORD; - -const - MCIWND_WINDOW_CLASS = 'MCIWndClass' ; - -function MCIWndCreateA(hwndParent: HWND; hInstance: HINST; dwStyle: DWORd; szFile: LPCSTR): HWND; cdecl; -function MCIWndCreateW(hwndParent: HWND; hInstance: HINST; dwStyle: DWORd; szFile: LPCWSTR): HWND; cdecl; -function MCIWndCreate(hwndParent: HWND; hInstance: HINST; dwStyle: DWORd; szFile: LPCSTR): HWND; cdecl; // MCIWndCreateA -function MCIWndRegisterClass: BOOL; cdecl; - -{-- Flags for the MCIWndOpen command -----------------------------------------} - -const - MCIWNDOPENF_NEW = $0001; // open a new file - -{-- Window styles ------------------------------------------------------------} - - MCIWNDF_NOAUTOSIZEWINDOW = $0001; // when movie size changes - MCIWNDF_NOPLAYBAR = $0002; // no toolbar - MCIWNDF_NOAUTOSIZEMOVIE = $0004; // when window size changes - MCIWNDF_NOMENU = $0008; // no popup menu from RBUTTONDOWN - MCIWNDF_SHOWNAME = $0010; // show name in caption - MCIWNDF_SHOWPOS = $0020; // show position in caption - MCIWNDF_SHOWMODE = $0040; // show mode in caption - MCIWNDF_SHOWALL = $0070; // show all - - MCIWNDF_NOTIFYMODE = $0100; // tell parent of mode change - MCIWNDF_NOTIFYPOS = $0200; // tell parent of pos change - MCIWNDF_NOTIFYSIZE = $0400; // tell parent of size change - MCIWNDF_NOTIFYERROR = $1000; // tell parent of an error - MCIWNDF_NOTIFYALL = $1F00; // tell all - - MCIWNDF_NOTIFYANSI = $0080; - -// The MEDIA notification includes a text string. -// To receive notifications in ANSI instead of unicode set the -// MCIWNDF_NOTIFYANSI style bit. The macro below includes this bit -// by default unless you define UNICODE in your application. - - MCIWNDF_NOTIFYMEDIAA = $0880; // tell parent of media change - MCIWNDF_NOTIFYMEDIAW = $0800; // tell parent of media change - - MCIWNDF_NOTIFYMEDIA = MCIWNDF_NOTIFYMEDIAA; - - MCIWNDF_RECORD = $2000; // Give a record button - MCIWNDF_NOERRORDLG = $4000; // Show Error Dlgs for MCI cmds? - MCIWNDF_NOOPEN = $8000; // Don't allow user to open things - -{-- Can macros ---------------------------------------------------------------} - -function MCIWndCanPlay(hwnd: HWND): BOOL; -function MCIWndCanRecord(hwnd: HWND): BOOL; -function MCIWndCanSave(hwnd: HWND): BOOL; -function MCIWndCanWindow(hwnd: HWND): BOOL; -function MCIWndCanEject(hwnd: HWND): BOOL; -function MCIWndCanConfig(hwnd: HWND): BOOL; -function MCIWndPaletteKick(hwnd: HWND): BOOL; -function MCIWndSave(hwnd: HWND; szFile: LPCSTR): DWORD; -function MCIWndSaveDialog(hwnd: HWND): DWORD; - -// If you dont give a device it will use the current device.... - -function MCIWndNew(hwnd: HWND; lp: PVOID): DWORD; -function MCIWndRecord(hwnd: HWND): DWORD; -function MCIWndOpen(hwnd: HWND; sz: LPCSTR; f: BOOL): DWORD; -function MCIWndOpenDialog(hwnd: HWND): DWORD; -function MCIWndClose(hwnd: HWND): DWORD; -function MCIWndPlay(hwnd: HWND): DWORD; -function MCIWndStop(hwnd: HWND): DWORD; -function MCIWndPause(hwnd: HWND): DWORD; -function MCIWndResume(hwnd: HWND): DWORD; -function MCIWndSeek(hwnd: HWND; lPos: DWORD): DWORD; -function MCIWndEject(hwnd: HWND): DWORD; -function MCIWndHome(hwnd: HWND): DWORD; -function MCIWndEnd(hwnd: HWND): DWORD; -function MCIWndGetSource(hwnd: HWND; prc: PRECT): DWORD; -function MCIWndPutSource(hwnd: HWND; prc: PRECT): DWORD; -function MCIWndGetDest(hwnd: HWND; prc: PRECT): DWORD; -function MCIWndPutDest(hwnd: HWND; prc: PRECT): DWORD; -function MCIWndPlayReverse(hwnd: HWND): DWORD; -function MCIWndPlayFrom(hwnd: HWND; lPos: DWORD): DWORD; -function MCIWndPlayTo(hwnd: HWND; lPos: DWORD): DWORD; -function MCIWndPlayFromTo(hwnd: HWND; lStart, lEnd: DWORD): DWORD; -function MCIWndGetDeviceID(hwnd: HWND): UINT; -function MCIWndGetAlias(hwnd: HWND): UINT; -function MCIWndGetMode(hwnd: HWND; lp: LPSTR; len: UINT): DWORD; -function MCIWndGetPosition(hwnd: HWND): DWORD; -function MCIWndGetPositionString(hwnd: HWND; lp: LPSTR; len: UINT): DWORD; -function MCIWndGetStart(hwnd: HWND): DWORD; -function MCIWndGetLength(hwnd: HWND): DWORD; -function MCIWndGetEnd(hwnd: HWND): DWORD; -function MCIWndStep(hwnd: HWND; n: DWORD): DWORD; -procedure MCIWndDestroy(hwnd: HWND); -procedure MCIWndSetZoom(hwnd: HWND; iZoom: UINT); -function MCIWndGetZoom(hwnd: HWND): UINT; -function MCIWndSetVolume(hwnd: HWND; iVol: UINT): DWORD; -function MCIWndGetVolume(hwnd: HWND): DWORD; -function MCIWndSetSpeed(hwnd: HWND; iSpeed: UINT): DWORD; -function MCIWndGetSpeed(hwnd: HWND): DWORD; -function MCIWndSetTimeFormat(hwnd: HWND; lp: LPCSTR): DWORD; -function MCIWndGetTimeFormat(hwnd: HWND; lp: LPSTR; len: UINT): DWORD; -procedure MCIWndValidateMedia(hwnd: HWND); -procedure MCIWndSetRepeat(hwnd: HWND; f: BOOL); -function MCIWndGetRepeat(hwnd: HWND): BOOL; -function MCIWndUseFrames(hwnd: HWND): DWORD; -function MCIWndUseTime(hwnd: HWND): DWORD; -procedure MCIWndSetActiveTimer(hwnd: HWND; active: UINT); -procedure MCIWndSetInactiveTimer(hwnd: HWND; inactive: UINT); -procedure MCIWndSetTimers(hwnd: HWND; active, inactive: UINT); -function MCIWndGetActiveTimer(hwnd: HWND): UINT; -function MCIWndGetInactiveTimer(hwnd: HWND): UINT; -function MCIWndRealize(hwnd: HWND; fBkgnd: BOOL): DWORD; -function MCIWndSendString(hwnd: HWND; sz: LPCSTR): DWORD; -function MCIWndReturnString(hwnd: HWND; lp: LPSTR; len: UINT): DWORD; -function MCIWndGetError(hwnd: HWND; lp: LPSTR; len: UINT): DWORD; - -// #define MCIWndActivate(hwnd, f) (void)MCIWndSM(hwnd, WM_ACTIVATE, (WPARAM)(BOOL)(f), 0) - -function MCIWndGetPalette(hwnd: HWND): HPALETTE; -function MCIWndSetPalette(hwnd: HWND; hpal: HPALETTE): DWORD; -function MCIWndGetFileName(hwnd: HWND; lp: LPSTR; len: UINT): DWORD; -function MCIWndGetDevice(hwnd: HWND; lp: LPSTR; len: UINT): DWORD; -function MCIWndGetStyles(hwnd: HWND): UINT; -function MCIWndChangeStyles(hwnd: HWND; mask: UINT; value: DWORD): DWORD; - -type - PUnknown = ^IUnknown; - -function MCIWndOpenInterface(hwnd: HWND; pUnk: PUnknown): DWORD; -function MCIWndSetOwner(hwnd: HWND; hwndP: HWND): DWORD; - -{-- Messages an app will send to MCIWND --------------------------------------} - -// all the text-related messages are defined out of order above (they need -// to be defined before the MCIWndOpen() macros - -const - MCIWNDM_GETDEVICEID = WM_USER + 100; - MCIWNDM_GETSTART = WM_USER + 103; - MCIWNDM_GETLENGTH = WM_USER + 104; - MCIWNDM_GETEND = WM_USER + 105; - MCIWNDM_EJECT = WM_USER + 107; - MCIWNDM_SETZOOM = WM_USER + 108; - MCIWNDM_GETZOOM = WM_USER + 109; - MCIWNDM_SETVOLUME = WM_USER + 110; - MCIWNDM_GETVOLUME = WM_USER + 111; - MCIWNDM_SETSPEED = WM_USER + 112; - MCIWNDM_GETSPEED = WM_USER + 113; - MCIWNDM_SETREPEAT = WM_USER + 114; - MCIWNDM_GETREPEAT = WM_USER + 115; - MCIWNDM_REALIZE = WM_USER + 118; - MCIWNDM_VALIDATEMEDIA = WM_USER + 121; - MCIWNDM_PLAYFROM = WM_USER + 122; - MCIWNDM_PLAYTO = WM_USER + 123; - MCIWNDM_GETPALETTE = WM_USER + 126; - MCIWNDM_SETPALETTE = WM_USER + 127; - MCIWNDM_SETTIMERS = WM_USER + 129; - MCIWNDM_SETACTIVETIMER = WM_USER + 130; - MCIWNDM_SETINACTIVETIMER = WM_USER + 131; - MCIWNDM_GETACTIVETIMER = WM_USER + 132; - MCIWNDM_GETINACTIVETIMER = WM_USER + 133; - MCIWNDM_CHANGESTYLES = WM_USER + 135; - MCIWNDM_GETSTYLES = WM_USER + 136; - MCIWNDM_GETALIAS = WM_USER + 137; - MCIWNDM_PLAYREVERSE = WM_USER + 139; - MCIWNDM_GET_SOURCE = WM_USER + 140; - MCIWNDM_PUT_SOURCE = WM_USER + 141; - MCIWNDM_GET_DEST = WM_USER + 142; - MCIWNDM_PUT_DEST = WM_USER + 143; - MCIWNDM_CAN_PLAY = WM_USER + 144; - MCIWNDM_CAN_WINDOW = WM_USER + 145; - MCIWNDM_CAN_RECORD = WM_USER + 146; - MCIWNDM_CAN_SAVE = WM_USER + 147; - MCIWNDM_CAN_EJECT = WM_USER + 148; - MCIWNDM_CAN_CONFIG = WM_USER + 149; - MCIWNDM_PALETTEKICK = WM_USER + 150; - MCIWNDM_OPENINTERFACE = WM_USER + 151; - MCIWNDM_SETOWNER = WM_USER + 152; - -{-- Define both A and W messages ---------------------------------------------} - - MCIWNDM_SENDSTRINGA = WM_USER + 101; - MCIWNDM_GETPOSITIONA = WM_USER + 102; - MCIWNDM_GETMODEA = WM_USER + 106; - MCIWNDM_SETTIMEFORMATA = WM_USER + 119; - MCIWNDM_GETTIMEFORMATA = WM_USER + 120; - MCIWNDM_GETFILENAMEA = WM_USER + 124; - MCIWNDM_GETDEVICEA = WM_USER + 125; - MCIWNDM_GETERRORA = WM_USER + 128; - MCIWNDM_NEWA = WM_USER + 134; - MCIWNDM_RETURNSTRINGA = WM_USER + 138; - MCIWNDM_OPENA = WM_USER + 153; - - MCIWNDM_SENDSTRINGW = WM_USER + 201; - MCIWNDM_GETPOSITIONW = WM_USER + 202; - MCIWNDM_GETMODEW = WM_USER + 206; - MCIWNDM_SETTIMEFORMATW = WM_USER + 219; - MCIWNDM_GETTIMEFORMATW = WM_USER + 220; - MCIWNDM_GETFILENAMEW = WM_USER + 224; - MCIWNDM_GETDEVICEW = WM_USER + 225; - MCIWNDM_GETERRORW = WM_USER + 228; - MCIWNDM_NEWW = WM_USER + 234; - MCIWNDM_RETURNSTRINGW = WM_USER + 238; - MCIWNDM_OPENW = WM_USER + 252; - -{-- Map defaults to A --------------------------------------------------------} - - MCIWNDM_SENDSTRING = MCIWNDM_SENDSTRINGA; - MCIWNDM_GETPOSITION = MCIWNDM_GETPOSITIONA; - MCIWNDM_GETMODE = MCIWNDM_GETMODEA; - MCIWNDM_SETTIMEFORMAT = MCIWNDM_SETTIMEFORMATA; - MCIWNDM_GETTIMEFORMAT = MCIWNDM_GETTIMEFORMATA; - MCIWNDM_GETFILENAME = MCIWNDM_GETFILENAMEA; - MCIWNDM_GETDEVICE = MCIWNDM_GETDEVICEA; - MCIWNDM_GETERROR = MCIWNDM_GETERRORA; - MCIWNDM_NEW = MCIWNDM_NEWA; - MCIWNDM_RETURNSTRING = MCIWNDM_RETURNSTRINGA; - MCIWNDM_OPEN = MCIWNDM_OPENA; - -// note that the source text for MCIWND will thus contain -// support for eg MCIWNDM_SENDSTRING (both the 16-bit entrypoint and -// in win32 mapped to MCIWNDM_SENDSTRINGW), and MCIWNDM_SENDSTRINGA (the -// win32 ansi thunk). - -{-- Messages MCIWND will send to an app --------------------------------------} - -const - MCIWNDM_NOTIFYMODE = WM_USER + 200; // wp = hwnd, lp = mode - MCIWNDM_NOTIFYPOS = WM_USER + 201; // wp = hwnd, lp = pos - MCIWNDM_NOTIFYSIZE = WM_USER + 202; // wp = hwnd - MCIWNDM_NOTIFYMEDIA = WM_USER + 203; // wp = hwnd, lp = fn - MCIWNDM_NOTIFYERROR = WM_USER + 205; // wp = hwnd, lp = error - -{-- Special seek values for START and END ------------------------------------} - - MCIWND_START = dword(-1) ; - MCIWND_END = dword(-2) ; - -{== VIDEO - Video capture driver interface ===================================} - -type - HVIDEO = THandle; - PHVIDEO = ^HVIDEO; - -{-- Error return values ------------------------------------------------------} - -const - DV_ERR_OK = 0; // No error - DV_ERR_BASE = 1; // Error Base - DV_ERR_NONSPECIFIC = DV_ERR_BASE; - DV_ERR_BADFORMAT = DV_ERR_BASE + 1; // unsupported video format - DV_ERR_STILLPLAYING = DV_ERR_BASE + 2; // still something playing - DV_ERR_UNPREPARED = DV_ERR_BASE + 3; // header not prepared - DV_ERR_SYNC = DV_ERR_BASE + 4; // device is synchronous - DV_ERR_TOOMANYCHANNELS = DV_ERR_BASE + 5; // number of channels exceeded - DV_ERR_NOTDETECTED = DV_ERR_BASE + 6; // HW not detected - DV_ERR_BADINSTALL = DV_ERR_BASE + 7; // Can not get Profile - DV_ERR_CREATEPALETTE = DV_ERR_BASE + 8; - DV_ERR_SIZEFIELD = DV_ERR_BASE + 9; - DV_ERR_PARAM1 = DV_ERR_BASE + 10; - DV_ERR_PARAM2 = DV_ERR_BASE + 11; - DV_ERR_CONFIG1 = DV_ERR_BASE + 12; - DV_ERR_CONFIG2 = DV_ERR_BASE + 13; - DV_ERR_FLAGS = DV_ERR_BASE + 14; - DV_ERR_13 = DV_ERR_BASE + 15; - - DV_ERR_NOTSUPPORTED = DV_ERR_BASE + 16; // function not suported - DV_ERR_NOMEM = DV_ERR_BASE + 17; // out of memory - DV_ERR_ALLOCATED = DV_ERR_BASE + 18; // device is allocated - DV_ERR_BADDEVICEID = DV_ERR_BASE + 19; - DV_ERR_INVALHANDLE = DV_ERR_BASE + 20; - DV_ERR_BADERRNUM = DV_ERR_BASE + 21; - DV_ERR_NO_BUFFERS = DV_ERR_BASE + 22; // out of buffers - - DV_ERR_MEM_CONFLICT = DV_ERR_BASE + 23; // Mem conflict detected - DV_ERR_IO_CONFLICT = DV_ERR_BASE + 24; // I/O conflict detected - DV_ERR_DMA_CONFLICT = DV_ERR_BASE + 25; // DMA conflict detected - DV_ERR_INT_CONFLICT = DV_ERR_BASE + 26; // Interrupt conflict detected - DV_ERR_PROTECT_ONLY = DV_ERR_BASE + 27; // Can not run in standard mode - DV_ERR_LASTERROR = DV_ERR_BASE + 27; - DV_ERR_USER_MSG = DV_ERR_BASE + 1000; // Hardware specific errors - -{-- Callback messages --------------------------------------------------------} - -// Note that the values for all installable driver callback messages are -// identical, (ie. MM_DRVM_DATA has the same value for capture drivers, -// installable video codecs, and the audio compression manager). - -const - DV_VM_OPEN = MM_DRVM_OPEN; // Obsolete messages - DV_VM_CLOSE = MM_DRVM_CLOSE; - DV_VM_DATA = MM_DRVM_DATA; - DV_VM_ERROR = MM_DRVM_ERROR; - -{== Structures ===============================================================} - -{-- Video data block header --------------------------------------------------} - -type - PVIDEOHDR = ^TVIDEOHDR; - TVIDEOHDR = record - lpData : PBYTE; // pointer to locked data buffer - dwBufferLength : DWORD; // Length of data buffer - dwBytesUsed : DWORD; // Bytes actually used - dwTimeCaptured : DWORD; // Milliseconds from start of stream - dwUser : DWORD; // for client's use - dwFlags : DWORD; // assorted flags (see defines) - dwReserved : array[0..3] of DWORD; // reserved for driver - end; - -{-- dwFlags field of VIDEOHDR ------------------------------------------------} - -const - VHDR_DONE = $00000001; // Done bit - VHDR_PREPARED = $00000002; // Set if this header has been prepared - VHDR_INQUEUE = $00000004; // Reserved for driver - VHDR_KEYFRAME = $00000008; // Key Frame - -{-- Channel capabilities structure -------------------------------------------} - -type - PCHANNEL_CAPS = ^TCHANNEL_CAPS; - TCHANNEL_CAPS = record - dwFlags : DWORD; // Capability flags - dwSrcRectXMod : DWORD; // Granularity of src rect in x - dwSrcRectYMod : DWORD; // Granularity of src rect in y - dwSrcRectWidthMod : DWORD; // Granularity of src rect width - dwSrcRectHeightMod : DWORD; // Granularity of src rect height - dwDstRectXMod : DWORD; // Granularity of dst rect in x - dwDstRectYMod : DWORD; // Granularity of dst rect in y - dwDstRectWidthMod : DWORD; // Granularity of dst rect width - dwDstRectHeightMod : DWORD; // Granularity of dst rect height - end; - -{-- dwFlags of CHANNEL_CAPS --------------------------------------------------} - -const - VCAPS_OVERLAY = $00000001; // overlay channel - VCAPS_SRC_CAN_CLIP = $00000002; // src rect can clip - VCAPS_DST_CAN_CLIP = $00000004; // dst rect can clip - VCAPS_CAN_SCALE = $00000008; // allows src != dst - -{== API flags ================================================================} - -{-- Types of channels to open with the videoOpen function --------------------} - -const - VIDEO_EXTERNALIN = $0001; - VIDEO_EXTERNALOUT = $0002; - VIDEO_IN = $0004; - VIDEO_OUT = $0008; - -{-- Is a driver dialog available for this channel ----------------------------} - - VIDEO_DLG_QUERY = $0010; - -{-- videoConfigure (both GET and SET) ----------------------------------------} - - VIDEO_CONFIGURE_QUERY = $8000; - -{-- videoConfigure (SET only) ------------------------------------------------} - - VIDEO_CONFIGURE_SET = $1000; - -{-- videoConfigure (GET only) ------------------------------------------------} - - VIDEO_CONFIGURE_GET = $2000; - VIDEO_CONFIGURE_QUERYSIZE = $0001; - - VIDEO_CONFIGURE_CURRENT = $0010; - VIDEO_CONFIGURE_NOMINAL = $0020; - VIDEO_CONFIGURE_MIN = $0040; - VIDEO_CONFIGURE_MAX = $0080; - -{== Configure messages =======================================================} - - DVM_USER = $4000; - - DVM_CONFIGURE_START = $1000; - DVM_CONFIGURE_END = $1FFF; - DVM_PALETTE = DVM_CONFIGURE_START + 1; - DVM_FORMAT = DVM_CONFIGURE_START + 2; - DVM_PALETTERGB555 = DVM_CONFIGURE_START + 3; - DVM_SRC_RECT = DVM_CONFIGURE_START + 4; - DVM_DST_RECT = DVM_CONFIGURE_START + 5; - -{== AVICAP - Window class for AVI capture ====================================} - -function AVICapSM(hwnd: HWND; m: UINT; w: WPARAM; l: LPARAM): DWORD; - -{-- Window messages WM_CAP... which can be sent to an AVICAP window ----------} - -// UNICODE -// -// The Win32 version of AVICAP on NT supports UNICODE applications: -// for each API or message that takes a char or string parameter, there are -// two versions, ApiNameA and ApiNameW. The default name ApiName is #defined -// to one or other depending on whether UNICODE is defined. Apps can call -// the A and W apis directly, and mix them. -// -// The 32-bit AVICAP on NT uses unicode exclusively internally. -// ApiNameA() will be implemented as a call to ApiNameW() together with -// translation of strings. - -// Defines start of the message range -const - WM_CAP_START = WM_USER; - WM_CAP_UNICODE_START = WM_USER + 100; - - WM_CAP_GET_CAPSTREAMPTR = WM_CAP_START + 1; - - WM_CAP_SET_CALLBACK_ERRORW = WM_CAP_UNICODE_START + 2; - WM_CAP_SET_CALLBACK_STATUSW = WM_CAP_UNICODE_START + 3; - WM_CAP_SET_CALLBACK_ERRORA = WM_CAP_START + 2; - WM_CAP_SET_CALLBACK_STATUSA = WM_CAP_START + 3; - WM_CAP_SET_CALLBACK_ERROR = WM_CAP_SET_CALLBACK_ERRORA; - WM_CAP_SET_CALLBACK_STATUS = WM_CAP_SET_CALLBACK_STATUSA; - - WM_CAP_SET_CALLBACK_YIELD = WM_CAP_START + 4; - WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5; - WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6; - WM_CAP_SET_CALLBACK_WAVESTREAM = WM_CAP_START + 7; - WM_CAP_GET_USER_DATA = WM_CAP_START + 8; - WM_CAP_SET_USER_DATA = WM_CAP_START + 9; - - WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10; - WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11; - - WM_CAP_DRIVER_GET_NAMEA = WM_CAP_START + 12; - WM_CAP_DRIVER_GET_VERSIONA = WM_CAP_START + 13; - WM_CAP_DRIVER_GET_NAMEW = WM_CAP_UNICODE_START + 12; - WM_CAP_DRIVER_GET_VERSIONW = WM_CAP_UNICODE_START + 13; - WM_CAP_DRIVER_GET_NAME = WM_CAP_DRIVER_GET_NAMEA; - WM_CAP_DRIVER_GET_VERSION = WM_CAP_DRIVER_GET_VERSIONA; - - WM_CAP_DRIVER_GET_CAPS = WM_CAP_START + 14; - - WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20; - WM_CAP_FILE_GET_CAPTURE_FILEA = WM_CAP_START + 21; - WM_CAP_FILE_SAVEASA = WM_CAP_START + 23; - WM_CAP_FILE_SAVEDIBA = WM_CAP_START + 25; - WM_CAP_FILE_SET_CAPTURE_FILEW = WM_CAP_UNICODE_START + 20; - WM_CAP_FILE_GET_CAPTURE_FILEW = WM_CAP_UNICODE_START + 21; - WM_CAP_FILE_SAVEASW = WM_CAP_UNICODE_START + 23; - WM_CAP_FILE_SAVEDIBW = WM_CAP_UNICODE_START + 25; - WM_CAP_FILE_SET_CAPTURE_FILE = WM_CAP_FILE_SET_CAPTURE_FILEA; - WM_CAP_FILE_GET_CAPTURE_FILE = WM_CAP_FILE_GET_CAPTURE_FILEA; - WM_CAP_FILE_SAVEAS = WM_CAP_FILE_SAVEASA; - WM_CAP_FILE_SAVEDIB = WM_CAP_FILE_SAVEDIBA; - - // out of order to save on ifdefs - - WM_CAP_FILE_ALLOCATE = WM_CAP_START + 22; - WM_CAP_FILE_SET_INFOCHUNK = WM_CAP_START + 24; - - WM_CAP_EDIT_COPY = WM_CAP_START + 30; - - WM_CAP_SET_AUDIOFORMAT = WM_CAP_START + 35; - WM_CAP_GET_AUDIOFORMAT = WM_CAP_START + 36; - - WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41; - WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42; - WM_CAP_DLG_VIDEODISPLAY = WM_CAP_START + 43; - WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44; - WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45; - WM_CAP_DLG_VIDEOCOMPRESSION = WM_CAP_START + 46; - - WM_CAP_SET_PREVIEW = WM_CAP_START + 50; - WM_CAP_SET_OVERLAY = WM_CAP_START + 51; - WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52; - WM_CAP_SET_SCALE = WM_CAP_START + 53; - WM_CAP_GET_STATUS = WM_CAP_START + 54; - WM_CAP_SET_SCROLL = WM_CAP_START + 55; - - WM_CAP_GRAB_FRAME = WM_CAP_START + 60; - WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP_START + 61; - - WM_CAP_SEQUENCE = WM_CAP_START + 62; - WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63; - WM_CAP_SET_SEQUENCE_SETUP = WM_CAP_START + 64; - WM_CAP_GET_SEQUENCE_SETUP = WM_CAP_START + 65; - - WM_CAP_SET_MCI_DEVICEA = WM_CAP_START + 66; - WM_CAP_GET_MCI_DEVICEA = WM_CAP_START + 67; - WM_CAP_SET_MCI_DEVICEW = WM_CAP_UNICODE_START + 66; - WM_CAP_GET_MCI_DEVICEW = WM_CAP_UNICODE_START + 67; - WM_CAP_SET_MCI_DEVICE = WM_CAP_SET_MCI_DEVICEA; - WM_CAP_GET_MCI_DEVICE = WM_CAP_GET_MCI_DEVICEA; - - WM_CAP_STOP = WM_CAP_START + 68; - WM_CAP_ABORT = WM_CAP_START + 69; - - WM_CAP_SINGLE_FRAME_OPEN = WM_CAP_START + 70; - WM_CAP_SINGLE_FRAME_CLOSE = WM_CAP_START + 71; - WM_CAP_SINGLE_FRAME = WM_CAP_START + 72; - - WM_CAP_PAL_OPENA = WM_CAP_START + 80; - WM_CAP_PAL_SAVEA = WM_CAP_START + 81; - WM_CAP_PAL_OPENW = WM_CAP_UNICODE_START + 80; - WM_CAP_PAL_SAVEW = WM_CAP_UNICODE_START + 81; - WM_CAP_PAL_OPEN = WM_CAP_PAL_OPENA; - WM_CAP_PAL_SAVE = WM_CAP_PAL_SAVEA; - - WM_CAP_PAL_PASTE = WM_CAP_START + 82; - WM_CAP_PAL_AUTOCREATE = WM_CAP_START + 83; - WM_CAP_PAL_MANUALCREATE = WM_CAP_START + 84; - - // Following added post VFW 1.1 - - WM_CAP_SET_CALLBACK_CAPCONTROL = WM_CAP_START + 85; - - // Defines end of the message range - - WM_CAP_UNICODE_END = WM_CAP_PAL_SAVEW; - WM_CAP_END = WM_CAP_UNICODE_END; - -{-- Callback definitions -----------------------------------------------------} - -type - TCAPYIELDCALLBACK = function(hWnd: HWND): DWORD; stdcall; - - TCAPSTATUSCALLBACKW = function(hWnd: HWND; nID: int; lpsz: LPCWSTR): DWORD; stdcall; - TCAPERRORCALLBACKW = function(hWnd: HWND; nID: int; lpsz: LPCWSTR): DWORD; stdcall; - TCAPSTATUSCALLBACKA = function(hWnd: HWND; nID: int; lpsz: LPCSTR): DWORD; stdcall; - TCAPERRORCALLBACKA = function(hWnd: HWND; nID: int; lpsz: LPCSTR): DWORD; stdcall; - - TCAPSTATUSCALLBACK = TCAPSTATUSCALLBACKA; - TCAPERRORCALLBACK = TCAPERRORCALLBACKA; - - TCAPVIDEOCALLBACK = function(hWnd: HWND; lpVHdr: PVIDEOHDR): DWORD; stdcall; - TCAPWAVECALLBACK = function(hWnd: HWND; lpWHdr: PWAVEHDR): DWORD; stdcall; - TCAPCONTROLCALLBACK = function(hWnd: HWND; nState: int): DWORD; stdcall; - -{-- Structures ---------------------------------------------------------------} - -type - PCAPDRIVERCAPS = ^TCAPDRIVERCAPS; - TCAPDRIVERCAPS = record - wDeviceIndex : UINT; // Driver index in system.ini - fHasOverlay : BOOL; // Can device overlay? - fHasDlgVideoSource : BOOL; // Has Video source dlg? - fHasDlgVideoFormat : BOOL; // Has Format dlg? - fHasDlgVideoDisplay : BOOL; // Has External out dlg? - fCaptureInitialized : BOOL; // Driver ready to capture? - fDriverSuppliesPalettes : BOOL; // Can driver make palettes? - - // following always NULL on Win32. - hVideoIn : THANDLE; // Driver In channel - hVideoOut : THANDLE; // Driver Out channel - hVideoExtIn : THANDLE; // Driver Ext In channel - hVideoExtOut : THANDLE; // Driver Ext Out channel - end; - - PCAPSTATUS = ^TCAPSTATUS; - TCAPSTATUS = record - uiImageWidth : UINT ; // Width of the image - uiImageHeight : UINT ; // Height of the image - fLiveWindow : BOOL ; // Now Previewing video? - fOverlayWindow : BOOL ; // Now Overlaying video? - fScale : BOOL ; // Scale image to client? - ptScroll : TPOINT ; // Scroll position - fUsingDefaultPalette : BOOL ; // Using default driver palette? - fAudioHardware : BOOL ; // Audio hardware present? - fCapFileExists : BOOL ; // Does capture file exist? - dwCurrentVideoFrame : DWORD ; // # of video frames cap'td - dwCurrentVideoFramesDropped : DWORD ; // # of video frames dropped - dwCurrentWaveSamples : DWORD ; // # of wave samples cap'td - dwCurrentTimeElapsedMS : DWORD ; // Elapsed capture duration - hPalCurrent : HPALETTE; // Current palette in use - fCapturingNow : BOOL ; // Capture in progress? - dwReturn : DWORD ; // Error value after any operation - wNumVideoAllocated : UINT ; // Actual number of video buffers - wNumAudioAllocated : UINT ; // Actual number of audio buffers - end; - - // Default values in parenthesis - - PCAPTUREPARMS = ^TCAPTUREPARMS; - TCAPTUREPARMS = record - dwRequestMicroSecPerFrame : DWORD ; // Requested capture rate - fMakeUserHitOKToCapture : BOOL ; // Show "Hit OK to cap" dlg? - wPercentDropForError : UINT ; // Give error msg if > (10%) - fYield : BOOL ; // Capture via background task? - dwIndexSize : DWORD ; // Max index size in frames (32K) - wChunkGranularity : UINT ; // Junk chunk granularity (2K) - fUsingDOSMemory : BOOL ; // Use DOS buffers? - wNumVideoRequested : UINT ; // # video buffers, If 0, autocalc - fCaptureAudio : BOOL ; // Capture audio? - wNumAudioRequested : UINT ; // # audio buffers, If 0, autocalc - vKeyAbort : UINT ; // Virtual key causing abort - fAbortLeftMouse : BOOL ; // Abort on left mouse? - fAbortRightMouse : BOOL ; // Abort on right mouse? - fLimitEnabled : BOOL ; // Use wTimeLimit? - wTimeLimit : UINT ; // Seconds to capture - fMCIControl : BOOL ; // Use MCI video source? - fStepMCIDevice : BOOL ; // Step MCI device? - dwMCIStartTime : DWORD ; // Time to start in MS - dwMCIStopTime : DWORD ; // Time to stop in MS - fStepCaptureAt2x : BOOL ; // Perform spatial averaging 2x - wStepCaptureAverageFrames : UINT ; // Temporal average n Frames - dwAudioBufferSize : DWORD ; // Size of audio bufs (0 = default) - fDisableWriteCache : BOOL ; // Attempt to disable write cache - AVStreamMaster : UINT ; // Which stream controls length? - end; - -{-- AVStreamMaster -----------------------------------------------------------} - -// Since Audio and Video streams generally use non-synchronized capture -// clocks, this flag determines whether the audio stream is to be considered -// the master or controlling clock when writing the AVI file: -// -// AVSTREAMMASTER_AUDIO - Audio is master, video frame duration is forced -// to match audio duration (VFW 1.0, 1.1 default) -// AVSTREAMMASTER_NONE - No master, audio and video streams may be of -// different lengths - -const - AVSTREAMMASTER_AUDIO = 0; // Audio master (VFW 1.0, 1.1) - AVSTREAMMASTER_NONE = 1; // No master - -type - PCAPINFOCHUNK = ^TCAPINFOCHUNK; - TCAPINFOCHUNK = record - fccInfoID : FOURCC; // Chunk ID, "ICOP" for copyright - lpData : PVOID; // pointer to data - cbData : DWORD; // size of lpData - end; - -{-- CapControlCallback states ------------------------------------------------} - -const - CONTROLCALLBACK_PREROLL = 1; // Waiting to start capture - CONTROLCALLBACK_CAPTURING = 2; // Now capturing - -{-- Message crackers for above -----------------------------------------------} - -// message wrapper macros are defined for the default messages only. Apps -// that wish to mix Ansi and UNICODE message sending will have to -// reference the _A and _W messages directly - -function capSetCallbackOnError(hwnd: HWND; fpProc: TCAPERRORCALLBACK): BOOL; -function capSetCallbackOnStatus(hwnd: HWND; fpProc: TCAPSTATUSCALLBACK): BOOL; -function capSetCallbackOnYield(hwnd: HWND; fpProc: TCAPYIELDCALLBACK): BOOL; -function capSetCallbackOnFrame(hwnd: HWND; fpProc: TCAPVIDEOCALLBACK): BOOL; -function capSetCallbackOnVideoStream(hwnd: HWND; fpProc: TCAPVIDEOCALLBACK): BOOL; -function capSetCallbackOnWaveStream(hwnd: HWND; fpProc: TCAPWAVECALLBACK): BOOL; -function capSetCallbackOnCapControl(hwnd: HWND; fpProc: TCAPCONTROLCALLBACK): BOOL; - -function capSetUserData(hwnd: HWND; lUser: DWORD): BOOL; -function capGetUserData(hwnd: HWND): DWORD; - -function capDriverConnect(hwnd: HWND; i: INT): BOOL; -function capDriverDisconnect(hwnd: HWND): BOOL; -function capDriverGetName(hwnd: HWND; szName: LPSTR; wSize: WORD): BOOL; -function capDriverGetVersion(hwnd: HWND; szVer: LPSTR; wSize: WORD): BOOL; -function capDriverGetCaps(hwnd: HWND; s: PCAPDRIVERCAPS; wSize: WORD): BOOL; - -function capFileSetCaptureFile(hwnd: HWND; szName: LPCSTR): BOOL; -function capFileGetCaptureFile(hwnd: HWND; szName: LPSTR; wSize: WORD): BOOL; -function capFileAlloc(hwnd: HWND; dwSize: DWORD): BOOL; -function capFileSaveAs(hwnd: HWND; szName: LPCSTR): BOOL; -function capFileSetInfoChunk(hwnd: HWND; lpInfoChunk: PCAPINFOCHUNK): BOOL; -function capFileSaveDIB(hwnd: HWND; szName: LPCSTR): BOOL; - -function capEditCopy(hwnd: HWND): BOOL; - -function capSetAudioFormat(hwnd: HWND; s: PWAVEFORMATEX; wSize: WORD): BOOL; -function capGetAudioFormat(hwnd: HWND; s: PWAVEFORMATEX; wSize: WORD): DWORD; -function capGetAudioFormatSize(hwnd: HWND): DWORD; - -function capDlgVideoFormat(hwnd: HWND): BOOL; -function capDlgVideoSource(hwnd: HWND): BOOL; -function capDlgVideoDisplay(hwnd: HWND): BOOL; -function capDlgVideoCompression(hwnd: HWND): BOOL; - -function capGetVideoFormat(hwnd: HWND; s: PVOID; wSize: WORD): DWORD; -function capGetVideoFormatSize(hwnd: HWND): DWORD; -function capSetVideoFormat(hwnd: HWND; s: PVOID; wSize: WORD): BOOL; - -function capPreview(hwnd: HWND; f: BOOL): BOOL; -function capPreviewRate(hwnd: HWND; wMS: WORD): BOOL; -function capOverlay(hwnd: HWND; f: BOOL): BOOL; -function capPreviewScale(hwnd: HWND; f: BOOL): BOOL; -function capGetStatus(hwnd: HWND; s: PCAPSTATUS; wSize: WORD): BOOL; -function capSetScrollPos(hwnd: HWND; lpP: PPOINT): BOOL; - -function capGrabFrame(hwnd: HWND): BOOL; -function capGrabFrameNoStop(hwnd: HWND): BOOL; - -function capCaptureSequence(hwnd: HWND): BOOL; -function capCaptureSequenceNoFile(hwnd: HWND): BOOL; -function capCaptureStop(hwnd: HWND): BOOL; -function capCaptureAbort(hwnd: HWND): BOOL; - -function capCaptureSingleFrameOpen(hwnd: HWND): BOOL; -function capCaptureSingleFrameClose(hwnd: HWND): BOOL; -function capCaptureSingleFrame(hwnd: HWND): BOOL; - -function capCaptureGetSetup(hwnd: HWND; s: PCAPTUREPARMS; wSize: WORD): BOOL; -function capCaptureSetSetup(hwnd: HWND; s: PCAPTUREPARMS; wSize: WORD): BOOL; - -function capSetMCIDeviceName(hwnd: HWND; szName: LPCSTR): BOOL; -function capGetMCIDeviceName(hwnd: HWND; szName: LPSTR; wSize: WORD): BOOL; - -function capPaletteOpen(hwnd: HWND; szName: LPCSTR): BOOL; -function capPaletteSave(hwnd: HWND; szName: LPCSTR): BOOL; -function capPalettePaste(hwnd: HWND): BOOL; -function capPaletteAuto(hwnd: HWND; iFrames, iColors: INT): BOOL; -function capPaletteManual(hwnd: HWND; fGrab: BOOL; iColors: INT): BOOL; - -{-- The only exported functions from AVICAP.DLL ------------------------------} - -function capCreateCaptureWindowA( - lpszWindowName : LPCSTR; - dwStyle : DWORD; - x, y : int; - nWidth, nHeight : int; - hwndParent : HWND; - nID : int - ): HWND; stdcall; - -function capGetDriverDescriptionA( - wDriverIndex : UINT; - lpszName : LPSTR; - cbName : int; - lpszVer : LPSTR; - cbVer : int - ): BOOL; stdcall; - -function capCreateCaptureWindowW( - lpszWindowName : LPCWSTR; - dwStyle : DWORD; - x, y : int; - nWidth, nHeight : int; - hwndParent : HWND; - nID : int - ): HWND; stdcall; - -function capGetDriverDescriptionW( - wDriverIndex : UINT; - lpszName : LPWSTR; - cbName : int; - lpszVer : LPWSTR; - cbVer : int - ): BOOL; stdcall; - -function capCreateCaptureWindow( - lpszWindowName : LPCSTR; - dwStyle : DWORD; - x, y : int; - nWidth, nHeight : int; - hwndParent : HWND; - nID : int - ): HWND; stdcall; // capCreateCaptureWindowA - -function capGetDriverDescription( - wDriverIndex : UINT; - lpszName : LPSTR; - cbName : int; - lpszVer : LPSTR; - cbVer : int - ): BOOL; stdcall; // capGetDriverDescriptionA - -{-- New information chunk IDs ------------------------------------------------} - -const - infotypeDIGITIZATION_TIME = $54494449; // mmioFOURCC ('I','D','I','T') - infotypeSMPTE_TIME = $504D5349; // mmioFOURCC ('I','S','M','P') - -{-- String IDs from status and error callbacks -------------------------------} - - IDS_CAP_BEGIN = 300; // "Capture Start" - IDS_CAP_END = 301; // "Capture End" - - IDS_CAP_INFO = 401; // "%s" - IDS_CAP_OUTOFMEM = 402; // "Out of memory" - IDS_CAP_FILEEXISTS = 403; // "File '%s' exists -- overwrite it?" - IDS_CAP_ERRORPALOPEN = 404; // "Error opening palette '%s'" - IDS_CAP_ERRORPALSAVE = 405; // "Error saving palette '%s'" - IDS_CAP_ERRORDIBSAVE = 406; // "Error saving frame '%s'" - IDS_CAP_DEFAVIEXT = 407; // "avi" - IDS_CAP_DEFPALEXT = 408; // "pal" - IDS_CAP_CANTOPEN = 409; // "Cannot open '%s'" - IDS_CAP_SEQ_MSGSTART = 410; // "Select OK to start capture\nof video sequence\nto %s." - IDS_CAP_SEQ_MSGSTOP = 411; // "Hit ESCAPE or click to end capture" - - IDS_CAP_VIDEDITERR = 412; // "An error occurred while trying to run VidEdit." - IDS_CAP_READONLYFILE = 413; // "The file '%s' is a read-only file." - IDS_CAP_WRITEERROR = 414; // "Unable to write to file '%s'.\nDisk may be full." - IDS_CAP_NODISKSPACE = 415; // "There is no space to create a capture file on the specified device." - IDS_CAP_SETFILESIZE = 416; // "Set File Size" - IDS_CAP_SAVEASPERCENT = 417; // "SaveAs: %2ld%% Hit Escape to abort." - - IDS_CAP_DRIVER_ERROR = 418; // Driver specific error message - - IDS_CAP_WAVE_OPEN_ERROR = 419; // "Error: Cannot open the wave input device.\nCheck sample size, frequency, and channels." - IDS_CAP_WAVE_ALLOC_ERROR = 420; // "Error: Out of memory for wave buffers." - IDS_CAP_WAVE_PREPARE_ERROR = 421; // "Error: Cannot prepare wave buffers." - IDS_CAP_WAVE_ADD_ERROR = 422; // "Error: Cannot add wave buffers." - IDS_CAP_WAVE_SIZE_ERROR = 423; // "Error: Bad wave size." - - IDS_CAP_VIDEO_OPEN_ERROR = 424; // "Error: Cannot open the video input device." - IDS_CAP_VIDEO_ALLOC_ERROR = 425; // "Error: Out of memory for video buffers." - IDS_CAP_VIDEO_PREPARE_ERROR = 426; // "Error: Cannot prepare video buffers." - IDS_CAP_VIDEO_ADD_ERROR = 427; // "Error: Cannot add video buffers." - IDS_CAP_VIDEO_SIZE_ERROR = 428; // "Error: Bad video size." - - IDS_CAP_FILE_OPEN_ERROR = 429; // "Error: Cannot open capture file." - IDS_CAP_FILE_WRITE_ERROR = 430; // "Error: Cannot write to capture file. Disk may be full." - IDS_CAP_RECORDING_ERROR = 431; // "Error: Cannot write to capture file. Data rate too high or disk full." - IDS_CAP_RECORDING_ERROR2 = 432; // "Error while recording" - IDS_CAP_AVI_INIT_ERROR = 433; // "Error: Unable to initialize for capture." - IDS_CAP_NO_FRAME_CAP_ERROR = 434; // "Warning: No frames captured.\nConfirm that vertical sync interrupts\nare configured and enabled." - IDS_CAP_NO_PALETTE_WARN = 435; // "Warning: Using default palette." - IDS_CAP_MCI_CONTROL_ERROR = 436; // "Error: Unable to access MCI device." - IDS_CAP_MCI_CANT_STEP_ERROR = 437; // "Error: Unable to step MCI device." - IDS_CAP_NO_AUDIO_CAP_ERROR = 438; // "Error: No audio data captured.\nCheck audio card settings." - IDS_CAP_AVI_DRAWDIB_ERROR = 439; // "Error: Unable to draw this data format." - IDS_CAP_COMPRESSOR_ERROR = 440; // "Error: Unable to initialize compressor." - IDS_CAP_AUDIO_DROP_ERROR = 441; // "Error: Audio data was lost during capture, reduce capture rate." - -{-- Status string IDs --------------------------------------------------------} - - IDS_CAP_STAT_LIVE_MODE = 500; // "Live window" - IDS_CAP_STAT_OVERLAY_MODE = 501; // "Overlay window" - IDS_CAP_STAT_CAP_INIT = 502; // "Setting up for capture - Please wait" - IDS_CAP_STAT_CAP_FINI = 503; // "Finished capture, now writing frame %ld" - IDS_CAP_STAT_PALETTE_BUILD = 504; // "Building palette map" - IDS_CAP_STAT_OPTPAL_BUILD = 505; // "Computing optimal palette" - IDS_CAP_STAT_I_FRAMES = 506; // "%d frames" - IDS_CAP_STAT_L_FRAMES = 507; // "%ld frames" - IDS_CAP_STAT_CAP_L_FRAMES = 508; // "Captured %ld frames" - IDS_CAP_STAT_CAP_AUDIO = 509; // "Capturing audio" - IDS_CAP_STAT_VIDEOCURRENT = 510; // "Captured %ld frames (%ld dropped) %d.%03d sec." - IDS_CAP_STAT_VIDEOAUDIO = 511; // "Captured %d.%03d sec. %ld frames (%ld dropped) (%d.%03d fps). %ld audio bytes (%d,%03d sps)" - IDS_CAP_STAT_VIDEOONLY = 512; // "Captured %d.%03d sec. %ld frames (%ld dropped) (%d.%03d fps)" - IDS_CAP_STAT_FRAMESDROPPED = 513; // "Dropped %ld of %ld frames (%d.%02d%%) during capture." - -{== FilePreview dialog =======================================================} - -function GetOpenFileNamePreviewA(lpofn: POPENFILENAMEA): BOOL; stdcall; -function GetSaveFileNamePreviewA(lpofn: POPENFILENAMEA): BOOL; stdcall; - -function GetOpenFileNamePreviewW(lpofn: POPENFILENAMEW): BOOL; stdcall; -function GetSaveFileNamePreviewW(lpofn: POPENFILENAMEW): BOOL; stdcall; - -function GetOpenFileNamePreview(lpofn: POPENFILENAMEA): BOOL; stdcall; // GetOpenFileNamePreviewA -function GetSaveFileNamePreview(lpofn: POPENFILENAMEA): BOOL; stdcall; // GetSaveFileNamePreviewA - -implementation - -function MKFOURCC( ch0, ch1, ch2, ch3: AnsiChar ): FOURCC; -begin - Result := (DWord(Ord(ch0))) or - (DWord(Ord(ch1)) shl 8) or - (DWord(Ord(ch2)) shl 16) or - (DWord(Ord(ch3)) shl 24); -end; - -function mmioFOURCC( ch0, ch1, ch2, ch3: AnsiChar ): FOURCC; -begin - Result := MKFOURCC(ch0,ch1,ch2,ch3); -end; - -function aviTWOCC(ch0, ch1: AnsiChar): TWOCC; -begin - Result := (Word(Ord(ch0))) or (Word(Ord(ch1)) shl 8); -end; - -{-- Query macros -------------------------------------------------------------} - -function ICQueryAbout(hic: HIC): BOOL; -begin - Result := ICSendMessage(hic, ICM_ABOUT, dword(-1), ICMF_ABOUT_QUERY) = ICERR_OK; -end; - -function ICAbout(hic: HIC; hwnd: HWND): DWORD; -begin - Result := ICSendMessage(hic, ICM_ABOUT, hwnd, 0); -end; - -function ICQueryConfigure(hic: HIC): BOOL; -begin - Result := ICSendMessage(hic, ICM_CONFIGURE, dword(-1), ICMF_CONFIGURE_QUERY) = ICERR_OK; -end; - -function ICConfigure(hic: HIC; hwnd: HWND): DWORD; -begin - Result := ICSendMessage(hic, ICM_CONFIGURE, hwnd, 0); -end; - -{-- Get/Set state macros -----------------------------------------------------} - -function ICGetState(hic: HIC; pv: PVOID; cb: DWORD): DWORD; -begin - Result := ICSendMessage(hic, ICM_GETSTATE, DWORD(pv), cb); -end; - -function ICSetState(hic: HIC; pv: PVOID; cb: DWORD): DWORD; -begin - Result := ICSendMessage(hic, ICM_SETSTATE, DWORD(pv), cb); -end; - -function ICGetStateSize(hic: HIC): DWORD; -begin - Result := ICGetState(hic, nil, 0); -end; - -{-- Get value macros ---------------------------------------------------------} - -function ICGetDefaultQuality(hic: HIC): DWORD; -begin - ICSendMessage(hic, ICM_GETDEFAULTQUALITY, DWORD(@Result), sizeof(Result)); -end; - -function ICGetDefaultKeyFrameRate(hic: HIC): DWORD; -begin - ICSendMessage(hic, ICM_GETDEFAULTKEYFRAMERATE, DWORD(@Result), sizeof(Result)); -end; - -{-- Draw window macro --------------------------------------------------------} - -function ICDrawWindow(hic: HIC; prc: PRECT): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_WINDOW, DWORD(prc), sizeof(prc^)); -end; - -{-- ICCompressBegin() - start compression from a source fmt to a dest fmt ----} - -function ICCompressBegin(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; -begin - Result := ICSendMessage(hic, ICM_COMPRESS_BEGIN, DWORD(lpbiInput), DWORD(lpbiOutput)); -end; - -{-- ICCompressQuery() - determines if compression from src to dst is supp ----} - -function ICCompressQuery(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; -begin - Result := ICSendMessage(hic, ICM_COMPRESS_QUERY, DWORD(lpbiInput), DWORD(lpbiOutput)); -end; - -{-- ICCompressGetFormat() - get the output format (fmt of compressed) --------} - -// if lpbiOutput is nil return the size in bytes needed for format. - -function ICCompressGetFormat(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; -begin - Result := ICSendMessage(hic, ICM_COMPRESS_GET_FORMAT, DWORD(lpbiInput), DWORD(lpbiOutput)); -end; - -function ICCompressGetFormatSize(hic: HIC; lpbi: PBITMAPINFOHEADER): DWORD; -begin - Result := ICCompressGetFormat(hic, lpbi, nil); -end; - -{-- ICCompressSize() - return the maximal size of a compressed frame ---------} - -function ICCompressGetSize(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; -begin - Result := ICSendMessage(hic, ICM_COMPRESS_GET_SIZE, DWORD(lpbiInput), DWORD(lpbiOutput)); -end; - -function ICCompressEnd(hic: HIC): DWORD; -begin - Result := ICSendMessage(hic, ICM_COMPRESS_END, 0, 0); -end; - -{-- ICDecompressBegin() - start compression from src fmt to a dest fmt -------} - -function ICDecompressBegin(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; -begin - Result := ICSendMessage(hic, ICM_DECOMPRESS_BEGIN, DWORD(lpbiInput), DWORD(lpbiOutput)); -end; - -{-- ICDecompressQuery() - determines if compression is supported -------------} - -function ICDecompressQuery(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; -begin - Result := ICSendMessage(hic, ICM_DECOMPRESS_QUERY, DWORD(lpbiInput), DWORD(lpbiOutput)); -end; - -{-- ICDecompressGetFormat - get the output fmt (fmt of uncompressed data) ----} - -// if lpbiOutput is NULL return the size in bytes needed for format. - -function ICDecompressGetFormat(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; -begin - Result := ICSendMessage(hic, ICM_DECOMPRESS_GET_FORMAT, DWORD(lpbiInput), DWORD(lpbiOutput)); -end; - -function ICDecompressGetFormatSize(hic: HIC; lpbi: PBITMAPINFOHEADER): DWORD; -begin - Result := ICDecompressGetFormat(hic, lpbi, nil); -end; - -{-- ICDecompressGetPalette() - get the output palette ------------------------} - -function ICDecompressGetPalette(hic: HIC; lpbiInput, lpbiOutput: PBITMAPINFOHEADER): DWORD; -begin - Result := ICSendMessage(hic, ICM_DECOMPRESS_GET_PALETTE, DWORD(lpbiInput), DWORD(lpbiOutput)); -end; - -function ICDecompressSetPalette(hic: HIC; lpbiPalette: PBITMAPINFOHEADER): DWORD; -begin - Result := ICSendMessage(hic, ICM_DECOMPRESS_SET_PALETTE, DWORD(lpbiPalette), 0); -end; - -function ICDecompressEnd(hic: HIC): DWORD; -begin - Result := ICSendMessage(hic, ICM_DECOMPRESS_END, 0, 0); -end; - -{-- ICDecompressEx() - decompress a single frame -----------------------------} - -function ICDecompressEx( - hic : HIC; - dwFlags : DWORD; - lpbiSrc : PBITMAPINFOHEADER; - lpSrc : PVOID; - xSrc : int; - ySrc : int; - dxSrc : int; - dySrc : int; - lpbiDst : PBITMAPINFOHEADER; - lpDst : PVOID; - xDst : int; - yDst : int; - dxDst : int; - dyDst : int - ): DWORD; stdcall; -var - ic : TICDECOMPRESSEX; -begin - ic.dwFlags := dwFlags; - ic.lpbiSrc := lpbiSrc; - ic.lpSrc := lpSrc; - ic.xSrc := xSrc; - ic.ySrc := ySrc; - ic.dxSrc := dxSrc; - ic.dySrc := dySrc; - ic.lpbiDst := lpbiDst; - ic.lpDst := lpDst; - ic.xDst := xDst; - ic.yDst := yDst; - ic.dxDst := dxDst; - ic.dyDst := dyDst; - - // note that ICM swaps round the length and pointer - // length in lparam2, pointer in lparam1 - Result := ICSendMessage(hic, ICM_DECOMPRESSEX, DWORD(@ic), sizeof(ic)); -end; - -{-- ICDecompressExBegin() - start compression from a src fmt to a dest fmt ---} - -function ICDecompressExBegin( - hic : HIC; - dwFlags : DWORD; - lpbiSrc : PBITMAPINFOHEADER; - lpSrc : PVOID; - xSrc : int; - ySrc : int; - dxSrc : int; - dySrc : int; - lpbiDst : PBITMAPINFOHEADER; - lpDst : PVOID; - xDst : int; - yDst : int; - dxDst : int; - dyDst : int - ): DWORD; stdcall; -var - ic : TICDECOMPRESSEX ; -begin - ic.dwFlags := dwFlags; - ic.lpbiSrc := lpbiSrc; - ic.lpSrc := lpSrc; - ic.xSrc := xSrc; - ic.ySrc := ySrc; - ic.dxSrc := dxSrc; - ic.dySrc := dySrc; - ic.lpbiDst := lpbiDst; - ic.lpDst := lpDst; - ic.xDst := xDst; - ic.yDst := yDst; - ic.dxDst := dxDst; - ic.dyDst := dyDst; - - // note that ICM swaps round the length and pointer - // length in lparam2, pointer in lparam1 - Result := ICSendMessage(hic, ICM_DECOMPRESSEX_BEGIN, DWORD(@ic), sizeof(ic)); -end; - -{-- ICDecompressExQuery() ----------------------------------------------------} - -function ICDecompressExQuery( - hic : HIC; - dwFlags : DWORD; - lpbiSrc : PBITMAPINFOHEADER; - lpSrc : PVOID; - xSrc : int; - ySrc : int; - dxSrc : int; - dySrc : int; - lpbiDst : PBITMAPINFOHEADER; - lpDst : PVOID; - xDst : int; - yDst : int; - dxDst : int; - dyDst : int - ): DWORD; stdcall; -var - ic : TICDECOMPRESSEX; -begin - ic.dwFlags := dwFlags; - ic.lpbiSrc := lpbiSrc; - ic.lpSrc := lpSrc; - ic.xSrc := xSrc; - ic.ySrc := ySrc; - ic.dxSrc := dxSrc; - ic.dySrc := dySrc; - ic.lpbiDst := lpbiDst; - ic.lpDst := lpDst; - ic.xDst := xDst; - ic.yDst := yDst; - ic.dxDst := dxDst; - ic.dyDst := dyDst; - - // note that ICM swaps round the length and pointer - // length in lparam2, pointer in lparam1 - Result := ICSendMessage(hic, ICM_DECOMPRESSEX_QUERY, DWORD(@ic), sizeof(ic)); -end; - -function ICDecompressExEnd(hic: HIC): DWORD; -begin - Result := ICSendMessage(hic, ICM_DECOMPRESSEX_END, 0, 0) -end; - -function ICDrawSuggestFormat( - hic : HIC; - lpbiIn : PBITMAPINFOHEADER; - lpbiOut : PBITMAPINFOHEADER; - dxSrc : int; - dySrc : int; - dxDst : int; - dyDst : int; - hicDecomp : HIC - ): DWORD; stdcall; -var - ic : TICDRAWSUGGEST; -begin - ic.lpbiIn := lpbiIn; - ic.lpbiSuggest := lpbiOut; - ic.dxSrc := dxSrc; - ic.dySrc := dySrc; - ic.dxDst := dxDst; - ic.dyDst := dyDst; - ic.hicDecompressor := hicDecomp; - - // note that ICM swaps round the length and pointer - // length in lparam2, pointer in lparam1 - Result := ICSendMessage(hic, ICM_DRAW_SUGGESTFORMAT, DWORD(@ic), sizeof(ic)); -end; - -{-- ICDrawQuery() - determines if the compressor is willing to render fmt ----} - -function ICDrawQuery(hic: HIC; lpbiInput: PBITMAPINFOHEADER): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_QUERY, DWORD(lpbiInput), 0); -end; - -function ICDrawChangePalette(hic: HIC; lpbiInput: PBITMAPINFOHEADER): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_CHANGEPALETTE, DWORD(lpbiInput), 0); -end; - -function ICGetBuffersWanted(hic: HIC; lpdwBuffers: PDWORD): DWORD; -begin - Result := ICSendMessage(hic, ICM_GETBUFFERSWANTED, DWORD(lpdwBuffers), 0); -end; - -function ICDrawEnd(hic: HIC): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_END, 0, 0); -end; - -function ICDrawStart(hic: HIC): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_START, 0, 0); -end; - -function ICDrawStartPlay(hic: HIC; lFrom, lTo: DWORD): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_START_PLAY, lFrom, lTo); -end; - -function ICDrawStop(hic: HIC): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_STOP, 0, 0); -end; - -function ICDrawStopPlay(hic: HIC): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_STOP_PLAY, 0, 0); -end; - -function ICDrawGetTime(hic: HIC; lplTime: PDWORD): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_GETTIME, DWORD(lplTime), 0); -end; - -function ICDrawSetTime(hic: HIC; lTime: DWORD): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_SETTIME, lTime, 0); -end; - -function ICDrawRealize(hic: HIC; hdc: HDC; fBackground: BOOL): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_REALIZE, DWORD(hdc), DWORD(fBackground)); -end; - -function ICDrawFlush(hic: HIC): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_FLUSH, 0, 0); -end; - -function ICDrawRenderBuffer(hic: HIC): DWORD; -begin - Result := ICSendMessage(hic, ICM_DRAW_RENDERBUFFER, 0, 0); -end; - -{-- ICSetStatusProc() - Set the status callback function ---------------------} - -// ICMessage is not supported on NT - -function ICSetStatusProc( - hic : HIC; - dwFlags : DWORD; - lParam : DWORD; - fpfnStatus : TICStatusProc - ): DWORD; stdcall; -var - ic : TICSETSTATUSPROC; -begin - ic.dwFlags := dwFlags; - ic.lParam := lParam; - ic.Status := fpfnStatus; - - // note that ICM swaps round the length and pointer - // length in lparam2, pointer in lparam1 - Result := ICSendMessage(hic, ICM_SET_STATUS_PROC, DWORD(@ic), sizeof(ic)); -end; - -{== Helper routines for DrawDib and MCIAVI... ================================} - -function ICDecompressOpen(fccType, fccHandler: DWORD; lpbiIn, lpbiOut: PBITMAPINFOHEADER): HIC; -begin - Result := ICLocate(fccType, fccHandler, lpbiIn, lpbiOut, ICMODE_DECOMPRESS); -end; - -function ICDrawOpen(fccType, fccHandler: DWORD; lpbiIn: PBITMAPINFOHEADER): HIC; -begin - Result := ICLocate(fccType, fccHandler, lpbiIn, nil, ICMODE_DRAW); -end; - -{-- DrawDibUpdate() - redraw last image (may only be valid with DDF_BUFFER) --} - -function DrawDibUpdate(hdd: HDRAWDIB; hdc: HDC; x, y: int): BOOL; -begin - Result := DrawDibDraw(hdd, hdc, x, y, 0, 0, nil, nil, 0, 0, 0, 0, DDF_UPDATE); -end; - -{== Useful macros ============================================================} - -{-- Macro to get stream number out of a FOURCC ckid --------------------------} - -function FromHex(n: BYTE): BYTE; -begin - if n >= Ord('A') then - Result := Ord(n) + 10 - Ord('A') - else - Result := Ord(n) - Ord('0'); -end; - -function StreamFromFOURCC(fcc: DWORD): BYTE; -begin - Result := (FromHex(Lo(LoWord(fcc))) shl 4) + FromHex(Hi(LoWord(fcc))); -end; - -{-- Macro to get TWOCC chunk type out of a FOURCC ckid -----------------------} - -function TWOCCFromFOURCC(fcc: DWORD): WORD; -begin - Result := HiWord(fcc); -end; - -{-- Macro to make a ckid for a chunk out of a TWOCC and a stream num (0-255) -} - -function ToHex(n: BYTE): BYTE; -begin - if n > 9 then - Result := n - 10 + Ord('A') - else - Result := n + Ord('0'); -end; - -function MAKEAVICKID(tcc: WORD; stream: BYTE): DWORD; -begin - Result := MakeLONG((ToHex(stream and $0F) shl 8) or ToHex((stream and $F0) shr 4),tcc); -end; - -{-- Helper macros ------------------------------------------------------------} - -function AVIStreamSampleToSample(pavi1, pavi2: IAVISTREAM; l: LONG): LONG; -begin - Result := AVIStreamTimeToSample(pavi1,AVIStreamSampleToTime(pavi2, l)); -end; - -function AVIStreamNextSample(pavi: IAVISTREAM; l: LONG): LONG; -begin - Result := AVIStreamFindSample(pavi,l+1,FIND_NEXT or FIND_ANY); -end; - -function AVIStreamPrevSample(pavi: IAVISTREAM; l: LONG): LONG; -begin - Result := AVIStreamFindSample(pavi,l-1,FIND_PREV or FIND_ANY); -end; - -function AVIStreamNearestSample(pavi: IAVISTREAM; l: LONG): LONG; -begin - Result := AVIStreamFindSample(pavi,l,FIND_PREV or FIND_ANY); -end; - -function AVIStreamNextKeyFrame(pavi: IAVISTREAM; l: LONG): LONG; -begin - Result := AVIStreamFindSample(pavi,l+1,FIND_NEXT or FIND_KEY); -end; - -function AVIStreamPrevKeyFrame(pavi: IAVISTREAM; l: LONG): LONG; -begin - Result := AVIStreamFindSample(pavi,l-1,FIND_PREV or FIND_KEY); -end; - -function AVIStreamNearestKeyFrame(pavi: IAVISTREAM; l: LONG): LONG; -begin - Result := AVIStreamFindSample(pavi,l,FIND_PREV or FIND_KEY) -end; - -function AVIStreamIsKeyFrame(pavi: IAVISTREAM; l: LONG): BOOL; -begin - Result := AVIStreamNearestKeyFrame(pavi,l) = l; -end; - -function AVIStreamPrevSampleTime(pavi: IAVISTREAM; t: LONG): LONG; -begin - Result := AVIStreamSampleToTime(pavi, AVIStreamPrevSample(pavi,AVIStreamTimeToSample(pavi,t))); -end; - -function AVIStreamNextSampleTime(pavi: IAVISTREAM; t: LONG): LONG; -begin - Result := AVIStreamSampleToTime(pavi, AVIStreamNextSample(pavi,AVIStreamTimeToSample(pavi,t))); -end; - -function AVIStreamNearestSampleTime(pavi: IAVISTREAM; t: LONG): LONG; -begin - Result := AVIStreamSampleToTime(pavi, AVIStreamNearestSample(pavi,AVIStreamTimeToSample(pavi,t))); -end; - -function AVIStreamNextKeyFrameTime(pavi: IAVISTREAM; t: LONG): LONG; -begin - Result := AVIStreamSampleToTime(pavi, AVIStreamNextKeyFrame(pavi,AVIStreamTimeToSample(pavi, t))); -end; - -function AVIStreamPrevKeyFrameTime(pavi: IAVISTREAM; t: LONG): LONG; -begin - Result := AVIStreamSampleToTime(pavi, AVIStreamPrevKeyFrame(pavi,AVIStreamTimeToSample(pavi, t))); -end; - -function AVIStreamNearestKeyFrameTime(pavi: IAVISTREAM; t: LONG): LONG; -begin - Result := AVIStreamSampleToTime(pavi, AVIStreamNearestKeyFrame(pavi,AVIStreamTimeToSample(pavi, t))); -end; - -function AVIStreamStartTime(pavi: IAVISTREAM): LONG; -begin - Result := AVIStreamSampleToTime(pavi, AVIStreamStart(pavi)); -end; - -function AVIStreamLengthTime(pavi: IAVISTREAM): LONG; -begin - Result := AVIStreamSampleToTime(pavi, AVIStreamLength(pavi)); -end; - -function AVIStreamEnd(pavi: IAVISTREAM): LONG; -begin - Result := AVIStreamStart(pavi) + AVIStreamLength(pavi); -end; - -function AVIStreamEndTime(pavi: IAVISTREAM): LONG; -begin - Result := AVIStreamSampleToTime(pavi, AVIStreamEnd(pavi)); -end; - -function AVIStreamSampleSize(pavi: IAVISTREAM; lPos: LONG; plSize: PLONG): LONG; -begin - Result := AVIStreamRead(pavi,lPos,1,nil,0,plSize,nil); -end; - -function AVIStreamFormatSize(pavi: IAVISTREAM; lPos: LONG; plSize: PLONG): HResult; -begin - Result := AVIStreamReadFormat(pavi,lPos,nil,plSize); -end; - -function AVIStreamDataSize(pavi: IAVISTREAM; fcc: DWORD; plSize: PLONG): HResult; -begin - Result := AVIStreamReadData(pavi,fcc,nil,plSize) -end; - -{== MCIWnd ===================================================================} - -function MCIWndSM(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): DWORD; -begin - Result := SendMessage(hWnd, Msg, wParam, lParam); -end; - -{-- Can macros ---------------------------------------------------------------} - -function MCIWndCanPlay(hwnd: HWND): BOOL; -begin - Result := MCIWndSM(hwnd,MCIWNDM_CAN_PLAY,0,0) <> 0; -end; - -function MCIWndCanRecord(hwnd: HWND): BOOL; -begin - Result := MCIWndSM(hwnd,MCIWNDM_CAN_RECORD,0,0) <> 0; -end; - -function MCIWndCanSave(hwnd: HWND): BOOL; -begin - Result := MCIWndSM(hwnd,MCIWNDM_CAN_SAVE,0,0) <> 0; -end; - -function MCIWndCanWindow(hwnd: HWND): BOOL; -begin - Result := MCIWndSM(hwnd,MCIWNDM_CAN_WINDOW,0,0) <> 0; -end; - -function MCIWndCanEject(hwnd: HWND): BOOL; -begin - Result := MCIWndSM(hwnd,MCIWNDM_CAN_EJECT,0,0) <> 0; -end; - -function MCIWndCanConfig(hwnd: HWND): BOOL; -begin - Result := MCIWndSM(hwnd,MCIWNDM_CAN_CONFIG,0,0) <> 0; -end; - -function MCIWndPaletteKick(hwnd: HWND): BOOL; -begin - Result := MCIWndSM(hwnd,MCIWNDM_PALETTEKICK,0,0) <> 0; -end; - -function MCIWndSave(hwnd: HWND; szFile: LPCSTR): DWORD; -begin - Result := MCIWndSM(hwnd, MCI_SAVE, 0, LPARAM(szFile)); -end; - -function MCIWndSaveDialog(hwnd: HWND): DWORD; -begin - Result := MCIWndSave(hwnd, LPCSTR(-1)); -end; - -// If you dont give a device it will use the current device.... - -function MCIWndNew(hwnd: HWND; lp: PVOID): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_NEW, 0, LPARAM(lp)); -end; - -function MCIWndRecord(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCI_RECORD, 0, 0); -end; - -function MCIWndOpen(hwnd: HWND; sz: LPCSTR; f: BOOL): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_OPEN, WPARAM(f), LPARAM(sz)); -end; - -function MCIWndOpenDialog(hwnd: HWND): DWORD; -begin - Result := MCIWndOpen(hwnd, LPCSTR(-1), False); -end; - -function MCIWndClose(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCI_CLOSE, 0, 0); -end; - -function MCIWndPlay(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCI_PLAY, 0, 0); -end; - -function MCIWndStop(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCI_STOP, 0, 0); -end; - -function MCIWndPause(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCI_PAUSE, 0, 0); -end; - -function MCIWndResume(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCI_RESUME, 0, 0); -end; - -function MCIWndSeek(hwnd: HWND; lPos: DWORD): DWORD; -begin - Result := MCIWndSM(hwnd, MCI_SEEK, 0, lPos); -end; - -function MCIWndEject(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_EJECT, 0, 0); -end; - -function MCIWndHome(hwnd: HWND): DWORD; -begin - Result := MCIWndSeek(hwnd, MCIWND_START); -end; - -function MCIWndEnd(hwnd: HWND): DWORD; -begin - Result := MCIWndSeek(hwnd, MCIWND_END); -end; - -function MCIWndGetSource(hwnd: HWND; prc: PRECT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GET_SOURCE, 0, LPARAM(prc)); -end; - -function MCIWndPutSource(hwnd: HWND; prc: PRECT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_PUT_SOURCE, 0, LPARAM(prc)); -end; - -function MCIWndGetDest(hwnd: HWND; prc: PRECT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GET_DEST, 0, LPARAM(prc)); -end; - -function MCIWndPutDest(hwnd: HWND; prc: PRECT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_PUT_DEST, 0, LPARAM(prc)); -end; - -function MCIWndPlayReverse(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_PLAYREVERSE, 0, 0); -end; - -function MCIWndPlayFrom(hwnd: HWND; lPos: DWORD): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_PLAYFROM, 0, lPos); -end; - -function MCIWndPlayTo(hwnd: HWND; lPos: DWORD): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_PLAYTO, 0, lPos); -end; - -function MCIWndPlayFromTo(hwnd: HWND; lStart, lEnd: DWORD): DWORD; -begin - MCIWndSeek(hwnd, lStart); - Result := MCIWndPlayTo(hwnd, lEnd); -end; - -function MCIWndGetDeviceID(hwnd: HWND): UINT; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETDEVICEID, 0, 0); -end; - -function MCIWndGetAlias(hwnd: HWND): UINT; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETALIAS, 0, 0); -end; - -function MCIWndGetMode(hwnd: HWND; lp: LPCSTR; len: UINT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETMODE, len, LPARAM(lp)); -end; - -function MCIWndGetPosition(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETPOSITION, 0, 0); -end; - -function MCIWndGetPositionString(hwnd: HWND; lp: LPCSTR; len: UINT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETPOSITION, len, LPARAM(lp)); -end; - -function MCIWndGetStart(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETSTART, 0, 0); -end; - -function MCIWndGetLength(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETLENGTH, 0, 0); -end; - -function MCIWndGetEnd(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETEND, 0, 0); -end; - -function MCIWndStep(hwnd: HWND; n: DWORD): DWORD; -begin - Result := MCIWndSM(hwnd, MCI_STEP, 0, n); -end; - -procedure MCIWndDestroy(hwnd: HWND); -begin - MCIWndSM(hwnd, WM_CLOSE, 0, 0); -end; - -procedure MCIWndSetZoom(hwnd: HWND; iZoom: UINT); -begin - MCIWndSM(hwnd, MCIWNDM_SETZOOM, 0, iZoom); -end; - -function MCIWndGetZoom(hwnd: HWND): UINT; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETZOOM, 0, 0); -end; - -function MCIWndSetVolume(hwnd: HWND; iVol: UINT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_SETVOLUME, 0, iVol); -end; - -function MCIWndGetVolume(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETVOLUME, 0, 0); -end; - -function MCIWndSetSpeed(hwnd: HWND; iSpeed: UINT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_SETSPEED, 0, iSpeed); -end; - -function MCIWndGetSpeed(hwnd: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETSPEED, 0, 0); -end; - -function MCIWndSetTimeFormat(hwnd: HWND; lp: LPCSTR): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_SETTIMEFORMAT, 0, LPARAM(lp)); -end; - -function MCIWndGetTimeFormat(hwnd: HWND; lp: LPCSTR; len: UINT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETTIMEFORMAT, len, LPARAM(lp)); -end; - -procedure MCIWndValidateMedia(hwnd: HWND); -begin - MCIWndSM(hwnd, MCIWNDM_VALIDATEMEDIA, 0, 0); -end; - -procedure MCIWndSetRepeat(hwnd: HWND; f: BOOL); -begin - MCIWndSM(hwnd, MCIWNDM_SETREPEAT, 0, LPARAM(f)); -end; - -function MCIWndGetRepeat(hwnd: HWND): BOOL; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETREPEAT, 0, 0) <> 0; -end; - -function MCIWndUseFrames(hwnd: HWND): DWORD; -begin - Result := MCIWndSetTimeFormat(hwnd, 'frames'); -end; - -function MCIWndUseTime(hwnd: HWND): DWORD; -begin - Result := MCIWndSetTimeFormat(hwnd, 'ms'); -end; - -procedure MCIWndSetActiveTimer(hwnd: HWND; active: UINT); -begin - MCIWndSM(hwnd, MCIWNDM_SETACTIVETIMER, active, 0); -end; - -procedure MCIWndSetInactiveTimer(hwnd: HWND; inactive: UINT); -begin - MCIWndSM(hwnd, MCIWNDM_SETINACTIVETIMER, inactive, 0); -end; - -procedure MCIWndSetTimers(hwnd: HWND; active, inactive: UINT); -begin - MCIWndSM(hwnd, MCIWNDM_SETTIMERS, active, inactive); -end; - -function MCIWndGetActiveTimer(hwnd: HWND): UINT; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETACTIVETIMER, 0, 0); -end; - -function MCIWndGetInactiveTimer(hwnd: HWND): UINT; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETINACTIVETIMER, 0, 0); -end; - -function MCIWndRealize(hwnd: HWND; fBkgnd: BOOL): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_REALIZE, WPARAM(fBkgnd), 0); -end; - -function MCIWndSendString(hwnd: HWND; sz: LPCSTR): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_SENDSTRING, 0, LPARAM(sz)); -end; - -function MCIWndReturnString(hwnd: HWND; lp: LPSTR; len: UINT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_RETURNSTRING, len, LPARAM(lp)); -end; - -function MCIWndGetError(hwnd: HWND; lp: LPSTR; len: UINT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETERROR, len, LPARAM(lp)); -end; - -function MCIWndGetPalette(hwnd: HWND): HPALETTE; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETPALETTE, 0, 0); -end; - -function MCIWndSetPalette(hwnd: HWND; hpal: HPALETTE): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_SETPALETTE, hpal, 0); -end; - -function MCIWndGetFileName(hwnd: HWND; lp: LPCSTR; len: UINT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETFILENAME, len, LPARAM(lp)); -end; - -function MCIWndGetDevice(hwnd: HWND; lp: LPCSTR; len: UINT): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETDEVICE, len, LPARAM(lp)); -end; - -function MCIWndGetStyles(hwnd: HWND): UINT; -begin - Result := MCIWndSM(hwnd, MCIWNDM_GETSTYLES, 0, 0); -end; - -function MCIWndChangeStyles(hwnd: HWND; mask: UINT; value: DWORD): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_CHANGESTYLES, mask, value); -end; - -function MCIWndOpenInterface(hwnd: HWND; pUnk: PUNKNOWN): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_OPENINTERFACE, 0, LPARAM(pUnk)); -end; - -function MCIWndSetOwner(hwnd: HWND; hwndP: HWND): DWORD; -begin - Result := MCIWndSM(hwnd, MCIWNDM_SETOWNER, hwndP, 0); -end; - -{== AVICAP - Window class for AVI capture ====================================} - -function AVICapSM(hwnd: HWND; m: UINT; w: WPARAM; l: LPARAM): DWORD; -begin - if IsWindow(hwnd) then - Result := SendMessage(hwnd,m,w,l) - else - Result := 0; -end; - -{-- Message crackers for above -----------------------------------------------} - -function capSetCallbackOnError(hwnd: HWND; fpProc: TCAPERRORCALLBACK): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_CALLBACK_ERROR, 0, LPARAM(@fpProc)) <> 0; -end; - -function capSetCallbackOnStatus(hwnd: HWND; fpProc: TCAPSTATUSCALLBACK): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_CALLBACK_STATUS, 0, LPARAM(@fpProc)) <> 0; -end; - -function capSetCallbackOnYield(hwnd: HWND; fpProc: TCAPYIELDCALLBACK): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_CALLBACK_YIELD, 0, LPARAM(@fpProc)) <> 0; -end; - -function capSetCallbackOnFrame(hwnd: HWND; fpProc: TCAPVIDEOCALLBACK): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_CALLBACK_FRAME, 0, LPARAM(@fpProc)) <> 0; -end; - -function capSetCallbackOnVideoStream(hwnd: HWND; fpProc: TCAPVIDEOCALLBACK): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, LPARAM(@fpProc)) <> 0; -end; - -function capSetCallbackOnWaveStream(hwnd: HWND; fpProc: TCAPWAVECALLBACK): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_CALLBACK_WAVESTREAM, 0, LPARAM(@fpProc)) <> 0; -end; - -function capSetCallbackOnCapControl(hwnd: HWND; fpProc: TCAPCONTROLCALLBACK): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_CALLBACK_CAPCONTROL, 0, LPARAM(@fpProc)) <> 0; -end; - -function capSetUserData(hwnd: HWND; lUser: DWORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_USER_DATA, 0, lUser) <> 0; -end; - -function capGetUserData(hwnd: HWND): DWORD; -begin - Result := AVICapSM(hwnd, WM_CAP_GET_USER_DATA, 0, 0); -end; - -function capDriverConnect(hwnd: HWND; i: INT): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_DRIVER_CONNECT, i, 0) <> 0; -end; - -function capDriverDisconnect(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0) <> 0; -end; - -function capDriverGetName(hwnd: HWND; szName: LPSTR; wSize: WORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_DRIVER_GET_NAME, wSize, LPARAM(szName)) <> 0; -end; - -function capDriverGetVersion(hwnd: HWND; szVer: LPSTR; wSize: WORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_DRIVER_GET_VERSION, wSize, LPARAM(szVer)) <> 0; -end; - -function capDriverGetCaps(hwnd: HWND; s: PCAPDRIVERCAPS; wSize: WORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_DRIVER_GET_CAPS, wSize, LPARAM(s)) <> 0; -end; - -function capFileSetCaptureFile(hwnd: HWND; szName: LPCSTR): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_FILE_SET_CAPTURE_FILE, 0, LPARAM(szName)) <> 0; -end; - -function capFileGetCaptureFile(hwnd: HWND; szName: LPSTR; wSize: WORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_FILE_GET_CAPTURE_FILE, wSize, LPARAM(szName)) <> 0; -end; - -function capFileAlloc(hwnd: HWND; dwSize: DWORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_FILE_ALLOCATE, 0, dwSize) <> 0; -end; - -function capFileSaveAs(hwnd: HWND; szName: LPCSTR): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_FILE_SAVEAS, 0, LPARAM(szName)) <> 0; -end; - -function capFileSetInfoChunk(hwnd: HWND; lpInfoChunk: PCAPINFOCHUNK): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_FILE_SET_INFOCHUNK, 0, LPARAM(lpInfoChunk)) <> 0; -end; - -function capFileSaveDIB(hwnd: HWND; szName: LPCSTR): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_FILE_SAVEDIB, 0, LPARAM(szName)) <> 0; -end; - -function capEditCopy(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_EDIT_COPY, 0, 0) <> 0; -end; - -function capSetAudioFormat(hwnd: HWND; s: PWAVEFORMATEX; wSize: WORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_AUDIOFORMAT, wSize, LPARAM(s)) <> 0; -end; - -function capGetAudioFormat(hwnd: HWND; s: PWAVEFORMATEX; wSize: WORD): DWORD; -begin - Result := AVICapSM(hwnd, WM_CAP_GET_AUDIOFORMAT, wSize, LPARAM(s)); -end; - -function capGetAudioFormatSize(hwnd: HWND): DWORD; -begin - Result := AVICapSM(hwnd, WM_CAP_GET_AUDIOFORMAT, 0, 0); -end; - -function capDlgVideoFormat(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0) <> 0; -end; - -function capDlgVideoSource(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0) <> 0; -end; - -function capDlgVideoDisplay(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_DLG_VIDEODISPLAY, 0, 0) <> 0; -end; - -function capDlgVideoCompression(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_DLG_VIDEOCOMPRESSION, 0, 0) <> 0; -end; - -function capGetVideoFormat(hwnd: HWND; s: PVOID; wSize: WORD): DWORD; -begin - Result := AVICapSM(hwnd, WM_CAP_GET_VIDEOFORMAT, wSize, LPARAM(s)); -end; - -function capGetVideoFormatSize(hwnd: HWND): DWORD; -begin - Result := AVICapSM(hwnd, WM_CAP_GET_VIDEOFORMAT, 0, 0); -end; - -function capSetVideoFormat(hwnd: HWND; s: PVOID; wSize: WORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_VIDEOFORMAT, wSize, LPARAM(s)) <> 0; -end; - -function capPreview(hwnd: HWND; f: BOOL): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_PREVIEW, WPARAM(f), 0) <> 0; -end; - -function capPreviewRate(hwnd: HWND; wMS: WORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_PREVIEWRATE, wMS, 0) <> 0; -end; - -function capOverlay(hwnd: HWND; f: BOOL): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_OVERLAY, WPARAM(f), 0) <> 0; -end; - -function capPreviewScale(hwnd: HWND; f: BOOL): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_SCALE, WPARAM(f), 0) <> 0; -end; - -function capGetStatus(hwnd: HWND; s: PCAPSTATUS; wSize: WORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_GET_STATUS, wSize, LPARAM(s)) <> 0; -end; - -function capSetScrollPos(hwnd: HWND; lpP: PPOINT): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_SCROLL, 0, LPARAM(lpP)) <> 0; -end; - -function capGrabFrame(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_GRAB_FRAME, 0, 0) <> 0; -end; - -function capGrabFrameNoStop(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0) <> 0; -end; - -function capCaptureSequence(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SEQUENCE, 0, 0) <> 0; -end; - -function capCaptureSequenceNoFile(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SEQUENCE_NOFILE, 0, 0) <> 0; -end; - -function capCaptureStop(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_STOP, 0, 0) <> 0; -end; - -function capCaptureAbort(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_ABORT, 0, 0) <> 0; -end; - -function capCaptureSingleFrameOpen(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SINGLE_FRAME_OPEN, 0, 0) <> 0; -end; - -function capCaptureSingleFrameClose(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SINGLE_FRAME_CLOSE, 0, 0) <> 0; -end; - -function capCaptureSingleFrame(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SINGLE_FRAME, 0, 0) <> 0; -end; - -function capCaptureGetSetup(hwnd: HWND; s: PCAPTUREPARMS; wSize: WORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_GET_SEQUENCE_SETUP, wSize, LPARAM(s)) <> 0; -end; - -function capCaptureSetSetup(hwnd: HWND; s: PCAPTUREPARMS; wSize: WORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_SEQUENCE_SETUP, wSize, LPARAM(s)) <> 0; -end; - -function capSetMCIDeviceName(hwnd: HWND; szName: LPCSTR): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_SET_MCI_DEVICE, 0, LPARAM(szName)) <> 0; -end; - -function capGetMCIDeviceName(hwnd: HWND; szName: LPSTR; wSize: WORD): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_GET_MCI_DEVICE, wSize, LPARAM(szName)) <> 0; -end; - -function capPaletteOpen(hwnd: HWND; szName: LPCSTR): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_PAL_OPEN, 0, LPARAM(szName)) <> 0; -end; - -function capPaletteSave(hwnd: HWND; szName: LPCSTR): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_PAL_SAVE, 0, LPARAM(szName)) <> 0; -end; - -function capPalettePaste(hwnd: HWND): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_PAL_PASTE, 0, 0) <> 0; -end; - -function capPaletteAuto(hwnd: HWND; iFrames, iColors: INT): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_PAL_AUTOCREATE, iFrames, iColors) <> 0; -end; - -function capPaletteManual(hwnd: HWND; fGrab: BOOL; iColors: INT): BOOL; -begin - Result := AVICapSM(hwnd, WM_CAP_PAL_MANUALCREATE, WPARAM(fGrab), iColors) <> 0; -end; - -{== Externals ================================================================} - -const - VFWDLL = 'MSVFW32.DLL'; - AVIFILDLL = 'AVIFIL32.DLL'; - AVICAPDLL = 'AVICAP32.DLL'; - -{-- Returns version of VFW ---------------------------------------------------} - -function VideoForWindowsVersion: DWord; pascal; external VFWDLL; - -{-- Call these to start stop using VfW from your app -------------------------} - -{ TODO: Where are these functions? } - { - function InitVFW: LONG; stdcall; - function TermVFW: LONG; stdcall; } - -{-- ICM function declarations ------------------------------------------------} - -function ICInfo(fccType, fccHandler: DWORD; lpicinfo: PICINFO) : BOOL ; stdcall ; external VFWDLL; -function ICInstall(fccType, fccHandler: DWORD; lParam: LPARAM; szDesc: LPSTR; wFlags: UINT) : BOOL ; stdcall ; external VFWDLL; -function ICRemove(fccType, fccHandler: DWORD; wFlags: UINT) : BOOL ; stdcall ; external VFWDLL; -function ICGetInfo(hic: HIC; picinfo: PICINFO; cb: DWORD) : DWORD ; stdcall ; external VFWDLL; - -function ICOpen(fccType, fccHandler: DWORD; wMode: UINT) : HIC ; stdcall ; external VFWDLL; -function ICOpenFunction(fccType, fccHandler: DWORD; wMode: UINT; lpfnHandler: TFarProc) : HIC ; stdcall ; external VFWDLL; -function ICClose(hic: HIC) : DWORD ; stdcall ; external VFWDLL; - -function ICSendMessage(hic: HIC; msg: UINT; dw1, dw2: DWORD) : DWORD ; stdcall ; external VFWDLL; - -{== Compression functions ====================================================} - -{-- ICCompress() - compress a single frame -----------------------------------} - -function ICCompress( - hic : HIC; - dwFlags : DWORD; // flags - lpbiOutput : PBITMAPINFOHEADER; // output format - lpData : PVOID; // output data - lpbiInput : PBITMAPINFOHEADER; // format of frame to compress - lpBits : PVOID; // frame data to compress - lpckid : PDWORD; // ckid for data in AVI file - lpdwFlags : PDWORD; // flags in the AVI index. - lFrameNum : DWORD; // frame number of seq. - dwFrameSize : DWORD; // reqested size in bytes. (if non zero) - dwQuality : DWORD; // quality within one frame - lpbiPrev : PBITMAPINFOHEADER; // format of previous frame - lpPrev : PVOID // previous frame - ) : DWORD; cdecl; external VFWDLL; - -{== Decompression functions ==================================================} - -{-- ICDecompress() - decompress a single frame -------------------------------} - -function ICDecompress( - hic : HIC; - dwFlags : DWORD; // flags (from AVI index...) - lpbiFormat : PBITMAPINFOHEADER; // BITMAPINFO of compressed data - // biSizeImage has the chunk size - lpData : PVOID; // data - lpbi : PBITMAPINFOHEADER; // DIB to decompress to - lpBits : PVOID - ): DWORD; cdecl; external VFWDLL; - -{== Drawing functions ========================================================} - -{-- ICDrawBegin() - start decompressing data with fmt directly to screen -----} - -// return zero if the decompressor supports drawing. - -function ICDrawBegin( - hic : HIC; - dwFlags : DWORD; // flags - hpal : HPALETTE; // palette to draw with - hwnd : HWND; // window to draw to - hdc : HDC; // HDC to draw to - xDst : int; // destination rectangle - yDst : int; - dxDst : int; - dyDst : int; - lpbi : PBITMAPINFOHEADER; // format of frame to draw - xSrc : int; // source rectangle - ySrc : int; - dxSrc : int; - dySrc : int; - dwRate : DWORD; // frames/second = (dwRate/dwScale) - dwScale : DWORD - ): DWORD; cdecl; external VFWDLL; - -{-- ICDraw() - decompress data directly to the screen ------------------------} - -function ICDraw( - hic : HIC; - dwFlags : DWORD; // flags - lpFormat : PVOID; // format of frame to decompress - lpData : PVOID; // frame data to decompress - cbData : DWORD; // size of data - lTime : DWORD // time to draw this frame - ): DWORD; cdecl; external VFWDLL; - -{== Helper routines for DrawDib and MCIAVI... ================================} - -function ICLocate(fccType, fccHandler: DWORD; lpbiIn, lpbiOut: PBITMAPINFOHEADER; wFlags: WORD): HIC; stdcall; external VFWDLL; -function ICGetDisplayFormat(hic: HIC; lpbiIn, lpbiOut: PBITMAPINFOHEADER; BitDepth: int; dx, dy: int): HIC; stdcall; external VFWDLL; - -{== Higher level functions ===================================================} - -function ICImageCompress( - hic : HIC; // compressor to use - uiFlags : UINT; // flags (none yet) - lpbiIn : PBITMAPINFO; // format to compress from - lpBits : PVOID; // data to compress - lpbiOut : PBITMAPINFO; // compress to this (NULL ==> default) - lQuality : LONG; // quality to use - plSize : PDWORD // compress to this size (0=whatever) - ): THANDLE; stdcall; external VFWDLL; - -function ICImageDecompress( - hic : HIC; // compressor to use - uiFlags : UINT; // flags (none yet) - lpbiIn : PBITMAPINFO; // format to decompress from - lpBits : PVOID; // data to decompress - lpbiOut : PBITMAPINFO // decompress to this (NULL ==> default) - ): THANDLE; stdcall; external VFWDLL; - -{-- ICCompressorChoose() - allows user to choose compressor, quality etc... --} - -function ICCompressorChoose( - hwnd : HWND; // parent window for dialog - uiFlags : UINT; // flags - pvIn : PVOID; // input format (optional) - lpData : PVOID; // input data (optional) - pc : PCOMPVARS; // data about the compressor/dlg - lpszTitle : LPSTR // dialog title (optional) - ): BOOL; stdcall; external VFWDLL; - -function ICSeqCompressFrameStart(pc: PCOMPVARS; lpbiIn: PBITMAPINFO): BOOL; stdcall; external VFWDLL; -procedure ICSeqCompressFrameEnd(pc: PCOMPVARS); stdcall; external VFWDLL; - -function ICSeqCompressFrame( - pc : PCOMPVARS; // set by ICCompressorChoose - uiFlags : UINT; // flags - lpBits : PVOID; // input DIB bits - pfKey : PBOOL; // did it end up being a key frame? - plSize : PDWORD // size to compress to/of returned image - ): PVOID; stdcall; external VFWDLL; - -procedure ICCompressorFree(pc: PCOMPVARS); stdcall; external VFWDLL; - -{== DrawDib functions ========================================================} - -{-- DrawDibOpen() ------------------------------------------------------------} - -function DrawDibOpen: HDRAWDIB; stdcall; external VFWDLL; - -{-- DrawDibClose() -----------------------------------------------------------} - -function DrawDibClose(hdd: HDRAWDIB): BOOL; stdcall; external VFWDLL; - -{-- DrawDibGetBuffer() -------------------------------------------------------} - -function DrawDibGetBuffer(hdd: HDRAWDIB; lpbi: PBITMAPINFOHEADER; dwSize: DWORD; dwFlags: DWORD): PVOID; stdcall; external VFWDLL; - -{-- DrawDibGetPalette() - get the palette used for drawing DIBs --------------} - -function DrawDibGetPalette(hdd: HDRAWDIB): HPALETTE; stdcall; external VFWDLL; - -{-- DrawDibSetPalette() - set the palette used for drawing DIBs --------------} - -function DrawDibSetPalette(hdd: HDRAWDIB; hpal: HPALETTE): BOOL; stdcall; external VFWDLL; - -{-- DrawDibChangePalette() ---------------------------------------------------} - -function DrawDibChangePalette(hdd: HDRAWDIB; iStart, iLen: int; lppe: PPALETTEENTRY): BOOL; stdcall; external VFWDLL; - -{-- DrawDibRealize() - realize the palette in a HDD --------------------------} - -function DrawDibRealize(hdd: HDRAWDIB; hdc: HDC; fBackground: BOOL): UINT; stdcall; external VFWDLL; - -{-- DrawDibStart() - start of streaming playback -----------------------------} - -function DrawDibStart(hdd: HDRAWDIB; rate: DWORD): BOOL; stdcall; external VFWDLL; - -{-- DrawDibStop() - start of streaming playback ------------------------------} - -function DrawDibStop(hdd: HDRAWDIB): BOOL; stdcall; external VFWDLL; - -{-- DrawDibBegin() - prepare to draw -----------------------------------------} - -function DrawDibBegin( - hdd : HDRAWDIB; - hdc : HDC; - dxDst : int; - dyDst : int; - lpbi : PBITMAPINFOHEADER; - dxSrc : int; - dySrc : int; - wFlags : UINT - ): BOOL; stdcall; external VFWDLL; - -{-- DrawDibDraw() - actually draw a DIB to the screen ------------------------} - -function DrawDibDraw( - hdd : HDRAWDIB; - hdc : HDC; - xDst : int; - yDst : int; - dxDst : int; - dyDst : int; - lpbi : PBITMAPINFOHEADER; - lpBits : PVOID; - xSrc : int; - ySrc : int; - dxSrc : int; - dySrc : int; - wFlags : UINT - ): BOOL; stdcall; external VFWDLL; - -{-- DrawDibEnd() -------------------------------------------------------------} - -function DrawDibEnd(hdd: HDRAWDIB): BOOL; stdcall; external VFWDLL; - -{-- DrawDibTime() - for debugging purposes only ------------------------------} - -function DrawDibTime(hdd: HDRAWDIB; lpddtime: PDRAWDIBTIME): BOOL; stdcall; external VFWDLL; - -{-- Display profiling --------------------------------------------------------} - -function DrawDibProfileDisplay(lpbi: PBITMAPINFOHEADER): DWORD; stdcall; external VFWDLL; - -{-- Functions ----------------------------------------------------------------} - -procedure AVIFileInit; stdcall; external AVIFILDLL; // Call this first! -procedure AVIFileExit; stdcall; external AVIFILDLL; - -function AVIFileAddRef(pfile: IAVIFILE): ULONG; stdcall; external AVIFILDLL; -function AVIFileRelease(pfile: IAVIFILE): ULONG; stdcall; external AVIFILDLL; - -function AVIFileOpenA(var ppfile: IAVIFILE; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID): HResult; stdcall; external AVIFILDLL; -function AVIFileOpenW(var ppfile: IAVIFILE; szFile: LPCWSTR; uMode: UINT; lpHandler: PCLSID): HResult; stdcall; external AVIFILDLL; - -{$IFDEF UNICODE} -function AVIFileOpen(var ppfile: IAVIFILE; szFile: LPCWSTR; uMode: UINT; lpHandler: PCLSID): HResult; stdcall; external AVIFILDLL name 'AVIFileOpenW'; -{$ELSE} -function AVIFileOpen(var ppfile: IAVIFILE; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID): HResult; stdcall; external AVIFILDLL name 'AVIFileOpenA'; -{$ENDIF} - -function AVIFileInfoW(pfile: IAVIFILE; var pfi: TAVIFILEINFOW; lSize: LONG): HResult; stdcall; external AVIFILDLL; -function AVIFileInfoA(pfile: IAVIFILE; var pfi: TAVIFILEINFOA; lSize: LONG): HResult; stdcall; external AVIFILDLL; - -{$IFDEF UNICODE} -function AVIFileInfo(pfile: IAVIFILE; var pfi: TAVIFILEINFO; lSize: LONG): HResult; stdcall; external AVIFILDLL name 'AVIFileInfoW'; -{$ELSE} -function AVIFileInfo(pfile: IAVIFILE; var pfi: TAVIFILEINFO; lSize: LONG): HResult; stdcall; external AVIFILDLL name 'AVIFileInfoA'; -{$ENDIF} - -function AVIFileGetStream(pfile: IAVIFILE; var ppavi: IAVISTREAM; fccType: DWORD; lParam: LONG): HResult; stdcall; external AVIFILDLL; - -function AVIFileCreateStreamW(pfile: IAVIFILE; var ppavi: IAVISTREAM; var psi: TAVISTREAMINFOW): HResult; stdcall; external AVIFILDLL; -function AVIFileCreateStreamA(pfile: IAVIFILE; var ppavi: IAVISTREAM; var psi: TAVISTREAMINFOA): HResult; stdcall; external AVIFILDLL; - -{$IFDEF UNICODE} -function AVIFileCreateStream(pfile: IAVIFILE; var ppavi: IAVISTREAM; var psi: TAVISTREAMINFO): HResult; stdcall; external AVIFILDLL name 'AVIFileCreateStreamW'; -{$ELSE} -function AVIFileCreateStream(pfile: IAVIFILE; var ppavi: IAVISTREAM; var psi: TAVISTREAMINFO): HResult; stdcall; external AVIFILDLL name 'AVIFileCreateStreamA'; -{$ENDIF} - -function AVIFileWriteData(pfile: IAVIFILE; ckid: DWORD; lpData: PVOID; cbData: LONG): HResult; stdcall; external AVIFILDLL; -function AVIFileReadData(pfile: IAVIFILE; ckid: DWORD; lpData: PVOID; var lpcbData: LONG): HResult; stdcall; external AVIFILDLL; -function AVIFileEndRecord(pfile: IAVIFILE): HResult; stdcall; external AVIFILDLL; - -function AVIStreamAddRef(pavi: IAVISTREAM): ULONG; stdcall; external AVIFILDLL; -function AVIStreamRelease(pavi: IAVISTREAM): ULONG; stdcall; external AVIFILDLL; - -function AVIStreamInfoW (pavi: IAVISTREAM; var psi: TAVISTREAMINFOW; lSize: LONG): HResult; stdcall; external AVIFILDLL; -function AVIStreamInfoA (pavi: IAVISTREAM; var psi: TAVISTREAMINFOA; lSize: LONG): HResult; stdcall; external AVIFILDLL; - -{$IFDEF UNICODE} -function AVIStreamInfo(pavi: IAVISTREAM; var psi: TAVISTREAMINFO; lSize: LONG): HResult; stdcall; external AVIFILDLL name 'AVIStreamInfoW'; -{$ELSE} -function AVIStreamInfo(pavi: IAVISTREAM; var psi: TAVISTREAMINFO; lSize: LONG): HResult; stdcall; external AVIFILDLL name 'AVIStreamInfoA'; -{$ENDIF} - - -function AVIStreamFindSample(pavi: IAVISTREAM; lPos: LONG; lFlags: LONG): LONG; stdcall; external AVIFILDLL; -function AVIStreamReadFormat(pavi: IAVISTREAM; lPos: LONG; lpFormat: PVOID; lpcbFormat: PLONG): HResult; stdcall; external AVIFILDLL; -function AVIStreamSetFormat(pavi: IAVISTREAM; lPos: LONG; lpFormat: PVOID; cbFormat: LONG): HResult; stdcall; external AVIFILDLL; -function AVIStreamReadData(pavi: IAVISTREAM; fcc: DWORD; lp: PVOID; lpcb: PLONG): HResult; stdcall; external AVIFILDLL; -function AVIStreamWriteData(pavi: IAVISTREAM; fcc: DWORD; lp: PVOID; cb: LONG): HResult; stdcall; external AVIFILDLL; - -function AVIStreamRead( - pavi : IAVISTREAM; - lStart : LONG; - lSamples : LONG; - lpBuffer : PVOID; - cbBuffer : LONG; - plBytes : PLONG; - plSamples : PLONG - ): HResult; stdcall; external AVIFILDLL; - -function AVIStreamWrite( - pavi : IAVISTREAM; - lStart : LONG; - lSamples : LONG; - lpBuffer : PVOID; - cbBuffer : LONG; - dwFlags : DWORD; - plSampWritten : PLONG; - plBytesWritten : PLONG - ): HResult; stdcall; external AVIFILDLL; - -// Right now, these just use AVIStreamInfo() to get information, then -// return some of it. Can they be more efficient? - -function AVIStreamStart(pavi: IAVISTREAM): LONG; stdcall; external AVIFILDLL; -function AVIStreamLength(pavi: IAVISTREAM): LONG; stdcall; external AVIFILDLL; -function AVIStreamTimeToSample(pavi: IAVISTREAM; lTime: LONG): LONG; stdcall; external AVIFILDLL; -function AVIStreamSampleToTime(pavi: IAVISTREAM; lSample: LONG): LONG; stdcall; external AVIFILDLL; - -function AVIStreamBeginStreaming(pavi: IAVISTREAM; lStart, lEnd: LONG; lRate: LONG): HResult; stdcall; external AVIFILDLL; -function AVIStreamEndStreaming(pavi: IAVISTREAM): HResult; stdcall; external AVIFILDLL; - -{-- Helper functions for using IGetFrame -------------------------------------} - -function AVIStreamGetFrameOpen_(pavi: IAVISTREAM; lpbiWanted: PBitmapInfoHeader): pointer; stdcall; external AVIFILDLL name 'AVIStreamGetFrameOpen'; -function AVIStreamGetFrame(pg: IGETFRAME; lPos: LONG): PBitmapInfoHeader; stdcall; external AVIFILDLL; -function AVIStreamGetFrameClose(pg: IGETFRAME): HResult; stdcall; external AVIFILDLL; - -function AVIStreamGetFrameOpen(pavi: IAVIStream; lpbiWanted: PBitmapInfoHeader): IGetFrame; stdcall; -begin - pointer(Result) := AVIStreamGetFrameOpen_(pavi, lpbiWanted); -end; - -// !!! We need some way to place an advise on a stream.... -// STDAPI AVIStreamHasChanged (PAVISTREAM pavi); - -{-- Shortcut function --------------------------------------------------------} - -function AVIStreamOpenFromFileA(var ppavi: IAVISTREAM; szFile: LPCSTR; fccType: DWORD; - lParam: LONG; mode: UINT; pclsidHandler: PCLSID): HResult; stdcall; external AVIFILDLL; -function AVIStreamOpenFromFileW(var ppavi: IAVISTREAM; szFile: LPCWSTR; fccType: DWORD; - lParam: LONG; mode: UINT; pclsidHandler: PCLSID): HResult; stdcall; external AVIFILDLL; - -{$IFDEF UNICODE} -function AVIStreamOpenFromFile(var ppavi: IAVISTREAM; szFile: LPCWSTR; fccType: DWORD; - lParam: LONG; mode: UINT; pclsidHandler: PCLSID): HResult; stdcall; external AVIFILDLL name 'AVIStreamOpenFromFileW'; -{$ELSE} -function AVIStreamOpenFromFile(var ppavi: IAVISTREAM; szFile: LPCSTR; fccType: DWORD; - lParam: LONG; mode: UINT; pclsidHandler: PCLSID): HResult; stdcall; external AVIFILDLL name 'AVIStreamOpenFromFileA'; -{$ENDIF} - -{-- Use to create disembodied streams ----------------------------------------} - -function AVIStreamCreate(var ppavi: IAVISTREAM; lParam1, lParam2: LONG; - pclsidHandler: PCLSID): HResult; stdcall; external AVIFILDLL; - -// PHANDLER AVIAPI AVIGetHandler (PAVISTREAM pavi, PAVISTREAMHANDLER psh); -// PAVISTREAM AVIAPI AVIGetStream (PHANDLER p); - -{-- Stuff to support backward compat. ----------------------------------------} - -function AVIStreamFindKeyFrame(var pavi: IAVISTREAM; lPos: LONG; lFlags: LONG): DWORD; stdcall; external AVIFILDLL name 'AVIStreamFindSample'; - -// Non-portable: this is alias for method name -// FindKeyFrame FindSample - -function AVIStreamClose(pavi: IAVISTREAM): ULONG; stdcall; external AVIFILDLL name 'AVIStreamRelease'; -function AVIFileClose(pfile: IAVIFILE): ULONG; stdcall; external AVIFILDLL name 'AVIFileRelease'; -procedure AVIStreamInit; stdcall; external AVIFILDLL name 'AVIFileInit'; -procedure AVIStreamExit; stdcall; external AVIFILDLL name 'AVIFileExit'; - -{== AVISave routines and structures ==========================================} - -function AVIMakeCompressedStream( - var ppsCompressed : IAVISTREAM; - ppsSource : IAVISTREAM; - lpOptions : PAVICOMPRESSOPTIONS; - pclsidHandler : PCLSID - ): HResult; stdcall; external AVIFILDLL; - -// Non-portable: uses variable number of params -// EXTERN_C HRESULT CDECL AVISaveA (LPCSTR szFile, -// CLSID FAR *pclsidHandler, -// AVISAVECALLBACK lpfnCallback, -// int nStreams, -// PAVISTREAM pfile, -// LPAVICOMPRESSOPTIONS lpOptions, -// ...); - -function AVISaveVA( - szFile : LPCSTR; - pclsidHandler : PCLSID; - lpfnCallback : TAVISAVECALLBACK; - nStreams : int; - var ppavi : IAVISTREAM; - var plpOptions : PAVICOMPRESSOPTIONS - ): HResult; stdcall; external AVIFILDLL; - -// Non-portable: uses variable number of params -// EXTERN_C HRESULT CDECL AVISaveW (LPCWSTR szFile, -// CLSID FAR *pclsidHandler, -// AVISAVECALLBACK lpfnCallback, -// int nStreams, -// PAVISTREAM pfile, -// LPAVICOMPRESSOPTIONS lpOptions, -// ...); - -function AVISaveVW( - szFile : LPCWSTR; - pclsidHandler : PCLSID; - lpfnCallback : TAVISAVECALLBACK; - nStreams : int; - var ppavi : IAVISTREAM; - var plpOptions : PAVICOMPRESSOPTIONS - ): HResult; stdcall; external AVIFILDLL; - -// #define AVISave AVISaveA - -function AVISaveV( - szFile : LPCSTR; - pclsidHandler : PCLSID; - lpfnCallback : TAVISAVECALLBACK; - nStreams : int; - var ppavi : IAVISTREAM; - var plpOptions : PAVICOMPRESSOPTIONS - ): HResult; stdcall; external AVIFILDLL name 'AVISaveVA'; - -function AVISaveOptions( - hwnd : HWND; - uiFlags : UINT; - nStreams : int; - var ppavi : IAVISTREAM; - var plpOptions : PAVICOMPRESSOPTIONS - ): BOOL; stdcall; external AVIFILDLL; - -function AVISaveOptionsFree(nStreams: int; var plpOptions: PAVICOMPRESSOPTIONS): HResult; stdcall; external AVIFILDLL; - -{-----------------------------------------------------------------------------} - -function AVIBuildFilterW(lpszFilter: LPWSTR; cbFilter: LONG; fSaving: BOOL): HResult; stdcall; external AVIFILDLL; -function AVIBuildFilterA(lpszFilter: LPSTR; cbFilter: LONG; fSaving: BOOL): HResult; stdcall; external AVIFILDLL; - -function AVIBuildFilter(lpszFilter: LPSTR; cbFilter: LONG; fSaving: BOOL): HResult; stdcall; external AVIFILDLL name 'AVIBuildFilterA'; - -function AVIMakeFileFromStreams(var ppfile: IAVIFILE; nStreams: int; var papStreams: IAVISTREAM): HResult; stdcall; external AVIFILDLL; - -function AVIMakeStreamFromClipboard(cfFormat: UINT; hGlobal: THANDLE; var ppstream: IAVISTREAM): HResult; stdcall; external AVIFILDLL; - -{-- Clipboard routines -------------------------------------------------------} - -function AVIPutFileOnClipboard(pf: IAVIFILE): HResult; stdcall; external AVIFILDLL; -function AVIGetFromClipboard(var lppf: IAVIFILE): HResult; stdcall; external AVIFILDLL; -function AVIClearClipboard: HResult; stdcall; external AVIFILDLL; - -{-- Editing routines ---------------------------------------------------------} - -function CreateEditableStream(var ppsEditable: IAVISTREAM; psSource: IAVISTREAM): HResult; stdcall; external AVIFILDLL; - -function EditStreamCut(pavi: IAVISTREAM; var plStart, plLength: LONG; var ppResult: IAVISTREAM): HResult; stdcall; external AVIFILDLL; -function EditStreamCopy(pavi: IAVISTREAM; var plStart, plLength: LONG; var ppResult: IAVISTREAM): HResult; stdcall; external AVIFILDLL; -function EditStreamPaste(pavi: IAVISTREAM; var plPos, plLength: LONG; pstream: IAVISTREAM; lStart, lEnd: LONG): HResult; stdcall; external AVIFILDLL; -function EditStreamClone(pavi: IAVISTREAM; var ppResult: IAVISTREAM): HResult; stdcall; external AVIFILDLL; - -function EditStreamSetNameA(pavi: IAVISTREAM; lpszName: LPCSTR): HResult; stdcall; external AVIFILDLL; -function EditStreamSetNameW(pavi: IAVISTREAM; lpszName: LPCWSTR): HResult; stdcall; external AVIFILDLL; -function EditStreamSetInfoW(pavi: IAVISTREAM; lpInfo: PAVISTREAMINFOW; cbInfo: LONG): HResult; stdcall; external AVIFILDLL; -function EditStreamSetInfoA(pavi: IAVISTREAM; lpInfo: PAVISTREAMINFOA; cbInfo: LONG): HResult; stdcall; external AVIFILDLL; - -function EditStreamSetInfo(pavi: IAVISTREAM; lpInfo: PAVISTREAMINFOA; cbInfo: LONG): HResult; stdcall; external AVIFILDLL name 'EditStreamSetInfoA'; -function EditStreamSetName(pavi: IAVISTREAM; lpszName: LPCSTR): HResult; stdcall; external AVIFILDLL name 'EditStreamSetNameA'; - -{-- MCIWnd -------------------------------------------------------------------} - -function MCIWndCreateA(hwndParent: HWND; hInstance: HINST; dwStyle: DWORd; szFile: LPCSTR): HWND; cdecl; external VFWDLL; -function MCIWndCreateW(hwndParent: HWND; hInstance: HINST; dwStyle: DWORd; szFile: LPCWSTR): HWND; cdecl; external VFWDLL; - -function MCIWndCreate(hwndParent: HWND; hInstance: HINST; dwStyle: DWORd; szFile: LPCSTR): HWND; cdecl; external VFWDLL name 'MCIWndCreateA'; - -function MCIWndRegisterClass: BOOL; cdecl; external VFWDLL; - -{== AVICAP - Window class for AVI capture ====================================} - -{-- The only exported functions from AVICAP.DLL ------------------------------} - -function capCreateCaptureWindowA( - lpszWindowName : LPCSTR; - dwStyle : DWORD; - x, y : int; - nWidth, nHeight : int; - hwndParent : HWND; - nID : int - ): HWND; stdcall; external AVICAPDLL; - -function capGetDriverDescriptionA( - wDriverIndex : UINT; - lpszName : LPSTR; - cbName : int; - lpszVer : LPSTR; - cbVer : int - ): BOOL; stdcall; external AVICAPDLL; - -function capCreateCaptureWindowW( - lpszWindowName : LPCWSTR; - dwStyle : DWORD; - x, y : int; - nWidth, nHeight : int; - hwndParent : HWND; - nID : int - ): HWND; stdcall; external AVICAPDLL; - -function capGetDriverDescriptionW( - wDriverIndex : UINT; - lpszName : LPWSTR; - cbName : int; - lpszVer : LPWSTR; - cbVer : int - ): BOOL; stdcall; external AVICAPDLL; - -function capCreateCaptureWindow( - lpszWindowName : LPCSTR; - dwStyle : DWORD; - x, y : int; - nWidth, nHeight : int; - hwndParent : HWND; - nID : int - ): HWND; stdcall; external AVICAPDLL name 'capCreateCaptureWindowA'; - -function capGetDriverDescription( - wDriverIndex : UINT; - lpszName : LPSTR; - cbName : int; - lpszVer : LPSTR; - cbVer : int - ): BOOL; stdcall; external AVICAPDLL name 'capGetDriverDescriptionA'; - -{== FilePreview dialog =======================================================} - -function GetOpenFileNamePreviewA(lpofn: POPENFILENAMEA): BOOL; stdcall; external VFWDLL; -function GetSaveFileNamePreviewA(lpofn: POPENFILENAMEA): BOOL; stdcall; external VFWDLL; - -function GetOpenFileNamePreviewW(lpofn: POPENFILENAMEW): BOOL; stdcall; external VFWDLL; -function GetSaveFileNamePreviewW(lpofn: POPENFILENAMEW): BOOL; stdcall; external VFWDLL; - -function GetOpenFileNamePreview(lpofn: POPENFILENAMEA): BOOL; stdcall; external VFWDLL name 'GetOpenFileNamePreviewA'; -function GetSaveFileNamePreview(lpofn: POPENFILENAMEA): BOOL; stdcall; external VFWDLL name 'GetSaveFileNamePreviewA'; - -end. diff --git a/Sourcex/Formatx.VRML.pas b/Sourcex/Formatx.VRML.pas deleted file mode 100644 index 6e51c4ac..00000000 --- a/Sourcex/Formatx.VRML.pas +++ /dev/null @@ -1,921 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.VRML; - -(* VRML file format parser *) - -interface - -{$I GLScene.Defines.inc} - -uses - System.Classes, - System.SysUtils, - GLScene.VectorTypes, - GLScene.VectorGeometry, - GLScene.VectorLists, - GLScene.Strings; - -type - TVRMLNode = class - private - FNodes: TList; - FParent: TVRMLNode; - FName, FDefName: String; - function GetNode(index: Integer): TVRMLNode; - public - constructor Create; virtual; - constructor CreateOwned(AParent: TVRMLNode); - destructor Destroy; override; - function Count: Integer; - procedure Clear; - procedure Add(node: TVRMLNode); - procedure Remove(node: TVRMLNode); - procedure Delete(index: Integer); - property Nodes[index: Integer]: TVRMLNode read GetNode; default; - property Parent: TVRMLNode read FParent; - property Name: String read FName write FName; - property DefName: String read FDefName write FDefName; - end; - - TVRMLSingleArray = class(TVRMLNode) - private - FValues: TGSingleList; - public - constructor Create; override; - destructor Destroy; override; - property Values: TGSingleList read FValues; - end; - - TVRMLIntegerArray = class(TVRMLNode) - private - FValues: TGIntegerList; - public - constructor Create; override; - destructor Destroy; override; - property Values: TGIntegerList read FValues; - end; - - TVRMLMaterial = class(TVRMLNode) - private - FDiffuseColor, FAmbientColor, FSpecularColor, FEmissiveColor: TVector3f; - FTransparency, FShininess: Single; - FHasDiffuse, FHasAmbient, FHasSpecular, FHasEmissive, FHasTransparency, - FHasShininess: Boolean; - public - constructor Create; override; - property DiffuseColor: TVector3f read FDiffuseColor write FDiffuseColor; - property AmbientColor: TVector3f read FAmbientColor write FAmbientColor; - property SpecularColor: TVector3f read FSpecularColor write FSpecularColor; - property EmissiveColor: TVector3f read FEmissiveColor write FEmissiveColor; - property Transparency: Single read FTransparency write FTransparency; - property Shininess: Single read FShininess write FShininess; - property HasDiffuse: Boolean read FHasDiffuse write FHasDiffuse; - property HasAmbient: Boolean read FHasAmbient write FHasAmbient; - property HasSpecular: Boolean read FHasSpecular write FHasSpecular; - property HasEmissive: Boolean read FHasEmissive write FHasEmissive; - property HasTransparency: Boolean read FHasTransparency - write FHasTransparency; - property HasShininess: Boolean read FHasShininess write FHasShininess; - end; - - TVRMLUse = class(TVRMLNode) - private - FValue: String; - public - property Value: String read FValue write FValue; - end; - - TVRMLShapeHints = class(TVRMLNode) - private - FCreaseAngle: Single; - public - property CreaseAngle: Single read FCreaseAngle write FCreaseAngle; - end; - - TVRMLTransform = class(TVRMLNode) - private - FCenter: TVector3f; - FRotation: TVector4f; - FScaleFactor: TVector3f; - public - constructor Create; override; - property Center: TVector3f read FCenter write FCenter; - property Rotation: TVector4f read FRotation write FRotation; - property ScaleFactor: TVector3f read FScaleFactor write FScaleFactor; - end; - - TVRMLParser = class - private - FCursor: Integer; - FTokens: TStringList; - FRootNode: TVRMLNode; - FCurrentNode: TVRMLNode; - FAllowUnknownNodes: Boolean; - FDefines: TList; - protected - function ReadToken: String; - function ReadSingle: Single; - function ReadVector3f: TVector3f; - function ReadVector4f: TVector4f; - procedure ReadUnknownArray(DefName: String = ''); - procedure ReadUnknownHeirachy(DefName: String = ''); - procedure ReadUnknown(unknown_token: String; DefName: String = ''); - procedure ReadPointArray(DefName: String = ''); - procedure ReadCoordIndexArray(DefName: String = ''); - procedure ReadNormalIndexArray(DefName: String = ''); - procedure ReadTextureCoordIndexArray(DefName: String = ''); - procedure ReadCoordinate3(DefName: String = ''); - procedure ReadNormal(DefName: String = ''); - procedure ReadTextureCoordinate2(DefName: String = ''); - procedure ReadMaterial(DefName: String = ''); - procedure ReadIndexedFaceSet(DefName: String = ''); - procedure ReadTransform(DefName: String = ''); - procedure ReadShapeHints(DefName: String = ''); - procedure ReadSeparator(DefName: String = ''); - procedure ReadGroup(DefName: String = ''); - procedure ReadDef; - procedure ReadUse; - public - constructor Create; - destructor Destroy; override; - procedure Parse(Text: String); - property RootNode: TVRMLNode read FRootNode; - property AllowUnknownNodes: Boolean read FAllowUnknownNodes - write FAllowUnknownNodes; - end; - -// --------------------------------------------------------------------------- -implementation -// --------------------------------------------------------------------------- - -function CreateVRMLTokenList(Text: String): TStringList; -const - cSymbols: array [0 .. 3] of char = ('{', '}', '[', ']'); -var - i, j, p: Integer; - str, token: String; -begin - Result := TStringList.Create; - - Result.Text := Text; - for i := 0 to Result.Count - 1 do - begin - p := Pos('#', Result[i]); - if p > 0 then - Result[i] := Copy(Result[i], 1, p - 1); - end; - - Result.CommaText := Result.Text; - for j := 0 to Length(cSymbols) - 1 do - begin - i := 0; - repeat - token := Result[i]; - p := Pos(cSymbols[j], token); - if (p > 0) and (token <> cSymbols[j]) then - begin - str := Copy(token, p + 1, Length(token) - p); - - if (p = 1) then - begin - Result.Delete(i); - Result.Insert(i, trim(str)); - Result.Insert(i, cSymbols[j]); - end - else - begin - Result.Delete(i); - if Length(str) > 0 then - Result.Insert(i, trim(str)); - Result.Insert(i, cSymbols[j]); - Result.Insert(i, trim(Copy(token, 1, p - 1))); - end; - end; - Inc(i); - until i >= Result.Count - 1; - end; -end; - -// --------------- -// --------------- TVRMLNode --------------- -// --------------- - -constructor TVRMLNode.Create; -begin - FNodes := TList.Create; -end; - -constructor TVRMLNode.CreateOwned(AParent: TVRMLNode); -begin - Create; - if Assigned(AParent) then - AParent.Add(Self); -end; - -destructor TVRMLNode.Destroy; -begin - Clear; - FNodes.Free; - inherited; -end; - -function TVRMLNode.GetNode(index: Integer): TVRMLNode; -begin - Result := TVRMLNode(FNodes[index]); -end; - -function TVRMLNode.Count: Integer; -begin - Result := FNodes.Count; -end; - -procedure TVRMLNode.Clear; -begin - while FNodes.Count > 0 do - Delete(0); -end; - -procedure TVRMLNode.Add(node: TVRMLNode); -begin - if not Assigned(node) then - exit; - if Assigned(node.Parent) then - node.Parent.FNodes.Remove(node); - FNodes.Add(node); - node.FParent := Self; -end; - -procedure TVRMLNode.Remove(node: TVRMLNode); -begin - if not Assigned(node) then - exit; - FNodes.Remove(node); - node.Free; -end; - -procedure TVRMLNode.Delete(index: Integer); -begin - if (index < 0) or (index >= Count) then - exit; - Nodes[index].Free; - FNodes.Delete(index); -end; - - -// --------------- -// --------------- TVRMLSingleArray --------------- -// --------------- - -constructor TVRMLSingleArray.Create; -begin - inherited; - FValues := TGSingleList.Create; -end; - -destructor TVRMLSingleArray.Destroy; -begin - FValues.Free; - inherited; -end; - - -// --------------- -// --------------- TVRMLIntegerArray --------------- -// --------------- - -constructor TVRMLIntegerArray.Create; -begin - inherited; - FValues := TGIntegerList.Create; -end; - -destructor TVRMLIntegerArray.Destroy; -begin - FValues.Free; - inherited; -end; - - -// --------------- -// --------------- TVRMLMaterial --------------- -// --------------- - -constructor TVRMLMaterial.Create; -begin - inherited; - // Default shininess value - FHasDiffuse := False; - FHasAmbient := False; - FHasSpecular := False; - FHasEmissive := False; - FHasTransparency := False; - FHasShininess := False; -end; - - -// --------------- -// --------------- TVRMLTransform --------------- -// --------------- - -constructor TVRMLTransform.Create; -begin - inherited; - FScaleFactor.X := 1; - FScaleFactor.Y := 1; - FScaleFactor.Z := 1; -end; - - -// --------------- -// --------------- TVRMLParser --------------- -// --------------- - -constructor TVRMLParser.Create; -begin - FDefines := TList.Create; - FRootNode := TVRMLNode.Create; - FRootNode.Name := 'Root'; - FAllowUnknownNodes := False; -end; - -destructor TVRMLParser.Destroy; -begin - FDefines.Free; - FRootNode.Free; - inherited; -end; - -function TVRMLParser.ReadToken: String; -begin - if FCursor < FTokens.Count then - begin - Result := LowerCase(FTokens[FCursor]); - Inc(FCursor); - end - else - Result := ''; -end; - -procedure TVRMLParser.ReadUnknownArray(DefName: String); -var - token: String; -begin - if AllowUnknownNodes then - begin - FCurrentNode := TVRMLNode.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'Unknown array'; - end; - repeat - token := ReadToken; - if token = '' then - exit; - until token = ']'; - if AllowUnknownNodes then - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadUnknownHeirachy(DefName: String); -var - token: String; -begin - if AllowUnknownNodes then - begin - FCurrentNode := TVRMLNode.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'Unknown heirachy'; - end; - repeat - token := ReadToken; - if token = '' then - exit - else - ReadUnknown(token); - until token = '}'; - if AllowUnknownNodes then - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadUnknown(unknown_token: String; DefName: String); -begin - if unknown_token = '{' then - ReadUnknownHeirachy - else if unknown_token = '[' then - ReadUnknownArray - else if (unknown_token <> '}') and (unknown_token <> ']') and AllowUnknownNodes - then - begin - TVRMLNode.CreateOwned(FCurrentNode).Name := 'UNKNOWN[' + - unknown_token + ']'; - end; -end; - -function TVRMLParser.ReadSingle: Single; -begin - Result := StrToFloatDef(ReadToken, 0); -end; - -function TVRMLParser.ReadVector3f: TVector3f; -begin - Result.X := ReadSingle; - Result.Y := ReadSingle; - Result.Z := ReadSingle; -end; - -function TVRMLParser.ReadVector4f: TVector4f; -begin - Result.X := ReadSingle; - Result.Y := ReadSingle; - Result.Z := ReadSingle; - Result.W := ReadSingle; -end; - -procedure TVRMLParser.ReadPointArray(DefName: String); -var - token: String; -begin - FCurrentNode := TVRMLSingleArray.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'PointArray'; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '['; - - repeat - token := ReadToken; - if token = '' then - exit - else if token <> ']' then - TVRMLSingleArray(FCurrentNode) - .Values.Add(StrToFloatDef(token, 0)); - until token = ']'; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadCoordIndexArray(DefName: String = ''); -var - token: String; -begin - FCurrentNode := TVRMLIntegerArray.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'CoordIndexArray'; - FCurrentNode.DefName := DefName; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '['; - - repeat - token := ReadToken; - if token = '' then - exit - else if token <> ']' then - TVRMLIntegerArray(FCurrentNode).Values.Add(StrToInt(token)); - until token = ']'; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadNormalIndexArray(DefName: String = ''); -var - token: String; -begin - FCurrentNode := TVRMLIntegerArray.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'NormalIndexArray'; - FCurrentNode.DefName := DefName; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '['; - - repeat - token := ReadToken; - if token = '' then - exit - else if token <> ']' then - TVRMLIntegerArray(FCurrentNode).Values.Add(StrToInt(token)); - until token = ']'; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadTextureCoordIndexArray(DefName: String = ''); -var - token: String; -begin - FCurrentNode := TVRMLIntegerArray.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'TextureCoordIndexArray'; - FCurrentNode.DefName := DefName; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '['; - - repeat - token := ReadToken; - if token = '' then - exit - else if token <> ']' then - TVRMLIntegerArray(FCurrentNode).Values.Add(StrToInt(token)); - until token = ']'; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadMaterial(DefName: String); -var - token: String; -begin - FCurrentNode := TVRMLMaterial.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'Material'; - FCurrentNode.DefName := DefName; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '{'; - - with TVRMLMaterial(FCurrentNode) do - begin - repeat - token := ReadToken; - if token = '' then - exit - else if token = 'diffusecolor' then - begin - DiffuseColor := ReadVector3f; - HasDiffuse := True; - end - else if token = 'ambientcolor' then - begin - AmbientColor := ReadVector3f; - HasAmbient := True; - end - else if token = 'specularcolor' then - begin - SpecularColor := ReadVector3f; - HasSpecular := True; - end - else if token = 'emissivecolor' then - begin - EmissiveColor := ReadVector3f; - HasEmissive := True; - end - else if token = 'transparency' then - begin - Transparency := ReadSingle; - HasTransparency := True; - end - else if token = 'shininess' then - begin - Shininess := ReadSingle; - HasShininess := True; - end - else if token <> '}' then - ReadUnknown(token); - until token = '}'; - end; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadCoordinate3(DefName: String = ''); -var - token: String; -begin - FCurrentNode := TVRMLNode.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'Coordinate3'; - FCurrentNode.DefName := DefName; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '{'; - - repeat - token := ReadToken; - if token = '' then - exit - else if token = 'point' then - ReadPointArray - else if token <> '}' then - ReadUnknown(token); - until token = '}'; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadNormal(DefName: String = ''); -var - token: String; -begin - FCurrentNode := TVRMLNode.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'Normal'; - FCurrentNode.DefName := DefName; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '{'; - - repeat - token := ReadToken; - if token = '' then - exit - else if token = 'vector' then - ReadPointArray - else if token <> '}' then - ReadUnknown(token); - until token = '}'; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadTextureCoordinate2(DefName: String = ''); -var - token: String; -begin - FCurrentNode := TVRMLNode.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'TextureCoordinate2'; - FCurrentNode.DefName := DefName; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '{'; - - repeat - token := ReadToken; - if token = '' then - exit - else if token = 'point' then - ReadPointArray - else if token <> '}' then - ReadUnknown(token); - until token = '}'; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadIndexedFaceSet(DefName: String = ''); -var - token: String; -begin - FCurrentNode := TVRMLNode.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'IndexedFaceSet'; - FCurrentNode.DefName := DefName; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '{'; - - repeat - token := ReadToken; - if token = '' then - exit - else if token = 'coordindex' then - ReadCoordIndexArray - else if token = 'normalindex' then - ReadNormalIndexArray - else if token = 'texturecoordindex' then - ReadTextureCoordIndexArray - else if token <> '}' then - ReadUnknown(token); - until token = '}'; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadTransform(DefName: String); -var - token: String; -begin - FCurrentNode := TVRMLTransform.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'Transform'; - FCurrentNode.DefName := DefName; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '{'; - - with TVRMLTransform(FCurrentNode) do - begin - repeat - token := ReadToken; - if token = '' then - exit - else if token = 'rotation' then - Rotation := ReadVector4f - else if token = 'center' then - Center := ReadVector3f - else if token = 'scalefactor' then - ScaleFactor := ReadVector3f - else if token <> '}' then - ReadUnknown(token); - until token = '}'; - end; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadShapeHints(DefName: String = ''); -var - token: String; -begin - FCurrentNode := TVRMLShapeHints.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'ShapeHints'; - FCurrentNode.DefName := DefName; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '{'; - - repeat - token := ReadToken; - if token = '' then - exit - else if token = 'creaseangle' then - TVRMLShapeHints(FCurrentNode).CreaseAngle := ReadSingle - else if token <> '}' then - ReadUnknown(token); - until token = '}'; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadSeparator(DefName: String = ''); -var - token: String; -begin - FCurrentNode := TVRMLNode.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'Separator'; - FCurrentNode.DefName := DefName; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '{'; - - repeat - token := ReadToken; - if token = '' then - exit - else if token = 'def' then - ReadDef - else if (token = 'group') or (token = 'switch') then - ReadGroup - else if token = 'separator' then - ReadSeparator - else if token = 'use' then - ReadUse - else if token = 'shapehints' then - ReadShapeHints - else if token = 'transform' then - ReadTransform - else if token = 'material' then - ReadMaterial - else if token = 'coordinate3' then - ReadCoordinate3 - else if token = 'normal' then - ReadNormal - else if token = 'texturecoordinate2' then - ReadTextureCoordinate2 - else if token = 'indexedfaceset' then - ReadIndexedFaceSet - else if token <> '}' then - ReadUnknown(token); - until token = '}'; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadGroup(DefName: String = ''); -var - token: String; -begin - FCurrentNode := TVRMLNode.CreateOwned(FCurrentNode); - FCurrentNode.Name := 'Group'; - FCurrentNode.DefName := DefName; - - repeat - token := ReadToken; - if token = '' then - exit; - until token = '{'; - - repeat - token := ReadToken; - if token = '' then - exit - else if token = 'def' then - ReadDef - else if (token = 'group') or (token = 'switch') then - ReadGroup - else if token = 'separator' then - ReadSeparator - else if token = 'use' then - ReadUse - else if token = 'shapehints' then - ReadShapeHints - else if token = 'transform' then - ReadTransform - else if token = 'material' then - ReadMaterial - else if token = 'coordinate3' then - ReadCoordinate3 - else if token = 'indexedfaceset' then - ReadIndexedFaceSet - else if token <> '}' then - ReadUnknown(token); - until token = '}'; - - FCurrentNode := FCurrentNode.Parent; -end; - -procedure TVRMLParser.ReadDef; -var - DefName, token: String; -begin - DefName := ReadToken; - token := ReadToken; - if (token = 'group') or (token = 'switch') then - ReadGroup(DefName) - else if token = 'separator' then - ReadSeparator(DefName) - else if token = 'transform' then - ReadTransform(DefName) - else if token = 'material' then - ReadMaterial(DefName) - else if token = 'coordinate3' then - ReadCoordinate3(DefName) - else if token = 'indexedfaceset' then - ReadIndexedFaceSet(DefName) - else - ReadUnknown(token); -end; - -procedure TVRMLParser.ReadUse; -begin - with TVRMLUse.CreateOwned(FCurrentNode) do - begin - name := 'Use'; - Value := ReadToken; - end; -end; - -procedure TVRMLParser.Parse(Text: String); -var - token: String; -begin - FTokens := CreateVRMLTokenList(Text); - FCursor := 0; - FCurrentNode := FRootNode; - try - repeat - token := ReadToken; - if token = 'def' then - ReadDef - else if (token = 'group') or (token = 'switch') then - ReadGroup - else if token = 'separator' then - ReadSeparator - else if token = 'use' then - ReadUse - else if token = 'shapehints' then - ReadShapeHints - else if token = 'transform' then - ReadTransform - else if token = 'material' then - ReadMaterial - else if token = 'coordinate3' then - ReadCoordinate3 - else if token = 'indexedfaceset' then - ReadIndexedFaceSet - else - ReadUnknown(token); - until FCursor >= FTokens.Count; - finally - FTokens.Free; - end; -end; - -end. diff --git a/Sourcex/Formatx.VfsPAK.pas b/Sourcex/Formatx.VfsPAK.pas deleted file mode 100644 index 8d916f52..00000000 --- a/Sourcex/Formatx.VfsPAK.pas +++ /dev/null @@ -1,472 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.VfsPAK; -(* - Support-code for loading files from Quake II PAK Files. - When instance is created all LoadFromFile methods using - GXS.ApplicationFileIO mechanism will be pointed into PAK file. - You can change current PAK file by ActivePak variable. -*) -interface - -{$I GLScene.Defines.inc} - -uses - System.Classes, - System.Contnrs, - System.SysUtils, - GXS.ApplicationFileIO, - GLScene.Strings; - -const - SIGN = 'PACK'; // Signature for uncompressed - raw pak. - SIGN_COMPRESSED = 'PACZ'; // Signature for compressed pak. - -type - - TZCompressedMode = (Good, Fast, Auto, None); - - TPakHeader = record - Signature: array [0 .. 3] of AnsiChar; - DirOffset: integer; - DirLength: integer; - end; - - TFileSection = record - FileName: array [0 .. 119] of AnsiChar; - FilePos: integer; - FileLength: integer; - end; - - TgxVfsPAK = class(TComponent) - private - FPakFiles: TStringList; - FHeader: TPakHeader; - FHeaderList: array of TPakHeader; - FStream: TFileStream; - FStreamList: TObjectList; - FFiles: TStrings; - FFilesLists: TObjectList; - FFileName: string; - FCompressionLevel: TZCompressedMode; - FCompressed: Boolean; - function GetFileCount: integer; - procedure MakeFileList; - function GetStreamNumber: integer; - procedure SetStreamNumber(i: integer); - public - property PakFiles: TStringList read FPakFiles; - property Files: TStrings read FFiles; - property ActivePakNum: integer read GetStreamNumber write SetStreamNumber; - property FileCount: integer Read GetFileCount; - property PakFileName: string Read FFileName; - property Compressed: Boolean read FCompressed; - property CompressionLevel: TZCompressedMode read FCompressionLevel; - constructor Create(AOwner: TComponent); overload; override; - constructor Create(AOwner: TComponent; const CbrMode: TZCompressedMode); - reintroduce; overload; - destructor Destroy; override; - // for Mode value search Delphi Help for "File open mode constants" - procedure LoadFromFile(FileName: string; Mode: word); - procedure ClearPakFiles; - function FileExists(FileName: string): Boolean; - function GetFile(index: integer): TStream; overload; - function GetFile(FileName: string): TStream; overload; - function GetFileSize(index: integer): integer; overload; - function GetFileSize(FileName: string): integer; overload; - procedure AddFromStream(FileName, Path: string; F: TStream); - procedure AddFromFile(FileName, Path: string); - procedure AddEmptyFile(FileName, Path: string); - procedure RemoveFile(index: integer); overload; - procedure RemoveFile(FileName: string); overload; - procedure Extract(index: integer; NewName: string); overload; - procedure Extract(FileName, NewName: string); overload; - end; - -function PAKCreateFileStream(const FileName: string; Mode: word): TStream; -function PAKFileStreamExists(const FileName: string): Boolean; - -var - ActiveVfsPAK: TgxVfsPAK; - -// =================================================================== -implementation -// =================================================================== - -var - Dir: TFileSection; - -function BackToSlash(s: string): string; -var - i: integer; -begin - SetLength(Result, Length(s)); - for i := 1 to Length(s) do - if s[i] = '\' then - Result[i] := '/' - else - Result[i] := s[i]; -end; - -function PAKCreateFileStream(const FileName: string; Mode: word): TStream; -var - i: integer; -begin - with ActiveVfsPAK do - for i := FStreamList.Count - 1 downto 0 do - begin - FFiles := TStrings(FFilesLists[i]); - if FileExists(BackToSlash(FileName)) then - begin - FHeader := FHeaderList[i]; - FStream := TFileStream(FStreamList[i]); - Result := GetFile(BackToSlash(FileName)); - Exit; - end - else - begin - if FileExists(FileName) then - begin - Result := TFileStream.Create(FileName, fmOpenReadWrite or - fmShareDenyWrite); - Exit; - end - else - begin - Result := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite); - Exit; - end; - end; - end; - if FileExists(FileName) then - begin - Result := TFileStream.Create(FileName, fmOpenReadWrite or fmShareDenyWrite); - Exit; - end - else - begin - Result := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite); - Exit; - end; - - Result := nil; -end; - -function PAKFileStreamExists(const FileName: string): Boolean; -var - i: integer; -begin - with ActiveVfsPAK do - for i := 0 to FStreamList.Count - 1 do - begin - FFiles := TStrings(FFilesLists[i]); - if FileExists(BackToSlash(FileName)) then - begin - Result := True; - Exit; - end; - end; - Result := FileExists(FileName); -end; - -//------------------------------ -// TgxVfsPAK -//------------------------------ - -function TgxVfsPAK.GetStreamNumber: integer; -begin - Result := FStreamList.IndexOf(FStream); -end; - -procedure TgxVfsPAK.SetStreamNumber(i: integer); -begin - FStream := TFileStream(FStreamList[i]); -end; - -constructor TgxVfsPAK.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FPakFiles := TStringList.Create; - FStreamList := TObjectList.Create(True); - FFilesLists := TObjectList.Create(True); - ActiveVfsPAK := Self; - vGXAFIOCreateFileStream := PAKCreateFileStream; - vGXAFIOFileStreamExists := PAKFileStreamExists; - FCompressionLevel := None; - FCompressed := False; -end; - -constructor TgxVfsPAK.Create(AOwner: TComponent; - const CbrMode: TZCompressedMode); -begin - Self.Create(AOwner); - FCompressionLevel := None; - FCompressed := FCompressionLevel <> None; -end; - -destructor TgxVfsPAK.Destroy; -begin - vGXAFIOCreateFileStream := nil; - vGXAFIOFileStreamExists := nil; - SetLength(FHeaderList, 0); - FPakFiles.Free; - // Objects are automatically freed by TObjectList - FStreamList.Free; - FFilesLists.Free; - ActiveVfsPAK := nil; - inherited Destroy; -end; - -function TgxVfsPAK.GetFileCount: integer; -begin - Result := FHeader.DirLength div SizeOf(TFileSection); -end; - -procedure TgxVfsPAK.MakeFileList; -var - i: integer; -begin - FStream.Seek(FHeader.DirOffset, soFromBeginning); - FFiles.Clear; - for i := 0 to FileCount - 1 do - begin - FStream.ReadBuffer(Dir, SizeOf(TFileSection)); - FFiles.Add(string(Dir.FileName)); - end; -end; - -procedure TgxVfsPAK.LoadFromFile(FileName: string; Mode: word); -var - l: integer; -begin - FFileName := FileName; - FPakFiles.Clear; - FPakFiles.Add(FileName); - FFiles := TStringList.Create; - FStream := TFileStream.Create(FileName, Mode); - if FStream.Size = 0 then - begin - if FCompressed then - FHeader.Signature := SIGN_COMPRESSED - else - FHeader.Signature := SIGN; - FHeader.DirOffset := SizeOf(TPakHeader); - FHeader.DirLength := 0; - if FHeader.Signature = SIGN_COMPRESSED then - begin - FStream.Free; - raise Exception.Create - (FileName + - ' - This is a compressed PAK file. This version of software does not support Compressed Pak files.'); - Exit; - end; - FStream.WriteBuffer(FHeader, SizeOf(TPakHeader)); - FStream.Position := 0; - end; - FStream.ReadBuffer(FHeader, SizeOf(TPakHeader)); - if (FHeader.Signature <> SIGN) and (FHeader.Signature <> SIGN_COMPRESSED) then - begin - FStream.Free; - raise Exception.Create(FileName + ' - This is not PAK file'); - Exit; - end; - - // Set the compression flag property. - FCompressed := FHeader.Signature = SIGN_COMPRESSED; - if FCompressed then - begin - FStream.Free; - raise Exception.Create - (FileName + - ' - This is a compressed PAK file. This version of software does not support Compressed Pak files.'); - Exit; - end; - - if FileCount <> 0 then - MakeFileList; - l := Length(FHeaderList); - SetLength(FHeaderList, l + 1); - FHeaderList[l] := FHeader; - FFilesLists.Add(FFiles); - FStreamList.Add(FStream); -end; - -procedure TgxVfsPAK.ClearPakFiles; -begin - SetLength(FHeaderList, 0); - FPakFiles.Clear; - // Objects are automatically freed by TObjectList - FStreamList.Clear; - FFilesLists.Clear; - ActiveVfsPAK := nil; -end; - -function TgxVfsPAK.GetFile(index: integer): TStream; -begin - FStream.Seek(FHeader.DirOffset + SizeOf(TFileSection) * index, - soFromBeginning); - FStream.Read(Dir, SizeOf(TFileSection)); - FStream.Seek(Dir.FilePos, soFromBeginning); - Result := TMemoryStream.Create; - Result.CopyFrom(FStream, Dir.FileLength); - Result.Position := 0; -end; - -function TgxVfsPAK.FileExists(FileName: string): Boolean; -begin - Result := (FFiles.IndexOf(FileName) > -1); -end; - -function TgxVfsPAK.GetFile(FileName: string): TStream; -begin - Result := nil; - if Self.FileExists(FileName) then - Result := GetFile(FFiles.IndexOf(FileName)); -end; - -function TgxVfsPAK.GetFileSize(index: integer): integer; -begin - FStream.Seek(FHeader.DirOffset + SizeOf(TFileSection) * index, - soFromBeginning); - FStream.Read(Dir, SizeOf(Dir)); - Result := Dir.FileLength; -end; - -function TgxVfsPAK.GetFileSize(FileName: string): integer; -begin - Result := -1; - if Self.FileExists(FileName) then - Result := GetFileSize(FFiles.IndexOf(FileName)); -end; - -{$WARNINGS OFF} - -procedure TgxVfsPAK.AddFromStream(FileName, Path: string; F: TStream); -var - Temp: TMemoryStream; -begin - FStream.Position := FHeader.DirOffset; - if FHeader.DirLength > 0 then - begin - Temp := TMemoryStream.Create; - Temp.CopyFrom(FStream, FHeader.DirLength); - Temp.Position := 0; - FStream.Position := FHeader.DirOffset; - end; - Dir.FilePos := FHeader.DirOffset; - - Dir.FileLength := F.Size; - FStream.CopyFrom(F, 0); - - FHeader.DirOffset := FStream.Position; - if FHeader.DirLength > 0 then - begin - FStream.CopyFrom(Temp, 0); - Temp.Free; - end; - StrPCopy(Dir.FileName, Path + ExtractFileName(FileName)); - FStream.WriteBuffer(Dir, SizeOf(TFileSection)); - FHeader.DirLength := FHeader.DirLength + SizeOf(TFileSection); - FStream.Position := 0; - FStream.WriteBuffer(FHeader, SizeOf(TPakHeader)); - FFiles.Add(Dir.FileName); -end; - -{$WARNINGS ON} - -procedure TgxVfsPAK.AddFromFile(FileName, Path: string); -var - F: TFileStream; -begin - if not FileExists(FileName) then - Exit; - F := TFileStream.Create(FileName, fmOpenRead); - try - AddFromStream(FileName, Path, F); - finally - F.Free; - end; -end; - -procedure TgxVfsPAK.AddEmptyFile(FileName, Path: string); -var - F: TMemoryStream; -begin - F := TMemoryStream.Create; - try - AddFromStream(FileName, Path, F); - finally - F.Free; - end; -end; - -procedure TgxVfsPAK.RemoveFile(index: integer); -var - Temp: TMemoryStream; - i: integer; - F: TFileSection; -begin - Temp := TMemoryStream.Create; - FStream.Seek(FHeader.DirOffset + SizeOf(TFileSection) * index, - soFromBeginning); - FStream.ReadBuffer(Dir, SizeOf(TFileSection)); - FStream.Seek(Dir.FilePos + Dir.FileLength, soFromBeginning); - Temp.CopyFrom(FStream, FStream.Size - FStream.Position); - FStream.Position := Dir.FilePos; - FStream.CopyFrom(Temp, 0); - FHeader.DirOffset := FHeader.DirOffset - Dir.FileLength; - Temp.Clear; - for i := 0 to FileCount - 1 do - if i > index then - begin - FStream.Seek(FHeader.DirOffset + SizeOf(TFileSection) * i, - soFromBeginning); - FStream.ReadBuffer(F, SizeOf(TFileSection)); - FStream.Position := FStream.Position - SizeOf(TFileSection); - F.FilePos := F.FilePos - Dir.FileLength; - FStream.WriteBuffer(F, SizeOf(TFileSection)); - end; - - i := FHeader.DirOffset + SizeOf(TFileSection) * index; - FStream.Position := i + SizeOf(TFileSection); - if FStream.Position < FStream.Size then - begin - Temp.CopyFrom(FStream, FStream.Size - FStream.Position); - FStream.Position := i; - FStream.CopyFrom(Temp, 0); - end; - Temp.Free; - FHeader.DirLength := FHeader.DirLength - SizeOf(TFileSection); - FStream.Position := 0; - FStream.WriteBuffer(FHeader, SizeOf(TPakHeader)); - FStream.Size := FStream.Size - Dir.FileLength - SizeOf(TFileSection); - MakeFileList; -end; - -procedure TgxVfsPAK.RemoveFile(FileName: string); -begin - if Self.FileExists(FileName) then - RemoveFile(FFiles.IndexOf(FileName)); -end; - -procedure TgxVfsPAK.Extract(index: integer; NewName: string); -var - s: TFileStream; -begin - if NewName = '' then - Exit; - if (index < 0) or (index >= FileCount) then - Exit; - s := TFileStream.Create(NewName, fmCreate); - s.CopyFrom(GetFile(index), 0); - s.Free; -end; - -procedure TgxVfsPAK.Extract(FileName, NewName: string); -begin - if Self.FileExists(FileName) then - Extract(FFiles.IndexOf(FileName), NewName); -end; - -end. diff --git a/Sourcex/Formatx.X.pas b/Sourcex/Formatx.X.pas deleted file mode 100644 index 6c0686ce..00000000 --- a/Sourcex/Formatx.X.pas +++ /dev/null @@ -1,693 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.X; - -(* Simple X format support for Microsoft's favorite format *) - -interface - -{$I GLScene.Defines.inc} - -uses - System.Classes, - System.SysUtils, - - GLScene.Strings, - - GLScene.VectorTypes, - GLScene.VectorGeometry, - GLScene.VectorLists, - GLScene.PersistentClasses; - -type - TDXNode = class; - - TDXFileHeader = record - Magic: array [0 .. 3] of AnsiChar; - Major: array [0 .. 1] of AnsiChar; - Minor: array [0 .. 1] of AnsiChar; - FileType: array [0 .. 3] of AnsiChar; - FloatType: array [0 .. 3] of AnsiChar; - end; - - TDXNode = class(TList) - private - FName, FTypeName: String; - FOwner: TDXNode; - function GetItem(index: Integer): TDXNode; - public - constructor CreateOwned(AOwner: TDXNode); - constructor Create; virtual; - procedure Clear; override; - property Name: String read FName write FName; - property TypeName: String read FTypeName write FTypeName; - property Owner: TDXNode read FOwner; - property Items[index: Integer]: TDXNode read GetItem; - end; - - TDXMaterialList = class; - - TDXMaterial = class(TGPersistentObject) - private - FDiffuse: TVector4f; - FSpecPower: Single; - FSpecular, FEmissive: TVector3f; - FTexture: String; - public - constructor CreateOwned(AOwner: TDXMaterialList); - property Diffuse: TVector4f read FDiffuse write FDiffuse; - property SpecPower: Single read FSpecPower write FSpecPower; - property Specular: TVector3f read FSpecular write FSpecular; - property Emissive: TVector3f read FEmissive write FEmissive; - property Texture: String read FTexture write FTexture; - end; - - TDXMaterialList = class(TDXNode) - private - function GetMaterial(index: Integer): TDXMaterial; - public - property Items[index: Integer]: TDXMaterial read GetMaterial; - end; - - TDXFrame = class(TDXNode) - private - FMatrix: TMatrix4f; - public - constructor Create; override; - function GlobalMatrix: TMatrix4f; - property Matrix: TMatrix4f read FMatrix write FMatrix; - end; - - TDXMesh = class(TDXNode) - private - FVertices, FNormals, FTexCoords: TGAffineVectorList; - FVertexIndices, FNormalIndices, FMaterialIndices, FVertCountIndices - : TGIntegerList; - FMaterialList: TDXMaterialList; - public - constructor Create; override; - destructor Destroy; override; - property Vertices: TGAffineVectorList read FVertices; - property Normals: TGAffineVectorList read FNormals; - property TexCoords: TGAffineVectorList read FTexCoords; - property VertexIndices: TGIntegerList read FVertexIndices; - property NormalIndices: TGIntegerList read FNormalIndices; - property MaterialIndices: TGIntegerList read FMaterialIndices; - property VertCountIndices: TGIntegerList read FVertCountIndices; - property MaterialList: TDXMaterialList read FMaterialList; - end; - - TDXFile = class - private - FRootNode: TDXNode; - FHeader: TDXFileHeader; - protected - procedure ParseText(Stream: TStream); - procedure ParseBinary(Stream: TStream); - public - constructor Create; - destructor Destroy; override; - procedure LoadFromStream(Stream: TStream); - // procedure SaveToStream(Stream : TStream); - property Header: TDXFileHeader read FHeader; - property RootNode: TDXNode read FRootNode; - end; - -// ---------------------------------------------------------------------- -implementation -// ---------------------------------------------------------------------- - -// ---------------------------------------------------------------------- -// Text parsing functions -// ---------------------------------------------------------------------- - -procedure RemoveComments(Text: TStringList); -var - i, comment: Integer; -begin - for i := 0 to Text.Count - 1 do - begin - comment := Pos('//', Text[i]); - if comment > 0 then - Text[i] := Copy(Text[i], 0, comment - 1); - comment := Pos('#', Text[i]); - if comment > 0 then - Text[i] := Copy(Text[i], 0, comment - 1); - end; -end; - - -// ---------------------------------------------------------------------- -// TDXFile -// ---------------------------------------------------------------------- - -constructor TDXFile.Create; -begin - FRootNode := TDXNode.Create; -end; - -destructor TDXFile.Destroy; -begin - FRootNode.Free; - inherited; -end; - -procedure TDXFile.LoadFromStream(Stream: TStream); -begin - Stream.Read(FHeader, SizeOf(TDXFileHeader)); - Assert(Header.Magic = 'xof ', 'Invalid DirectX file'); - - if Header.FileType = 'txt ' then - ParseText(Stream) - else if Header.FileType = 'bin ' then - raise Exception.Create('FileX error, "bin" filetype not supported') - else if Header.FileType = 'tzip' then - raise Exception.Create('FileX error, "tzip" filetype not supported') - else if Header.FileType = 'bzip' then - raise Exception.Create('FileX error, "bzip" filetype not supported'); - -end; - -procedure TDXFile.ParseBinary(Stream: TStream); -begin - // To-do -end; - -procedure TDXFile.ParseText(Stream: TStream); -var - XText, TempBuffer: TStringList; - Cursor: Integer; - Buffer: String; - - function ContainsColon(Buffer: String): Boolean; - begin - Result := Pos(';', Buffer) > 0; - end; - - function ContainsBegin(Buffer: String): Boolean; - begin - Result := Pos('{', Buffer) > 0; - end; - - function ContainsEnd(Buffer: String): Boolean; - begin - Result := Pos('}', Buffer) > 0; - end; - - function ReadString: String; - begin - if Cursor < XText.Count then - Result := XText[Cursor] - else - Result := ''; - Inc(Cursor); - end; - - function GetNodeData(var NodeType, NodeName: String): Boolean; - begin - NodeType := ''; - NodeName := ''; - Result := False; - if Cursor < 3 then - exit; - - NodeType := XText[Cursor - 3]; - NodeName := XText[Cursor - 2]; - - if ContainsBegin(NodeType) or ContainsEnd(NodeType) or - ContainsColon(NodeType) then - begin - NodeType := NodeName; - NodeName := ''; - end; - - NodeType := LowerCase(NodeType); - end; - - function ReadInteger: Integer; - var - str: String; - begin - str := ReadString; - - if ContainsColon(str) then - str := StringReplace(str, ';', '', [rfReplaceAll]); - if ContainsBegin(str) then - str := StringReplace(str, '{', '', [rfReplaceAll]); - if ContainsEnd(str) then - str := StringReplace(str, '}', '', [rfReplaceAll]); - - Result := StrToInt(str); - end; - - function ReadSingle: Single; - var - str: String; - begin - str := ReadString; - - if ContainsColon(str) then - str := StringReplace(str, ';', '', [rfReplaceAll]); - if ContainsBegin(str) then - str := StringReplace(str, '{', '', [rfReplaceAll]); - if ContainsEnd(str) then - str := StringReplace(str, '}', '', [rfReplaceAll]); - - Result := StrToFloatDef(str, 0); - end; - - function ReadMatrix: TMatrix4f; - var - i, j: Integer; - begin - try - for j := 0 to 3 do - for i := 0 to 3 do - Result.V[i].V[j] := ReadSingle; - except - on E: Exception do - begin - Result := IdentityHMGMatrix; - end; - end; - end; - - function ReadVector3f: TAffineVector; - var - str: String; - begin - str := ReadString; - str := StringReplace(str, ';', ' ', [rfReplaceAll]); - TempBuffer.CommaText := str; - if TempBuffer.Count > 1 then - begin - Result.X := StrToFloatDef(TempBuffer[0], 0); - Result.Y := StrToFloatDef(TempBuffer[1], 0); - Result.Z := StrToFloatDef(TempBuffer[2], 0); - end - else - begin - Result.X := StrToFloatDef(TempBuffer[0], 0); - Result.Y := ReadSingle; - Result.Z := ReadSingle; - end; - end; - - function ReadVector4f: TVector4f; - var - str: String; - begin - str := ReadString; - str := StringReplace(str, ';', ' ', [rfReplaceAll]); - TempBuffer.CommaText := str; - if TempBuffer.Count > 1 then - begin - Result.X := StrToFloatDef(TempBuffer[0], 0); - Result.Y := StrToFloatDef(TempBuffer[1], 0); - Result.Z := StrToFloatDef(TempBuffer[2], 0); - Result.W := StrToFloatDef(TempBuffer[3], 0); - end - else - begin - Result.X := StrToFloatDef(TempBuffer[0], 0); - Result.Y := ReadSingle; - Result.Z := ReadSingle; - Result.W := ReadSingle; - end; - end; - - function ReadTexCoord: TAffineVector; - var - str: String; - begin - str := ReadString; - str := StringReplace(str, ';', ' ', [rfReplaceAll]); - TempBuffer.CommaText := str; - if TempBuffer.Count > 1 then - begin - Result.X := StrToFloatDef(TempBuffer[0], 0); - Result.Y := StrToFloatDef(TempBuffer[1], 0); - end - else - begin - Result.X := StrToFloatDef(TempBuffer[0], 0); - Result.Y := ReadSingle; - end; - Result.Z := 0; - end; - - procedure ReadMeshVectors(VectorList: TGAffineVectorList); - var - i, NumVectors: Integer; - begin - NumVectors := ReadInteger; - for i := 0 to NumVectors - 1 do - VectorList.Add(ReadVector3f); - end; - - procedure ReadMeshIndices(IndexList: TGIntegerList; - VertCountIndices: TGIntegerList = nil); - var - str: String; - i, j, NumFaces, NumIndices, jStart: Integer; - Indices: array of Integer; - begin - NumFaces := ReadInteger; - for i := 0 to NumFaces - 1 do - begin - str := ReadString; - str := StringReplace(str, ';', ' ', [rfReplaceAll]); - TempBuffer.CommaText := str; - NumIndices := StrToInt(TempBuffer[0]); - SetLength(Indices, NumIndices); - jStart := 0; - if TempBuffer.Count > 1 then - begin - Indices[0] := StrToInt(TempBuffer[1]); - jStart := 1; - end; - for j := jStart to NumIndices - 1 do - Indices[j] := ReadInteger; - case NumIndices of - 3: - begin - IndexList.Add(Indices[0], Indices[1], Indices[2]); - if Assigned(VertCountIndices) then - VertCountIndices.Add(3); - end; - 4: - begin - IndexList.Add(Indices[0], Indices[1], Indices[2]); - IndexList.Add(Indices[0], Indices[2], Indices[3]); - if Assigned(VertCountIndices) then - VertCountIndices.Add(6); - end; - end; - SetLength(Indices, 0); - end; - end; - - procedure ReadTexCoords(VectorList: TGAffineVectorList); - var - i, NumVectors: Integer; - begin - NumVectors := ReadInteger; - for i := 0 to NumVectors - 1 do - VectorList.Add(ReadTexCoord); - end; - - procedure ReadMeshVertices(Mesh: TDXMesh); - begin - ReadMeshVectors(Mesh.Vertices); - ReadMeshIndices(Mesh.VertexIndices, Mesh.VertCountIndices); - end; - - procedure ReadMeshNormals(Mesh: TDXMesh); - begin - ReadMeshVectors(Mesh.Normals); - ReadMeshIndices(Mesh.NormalIndices); - end; - - procedure ReadMeshTexCoords(Mesh: TDXMesh); - begin - ReadTexCoords(Mesh.TexCoords); - end; - - procedure ReadMeshMaterialList(Mesh: TDXMesh); - var - i, { NumMaterials, } NumIndices: Integer; - begin - { NumMaterials:= } ReadInteger; - NumIndices := ReadInteger; - for i := 0 to NumIndices - 1 do - Mesh.MaterialIndices.Add(ReadInteger); - end; - - procedure ReadMeshMaterial(Mesh: TDXMesh); - begin - with TDXMaterial.CreateOwned(Mesh.MaterialList) do - begin - Diffuse := ReadVector4f; - SpecPower := ReadSingle; - Specular := ReadVector3f; - Emissive := ReadVector3f; - end; - end; - - procedure ReadTextureFilename(Mesh: TDXMesh); - var - str: String; - begin - if Mesh.MaterialList.Count > 0 then - begin - str := ReadString; - str := StringReplace(str, '"', '', [rfReplaceAll]); - str := StringReplace(str, ';', '', [rfReplaceAll]); - str := Trim(str); - Mesh.MaterialList.Items[Mesh.MaterialList.Count - 1].Texture := str; - end; - end; - - procedure ReadStruct(ParentNode: TDXNode); - var - Buffer, NodeType, NodeName: String; - Loop: Boolean; - NewNode: TDXNode; - begin - Loop := True; - while Loop do - begin - Buffer := ReadString; - if Cursor > XText.Count - 1 then - break; - if ContainsEnd(Buffer) then - Loop := False - else if ContainsBegin(Buffer) then - begin - GetNodeData(NodeType, NodeName); - NewNode := nil; - - // Frame - if NodeType = 'frame' then - begin - NewNode := TDXFrame.CreateOwned(ParentNode); - ReadStruct(NewNode); - - // Frame transform matrix - end - else if NodeType = 'frametransformmatrix' then - begin - if ParentNode is TDXFrame then - TDXFrame(ParentNode).Matrix := ReadMatrix; - ReadStruct(ParentNode); - - // Mesh - end - else if NodeType = 'mesh' then - begin - NewNode := TDXMesh.CreateOwned(ParentNode); - ReadMeshVertices(TDXMesh(NewNode)); - ReadStruct(NewNode); - - // Mesh normals - end - else if NodeType = 'meshnormals' then - begin - if ParentNode is TDXMesh then - ReadMeshNormals(TDXMesh(ParentNode)); - ReadStruct(ParentNode); - - // Mesh texture coords - end - else if NodeType = 'meshtexturecoords' then - begin - if ParentNode is TDXMesh then - ReadMeshTexCoords(TDXMesh(ParentNode)); - ReadStruct(ParentNode); - - // Mesh material list - end - else if NodeType = 'meshmateriallist' then - begin - if ParentNode is TDXMesh then - ReadMeshMaterialList(TDXMesh(ParentNode)); - ReadStruct(ParentNode); - - // Mesh material - end - else if NodeType = 'material' then - begin - if ParentNode is TDXMesh then - ReadMeshMaterial(TDXMesh(ParentNode)); - ReadStruct(ParentNode); - - // Material texture filename - end - else if NodeType = 'texturefilename' then - begin - if ParentNode is TDXMesh then - ReadTextureFilename(TDXMesh(ParentNode)); - ReadStruct(ParentNode); - - // Unknown type - end - else - begin - // NewNode:=TDXNode.CreateOwned(ParentNode); - // NodeType:='*'+NodeType; - // ReadStruct(NewNode); - ReadStruct(ParentNode); - end; - - if Assigned(NewNode) then - begin - NewNode.TypeName := NodeType; - NewNode.Name := NodeName; - end; - end; - end; - end; - -begin - XText := TStringList.Create; - TempBuffer := TStringList.Create; - XText.LoadFromStream(Stream); - - // Remove comments and white spaces - RemoveComments(XText); - XText.CommaText := XText.Text; - - // Fix embedded open braces - Cursor := 0; - while Cursor < XText.Count - 1 do - begin - Buffer := ReadString; - if Pos('{', Buffer) > 1 then - begin - XText[Cursor - 1] := Copy(Buffer, 0, Pos('{', Buffer) - 1); - XText.Insert(Cursor, '{'); - end; - end; - - XText.SaveToFile('XText_dump.txt'); - - // Start parsing - Cursor := 0; - while Cursor < XText.Count - 1 do - ReadStruct(RootNode); - - TempBuffer.Free; - XText.Free; -end; - - -// ---------------------------------------------------------------------- -// TDXMaterialList -// ---------------------------------------------------------------------- - -function TDXMaterialList.GetMaterial(index: Integer): TDXMaterial; -begin - Result := TDXMaterial(Get(index)); -end; - - -// ---------------------------------------------------------------------- -// TDXMesh -// ---------------------------------------------------------------------- - -constructor TDXMesh.Create; -begin - inherited; - - FVertices := TGAffineVectorList.Create; - FNormals := TGAffineVectorList.Create; - FTexCoords := TGAffineVectorList.Create; - FVertexIndices := TGIntegerList.Create; - FNormalIndices := TGIntegerList.Create; - FMaterialIndices := TGIntegerList.Create; - FVertCountIndices := TGIntegerList.Create; - FMaterialList := TDXMaterialList.Create; -end; - -destructor TDXMesh.Destroy; -begin - FVertices.Free; - FNormals.Free; - FTexCoords.Free; - FVertexIndices.Free; - FNormalIndices.Free; - FMaterialIndices.Free; - FVertCountIndices.Free; - FMaterialList.Free; - - inherited; -end; - - -// ---------------------------------------------------------------------- -// TDXNode -// ---------------------------------------------------------------------- - -constructor TDXNode.Create; -begin - // Virtual -end; - -// CreateOwned -// -constructor TDXNode.CreateOwned(AOwner: TDXNode); -begin - FOwner := AOwner; - Create; - if Assigned(FOwner) then - FOwner.Add(Self); -end; - -function TDXNode.GetItem(index: Integer): TDXNode; -begin - Result := TDXNode(Get(index)); -end; - -procedure TDXNode.Clear; -var - i: Integer; -begin - for i := 0 to Count - 1 do - Items[i].Free; - - inherited; -end; - - -// ---------------------------------------------------------------------- -// TDXFrame -// ---------------------------------------------------------------------- - -constructor TDXFrame.Create; -begin - inherited; - FMatrix := IdentityHMGMatrix; -end; - -function TDXFrame.GlobalMatrix: TMatrix4f; -begin - if Owner is TDXFrame then - Result := MatrixMultiply(TDXFrame(Owner).GlobalMatrix, FMatrix) - else - Result := FMatrix; -end; - - -// ---------------------------------------------------------------------- -// TDXMaterial -// ---------------------------------------------------------------------- - -constructor TDXMaterial.CreateOwned(AOwner: TDXMaterialList); -begin - Create; - if Assigned(AOwner) then - AOwner.Add(Self); -end; - -end. diff --git a/Sourcex/Formatx.m3DS.pas b/Sourcex/Formatx.m3DS.pas deleted file mode 100644 index 8f60a2e7..00000000 --- a/Sourcex/Formatx.m3DS.pas +++ /dev/null @@ -1,2970 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.m3DS; - -(* - Implementation of an universal 3DS file reader (and writer). This is the main file of the - 3DS import library. Currently only loading of 3DS files (Mesh files * .3ds, Project files * .prj - and Material files * .mli) is supported. - Note: Be careful when using LoadFromStream, because chunk data (in opposition to the - chunk structure) will be loaded on demand, i.e. when it is needed. Therefore the - passed stream must be available during load. - LoadFromStream does not make a copy of the passed stream, but keeps a reference - which must stay valid either during the entire lifetime of TFile3DS or at least - 'til all chunks have been read (by accessing them all once). -*) - -interface - -{$I GLScene.Defines.inc} -{$ALIGN ON} -{$MINENUMSIZE 4} -{$RANGECHECKS OFF} - -uses - System.Classes, - System.SysUtils, - - Formatx.m3DSTypes; - -type - TFile3DS = class; - - TLoadProgress = procedure(StreamPos, StreamMax: Longint) of object; - // Progress : TProgressBar; - // - // This allows to use something like that: - // - // procedure TSomeForm.CreateForm(Sender: TObject); - // begin - // .... - // 3DSReader.OnProgress := LoadProgress; - // .... - // end; - - // procedure TSomeForm.LoadProgress(StreamPos, StreamMax : Longint); - // begin - // if StreamMax <> 0 then - // Progress.MaxValue := StreamMax; - // Progress.Position := StreamPos; - // end; - - // ----- support classes ----- - // All structure data of a 3DS file is actually held in TFile3DS.FDatabase as a - // tree with lots of links across the various chunks. - // For convinience and speed the data of the chunks is collected into some - // special structures (FMaterialList etc.) and presented to the user - // by the following helper classes: - - TMaterialList = class - private - FOwner: TFile3DS; - FLocalList: TList; - function GetCount: Integer; - function GetMaterial(Index: Integer): PMaterial3DS; - function GetMaterialByName(const Name: String): PMaterial3DS; - public - constructor Create(AOwner: TFile3DS); virtual; - destructor Destroy; override; - procedure ClearList; - property Count: Integer read GetCount; - property Material[Index: Integer]: PMaterial3DS read GetMaterial; default; - property MaterialByName[const Name: String]: PMaterial3DS read GetMaterialByName; - end; - - TObjectList = class - private - FOwner: TFile3DS; - FMeshList, - FOmniList, - FSpotList, - FCameraList: TList; - function GetCamera(Index: Integer): PCamera3DS; - function GetCamCount: Integer; - function GetMeshObjectCount: Integer; - function GetMesh(Index: Integer): PMesh3DS; - function GetOmniCount: Integer; - function GetOmniLight(Index: Integer): PLight3DS; - function GetSpotCount: Integer; - function GetSpotLight(Index: Integer): PLight3DS; - public - constructor Create(AOwner: TFile3DS); virtual; - destructor Destroy; override; - procedure ClearLists; - property CameraCount: Integer read GetCamCount; - property MeshCount: Integer read GetMeshObjectCount; - property OmniLightCount: Integer read GetOmniCount; - property SpotLightCount: Integer read GetSpotCount; - property Mesh[Index: Integer]: PMesh3DS read GetMesh; - property Camera[Index: Integer]: PCamera3DS read GetCamera; - property OmniLight[Index: Integer]: PLight3DS read GetOmniLight; - property SpotLight[Index: Integer]: PLight3DS read GetSpotLight; - end; - - TKeyFramer = class - private - FOwner: TFile3DS; - FMeshMotionList, - FOmniMotionList, - FSpotMotionList, - FCameraMotionList: TList; - FAmbientMotion: PKFAmbient3DS; - function GetAmbientMotion: PKFAmbient3DS; - function GetCameraMotion(Index: Integer): PKFCamera3DS; - function GetCamMotionCount: Integer; - function GetKFSets: TKFSets3DS; - function GetMeshMotionCount: Integer; - function GetMeshMotion(Index: Integer): PKFMesh3DS; - function GetOmniMotionCount: Integer; - function GetOmniLightMotion(Index: Integer): PKFOmni3DS; - function GetSpotMotionCount: Integer; - function GetSpotLightMotion(Index: Integer): PKFSpot3DS; - public - constructor Create(AOwner: TFile3DS); virtual; - destructor Destroy; override; - procedure ClearLists; - property AmbientLightMotion: PKFAmbient3DS read GetAmbientMotion; - property CameraMotionCount: Integer read GetCamMotionCount; - property MeshMotionCount: Integer read GetMeshMotionCount; - property OmniLightMotionCount: Integer read GetOmniMotionCount; - property SpotLightMotionCount: Integer read GetSpotMotionCount; - property MeshMotion[Index: Integer]: PKFMesh3DS read GetMeshMotion; default; - property CameraMotion[Index: Integer]: PKFCamera3DS read GetCameraMotion; - property OmniLightMotion[Index: Integer]: PKFOmni3DS read GetOmniLightMotion; - property Settings: TKFSets3DS read GetKFSets; - property SpotLightMotion[Index: Integer]: PKFSpot3DS read GetSpotLightMotion; - end; - - (* The main class that supplies the user with all available data - from a specific 3DS file. The data is currently read only, but the class might be - finished sometime later... *) - TFile3DS = class - private - FNodeList: PNodeList; - FDatabase: TDatabase3DS; - FStream: TStream; - FOwnStream: Boolean; - FMaterialList: TMaterialList; - FObjectList: TObjectList; - FKeyFramer: TKeyFramer; - FFileName: String; - FOnLoadProgress: TLoadProgress; - function GetAtmosphereData: TAtmosphere3DS; - function GetBackgroundData: TBackground3DS; - function GetDatabaseType: TDBType3DS; - function GetMeshSettings: TMeshSet3DS; - function GetViewportData: TViewport3DS; - function GetDatabaseRelease: TReleaseLevel; - function GetMeshRelease: TReleaseLevel; - protected - procedure AddToNodeList(Chunk: PChunk3DS); - procedure AssignParentNames; - procedure CheckListNodeIDs; - procedure CreateDatabase; - function FindNodeByID(ID: SmallInt): PNodeList; - function GetChunkNodeID(Chunk: PChunk3DS): SmallInt; - procedure InitDatabase; - function IsNode(Tag: Word): Boolean; - procedure KFAddParentName(Chunk: PChunk3DS; const Name: String3DS); - procedure MakeNode(var Node: PNodeList); - procedure ParseDatabase; - procedure ReadChildren(Parent: PChunk3DS); - procedure ReadXDataEntryChildren(Parent: PChunk3DS); - procedure ReleaseDatabase; - procedure ReleaseNodeList; - procedure ReleaseStream; - public - constructor Create; virtual; - constructor CreateFromFile(const FileName: String); virtual; - destructor Destroy; override; - procedure ClearLists; - // database methods - procedure DumpDataBase(Strings: TStrings; DumpLevel: TDumpLevel); - procedure LoadFromFile(const FileName: String); - procedure LoadFromStream(const aStream: TStream); - // basic access methods - function ReadByte: Byte; - function ReadCardinal: Cardinal; - procedure ReadChunkData(Chunk: PChunk3DS); - procedure ReadData(Size: Integer; Data: Pointer); - function ReadDouble: Double; - function ReadFace: TFace3DS; - procedure ReadHeader(var ChunkType: Word; var ChunkSize: Cardinal); - function ReadInteger: Integer; - function ReadKeyHeader: TKeyHeader3DS; - function ReadPoint: TPoint3DS; - function ReadShort: SmallInt; - function ReadSingle: Single; - function ReadString: PChar3DS; - function ReadTexVert: TTexVert3DS; - function ReadTrackHeader: TTrackHeader3DS; - function ReadWord: Word; - procedure FinishHeader(StartPos, EndPos: Cardinal); - function InitChunkData(Chunk: PChunk3DS): Pointer; - procedure SeekChild(Chunk: PChunk3DS); - procedure Skip(AValue: Integer); - procedure WriteByte(AValue: Byte); - procedure WriteCardinal(AValue: Cardinal); - procedure WriteData(Size: Integer; Data: Pointer); - procedure WriteDouble(AValue: Double); - procedure WriteFace(const F: TFace3DS); - procedure WriteFixedString(const AValue: String3DS; Len: Integer); - procedure WriteHeader(ChunkType: Word; ChunkSize: Cardinal); - procedure WriteInteger(AValue: Integer); - procedure WriteKeyHeader(const K: TKeyHeader3DS); - procedure WritePoint(const P: TPoint3DS); - procedure WriteShort(AValue: SmallInt); - procedure WriteSingle(AValue: Single); - procedure WriteString(const AValue: String3DS); - procedure WriteTexVertex(const T: TTexVert3DS); - procedure WriteTrackHeader(const T: TTrackHeader3DS); - procedure WriteWord(AValue: Word); - property Atmosphere: TAtmosphere3DS read GetAtmosphereData; - property Background: TBackground3DS read GetBackgroundData; - property DatabaseRelease: TReleaseLevel read GetDatabaseRelease; - property DatabaseType: TDBType3DS read GetDatabaseType; - property FileName: String read FFileName; - // this is only valid if loaded from a file - property KeyFramer: TKeyFramer read FKeyFramer; - property Materials: TMaterialList read FMaterialList; - property MeshRelease: TReleaseLevel read GetMeshRelease; - property MeshSettings: TMeshSet3DS read GetMeshSettings; - property Objects: TObjectList read FObjectList; - property Viewport: TViewport3DS read GetViewportData; - property OnLoadProgress: TLoadProgress read FOnLoadProgress write FOnLoadProgress; - end; - -// --------------------------------------------------------------------------------------------------------------------- -implementation -// --------------------------------------------------------------------------------------------------------------------- - -uses - Formatx.m3DSConst, - Formatx.m3DSUtils; - -function StrPasFree(P: PChar3DS): String; -begin - Result := string(StrPas(P)); - FreeMem(P); -end; - -// ----------------- TMaterialList ------------------------------------------------------------------------------------- - -constructor TMaterialList.Create(AOwner: TFile3DS); - -begin - FOwner := AOwner; - FLocalList := TList.Create; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -destructor TMaterialList.Destroy; - -begin - ClearList; - FLocalList.Free; - inherited Destroy; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TMaterialList.ClearList; - -var - I: Integer; - Mat: PMaterial3DS; - -begin - for I := 0 to FLocalList.Count - 1 do - if FLocalList[I] <> nil then - begin - Mat := FLocalList[I]; - // free structure data - ReleaseMaterial(Mat); - end; - FLocalList.Count := 0; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TMaterialList.GetCount: Integer; - -begin - if (FLocalList.Count = 0) and (FOwner.FDatabase.MatListDirty) then - FLocalList.Count := GetMaterialCount(FOwner, FOwner.FDatabase);; - Result := FLocalList.Count; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TMaterialList.GetMaterial(Index: Integer): PMaterial3DS; - -var - NewEntry: PMaterial3DS; - -begin - Result := nil; - if Count = 0 then - Exit; // force reading the list if it was modified - - if FLocalList[Index] = nil then - begin - New(NewEntry); - FillChar(NewEntry^, SizeOf(NewEntry^), 0); - NewEntry^ := GetMaterialByIndex(FOwner, FOwner.FDatabase, Index); - FLocalList[Index] := NewEntry; - end; - Result := FLocalList[Index]; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TMaterialList.GetMaterialByName(const Name: String): PMaterial3DS; - -var - Entry: PMaterial3DS; - Index: Integer; - -begin - Result := nil; - for Index := 0 to Count - 1 do - begin - Entry := GetMaterial(Index); - if Entry = nil then - Continue; - if CompareText(string(Entry.NameStr), Name) = 0 then - begin - Result := Entry; - Break; - end; - end; -end; - -// ----------------- TObjectList --------------------------------------------------------------------------------------- - -constructor TObjectList.Create(AOwner: TFile3DS); - -begin - FOwner := AOwner; - FMeshList := TList.Create; - FOmniList := TList.Create; - FSpotList := TList.Create; - FCameraList := TList.Create; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -destructor TObjectList.Destroy; - -begin - ClearLists; - FMeshList.Free; - FOmniList.Free; - FSpotList.Free; - FCameraList.Free; - inherited Destroy; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TObjectList.ClearLists; - -var - I: Integer; - -begin - for I := 0 to FMeshList.Count - 1 do - ReleaseMeshObj(FMeshList[I]); - FMeshList.Clear; - - for I := 0 to FOmniList.Count - 1 do - ReleaseLight(FOmniList[I]); - FOmniList.Clear; - - for I := 0 to FSpotList.Count - 1 do - ReleaseLight(FSpotList[I]); - FSpotList.Clear; - - for I := 0 to FCameraList.Count - 1 do - ReleaseCamera(FCameraList[I]); - FCameraList.Clear; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TObjectList.GetCamera(Index: Integer): PCamera3DS; - -var - NewEntry: PCamera3DS; - -begin - Result := nil; - if CameraCount = 0 then - Exit; // force reading the list if it was modified - - if FCameraList[Index] = nil then - begin - New(NewEntry); - FillChar(NewEntry^, SizeOf(NewEntry^), 0); - NewEntry^ := GetCameraByIndex(FOwner, FOwner.FDatabase, Index); - FCameraList[Index] := NewEntry; - end; - Result := FCameraList[Index]; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TObjectList.GetCamCount: Integer; - -begin - if FCameraList.Count = 0 then - FCameraList.Count := GetCameraCount(FOwner, FOwner.FDatabase); - Result := FCameraList.Count; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TObjectList.GetMeshObjectCount: Integer; - -begin - if FMeshList.Count = 0 then - FMeshList.Count := GetMeshCount(FOwner, FOwner.FDatabase); - Result := FMeshList.Count; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TObjectList.GetMesh(Index: Integer): PMesh3DS; - -var - NewEntry: PMesh3DS; - -begin - Result := nil; - if MeshCount = 0 then - Exit; // force reading the list if it was modified - - if FMeshList[Index] = nil then - begin - New(NewEntry); - FillChar(NewEntry^, SizeOf(NewEntry^), 0); - NewEntry^ := GetMeshByIndex(FOwner, FOwner.FDatabase, Index); - FMeshList[Index] := NewEntry; - end; - Result := FMeshList[Index]; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TObjectList.GetOmniCount: Integer; - -begin - if FOmniList.Count = 0 then - FOmniList.Count := GetOmniLightCount(FOwner, FOwner.FDatabase); - Result := FOmniList.Count; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TObjectList.GetOmniLight(Index: Integer): PLight3DS; - -var - NewEntry: PLight3DS; - -begin - Result := nil; - if OmniLightCount = 0 then - Exit; // force reading the list if it was modified - - if FOmniList[Index] = nil then - begin - New(NewEntry); - FillChar(NewEntry^, SizeOf(NewEntry^), 0); - NewEntry^ := GetOmniLightByIndex(FOwner, FOwner.FDatabase, Index); - FOmniList[Index] := NewEntry; - end; - Result := FOmniList[Index]; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TObjectList.GetSpotCount: Integer; - -begin - if FSpotList.Count = 0 then - FSpotList.Count := GetSpotLightCount(FOwner, FOwner.FDatabase); - Result := FSpotList.Count; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TObjectList.GetSpotLight(Index: Integer): PLight3DS; - -var - NewEntry: PLight3DS; - -begin - Result := nil; - if SpotLightCount = 0 then - Exit; // force reading the list if it was modified - - if FSpotList[Index] = nil then - begin - New(NewEntry); - FillChar(NewEntry^, SizeOf(NewEntry^), 0); - NewEntry^ := GetSpotLightByIndex(FOwner, FOwner.FDatabase, Index); - FSpotList[Index] := NewEntry; - end; - Result := FSpotList[Index]; -end; - -// ----------------- TKeyFramer ---------------------------------------------------------------------------------------- - -constructor TKeyFramer.Create(AOwner: TFile3DS); - -begin - FOwner := AOwner; - FMeshMotionList := TList.Create; - FOmniMotionList := TList.Create; - FSpotMotionList := TList.Create; - FCameraMotionList := TList.Create; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -destructor TKeyFramer.Destroy; - -begin - ClearLists; - FMeshMotionList.Free; - FOmniMotionList.Free; - FSpotMotionList.Free; - FCameraMotionList.Free; - inherited; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TKeyFramer.GetAmbientMotion: PKFAmbient3DS; - -begin - if FAmbientMotion = nil then - begin - New(FAmbientMotion); - FillChar(FAmbientMotion^, SizeOf(FAmbientMotion^), 0); - FAmbientMotion^ := GetAmbientLightMotion(FOwner, FOwner.FDatabase); - end; - Result := FAmbientMotion; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TKeyFramer.GetCameraMotion(Index: Integer): PKFCamera3DS; - -var - NewEntry: PKFCamera3DS; - -begin - Result := nil; - if CameraMotionCount = 0 then - Exit; // force reading the list if it was modified - - if FCameraMotionList[Index] = nil then - begin - New(NewEntry); - FillChar(NewEntry^, SizeOf(NewEntry^), 0); - NewEntry^ := GetCameraMotionByIndex(FOwner, FOwner.FDatabase, Index); - FCameraMotionList[Index] := NewEntry; - end; - Result := FCameraMotionList[Index]; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TKeyFramer.GetCamMotionCount: Integer; - -begin - if FCameraMotionList.Count = 0 then - FCameraMotionList.Count := GetCameraNodeCount(FOwner, FOwner.FDatabase); - Result := FCameraMotionList.Count; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TKeyFramer.GetKFSets: TKFSets3DS; - -begin - Result := GetKFSettings(FOwner, FOwner.FDatabase); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TKeyFramer.GetMeshMotionCount: Integer; - -begin - if FMeshMotionList.Count = 0 then - FMeshMotionList.Count := GetObjectNodeCount(FOwner, FOwner.FDatabase); - Result := FMeshMotionList.Count; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TKeyFramer.GetMeshMotion(Index: Integer): PKFMesh3DS; - -var - NewEntry: PKFMesh3DS; - -begin - Result := nil; - if MeshMotionCount = 0 then - Exit; // force reading the list if it was modified - - if FMeshMotionList[Index] = nil then - begin - New(NewEntry); - FillChar(NewEntry^, SizeOf(NewEntry^), 0); - NewEntry^ := GetObjectMotionByIndex(FOwner, FOwner.FDatabase, Index); - FMeshMotionList[Index] := NewEntry; - end; - Result := FMeshMotionList[Index]; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TKeyFramer.GetOmniMotionCount: Integer; - -begin - if FOmniMotionList.Count = 0 then - FOmniMotionList.Count := GetOmniLightNodeCount(FOwner, FOwner.FDatabase); - Result := FOmniMotionList.Count; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TKeyFramer.GetOmniLightMotion(Index: Integer): PKFOmni3DS; - -var - NewEntry: PKFOmni3DS; - -begin - Result := nil; - if OmniLightMotionCount = 0 then - Exit; // force reading the list if it was modified - - if FOmniMotionList[Index] = nil then - begin - New(NewEntry); - FillChar(NewEntry^, SizeOf(NewEntry^), 0); - NewEntry^ := GetOmniLightMotionByIndex(FOwner, FOwner.FDatabase, Index); - FOmniMotionList[Index] := NewEntry; - end; - Result := FOmniMotionList[Index]; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TKeyFramer.GetSpotMotionCount: Integer; - -begin - if FSpotMotionList.Count = 0 then - FSpotMotionList.Count := GetSpotLightNodeCount(FOwner, FOwner.FDatabase); - Result := FSpotMotionList.Count; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TKeyFramer.GetSpotLightMotion(Index: Integer): PKFSpot3DS; - -var - NewEntry: PKFSpot3DS; - -begin - Result := nil; - if SpotLightMotionCount = 0 then - Exit; // force reading the list if it was modified - - if FSpotMotionList[Index] = nil then - begin - New(NewEntry); - FillChar(NewEntry^, SizeOf(NewEntry^), 0); - NewEntry^ := GetSpotLightMotionByIndex(FOwner, FOwner.FDatabase, Index); - FSpotMotionList[Index] := NewEntry; - end; - Result := FSpotMotionList[Index]; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TKeyFramer.ClearLists; - -var - I: Integer; - -begin - for I := 0 to FMeshMotionList.Count - 1 do - ReleaseObjectMotion(FMeshMotionList[I]); - FMeshMotionList.Clear; - - for I := 0 to FOmniMotionList.Count - 1 do - ReleaseOmnilightMotion(FOmniMotionList[I]); - FOmniMotionList.Clear; - - for I := 0 to FSpotMotionList.Count - 1 do - ReleaseSpotlightMotion(FSpotMotionList[I]); - FSpotMotionList.Clear; - - for I := 0 to FCameraMotionList.Count - 1 do - ReleaseCameraMotion(FCameraMotionList[I]); - FCameraMotionList.Clear; - - if assigned(FAmbientMotion) then - ReleaseAmbientLightMotion(FAmbientMotion); - FAmbientMotion := nil; -end; - -// ----------------- TFile3DS ------------------------------------------------------------------------------------------ - -constructor TFile3DS.Create; - -begin - FMaterialList := TMaterialList.Create(Self); - FObjectList := TObjectList.Create(Self); - FKeyFramer := TKeyFramer.Create(Self); -end; - -constructor TFile3DS.CreateFromFile(const FileName: String); -begin - Create; - FFileName := FileName; - FStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); - InitDatabase; - CreateDatabase; -end; - -destructor TFile3DS.Destroy; -begin - FKeyFramer.Free; - FObjectList.Free; - FMaterialList.Free; - ReleaseDatabase; - ReleaseStream; - inherited Destroy; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.AddToNodeList(Chunk: PChunk3DS); - -// creates a node, put node in list and fill-in structure - -var - NewNode: PNodeList; - HdrChunk, InstChunk: PChunk3DS; - -begin - MakeNode(NewNode); - if NewNode = nil then - Exit; - - HdrChunk := FindChunk(Chunk, NODE_HDR); - if HdrChunk = nil then - Exit; - - ReadChunkData(HdrChunk); - if HdrChunk = nil then - Exit; - - // fill in node Data - NewNode.Name := HdrChunk.Data.NodeHdr.ObjNameStr; - NewNode.ID := GetChunkNodeID(Chunk); - NewNode.Tag := Chunk.Tag; - NewNode.ParentID := HdrChunk.Data.NodeHdr.ParentIndex; - NewNode.Next := nil; - NewNode.InstStr := ''; - - // check for instance - if Chunk.Tag = OBJECT_NODE_TAG then - begin - InstChunk := FindChunk(Chunk, INSTANCE_NAME); - if assigned(InstChunk) then - begin - ReadChunkData(InstChunk); - NewNode.InstStr := string(StrPas(InstChunk.Data.InstanceName)); - FreeChunkData(InstChunk); - end; - end; - HdrChunk.Data.NodeHdr.ObjNameStr := ''; - FreeChunkData(HdrChunk); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.AssignParentNames; - -// traverse keyframe data and assign parent names to its own chunk PARENT_NAME -// which is a child of NODE_HDR - -var - Chunk, KfDataChunk, HdrChunk, NameChunk, IdChunk: PChunk3DS; - I: Integer; - IDNode, IDParentNode: PNodeList; - Name, Inst: String3DS; - -begin - KfDataChunk := FindChunk(FDatabase.TopChunk, KFDATA); - if KfDataChunk = nil then - Exit; - - // Find chunks in KFRAMER - for I := 1 to NodeTagCount do - begin - Chunk := FindChunk(KfDataChunk, NodeTags[I]); - while assigned(Chunk) do - begin - HdrChunk := FindChunk(Chunk, NODE_HDR); - if assigned(HdrChunk) then - begin - IdChunk := FindChunk(Chunk, NODE_ID); - if assigned(IdChunk) then - begin - ReadChunkData(IdChunk); - if assigned(IdChunk.Data.KFID) then - begin - // Find table entry for node of interest - IDNode := FindNodeByID(IdChunk.Data.KFID^); - // no ID (bad) or no parent (ok) - if assigned(IDNode) and (IDNode.ParentID <> -1) then - begin - // find table entry for parent - IDParentNode := FindNodeByID(IDNode.ParentID); - if assigned(IDParentNode) then - begin - Name := UTF8String(IDParentNode.Name); - Inst := UTF8String(IDParentNode.InstStr); - end; - - if Length(Name) > 0 then - begin - // concatenate names if there is an inst name - if Length(Inst) > 0 then - Name := Name + '.' + Inst; - - // if PARENT chunk exists, copy into it - NameChunk := FindChunk(HdrChunk, PARENT_NAME); - if assigned(NameChunk) then - begin - ReadChunkData(NameChunk); - if assigned(NameChunk.Data.InstanceName) then - begin - NameChunk.Data.InstanceName := AllocMem(Length(Name) + 1); - Move(Name[1], NameChunk.Data.InstanceName^, Length(Name) + 1); - end; - end - else - KFAddParentName(HdrChunk, Name); // creates PARENT_NAME chunk - end; - end; - end; - end; - end; - Chunk := FindNextChunk(Chunk.Sibling, NodeTags[I]); - end; - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.CheckListNodeIDs; - -// Earlier versions (pre 3) of 3dStudio had no node ids, they simply used the order -// in which they came along, if so put in NODE IDs. Assuming that if one node -// has no ID the whole list get renumbered. - -var - ID: PNodeList; - Index: SmallInt; - -begin - ID := FNodeList; - - while assigned(ID) do - begin - if (ID.ID = KNoID) then // if somebody has no ID renumber list - begin - Index := 0; - ID := FNodeList; - while assigned(ID) do - begin - ID.ID := Index; - Inc(Index); - ID := ID.Next; - end; - Break; - end; - ID := ID.Next; - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.FindNodeByID(ID: SmallInt): PNodeList; - -begin - Result := FNodeList; - while assigned(Result) do - begin - if Result.ID = ID then - Break; - Result := Result.Next; - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.DumpDataBase(Strings: TStrings; DumpLevel: TDumpLevel); - -// dumps entire database into the given string class - -var - OldSeparator: Char; - -begin - - OldSeparator := FormatSettings.DecimalSeparator; - FormatSettings.DecimalSeparator := '.'; - try - if Assigned(FDatabase.TopChunk) then - DumpChunk(Self, Strings, FDatabase.TopChunk, 0, DumpLevel); - finally - FormatSettings.DecimalSeparator := OldSeparator; - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.GetChunkNodeID(Chunk: PChunk3DS): SmallInt; - -var - IdChunk: PChunk3DS; - -begin - Result := KNoID; - IdChunk := FindChunk(Chunk, NODE_ID); - if assigned(IdChunk) then - begin - ReadChunkData(IdChunk); - if assigned(IdChunk.Data.KFID) then - Result := IdChunk.Data.KFID^; - FreeChunkData(IdChunk); - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.IsNode(Tag: Word): Boolean; - -var - I: Integer; - -begin - Result := False; - for I := 1 to NodeTagCount do - if Tag = NodeTags[I] then - begin - Result := True; - Break; - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.KFAddParentName(Chunk: PChunk3DS; const Name: String3DS); -var - Temp: PChunk3DS; -begin - InitChunk(Temp); - Temp.Tag := PARENT_NAME; - Temp.Data.Dummy := AllocMem(Length(Name) + 1); - Move(Name[1], Temp.Data.Dummy^, Length(Name) + 1); - AddChildOrdered(Chunk, Temp); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.MakeNode(var Node: PNodeList); - -// add node to linked list (uninitialized) - -var - ID: PNodeList; - -begin - ID := FNodeList; - Node := AllocMem(SizeOf(TNodeList)); - if assigned(Node) then - begin - // first node ? - if ID = nil then - FNodeList := Node - else // add to list - begin - while assigned(ID.Next) do - ID := ID.Next; - ID.Next := Node; - end; - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.ParseDatabase; - -var - Chunk, KfDataChunk: PChunk3DS; - -begin - KfDataChunk := FindChunk(FDatabase.TopChunk, KFDATA); - if assigned(KfDataChunk) then - begin - Chunk := KfDataChunk.Children; - while assigned(Chunk) do - begin - if IsNode(Chunk.Tag) then - AddToNodeList(Chunk); - Chunk := Chunk.Sibling; - end; - CheckListNodeIDs; - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.ReadXDataEntryChildren(Parent: PChunk3DS); - -var - ParentBody: Cardinal; - Child: PChunk3DS; - -begin - SeekChild(Parent); - ParentBody := Parent.Position + Parent.Size; - - // satisfy the D4 compiler by castíng the (longint) position to a cardinal - while Cardinal(FStream.Position) < ParentBody do - begin - Child := nil; - InitChunk(Child); - Child.Position := FStream.Position; - ReadHeader(Child.Tag, Child.Size); - // Validate the child chunk... - // First, is it a valid header? - case Child.Tag of - XDATA_APPNAME, - XDATA_STRING, - XDATA_FLOAT, - XDATA_DOUBLE, - XDATA_SHORT, - XDATA_LONG, - XDATA_VOID, - XDATA_GROUP, - XDATA_RFU6, - XDATA_RFU5, - XDATA_RFU4, - XDATA_RFU3, - XDATA_RFU2, - XDATA_RFU1: - begin - // second, does the size fit inside the XDATA_ENTRY chunk? - if (Child.Position + Child.Size) <= ParentBody then - begin - // chances are its a good subchunk, so add it in - AddChild(Parent, Child); - ReadXDataEntryChildren(Child); - end - else - ReleaseChunk(Child); - end - else // must not be a valid chunk, seek to the end of the parent then - begin - ReleaseChunk(Child); - FStream.Position := ParentBody; - end; - end; - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.ReleaseNodeList; - -var - Next: PNodeList; - -begin - while assigned(FNodeList) do - begin - Next := FNodeList.Next; - Dispose(FNodeList); - FNodeList := Next; - end; -end; - -procedure TFile3DS.ReleaseStream; -begin - if FOwnStream then - FreeAndNil(FStream) - else - FStream := nil; - FOwnStream := False; -end; - - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.CreateDatabase; - -begin - with FDatabase do - begin - InitChunk(TopChunk); - FStream.Position := 0; - ReadHeader(TopChunk.Tag, TopChunk.Size); - - // test header to determine whether it is a top level chunk type - if (TopChunk.Tag = M3DMAGIC) or (TopChunk.Tag = CMAGIC) or - (TopChunk.Tag = MLIBMAGIC) then - begin - // gw: set needed max value for ProgressBar - if assigned(FOnLoadProgress) then - FOnLoadProgress(0, FStream.Size); - // read database structure - ReadChildren(TopChunk); - ParseDatabase; - AssignParentNames; - ReleaseNodeList; - end; - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.InitDatabase; - -begin - with FDatabase do - begin - TopChunk := nil; - ObjListDirty := True; - MatListDirty := True; - NodeListDirty := True; - ObjList := nil; - MatList := nil; - NodeList := nil; - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.ClearLists; - -begin - FMaterialList.ClearList; - FObjectList.ClearLists; - FKeyFramer.ClearLists; - ReleaseDatabase; -end; - -procedure TFile3DS.LoadFromFile(const FileName: String); -begin - ClearLists; - ReleaseStream; - FFileName := FileName; - FStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); - FOwnStream := True; - InitDatabase; - CreateDatabase; -end; - -procedure TFile3DS.LoadFromStream(const aStream: TStream); -begin - ReleaseStream; - ClearLists; - FFileName := ''; - FStream := aStream; - InitDatabase; - CreateDatabase; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.GetAtmosphereData: TAtmosphere3DS; - -begin - Result := GetAtmosphere(Self, FDatabase); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.GetBackgroundData: TBackground3DS; - -begin - Result := GetBackground(Self, FDatabase); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.GetDatabaseType: TDBType3DS; - -begin - case FDatabase.TopChunk.Tag of - M3DMAGIC: - Result := dbMeshFile; - CMAGIC: - Result := dbProjectFile; - MLIBMAGIC: - Result := dbMaterialFile; - else - Result := dbUnknown; - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.GetMeshSettings: TMeshSet3DS; - -begin - Result := GetMeshSet(Self, FDatabase); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.GetViewportData: TViewport3DS; - -begin - Result := GetViewport(Self, FDatabase); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.ReadChildren(Parent: PChunk3DS); - -var - ParentBody: Integer; - Child: PChunk3DS; - -begin - SeekChild(Parent); - ParentBody := Parent.Position + Parent.Size; - while FStream.Position < ParentBody do - begin - Child := nil; - InitChunk(Child); - // gw: set ProgressBar current position - if assigned(FOnLoadProgress) then - FOnLoadProgress(FStream.Position, 0); - - Child.Position := FStream.Position; - ReadHeader(Child.Tag, Child.Size); - AddChild(Parent, Child); - if Child.Tag = XDATA_ENTRY then - ReadXDataEntryChildren(Child) - else - ReadChildren(Child); - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.ReleaseDatabase; - -begin - with FDatabase do - begin - if assigned(TopChunk) then - ReleaseChunk(TopChunk); - if assigned(ObjList) then - ReleaseChunkList(ObjList); - if assigned(MatList) then - ReleaseChunkList(MatList); - if assigned(NodeList) then - ReleaseChunkList(NodeList); - end; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.InitChunkData(Chunk: PChunk3DS): Pointer; - -begin - case Chunk.Tag of - COLOR_F: - Chunk.Data.ColorF := AllocMem(SizeOf(TColorF)); - LIN_COLOR_F: - Chunk.Data.LinColorF := AllocMem(SizeOf(TLinColorF)); - COLOR_24: - Chunk.Data.Color24 := AllocMem(SizeOf(TColor24)); - LIN_COLOR_24: - Chunk.Data.LinColor24 := AllocMem(SizeOf(TLinColor24)); - INT_PERCENTAGE: - Chunk.Data.IntPercentage := AllocMem(SizeOf(TIntPercentage)); - FLOAT_PERCENTAGE: - Chunk.Data.FloatPercentage := AllocMem(SizeOf(TFloatPercentage)); - MAT_MAPNAME: - Chunk.Data.MatMapname := nil; // AllocMem(SizeOf(TMatMapname)); - M3D_VERSION: - Chunk.Data.M3dVersion := AllocMem(SizeOf(TM3dVersion)); - MESH_VERSION: - Chunk.Data.MeshVersion := AllocMem(SizeOf(TMeshVersion)); - MASTER_SCALE: - Chunk.Data.MasterScale := AllocMem(SizeOf(TMasterScale)); - LO_SHADOW_BIAS: - Chunk.Data.LoShadowBias := AllocMem(SizeOf(TLoShadowBias)); - SHADOW_FILTER: - Chunk.Data.ShadowFilter := AllocMem(SizeOf(TShadowFilter)); - SHADOW_RANGE: - Chunk.Data.ShadowRange := AllocMem(SizeOf(TShadowRange)); - HI_SHADOW_BIAS: - Chunk.Data.HiShadowBias := AllocMem(SizeOf(THiShadowBias)); - RAY_BIAS: - Chunk.Data.RayBias := AllocMem(SizeOf(TRayBias)); - SHADOW_MAP_SIZE: - Chunk.Data.ShadowMapSize := AllocMem(SizeOf(TShadowMapSize)); - SHADOW_SAMPLES: - Chunk.Data.ShadowSamples := AllocMem(SizeOf(TShadowSamples)); - O_CONSTS: - Chunk.Data.OConsts := AllocMem(SizeOf(TOConsts)); - BIT_MAP: - Chunk.Data.BitMapName := nil; // AllocMem(SizeOf(TBitMapName)); - V_GRADIENT: - Chunk.Data.VGradient := AllocMem(SizeOf(TVGradient)); - FOG: - Chunk.Data.FOG := AllocMem(SizeOf(TFog)); - LAYER_FOG: - Chunk.Data.LayerFog := AllocMem(SizeOf(TLayerFog)); - DISTANCE_CUE: - Chunk.Data.DistanceCue := AllocMem(SizeOf(TDistanceCue)); - VIEW_TOP, - VIEW_BOTTOM, - VIEW_LEFT, - VIEW_RIGHT, - VIEW_FRONT, - VIEW_BACK: - Chunk.Data.ViewStandard := AllocMem(SizeOf(TViewStandard)); - VIEW_USER: - Chunk.Data.ViewUser := AllocMem(SizeOf(TViewUser)); - VIEW_CAMERA: - Chunk.Data.ViewCamera := nil; // AllocMem(SizeOf(TViewCamera)); - MAT_NAME: - Chunk.Data.MatName := nil; // AllocMem(SizeOf(TMatName)); - MAT_SHADING: - Chunk.Data.MatShading := AllocMem(SizeOf(TMatShading)); - MAT_ACUBIC: - Chunk.Data.MatAcubic := AllocMem(SizeOf(TMatAcubic)); - MAT_SXP_TEXT_DATA, - MAT_SXP_TEXT2_DATA, - MAT_SXP_OPAC_DATA, - MAT_SXP_BUMP_DATA, - MAT_SXP_SPEC_DATA, - MAT_SXP_SHIN_DATA, - MAT_SXP_SELFI_DATA, - MAT_SXP_TEXT_MASKDATA, - MAT_SXP_TEXT2_MASKDATA, - MAT_SXP_OPAC_MASKDATA, - MAT_SXP_BUMP_MASKDATA, - MAT_SXP_SPEC_MASKDATA, - MAT_SXP_SHIN_MASKDATA, - MAT_SXP_SELFI_MASKDATA, - MAT_SXP_REFL_MASKDATA, - PROC_DATA: - Chunk.Data.IpasData := AllocMem(SizeOf(TIpasData)); - MAT_WIRESIZE: - Chunk.Data.MatWireSize := AllocMem(SizeOf(TMatWireSize)); - MAT_MAP_TILING: - Chunk.Data.MatMapTiling := AllocMem(SizeOf(TMatMapTiling)); - MAT_MAP_TEXBLUR: - Chunk.Data.MatMapTexblur := AllocMem(SizeOf(TMatMapTexblur)); - MAT_MAP_USCALE: - Chunk.Data.MatMapUScale := AllocMem(SizeOf(TMatMapUScale)); - MAT_MAP_VSCALE: - Chunk.Data.MatMapVScale := AllocMem(SizeOf(TMatMapVScale)); - MAT_MAP_UOFFSET: - Chunk.Data.MatMapUOffset := AllocMem(SizeOf(TMatMapUOffset)); - MAT_MAP_VOFFSET: - Chunk.Data.MatMapVOffset := AllocMem(SizeOf(TMatMapVOffset)); - MAT_MAP_ANG: - Chunk.Data.MatMapAng := AllocMem(SizeOf(TMatMapAng)); - MAT_MAP_COL1: - Chunk.Data.MatMapCol1 := AllocMem(SizeOf(TMatMapCol1)); - MAT_MAP_COL2: - Chunk.Data.MatMapCol2 := AllocMem(SizeOf(TMatMapCol2)); - MAT_MAP_RCOL: - Chunk.Data.MatMapRCol := AllocMem(SizeOf(TMatMapRCol)); - MAT_MAP_GCOL: - Chunk.Data.MatMapGCol := AllocMem(SizeOf(TMatMapGCol)); - MAT_MAP_BCOL: - Chunk.Data.MatMapBCol := AllocMem(SizeOf(TMatMapBCol)); - MAT_BUMP_PERCENT: - Chunk.Data.MatBumpPercent := AllocMem(SizeOf(TMatBumpPercent)); - NAMED_OBJECT: - Chunk.Data.NamedObject := nil; // AllocMem(SizeOf(TNamedObject)); - POINT_ARRAY: - Chunk.Data.PointArray := AllocMem(SizeOf(TPointArray)); - POINT_FLAG_ARRAY: - Chunk.Data.PointFlagArray := AllocMem(SizeOf(TPointFlagArray)); - FACE_ARRAY: - Chunk.Data.FaceArray := AllocMem(SizeOf(TFaceArray)); - MSH_MAT_GROUP: - Chunk.Data.MshMatGroup := AllocMem(SizeOf(TMshMatGroup)); - MSH_BOXMAP: - Chunk.Data.MshBoxmap := AllocMem(SizeOf(TMshBoxmap)); - SMOOTH_GROUP: - Chunk.Data.SmoothGroup := AllocMem(SizeOf(TSmoothGroup)); - TEX_VERTS: - Chunk.Data.TexVerts := AllocMem(SizeOf(TTexVerts)); - MESH_MATRIX: - Chunk.Data.MeshMatrix := AllocMem(SizeOf(TMeshMatrix)); - MESH_COLOR: - Chunk.Data.MeshColor := AllocMem(SizeOf(TMeshColor)); - MESH_TEXTURE_INFO: - Chunk.Data.MeshTextureInfo := AllocMem(SizeOf(TMeshTextureInfo)); - PROC_NAME: - Chunk.Data.ProcName := nil; // AllocMem(SizeOf(TProcName)); - N_DIRECT_LIGHT: - Chunk.Data.NDirectLight := AllocMem(SizeOf(TNDirectLight)); - DL_EXCLUDE: - Chunk.Data.DlExclude := nil; // AllocMem(SizeOf(TDlExclude)); - DL_INNER_RANGE: - Chunk.Data.DlInnerRange := AllocMem(SizeOf(TDlInnerRange)); - DL_OUTER_RANGE: - Chunk.Data.DlOuterRange := AllocMem(SizeOf(TDlOuterRange)); - DL_MULTIPLIER: - Chunk.Data.DlMultiplier := AllocMem(SizeOf(TDlMultiplier)); - DL_SPOTLIGHT: - Chunk.Data.DlSpotlight := AllocMem(SizeOf(TDlSpotlight)); - DL_LOCAL_SHADOW2: - Chunk.Data.DlLocalShadow2 := AllocMem(SizeOf(TDlLocalShadow2)); - DL_SPOT_ROLL: - Chunk.Data.DlSpotRoll := AllocMem(SizeOf(TDlSpotRoll)); - DL_SPOT_ASPECT: - Chunk.Data.DlSpotAspect := AllocMem(SizeOf(TDlSpotAspect)); - DL_SPOT_PROJECTOR: - Chunk.Data.DlSpotProjector := nil; // AllocMem(SizeOf(TDlSpotProjector)); - DL_RAY_BIAS: - Chunk.Data.DlRayBias := AllocMem(SizeOf(TDlRayBias)); - N_CAMERA: - Chunk.Data.NCamera := AllocMem(SizeOf(TNCamera)); - CAM_RANGES: - Chunk.Data.CamRanges := AllocMem(SizeOf(TCamRanges)); - VIEWPORT_LAYOUT: - Chunk.Data.ViewportLayout := AllocMem(SizeOf(TViewportLayout)); - VIEWPORT_SIZE: - Chunk.Data.ViewportSize := AllocMem(SizeOf(TViewportSize)); - VIEWPORT_DATA_3, - VIEWPORT_DATA: - Chunk.Data.ViewportData := AllocMem(SizeOf(TViewportData)); - XDATA_ENTRY: - Chunk.Data.XDataEntry := AllocMem(SizeOf(TXDataEntry)); - XDATA_APPNAME: - Chunk.Data.XDataAppName := nil; // AllocMem(SizeOf(TXDataAppName)); - XDATA_STRING: - Chunk.Data.XDataString := nil; // AllocMem(SizeOf(TXDataString)); - KFHDR: - Chunk.Data.KFHDR := AllocMem(SizeOf(TKFHdr)); - KFSEG: - Chunk.Data.KFSEG := AllocMem(SizeOf(TKFSeg)); - KFCURTIME: - Chunk.Data.KFCURTIME := AllocMem(SizeOf(TKFCurtime)); - NODE_ID: - Chunk.Data.KFID := AllocMem(SizeOf(TKFId)); - NODE_HDR: - Chunk.Data.NodeHdr := AllocMem(SizeOf(TNodeHdr)); - PIVOT: - Chunk.Data.PIVOT := AllocMem(SizeOf(TPivot)); - INSTANCE_NAME, PARENT_NAME: - Chunk.Data.InstanceName := nil; // AllocMem(SizeOf(TInstanceName)); - MORPH_SMOOTH: - Chunk.Data.MorphSmooth := AllocMem(SizeOf(TMorphSmooth)); - BOUNDBOX: - Chunk.Data.BOUNDBOX := AllocMem(SizeOf(TBoundBox)); - POS_TRACK_TAG: - Chunk.Data.PosTrackTag := AllocMem(SizeOf(TPosTrackTag)); - COL_TRACK_TAG: - Chunk.Data.ColTrackTag := AllocMem(SizeOf(TColTrackTag)); - ROT_TRACK_TAG: - Chunk.Data.RotTrackTag := AllocMem(SizeOf(TRotTrackTag)); - SCL_TRACK_TAG: - Chunk.Data.ScaleTrackTag := AllocMem(SizeOf(TScaleTrackTag)); - MORPH_TRACK_TAG: - Chunk.Data.MorphTrackTag := AllocMem(SizeOf(TMorphTrackTag)); - FOV_TRACK_TAG: - Chunk.Data.FovTrackTag := AllocMem(SizeOf(TFovTrackTag)); - ROLL_TRACK_TAG: - Chunk.Data.RollTrackTag := AllocMem(SizeOf(TRollTrackTag)); - HOT_TRACK_TAG: - Chunk.Data.HotTrackTag := AllocMem(SizeOf(THotTrackTag)); - FALL_TRACK_TAG: - Chunk.Data.FallTrackTag := AllocMem(SizeOf(TFallTrackTag)); - HIDE_TRACK_TAG: - Chunk.Data.HideTrackTag := AllocMem(SizeOf(THideTrackTag)); - M3DMAGIC, // Chunks who consist entirely of children - MLIBMAGIC, - MDATA, - AMBIENT_LIGHT, - SOLID_BGND, - DEFAULT_VIEW, - MAT_ENTRY, - MAT_AMBIENT, - MAT_DIFFUSE, - MAT_SPECULAR, - MAT_SHININESS, - MAT_SHIN2PCT, - MAT_SHIN3PCT, - MAT_TRANSPARENCY, - MAT_XPFALL, - MAT_REFBLUR, - MAT_SELF_ILPCT, - MAT_TEXMAP, - MAT_TEXMASK, - MAT_TEX2MAP, - MAT_TEX2MASK, - MAT_OPACMAP, - MAT_OPACMASK, - MAT_REFLMAP, - MAT_REFLMASK, - MAT_BUMPMAP, - MAT_BUMPMASK, - MAT_SPECMAP, - MAT_SPECMASK, - MAT_SHINMAP, - MAT_SHINMASK, - MAT_SELFIMAP, - MAT_SELFIMASK, - N_TRI_OBJECT, - KFDATA, - AMBIENT_NODE_TAG, - OBJECT_NODE_TAG, - CAMERA_NODE_TAG, - TARGET_NODE_TAG, - LIGHT_NODE_TAG, - SPOTLIGHT_NODE_TAG, - L_TARGET_NODE_TAG, - CMAGIC, - XDATA_SECTION, - XDATA_GROUP: - Chunk.Data.Dummy := nil; - else // A truely hideous thing to do but it helps with unknown chunks - // Don't mess with dataless chunks - if Chunk.Size > 6 then - Chunk.Data.Dummy := AllocMem(Chunk.Size - 6) - else - Chunk.Data.Dummy := nil; - end; // end of case - Result := Chunk.Data.Dummy; // returns the pointer should someone want it -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteByte(AValue: Byte); - -begin - FStream.WriteBuffer(AValue, 1); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadByte: Byte; - -begin - FStream.ReadBuffer(Result, 1); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteShort(AValue: SmallInt); - -begin - FStream.WriteBuffer(AValue, SizeOf(AValue)); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadShort: SmallInt; - -begin - FStream.ReadBuffer(Result, SizeOf(Result)); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadCardinal: Cardinal; - -begin - FStream.ReadBuffer(Result, SizeOf(Result)); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadDouble: Double; - -begin - FStream.ReadBuffer(Result, SizeOf(Result)); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadInteger: Integer; - -begin - FStream.ReadBuffer(Result, SizeOf(Result)); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadSingle: Single; - -begin - FStream.ReadBuffer(Result, SizeOf(Result)); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadWord: Word; - -begin - FStream.ReadBuffer(Result, SizeOf(Result)); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteCardinal(AValue: Cardinal); - -begin - FStream.WriteBuffer(AValue, SizeOf(AValue)); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteDouble(AValue: Double); - -begin - FStream.WriteBuffer(AValue, SizeOf(AValue)); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteInteger(AValue: Integer); - -begin - FStream.WriteBuffer(AValue, SizeOf(AValue)); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteSingle(AValue: Single); - -begin - FStream.WriteBuffer(AValue, SizeOf(AValue)); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteWord(AValue: Word); - -begin - FStream.WriteBuffer(AValue, SizeOf(AValue)); -end; - -// WriteData -// -procedure TFile3DS.WriteData(Size: Integer; Data: Pointer); -begin - if assigned(Data) then - FStream.WriteBuffer(Data^, Size); -end; - -// ReadData -// -procedure TFile3DS.ReadData(Size: Integer; Data: Pointer); -begin - FStream.ReadBuffer(Data^, Size); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.Skip(AValue: Integer); - -begin - FStream.Seek(soFromCurrent, AValue); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteString(const AValue: String3DS); - -begin - WriteData(Length(AValue), @AValue[1]); - WriteByte(0); // Write a null on the end of the string -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteFixedString(const AValue: String3DS; Len: Integer); - -var - I: Integer; - -begin - // len is the length of the target string space including null - WriteString(AValue); // 1 null byte will also be written - for I := 1 to Len - Length(AValue) - 1 do - WriteByte(0); // fill the remaining space with nulls -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadString: PChar3DS; -var - Len, LB: Integer; - Buffer: String3DS; -begin - Len := 0; - LB := 0; - repeat - if Len >= LB then - begin - Inc(LB, 50); - SetLength(Buffer, LB); - end; - Inc(Len); - FStream.Read(Buffer[Len], 1); - until Buffer[Len] = #0; - Result := AllocMem(Len); - Move(Buffer[1], Result^, Len); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteHeader(ChunkType: Word; ChunkSize: Cardinal); - -begin - WriteWord(ChunkType); - WriteCardinal(ChunkSize); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.ReadHeader(var ChunkType: Word; var ChunkSize: Cardinal); - -begin - ChunkType := ReadWord; - ChunkSize := ReadCardinal; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.FinishHeader(StartPos, EndPos: Cardinal); - -begin - FStream.Position := StartPos + 2; - WriteCardinal(EndPos - StartPos); - FStream.Position := EndPos; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WritePoint(const P: TPoint3DS); - -begin - WriteSingle(P.X); - WriteSingle(P.Y); - WriteSingle(P.Z); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadPoint: TPoint3DS; - -begin - Result := DefPoint3DS; - FStream.ReadBuffer(Result, SizeOf(Result)); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteTexVertex(const T: TTexVert3DS); - -begin - WriteSingle(T.U); - WriteSingle(T.V); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadTexVert: TTexVert3DS; - -begin - Result := DefTextVert3DS; - Result.U := ReadSingle; - Result.V := ReadSingle; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteFace(const F: TFace3DS); - -begin - WriteWord(F.v1); - WriteWord(F.v2); - WriteWord(F.v3); - WriteWord(F.flag); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadFace: TFace3DS; - -begin - Result := DefFace3DS; - Result.v1 := ReadWord; - Result.v2 := ReadWord; - Result.v3 := ReadWord; - Result.flag := ReadWord; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteTrackHeader(const T: TTrackHeader3DS); - -begin - WriteWord(T.Flags); - WriteCardinal(T.nu1); - WriteCardinal(T.nu2); - WriteCardinal(T.KeyCount); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadTrackHeader: TTrackHeader3DS; - -begin - Result := DefTrackHeader3DS; - Result.Flags := ReadWord; - Result.nu1 := ReadCardinal; - Result.nu2 := ReadCardinal; - Result.KeyCount := ReadCardinal; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.WriteKeyHeader(const K: TKeyHeader3DS); - -begin - WriteCardinal(K.time); - WriteWord(K.rflags); - if (K.rflags and KeyUsesTension3DS) > 0 then - WriteSingle(K.tension); - if (K.rflags and KeyUsesCont3DS) > 0 then - WriteSingle(K.continuity); - if (K.rflags and KeyUsesBias3DS) > 0 then - WriteSingle(K.bias); - if (K.rflags and KeyUsesEaseTo3DS) > 0 then - WriteSingle(K.easeto); - if (K.rflags and KeyUsesEaseFrom3DS) > 0 then - WriteSingle(K.easefrom); -end; - -// --------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.ReadKeyHeader: TKeyHeader3DS; - -begin - Result := DefKeyHeader3DS; - Result.time := ReadCardinal; - Result.rflags := ReadWord; - if (Result.rflags and KeyUsesTension3DS) > 0 then - Result.tension := ReadSingle; - if (Result.rflags and KeyUsesCont3DS) > 0 then - Result.continuity := ReadSingle; - if (Result.rflags and KeyUsesBias3DS) > 0 then - Result.bias := ReadSingle; - if (Result.rflags and KeyUsesEaseTo3DS) > 0 then - Result.easeto := ReadSingle; - if (Result.rflags and KeyUsesEaseFrom3DS) > 0 then - Result.easefrom := ReadSingle; -end; - -// --------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.ReadChunkData(Chunk: PChunk3DS); - -// Reads the data out of the chunk detailed in Chunk and places a pointer to -// the data into the PChunk3DS structure, it will also return that pointer. - -var - I: Integer; - -begin - if Chunk.Data.Dummy = nil then // don't try to read the data if its already been read - begin - // seek to the beginning of the Chunk's data (harmless if the Chunk has no data) - FStream.Position := Chunk.Position + 6; - case Chunk.Tag of - COLOR_F: - begin - Chunk.Data.ColorF := AllocMem(SizeOf(TColorF)); // allocate the memory to hold the data - with Chunk.Data.ColorF^ do - begin - Red := ReadSingle; // Read the data out of the file - Green := ReadSingle; - Blue := ReadSingle; - end; - end; - LIN_COLOR_F: - begin - Chunk.Data.LinColorF := AllocMem(SizeOf(TLinColorF)); - with Chunk.Data.LinColorF^ do - begin - Red := ReadSingle; - Green := ReadSingle; - Blue := ReadSingle; - end; - end; - COLOR_24: - begin - Chunk.Data.Color24 := AllocMem(SizeOf(TColor24)); - with Chunk.Data.Color24^ do - begin - Red := ReadByte; - Green := ReadByte; - Blue := ReadByte; - end; - end; - LIN_COLOR_24: - begin - Chunk.Data.LinColor24 := AllocMem(SizeOf(TLinColor24)); - with Chunk.Data.LinColor24^ do - begin - Red := ReadByte; - Green := ReadByte; - Blue := ReadByte; - end; - end; - INT_PERCENTAGE: - begin - Chunk.Data.IntPercentage := AllocMem(SizeOf(TIntPercentage)); - Chunk.Data.IntPercentage^ := ReadShort; - end; - FLOAT_PERCENTAGE: - begin - Chunk.Data.FloatPercentage := AllocMem(SizeOf(TFloatPercentage)); - Chunk.Data.FloatPercentage^ := ReadSingle; - end; - MAT_MAPNAME: - begin - // Chunk.Data.MatMapname := AllocMem(SizeOf(TMatMapname)); - Chunk.Data.MatMapname := ReadString; - end; - M3D_VERSION: - begin - Chunk.Data.M3dVersion := AllocMem(SizeOf(TM3dVersion)); - Chunk.Data.M3dVersion^ := ReadInteger; - end; - MESH_VERSION: - begin - Chunk.Data.MeshVersion := AllocMem(SizeOf(TMeshVersion)); - Chunk.Data.MeshVersion^ := ReadInteger; - end; - MASTER_SCALE: - begin - Chunk.Data.MasterScale := AllocMem(SizeOf(TMasterScale)); - Chunk.Data.MasterScale^ := ReadSingle; - end; - LO_SHADOW_BIAS: - begin - Chunk.Data.LoShadowBias := AllocMem(SizeOf(TLoShadowBias)); - Chunk.Data.LoShadowBias^ := ReadSingle; - end; - SHADOW_FILTER: - begin - Chunk.Data.ShadowFilter := AllocMem(SizeOf(TShadowFilter)); - Chunk.Data.ShadowFilter^ := ReadSingle; - end; - SHADOW_RANGE: - begin - Chunk.Data.ShadowRange := AllocMem(SizeOf(TShadowRange)); - Chunk.Data.ShadowRange^ := ReadInteger; - end; - HI_SHADOW_BIAS: - begin - Chunk.Data.HiShadowBias := AllocMem(SizeOf(THiShadowBias)); - Chunk.Data.HiShadowBias^ := ReadSingle; - end; - RAY_BIAS: - begin - Chunk.Data.RayBias := AllocMem(SizeOf(TRayBias)); - Chunk.Data.RayBias^ := ReadSingle; - end; - SHADOW_MAP_SIZE: - begin - Chunk.Data.ShadowMapSize := AllocMem(SizeOf(TShadowMapSize)); - Chunk.Data.ShadowMapSize^ := ReadShort; - end; - SHADOW_SAMPLES: - begin - Chunk.Data.ShadowSamples := AllocMem(SizeOf(TShadowSamples)); - Chunk.Data.ShadowSamples^ := ReadShort; - end; - O_CONSTS: - begin - Chunk.Data.OConsts := AllocMem(SizeOf(TOConsts)); - Chunk.Data.OConsts^ := ReadPoint; - end; - BIT_MAP: - begin - // Chunk.Data.BitMapName := AllocMem(SizeOf(TBitMapName)); - Chunk.Data.BitMapName := ReadString; - end; - V_GRADIENT: - begin - Chunk.Data.VGradient := AllocMem(SizeOf(TVGradient)); - Chunk.Data.VGradient^ := ReadSingle; - end; - FOG: - begin - Chunk.Data.FOG := AllocMem(SizeOf(TFog)); - with Chunk.Data.FOG^ do - begin - NearPlaneDist := ReadSingle; - NearPlaneDensity := ReadSingle; - FarPlaneDist := ReadSingle; - FarPlaneDensity := ReadSingle; - end; - end; - LAYER_FOG: - begin - Chunk.Data.LayerFog := AllocMem(SizeOf(TLayerFog)); - with Chunk.Data.LayerFog^ do - begin - ZMin := ReadSingle; - ZMax := ReadSingle; - Density := ReadSingle; - AType := ReadCardinal; - end; - end; - DISTANCE_CUE: - begin - Chunk.Data.DistanceCue := AllocMem(SizeOf(TDistanceCue)); - with Chunk.Data.DistanceCue^ do - begin - NearPlaneDist := ReadSingle; - NearPlaneDimming := ReadSingle; - FarPlaneDist := ReadSingle; - FarPlaneDimming := ReadSingle; - end; - end; - VIEW_TOP, - VIEW_BOTTOM, - VIEW_LEFT, - VIEW_RIGHT, - VIEW_FRONT, - VIEW_BACK: - begin - Chunk.Data.ViewStandard := AllocMem(SizeOf(TViewStandard)); - with Chunk.Data.ViewStandard^ do - begin - ViewWidth := ReadSingle; - ViewTargetCoord := ReadPoint; - end; - end; - VIEW_USER: - begin - Chunk.Data.ViewUser := AllocMem(SizeOf(TViewUser)); - with Chunk.Data.ViewUser^ do - begin - ViewWidth := ReadSingle; - XYViewAngle := ReadSingle; - YZViewAngle := ReadSingle; - BankAngle := ReadSingle; - ViewTargetCoord := ReadPoint; - end; - end; - VIEW_CAMERA: - begin - // Chunk.Data.ViewCamera := AllocMem(SizeOf(TViewCamera)); - Chunk.Data.ViewCamera := ReadString; - end; - MAT_NAME: - begin - // Chunk.Data.MatName := AllocMem(SizeOf(TMatName)); - Chunk.Data.MatName := ReadString; - end; - MAT_SHADING: - begin - Chunk.Data.MatShading := AllocMem(SizeOf(TMatShading)); - FStream.Position := Chunk.Position + 6; - Chunk.Data.MatShading^ := ReadShort; - end; - MAT_ACUBIC: - begin - Chunk.Data.MatAcubic := AllocMem(SizeOf(TMatAcubic)); - with Chunk.Data.MatAcubic^ do - begin - ShadeLevel := ReadByte; - AntiAlias := ReadByte; - Flags := ReadShort; - MapSize := ReadCardinal; - FrameInterval := ReadCardinal; - end; - end; - MAT_SXP_TEXT_DATA, - MAT_SXP_TEXT2_DATA, - MAT_SXP_OPAC_DATA, - MAT_SXP_BUMP_DATA, - MAT_SXP_SPEC_DATA, - MAT_SXP_SHIN_DATA, - MAT_SXP_SELFI_DATA, - MAT_SXP_TEXT_MASKDATA, - MAT_SXP_TEXT2_MASKDATA, - MAT_SXP_OPAC_MASKDATA, - MAT_SXP_BUMP_MASKDATA, - MAT_SXP_SPEC_MASKDATA, - MAT_SXP_SHIN_MASKDATA, - MAT_SXP_SELFI_MASKDATA, - MAT_SXP_REFL_MASKDATA, - PROC_DATA: - begin - Chunk.Data.IpasData := AllocMem(SizeOf(TIpasData)); - with Chunk.Data.IpasData^ do - begin - Size := Chunk.Size - 6; - Data := AllocMem(Size); - ReadData(Size, Data); - end; - end; - MAT_WIRESIZE: - begin - Chunk.Data.MatWireSize := AllocMem(SizeOf(TMatWireSize)); - Chunk.Data.MatWireSize^ := ReadSingle; - end; - MAT_MAP_TILING: - begin - Chunk.Data.MatMapTiling := AllocMem(SizeOf(TMatMapTiling)); - Chunk.Data.MatMapTiling^ := ReadWord; - end; - MAT_MAP_TEXBLUR: - begin - Chunk.Data.MatMapTexblur := AllocMem(SizeOf(TMatMapTexblur)); - Chunk.Data.MatMapTexblur^ := ReadSingle; - end; - MAT_MAP_USCALE: - begin - Chunk.Data.MatMapUScale := AllocMem(SizeOf(TMatMapUScale)); - Chunk.Data.MatMapUScale^ := ReadSingle; - end; - MAT_MAP_VSCALE: - begin - Chunk.Data.MatMapVScale := AllocMem(SizeOf(TMatMapVScale)); - Chunk.Data.MatMapVScale^ := ReadSingle; - end; - MAT_MAP_UOFFSET: - begin - Chunk.Data.MatMapUOffset := AllocMem(SizeOf(TMatMapUOffset)); - Chunk.Data.MatMapUOffset^ := ReadSingle; - end; - MAT_MAP_VOFFSET: - begin - Chunk.Data.MatMapVOffset := AllocMem(SizeOf(TMatMapVOffset)); - Chunk.Data.MatMapVOffset^ := ReadSingle; - end; - MAT_MAP_ANG: - begin - Chunk.Data.MatMapAng := AllocMem(SizeOf(TMatMapAng)); - Chunk.Data.MatMapAng^ := ReadSingle; - end; - MAT_MAP_COL1: - begin - Chunk.Data.MatMapCol1 := AllocMem(SizeOf(TMatMapCol1)); - with Chunk.Data.MatMapCol1^ do - begin - Red := ReadByte; - Green := ReadByte; - Blue := ReadByte; - end; - end; - MAT_MAP_COL2: - begin - Chunk.Data.MatMapCol2 := AllocMem(SizeOf(TMatMapCol2)); - with Chunk.Data.MatMapCol2^ do - begin - Red := ReadByte; - Green := ReadByte; - Blue := ReadByte; - end; - end; - MAT_MAP_RCOL: - begin - Chunk.Data.MatMapRCol := AllocMem(SizeOf(TMatMapRCol)); - with Chunk.Data.MatMapRCol^ do - begin - Red := ReadByte; - Green := ReadByte; - Blue := ReadByte; - end; - end; - MAT_MAP_GCOL: - begin - Chunk.Data.MatMapGCol := AllocMem(SizeOf(TMatMapGCol)); - with Chunk.Data.MatMapGCol^ do - begin - Red := ReadByte; - Green := ReadByte; - Blue := ReadByte; - end; - end; - MAT_MAP_BCOL: - begin - Chunk.Data.MatMapBCol := AllocMem(SizeOf(TMatMapBCol)); - with Chunk.Data.MatMapBCol^ do - begin - Red := ReadByte; - Green := ReadByte; - Blue := ReadByte; - end; - end; - MAT_BUMP_PERCENT: - begin - Chunk.Data.MatBumpPercent := AllocMem(SizeOf(TMatBumpPercent)); - Chunk.Data.MatBumpPercent^ := ReadShort; - end; - NAMED_OBJECT: - begin - // Chunk.Data.NamedObject := AllocMem(SizeOf(TNamedObject)); - Chunk.Data.NamedObject := ReadString; - end; - POINT_ARRAY: - begin - Chunk.Data.PointArray := AllocMem(SizeOf(TPointArray)); - with Chunk.Data.PointArray^ do - begin - Vertices := ReadWord; - PointList := AllocMem(Vertices * SizeOf(TPoint3DS)); - // for I := 0 to Vertices - 1 do PointList[I] := ReadPoint; - ReadData(Vertices * SizeOf(TPoint3DS), PointList); - end; - end; - POINT_FLAG_ARRAY: - begin - Chunk.Data.PointFlagArray := AllocMem(SizeOf(TPointFlagArray)); - with Chunk.Data.PointFlagArray^ do - begin - Flags := ReadWord; - FlagList := AllocMem(Flags * SizeOf(SmallInt)); - // for I := 0 to Flags - 1 do FlagList[I] := ReadShort; - ReadData(Flags * SizeOf(SmallInt), FlagList); - end; - end; - FACE_ARRAY: - begin - Chunk.Data.FaceArray := AllocMem(SizeOf(TFaceArray)); - with Chunk.Data.FaceArray^ do - begin - Faces := ReadWord; - FaceList := AllocMem(Faces * SizeOf(TFace3DS)); - // for I := 0 to Faces - 1 do FaceList[I] := ReadFace; - ReadData(Faces * SizeOf(TFace3DS), FaceList); - end; - end; - MSH_MAT_GROUP: - begin - Chunk.Data.MshMatGroup := AllocMem(SizeOf(TMshMatGroup)); - with Chunk.Data.MshMatGroup^ do - begin - MatNameStr := AnsiString(StrPasFree(ReadString)); - Faces := ReadWord; - if Faces > 0 then - begin - FaceList := AllocMem(Faces * SizeOf(Word)); - // for I := 0 to Faces - 1 do FaceList[I] := ReadWord; - ReadData(Faces * SizeOf(Word), FaceList); - end - else - FaceList := nil; - end; - end; - MSH_BOXMAP: - begin - Chunk.Data.MshBoxmap := AllocMem(SizeOf(TMshBoxmap)); - for I := 0 to 5 do - Chunk.Data.MshBoxmap[I] := ReadString; - end; - SMOOTH_GROUP: - begin - Chunk.Data.SmoothGroup := AllocMem(SizeOf(TSmoothGroup)); - with Chunk.Data.SmoothGroup^ do - begin - Groups := (Chunk.Size - 6) div 4; - GroupList := AllocMem(Groups * SizeOf(Cardinal)); - // for I := 0 to Groups - 1 do GroupList[I] := ReadCardinal; - ReadData(Groups * SizeOf(Cardinal), GroupList); - end; - end; - TEX_VERTS: - begin - Chunk.Data.TexVerts := AllocMem(SizeOf(TTexVerts)); - with Chunk.Data.TexVerts^ do - begin - NumCoords := ReadWord; - TextVertList := AllocMem(NumCoords * SizeOf(TTexVert3DS)); - // for I := 0 to NumCoords - 1 do TextVertList[I] := ReadTexVert; - ReadData(NumCoords * SizeOf(TTexVert3DS), TextVertList); - end; - end; - MESH_MATRIX: - begin - Chunk.Data.MeshMatrix := AllocMem(SizeOf(TMeshMatrix)); - for I := 0 to 11 do - Chunk.Data.MeshMatrix[I] := ReadSingle; - end; - MESH_COLOR: - begin - Chunk.Data.MeshColor := AllocMem(SizeOf(TMeshColor)); - Chunk.Data.MeshColor^ := ReadByte; - end; - MESH_TEXTURE_INFO: - begin - Chunk.Data.MeshTextureInfo := AllocMem(SizeOf(TMeshTextureInfo)); - with Chunk.Data.MeshTextureInfo^ do - begin - MapType := ReadWord; - XTiling := ReadSingle; - YTiling := ReadSingle; - IconPos := ReadPoint(); - IconScaling := ReadSingle; - for I := 0 to 11 do - XMatrix[I] := ReadSingle; - IconWidth := ReadSingle; - IconHeight := ReadSingle; - CylIconHeight := ReadSingle; - end; - end; - PROC_NAME: - begin - // Chunk.Data.ProcName := AllocMem(SizeOf(TProcName)); - Chunk.Data.ProcName := ReadString; - end; - N_DIRECT_LIGHT: - begin - Chunk.Data.NDirectLight := AllocMem(SizeOf(TNDirectLight)); - Chunk.Data.NDirectLight^ := ReadPoint; - end; - DL_EXCLUDE: - begin - // Chunk.Data.DlExclude := AllocMem(SizeOf(TDlExclude)); - Chunk.Data.DlExclude := ReadString; - end; - DL_INNER_RANGE: - begin - Chunk.Data.DlInnerRange := AllocMem(SizeOf(TDlInnerRange)); - Chunk.Data.DlInnerRange^ := ReadSingle; - end; - DL_OUTER_RANGE: - begin - Chunk.Data.DlOuterRange := AllocMem(SizeOf(TDlOuterRange)); - Chunk.Data.DlOuterRange^ := ReadSingle; - end; - DL_MULTIPLIER: - begin - Chunk.Data.DlMultiplier := AllocMem(SizeOf(TDlMultiplier)); - Chunk.Data.DlMultiplier^ := ReadSingle; - end; - DL_SPOTLIGHT: - begin - Chunk.Data.DlSpotlight := AllocMem(SizeOf(TDlSpotlight)); - with Chunk.Data.DlSpotlight^ do - begin - SpotlightTarg := ReadPoint; - HotspotAngle := ReadSingle; - FalloffAngle := ReadSingle; - end; - end; - DL_LOCAL_SHADOW2: - begin - Chunk.Data.DlLocalShadow2 := AllocMem(SizeOf(TDlLocalShadow2)); - with Chunk.Data.DlLocalShadow2^ do - begin - LocalShadowBias := ReadSingle; - LocalShadowFilter := ReadSingle; - LocalShadowMapSize := ReadShort; - end; - end; - DL_SPOT_ROLL: - begin - Chunk.Data.DlSpotRoll := AllocMem(SizeOf(TDlSpotRoll)); - Chunk.Data.DlSpotRoll^ := ReadSingle; - end; - DL_SPOT_ASPECT: - begin - Chunk.Data.DlSpotAspect := AllocMem(SizeOf(TDlSpotAspect)); - Chunk.Data.DlSpotAspect^ := ReadSingle; - end; - DL_SPOT_PROJECTOR: - begin - // Chunk.Data.DlSpotProjector := AllocMem(SizeOf(TDlSpotProjector)); - Chunk.Data.DlSpotProjector := ReadString; - end; - DL_RAY_BIAS: - begin - Chunk.Data.DlRayBias := AllocMem(SizeOf(TDlRayBias)); - Chunk.Data.DlRayBias^ := ReadSingle; - end; - N_CAMERA: - begin - Chunk.Data.NCamera := AllocMem(SizeOf(TNCamera)); - with Chunk.Data.NCamera^ do - begin - CameraPos := ReadPoint; - TargetPos := ReadPoint; - CameraBank := ReadSingle; - CameraFocalLength := ReadSingle; - end; - end; - CAM_RANGES: - begin - Chunk.Data.CamRanges := AllocMem(SizeOf(TCamRanges)); - with Chunk.Data.CamRanges^ do - begin - NearPlane := ReadSingle; - FarPlane := ReadSingle; - end; - end; - VIEWPORT_LAYOUT: - begin - Chunk.Data.ViewportLayout := AllocMem(SizeOf(TViewportLayout)); - with Chunk.Data.ViewportLayout^ do - begin - Form := ReadShort; - Top := ReadShort; - Ready := ReadShort; - WState := ReadShort; - SwapWS := ReadShort; - SwapPort := ReadShort; - SwapCur := ReadShort; - end; - end; - VIEWPORT_SIZE: - begin - Chunk.Data.ViewportSize := AllocMem(SizeOf(TViewportSize)); - with Chunk.Data.ViewportSize^ do - begin - XPos := ReadWord; - YPos := ReadWord; - Width := ReadWord; - Height := ReadWord; - end; - end; - VIEWPORT_DATA_3, - VIEWPORT_DATA: - begin - Chunk.Data.ViewportData := AllocMem(SizeOf(TViewportData)); - with Chunk.Data.ViewportData^ do - begin - Flags := ReadShort; - AxisLockout := ReadShort; - WinXPos := ReadShort; - WinYPos := ReadShort; - WinWidth := ReadShort; - WinHeight := ReadShort; - View := ReadShort; - ZoomFactor := ReadSingle; - Center := ReadPoint; - HorizAng := ReadSingle; - VertAng := ReadSingle; - CamNameStr := AnsiString(StrPasFree(ReadString)); - end; - end; - XDATA_ENTRY: - begin - InitChunkData(Chunk); - with Chunk.Data.XDataEntry^ do - begin - Size := (Chunk.Size) - 6; - Data := AllocMem(Size); - ReadData(Size, Data); - end; - end; - XDATA_APPNAME: - begin - Chunk.Data.XDataAppName := ReadString; - end; - XDATA_STRING: - begin - Chunk.Data.XDataString := ReadString; - end; - KFHDR: - begin - Chunk.Data.KFHDR := AllocMem(SizeOf(TKFHdr)); - with Chunk.Data.KFHDR^ do - begin - Revision := ReadShort; - FileName := StrPasFree(ReadString); - AnimLength := ReadInteger; - end; - end; - KFSEG: - begin - Chunk.Data.KFSEG := AllocMem(SizeOf(TKFSeg)); - with Chunk.Data.KFSEG^ do - begin - First := ReadInteger; - Last := ReadInteger; - end; - end; - KFCURTIME: - begin - Chunk.Data.KFCURTIME := AllocMem(SizeOf(TKFCurtime)); - Chunk.Data.KFCURTIME^ := ReadInteger; - end; - NODE_ID: - begin - Chunk.Data.KFID := AllocMem(SizeOf(TKFId)); - Chunk.Data.KFID^ := ReadShort; - end; - NODE_HDR: - begin - Chunk.Data.NodeHdr := AllocMem(SizeOf(TNodeHdr)); - with Chunk.Data.NodeHdr^ do - begin - ObjNameStr := StrPasFree(ReadString); - Flags1 := ReadWord; - Flags2 := ReadWord; - ParentIndex := ReadShort; - end; - end; - PIVOT: - begin - Chunk.Data.PIVOT := AllocMem(SizeOf(TPivot)); - Chunk.Data.PIVOT^ := ReadPoint; - end; - INSTANCE_NAME: - begin - Chunk.Data.InstanceName := ReadString; - end; - PARENT_NAME: - ; // do nothing - MORPH_SMOOTH: - begin - Chunk.Data.MorphSmooth := AllocMem(SizeOf(TMorphSmooth)); - Chunk.Data.MorphSmooth^ := ReadSingle; - end; - BOUNDBOX: - begin - Chunk.Data.BOUNDBOX := AllocMem(SizeOf(TBoundBox)); - with Chunk.Data.BOUNDBOX^ do - begin - Min := ReadPoint; - Max := ReadPoint; - end; - end; - POS_TRACK_TAG: - begin - Chunk.Data.PosTrackTag := AllocMem(SizeOf(TPosTrackTag)); - with Chunk.Data.PosTrackTag^ do - begin - TrackHdr := ReadTrackHeader; - KeyHdrList := AllocMem(TrackHdr.KeyCount * SizeOf(TKeyHeader3DS)); - PositionList := AllocMem(TrackHdr.KeyCount * SizeOf(TPoint3DS)); - for I := 0 to TrackHdr.KeyCount - 1 do - begin - KeyHdrList[I] := ReadKeyHeader; - PositionList[I] := ReadPoint; - end; - end; - end; - COL_TRACK_TAG: - begin - Chunk.Data.ColTrackTag := AllocMem(SizeOf(TColTrackTag)); - with Chunk.Data.ColTrackTag^ do - begin - TrackHdr := ReadTrackHeader; - ColorList := AllocMem(TrackHdr.KeyCount * SizeOf(TFColor3DS)); - KeyHdrList := AllocMem(TrackHdr.KeyCount * SizeOf(TKeyHeader3DS)); - for I := 0 to TrackHdr.KeyCount - 1 do - begin - KeyHdrList[I] := ReadKeyHeader; - ColorList[I].R := ReadSingle; - ColorList[I].G := ReadSingle; - ColorList[I].B := ReadSingle; - end; - end; - end; - ROT_TRACK_TAG: - begin - Chunk.Data.RotTrackTag := AllocMem(SizeOf(TRotTrackTag)); - with Chunk.Data.RotTrackTag^ do - begin - TrackHdr := ReadTrackHeader; - KeyHdrList := AllocMem(TrackHdr.KeyCount * SizeOf(TKeyHeader3DS)); - RotationList := AllocMem(TrackHdr.KeyCount * SizeOf(TKFrotkey3DS)); - for I := 0 to TrackHdr.KeyCount - 1 do - begin - KeyHdrList[I] := ReadKeyHeader; - RotationList[I].Angle := ReadSingle; - RotationList[I].X := ReadSingle; - RotationList[I].Y := ReadSingle; - RotationList[I].Z := ReadSingle; - end; - end; - end; - SCL_TRACK_TAG: - begin - Chunk.Data.ScaleTrackTag := AllocMem(SizeOf(TScaleTrackTag)); - with Chunk.Data.ScaleTrackTag^ do - begin - TrackHdr := ReadTrackHeader; - KeyHdrList := AllocMem(TrackHdr.KeyCount * SizeOf(TKeyHeader3DS)); - ScaleList := AllocMem(TrackHdr.KeyCount * SizeOf(TPoint3DS)); - for I := 0 to TrackHdr.KeyCount - 1 do - begin - KeyHdrList[I] := ReadKeyHeader; - ScaleList[I].X := ReadSingle; - ScaleList[I].Y := ReadSingle; - ScaleList[I].Z := ReadSingle; - end; - end; - end; - MORPH_TRACK_TAG: - begin - Chunk.Data.MorphTrackTag := AllocMem(SizeOf(TMorphTrackTag)); - with Chunk.Data.MorphTrackTag^ do - begin - TrackHdr := ReadTrackHeader; - KeyHdrList := AllocMem(TrackHdr.KeyCount * SizeOf(TKeyHeader3DS)); - MorphList := AllocMem(TrackHdr.KeyCount * SizeOf(TKFmorphKey3DS)); - for I := 0 to TrackHdr.KeyCount - 1 do - begin - KeyHdrList[I] := ReadKeyHeader; - MorphList[I] := StrPasFree(ReadString); - end; - end; - end; - FOV_TRACK_TAG: - begin - Chunk.Data.FovTrackTag := AllocMem(SizeOf(TFovTrackTag)); - with Chunk.Data.FovTrackTag^ do - begin - TrackHdr := ReadTrackHeader; - KeyHdrList := AllocMem(TrackHdr.KeyCount * SizeOf(TKeyHeader3DS)); - FOVAngleList := AllocMem(TrackHdr.KeyCount * SizeOf(Single)); - for I := 0 to TrackHdr.KeyCount - 1 do - begin - KeyHdrList[I] := ReadKeyHeader; - FOVAngleList[I] := ReadSingle; - end; - end; - end; - ROLL_TRACK_TAG: - begin - Chunk.Data.RollTrackTag := AllocMem(SizeOf(TRollTrackTag)); - with Chunk.Data.RollTrackTag^ do - begin - TrackHdr := ReadTrackHeader; - KeyHdrList := AllocMem(TrackHdr.KeyCount * SizeOf(TKeyHeader3DS)); - RollAngleList := AllocMem(TrackHdr.KeyCount * SizeOf(Single)); - for I := 0 to TrackHdr.KeyCount - 1 do - begin - KeyHdrList[I] := ReadKeyHeader; - RollAngleList[I] := ReadSingle; - end; - end; - end; - HOT_TRACK_TAG: - begin - Chunk.Data.HotTrackTag := AllocMem(SizeOf(THotTrackTag)); - with Chunk.Data.HotTrackTag^ do - begin - TrackHdr := ReadTrackHeader; - KeyHdrList := AllocMem(TrackHdr.KeyCount * SizeOf(TKeyHeader3DS)); - HotspotAngleList := AllocMem(TrackHdr.KeyCount * SizeOf(Single)); - for I := 0 to TrackHdr.KeyCount - 1 do - begin - KeyHdrList[I] := ReadKeyHeader; - HotspotAngleList[I] := ReadSingle; - end; - end; - end; - FALL_TRACK_TAG: - begin - Chunk.Data.FallTrackTag := AllocMem(SizeOf(TFallTrackTag)); - with Chunk.Data.FallTrackTag^ do - begin - TrackHdr := ReadTrackHeader; - KeyHdrList := AllocMem(TrackHdr.KeyCount * SizeOf(TKeyHeader3DS)); - FalloffAngleList := AllocMem(TrackHdr.KeyCount * SizeOf(Single)); - for I := 0 to TrackHdr.KeyCount - 1 do - begin - KeyHdrList[I] := ReadKeyHeader; - FalloffAngleList[I] := ReadSingle; - end; - end; - end; - HIDE_TRACK_TAG: - begin - Chunk.Data.HideTrackTag := AllocMem(SizeOf(THideTrackTag)); - with Chunk.Data.HideTrackTag^ do - begin - TrackHdr := ReadTrackHeader; - KeyHdrList := AllocMem(TrackHdr.KeyCount * SizeOf(TKeyHeader3DS)); - for I := 0 to TrackHdr.KeyCount - 1 do - KeyHdrList[I] := ReadKeyHeader; - end; - end; - M3DMAGIC, // Chunks that do not contain data, or only contain children - MLIBMAGIC, - MDATA, - AMBIENT_LIGHT, - SOLID_BGND, - DEFAULT_VIEW, - MAT_ENTRY, - MAT_AMBIENT, - MAT_DIFFUSE, - MAT_SPECULAR, - MAT_SHININESS, - MAT_SHIN2PCT, - MAT_SHIN3PCT, - MAT_TRANSPARENCY, - MAT_XPFALL, - MAT_REFBLUR, - MAT_SELF_ILPCT, - MAT_TEXMAP, - MAT_TEXMASK, - MAT_TEX2MAP, - MAT_TEX2MASK, - MAT_OPACMAP, - MAT_OPACMASK, - MAT_REFLMAP, - MAT_REFLMASK, - MAT_BUMPMAP, - MAT_BUMPMASK, - MAT_SPECMAP, - MAT_SPECMASK, - MAT_SHINMAP, - MAT_SHINMASK, - MAT_SELFIMAP, - MAT_SELFIMASK, - N_TRI_OBJECT, - KFDATA, - AMBIENT_NODE_TAG, - OBJECT_NODE_TAG, - CAMERA_NODE_TAG, - TARGET_NODE_TAG, - LIGHT_NODE_TAG, - SPOTLIGHT_NODE_TAG, - L_TARGET_NODE_TAG, - CMAGIC, - XDATA_SECTION, - XDATA_GROUP: - ; // do nothing - else // a truely hideous thing to do, but it helps with unknown chunks - if Chunk.Size > 6 then // don't mess with dataless chunks - begin - Chunk.Data.Dummy := AllocMem(Chunk.Size - 6); - ReadData(Chunk.Size - 6, Chunk.Data.Dummy); - end; - end; // end of case - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure TFile3DS.SeekChild(Chunk: PChunk3DS); - -// Function skips to next Chunk on disk by seeking the next file position - -var - Offset: Integer; -begin - Offset := 0; - case Chunk.Tag of - M3DMAGIC, - SMAGIC, - LMAGIC, - MATMAGIC, - MLIBMAGIC, - MDATA, - AMBIENT_LIGHT, - SOLID_BGND, - DEFAULT_VIEW, - MAT_ENTRY, - MAT_AMBIENT, - MAT_DIFFUSE, - MAT_SPECULAR, - MAT_SHININESS, - MAT_SHIN2PCT, - MAT_SHIN3PCT, - MAT_TRANSPARENCY, - MAT_XPFALL, - MAT_REFBLUR, - MAT_SELF_ILPCT, - MAT_TEXMAP, - MAT_TEXMASK, - MAT_TEX2MAP, - MAT_TEX2MASK, - MAT_OPACMAP, - MAT_OPACMASK, - MAT_REFLMAP, - MAT_REFLMASK, - MAT_BUMPMAP, - MAT_BUMPMASK, - MAT_SPECMAP, - MAT_SPECMASK, - MAT_SHINMAP, - MAT_SHINMASK, - MAT_SELFIMAP, - MAT_SELFIMASK, - N_TRI_OBJECT, - XDATA_SECTION, - XDATA_ENTRY, - KFDATA, - OBJECT_NODE_TAG, - CAMERA_NODE_TAG, - TARGET_NODE_TAG, - LIGHT_NODE_TAG, - SPOTLIGHT_NODE_TAG, - L_TARGET_NODE_TAG, - AMBIENT_NODE_TAG, - CMAGIC : - ; // do nothing - M3D_VERSION: - Offset := SizeOf(Integer); - COLOR_F: - Offset := 3 * SizeOf(Single); - COLOR_24: - Offset := 3 * SizeOf(Byte); - INT_PERCENTAGE: - Offset := SizeOf(SmallInt); - FLOAT_PERCENTAGE: - Offset := SizeOf(Single); - MAT_MAPNAME: - FreeMem(ReadString); - MESH_VERSION: - Offset := SizeOf(Integer); - MASTER_SCALE: - Offset := SizeOf(Single); - LO_SHADOW_BIAS: - Offset := SizeOf(Single); - HI_SHADOW_BIAS: - Offset := SizeOf(Single); - SHADOW_MAP_SIZE: - Offset := SizeOf(SmallInt); - SHADOW_SAMPLES: - Offset := SizeOf(SmallInt); - O_CONSTS: - Offset := 12; - V_GRADIENT: - Offset := SizeOf(Single); - NAMED_OBJECT: - FreeMem(ReadString); - BIT_MAP: - FreeMem(ReadString); - FOG: - Offset := 4 * SizeOf(Single); - LAYER_FOG: - Offset := 3 * SizeOf(Single) + SizeOf(Integer); - DISTANCE_CUE: - Offset := 4 * SizeOf(Single); - N_DIRECT_LIGHT: - Offset := 12; - DL_SPOTLIGHT: - Offset := 12 + 2 * SizeOf(Single); - N_CAMERA: - Offset := 24 + 2 * SizeOf(Single); - VIEWPORT_LAYOUT: - Offset := 7 * SizeOf(SmallInt); - VIEW_TOP, - VIEW_BOTTOM, - VIEW_LEFT, - VIEW_RIGHT, - VIEW_FRONT, - VIEW_BACK: - Offset := 12 + SizeOf(Single); - VIEW_USER: - Offset := 12 + 4 * SizeOf(Single); - VIEW_CAMERA: - FreeMem(ReadString); - MAT_NAME: - FreeMem(ReadString); - MAT_ACUBIC: - Offset := 2 * SizeOf(Byte) + 2 * SizeOf(Integer) + SizeOf(SmallInt); - POINT_ARRAY, - POINT_FLAG_ARRAY: - Offset := Chunk.Size - 6; - FACE_ARRAY: - Offset := ReadWord * SizeOf(SmallInt) * 4; - MSH_MAT_GROUP: - Offset := Chunk.Size - 6; - SMOOTH_GROUP: - Offset := Chunk.Size - 6; - TEX_VERTS: - Offset := Chunk.Size - 6; - MESH_MATRIX: - Offset := 12 * SizeOf(Single); - MESH_TEXTURE_INFO: - Offset := Chunk.Size - 6; - PROC_NAME: - FreeMem(ReadString); - DL_LOCAL_SHADOW2: - Offset := 2 * SizeOf(Single) + SizeOf(SmallInt); - KFHDR: - begin - ReadShort; - FreeMem(ReadString); - ReadInteger; - end; - KFSEG: - Offset := 2 * SizeOf(Integer); - KFCURTIME: - Offset := SizeOf(Integer); - NODE_HDR: - begin - FreeMem(ReadString); - Offset := 2 * SizeOf(SmallInt) + SizeOf(SmallInt); - end; - NODE_ID: - Offset := SizeOf(SmallInt); - PIVOT: - Offset := 12; - INSTANCE_NAME: - FreeMem(ReadString); - MORPH_SMOOTH: - Offset := SizeOf(Single); - BOUNDBOX: - Offset := 24; - VPDATA: - Offset := SizeOf(Integer); - else - Offset := Chunk.Size - 6; - end; - FStream.Seek(Offset, soFromCurrent); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.GetDatabaseRelease: TReleaseLevel; - -begin - Result := Formatx.m3DSUtils.GetDatabaseRelease(Self, FDatabase); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function TFile3DS.GetMeshRelease: TReleaseLevel; - -begin - Result := Formatx.m3DSUtils.GetMeshRelease(Self, FDatabase); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -end. diff --git a/Sourcex/Formatx.m3DSConst.pas b/Sourcex/Formatx.m3DSConst.pas deleted file mode 100644 index 5d995017..00000000 --- a/Sourcex/Formatx.m3DSConst.pas +++ /dev/null @@ -1,981 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.m3DSConst; - -(* - All 3DS constant definitions used by the various routines (mainly in Utils3DS.pas). About one thousand - defined constants herein. The guys at Autodesk must be crazy... - Last Change - 03. October 1999 - (c) Copyright 1999, Dipl. Ing. Mike Lischke (public@lischke-online.de) -*) - -interface - -uses - Formatx.m3DSTypes; - -// ---------------- Constants for commonly used structures -------------------- - -const // Flags used by the flag field of the Mesh3DS structure - FaceCAVisable3DS = $0001; // flags the CA edge as visible - FaceBCVisable3DS = $0002; // flags the BC edge as visible - FaceABVisable3DS = $0004; // flags the AB edge as visible - FaceUWrap3DS = $0008; // flags the face as being at - // a texture coord u wrap seam - FaceVWrap3DS = $0010; // flags the face as being at - // a texture coord v wrap seam - - // flags used by the rflags field of the keyheader3DS structure - KeyUsesTension3DS = $01; - KeyUsesCont3DS = $02; - KeyUsesBias3DS = $04; - KeyUsesEaseTo3DS = $08; - KeyUsesEaseFrom3DS = $10; - - // flags used by the track flags field - TrackSingle3DS = $0000; - TrackLoops3DS = $0003; - TrackRepeats3DS = $0002; - TrackLockX3DS = $0008; - TrackLockY3DS = $0010; - TrackLockZ3DS = $0020; - TrackNoLinkX3DS = $0100; - TrackNoLinkY3DS = $0200; - TrackNoLinkZ3DS = $0400; - - // Basic structure default contents for ease of initialization - DefPoint3DS : TPoint3DS = (X: 0; Y: 0; Z: 0); - DefTextVert3DS : TTexVert3DS = (U: 0; V: 0); - DefFace3DS : TFace3DS = (v1: 0; v2: 1; v3: 2; Flag: 0); - DefTrackHeader3DS : TTrackHeader3DS = (Flags: 0; nu1: 0; nu2: 0; KeyCount: 1); - DefKeyHeader3DS : TKeyHeader3DS = (Time: 0; RFlags: 0; Tension: 0; Continuity: 0; Bias: 0; EaseTo: 0; EaseFrom: 0); - DefObjMat3DS : TObjMat3DS = (NameStr: ''; NFaces: 0; FaceIndex: nil); - DefKFRotKey3DS : TKFRotKey3DS = (Angle: 0; X: 0; Y: 0; Z: 1); - - - // Fog Flags - LayerFogBgnd = $100000; - NoFalloff = $0; - TopFalloff = $2; - BottomFalloff = $1; - - // Flags for initflags parameter - InitNoExtras3DS = $0000; - InitVertexArray3DS = $0001; - InitTextArray3DS = $0002; - InitFaceArray3DS = $0004; - InitMatArray3DS = $0008; - InitSmoothArray3DS = $0010; - InitProcData3DS = $0020; - InitVFlagArray3DS = $0040; - - // field codes for RelMeshObjField3ds - RelVertexArray3ds = $0001; - RelTextArray3ds = $0002; - RelFaceArray3ds = $0004; - RelMatArray3ds = $0008; - RelSmoothArray3ds = $0010; - RelProcData3ds = $0020; - RelVFlagArray3ds = $0040; - RelAll3DS = $FFFF; - - // Smoothing group Flags used in the smootharray field of the TMesh3DS structure - Smooth01Group3DS = $00000001; - Smooth02Group3DS = $00000002; - Smooth03Group3DS = $00000004; - Smooth04Group3DS = $00000008; - Smooth05Group3DS = $00000010; - Smooth06Group3DS = $00000020; - Smooth07Group3DS = $00000030; - Smooth08Group3DS = $00000080; - Smooth09Group3DS = $00000100; - Smooth10Group3DS = $00000200; - Smooth11Group3DS = $00000400; - Smooth12Group3DS = $00000800; - Smooth13Group3DS = $00001000; - Smooth14Group3DS = $00002000; - Smooth15Group3DS = $00004000; - Smooth16Group3DS = $00008000; - Smooth17Group3DS = $00010000; - Smooth18Group3DS = $00020000; - Smooth19Group3DS = $00040000; - Smooth20Group3DS = $00080000; - Smooth21Group3DS = $00100000; - Smooth22Group3DS = $00200000; - Smooth23Group3DS = $00400000; - Smooth24Group3DS = $00800000; - Smooth25Group3DS = $01000000; - Smooth26Group3DS = $02000000; - Smooth27Group3DS = $04000000; - Smooth28Group3DS = $08000000; - Smooth29Group3DS = $10000000; - Smooth30Group3DS = $20000000; - Smooth31Group3DS = $40000000; - Smooth32Group3DS = $80000000; - - DummyName3DS = '$$$DUMMY'; - - // flag settings for TKFMesh3DS, TKFOmni3DS, TKFCamera3DS, TKFAmbient and TKFSpot3DS - // ml: these flags correspond directly to NODE_RENDOB_HIDE etc. (see below), I don't know - // what these duplications are for... - - // for the flags field - KfNodeOff3DS = 1 shl 3; - KfHideNode3DS = 1 shl 11; - KfFastNode3DS = 1 shl 12; - - // For the flags2 field - KfNodeHasPath3DS = 1; - KfNodeAutoSmooth3DS = 1 shl 1; - KfNodeFrozen3DS = 1 shl 2; - KfMotionBlur3DS = 1 shl 4; - KfBlurBranch3DS = 1 shl 5; - KfMorphMtl3DS = 1 shl 6; - KfMorphOb3DS = 1 shl 7; - -//-------------- constants that define various value ranges for specific chunks - - // 3DS filename - FileNameStrMax3DS = 512; - - // 3DS file attributes - FileAttrStrMax3DS = 128; - - // MASTER_SCALE chunk - MasterScaleMin3DS = 0; // noninclusive minimum value for master scale - - // LO_SHADOW_BIAS chunk - LoShadowBiasMin3DS = 0; // noninclusive minimum value for low shadow bias setting - - // HI_SHADOW_BIAS chunk - HiShadowBiasMin3DS = 0; // noninclusive minimum value for high shadow bias setting - - // SHADOW_MAP_SIZE chunk - ShadowMapSizeMin3DS = 0; // noninclusive minimum value for shadow map size - - // SHADOW_SAMPLES chunk - ShadowSamplesMin3DS = 0; // noninclusive minimum value for shadow samples - - // SHADOW_RANGE chunk - ShadowRangeMin3DS = 0; // noninclusive minimum value for shadow range - - // SHADOW_FILTER chunk - ShadowFilterMin3DS = 1; // inclusive minimum value for shadow filter - ShadowFilterMax3DS = 10; // inclusive maximum value for shadow filter - - // BITMAP chunk - BitMapStrMax3DS = 12; // maximum string length for filename - - // V_GRADIENT chunk - VGradientMin3DS = 0; // minimum value for gradient midpoint - VGradientMax3DS = 1; // maximum value for gradient midpoint - - // FOG chunk - FogMin3DS = 0; // minimum value for fogging plane density - FogMax3DS = 1; // maximum value for fogging plane density - - // DISTANCE_CUE - DistanceCueMin3DS = 0; // minimum value for dimming factor - DistanceCueMax3DS = 1; // maximum value for dimming factor - - // VIEW_CAMERA - ViewCameraStrMax3DS = 10; // maximum string length for filename - - // MAT_NAME - MatNameStrMax3DS = 16; // maximum string length for material name - - // MAT_SHADING - MatShadingMin3DS = 0; // minimum shading value - MatShadingMax3DS = 3; // maximum shading value - - // MAT_ACUBIC_FMIN - MatACubicFMin3DS = 1; // minimum frame skip count - MatACubicAMin3DS = 0; // minimum reflection map aliasing - MatACubicAMax3DS = 3; // maximum reflection map aliasing - - // used with TAcubic3DS structure - ACubicFirst3DS = $09; - ACubicFlat3DS = $11; - - // POINT_ARRAY - PointArrayMin3DS = 3; // minimum number of vertices - - // FACE_ARRAY - FaceArrayMin3DS = 1; // minimum number of faces - - // MshMatGroup3DS - MshMatGroupMin3DS = 1; // minimum number of faces per material - MshMatGroupStrMax3DS = 16; // maximim string length for MshMatGroup - - // PROC_NAME - ProcNameStrMax3DS = 12; // maximum string length for axp process - - // DL_SPOTLIGHT - DLSpotlightMin3DS = 0; // minimum for hotspot and falloff cones - DLSpotlightMax3DS = 160; // maximum for hotspot and falloff cones - - // DL_LOCAL_SHADOW2 - DLLocalShadow2SMin3DS = 10; // minimum shadow map size - DLLocalShadow2SMax3DS = 4096; // maximum shadow map size - DLLocalShadow2FMin3DS = 1; // minimum shadow map size - DLLocalShadow2FMax3DS = 10; // maximum shadow map size - - // COLOR_F - ColorFMin3DS = 0; // minimum color value in a channel - ColorFMax3DS = 1; // maximum color value in a channel - - // INT_PERCENTAGE - IntPercentageMax3DS = 100; // Maximum integer percentage - - // FLOAT_PERCENTAGE - FloatPercentageMax3DS = 1; // Maximum floating point percentage - - // MAT_MAPNAME - MatMapNameStrMax3DS = 12; // Maximum map name string size - - // NAMED_OBJECT - NamedObjectStrMax3DS = 10; // Maximum named object string size - - // N_CAMERA - NCameraFOVMin3DS = 0.00025; // Minimum field of view for camera - NCameraFOVMax3DS = 160; // Maximum field of view for camera - NCameraFocMin3DS = 10.7813; // Minimum lens size for camera - NCameraFocMax3DS = 10000000; // Maximum lens size for camera - - // KFHDR - KFHdrStrMax3DS = 12; // Maximum keyframe header name string size - - // NODE_HDR - NodeHdrStrMax3DS = 10; // Maximum node name string size - - // INSTANCE_NAME - InstanceNameStrMax3DS = 10; // Maximum instance name string size - - // MORPH_TRACK - MorphTrackStrMax3DS = 10; // Maximum morph object name string size - - // MORPH_SMOOTH - MorphSmoothMin3DS = 0; // Minimum morph smoothing angle - MorphSmoothMax3DS = 360; // Maximum morph smoothing angle - - // Keyframe Spline Limits - KFTensionMin3DS = -1; // Minimum key spline tension - KFTensionMax3DS = 1; // Maximum key spline tension - KFContinuityMin3DS = -1; // Minimum key spline continuity - KFContinuityMax3DS = 1; // Maximum key spline continuity - KFBiasMin3DS = -1; // Minimum key spline bias - KFBiasMax3DS = 1; // Maximum key spline bias - KFEaseToMin3DS = 0; // Minimum key spline ease to - KFEaseToMax3DS = 1; // Maximum key spline ease to - KFEaseFromMin3DS = 0; // Minimum key spline ease from - KFEaseFromMax3DS = 1; // Maximum key spline ease from - - // Track header Limits - TrackHeaderKeysMin3DS = 1; // Minimum number of keys in a track - - // COL_TRACK_TAG_KEY - ColTrackTagMin3DS = 0; // Minimum color value - ColTrackTagMax3DS = 1; // Maximum color value - - // FOV_TRACK_TAG_KEY - FOVTrackTagMin3DS = NCameraFOVMin3DS; // Minimum camera FOV - FOVTrackTagMax3DS = NCameraFOVMax3DS; // Maximum camera FOV - - // HOT_TRACK_TAG_KEY - HotTrackTagMin3DS = 0; // Minimum hot spot angle - HotTrackTagMax3DS = 160; // Maximum hot spot angle - - // FALL_TRACK_TAG_KEY - FallTrackTagMin3DS = 0; // Minimum fall off angle - FallTrackTagMax3DS = 160; // Maximum fall off angle - - KNoID = -1; - - // MAT_TILING - TEX_DECAL = 1; - TEX_MIRROR = 1 shl 1; - TEX_UNUSED1 = 1 shl 2; - TEX_INVERT = 1 shl 3; - TEX_NOWRAP = 1 shl 4; - TEX_SAT = 1 shl 5; // summed area table - TEX_ALPHA_SOURCE = 1 shl 6; // use ALPHA instead of RGB of map - TEX_TINT = 1 shl 7; // tint for color - TEX_DONT_USE_ALPHA = 1 shl 8; // don't use map alpha - TEX_RGB_TINT = 1 shl 9; // do RGB color transform - - // Values for keyframer flags1 - NODE_RENDOB_HIDE = 1 shl 2; - NODE_OFF = 1 shl 3; - ATKEY1 = 1 shl 4; - ATKEY2 = 1 shl 5; - ATKEY3 = 1 shl 6; - ATKEY4 = 1 shl 7; - ATKEY5 = 1 shl 8; - ATKEYFLAGS = ATKEY1 or ATKEY2 or ATKEY3 or ATKEY4 or ATKEY5; - MARK_NODE = 1 shl 9; - DISABLE_NODE = 1 shl 10; - HIDE_NODE = 1 shl 11; - FAST_NODE = 1 shl 12; // draw node quickdraw style - PRIMARY_NODE = 1 shl 14; // corresponds to mesh - NODE_CALC_PATH = 1 shl 15; - - // Values for keyframer flags2 - NODE_HAS_PATH = 1; - NODE_AUTO_SMOOTH = 1 shl 1; - NODE_FROZEN = 1 shl 2; - NODE_ANI_HIDDEN = 1 shl 3; - NODE_MOTION_BLUR = 1 shl 4; - NODE_BLUR_BRANCH = 1 shl 5; - NODE_MORPH_MTL = 1 shl 6; - NODE_MORPH_OB = 1 shl 7; - -//----------------- List of all chunk IDs ------------------------------------- - - NULL_CHUNK = $0000; - - // Trick Chunk Flags For ChunkSyntax function - ChunkType = $0995; - ChunkUnique = $0996; - NotChunk = $0997; - Container = $0998; - IsChunk = $0999; - - // Dummy Chunk that sometimes appears in 3DS files created by prerelease 3D Studio R2 - DUMMY = $FFFF; - - // Trick Chunk Types For Open, Write, Close functions - POINT_ARRAY_ENTRY = $F110; - POINT_FLAG_ARRAY_ENTRY = $F111; - FACE_ARRAY_ENTRY = $F120; - MSH_MAT_GROUP_ENTRY = $F130; - TEX_VERTS_ENTRY = $F140; - SMOOTH_GROUP_ENTRY = $F150; - POS_TRACK_TAG_KEY = $F020; - ROT_TRACK_TAG_KEY = $F021; - SCL_TRACK_TAG_KEY = $F022; - FOV_TRACK_TAG_KEY = $F023; - ROLL_TRACK_TAG_KEY = $F024; - COL_TRACK_TAG_KEY = $F025; - MORPH_TRACK_TAG_KEY = $F026; - HOT_TRACK_TAG_KEY = $F027; - FALL_TRACK_TAG_KEY = $F028; - - // 3DS file Chunk IDs - M3DMAGIC = $4D4D; - SMAGIC = $2D2D; - LMAGIC = $2D3D; - MLIBMAGIC = $3DAA; - MATMAGIC = $3DFF; - M3D_VERSION = $0002; - M3D_KFVERSION = $0005; - - // Mesh Chunk Ids - MDATA = $3D3D; - MESH_VERSION = $3D3E; - COLOR_F = $0010; - COLOR_24 = $0011; - LIN_COLOR_24 = $0012; - LIN_COLOR_F = $0013; - INT_PERCENTAGE = $0030; - FLOAT_PERCENTAGE = $0031; - MASTER_SCALE = $0100; - BIT_MAP = $1100; - USE_BIT_MAP = $1101; - SOLID_BGND = $1200; - USE_SOLID_BGND = $1201; - V_GRADIENT = $1300; - USE_V_GRADIENT = $1301; - LO_SHADOW_BIAS = $1400; - HI_SHADOW_BIAS = $1410; - SHADOW_MAP_SIZE = $1420; - SHADOW_SAMPLES = $1430; - SHADOW_RANGE = $1440; - SHADOW_FILTER = $1450; - RAY_BIAS = $1460; - O_CONSTS = $1500; - AMBIENT_LIGHT = $2100; - FOG = $2200; - USE_FOG = $2201; - FOG_BGND = $2210; - DISTANCE_CUE = $2300; - USE_DISTANCE_CUE = $2301; - LAYER_FOG = $2302; - USE_LAYER_FOG = $2303; - DCUE_BGND = $2310; - DEFAULT_VIEW = $3000; - VIEW_TOP = $3010; - VIEW_BOTTOM = $3020; - VIEW_LEFT = $3030; - VIEW_RIGHT = $3040; - VIEW_FRONT = $3050; - VIEW_BACK = $3060; - VIEW_USER = $3070; - VIEW_CAMERA = $3080; - VIEW_WINDOW = $3090; - NAMED_OBJECT = $4000; - OBJ_HIDDEN = $4010; - OBJ_VIS_LOFTER = $4011; - OBJ_DOESNT_CAST = $4012; - OBJ_MATTE = $4013; - OBJ_FAST = $4014; - OBJ_PROCEDURAL = $4015; - OBJ_FROZEN = $4016; - OBJ_DONT_RCVSHADOW = $4017; - N_TRI_OBJECT = $4100; - POINT_ARRAY = $4110; - POINT_FLAG_ARRAY = $4111; - FACE_ARRAY = $4120; - MSH_MAT_GROUP = $4130; - OLD_MAT_GROUP = $4131; - TEX_VERTS = $4140; - SMOOTH_GROUP = $4150; - MESH_MATRIX = $4160; - MESH_COLOR = $4165; - MESH_TEXTURE_INFO = $4170; - PROC_NAME = $4181; - PROC_DATA = $4182; - MSH_BOXMAP = $4190; - N_D_L_OLD = $4400; - N_CAM_OLD = $4500; - N_DIRECT_LIGHT = $4600; - DL_SPOTLIGHT = $4610; - DL_OFF = $4620; - DL_ATTENUATE = $4625; - DL_RAYSHAD = $4627; - DL_SHADOWED = $4630; - DL_LOCAL_SHADOW = $4640; - DL_LOCAL_SHADOW2 = $4641; - DL_SEE_CONE = $4650; - DL_SPOT_RECTANGULAR = $4651; - DL_SPOT_OVERSHOOT = $4652; - DL_SPOT_PROJECTOR = $4653; - DL_EXCLUDE = $4654; - DL_RANGE = $4655; - - // Not used in R3 - DL_SPOT_ROLL = $4656; - DL_SPOT_ASPECT = $4657; - DL_RAY_BIAS = $4658; - DL_INNER_RANGE = $4659; - DL_OUTER_RANGE = $465A; - DL_MULTIPLIER = $465B; - N_AMBIENT_LIGHT = $4680; - N_CAMERA = $4700; - CAM_SEE_CONE = $4710; - CAM_RANGES = $4720; - HIERARCHY = $4F00; - PARENT_OBJECT = $4F10; - PIVOT_OBJECT = $4F20; - PIVOT_LIMITS = $4F30; - PIVOT_ORDER = $4F40; - XLATE_RANGE = $4F50; - POLY_2D = $5000; - - // Flags in shaper AFile that tell whether polys make up an ok shape - SHAPE_OK = $5010; - SHAPE_NOT_OK = $5011; - SHAPE_HOOK = $5020; - PATH_3D = $6000; - PATH_MATRIX = $6005; - SHAPE_2D = $6010; - M_SCALE = $6020; - M_TWIST = $6030; - M_TEETER = $6040; - M_FIT = $6050; - M_BEVEL = $6060; - XZ_CURVE = $6070; - YZ_CURVE = $6080; - INTERPCT = $6090; - DEFORM_LIMIT = $60A0; - - // Flags for Modeler options - USE_CONTOUR = $6100; - USE_TWEEN = $6110; - USE_SCALE = $6120; - USE_TWIST = $6130; - USE_TEETER = $6140; - USE_FIT = $6150; - USE_BEVEL = $6160; - - // Viewport description chunks - VIEWPORT_LAYOUT_OLD = $7000; - VIEWPORT_DATA_OLD = $7010; - VIEWPORT_LAYOUT = $7001; - VIEWPORT_DATA = $7011; - VIEWPORT_DATA_3 = $7012; - VIEWPORT_SIZE = $7020; - NETWORK_VIEW = $7030; - - // External Application Data - XDATA_SECTION = $8000; - XDATA_ENTRY = $8001; - XDATA_APPNAME = $8002; - XDATA_STRING = $8003; - XDATA_FLOAT = $8004; - XDATA_DOUBLE = $8005; - XDATA_SHORT = $8006; - XDATA_LONG = $8007; - XDATA_VOID = $8008; - XDATA_GROUP = $8009; - XDATA_RFU6 = $800A; - XDATA_RFU5 = $800B; - XDATA_RFU4 = $800C; - XDATA_RFU3 = $800D; - XDATA_RFU2 = $800E; - XDATA_RFU1 = $800F; - PARENT_NAME = $80F0; - - // Material Chunk IDs - MAT_ENTRY = $AFFF; - MAT_NAME = $A000; - MAT_AMBIENT = $A010; - MAT_DIFFUSE = $A020; - MAT_SPECULAR = $A030; - MAT_SHININESS = $A040; - MAT_SHIN2PCT = $A041; - MAT_SHIN3PCT = $A042; - MAT_TRANSPARENCY = $A050; - MAT_XPFALL = $A052; - MAT_REFBLUR = $A053; - MAT_SELF_ILLUM = $A080; - MAT_TWO_SIDE = $A081; - MAT_DECAL = $A082; - MAT_ADDITIVE = $A083; - MAT_SELF_ILPCT = $A084; - MAT_WIRE = $A085; - MAT_SUPERSMP = $A086; - MAT_WIRESIZE = $A087; - MAT_FACEMAP = $A088; - MAT_XPFALLIN = $A08A; - MAT_PHONGSOFT = $A08C; - MAT_WIREABS = $A08E; - MAT_SHADING = $A100; - MAT_TEXMAP = $A200; - MAT_OPACMAP = $A210; - MAT_REFLMAP = $A220; - MAT_BUMPMAP = $A230; - MAT_SPECMAP = $A204; - MAT_USE_XPFALL = $A240; - MAT_USE_REFBLUR = $A250; - MAT_BUMP_PERCENT = $A252; - MAT_MAPNAME = $A300; - MAT_ACUBIC = $A310; - MAT_SXP_TEXT_DATA = $A320; - MAT_SXP_TEXT2_DATA = $A321; - MAT_SXP_OPAC_DATA = $A322; - MAT_SXP_BUMP_DATA = $A324; - MAT_SXP_SPEC_DATA = $A325; - MAT_SXP_SHIN_DATA = $A326; - MAT_SXP_SELFI_DATA = $A328; - MAT_SXP_TEXT_MASKDATA = $A32A; - MAT_SXP_TEXT2_MASKDATA = $A32C; - MAT_SXP_OPAC_MASKDATA = $A32E; - MAT_SXP_BUMP_MASKDATA = $A330; - MAT_SXP_SPEC_MASKDATA = $A332; - MAT_SXP_SHIN_MASKDATA = $A334; - MAT_SXP_SELFI_MASKDATA = $A336; - MAT_SXP_REFL_MASKDATA = $A338; - MAT_TEX2MAP = $A33A; - MAT_SHINMAP = $A33C; - MAT_SELFIMAP = $A33D; - MAT_TEXMASK = $A33E; - MAT_TEX2MASK = $A340; - MAT_OPACMASK = $A342; - MAT_BUMPMASK = $A344; - MAT_SHINMASK = $A346; - MAT_SPECMASK = $A348; - MAT_SELFIMASK = $A34A; - MAT_REFLMASK = $A34C; - MAT_MAP_TILINGOLD = $A350; - MAT_MAP_TILING = $A351; - MAT_MAP_TEXBLUR_OLD = $A352; - MAT_MAP_TEXBLUR = $A353; - MAT_MAP_USCALE = $A354; - MAT_MAP_VSCALE = $A356; - MAT_MAP_UOFFSET = $A358; - MAT_MAP_VOFFSET = $A35A; - MAT_MAP_ANG = $A35C; - MAT_MAP_COL1 = $A360; - MAT_MAP_COL2 = $A362; - MAT_MAP_RCOL = $A364; - MAT_MAP_GCOL = $A366; - MAT_MAP_BCOL = $A368; - - // Keyframe Chunk IDs - KFDATA = $B000; - KFHDR = $B00A; - AMBIENT_NODE_TAG = $B001; - OBJECT_NODE_TAG = $B002; - CAMERA_NODE_TAG = $B003; - TARGET_NODE_TAG = $B004; - LIGHT_NODE_TAG = $B005; - L_TARGET_NODE_TAG = $B006; - SPOTLIGHT_NODE_TAG = $B007; - KFSEG = $B008; - KFCURTIME = $B009; - NODE_HDR = $B010; - INSTANCE_NAME = $B011; - PRESCALE = $B012; - PIVOT = $B013; - BOUNDBOX = $B014; - MORPH_SMOOTH = $B015; - POS_TRACK_TAG = $B020; - ROT_TRACK_TAG = $B021; - SCL_TRACK_TAG = $B022; - FOV_TRACK_TAG = $B023; - ROLL_TRACK_TAG = $B024; - COL_TRACK_TAG = $B025; - MORPH_TRACK_TAG = $B026; - HOT_TRACK_TAG = $B027; - FALL_TRACK_TAG = $B028; - HIDE_TRACK_TAG = $B029; - NODE_ID = $B030; - CMAGIC = $C23D; - C_MDRAWER = $C010; - C_TDRAWER = $C020; - C_SHPDRAWER = $C030; - C_MODDRAWER = $C040; - C_RIPDRAWER = $C050; - C_TXDRAWER = $C060; - C_PDRAWER = $C062; - C_MTLDRAWER = $C064; - C_FLIDRAWER = $C066; - C_CUBDRAWER = $C067; - C_MFILE = $C070; - C_SHPFILE = $C080; - C_MODFILE = $C090; - C_RIPFILE = $C0A0; - C_TXFILE = $C0B0; - C_PFILE = $C0B2; - C_MTLFILE = $C0B4; - C_FLIFILE = $C0B6; - C_PALFILE = $C0B8; - C_TX_STRING = $C0C0; - C_CONSTS = $C0D0; - C_SNAPS = $C0E0; - C_GRIDS = $C0F0; - C_ASNAPS = $C100; - C_GRID_RANGE = $C110; - C_RENDTYPE = $C120; - C_PROGMODE = $C130; - C_PREVMODE = $C140; - C_MODWMODE = $C150; - C_MODMODEL = $C160; - C_ALL_LINES = $C170; - C_BACK_TYPE = $C180; - C_MD_CS = $C190; - C_MD_CE = $C1A0; - C_MD_SML = $C1B0; - C_MD_SMW = $C1C0; - C_LOFT_WITH_TEXTURE = $C1C3; - C_LOFT_L_REPEAT = $C1C4; - C_LOFT_W_REPEAT = $C1C5; - C_LOFT_UV_NORMALIZE = $C1C6; - C_WELD_LOFT = $C1C7; - C_MD_PDET = $C1D0; - C_MD_SDET = $C1E0; - C_RGB_RMODE = $C1F0; - C_RGB_HIDE = $C200; - C_RGB_MAPSW = $C202; - C_RGB_TWOSIDE = $C204; - C_RGB_SHADOW = $C208; - C_RGB_AA = $C210; - C_RGB_OVW = $C220; - C_RGB_OVH = $C230; - C_RGB_PICTYPE = $C240; - C_RGB_OUTPUT = $C250; - C_RGB_TODISK = $C253; - C_RGB_COMPRESS = $C254; - C_JPEG_COMPRESSION = $C255; - C_RGB_DISPDEV = $C256; - C_RGB_HARDDEV = $C259; - C_RGB_PATH = $C25A; - C_BITMAP_DRAWER = $C25B; - C_RGB_FILE = $C260; - C_RGB_OVASPECT = $C270; - C_RGB_ANIMTYPE = $C271; - C_RENDER_ALL = $C272; - C_REND_FROM = $C273; - C_REND_TO = $C274; - C_REND_NTH = $C275; - C_PAL_TYPE = $C276; - C_RND_TURBO = $C277; - C_RND_MIP = $C278; - C_BGND_METHOD = $C279; - C_AUTO_REFLECT = $C27A; - C_VP_FROM = $C27B; - C_VP_TO = $C27C; - C_VP_NTH = $C27D; - C_REND_TSTEP = $C27E; - C_VP_TSTEP = $C27F; - C_SRDIAM = $C280; - C_SRDEG = $C290; - C_SRSEG = $C2A0; - C_SRDIR = $C2B0; - C_HETOP = $C2C0; - C_HEBOT = $C2D0; - C_HEHT = $C2E0; - C_HETURNS = $C2F0; - C_HEDEG = $C300; - C_HESEG = $C310; - C_HEDIR = $C320; - C_QUIKSTUFF = $C330; - C_SEE_LIGHTS = $C340; - C_SEE_CAMERAS = $C350; - C_SEE_3D = $C360; - C_MESHSEL = $C370; - C_MESHUNSEL = $C380; - C_POLYSEL = $C390; - C_POLYUNSEL = $C3A0; - C_SHPLOCAL = $C3A2; - C_MSHLOCAL = $C3A4; - C_NUM_FORMAT = $C3B0; - C_ARCH_DENOM = $C3C0; - C_IN_DEVICE = $C3D0; - C_MSCALE = $C3E0; - C_COMM_PORT = $C3F0; - C_TAB_BASES = $C400; - C_TAB_DIVS = $C410; - C_MASTER_SCALES = $C420; - C_SHOW_1STVERT = $C430; - C_SHAPER_OK = $C440; - C_LOFTER_OK = $C450; - C_EDITOR_OK = $C460; - C_KEYFRAMER_OK = $C470; - C_PICKSIZE = $C480; - C_MAPTYPE = $C490; - C_MAP_DISPLAY = $C4A0; - C_TILE_XY = $C4B0; - C_MAP_XYZ = $C4C0; - C_MAP_SCALE = $C4D0; - C_MAP_MATRIX_OLD = $C4E0; - C_MAP_MATRIX = $C4E1; - C_MAP_WID_HT = $C4F0; - C_OBNAME = $C500; - C_CAMNAME = $C510; - C_LTNAME = $C520; - C_CUR_MNAME = $C525; - C_CURMTL_FROM_MESH = $C526; - C_GET_SHAPE_MAKE_FACES = $C527; - C_DETAIL = $C530; - C_VERTMARK = $C540; - C_MSHAX = $C550; - C_MSHCP = $C560; - C_USERAX = $C570; - C_SHOOK = $C580; - C_RAX = $C590; - C_STAPE = $C5A0; - C_LTAPE = $C5B0; - C_ETAPE = $C5C0; - C_KTAPE = $C5C8; - C_SPHSEGS = $C5D0; - C_GEOSMOOTH = $C5E0; - C_HEMISEGS = $C5F0; - C_PRISMSEGS = $C600; - C_PRISMSIDES = $C610; - C_TUBESEGS = $C620; - C_TUBESIDES = $C630; - C_TORSEGS = $C640; - C_TORSIDES = $C650; - C_CONESIDES = $C660; - C_CONESEGS = $C661; - C_NGPARMS = $C670; - C_PTHLEVEL = $C680; - C_MSCSYM = $C690; - C_MFTSYM = $C6A0; - C_MTTSYM = $C6B0; - C_SMOOTHING = $C6C0; - C_MODICOUNT = $C6D0; - C_FONTSEL = $C6E0; - C_TESS_TYPE = $C6f0; - C_TESS_TENSION = $C6f1; - C_SEG_START = $C700; - C_SEG_END = $C705; - C_CURTIME = $C710; - C_ANIMLENGTH = $C715; - C_PV_FROM = $C720; - C_PV_TO = $C725; - C_PV_DOFNUM = $C730; - C_PV_RNG = $C735; - C_PV_NTH = $C740; - C_PV_TYPE = $C745; - C_PV_METHOD = $C750; - C_PV_FPS = $C755; - C_VTR_FRAMES = $C765; - C_VTR_HDTL = $C770; - C_VTR_HD = $C771; - C_VTR_TL = $C772; - C_VTR_IN = $C775; - C_VTR_PK = $C780; - C_VTR_SH = $C785; - - // Material chunks - C_WORK_MTLS = $C790; // Old-style -- now ignored - C_WORK_MTLS_2 = $C792; // Old-style -- now ignored - C_WORK_MTLS_3 = $C793; // Old-style -- now ignored - C_WORK_MTLS_4 = $C794; // Old-style -- now ignored - C_WORK_MTLS_5 = $CB00; // Old-style -- now ignored - C_WORK_MTLS_6 = $CB01; // Old-style -- now ignored - C_WORK_MTLS_7 = $CB02; // Old-style -- now ignored - C_WORK_MTLS_8 = $CB03; // Old-style -- now ignored - C_WORKMTL = $CB04; - C_SXP_TEXT_DATA = $CB10; - C_SXP_TEXT2_DATA = $CB20; - C_SXP_OPAC_DATA = $CB11; - C_SXP_BUMP_DATA = $CB12; - C_SXP_SPEC_DATA = $CB24; - C_SXP_SHIN_DATA = $CB13; - C_SXP_SELFI_DATA = $CB28; - C_SXP_TEXT_MASKDATA = $CB30; - C_SXP_TEXT2_MASKDATA = $CB32; - C_SXP_OPAC_MASKDATA = $CB34; - C_SXP_BUMP_MASKDATA = $CB36; - C_SXP_SPEC_MASKDATA = $CB38; - C_SXP_SHIN_MASKDATA = $CB3A; - C_SXP_SELFI_MASKDATA = $C3CB; - C_SXP_REFL_MASKDATA = $CB3E; - C_BGTYPE = $C7A1; - C_MEDTILE = $C7B0; - - // Contrast - C_LO_CONTRAST = $C7D0; - C_HI_CONTRAST = $C7D1; - - // 3d frozen display - C_FROZ_DISPLAY = $C7E0; - - // Booleans - C_BOOLWELD = $C7f0; - C_BOOLTYPE = $C7f1; - C_ANG_THRESH = $C900; - C_SS_THRESH = $C901; - C_TEXTURE_BLUR_DEFAULT = $C903; - C_MAPDRAWER = $CA00; - C_MAPDRAWER1 = $CA01; - C_MAPDRAWER2 = $CA02; - C_MAPDRAWER3 = $CA03; - C_MAPDRAWER4 = $CA04; - C_MAPDRAWER5 = $CA05; - C_MAPDRAWER6 = $CA06; - C_MAPDRAWER7 = $CA07; - C_MAPDRAWER8 = $CA08; - C_MAPDRAWER9 = $CA09; - C_MAPDRAWER_ENTRY = $CA10; - - // system options - C_BACKUP_FILE = $CA20; - C_DITHER_256 = $CA21; - C_SAVE_LAST = $CA22; - C_USE_ALPHA = $CA23; - C_TGA_DEPTH = $CA24; - C_REND_FIELDS = $CA25; - C_REFLIP = $CA26; - C_SEL_ITEMTOG = $CA27; - C_SEL_RESET = $CA28; - C_STICKY_KEYINF = $CA29; - C_WELD_THRESHOLD = $CA2A; - C_ZCLIP_POINT = $CA2B; - C_ALPHA_SPLIT = $CA2C; - C_KF_SHOW_BACKFACE = $CA30; - C_OPTIMIZE_LOFT = $CA40; - C_TENS_DEFAULT = $CA42; - C_CONT_DEFAULT = $CA44; - C_BIAS_DEFAULT = $CA46; - C_DXFNAME_SRC = $CA50; - C_AUTO_WELD = $CA60; - C_AUTO_UNIFY = $CA70; - C_AUTO_SMOOTH = $CA80; - C_DXF_SMOOTH_ANG = $CA90; - C_SMOOTH_ANG = $CAA0; - - // Special network-use chunks - C_NET_USE_VPOST = $CC00; - C_NET_USE_GAMMA = $CC10; - C_NET_FIELD_ORDER = $CC20; - C_BLUR_FRAMES = $CD00; - C_BLUR_SAMPLES = $CD10; - C_BLUR_DUR = $CD20; - C_HOT_METHOD = $CD30; - C_HOT_CHECK = $CD40; - C_PIXEL_SIZE = $CD50; - C_DISP_GAMMA = $CD60; - C_FBUF_GAMMA = $CD70; - C_FILE_OUT_GAMMA = $CD80; - C_FILE_IN_GAMMA = $CD82; - C_GAMMA_CORRECT = $CD84; - C_APPLY_DISP_GAMMA = $CD90; // OBSOLETE - C_APPLY_FBUF_GAMMA = $CDA0; // OBSOLETE - C_APPLY_FILE_GAMMA = $CDB0; // OBSOLETE - C_FORCE_WIRE = $CDC0; - C_RAY_SHADOWS = $CDD0; - C_MASTER_AMBIENT = $CDE0; - C_SUPER_SAMPLE = $CDF0; - C_OBJECT_MBLUR = $CE00; - C_MBLUR_DITHER = $CE10; - C_DITHER_24 = $CE20; - C_SUPER_BLACK = $CE30; - C_SAFE_FRAME = $CE40; - C_VIEW_PRES_RATIO = $CE50; - C_BGND_PRES_RATIO = $CE60; - C_NTH_SERIAL_NUM = $CE70; - - // Video Post - VPDATA = $D000; - P_QUEUE_ENTRY = $D100; - P_QUEUE_IMAGE = $D110; - P_QUEUE_USEIGAMMA = $D114; - P_QUEUE_PROC = $D120; - P_QUEUE_SOLID = $D130; - P_QUEUE_GRADIENT = $D140; - P_QUEUE_KF = $D150; - P_QUEUE_MOTBLUR = $D152; - P_QUEUE_MB_REPEAT = $D153; - P_QUEUE_NONE = $D160; - P_QUEUE_RESIZE = $D180; - P_QUEUE_OFFSET = $D185; - P_QUEUE_ALIGN = $D190; - P_CUSTOM_SIZE = $D1a0; - P_ALPH_NONE = $D210; - P_ALPH_PSEUDO = $D220; // Old Chunk - P_ALPH_OP_PSEUDO = $D221; // Old Chunk - P_ALPH_BLUR = $D222; // Replaces pseudo - P_ALPH_PCOL = $D225; - P_ALPH_C0 = $D230; - P_ALPH_OP_KEY = $D231; - P_ALPH_KCOL = $D235; - P_ALPH_OP_NOCONV = $D238; - P_ALPH_IMAGE = $D240; - P_ALPH_ALPHA = $D250; - P_ALPH_QUES = $D260; - P_ALPH_QUEIMG = $D265; - P_ALPH_CUTOFF = $D270; - P_ALPHANEG = $D280; - P_TRAN_NONE = $D300; - P_TRAN_IMAGE = $D310; - P_TRAN_FRAMES = $D312; - P_TRAN_FADEIN = $D320; - P_TRAN_FADEOUT = $D330; - P_TRANNEG = $D340; - P_RANGES = $D400; - P_PROC_DATA = $D500; - - - NodeTagCount = 6; // number of entries in node tag list - NodeTags: array[1..NodeTagCount] of Word = - (TARGET_NODE_TAG, - OBJECT_NODE_TAG, - CAMERA_NODE_TAG, - LIGHT_NODE_TAG, - L_TARGET_NODE_TAG, - SPOTLIGHT_NODE_TAG - ); - -//--------------------------------------------------------------------------------------------------------------------- - -implementation - -//--------------------------------------------------------------------------------------------------------------------- - -end. - diff --git a/Sourcex/Formatx.m3DSTypes.pas b/Sourcex/Formatx.m3DSTypes.pas deleted file mode 100644 index 20c8fbad..00000000 --- a/Sourcex/Formatx.m3DSTypes.pas +++ /dev/null @@ -1,1314 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.m3DSTypes; - -(* Implements the standard Teapot, build from evaluators. *) - -// This unit contains all of the data types used by the core routines. Most of these are only used -// with the internal database, created when a file is loaded. -// Initial developer -// (c) Copyright 1999, Dipl. Ing. Mike Lischke (public@lischke-online.de) - - -{$ALIGN ON} -{$MINENUMSIZE 4} - -interface - -{.$I GXS.inc} - -uses - System.Classes, // for TStringList - System.SysUtils; - -//---------------- commonly used structures ---------------------------------- - -type - TDumpLevel = (dlTerseDump, dlMediumDump, dlMaximumDump); - - PChar3DS = PAnsiChar; - String3DS = UTF8String; - String64 = string[64]; - - PWordList = ^TWordList; - TWordList = array[0..MaxInt div (2*SizeOf(Word))] of Word; - - PIntegerArray = ^TIntegerArray; - TIntegerArray = array[0..MaxInt div (2*SizeOf(Integer))] of Integer; - - PCardinalArray = ^TCardinalArray; - TCardinalArray = array[0..MaxInt div (2*SizeOf(Cardinal))] of Cardinal; - - PSingleList = ^TSingleList; - TSingleList = array[0..MaxInt div (2*SizeOf(Single))] of Single; - - PPoint3DS = ^TPoint3DS; // 3D point structure - TPoint3DS = record - X, Y, Z : Single; - end; - PPointList = ^TPointList; - TPointList = array[0..MaxInt div (2*SizeOf(TPoint3DS))] of TPoint3DS; - - PFColor3DS = ^TFColor3DS; // RGB Color components - TFColor3DS = record - R, G, B: Single; - end; - PFColorList = ^TFColorList; - TFColorList = array[0..MaxInt div (2*SizeOf(TFColor3DS))] of TFColor3DS; - - PFace3DS = ^TFace3DS; // Face List element - TFace3DS = packed record - case Boolean of - True: (V1, V2, V3, Flag: Word); - False: (FaceRec: array[0..3] of Word); - end; - PFaceList = ^TFaceList; - TFaceList = array[0..MaxInt div (2*SizeOf(TFace3DS))] of TFace3DS; - - PTexVert3DS = ^TTexVert3DS; // Texture assignment coordinate - TTexVert3DS = record - U, V: Single; - end; - PTexVertList = ^TTexVertList; - TTexVertList = array[0..MaxInt div (2*SizeOf(TTexVert3DS))] of TTexVert3DS; - - PTrackHeader3DS = ^TTrackHeader3DS; // Global track settings - TTrackHeader3DS = record - Flags: Word; - nu1, nu2, - KeyCount: Integer; // Number of keys in the track - end; - - PKeyHeader3DS = ^TKeyHeader3DS; // Animation key settings - TKeyHeader3DS = record - Time: Integer; // Key's frame position - RFlags: Word; // Spline terms used flag - Tension: Single; // Flagged with $01 - Continuity: Single; // Flagged with $02 - Bias: Single; // Flagged with $04 - EaseTo: Single; // Flagged with $08 - EaseFrom: Single; // Flagged with $10 - end; - PKeyHeaderList = ^TKeyHeaderList; - TKeyHeaderList = array[0..MaxInt div (2*SizeOf(TKeyHeader3DS))] of TKeyHeader3DS; - - PKFRotKey3DS = ^TKFRotKey3DS; // Rotation key - TKFRotKey3DS = record - Angle: Single; // Angle of Rotation - X, Y, Z: Single; // Rotation axis vector - end; - PKFRotKeyList = ^TKFRotKeyList; - TKFRotKeyList = array[0..MaxInt div (2*SizeOf(TKFRotKey3DS))] of TKFRotKey3DS; - - PKFMorphKey3DS = ^TKFMorphKey3DS; // Object Morph key - TKFMorphKey3DS = String; // Name of Target Morph object - - PKFMorphKeyList = ^TKFMorphKeyList; - TKFMorphKeyList = array[0..MaxInt div (2*SizeOf(TKFMorphKey3DS))] of TKFMorphKey3DS; - - PChunk3DS = ^TChunk3DS; // internal database representation of file information - - PChunkListEntry3DS = ^TChunkListEntry3DS; // cross reference between Name and Chunk - TChunkListEntry3DS = record - NameStr: String; // chunk name list - Chunk: PChunk3DS; // corresponding pos - end; - PChunkList = ^TChunkList; - TChunkList = array[0..MaxInt div (2*SizeOf(TChunkListEntry3DS))] of TChunkListEntry3DS; - - PChunkList3DS = ^TChunkList3DS; // list of cross references - TChunkList3DS = record - Count: Integer; // number of entries in List - List: PChunkList; // contents of List - end; - - { replaced by a TStringList - PNameList = ^TNameList; - TNameList = array[0..0] of String; - - PNameList3DS = ^TNameList3DS; // list of database object names - TNameList3DS = record - Count : Integer; // how many entries are in list - Spaces : Integer; // how much space for entries - Names : PNameList; // to access pointers - end;} - - // Database type settings - TDBType3DS = (dbUnknown, // database has not been created yet - dbMeshFile, // 3D Studio .3DS file - dbProjectFile, // 3D Studio .PRJ file - dbMaterialFile // 3D Studio .MLI file - ); - - PNodeList = ^TNodeList; - TNodeList = record - ID: SmallInt; - Tag: Word; - Name, - InstStr: String; - ParentID: SmallInt; - Next: PNodeList; - end; - - PDatabase3DS = ^TDatabase3DS; // file database - TDatabase3DS = record - TopChunk: PChunk3DS; // Top chunk in the file - ObjListDirty, // If True, than ObjList needs to be recreated - MatListDirty, - NodeListDirty: Boolean; - ObjList, // Quick Cross references between names and database chunks - MatList, - NodeList: PChunkList3DS; - end; - - TViewType3DS = (vtNoView3DS, - vtTopView3DS, - vtBottomView3DS, - vtLeftView3DS, - vtRightView3DS, - vtFrontView3DS, - vtBackView3DS, - vtUserView3DS, - vtCameraView3DS, - vtSpotlightView3DS); - - PViewSize3DS = ^TViewSize3DS; - TViewSize3DS = record - XPos, - YPos, - Width, - Height: Word; - end; - - POrthoView3DS = ^TOrthoView3DS; // Used to describe Top, Bottom, left, right, front and back views - TOrthoView3DS = record - Center: TPoint3DS; // Center of orthogonal View - Zoom: Single; // View Zoom factor - end; - - PUserView3DS = ^TUserView3DS; - TUserView3DS = record // Used to describe User views - Center: TPoint3DS; // Center of User View - Zoom: Single; // View Zoom factor - HorAng: Single; // Horizontal Angle of View - VerAng: Single; // Vertical Angle of View - end; - - PViewport3DS = ^TViewport3DS; // Viewport structure details the kind of View in a viewport - TViewport3DS = record - AType: TViewType3DS; // top, bottom, left, right, front, back, user and camera, spot - Size: TViewSize3DS; // size of the viewport - Ortho: TOrthoView3DS; // used for top, bottom, left, right, front, and back views - User: TUserView3DS; // Used for User views - CameraStr: String; // used for camera views - end; - - TShadowStyle3DS = (ssUseShadowMap, - ssUseRayTraceShadow); - - PShadowSets3DS = ^TShadowSets3DS; // global Shadow settings - TShadowSets3DS = record - AType: TShadowStyle3DS; // either UseShadowMaps or UseRayTraceShadows - Bias: Single; // Shadow Bias factor. - RayBias: Single; // Shadow ray Bias factor, Used in R3 - MapSize: Smallint; // Shadow Map Size - Filter: Single; // Shadow Filter - end; - - PMeshSet3DS = ^TMeshSet3DS; - TMeshSet3DS = record - MasterScale: Single; // master mesh Scale factor - Shadow: TShadowSets3DS; // Global Shadow settings - AmbientLight: TFColor3DS; // Ambient light Color - OConsts: TPoint3DS; // default object constructing axis - end; - - TAtmosphereType3DS = (atNoAtmo, // no active atmospherics - atUseFog, // Fog atmospheric - atUseLayerFog, // layer Fog atmospheric - atUseDistanceCue // distance cue atmospheric - ); - - TLayerFogFalloff3DS = (lfNoFall, // no FallOff - lfTopFall, // FallOff to the Top - lfBottomFall // FallOff to the Bottom - ); - - PFogSettings3DS = ^TFogSettings3DS; // Fog atmosphere parameters - TFogSettings3DS = record - NearPlane: Single; // near radius of Fog effect - NearDensity: Single; // near Fog Density - FarPlane: Single; // far radius of Fog effect - FarDensity: Single; // far Fog Density - FogColor: TFColor3DS; // Color of Fog effect - FogBgnd: Boolean; // "Fog background" Flag - end; - - PLayerFogSettings3DS = ^TLayerFogSettings3DS; // layered Fog atmosphere parameters - TLayerFogSettings3DS = record - ZMin: Single; // lower bounds of Fog - ZMax: Single; // upper bounds of Fog - Density: Single; // Fog Density - FogColor: TFColor3DS; // Fog Color - FallOff: TLayerFogFalloff3DS; // FallOff style - FogBgnd: Boolean; // "Fog background" Flag - end; - - PDCueSettings3DS = ^TDCueSettings3DS; // distance cue atmosphere parameters - TDCueSettings3DS = record - NearPlane: Single; // near radius of effect - NearDim: Single; // near dimming factor - FarPlane: Single; // far radius of effect - FarDim: Single; // far dimming factor - DCueBgnd: Boolean; // effect the background Flag - end; - - PAtmosphere3DS = ^TAtmosphere3DS; - TAtmosphere3DS = record - Fog: TFogSettings3DS; // Fog atmosphere settings - LayerFog: TLayerFogSettings3DS; // layered Fog atmosphere parameters - DCue: TDCueSettings3DS; // distance cue atmosphere parameters - ActiveAtmo: TAtmosphereType3DS; // the active atmospheric - end; - - // enumerate list of possible backgrounds used in file - TBackgroundType3DS = (btNoBgnd, - btUseSolidBgnd, - btUseVGradientBgnd, - btUseBitmapBgnd); - - PBitmapBgnd3DS = ^TBitmapBgnd3DS; - TBitmapBgnd3DS = AnsiString; // Name of background Bitmap - - TSolidBgnd3DS = TFColor3DS; // Color of Solid background - - PVGradientBgnd3DS = ^TVGradientBgnd3DS; - TVGradientBgnd3DS = record - GradPercent: Single; // placement of Mid Color band, Ranges from 0-1 - Top: TFColor3DS; // color of Top band - Mid: TFColor3DS; // color of Mid background band - Bottom: TFColor3DS; // color of Bottom band - end; - - PBackground3DS = ^TBackground3DS; - TBackground3DS = record - Bitmap: TBitmapBgnd3DS; - Solid: TSolidBgnd3DS; - VGradient: TVGradientBgnd3DS; - BgndUsed: TBackgroundType3DS; // background in effect - end; - - // used for shading field in TMaterial3DS structure - TShadeType3DS = (stWire, - stFlat, - stGouraud, - stPhong, - stMetal); - - // used for tiling field in TBitmap3DS structure - TTileType3DS = (ttTile, - ttDecal, - ttBoth); - - TFilterType3DS = (ftPyramidal, - ftSummedArea); - - TTintType3DS = (ttRGB, - ttAlpha, - ttRGBLumaTint, - ttAlphaTint, - ttRGBTint); - - // used by AddMaterial3DS - PACubic3DS = ^TACubic3DS; - TACubic3DS = record - FirstFrame: Boolean; // True for First Frame Only - Flat: Boolean; // True for Flat Mirror reflection - Size: Integer; // Map resolution - nthFrame: Integer; // Map update period - end; - - // Cubic reflection Map defintion - PBitmap3DS = ^TBitmap3DS; - TBitmap3DS = record - NameStr: AnsiString; // Bitmap file name - Percent: Single; // Strength percentage - Tiling: TTileType3DS; // Tile/Decal/Both - IgnoreAlpha: Boolean; - Filter: TFilterType3DS; // Pyramidal/Summed Area - Blur: Single; - Mirror: Boolean; - Negative: Boolean; - UScale: Single; - VScale: Single; - UOffset: Single; - VOffset: Single; - Rotation: Single; - Source: TTintType3DS; // RGB/RGB Luma Tint/Alpha Tint/RGB Tint - Tint1: TFColor3DS; - Tint2: TFColor3DS; - RedTint: TFColor3DS; - GreenTint: TFColor3DS; - BlueTint: TFColor3DS; - DataSize: Integer; // Size of procedural Data - Data: Pointer; // Procedural Data - end; - - - // Bit Map definition - - // Structure to all Map settings - PMapSet3DS = ^TMapSet3DS; - TMapSet3DS = record - Map: TBitmap3DS; // The Map settings - Mask: TBitmap3DS; // The Mask settings - end; - - TRMapSet3DS = record - Map: TBitmap3DS; // The Map settings - UseAuto: Boolean; // True if automatic reflections are being used - AutoMap: TACubic3DS; // Automatic reflection definitions - Mask: TBitmap3DS; // The Mask settings - end; - - PMaterial3DS = ^TMaterial3DS; - TMaterial3DS = record - NameStr: AnsiString; // Name - Ambient: TFColor3DS; // Ambient Light Color - Diffuse: TFColor3DS; // Diffuse Light Color - Specular: TFColor3DS; // Specular Light Color - Shininess: Single; // Shininess factor - ShinStrength: Single; // Shininess strength - Blur: Single; // Blur factor - Transparency: Single; // Trasparency factor - TransFallOff: Single; // Falloff factor - SelfIllumPct: Single; // Self illumination percentage - WireSize: Single; // Width of wireframe - Shading: TShadeType3DS; // Shading type - UseBlur: Boolean; // Blurring Flag - UseFall: Boolean; // Transparency FallOff Flag - TwoSided: Boolean; // Two sided material Flag - SelFillum: Boolean; // Self illumination Flag - Additive: Boolean; // Additive Transparency Flag - UseWire: Boolean; // Use wireframe rendering - UseWireAbs: Boolean; // Wire Size is in units, not pixels. - FaceMap: Boolean; // Face mapping switch - Soften: Boolean; // Soften switch - Texture: TMapSet3DS; // Texture Map settings - Texture2: TMapSet3DS; // Second Texture Map settings - Opacity: TMapSet3DS; // Opacity Map settings - Bump: TMapSet3DS; // Bump Map settings - SpecMap: TMapSet3DS; // Specularity Map settings - ShinMap: TMapSet3DS; // Shininess Map settings - IllumMap: TMapSet3DS; // Self illumination Map settings - Reflect: TRMapSet3DS; // Reflection Map settings - end; - - - // Mesh definition - - PMeshMatrix = ^TMeshMatrix; - TMeshMatrix = array[0..11] of Single; - - // Texture Map icon placement - PMapInfo3DS = ^TMapInfo3DS; - TMapInfo3DS = record - MapType: Word; // icon type - TileX: Single; // tiling - TileY: Single; - CenX: Single; // position of center - CenY: Single; - CenZ: Single; - Scale: Single; // icon scaling factor - Matrix: TMeshMatrix; // orientation matrix - PW: Single; // planar icon width - PH: Single; // planar icon height - CH: Single; // cylinder icon height - end; - - // Material assignments by face - PObjMat3DS = ^TObjMat3DS; - TObjMat3DS = record - NameStr: AnsiString; // material name - NFaces: Word; // number of faces using material - FaceIndex: PWordList; // list of faces using material - end; - - PObjMatList = ^TObjMatList; - TObjMatList = array[0..MaxInt div (2*SizeOf(TObjMat3DS))] of TObjMat3DS; - - // Mesh object definition - PMesh3DS = ^TMesh3DS; - TMesh3DS = record - NameStr: AnsiString; // object name - IsHidden: Boolean; // hidden object flag - IsvisLofter: Boolean; // lofter visibility flag - IsMatte: Boolean; // matte object flag - IsNoCast: Boolean; // doesn't cast shadows flag - IsFast: Boolean; // fast display flag - IsNorcvShad: boolean; // doesn't recieve shadows - IsFrozen: Boolean; // frozen object flag - NVertices: Word; // vertice count - VertexArray: PPointList; // list of vertices - NVFlags: Word; // number of vertex flags - VFlagArray: PWordList; // list of vertex flags - NTextVerts: Word; // number of texture vertices - TextArray: PTexVertList; // list of texture coordinates - UseMapInfo: Boolean; // for use of mapping icon information - Map: TMapInfo3DS; // mapping icon info - LocMatrix: TMeshMatrix; // object orientation matrix - NFaces: Word; // face count - FaceArray: PFaceList; // list of faces - SmoothArray: PCardinalArray; // smoothing group assignment list - UseBoxMap: Boolean; // used to indicate the use of box mapping - BoxMapStr: array[0..5] of String; // material names used in boxmapping - MeshColor: Byte; // UI color assigned to the mesh - NMats: Word; // assigned materials count - MatArray: PObjMatList; // material assignment list - UseProc: Boolean; // use animated stand-in flag - ProcSize: Integer; // size of animated stand-in data - ProcNameStr: String; // name of animated stand-in procedure - ProcData: Pointer; // animated stand-in data - end; - - // Spotlight projection cone shape - TConeStyle3DS = (csCircular, - csRectangular); - - // Spotlight shadow settings - PSpotShadow3DS = ^TSpotShadow3DS; - TSpotShadow3DS = record - Cast: Boolean; // True if spotlight casts shadows - AType: TShadowStyle3DS; // UseShadow or UseRayTrace - Local: Boolean; // True if local shadow settings are being used - Bias: Single; // shadow bias - Filter: Single; // shadow filter - MapSize: Word; // shadow map size - RayBias: Single; // Ray tracing shadow bias - end; - - // Cone visibility settings - PSpotCone3DS = ^TSpotCone3DS; - TSpotCone3DS = record - AType: TConeStyle3DS; // Circular or rectangular light cone - Show: Boolean; // True if cone is visible - Overshoot: Boolean; // True if cone overshoot is on - end; - - // spotlight projectio Bitmap - PSpotProjector3DS = ^TSpotProjector3DS; - TSpotProjector3DS = record - Use: Boolean; // True if using projector - BitmapStr: String; // name of projector bitmap - end; - - // spotlight settings - PSpotLight3DS = ^TSpotLight3DS; - TSpotLight3DS = record - Target: TPoint3DS; // Spotlight Target - Hotspot: Single; // Hotspot Angle - FallOff: Single; // Hotspot FallOff - Roll: Single; // Roll Angle - Aspect: Single; // Aspect ratio - Shadows: TSpotShadow3DS; - Cone: TSpotCone3DS; - Projector: TSpotProjector3DS; - end; - - // Light Attenuation settings - PLiteAttenuate3DS = ^TLiteAttenuate3DS; - TLiteAttenuate3DS = record - IsOn: Boolean; // True if Light Attenuation is on - Inner: Single; // Inner range of Attenuation - Outer: Single; // Outer range of Attenuation - end; - - // omni and spotlight settings - PLight3DS = ^TLight3DS; - TLight3DS = record - NameStr: AnsiString; // light name - Pos: TPoint3DS; // light position - Color: TFColor3DS; // light color - Multiplier: Single; // light intensity multiplier - DLOff: Boolean; // True if light is off - Attenuation: TLiteAttenuate3DS; - Exclude: TStringList; - Spot: PSpotLight3DS; // if not nil then struct is a spotlight, else omni - end; - - // Camera atomosphere Ranges - PCamRanges3DS = ^TCamRanges3DS; - TCamRanges3DS = record - CamNear: Single; // Nearest effect radius - CamFar: Single; // Farthest effect radius - end; - - PCamera3DS = ^TCamera3DS; - TCamera3DS = record - NameStr: AnsiString; - Position: TPoint3DS; - Target: TPoint3DS; - Roll: Single; - FOV: Single; - ShowCone: Boolean; - Ranges: TCamRanges3DS; - end; - - PKFKeyInfo3DS = ^TKFKeyInfo3DS; - TKFKeyInfo3DS = record - Length: Integer; - CurFrame: Integer; - end; - - PKFSegment3DS = ^TKFSegment3DS; - TKFSegment3DS = record - Use: Boolean; - SegBegin: Integer; - SegEnd: Integer; - end; - - PKFSets3DS = ^TKFSets3DS; - TKFSets3DS = record - Anim: TKFKeyInfo3DS; - Seg: TKFSegment3DS; - end; - - PKFCamera3DS = ^TKFCamera3DS; - TKFCamera3DS = record - NameStr: AnsiString; // Name of Camera object - ParentStr: AnsiString; // Name of Parent object - Flags1: Word; // Flags field from node header -fixup later - Flags2: Word; // Flags2 field from node header -fixup later - NPKeys: Integer; // Number of Camera Position keys - NPFlag: Word; // Loop control Flag for Camera Position keys - PKeys: PKeyHeaderList; // Spline values for Camera Position keys - Pos: PPointList; // Camera Position keys - NFKeys: Integer; // Number of Camera FOV keys - NFFlag: Word; // Loop control Flag for Camera FOV keys - FKeys: PKeyHeaderList; // Spline values for Camera FOV keys - FOV: PSingleList; // Camera FOV keys - NRKeys: Integer; // Number of Camera Roll keys - NRFlag: Word; // Loop control Flag for Camera Roll keys - RKeys: PKeyHeaderList; // Spline values for Camera Roll keys - Roll: PSingleList; // Camera Roll keys - TParentStr: String; // Index of Parent object for Target - NTKeys: Integer; // Number of Target Position keys - NTFlag: Word; // Loop control Flag for Target Position keys - TKeys: PKeyHeaderList; // Spline values for Target Position keys - TPos: PPointList; // Target Position keys - TFlags1: Word; // Flags field from Target node header - TFlags2: Word; // Flags field from Target node header - end; - - // Ambient Light animation - PKFAmbient3DS = ^TKFAmbient3DS; - TKFAmbient3DS = record - Flags1: Word; // Flags field from node header -fixup later - Flags2: Word; // Flags2 field from node header -fixup later - NCKeys: Integer; // Number of Color keys - NCFlag: Word; // Loop control Flag for Color keys - CKeys: PKeyHeaderList; // Spline values for Position keys - Color: PFColorList; // Color keys - end; - - // used by ObjectMotion3DS - PKFMesh3DS = ^TKFMesh3DS; - TKFMesh3DS = record - NameStr: AnsiString; // Name of mesh - ParentStr: AnsiString; // Name of Parent object - Flags1: Word; // Flags field from node header - Flags2: Word; // Flags2 field from node header - Pivot: TPoint3DS; // Object Pivot point - InstanceStr: AnsiString; // Object Instance Name - BoundMin: TPoint3DS; // Minimum bounding box point for dummy objects - BoundMax: TPoint3DS; // Maximum bounding box point for dummy objects - NPKeys: Integer; // Number of Position keys - NPFlag: Smallint; // Loop control Flag for Position keys - PKeys: PKeyHeaderList; // Spline values for Position keys - Pos: PPointList; // Mesh Position keys - NRKeys: Integer; // Number of Rotation keys - NRFlag: Smallint; // Loop control Flag for Rotation keys - RKeys: PKeyHeaderList; // Spline values for Rotation keys - Rot: PKFRotKeyList; // Rotation keys - NSKeys: Integer; // Number of scaling keys - NSFlag: Smallint; // Loop control Flag for scaling keys - SKeys: PKeyHeaderList; // Spline values for scaling - Scale: PPointList; // Mesh scaling keys - NMKeys: Integer; // Number of Morph keys - NMFlag: Smallint; // Loop control Flag for Morph keys - MKeys: PKeyHeaderList; // Spline values for Morph keys - Morph: PKFMorphKeyList; // Morph keys - NHKeys: Integer; // Number of hide keys - NHFlag: Smallint; // Loop control Flag for hide keys - HKeys: PKeyHeaderList; // Spline values for hide keys - MSAngle: Single; // Morph smoothing group Angle - end; - - // used by OmnilightMotion3DS - PKFOmni3DS = ^TKFOmni3DS; - TKFOmni3DS = record - Name: AnsiString; // Name of the Light object node - Parent: AnsiString; // Name of the Parent object - Flags1: Word; // Flags field from node header -fixup later - Flags2: Word; // Flags2 field from node header -fixup later - NPKeys: Integer; // Number of Position keys - NPFlag: Word; // Loop control Flag for Position keys - PKeys: PKeyHeaderList; // Spline values for Position keys - Pos: PPointList; // Position keys - NCKeys: Integer; // Number of Color keys - NCFlag: Word; // Loop control Flag for Color keys - CKeys: PKeyHeaderList; // Spline values for Position keys - Color: PFColorList; // Color keys - end; - - PKFSpot3DS = ^TKFSpot3DS; - TKFSpot3DS = record - Name: AnsiString; // Name of Camera object - Parent: AnsiString; // Parent Name - Flags1: Word; // Flags field from node header -fixup later - Flags2: Word; // Flags2 field from node header -fixup later - - {$ifdef broken} - visible: Smallint; // Flags to control visibility - {$endif} - - NPKeys: Integer; // Number of Light Position keys - NPFlag: Word; // Loop control Flag for Position keys - PKeys: PKeyHeaderList; // Spline values for Light Position keys - Pos: PPointList; // Light Position keys - NCKeys: Integer; // Number of Color keys - NCFlag: Word; // Loop control Flag Color keys - CKeys: PKeyHeaderList; // Spline values for Color keys - Color: PFColorList; // Color keys - NHKeys: Integer; // Number of Hotspot Angle keys - NHFlag: Word; // Loop control Flag for Hotspot Angle keys - HKeys: PKeyHeaderList; // Spline values for Hotspot Angle keys - Hot: PSingleList; // Hotspot Angle keys - NFKeys: Integer; // Number of FallOff Angle keys - NFFlag: Word; // Loop control Flag for FallOff Angle keys - FKeys: PKeyHeaderList; // Spline values for FallOff Angle keys - Fall: PSingleList; // FallOff Angle keys - NRKeys: Integer; // Number of Light Roll keys - NRFlag: Word; // Loop control Flag for Light Roll keys - RKeys: PKeyHeaderList; // Spline values for Light Roll keys - Roll: PSingleList; // Light Roll keys - TParent: AnsiString; // Name of Target's Parent object - NTKeys: Integer; // Number of Target Position keys - NTFlag: Word; // Loop control Flag for Target Position keys - TKeys: PKeyHeaderList; // Spline values for Target Position keys - TPos: PPointList; // Target Position keys - TFlags1: Word; // Flags field from Target node header - TFlags2: Word; // Flags field from Target node header - end; - - PXDataRaw3DS = ^TXDataRaw3DS; - TXDataRaw3DS = record - Size: Integer; - Data: Pointer; - end; - - TTargetType3DS = (ttLightTarget,ttCameraTarget); - - PM3dVersion = ^TM3dVersion; - TM3dVersion = Cardinal; - - - // inner datatypes not followed by a '3DS' to show they are locally used - // (mostly as a part of another chunk or while collecting specific data) - - PColorF = ^TColorF; - TColorF = record - Red, Green, Blue: Single; - end; - - PLinColorF = ^TLinColorF; - TLinColorF = TColorF; - - PColor24 = ^TColor24; - TColor24 = record - Red, Green, Blue: Byte; - end; - - PLinColor24 = ^TLinColor24; - TLinColor24 = TColor24; - - PMatMapRCol = ^TMatMapRCol; - TMatMapRCol = TLinColor24; - - PMatMapGCol = ^TMatMapGCol; - TMatMapGCol = TMatMapRCol; - - PMatMapBCol = ^TMatMapBCol; - TMatMapBCol = TMatMapGCol; - - PMatMapCol1 = ^TMatMapCol1; - TMatMapCol1 = TMatMapBCol; - - PMatMapCol2 = ^TMatMapCol2; - TMatMapCol2 = TMatMapCol1; - - PIntPercentage = ^TIntPercentage; - TIntPercentage = SmallInt; - - PMatBumpPercent = ^TMatBumpPercent; - TMatBumpPercent = TIntPercentage; - - PFloatPercentage = ^TFloatPercentage; - TFloatPercentage = Single; - - PMatMapname = PChar3DS; - - PMeshVersion = ^TMeshVersion; - TMeshVersion = Integer; - - PMasterScale = ^TMasterScale; - TMasterScale = Single; - - PLoShadowBias = ^TLoShadowBias; - TLoShadowBias = Single; - - PHiShadowBias = ^THiShadowBias; - THiShadowBias = TLoShadowBias; - - PRayBias = ^TRayBias; - TRayBias = THiShadowBias; - - PShadowMapSize = ^TShadowMapSize; - TShadowMapSize = SmallInt; - - PShadowSamples = ^TShadowSamples; - TShadowSamples = SmallInt; - - PShadowRange = ^TShadowRange; - TShadowRange = Integer; - - PShadowFilter = ^TShadowFilter; - TShadowFilter = Single; - - POConsts = ^TOConsts; - TOConsts = TPoint3DS; - - PBitMapName = PChar3DS; - - PVGradient = ^TVGradient; - TVGradient = Single; - - PFog = ^TFog; - TFog = record - NearPlaneDist: Single; - NearPlaneDensity: Single; - FarPlaneDist: Single; - FarPlaneDensity: Single; - end; - - PLayerFog = ^TLayerFog; - TLayerFog = record - ZMin: Single; - ZMax: Single; - Density: Single; - AType: Cardinal; - end; - - PDistanceCue = ^TDistanceCue; - TDistanceCue = record - NearPlaneDist: Single; - NearPlaneDimming: Single; - FarPlaneDist: Single; - FarPlaneDimming: Single; - end; - - PViewStandard = ^TViewStandard; - TViewStandard = record - ViewTargetCoord: TPoint3DS; - ViewWidth: Single; - end; - - PViewUser = ^TViewUser; - TViewUser = record - ViewTargetCoord: TPoint3DS; - ViewWidth: Single; - XYViewangle: Single; - YZViewangle: Single; - BankAngle: Single; - end; - - PViewCamera = PChar3DS; - - PMatName = PChar3DS; - - PMatShading = ^TMatShading; - TMatShading = SmallInt; - - PMatAcubic = ^TMatAcubic; - TMatAcubic = record - ShadeLevel: Byte; - Antialias: Byte; - Flags: SmallInt; - MapSize: Cardinal; - FrameInterval: Cardinal; - end; - - PIpasData = ^TIpasData; - TIpasData = record - Size: Integer; - Data: Pointer; - end; - - PMatWireSize = ^TMatWireSize; - TMatWireSize = Single; - - PMatMapTiling = ^TMatMapTiling; - TMatMapTiling = Word; - - PMatMapTexblur = ^TMatMapTexblur; - TMatMapTexblur = Single; - - PMatMapUScale = ^TMatMapUScale; - TMatMapUScale = Single; - - PMatMapVScale = ^TMatMapVScale; - TMatMapVScale = TMatMapUScale; - - PMatMapUOffset = ^TMatMapUOffset; - TMatMapUOffset = Single; - - PMatMapVOffset = ^TMatMapVOffset; - TMatMapVOffset = TMatMapUOffset; - - PMatMapAng = ^TMatMapAng; - TMatMapAng = Single; - - PNamedObject = PChar3DS; - - PPointArray = ^TPointArray; - TPointArray = record - Vertices: Word; - PointList: PPointList; - end; - - PPointFlagArray = ^TPointFlagArray; - TPointFlagArray = record - Flags: Word; - FlagList: PWordList; - end; - - PFaceArray = ^TFaceArray; - TFaceArray = record - Faces: Word; - FaceList: PFaceList; - end; - - PMshMatGroup = ^TMshMatGroup; - TMshMatGroup = record - MatNameStr: AnsiString; - Faces: Word; - FaceList: PWordList; - end; - - PMshBoxmap = ^TMshBoxmap; - TMshBoxmap = array[0..5] of AnsiString; - - PSmoothGroup = ^TSmoothGroup; - TSmoothGroup = record - Groups: Word; - GroupList: PCardinalArray; - end; - - PTexVerts = ^TTexVerts; - TTexVerts = record - NumCoords: Word; - TextVertList: PTexVertList; - end; - - PMeshColor = ^TMeshColor; - TMeshColor = Byte; - - PMeshTextureInfo = ^TMeshTextureInfo; - TMeshTextureInfo = record - MapType: Word; - XTiling: Single; - YTiling: Single; - IconPos: TPoint3DS; - IconScaling: Single; - XMatrix: TMeshMatrix; - IconWidth: Single; - IconHeight: Single; - CylIconHeight: Single; - end; - - PProcName = PChar3DS; - - PNDirectLight = ^TNDirectLight; - TNDirectLight = TPoint3DS; - - PDlExclude = PChar3DS; - - PDlSpotlight = ^TDlSpotlight; - TDlSpotlight = record - SpotLightTarg: TPoint3DS; - HotspotAngle: Single; - FalloffAngle: Single; - end; - - PDlOuterRange = ^TDlOuterRange; - TDlOuterRange = Single; - - PDlInnerRange = ^TDlInnerRange; - TDlInnerRange = TDlOuterRange; - - PDlMultiplier = ^TDlMultiplier; - TDlMultiplier = Single; - - PDlSpotRoll = ^TDlSpotRoll; - TDlSpotRoll = Single; - - PDlSpotAspect = ^TDlSpotAspect; - TDlSpotAspect = Single; - - PDlSpotProjector = PChar3DS; - - PDlRayBias = ^TDlRayBias; - TDlRayBias = Single; - - PDlLocalShadow2 = ^TDlLocalShadow2; - TDlLocalShadow2 = record - LocalShadowBias: Single; - LocalShadowFilter: Single; - LocalShadowMapSize: SmallInt - end; - - PNCamera = ^TNCamera; - TNCamera = record - CameraPos: TPoint3DS; - TargetPos: TPoint3DS; - CameraBank: Single; - CameraFocalLength: Single; - end; - - PCamRanges = ^TCamRanges; - TCamRanges = record - NearPlane: Single; - FarPlane: Single; - end; - - PViewportLayout = ^TViewportLayout; - TViewportLayout = record - Form: SmallInt; // 0 = single window - // 1 = 2 split verticle - // 2 = 2 split horizontal - // 3 = 4 equal squares - // 4 = 2 squares left & 1 rect right - // 5 = 1 rect at Top & 2 sqr on bot - // 6 = 1 rect left & 2 sqr right - // 7 = 2 sqr Top & 1 rect bot - // 8 = 3 split vertical - // 9 = 2 split horiz - // 10 = 3 sqr left and 1 rect right - // 11 = 1 rect left & 3 sqr. right - // Form becomes 0 during swap and its preswapped value is stored in the SwapPort field - Top: SmallInt; // Active window index of 0 to 5 - Ready: SmallInt; - WState: SmallInt; // 0 if no swap window, 1 if in swaped "w" state. During a swap, the old 0 window gets stored as the 4 window - SwapWS: SmallInt; - SwapPort: SmallInt; // The preswapped value from the Form field - SwapCur: SmallInt; // The window index that was swapped - end; - - PViewportSize = ^TViewportSize; - TViewportSize = record // Values given for 1024x768 resolution - XPos: Word; // 0 - YPos: Word; // 14 - Width: Word; // 895 - Height: Word; // 725 - end; - - PViewportData = ^TViewportData; - TViewportData = record - Flags: Word; - AxisLockout: Word; - WinXPos: Word; - WinYPos: Word; - WinWidth: Word; - WinHeight: Word; - View: Word; // 0 = No View - // 1 = Top View - // 2 = Bottom View - // 3 = Left View - // 4 = Right View - // 5 = Front View - // 6 = Back View - // 7 = User View - // 18 = Spotlight View - // 65535 = Camera View - ZoomFactor: Single; - Center: TPoint3DS; - HorizAng: Single; - VertAng: Single; - CamNameStr: AnsiString; - end; - - PViewportData3 = ^TViewportData3; - TViewportData3 = TViewportData; - - PKFHdr = ^TKFHdr; - TKFHdr = record - Revision: SmallInt; - Filename: String; - AnimLength: Integer; - end; - - PKFId = ^TKFId; - TKFId = SmallInt; - - PKFSeg = ^TKFSeg; - TKFSeg = record - First: Integer; - Last: Integer; - end; - - PKFCurtime = ^TKFCurtime; - TKFCurtime = Integer; - - PNodeHdr = ^TNodeHdr; - TNodeHdr = record - ObjNameStr: String; - Flags1: Word; - Flags2: Word; - ParentIndex: SmallInt; - end; - - PPivot = ^TPivot; - TPivot = TPoint3DS; - - PInstanceName = PChar3DS; - - PMorphSmooth = ^TMorphSmooth; - TMorphSmooth = Single; - - PBoundBox = ^TBoundBox; - TBoundBox = record - Min: TPoint3DS; - Max: TPoint3DS; - end; - - PPosTrackTag = ^TPosTrackTag; - TPosTrackTag = record - TrackHdr: TTrackHeader3DS; - KeyHdrList: PKeyHeaderList; - PositionList: PPointList; - end; - - PColTrackTag = ^TColTrackTag; - TColTrackTag = record - TrackHdr: TTrackHeader3DS; - KeyHdrList: PKeyHeaderList; - ColorList: PFColorList; - end; - - PRotTrackTag = ^TRotTrackTag; - TRotTrackTag = record - TrackHdr: TTrackHeader3DS; - KeyHdrList: PKeyHeaderList; - RotationList: PKFRotKeyList; - end; - - PScaleTrackTag = ^TScaleTrackTag; - TScaleTrackTag = record - TrackHdr: TTrackHeader3DS; - KeyHdrList: PKeyHeaderList; - ScaleList: PPointList; - end; - - PMorphTrackTag = ^TMorphTrackTag; - TMorphTrackTag = record - TrackHdr: TTrackHeader3DS; - KeyHdrList: PKeyHeaderList; - MorphList: PKFMorphKeyList; - end; - - PHideTrackTag = ^THideTrackTag; - THideTrackTag = record - TrackHdr: TTrackHeader3DS; - KeyHdrList: PKeyHeaderList; - end; - - PFovTrackTag = ^TFovTrackTag; - TFovTrackTag = record - TrackHdr: TTrackHeader3DS; - KeyHdrList: PKeyHeaderList; - FOVAngleList: PSingleList; - end; - - PRollTrackTag = ^TRollTrackTag; - TRollTrackTag = record - TrackHdr: TTrackHeader3DS; - KeyHdrList: PKeyHeaderList; - RollAngleList: PSingleList; - end; - - PHotTrackTag = ^THotTrackTag; - THotTrackTag = record - TrackHdr: TTrackHeader3DS; - KeyHdrList: PKeyHeaderList; - HotspotAngleList: PSingleList; - end; - - PFallTrackTag = ^TFallTrackTag; - TFallTrackTag = record - TrackHdr: TTrackHeader3DS; - KeyHdrList: PKeyHeaderList; - FalloffAngleList: PSingleList; - end; - - PXDataEntry = ^TXDataEntry; - TXDataEntry = record - Size: Integer; - Data: Pointer; - end; - - PXDataAppName = PChar3DS; - - PXDataString = PChar3DS; - - PXDataFloat = ^TXDataFloat; - TXDataFloat = Single; - - PXDataDouble = ^TXDataDouble; - TXDataDouble = Double; - - PXDataShort = ^TXDataShort; - TXDataShort = SmallInt; - - PXDataLong = ^TXDataLong; - TXDataLong = Integer; - - PXDataVoid = ^TXDataVoid; - TXDataVoid = Pointer; - - TReleaseLevel = (rlRelease1, - rlRelease2, - rlRelease3, - rlReleaseNotKnown); - - // to avoid zillion type casts, we use this variant record for - // chunk data, effectively this defines the same pointer differently - // for different chunk types - // this is only possible because all types are just pointers - TChunkData = record - case Integer of - 0 : (ColorF: PColorF); - 1 : (LinColorF: PLinColorF); - 2 : (Color24: PColor24); - 3 : (LinColor24: PLinColor24); - 4 : (IntPercentage: PIntPercentage); - 5 : (FloatPercentage: PFloatPercentage); - 6 : (MatMapname: PMatMapname); - 7 : (M3dVersion: PM3dVersion); - 8 : (MeshVersion: PMeshVersion); - 9 : (MasterScale: PMasterScale); - 10 : (LoShadowBias: PLoShadowBias); - 11 : (ShadowFilter: PShadowFilter); - 12 : (ShadowRange: PShadowRange); - 13 : (HiShadowBias: PHiShadowBias); - 14 : (RayBias: PRayBias); - 15 : (ShadowMapSize: PShadowMapSize); - 16 : (ShadowSamples: PShadowSamples); - 17 : (OConsts: POConsts); - 18 : (BitMapName: PBitMapName); - 19 : (VGradient: PVGradient); - 20 : (Fog: PFog); - 21 : (LayerFog: PLayerFog); - 22 : (DistanceCue: PDistanceCue); - 23 : (ViewStandard: PViewStandard); - 24 : (ViewUser: PViewUser); - 25 : (ViewCamera: PViewCamera); - 26 : (MatName: PMatName); - 27 : (MatShading: PMatShading); - 28 : (MatAcubic: PMatAcubic); - 29 : (IpasData: PIpasData); - 30 : (MatWireSize: PMatWireSize); - 31 : (MatMapTiling: PMatMapTiling); - 32 : (MatMapTexblur: PMatMapTexblur); - 33 : (MatMapUScale: PMatMapUScale); - 34 : (MatMapVScale: PMatMapVScale); - 35 : (MatMapUOffset: PMatMapUOffset); - 36 : (MatMapVOffset: PMatMapVOffset); - 37 : (MatMapAng: PMatMapAng); - 38 : (MatMapCol1: PMatMapCol1); - 39 : (MatMapCol2: PMatMapCol2); - 40 : (MatMapRCol: PMatMapRCol); - 41 : (MatMapGCol: PMatMapGCol); - 42 : (MatMapBCol: PMatMapBCol); - 43 : (MatBumpPercent: PMatBumpPercent); - 44 : (NamedObject: PNamedObject); - 45 : (PointArray: PPointArray); - 46 : (PointFlagArray: PPointFlagArray); - 47 : (FaceArray: PFaceArray); - 48 : (MshMatGroup: PMshMatGroup); - 49 : (MshBoxmap: PMshBoxmap); - 50 : (SmoothGroup: PSmoothGroup); - 51 : (TexVerts: PTexVerts); - 52 : (MeshMatrix: PMeshMatrix); - 53 : (MeshColor: PMeshColor); - 54 : (MeshTextureInfo: PMeshTextureInfo); - 55 : (ProcName: PProcName); - 56 : (NDirectLight: PNDirectLight); - 57 : (DlExclude: PDlExclude); - 58 : (DlInnerRange: PDlInnerRange); - 59 : (DlOuterRange: PDlOuterRange); - 60 : (DlMultiplier: PDlMultiplier); - 61 : (DlSpotlight: PDlSpotlight); - 62 : (DlLocalShadow2: PDlLocalShadow2); - 63 : (DlSpotRoll: PDlSpotRoll); - 64 : (DlSpotAspect: PDlSpotAspect); - 65 : (DlSpotProjector: PDlSpotProjector); - 66 : (DlRayBias: PDlRayBias); - 67 : (NCamera: PNCamera); - 68 : (CamRanges: PCamRanges); - 69 : (ViewportLayout: PViewportLayout); - 70 : (ViewportSize: PViewportSize); - 71 : (ViewportData: PViewportData); - 72 : (XDataEntry: PXDataEntry); - 73 : (XDataAppName: PXDataAppName); - 74 : (XDataString: PXDataString); - 75 : (KFHdr: PKFHdr); - 76 : (KFSeg: PKFSeg); - 77 : (KFCurtime: PKFCurtime); - 78 : (KFId: PKFId); - 79 : (NodeHdr: PNodeHdr); - 80 : (Pivot: PPivot); - 81 : (InstanceName: PInstanceName); - 82 : (MorphSmooth: PMorphSmooth); - 83 : (BoundBox: PBoundBox); - 84 : (PosTrackTag: PPosTrackTag); - 85 : (ColTrackTag: PColTrackTag); - 86 : (RotTrackTag: PRotTrackTag); - 87 : (ScaleTrackTag: PScaleTrackTag); - 88 : (MorphTrackTag: PMorphTrackTag); - 89 : (FovTrackTag: PFovTrackTag); - 90 : (RollTrackTag: PRollTrackTag); - 91 : (HotTrackTag: PHotTrackTag); - 92 : (FallTrackTag: PFallTrackTag); - 93 : (HideTrackTag: PHideTrackTag); - 99 : (Dummy: Pointer); - end; - - // finally the chunk definition - TChunk3DS = record - Tag: Word; // Type of Chunk - Size: Cardinal; // Number of bytes used by Chunk - Position: Cardinal; // Offset in Source file - Data: TChunkData; // Memory copy of file Data - Sibling: PChunk3DS; // Next Chunk in database - Children: PChunk3DS; // Chunks contained within this Chunk - end; - -//--------------------------------------------------------------------------------------------------------------------- - -implementation - -//--------------------------------------------------------------------------------------------------------------------- - -end. - diff --git a/Sourcex/Formatx.m3DSUtils.pas b/Sourcex/Formatx.m3DSUtils.pas deleted file mode 100644 index cb3e18ac..00000000 --- a/Sourcex/Formatx.m3DSUtils.pas +++ /dev/null @@ -1,6791 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit Formatx.m3DSUtils; - -(* - Utility functions for the universal 3DS file reader and writer (TFile3DS). - Essentially, the functions here are the heart of the import library as - they deal actually with the database and chunks. -*) - -interface - -{$I GLScene.Defines.inc} -{$R-} - -uses - System.Classes, - System.SysUtils, - Formatx.m3DS, - Formatx.m3DSTypes, - Formatx.m3DSConst, - - GLScene.Strings; - -// functions to retrieve global settings of a specific 3DS database -function GetAtmosphere(const Source: TFile3DS; var DB: TDatabase3DS): TAtmosphere3DS; -function GetBackground(const Source: TFile3DS; var DB: TDatabase3DS): TBackground3DS; -function GetMeshSet(const Source: TFile3DS; var DB: TDatabase3DS): TMeshSet3DS; -function GetViewport(const Source: TFile3DS; var DB: TDatabase3DS): TViewport3DS; - -// functions to retrieve/modify data related to materials, lights and objects (meshs) -procedure AddChild(Parent, Child: PChunk3DS); -procedure AddChildOrdered(Parent, Child: PChunk3DS); -function FindChunk(Top: PChunk3DS; Tag: word): PChunk3DS; -function FindNextChunk(Local: PChunk3DS; Tag: word): PChunk3DS; -procedure FreeChunkData(var Chunk: PChunk3DS); -function GetCameraByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: integer): TCamera3DS; -function GetCameraCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; -function GetChunkValue(Tag: word): integer; -function GetMaterialByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: integer): TMaterial3DS; -function GetMaterialCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; -function GetMeshByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: integer): TMesh3DS; -function GetMeshCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; -function GetOmnilightByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: integer): TLight3DS; -function GetSpotlightByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: integer): TLight3DS; -function GetOmnilightCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; -function GetSpotlightCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; -procedure InitChunk(var Chunk: PChunk3DS); -procedure ReleaseCamera(Camera: PCamera3DS); -procedure ReleaseChunk(var Chunk: PChunk3DS); -procedure ReleaseChunkList(var List: PChunkList3DS); -procedure ReleaseLight(Light: PLight3DS); -procedure ReleaseMaterial(Mat: PMaterial3DS); -procedure ReleaseMeshObj(Mesh: PMesh3DS); - -// functions to retrieve/modify keyframer (animation) data -function GetKFSettings(const Source: TFile3DS; var DB: TDatabase3DS): TKFSets3DS; - -procedure ReleaseCameraMotion(Camera: PKFCamera3DS); -procedure GetCameraNodeNameList(const Source: TFile3DS; var DB: TDatabase3DS; - List: TStringList); -function GetCameraNodeCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; -function GetCameraMotion(const Source: TFile3DS; - CamChunk, TargetChunk: PChunk3DS): TKFCamera3DS; -function GetCameraMotionByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: integer): TKFCamera3DS; - -procedure ReleaseAmbientLightMotion(Light: PKFAmbient3DS); -function GetAmbientLightMotion(const Source: TFile3DS; - var DB: TDatabase3DS): TKFAmbient3DS; - -procedure InitObjectMotion(var Obj: TKFMesh3DS; - NewNPKeys, NewNRKeys, NewNSKeys, NewNMKeys, NewNHKeys: cardinal); -procedure ReleaseObjectMotion(Obj: PKFMesh3DS); -procedure GetObjectNodeNameList(const Source: TFile3DS; var DB: TDatabase3DS; - List: TStringList); -function GetObjectNodeCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; -function GetObjectMotionByName(const Source: TFile3DS; var DB: TDatabase3DS; - const Name: string): TKFMesh3DS; -function GetObjectMotionByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: cardinal): TKFMesh3DS; - -procedure ReleaseOmnilightMotion(Light: PKFOmni3DS); -procedure GetOmnilightNodeNameList(const Source: TFile3DS; var DB: TDatabase3DS; - List: TStringList); -function GetOmnilightNodeCount(const Source: TFile3DS; var DB: TDatabase3DS): cardinal; -function GetOmnilightMotionByName(const Source: TFile3DS; var DB: TDatabase3DS; - const Name: string): TKFOmni3DS; -function GetOmnilightMotionByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: cardinal): TKFOmni3DS; - -procedure ReleaseSpotlightMotion(Spot: PKFSpot3DS); -procedure GetSpotlightNodeNameList(const Source: TFile3DS; var DB: TDatabase3DS; - List: TStringList); -function GetSpotlightNodeCount(const Source: TFile3DS; var DB: TDatabase3DS): cardinal; -function GetSpotlightMotionByName(const Source: TFile3DS; var DB: TDatabase3DS; - const Name: string): TKFSpot3DS; -function GetSpotlightMotionByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: cardinal): TKFSpot3DS; - -// version information -function GetM3dMagicRelease(const Source: TFile3DS; var DB: TDatabase3DS): TReleaseLevel; -function GetMeshRelease(const Source: TFile3DS; var DB: TDatabase3DS): TReleaseLevel; -function GetKfRelease(const Source: TFile3DS; var DB: TDatabase3DS): TReleaseLevel; -function GetDatabaseRelease(const Source: TFile3DS; var DB: TDatabase3DS): TReleaseLevel; - -// support functions for text output of chunk and database contents -procedure ChunkHeaderReport(var Strings: TStrings; Chunk: PChunk3DS; - IndentLevel: integer); -function ChunkTagToString(Tag: word): string; -procedure DumpChunk(const Source: TFile3DS; var Strings: TStrings; - Chunk: PChunk3DS; IndentLevel: integer; DumpLevel: TDumpLevel); -procedure DumpKeyHeader(Strings: TStrings; const Key: TKeyHeader3DS; IndentLevel: integer); - -// support functions for chunk handling -procedure DeleteChunk(var Chunk: PChunk3DS); -function FindNamedObjectByIndex(Source: TFile3DS; DB: TDatabase3DS; - AType: word; Index: integer): PChunk3DS; - -// error message routines -procedure ShowError(const ErrorMessage: string); -procedure ShowErrorFormatted(const ErrorMessage: string; const Args: array of const); - -//------------------------------------------------- -implementation -//------------------------------------------------- - -type - E3DSError = class(Exception); - -//----------------- error handling ------------------------------------------------------------------------------------ - -procedure ShowError(const ErrorMessage: string); -begin - raise E3DSError.Create(ErrorMessage); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ShowErrorFormatted(const ErrorMessage: string; const Args: array of const); -begin - raise E3DSError.CreateFmt(ErrorMessage, Args); -end; - -//----------------- global settings functions ------------------------------------------------------------------------- - -function InitMeshSet: TMeshSet3DS; - - // initializes a mesh settings structure - -begin - FillChar(Result, SizeOf(Result), 0); - with Result do - begin - MasterScale := 1; - Shadow.Bias := 1; - Shadow.RayBias := 1; - Shadow.MapSize := 512; - Shadow.Filter := 3; - AmbientLight.R := 0.39216; - AmbientLight.G := 0.39216; - AmbientLight.B := 0.39216; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetMeshSet(const Source: TFile3DS; var DB: TDatabase3DS): TMeshSet3DS; - - // retrieves the mesh settings from the database - -var - MDataChunk, ColorChunk, Chunk: PChunk3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - - // find the mesh data chunk - MDataChunk := FindChunk(DB.TopChunk, MDATA); - - // If the mesh data section is found - if Assigned(MDataChunk) then - begin - Result := InitMeshSet; - with Result do - begin - // Search for a master_scale chunk - Chunk := FindNextChunk(MDataChunk^.Children, MASTER_SCALE); - if Assigned(Chunk) then - begin - Source.ReadChunkData(Chunk); - MasterScale := Chunk^.Data.MasterScale^; - FreeChunkData(Chunk); - end; - - // search for Lo_Shadow_Bias chunk - Chunk := FindNextChunk(MDataChunk^.Children, LO_SHADOW_BIAS); - if Assigned(Chunk) then - begin - Source.ReadChunkData(Chunk); - Shadow.Bias := Chunk^.Data.LoShadowBias^; - FreeChunkData(Chunk); - end; - - // Search for ray_Bias Chunk - Chunk := FindNextChunk(MDataChunk^.Children, RAY_BIAS); - if Assigned(Chunk) then - begin - Source.ReadChunkData(Chunk); - Shadow.RayBias := Chunk^.Data.RayBias^; - FreeChunkData(Chunk); - end; - - // search for MapSize Chunk - Chunk := FindNextChunk(MDataChunk^.Children, SHADOW_MAP_SIZE); - if Assigned(Chunk) then - begin - Source.ReadChunkData(Chunk); - Shadow.MapSize := Chunk^.Data.ShadowMapSize^; - FreeChunkData(Chunk); - end; - - // search for Shadow_Filter Chunk - Chunk := FindNextChunk(MDataChunk^.Children, SHADOW_FILTER); - if Assigned(Chunk) then - begin - Source.ReadChunkData(Chunk); - Shadow.Filter := Chunk^.Data.ShadowFilter^; - FreeChunkData(Chunk); - end; - - // search for ambient_light Chunk - Chunk := FindNextChunk(MDataChunk^.Children, AMBIENT_LIGHT); - if Assigned(Chunk) then - begin - // search for the old style Color chunk inside the ambient Light Chunk - ColorChunk := FindChunk(Chunk, COLOR_F); - if Assigned(ColorChunk) then - begin - Source.ReadChunkData(ColorChunk); - AmbientLight.R := ColorChunk^.Data.ColorF^.Red; - AmbientLight.G := ColorChunk^.Data.ColorF^.Green; - AmbientLight.B := ColorChunk^.Data.ColorF^.Blue; - FreeChunkData(ColorChunk); - end - else - begin - // just for robust completeness, search for the COLOR_24 chunk - ColorChunk := FindChunk(Chunk, COLOR_24); - if Assigned(ColorChunk) then - begin - Source.ReadChunkData(ColorChunk); - AmbientLight.R := ColorChunk^.Data.Color24^.Red / 255; - AmbientLight.G := ColorChunk^.Data.Color24^.Green / 255; - AmbientLight.B := ColorChunk^.Data.Color24^.Blue / 255; - FreeChunkData(ColorChunk); - end; - end; - - // search for the newer linear Color Chunk inside the ambient Light chunk - ColorChunk := FindChunk(Chunk, LIN_COLOR_F); - if Assigned(ColorChunk) then - begin - Source.ReadChunkData(ColorChunk); - AmbientLight.R := ColorChunk^.Data.LinColorF^.Red; - AmbientLight.G := ColorChunk^.Data.LinColorF^.Green; - AmbientLight.B := ColorChunk^.Data.LinColorF^.Blue; - FreeChunkData(ColorChunk); - end - else - begin - // just for completeness, search for the LIN_COLOR_24 chunk - ColorChunk := FindChunk(Chunk, LIN_COLOR_24); - if Assigned(ColorChunk) then - begin - Source.ReadChunkData(ColorChunk); - AmbientLight.R := ColorChunk^.Data.LinColorF^.Red / 255; - AmbientLight.G := ColorChunk^.Data.LinColorF^.Green / 255; - AmbientLight.B := ColorChunk^.Data.LinColorF^.Blue / 255; - FreeChunkData(ColorChunk); - end; - end; - end; - - // Search for the oconst chunk - Chunk := FindNextChunk(MDataChunk^.Children, O_CONSTS); - if Assigned(Chunk) then - begin - Source.ReadChunkData(Chunk); - oconsts.x := Chunk^.Data.OConsts^.X; - oconsts.y := Chunk^.Data.OConsts^.Y; - oconsts.z := Chunk^.Data.OConsts^.Z; - FreeChunkData(Chunk); - end; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function InitAtmosphere: TAtmosphere3DS; - - // initializes a atmosphere structure - -begin - FillChar(Result, SizeOf(Result), 0); - with Result do - begin - Fog.FarPlane := 1000; - Fog.FarDensity := 100; - Fog.FogBgnd := True; - - LayerFog.ZMax := 100; - LayerFog.Density := 50; - LayerFog.Falloff := lfNoFall; - LayerFog.Fogbgnd := True; - - DCue.FarPlane := 1000; - DCue.FarDim := 100; - - ActiveAtmo := atNoAtmo; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetAtmosphere(const Source: TFile3DS; var DB: TDatabase3DS): TAtmosphere3DS; - - // retrieves the atmospheric settings from database - -var - MDataChunk, FogChunk, BgnChunk, ColorChunk, Chunk: PChunk3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - - // find the MDATA chunk - MDataChunk := FindChunk(DB.TopChunk, MDATA); - - // if the MDATA chunk was found, then search for the atmospheric chunks - if Assigned(MDataChunk) then - begin - Result := InitAtmosphere; - // Search for fog chunk - FogChunk := FindChunk(MDataChunk, FOG); - if Assigned(FogChunk) then - with Result do - begin - // read the chunk information - Source.ReadChunkData(FogChunk); - - // Copy the FogChunk data into the structure - Fog.NearPlane := FogChunk^.Data.Fog^.NearPlaneDist; - Fog.NearDensity := FogChunk^.Data.Fog^.NearPlaneDensity; - Fog.FarPlane := FogChunk^.Data.Fog^.FarPlanedist; - Fog.FarDensity := FogChunk^.Data.Fog^.FarPlaneDensity; - - // Search for fog Color chunk - ColorChunk := FindChunk(FogChunk, COLOR_F); - if Assigned(ColorChunk) then - begin - Source.ReadChunkData(ColorChunk); - Fog.FogColor.R := ColorChunk^.Data.ColorF^.Red; - Fog.Fogcolor.G := ColorChunk^.Data.ColorF^.Green; - Fog.Fogcolor.B := ColorChunk^.Data.ColorF^.Blue; - FreeChunkData(ColorChunk); - end; - - // Search for FOG_BGND chunk - BgnChunk := FindChunk(FogChunk, FOG_BGND); - if Assigned(BgnChunk) then - Fog.FogBgnd := True - else - Fog.FogBgnd := False; - FreeChunkData(FogChunk); - - // search for LAYER_FOG chunk - FogChunk := FindChunk(MDataChunk, LAYER_FOG); - if Assigned(FogChunk) then - begin - Source.ReadChunkData(FogChunk); - - LayerFog.ZMin := FogChunk^.Data.LayerFog^.ZMin; - LayerFog.ZMax := FogChunk^.Data.LayerFog^.ZMax; - LayerFog.Density := FogChunk^.Data.LayerFog^.Density; - - if (FogChunk^.Data.LayerFog^.AType and LayerFogBgnd) <> 0 then - LayerFog.FogBgnd := True - else - LayerFog.FogBgnd := False; - - if (FogChunk^.Data.LayerFog^.AType and TopFalloff) <> 0 then - LayerFog.Falloff := lfTopFall - else if (FogChunk^.Data.LayerFog^.AType and BottomFalloff) <> 0 then - LayerFog.Falloff := lfBottomFall - else - LayerFog.Falloff := lfNoFall; - - ColorChunk := FindChunk(FogChunk, COLOR_F); - if Assigned(ColorChunk) then - begin - Source.ReadChunkData(ColorChunk); - LayerFog.FogColor.R := ColorChunk^.Data.ColorF^.Red; - LayerFog.Fogcolor.G := ColorChunk^.Data.ColorF^.Green; - LayerFog.Fogcolor.B := ColorChunk^.Data.ColorF^.Blue; - FreeChunkData(ColorChunk); - end; - FreeChunkData(FogChunk); - end; - - // search for DISTANCE_CUE chunk - Chunk := FindChunk(MDataChunk, DISTANCE_CUE); - if Assigned(Chunk) then - begin - Source.ReadChunkData(Chunk); - - DCue.NearPlane := Chunk^.Data.DistanceCue^.NearPlaneDist; - DCue.neardim := Chunk^.Data.DistanceCue^.NearPlaneDimming; - DCue.FarPlane := Chunk^.Data.DistanceCue^.FarPlaneDist; - DCue.FarDim := Chunk^.Data.DistanceCue^.FarPlaneDimming; - - BgnChunk := FindChunk(Chunk, DCUE_BGND); - if Assigned(BgnChunk) then - DCue.DCueBgnd := True - else - DCue.DCueBgnd := False; - FreeChunkData(Chunk); - end; - - // search for USE_FOG, USE_LAYER_FOG or USE_DISTANCE_CUE chunk - Chunk := FindChunk(MDataChunk, USE_FOG); - if Assigned(Chunk) then - ActiveAtmo := atUseFog - else - begin - Chunk := FindChunk(MDataChunk, USE_LAYER_FOG); - if Assigned(Chunk) then - ActiveAtmo := atUseLayerFog - else - begin - Chunk := FindChunk(MDataChunk, USE_DISTANCE_CUE); - if Assigned(Chunk) then - ActiveAtmo := atUseDistanceCue - else - ActiveAtmo := atNoAtmo; - end; - end; - end; // with Result do - end; // if Assigned(MDataChunk) -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function InitBackground: TBackground3DS; - - // initializes the TBackground3DS structure - -begin - FillChar(Result, SizeOf(Result), 0); - Result.VGradient.GradPercent := 0.5; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetBackground(const Source: TFile3DS; var DB: TDatabase3DS): TBackground3DS; - - // retrieves the background settings from the database - -var - MDataChunk, ColorChunk, TopColor, MidColor, BotColor, Chunk: PChunk3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - - // Find the MDATA chunk - MDataChunk := FindChunk(DB.TopChunk, MDATA); - - // only continue with structure filling if an MDATA chunk is found - if Assigned(MDataChunk) then - with Result do - begin - Result := InitBackground; - // search for bitmap chunk - Chunk := FindChunk(MDataChunk, BIT_MAP); - if Assigned(Chunk) then - begin - // read the chunk information - Source.ReadChunkData(Chunk); - // copy the bitmap filename to the structure - if Assigned(Chunk^.Data.BitmapName) then - Bitmap := Chunk^.Data.BitmapName^ - else - Bitmap := ''; - FreeChunkData(Chunk); - end; - - Chunk := FindChunk(MDataChunk, SOLID_BGND); - if Assigned(Chunk) then - begin - ColorChunk := FindChunk(Chunk, COLOR_F); - if Assigned(ColorChunk) then - begin - Source.ReadChunkData(ColorChunk); - Solid.R := ColorChunk^.Data.ColorF^.Red; - Solid.G := ColorChunk^.Data.ColorF^.Green; - Solid.B := ColorChunk^.Data.ColorF^.Blue; - FreeChunkData(ColorChunk); - end; - - ColorChunk := FindChunk(Chunk, LIN_COLOR_F); - if Assigned(ColorChunk) then - begin - Source.ReadChunkData(ColorChunk); - Solid.R := ColorChunk^.Data.ColorF^.Red; - Solid.G := ColorChunk^.Data.ColorF^.Green; - Solid.B := ColorChunk^.Data.ColorF^.Blue; - FreeChunkData(ColorChunk); - end; - end; - - Chunk := FindChunk(MDataChunk, V_GRADIENT); - if Assigned(Chunk) then - begin - // the COLOR_F chunks are the old, non-gamma corrected colors - Source.ReadChunkData(Chunk); - VGradient.GradPercent := Chunk^.Data.VGradient^; - TopColor := FindChunk(Chunk, COLOR_F); - if Assigned(TopColor) then - begin - Source.ReadChunkData(TopColor); - VGradient.Top.R := TopColor^.Data.ColorF^.Red; - VGradient.Top.G := TopColor^.Data.ColorF^.Green; - VGradient.Top.B := TopColor^.Data.ColorF^.Blue; - MidColor := FindNextChunk(TopColor^.Sibling, COLOR_F); - if Assigned(MidColor) then - begin - Source.ReadChunkData(MidColor); - VGradient.Mid.R := MidColor^.Data.ColorF^.Red; - VGradient.Mid.G := MidColor^.Data.ColorF^.Green; - VGradient.Mid.B := MidColor^.Data.ColorF^.Blue; - BotColor := FindNextChunk(MidColor^.Sibling, COLOR_F); - if Assigned(BotColor) then - begin - Source.ReadChunkData(BotColor); - VGradient.Bottom.R := MidColor^.Data.ColorF^.Red; - VGradient.Bottom.G := MidColor^.Data.ColorF^.Green; - VGradient.Bottom.B := MidColor^.Data.ColorF^.Blue; - FreeChunkData(BotColor); - end; - FreeChunkData(MidColor); - end; - FreeChunkData(TopColor); - end; - - // If the newer, gamma correct colors are available, then use them instead - TopColor := FindChunk(Chunk, LIN_COLOR_F); - if Assigned(TopColor) then - begin - Source.ReadChunkData(TopColor); - VGradient.Top.R := TopColor^.Data.ColorF^.Red; - VGradient.Top.G := TopColor^.Data.ColorF^.Green; - VGradient.Top.B := TopColor^.Data.ColorF^.Blue; - MidColor := FindNextChunk(TopColor^.Sibling, LIN_COLOR_F); - if Assigned(MidColor) then - begin - Source.ReadChunkData(MidColor); - VGradient.Mid.R := MidColor^.Data.ColorF^.Red; - VGradient.Mid.G := MidColor^.Data.ColorF^.Green; - VGradient.Mid.B := MidColor^.Data.ColorF^.Blue; - BotColor := FindNextChunk(MidColor^.Sibling, LIN_COLOR_F); - if Assigned(BotColor) then - begin - Source.ReadChunkData(BotColor); - VGradient.Bottom.R := MidColor^.Data.ColorF^.Red; - VGradient.Bottom.G := MidColor^.Data.ColorF^.Green; - VGradient.Bottom.B := MidColor^.Data.ColorF^.Blue; - FreeChunkData(BotColor); - end; - FreeChunkData(MidColor); - end; - FreeChunkData(TopColor); - end; - FreeChunkData(Chunk); - end; - - // Search for use_bitmap, use_solid_bgnd and use_v_gradient chunks - Chunk := FindChunk(MDataChunk, USE_BIT_MAP); - if Assigned(Chunk) then - BgndUsed := btUseBitmapBgnd - else - begin - Chunk := FindChunk(MDataChunk, USE_SOLID_BGND); - if Assigned(Chunk) then - BgndUsed := btUseSolidBgnd - else - begin - Chunk := FindChunk(MDataChunk, USE_V_GRADIENT); - if Assigned(Chunk) then - BgndUsed := btUseVGradientBgnd - else - BgndUsed := btNoBgnd; - end; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function InitViewport: TViewport3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - with Result do - begin - AType := vtTopView3DS; - Ortho.Zoom := 0.7395; - User.Zoom := 0.7395; - User.HorAng := 20; - User.VerAng := 30; - CameraStr := ''; - Size.Width := 1000; - Size.Height := 1000; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetViewportEntry(Source: TFile3DS; Section: PChunk3DS): TViewport3DS; - -var - Chunk, VLayout: PChunk3DS; - PortIndex: integer; - foundV3: boolean; - -begin - Result := InitViewport; - VLayout := FindNextChunk(Section^.Children, VIEWPORT_LAYOUT); - - if Assigned(VLayout) then - with Result do - begin - Source.ReadChunkData(VLayout); - - Chunk := VLayout^.Children; - foundV3 := False; - PortIndex := 0; - while Assigned(Chunk) do - begin - case Chunk^.Tag of - VIEWPORT_SIZE: - begin - Source.ReadChunkData(Chunk); - Size.XPos := Chunk^.Data.ViewportSize^.XPos; - Size.YPos := Chunk^.Data.ViewportSize^.YPos; - Size.Width := Chunk^.Data.ViewportSize^.Width; - Size.Height := Chunk^.Data.ViewportSize^.Height; - FreeChunkData(Chunk); - end; - VIEWPORT_DATA_3: - begin - foundV3 := True; - if PortIndex = VLayout^.Data.ViewportLayout^.Top then - begin - Source.ReadChunkData(Chunk); - case Chunk^.Data.ViewportData^.View of - 1: - AType := vtTopView3DS; - 2: - AType := vtBottomView3DS; - 3: - AType := vtLeftView3DS; - 4: - AType := vtRightView3DS; - 5: - AType := vtFrontView3DS; - 6: - AType := vtBackView3DS; - 7: - AType := vtUserView3DS; - 18: - AType := vtSpotlightView3DS; - $FFFF: - AType := vtCameraView3DS; - else - AType := vtNoView3DS; - end; - - Ortho.Zoom := Chunk^.Data.ViewportData^.ZoomFactor; - User.Zoom := Chunk^.Data.ViewportData^.ZoomFactor; - Ortho.Center.X := Chunk^.Data.ViewportData^.Center.X; - User.Center.X := Chunk^.Data.ViewportData^.Center.X; - Ortho.Center.Y := Chunk^.Data.ViewportData^.Center.Y; - User.Center.y := Chunk^.Data.ViewportData^.Center.Y; - Ortho.Center.Z := Chunk^.Data.ViewportData^.Center.Z; - User.Center.z := Chunk^.Data.ViewportData^.Center.Z; - User.HorAng := Chunk^.Data.ViewportData^.HorizAng; - User.VerAng := Chunk^.Data.ViewportData^.VertAng; - CameraStr := string(Chunk^.Data.ViewportData^.CamNameStr); - end; - Inc(PortIndex); - end; - VIEWPORT_DATA: - if not foundV3 then - begin - if PortIndex = VLayout^.Data.ViewportLayout^.Top then - begin - Source.ReadChunkData(Chunk); - case Chunk^.Data.ViewportData^.View of - 1: - AType := vtTopView3DS; - 2: - AType := vtBottomView3DS; - 3: - AType := vtLeftView3DS; - 4: - AType := vtRightView3DS; - 5: - AType := vtFrontView3DS; - 6: - AType := vtBackView3DS; - 7: - AType := vtUserView3DS; - 18: - AType := vtSpotlightView3DS; - $FFFF: - AType := vtCameraView3DS; - else - AType := vtNoView3DS; - end; - - Ortho.Zoom := Chunk^.Data.ViewportData^.ZoomFactor; - User.Zoom := Chunk^.Data.ViewportData^.ZoomFactor; - Ortho.Center.X := Chunk^.Data.ViewportData^.Center.X; - User.Center.X := Chunk^.Data.ViewportData^.Center.X; - Ortho.Center.Y := Chunk^.Data.ViewportData^.Center.Y; - User.Center.y := Chunk^.Data.ViewportData^.Center.Y; - Ortho.Center.Z := Chunk^.Data.ViewportData^.Center.Z; - User.Center.z := Chunk^.Data.ViewportData^.Center.Z; - User.HorAng := Chunk^.Data.ViewportData^.HorizAng; - User.VerAng := Chunk^.Data.ViewportData^.VertAng; - CameraStr := string(Chunk^.Data.ViewportData^.CamNameStr); - end; - Inc(PortIndex); - end; - end; - Chunk := Chunk^.Sibling; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetViewport(const Source: TFile3DS; var DB: TDatabase3DS): TViewport3DS; - -var - Data: PChunk3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - if (DB.TopChunk^.Tag = M3DMAGIC) or (DB.TopChunk^.Tag = CMAGIC) then - begin - Data := FindNextChunk(DB.TopChunk^.Children, KFDATA); - if Assigned(Data) then - Result := GetViewportEntry(Source, Data) - else - begin - Data := FindChunk(DB.TopChunk^.Children, MDATA); - if Assigned(Data) then - Result := GetViewportEntry(Source, Data); - end; - end; -end; - -//----------------- helper funcs for text output ---------------------------------------------------------------------- - -function ChunkTagToString(Tag: word): string; - -begin - case Tag of - NULL_CHUNK: Result := 'NULL_CHUNK'; - ChunkType: Result := 'ChunkType'; - ChunkUnique: Result := 'ChunkUnique'; - NotChunk: Result := 'NotChunk'; - Container: Result := 'Container'; - IsChunk: Result := 'IsChunk'; - - // Dummy Chunk that sometimes appears in 3DS files created by prerelease 3D Studio R2 - DUMMY: Result := 'DUMMY'; - - // Trick Chunk Types - POINT_ARRAY_ENTRY: Result := 'POINT_ARRAY_ENTRY'; - POINT_FLAG_ARRAY_ENTRY: Result := 'POINT_FLAG_ARRAY_ENTRY'; - FACE_ARRAY_ENTRY: Result := 'FACE_ARRAY_ENTRY'; - MSH_MAT_GROUP_ENTRY: Result := 'MSH_MAT_GROUP_ENTRY'; - TEX_VERTS_ENTRY: Result := 'TEX_VERTS_ENTRY'; - SMOOTH_GROUP_ENTRY: Result := 'SMOOTH_GROUP_ENTRY'; - POS_TRACK_TAG_KEY: Result := 'POS_TRACK_TAG_KEY'; - ROT_TRACK_TAG_KEY: Result := 'ROT_TRACK_TAG_KEY'; - SCL_TRACK_TAG_KEY: Result := 'SCL_TRACK_TAG_KEY'; - FOV_TRACK_TAG_KEY: Result := 'FOV_TRACK_TAG_KEY'; - ROLL_TRACK_TAG_KEY: Result := 'ROLL_TRACK_TAG_KEY'; - COL_TRACK_TAG_KEY: Result := 'COL_TRACK_TAG_KEY'; - MORPH_TRACK_TAG_KEY: Result := 'MORPH_TRACK_TAG_KEY'; - HOT_TRACK_TAG_KEY: Result := 'HOT_TRACK_TAG_KEY'; - FALL_TRACK_TAG_KEY: Result := 'FALL_TRACK_TAG_KEY'; - - // 3DS File Chunk IDs - M3DMAGIC: Result := 'M3DMAGIC'; - SMAGIC: Result := 'SMAGIC'; - LMAGIC: Result := 'LMAGIC'; - MLIBMAGIC: Result := 'MLIBMAGIC'; - MATMAGIC: Result := 'MATMAGIC'; - M3D_VERSION: Result := 'M3D_VERSION'; - M3D_KFVERSION: Result := 'M3D_KFVERSION'; - - // Mesh Chunk Ids - MDATA: Result := 'MDATA'; - MESH_VERSION: Result := 'MESH_VERSION'; - COLOR_F: Result := 'COLOR_F'; - COLOR_24: Result := 'COLOR_24'; - LIN_COLOR_24: Result := 'LIN_COLOR_24'; - LIN_COLOR_F: Result := 'LIN_COLOR_F'; - INT_PERCENTAGE: Result := 'INT_PERCENTAGE'; - FLOAT_PERCENTAGE: Result := 'FLOAT_PERCENTAGE'; - - MASTER_SCALE: Result := 'MASTER_SCALE'; - - BIT_MAP: Result := 'BIT_MAP'; - USE_BIT_MAP: Result := 'USE_BIT_MAP'; - SOLID_BGND: Result := 'SOLID_BGND'; - USE_SOLID_BGND: Result := 'USE_SOLID_BGND'; - V_GRADIENT: Result := 'V_GRADIENT'; - USE_V_GRADIENT: Result := 'USE_V_GRADIENT'; - - LO_SHADOW_BIAS: Result := 'LO_SHADOW_BIAS'; - HI_SHADOW_BIAS: Result := 'HI_SHADOW_BIAS'; - SHADOW_MAP_SIZE: Result := 'SHADOW_MAP_SIZE'; - SHADOW_SAMPLES: Result := 'SHADOW_SAMPLES'; - SHADOW_RANGE: Result := 'SHADOW_RANGE'; - SHADOW_FILTER: Result := 'SHADOW_FILTER'; - RAY_BIAS: Result := 'RAY_BIAS'; - - O_CONSTS: Result := 'O_CONSTS'; - - AMBIENT_LIGHT: Result := 'AMBIENT_LIGHT'; - - FOG: Result := 'FOG'; - USE_FOG: Result := 'USE_FOG'; - FOG_BGND: Result := 'FOG_BGND'; - DISTANCE_CUE: Result := 'DISTANCE_CUE'; - USE_DISTANCE_CUE: Result := 'USE_DISTANCE_CUE'; - LAYER_FOG: Result := 'LAYER_FOG'; - USE_LAYER_FOG: Result := 'USE_LAYER_FOG'; - DCUE_BGND: Result := 'DCUE_BGND'; - - DEFAULT_VIEW: Result := 'DEFAULT_VIEW'; - VIEW_TOP: Result := 'VIEW_TOP'; - VIEW_BOTTOM: Result := 'VIEW_BOTTOM'; - VIEW_LEFT: Result := 'VIEW_LEFT'; - VIEW_RIGHT: Result := 'VIEW_RIGHT'; - VIEW_FRONT: Result := 'VIEW_FRONT'; - VIEW_BACK: Result := 'VIEW_BACK'; - VIEW_USER: Result := 'VIEW_USER'; - VIEW_CAMERA: Result := 'VIEW_CAMERA'; - VIEW_WINDOW: Result := 'VIEW_WINDOW'; - - NAMED_OBJECT: Result := 'NAMED_OBJECT'; - OBJ_HIDDEN: Result := 'OBJ_HIDDEN'; - OBJ_VIS_LOFTER: Result := 'OBJ_VIS_LOFTER'; - OBJ_DOESNT_CAST: Result := 'OBJ_DOESNT_CAST'; - OBJ_MATTE: Result := 'OBJ_MATTE'; - OBJ_FAST: Result := 'OBJ_FAST'; - OBJ_PROCEDURAL: Result := 'OBJ_PROCEDURAL'; - OBJ_FROZEN: Result := 'OBJ_FROZEN'; - OBJ_DONT_RCVSHADOW: Result := 'OBJ_DONT_RCVSHADOW'; - - N_TRI_OBJECT: Result := 'N_TRI_OBJECT'; - - POINT_ARRAY: Result := 'POINT_ARRAY'; - POINT_FLAG_ARRAY: Result := 'POINT_FLAG_ARRAY'; - FACE_ARRAY: Result := 'FACE_ARRAY'; - MSH_MAT_GROUP: Result := 'MSH_MAT_GROUP'; - OLD_MAT_GROUP: Result := 'OLD_MAT_GROUP'; - TEX_VERTS: Result := 'TEX_VERTS'; - SMOOTH_GROUP: Result := 'SMOOTH_GROUP'; - MESH_MATRIX: Result := 'MESH_MATRIX'; - MESH_COLOR: Result := 'MESH_COLOR'; - MESH_TEXTURE_INFO: Result := 'MESH_TEXTURE_INFO'; - PROC_NAME: Result := 'PROC_NAME'; - PROC_DATA: Result := 'PROC_DATA'; - MSH_BOXMAP: Result := 'MSH_BOXMAP'; - - N_D_L_OLD: Result := 'N_D_L_OLD'; - - N_CAM_OLD: Result := 'N_CAM_OLD'; - - N_DIRECT_LIGHT: Result := 'N_DIRECT_LIGHT'; - DL_SPOTLIGHT: Result := 'DL_SPOTLIGHT'; - DL_OFF: Result := 'DL_OFF'; - DL_ATTENUATE: Result := 'DL_ATTENUATE'; - DL_RAYSHAD: Result := 'DL_RAYSHAD'; - DL_SHADOWED: Result := 'DL_SHADOWED'; - DL_LOCAL_SHADOW: Result := 'DL_LOCAL_SHADOW'; - DL_LOCAL_SHADOW2: Result := 'DL_LOCAL_SHADOW2'; - DL_SEE_CONE: Result := 'DL_SEE_CONE'; - DL_SPOT_RECTANGULAR: Result := 'DL_SPOT_RECTANGULAR'; - DL_SPOT_OVERSHOOT: Result := 'DL_SPOT_OVERSHOOT'; - DL_SPOT_PROJECTOR: Result := 'DL_SPOT_PROJECTOR'; - DL_EXCLUDE: Result := 'DL_EXCLUDE'; - DL_RANGE: Result := 'DL_RANGE'; - DL_SPOT_ROLL: Result := 'DL_SPOT_ROLL'; - DL_SPOT_ASPECT: Result := 'DL_SPOT_ASPECT'; - DL_RAY_BIAS: Result := 'DL_RAY_BIAS'; - DL_INNER_RANGE: Result := 'DL_INNER_RANGE'; - DL_OUTER_RANGE: Result := 'DL_OUTER_RANGE'; - DL_MULTIPLIER: Result := 'DL_MULTIPLIER'; - - N_AMBIENT_LIGHT: Result := 'N_AMBIENT_LIGHT'; - - N_CAMERA: Result := 'N_CAMERA'; - CAM_SEE_CONE: Result := 'CAM_SEE_CONE'; - CAM_RANGES: Result := 'CAM_RANGES'; - - HIERARCHY: Result := 'HIERARCHY'; - PARENT_OBJECT: Result := 'PARENT_OBJECT'; - PIVOT_OBJECT: Result := 'PIVOT_OBJECT'; - PIVOT_LIMITS: Result := 'PIVOT_LIMITS'; - PIVOT_ORDER: Result := 'PIVOT_ORDER'; - XLATE_RANGE: Result := 'XLATE_RANGE'; - - POLY_2D: Result := 'POLY_2D'; - - // Flags in shaper file that tell whether polys make up an ok shape - SHAPE_OK: Result := 'SHAPE_OK'; - SHAPE_NOT_OK: Result := 'SHAPE_NOT_OK'; - - SHAPE_HOOK: Result := 'SHAPE_HOOK'; - - PATH_3D: Result := 'PATH_3D'; - PATH_MATRIX: Result := 'PATH_MATRIX'; - SHAPE_2D: Result := 'SHAPE_2D'; - M_SCALE: Result := 'M_SCALE'; - M_TWIST: Result := 'M_TWIST'; - M_TEETER: Result := 'M_TEETER'; - M_FIT: Result := 'M_FIT'; - M_BEVEL: Result := 'M_BEVEL'; - XZ_CURVE: Result := 'XZ_CURVE'; - YZ_CURVE: Result := 'YZ_CURVE'; - INTERPCT: Result := 'INTERPCT'; - DEFORM_LIMIT: Result := 'DEFORM_LIMIT'; - - // Flags for Modeler options - USE_CONTOUR: Result := 'USE_CONTOUR'; - USE_TWEEN: Result := 'USE_TWEEN'; - USE_SCALE: Result := 'USE_SCALE'; - USE_TWIST: Result := 'USE_TWIST'; - USE_TEETER: Result := 'USE_TEETER'; - USE_FIT: Result := 'USE_FIT'; - USE_BEVEL: Result := 'USE_BEVEL'; - - // Viewport description chunks - VIEWPORT_LAYOUT_OLD: Result := 'VIEWPORT_LAYOUT_OLD'; - VIEWPORT_DATA_OLD: Result := 'VIEWPORT_DATA_OLD'; - VIEWPORT_LAYOUT: Result := 'VIEWPORT_LAYOUT'; - VIEWPORT_DATA: Result := 'VIEWPORT_DATA'; - VIEWPORT_DATA_3: Result := 'VIEWPORT_DATA_3'; - VIEWPORT_SIZE: Result := 'VIEWPORT_SIZE'; - NETWORK_VIEW: Result := 'NETWORK_VIEW'; - - // External Application Data - XDATA_SECTION: Result := 'XDATA_SECTION'; - XDATA_ENTRY: Result := 'XDATA_ENTRY'; - XDATA_APPNAME: Result := 'XDATA_APPNAME'; - XDATA_STRING: Result := 'XDATA_STRING'; - XDATA_FLOAT: Result := 'XDATA_FLOAT'; - XDATA_DOUBLE: Result := 'XDATA_DOUBLE'; - XDATA_SHORT: Result := 'XDATA_SHORT'; - XDATA_LONG: Result := 'XDATA_LONG'; - XDATA_VOID: Result := 'XDATA_procedure'; - XDATA_GROUP: Result := 'XDATA_GROUP'; - XDATA_RFU6: Result := 'XDATA_RFU6'; - XDATA_RFU5: Result := 'XDATA_RFU5'; - XDATA_RFU4: Result := 'XDATA_RFU4'; - XDATA_RFU3: Result := 'XDATA_RFU3'; - XDATA_RFU2: Result := 'XDATA_RFU2'; - XDATA_RFU1: Result := 'XDATA_RFU1'; - - // Material Chunk IDs - MAT_ENTRY: Result := 'MAT_ENTRY'; - MAT_NAME: Result := 'MAT_NAME'; - MAT_AMBIENT: Result := 'MAT_AMBIENT'; - MAT_DIFFUSE: Result := 'MAT_DIFFUSE'; - MAT_SPECULAR: Result := 'MAT_SPECULAR'; - MAT_SHININESS: Result := 'MAT_SHININESS'; - MAT_SHIN2PCT: Result := 'MAT_SHIN2PCT'; - MAT_SHIN3PCT: Result := 'MAT_SHIN3PCT'; - MAT_TRANSPARENCY: Result := 'MAT_TRANSPARENCY'; - MAT_XPFALL: Result := 'MAT_XPFALL'; - MAT_REFBLUR: Result := 'MAT_REFBLUR'; - - MAT_SELF_ILLUM: Result := 'MAT_SELF_ILLUM'; - MAT_TWO_SIDE: Result := 'MAT_TWO_SIDE'; - MAT_DECAL: Result := 'MAT_DECAL'; - MAT_ADDITIVE: Result := 'MAT_ADDITIVE'; - MAT_SELF_ILPCT: Result := 'MAT_SELF_ILPCT'; - MAT_WIRE: Result := 'MAT_WIRE'; - MAT_SUPERSMP: Result := 'MAT_SUPERSMP'; - MAT_WIRESIZE: Result := 'MAT_WIRESIZE'; - MAT_FACEMAP: Result := 'MAT_FACEMAP'; - MAT_XPFALLIN: Result := 'MAT_XPFALLIN'; - MAT_PHONGSOFT: Result := 'MAT_PHONGSOFT'; - MAT_WIREABS: Result := 'MAT_WIREABS'; - - MAT_SHADING: Result := 'MAT_SHADING'; - - MAT_TEXMAP: Result := 'MAT_TEXMAP'; - MAT_OPACMAP: Result := 'MAT_OPACMAP'; - MAT_REFLMAP: Result := 'MAT_REFLMAP'; - MAT_BUMPMAP: Result := 'MAT_BUMPMAP'; - MAT_SPECMAP: Result := 'MAT_SPECMAP'; - MAT_USE_XPFALL: Result := 'MAT_USE_XPFALL'; - MAT_USE_REFBLUR: Result := 'MAT_USE_REFBLUR'; - MAT_BUMP_PERCENT: Result := 'MAT_BUMP_PERCENT'; - - MAT_MAPNAME: Result := 'MAT_MAPNAME'; - MAT_ACUBIC: Result := 'MAT_ACUBIC'; - - MAT_SXP_TEXT_DATA: Result := 'MAT_SXP_TEXT_DATA'; - MAT_SXP_TEXT2_DATA: Result := 'MAT_SXP_TEXT2_DATA'; - MAT_SXP_OPAC_DATA: Result := 'MAT_SXP_OPAC_DATA'; - MAT_SXP_BUMP_DATA: Result := 'MAT_SXP_BUMP_DATA'; - MAT_SXP_SPEC_DATA: Result := 'MAT_SXP_SPEC_DATA'; - MAT_SXP_SHIN_DATA: Result := 'MAT_SXP_SHIN_DATA'; - MAT_SXP_SELFI_DATA: Result := 'MAT_SXP_SELFI_DATA'; - MAT_SXP_TEXT_MASKDATA: Result := 'MAT_SXP_TEXT_MASKDATA'; - MAT_SXP_TEXT2_MASKDATA: Result := 'MAT_SXP_TEXT2_MASKDATA'; - MAT_SXP_OPAC_MASKDATA: Result := 'MAT_SXP_OPAC_MASKDATA'; - MAT_SXP_BUMP_MASKDATA: Result := 'MAT_SXP_BUMP_MASKDATA'; - MAT_SXP_SPEC_MASKDATA: Result := 'MAT_SXP_SPEC_MASKDATA'; - MAT_SXP_SHIN_MASKDATA: Result := 'MAT_SXP_SHIN_MASKDATA'; - MAT_SXP_SELFI_MASKDATA: Result := 'MAT_SXP_SELFI_MASKDATA'; - MAT_SXP_REFL_MASKDATA: Result := 'MAT_SXP_REFL_MASKDATA'; - MAT_TEX2MAP: Result := 'MAT_TEX2MAP'; - MAT_SHINMAP: Result := 'MAT_SHINMAP'; - MAT_SELFIMAP: Result := 'MAT_SELFIMAP'; - MAT_TEXMASK: Result := 'MAT_TEXMASK'; - MAT_TEX2MASK: Result := 'MAT_TEX2MASK'; - MAT_OPACMASK: Result := 'MAT_OPACMASK'; - MAT_BUMPMASK: Result := 'MAT_BUMPMASK'; - MAT_SHINMASK: Result := 'MAT_SHINMASK'; - MAT_SPECMASK: Result := 'MAT_SPECMASK'; - MAT_SELFIMASK: Result := 'MAT_SELFIMASK'; - MAT_REFLMASK: Result := 'MAT_REFLMASK'; - MAT_MAP_TILINGOLD: Result := 'MAT_MAP_TILINGOLD'; - MAT_MAP_TILING: Result := 'MAT_MAP_TILING'; - MAT_MAP_TEXBLUR_OLD: Result := 'MAT_MAP_TEXBLUR_OLD'; - MAT_MAP_TEXBLUR: Result := 'MAT_MAP_TEXBLUR'; - MAT_MAP_USCALE: Result := 'MAT_MAP_USCALE'; - MAT_MAP_VSCALE: Result := 'MAT_MAP_VSCALE'; - MAT_MAP_UOFFSET: Result := 'MAT_MAP_UOFFSET'; - MAT_MAP_VOFFSET: Result := 'MAT_MAP_VOFFSET'; - MAT_MAP_ANG: Result := 'MAT_MAP_ANG'; - MAT_MAP_COL1: Result := 'MAT_MAP_COL1'; - MAT_MAP_COL2: Result := 'MAT_MAP_COL2'; - MAT_MAP_RCOL: Result := 'MAT_MAP_RCOL'; - MAT_MAP_GCOL: Result := 'MAT_MAP_GCOL'; - MAT_MAP_BCOL: Result := 'MAT_MAP_BCOL'; - - // Keyframe Chunk IDs - KFDATA: Result := 'KFDATA'; - KFHDR: Result := 'KFHDR'; - AMBIENT_NODE_TAG: Result := 'AMBIENT_NODE_TAG'; - OBJECT_NODE_TAG: Result := 'OBJECT_NODE_TAG'; - CAMERA_NODE_TAG: Result := 'CAMERA_NODE_TAG'; - TARGET_NODE_TAG: Result := 'TARGET_NODE_TAG'; - LIGHT_NODE_TAG: Result := 'LIGHT_NODE_TAG'; - L_TARGET_NODE_TAG: Result := 'L_TARGET_NODE_TAG'; - SPOTLIGHT_NODE_TAG: Result := 'SPOTLIGHT_NODE_TAG'; - - KFSEG: Result := 'KFSEG'; - KFCURTIME: Result := 'KFCURTIME'; - NODE_HDR: Result := 'NODE_HDR'; - PARENT_NAME: Result := 'PARENT_NAME'; - INSTANCE_NAME: Result := 'INSTANCE_NAME'; - PRESCALE: Result := 'PRESCALE'; - PIVOT: Result := 'PIVOT'; - BOUNDBOX: Result := 'BOUNDBOX'; - MORPH_SMOOTH: Result := 'MORPH_SMOOTH'; - POS_TRACK_TAG: Result := 'POS_TRACK_TAG'; - ROT_TRACK_TAG: Result := 'ROT_TRACK_TAG'; - SCL_TRACK_TAG: Result := 'SCL_TRACK_TAG'; - FOV_TRACK_TAG: Result := 'FOV_TRACK_TAG'; - ROLL_TRACK_TAG: Result := 'ROLL_TRACK_TAG'; - COL_TRACK_TAG: Result := 'COL_TRACK_TAG'; - MORPH_TRACK_TAG: Result := 'MORPH_TRACK_TAG'; - HOT_TRACK_TAG: Result := 'HOT_TRACK_TAG'; - FALL_TRACK_TAG: Result := 'FALL_TRACK_TAG'; - HIDE_TRACK_TAG: Result := 'HIDE_TRACK_TAG'; - NODE_ID: Result := 'NODE_ID'; - - CMAGIC: Result := 'CMAGIC'; - - C_MDRAWER: Result := 'C_MDRAWER'; - C_TDRAWER: Result := 'C_TDRAWER'; - C_SHPDRAWER: Result := 'C_SHPDRAWER'; - C_MODDRAWER: Result := 'C_MODDRAWER'; - C_RIPDRAWER: Result := 'C_RIPDRAWER'; - C_TXDRAWER: Result := 'C_TXDRAWER'; - C_PDRAWER: Result := 'C_PDRAWER'; - C_MTLDRAWER: Result := 'C_MTLDRAWER'; - C_FLIDRAWER: Result := 'C_FLIDRAWER'; - C_CUBDRAWER: Result := 'C_CUBDRAWER'; - C_MFILE: Result := 'C_MFILE'; - C_SHPFILE: Result := 'C_SHPFILE'; - C_MODFILE: Result := 'C_MODFILE'; - C_RIPFILE: Result := 'C_RIPFILE'; - C_TXFILE: Result := 'C_TXFILE'; - C_PFILE: Result := 'C_PFILE'; - C_MTLFILE: Result := 'C_MTLFILE'; - C_FLIFILE: Result := 'C_FLIFILE'; - C_PALFILE: Result := 'C_PALFILE'; - C_TX_STRING: Result := 'C_TX_STRING'; - C_CONSTS: Result := 'C_CONSTS'; - C_SNAPS: Result := 'C_SNAPS'; - C_GRIDS: Result := 'C_GRIDS'; - C_ASNAPS: Result := 'C_ASNAPS'; - C_GRID_RANGE: Result := 'C_GRID_RANGE'; - C_RENDTYPE: Result := 'C_RENDTYPE'; - C_PROGMODE: Result := 'C_PROGMODE'; - C_PREVMODE: Result := 'C_PREVMODE'; - C_MODWMODE: Result := 'C_MODWMODE'; - C_MODMODEL: Result := 'C_MODMODEL'; - C_ALL_LINES: Result := 'C_ALL_LINES'; - C_BACK_TYPE: Result := 'C_BACK_TYPE'; - C_MD_CS: Result := 'C_MD_CS'; - C_MD_CE: Result := 'C_MD_CE'; - C_MD_SML: Result := 'C_MD_SML'; - C_MD_SMW: Result := 'C_MD_SMW'; - C_LOFT_WITH_TEXTURE: Result := 'C_LOFT_WITH_TEXTURE'; - C_LOFT_L_REPEAT: Result := 'C_LOFT_L_REPEAT'; - C_LOFT_W_REPEAT: Result := 'C_LOFT_W_REPEAT'; - C_LOFT_UV_NORMALIZE: Result := 'C_LOFT_UV_NORMALIZE'; - C_WELD_LOFT: Result := 'C_WELD_LOFT'; - C_MD_PDET: Result := 'C_MD_PDET'; - C_MD_SDET: Result := 'C_MD_SDET'; - C_RGB_RMODE: Result := 'C_RGB_RMODE'; - C_RGB_HIDE: Result := 'C_RGB_HIDE'; - C_RGB_MAPSW: Result := 'C_RGB_MAPSW'; - C_RGB_TWOSIDE: Result := 'C_RGB_TWOSIDE'; - C_RGB_SHADOW: Result := 'C_RGB_SHADOW'; - C_RGB_AA: Result := 'C_RGB_AA'; - C_RGB_OVW: Result := 'C_RGB_OVW'; - C_RGB_OVH: Result := 'C_RGB_OVH'; - C_RGB_PICTYPE: Result := 'C_RGB_PICTYPE'; - C_RGB_OUTPUT: Result := 'C_RGB_OUTPUT'; - C_RGB_TODISK: Result := 'C_RGB_TODISK'; - C_RGB_COMPRESS: Result := 'C_RGB_COMPRESS'; - C_JPEG_COMPRESSION: Result := 'C_JPEG_COMPRESSION'; - C_RGB_DISPDEV: Result := 'C_RGB_DISPDEV'; - C_RGB_HARDDEV: Result := 'C_RGB_HARDDEV'; - C_RGB_PATH: Result := 'C_RGB_PATH'; - C_BITMAP_DRAWER: Result := 'C_BITMAP_DRAWER'; - C_RGB_FILE: Result := 'C_RGB_FILE'; - C_RGB_OVASPECT: Result := 'C_RGB_OVASPECT'; - - C_RGB_ANIMTYPE: Result := 'C_RGB_ANIMTYPE'; - C_RENDER_ALL: Result := 'C_RENDER_ALL'; - C_REND_FROM: Result := 'C_REND_FROM'; - C_REND_TO: Result := 'C_REND_TO'; - C_REND_NTH: Result := 'C_REND_NTH'; - C_REND_TSTEP: Result := 'C_REND_TSTEP'; - C_VP_TSTEP: Result := 'C_VP_TSTEP'; - - C_PAL_TYPE: Result := 'C_PAL_TYPE'; - C_RND_TURBO: Result := 'C_RND_TURBO'; - C_RND_MIP: Result := 'C_RND_MIP'; - C_BGND_METHOD: Result := 'C_BGND_METHOD'; - C_AUTO_REFLECT: Result := 'C_AUTO_REFLECT'; - C_VP_FROM: Result := 'C_VP_FROM'; - C_VP_TO: Result := 'C_VP_TO'; - C_VP_NTH: Result := 'C_VP_NTH'; - - C_SRDIAM: Result := 'C_SRDIAM'; - C_SRDEG: Result := 'C_SRDEG'; - C_SRSEG: Result := 'C_SRSEG'; - C_SRDIR: Result := 'C_SRDIR'; - C_HETOP: Result := 'C_HETOP'; - C_HEBOT: Result := 'C_HEBOT'; - C_HEHT: Result := 'C_HEHT'; - C_HETURNS: Result := 'C_HETURNS'; - C_HEDEG: Result := 'C_HEDEG'; - C_HESEG: Result := 'C_HESEG'; - C_HEDIR: Result := 'C_HEDIR'; - C_QUIKSTUFF: Result := 'C_QUIKSTUFF'; - C_SEE_LIGHTS: Result := 'C_SEE_LIGHTS'; - C_SEE_CAMERAS: Result := 'C_SEE_CAMERAS'; - C_SEE_3D: Result := 'C_SEE_3D'; - C_MESHSEL: Result := 'C_MESHSEL'; - C_MESHUNSEL: Result := 'C_MESHUNSEL'; - C_POLYSEL: Result := 'C_POLYSEL'; - C_POLYUNSEL: Result := 'C_POLYUNSEL'; - C_SHPLOCAL: Result := 'C_SHPLOCAL'; - C_MSHLOCAL: Result := 'C_MSHLOCAL'; - C_NUM_FORMAT: Result := 'C_NUM_FORMAT'; - C_ARCH_DENOM: Result := 'C_ARCH_DENOM'; - C_IN_DEVICE: Result := 'C_IN_DEVICE'; - C_MSCALE: Result := 'C_MSCALE'; - C_COMM_PORT: Result := 'C_COMM_PORT'; - C_TAB_BASES: Result := 'C_TAB_BASES'; - C_TAB_DIVS: Result := 'C_TAB_DIVS'; - C_MASTER_SCALES: Result := 'C_MASTER_SCALES'; - C_SHOW_1STVERT: Result := 'C_SHOW_1STVERT'; - C_SHAPER_OK: Result := 'C_SHAPER_OK'; - C_LOFTER_OK: Result := 'C_LOFTER_OK'; - C_EDITOR_OK: Result := 'C_EDITOR_OK'; - C_KEYFRAMER_OK: Result := 'C_KEYFRAMER_OK'; - C_PICKSIZE: Result := 'C_PICKSIZE'; - C_MAPTYPE: Result := 'C_MAPTYPE'; - C_MAP_DISPLAY: Result := 'C_MAP_DISPLAY'; - C_TILE_XY: Result := 'C_TILE_XY'; - C_MAP_XYZ: Result := 'C_MAP_XYZ'; - C_MAP_SCALE: Result := 'C_MAP_SCALE'; - C_MAP_MATRIX_OLD: Result := 'C_MAP_MATRIX_OLD'; - C_MAP_MATRIX: Result := 'C_MAP_MATRIX'; - C_MAP_WID_HT: Result := 'C_MAP_WID_HT'; - C_OBNAME: Result := 'C_OBNAME'; - C_CAMNAME: Result := 'C_CAMNAME'; - C_LTNAME: Result := 'C_LTNAME'; - C_CUR_MNAME: Result := 'C_CUR_MNAME'; - C_CURMTL_FROM_MESH: Result := 'C_CURMTL_FROM_MESH'; - C_GET_SHAPE_MAKE_FACES: Result := 'C_GET_SHAPE_MAKE_FACES'; - C_DETAIL: Result := 'C_DETAIL'; - C_VERTMARK: Result := 'C_VERTMARK'; - C_MSHAX: Result := 'C_MSHAX'; - C_MSHCP: Result := 'C_MSHCP'; - C_USERAX: Result := 'C_USERAX'; - C_SHOOK: Result := 'C_SHOOK'; - C_RAX: Result := 'C_RAX'; - C_STAPE: Result := 'C_STAPE'; - C_LTAPE: Result := 'C_LTAPE'; - C_ETAPE: Result := 'C_ETAPE'; - C_KTAPE: Result := 'C_KTAPE'; - C_SPHSEGS: Result := 'C_SPHSEGS'; - C_GEOSMOOTH: Result := 'C_GEOSMOOTH'; - C_HEMISEGS: Result := 'C_HEMISEGS'; - C_PRISMSEGS: Result := 'C_PRISMSEGS'; - C_PRISMSIDES: Result := 'C_PRISMSIDES'; - C_TUBESEGS: Result := 'C_TUBESEGS'; - C_TUBESIDES: Result := 'C_TUBESIDES'; - C_TORSEGS: Result := 'C_TORSEGS'; - C_TORSIDES: Result := 'C_TORSIDES'; - C_CONESIDES: Result := 'C_CONESIDES'; - C_CONESEGS: Result := 'C_CONESEGS'; - C_NGPARMS: Result := 'C_NGPARMS'; - C_PTHLEVEL: Result := 'C_PTHLEVEL'; - C_MSCSYM: Result := 'C_MSCSYM'; - C_MFTSYM: Result := 'C_MFTSYM'; - C_MTTSYM: Result := 'C_MTTSYM'; - C_SMOOTHING: Result := 'C_SMOOTHING'; - C_MODICOUNT: Result := 'C_MODICOUNT'; - C_FONTSEL: Result := 'C_FONTSEL'; - C_TESS_TYPE: Result := 'C_TESS_TYPE'; - C_TESS_TENSION: Result := 'C_TESS_TENSION'; - - C_SEG_START: Result := 'C_SEG_START'; - C_SEG_END: Result := 'C_SEG_END'; - C_CURTIME: Result := 'C_CURTIME'; - C_ANIMLENGTH: Result := 'C_ANIMLENGTH'; - C_PV_FROM: Result := 'C_PV_FROM'; - C_PV_TO: Result := 'C_PV_TO'; - C_PV_DOFNUM: Result := 'C_PV_DOFNUM'; - C_PV_RNG: Result := 'C_PV_RNG'; - C_PV_NTH: Result := 'C_PV_NTH'; - C_PV_TYPE: Result := 'C_PV_TYPE'; - C_PV_METHOD: Result := 'C_PV_METHOD'; - C_PV_FPS: Result := 'C_PV_FPS'; - C_VTR_FRAMES: Result := 'C_VTR_FRAMES'; - C_VTR_HDTL: Result := 'C_VTR_HDTL'; - C_VTR_HD: Result := 'C_VTR_HD'; - C_VTR_TL: Result := 'C_VTR_TL'; - C_VTR_IN: Result := 'C_VTR_IN'; - C_VTR_PK: Result := 'C_VTR_PK'; - C_VTR_SH: Result := 'C_VTR_SH'; - - // Material chunks - C_WORK_MTLS: Result := 'C_WORK_MTLS'; - C_WORK_MTLS_2: Result := 'C_WORK_MTLS_2'; - C_WORK_MTLS_3: Result := 'C_WORK_MTLS_3'; - C_WORK_MTLS_4: Result := 'C_WORK_MTLS_4'; - C_WORK_MTLS_5: Result := 'C_WORK_MTLS_5'; - C_WORK_MTLS_6: Result := 'C_WORK_MTLS_6'; - C_WORK_MTLS_7: Result := 'C_WORK_MTLS_7'; - C_WORK_MTLS_8: Result := 'C_WORK_MTLS_8'; - C_WORKMTL: Result := 'C_WORKMTL'; - C_SXP_TEXT_DATA: Result := 'C_SXP_TEXT_DATA'; - C_SXP_TEXT2_DATA: Result := 'C_SXP_TEXT2_DATA'; - C_SXP_OPAC_DATA: Result := 'C_SXP_OPAC_DATA'; - C_SXP_BUMP_DATA: Result := 'C_SXP_BUMP_DATA'; - C_SXP_SPEC_DATA: Result := 'C_SXP_SPEC_DATA'; - C_SXP_SHIN_DATA: Result := 'C_SXP_SHIN_DATA'; - C_SXP_SELFI_DATA: Result := 'C_SXP_SELFI_DATA'; - C_SXP_TEXT_MASKDATA: Result := 'C_SXP_TEXT_MASKDATA'; - C_SXP_TEXT2_MASKDATA: Result := 'C_SXP_TEXT2_MASKDATA'; - C_SXP_OPAC_MASKDATA: Result := 'C_SXP_OPAC_MASKDATA'; - C_SXP_BUMP_MASKDATA: Result := 'C_SXP_BUMP_MASKDATA'; - C_SXP_SPEC_MASKDATA: Result := 'C_SXP_SPEC_MASKDATA'; - C_SXP_SHIN_MASKDATA: Result := 'C_SXP_SHIN_MASKDATA'; - C_SXP_SELFI_MASKDATA: Result := 'C_SXP_SELFI_MASKDATA'; - C_SXP_REFL_MASKDATA: Result := 'C_SXP_REFL_MASKDATA'; - - C_BGTYPE: Result := 'C_BGTYPE'; - C_MEDTILE: Result := 'C_MEDTILE'; - - // Contrast - C_LO_CONTRAST: Result := 'C_LO_CONTRAST'; - C_HI_CONTRAST: Result := 'C_HI_CONTRAST'; - - // 3D frozen display - C_FROZ_DISPLAY: Result := 'C_FROZ_DISPLAY'; - - // Booleans - C_BOOLWELD: Result := 'C_BOOLWELD'; - C_BOOLTYPE: Result := 'C_BOOLTYPE'; - - C_ANG_THRESH: Result := 'C_ANG_THRESH'; - C_SS_THRESH: Result := 'C_SS_THRESH'; - C_TEXTURE_BLUR_DEFAULT: Result := 'C_TEXTURE_BLUR_DEFAULT'; - - C_MAPDRAWER: Result := 'C_MAPDRAWER'; - C_MAPDRAWER1: Result := 'C_MAPDRAWER1'; - C_MAPDRAWER2: Result := 'C_MAPDRAWER2'; - C_MAPDRAWER3: Result := 'C_MAPDRAWER3'; - C_MAPDRAWER4: Result := 'C_MAPDRAWER4'; - C_MAPDRAWER5: Result := 'C_MAPDRAWER5'; - C_MAPDRAWER6: Result := 'C_MAPDRAWER6'; - C_MAPDRAWER7: Result := 'C_MAPDRAWER7'; - C_MAPDRAWER8: Result := 'C_MAPDRAWER8'; - C_MAPDRAWER9: Result := 'C_MAPDRAWER9'; - C_MAPDRAWER_ENTRY: Result := 'C_MAPDRAWER_ENTRY'; - - // system options - C_BACKUP_FILE: Result := 'C_BACKUP_FILE'; - C_DITHER_256: Result := 'C_DITHER_256'; - C_SAVE_LAST: Result := 'C_SAVE_LAST'; - C_USE_ALPHA: Result := 'C_USE_ALPHA'; - C_TGA_DEPTH: Result := 'C_TGA_DEPTH'; - C_REND_FIELDS: Result := 'C_REND_FIELDS'; - C_REFLIP: Result := 'C_REFLIP'; - C_SEL_ITEMTOG: Result := 'C_SEL_ITEMTOG'; - C_SEL_RESET: Result := 'C_SEL_RESET'; - C_STICKY_KEYINF: Result := 'C_STICKY_KEYINF'; - C_WELD_THRESHOLD: Result := 'C_WELD_THRESHOLD'; - C_ZCLIP_POINT: Result := 'C_ZCLIP_POINT'; - C_ALPHA_SPLIT: Result := 'C_ALPHA_SPLIT'; - C_KF_SHOW_BACKFACE: Result := 'C_KF_SHOW_BACKFACE'; - C_OPTIMIZE_LOFT: Result := 'C_OPTIMIZE_LOFT'; - C_TENS_DEFAULT: Result := 'C_TENS_DEFAULT'; - C_CONT_DEFAULT: Result := 'C_CONT_DEFAULT'; - C_BIAS_DEFAULT: Result := 'C_BIAS_DEFAULT'; - - C_DXFNAME_SRC: Result := 'C_DXFNAME_SRC '; - C_AUTO_WELD: Result := 'C_AUTO_WELD '; - C_AUTO_UNIFY: Result := 'C_AUTO_UNIFY '; - C_AUTO_SMOOTH: Result := 'C_AUTO_SMOOTH '; - C_DXF_SMOOTH_ANG: Result := 'C_DXF_SMOOTH_ANG '; - C_SMOOTH_ANG: Result := 'C_SMOOTH_ANG '; - - // Special network-use chunks - C_NET_USE_VPOST: Result := 'C_NET_USE_VPOST'; - C_NET_USE_GAMMA: Result := 'C_NET_USE_GAMMA'; - C_NET_FIELD_ORDER: Result := 'C_NET_FIELD_ORDER'; - - C_BLUR_FRAMES: Result := 'C_BLUR_FRAMES'; - C_BLUR_SAMPLES: Result := 'C_BLUR_SAMPLES'; - C_BLUR_DUR: Result := 'C_BLUR_DUR'; - C_HOT_METHOD: Result := 'C_HOT_METHOD'; - C_HOT_CHECK: Result := 'C_HOT_CHECK'; - C_PIXEL_SIZE: Result := 'C_PIXEL_SIZE'; - C_DISP_GAMMA: Result := 'C_DISP_GAMMA'; - C_FBUF_GAMMA: Result := 'C_FBUF_GAMMA'; - C_FILE_OUT_GAMMA: Result := 'C_FILE_OUT_GAMMA'; - C_FILE_IN_GAMMA: Result := 'C_FILE_IN_GAMMA'; - C_GAMMA_CORRECT: Result := 'C_GAMMA_CORRECT'; - C_APPLY_DISP_GAMMA: Result := 'C_APPLY_DISP_GAMMA'; - C_APPLY_FBUF_GAMMA: Result := 'C_APPLY_FBUF_GAMMA'; - C_APPLY_FILE_GAMMA: Result := 'C_APPLY_FILE_GAMMA'; - C_FORCE_WIRE: Result := 'C_FORCE_WIRE'; - C_RAY_SHADOWS: Result := 'C_RAY_SHADOWS'; - C_MASTER_AMBIENT: Result := 'C_MASTER_AMBIENT'; - C_SUPER_SAMPLE: Result := 'C_SUPER_SAMPLE'; - C_OBJECT_MBLUR: Result := 'C_OBJECT_MBLUR'; - C_MBLUR_DITHER: Result := 'C_MBLUR_DITHER'; - C_DITHER_24: Result := 'C_DITHER_24'; - C_SUPER_BLACK: Result := 'C_SUPER_BLACK'; - C_SAFE_FRAME: Result := 'C_SAFE_FRAME'; - C_VIEW_PRES_RATIO: Result := 'C_VIEW_PRES_RATIO'; - C_BGND_PRES_RATIO: Result := 'C_BGND_PRES_RATIO'; - C_NTH_SERIAL_NUM: Result := 'C_NTH_SERIAL_NUM'; - - VPDATA: Result := 'VPDATA'; - - P_QUEUE_ENTRY: Result := 'P_QUEUE_ENTRY'; - P_QUEUE_IMAGE: Result := 'P_QUEUE_IMAGE'; - P_QUEUE_USEIGAMMA: Result := 'P_QUEUE_USEIGAMMA'; - P_QUEUE_PROC: Result := 'P_QUEUE_PROC'; - P_QUEUE_SOLID: Result := 'P_QUEUE_SOLID'; - P_QUEUE_GRADIENT: Result := 'P_QUEUE_GRADIENT'; - P_QUEUE_KF: Result := 'P_QUEUE_KF'; - P_QUEUE_MOTBLUR: Result := 'P_QUEUE_MOTBLUR'; - P_QUEUE_MB_REPEAT: Result := 'P_QUEUE_MB_REPEAT'; - P_QUEUE_NONE: Result := 'P_QUEUE_NONE'; - - P_QUEUE_RESIZE: Result := 'P_QUEUE_RESIZE'; - P_QUEUE_OFFSET: Result := 'P_QUEUE_OFFSET'; - P_QUEUE_ALIGN: Result := 'P_QUEUE_ALIGN'; - - P_CUSTOM_SIZE: Result := 'P_CUSTOM_SIZE'; - - P_ALPH_NONE: Result := 'P_ALPH_NONE'; - P_ALPH_PSEUDO: Result := 'P_ALPH_PSEUDO'; - P_ALPH_OP_PSEUDO: Result := 'P_ALPH_OP_PSEUDO'; - P_ALPH_BLUR: Result := 'P_ALPH_BLUR'; - P_ALPH_PCOL: Result := 'P_ALPH_PCOL'; - P_ALPH_C0: Result := 'P_ALPH_C0'; - P_ALPH_OP_KEY: Result := 'P_ALPH_OP_KEY'; - P_ALPH_KCOL: Result := 'P_ALPH_KCOL'; - P_ALPH_OP_NOCONV: Result := 'P_ALPH_OP_NOCONV'; - P_ALPH_IMAGE: Result := 'P_ALPH_IMAGE'; - P_ALPH_ALPHA: Result := 'P_ALPH_ALPHA'; - P_ALPH_QUES: Result := 'P_ALPH_QUES'; - P_ALPH_QUEIMG: Result := 'P_ALPH_QUEIMG'; - P_ALPH_CUTOFF: Result := 'P_ALPH_CUTOFF'; - P_ALPHANEG: Result := 'P_ALPHANEG'; - - P_TRAN_NONE: Result := 'P_TRAN_NONE'; - P_TRAN_IMAGE: Result := 'P_TRAN_IMAGE'; - P_TRAN_FRAMES: Result := 'P_TRAN_FRAMES'; - P_TRAN_FADEIN: Result := 'P_TRAN_FADEIN'; - P_TRAN_FADEOUT: Result := 'P_TRAN_FADEOUT'; - P_TRANNEG: Result := 'P_TRANNEG'; - - P_RANGES: Result := 'P_RANGES'; - - P_PROC_DATA: Result := 'P_PROC_DATA' - else - Result := 'UNKNOWN_CHUNK'; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -const - IndentString: string = #9#9#9#9#9#9#9#9#9#9#9#9; - -function Indent(Level: integer): string; -begin - Result := Copy(IndentString, 1, Level); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ChunkHeaderReport(var Strings: TStrings; Chunk: PChunk3DS; - IndentLevel: integer); - -var - OutString: string; - -begin - OutString := Format('%sChunk %s ($%x), Length is %d ($%3:x)', - [Indent(IndentLevel), ChunkTagToString(Chunk^.Tag), Chunk^.Tag, Chunk^.Size]); - Strings.Add(OutString); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure DumpKeyHeader(Strings: TStrings; const Key: TKeyHeader3DS; IndentLevel: integer); - -var - Output: string; - -begin - Output := Format('%sFrame %d', [Indent(IndentLevel), Key.Time]); - if (Key.rflags and KeyUsesTension3DS) <> 0 then - Output := Output + Format(', Tens %.2f', [Key.Tension]); - if (Key.rflags and KeyUsesCont3DS) <> 0 then - Output := Output + Format(', Cont %.2f', [Key.Continuity]); - if (Key.rflags and KeyUsesBias3DS) <> 0 then - Output := Output + Format(', Bias %.2f', [Key.Bias]); - if (Key.rflags and KeyUsesEaseTo3DS) <> 0 then - Output := Output + Format(', Ease to %.2f', [Key.EaseTo]); - if (Key.rflags and KeyUsesEaseFrom3DS) <> 0 then - Output := Output + Format(', Ease from %.2f', [Key.EaseFrom]); - Strings.Add(Output); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure DumpChunk(const Source: TFile3DS; var Strings: TStrings; - Chunk: PChunk3DS; IndentLevel: integer; DumpLevel: TDumpLevel); - -// retrieves the Data for a Chunk from the given Source, formats the Data into -// one or more lines of text and puts the lines into the given Strings parameter - -var - Child: PChunk3DS; - Output: string; - ID: string; - I: integer; - -begin - ChunkHeaderReport(Strings, Chunk, IndentLevel); - ID := Indent(IndentLevel) + #9; - - if DumpLevel <> dlTerseDump then - begin - case Chunk^.Tag of - MESH_VERSION: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sVersion %d', [ID, Chunk^.Data.MeshVersion^]); - Strings.Add(Output); - end; - M3D_VERSION: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sVersion %d', [ID, Chunk^.Data.M3DVersion^]); - Strings.Add(Output); - end; - COLOR_F: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sColor R: %f, ', [ID, Chunk^.Data.ColorF^.Red]); - Output := Output + Format(' G: %f, ', [Chunk^.Data.ColorF^.Green]); - Output := Output + Format(' B: %f', [Chunk^.Data.ColorF^.Blue]); - Strings.Add(Output); - end; - LIN_COLOR_F: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sColor R: %f, ', [ID, Chunk^.Data.LinColorF^.Red]); - Output := Output + Format(' G: %f, ', [Chunk^.Data.LinColorF^.Green]); - Output := Output + Format(' B: %f', [Chunk^.Data.LinColorF^.Blue]); - Strings.Add(Output); - end; - COLOR_24: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sColor R: %d, ', [ID, Chunk^.Data.Color24^.Red]); - Output := Output + Format(' G: %d, ', [Chunk^.Data.Color24^.Green]); - Output := Output + Format(' B: %d', [Chunk^.Data.Color24^.Blue]); - Strings.Add(Output); - end; - LIN_COLOR_24: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sColor R: %d, ', [ID, Chunk^.Data.LinColor24^.Red]); - Output := Output + Format(' G: %d, ', [Chunk^.Data.LinColor24^.Green]); - Output := Output + Format(' B: %d', [Chunk^.Data.LinColor24^.Blue]); - Strings.Add(Output); - end; - INT_PERCENTAGE: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sPercentage of %d%%', [ID, Chunk^.Data.IntPercentage^]); - Strings.Add(Output); - end; - FLOAT_PERCENTAGE: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sPercentage of %f%%', [ID, Chunk^.Data.FloatPercentage^]); - Strings.Add(Output); - end; - MASTER_SCALE: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMaster Scale %f', [ID, Chunk^.Data.MasterScale^]); - Strings.Add(Output); - end; - BIT_MAP: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sBitmap Name %s', [ID, Chunk^.Data.BitMapName^]); - Strings.Add(Output); - end; - V_GRADIENT: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMidpoint %f', [ID, Chunk^.Data.VGradient^]); - Strings.Add(Output); - end; - LO_SHADOW_BIAS: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sBias of %f', [ID, Chunk^.Data.LoShadowBias^]); - Strings.Add(Output); - end; - HI_SHADOW_BIAS: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sBias of %f', [ID, Chunk^.Data.HiShadowBias^]); - Strings.Add(Output); - end; - RAY_BIAS: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sBias of %f', [ID, Chunk^.Data.RayBias^]); - Strings.Add(Output); - end; - SHADOW_MAP_SIZE: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sSize of %d', [ID, Chunk^.Data.ShadowMapSize^]); - Strings.Add(Output); - end; - SHADOW_SAMPLES: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sSize of %d', [ID, Chunk^.Data.ShadowSamples^]); - Strings.Add(Output); - end; - SHADOW_RANGE: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sRange of %d', [ID, Chunk^.Data.ShadowRange^]); - Strings.Add(Output); - end; - SHADOW_FILTER: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sFilter of %f', [ID, Chunk^.Data.ShadowFilter^]); - Strings.Add(Output); - end; - O_CONSTS: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sPlane at %f, %f, %f', - [ID, Chunk^.Data.OConsts^.X, Chunk^.Data.OConsts^.Y, Chunk^.Data.OConsts^.Z]); - Strings.Add(Output); - end; - FOG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sNear plane at %f', [ID, Chunk^.Data.Fog^.NearPlaneDist]); - Strings.Add(Output); - Output := Format('%sNear Density of %f', - [ID, Chunk^.Data.Fog^.NearPlaneDensity]); - Strings.Add(Output); - Output := Format('%sFar plane at %f', [ID, Chunk^.Data.Fog^.FarPlaneDist]); - Strings.Add(Output); - Output := Format('%sFar Density of %f', - [ID, Chunk^.Data.Fog^.FarPlaneDensity]); - Strings.Add(Output); - end; - LAYER_FOG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sFog Z range is %f to %f', - [ID, Chunk^.Data.LayerFog^.ZMin, Chunk^.Data.LayerFog^.ZMax]); - Strings.Add(Output); - Output := Format('%sFog Density is %f', [ID, Chunk^.Data.LayerFog^.Density]); - Strings.Add(Output); - Output := Format('%sFog type of $%x', [ID, Chunk^.Data.LayerFog^.AType]); - Strings.Add(Output); - end; - DISTANCE_CUE: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sNear plane at %f', - [ID, Chunk^.Data.DistanceCue^.NearPlaneDist]); - Strings.Add(Output); - Output := Format('%sNear Density of %f', - [ID, Chunk^.Data.DistanceCue^.NearPlaneDimming]); - Strings.Add(Output); - Output := Format('%sFar plane at %f', - [ID, Chunk^.Data.DistanceCue^.FarPlaneDist]); - Strings.Add(Output); - Output := Format('%sFar Density of %f', - [ID, Chunk^.Data.DistanceCue^.FarPlaneDimming]); - Strings.Add(Output); - end; - VIEW_TOP, - VIEW_BOTTOM, - VIEW_LEFT, - VIEW_RIGHT, - VIEW_FRONT, - VIEW_BACK: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sTarget at %f, %f, %f', - [ID, Chunk^.Data.ViewStandard^.ViewTargetCoord.X, - Chunk^.Data.ViewStandard^.ViewTargetCoord.Y, - Chunk^.Data.ViewStandard^.ViewTargetCoord.Z]); - Strings.Add(Output); - Output := Format('%sView Width of %f', - [ID, Chunk^.Data.ViewStandard^.ViewWidth]); - Strings.Add(Output); - end; - VIEW_USER: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sTarget at %f, %f, %f', - [ID, Chunk^.Data.ViewUser^.ViewTargetCoord.X, - Chunk^.Data.ViewUser^.ViewTargetCoord.Y, - Chunk^.Data.ViewUser^.ViewTargetCoord.Z]); - Strings.Add(Output); - Output := Format('%sView Width of %f', [ID, Chunk^.Data.ViewUser^.ViewWidth]); - Strings.Add(Output); - Output := Format('%sHorizontal View angle of %f', - [ID, Chunk^.Data.ViewUser^.XYViewAngle]); - Strings.Add(Output); - Output := Format('%sVertical View angle of %f', - [ID, Chunk^.Data.ViewUser^.YZViewAngle]); - Strings.Add(Output); - Output := Format('%sBank angle of %f', [ID, Chunk^.Data.ViewUser^.BankAngle]); - Strings.Add(Output); - end; - VIEW_CAMERA: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sCamera Name %s', [ID, Chunk^.Data.ViewCamera^]); - Strings.Add(Output); - end; - NAMED_OBJECT: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sName: %s', [ID, Chunk^.Data.NamedObject^]); - Strings.Add(Output); - end; - POINT_ARRAY: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Vertices', [ID, Chunk^.Data.PointArray^.Vertices]); - Strings.Add(Output); - if DumpLevel = dlMaximumDump then - for I := 0 to Chunk^.Data.PointArray^.Vertices - 1 do - begin - Output := Format('%sVertex %d at %f, %f, %f', - [ID, I, Chunk^.Data.PointArray^.PointList^[I].X, - Chunk^.Data.PointArray^.PointList^[I].Y, - Chunk^.Data.PointArray^.PointList^[I].Z]); - Strings.Add(Output); - end; - end; - POINT_FLAG_ARRAY: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sFlags: %d', [ID, Chunk^.Data.PointFlagArray^.Flags]); - Strings.Add(Output); - if DumpLevel = dlMaximumDump then - for I := 0 to Chunk^.Data.PointFlagArray^.Flags - 1 do - begin - Output := Format('%sFlag %d is %d', - [ID, I, Chunk^.Data.PointFlagArray^.FlagList^[I]]); - Strings.Add(Output); - end; - end; - FACE_ARRAY: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Faces', [ID, Chunk^.Data.FaceArray^.Faces]); - Strings.Add(Output); - if DumpLevel = dlMaximumDump then - for I := 0 to Chunk^.Data.FaceArray^.Faces - 1 do - begin - Output := Format('%sFace %d Vertices %d, %d, %d and flag $%x', - [ID, I, Chunk^.Data.FaceArray^.FaceList^[I].V1, - Chunk^.Data.FaceArray^.FaceList^[I].V2, - Chunk^.Data.FaceArray^.FaceList^[I].V3, - Chunk^.Data.FaceArray^.FaceList^[I].Flag]); - Strings.Add(Output); - end; - end; - MSH_MAT_GROUP: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMaterial Name of %s', - [ID, Chunk^.Data.MshMatGroup^.MatNameStr]); - Strings.Add(Output); - Output := Format('%sAssigned to %d Faces', - [ID, Chunk^.Data.MshMatGroup^.Faces]); - Strings.Add(Output); - end; - MSH_BOXMAP: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sBoxmap consists of the following materials:', [ID]); - Strings.Add(Output); - for I := 0 to 5 do - begin - Output := Format('%s%s', [ID, Chunk^.Data.MshBoxmap^[I]]); - Strings.Add(Output); - end; - end; - TEX_VERTS: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Vertices', [ID, Chunk^.Data.TexVerts^.NumCoords]); - Strings.Add(Output); - if DumpLevel = dlMaximumDump then - begin - for I := 0 to Chunk^.Data.TexVerts^.NumCoords - 1 do - begin - Output := Format('%sVertex %d with tex vert of %f, %f', - [ID, I, Chunk^.Data.TexVerts^.TextVertList^[I].U, - Chunk^.Data.TexVerts^.TextVertList^[I].V]); - Strings.Add(Output); - end; - end; - end; - MESH_TEXTURE_INFO: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMap Type of %d', - [ID, Chunk^.Data.MeshTextureInfo^.MapType]); - Strings.Add(Output); - Output := Format('%sX Tiling of %f', - [ID, Chunk^.Data.MeshTextureInfo^.XTiling]); - Strings.Add(Output); - Output := Format('%sY Tiling of %f', - [ID, Chunk^.Data.MeshTextureInfo^.YTiling]); - Strings.Add(Output); - Output := Format('%sIcon position of %f, %f, %f', - [ID, Chunk^.Data.MeshTextureInfo^.IconPos.X, - Chunk^.Data.MeshTextureInfo^.IconPos.Y, - Chunk^.Data.MeshTextureInfo^.IconPos.Z]); - Strings.Add(Output); - I := 0; - while I < 12 do - begin - Output := Format('%s[%d] %f [%d] %f [%d] %f', - [ID, I, Chunk^.Data.MeshTextureInfo^.XMatrix[I], I + - 1, Chunk^.Data.MeshTextureInfo^.XMatrix[I + 1], I + - 2, Chunk^.Data.MeshTextureInfo^.XMatrix[I + 2]]); - Strings.Add(Output); - Inc(I, 3); - end; - Output := Format('%sScaling Value of %f', - [ID, Chunk^.Data.MeshTextureInfo^.IconScaling]); - Strings.Add(Output); - Output := Format('%sPlanar Icon Width of %f', - [ID, Chunk^.Data.MeshTextureInfo^.IconWidth]); - Strings.Add(Output); - Output := Format('%sPlanar Icon Height of %f', - [ID, Chunk^.Data.MeshTextureInfo^.IconHeight]); - Strings.Add(Output); - Output := Format('%sCylinder Icon Height of %f', - [ID, Chunk^.Data.MeshTextureInfo^.CylIconHeight]); - Strings.Add(Output); - end; - MESH_MATRIX: - begin - Source.ReadChunkData(Chunk); - I := 0; - while I < 12 do - begin - Output := Format('%s[%d] %f [%d] %f [%d] %f', - [ID, I, Chunk^.Data.MeshMatrix^[I], I + 1, - Chunk^.Data.MeshMatrix^[I + 1], I + 2, Chunk^.Data.MeshMatrix^[I + 2]]); - Strings.Add(Output); - Inc(I, 3); - end; - end; - PROC_NAME: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sProcedure Name of %s', [ID, Chunk^.Data.ProcName^]); - Strings.Add(Output); - end; - MESH_COLOR: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sColor index of %d', [ID, Chunk^.Data.MeshColor^]); - Strings.Add(Output); - end; - N_DIRECT_LIGHT: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sLight at %f, %f, %f', - [ID, Chunk^.Data.NDirectLight^.X, Chunk^.Data.NDirectLight^.Y, - Chunk^.Data.NDirectLight^.Z]); - Strings.Add(Output); - end; - DL_EXCLUDE: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sExclude %s', [ID, Chunk^.Data.DLExclude^]); - Strings.Add(Output); - end; - DL_OUTER_RANGE, - DL_INNER_RANGE: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sRange of %f', [ID, Chunk^.Data.DlOuterRange^]); - Strings.Add(Output); - end; - DL_MULTIPLIER: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMultiple of %f', [ID, Chunk^.Data.DlMultiplier^]); - Strings.Add(Output); - end; - DL_SPOT_ROLL: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sRoll angle of %f', [ID, Chunk^.Data.DlSpotRoll^]); - Strings.Add(Output); - end; - DL_SPOT_ASPECT: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sSpot aspect of %f', [ID, Chunk^.Data.DlSpotAspect^]); - Strings.Add(Output); - end; - DL_SPOT_PROJECTOR: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sFilename of projector is %s', - [ID, Chunk^.Data.DlSpotProjector^]); - Strings.Add(Output); - end; - DL_RAY_BIAS: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sBias of %f', [ID, Chunk^.Data.DlRayBias^]); - Strings.Add(Output); - end; - DL_SPOTLIGHT: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sTarget at %f, %f, %f', - [ID, Chunk^.Data.DlSpotlight^.SpotlightTarg.X, - Chunk^.Data.DlSpotlight^.SpotlightTarg.Y, - Chunk^.Data.DlSpotlight^.SpotlightTarg.Z]); - Strings.Add(Output); - Output := Format('%sHotspot cone of %f, ', - [ID, Chunk^.Data.DlSpotlight^.HotspotAngle]); - Output := Output + Format(' Falloff cone of %f', - [Chunk^.Data.DlSpotlight^.FalloffAngle]); - Strings.Add(Output); - end; - DL_LOCAL_SHADOW2: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sShadow bias of %f', - [ID, Chunk^.Data.DlLocalShadow2^.LocalShadowBias]); - Strings.Add(Output); - Output := Format('%sShadow filter of %f', - [ID, Chunk^.Data.DlLocalShadow2^.LocalShadowFilter]); - Strings.Add(Output); - Output := Format('%sShadow Map Size of %f', - [ID, Chunk^.Data.DlLocalShadow2^.LocalShadowMapSize]); - Strings.Add(Output); - end; - N_CAMERA: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sCamera at %f, %f, %f', - [ID, Chunk^.Data.NCamera^.CameraPos.X, Chunk^.Data.NCamera^.CameraPos.Y, - Chunk^.Data.NCamera^.CameraPos.Z]); - Strings.Add(Output); - Output := Format('%sTarget at %f, %f, %f', - [ID, Chunk^.Data.NCamera^.TargetPos.X, Chunk^.Data.NCamera^.TargetPos.Y, - Chunk^.Data.NCamera^.TargetPos.Z]); - Strings.Add(Output); - Output := Format('%sBank angle of %f', [ID, Chunk^.Data.NCamera^.CameraBank]); - Output := Output + Format(' and a foc of %f', - [Chunk^.Data.NCamera^.CameraFocalLength]); - Strings.Add(Output); - end; - CAM_RANGES: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sCamera near range is %f and far range is %f', - [ID, Chunk^.Data.CamRanges^.NearPlane, Chunk^.Data.CamRanges^.FarPlane]); - Strings.Add(Output); - end; - VIEWPORT_LAYOUT: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sForm of %d', [ID, Chunk^.Data.ViewportLayout^.Form]); - Strings.Add(Output); - Output := Format('%sTop of %d', [ID, Chunk^.Data.ViewportLayout^.Top]); - Strings.Add(Output); - Output := Format('%sReady of %d', [ID, Chunk^.Data.ViewportLayout^.Ready]); - Strings.Add(Output); - Output := Format('%sWState of %d', [ID, Chunk^.Data.ViewportLayout^.WState]); - Strings.Add(Output); - Output := Format('%sSwap WS of %d', [ID, Chunk^.Data.ViewportLayout^.SwapWS]); - Strings.Add(Output); - Output := Format('%sSwap Port of %d', - [ID, Chunk^.Data.ViewportLayout^.SwapPort]); - Strings.Add(Output); - Output := Format('%sSwap Cur of %d', - [ID, Chunk^.Data.ViewportLayout^.SwapCur]); - Strings.Add(Output); - end; - VIEWPORT_SIZE: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sWork Area X: %d Y: %d W: %d H: %d', - [ID, Chunk^.Data.ViewportSize^.XPos, Chunk^.Data.ViewportSize^.YPos, - Chunk^.Data.ViewportSize^.Width, - Chunk^.Data.ViewportSize^.Height]); - Strings.Add(Output); - end; - VIEWPORT_DATA_3, - VIEWPORT_DATA: - begin - Source.ReadChunkData(Chunk); - with Chunk^.Data.ViewportData^ do - begin - Output := Format('%sFlags: $%x', [ID, Flags]); - Strings.Add(Output); - Output := Format('%sAxis Lockouts of $%x', [ID, AxisLockout]); - Strings.Add(Output); - Output := Format('%sWindow Position of %d, %d', [ID, WinXPos, WinYPos]); - Strings.Add(Output); - Output := Format('%sWindow Size of %d, %d', [ID, WinWidth, WinHeight]); - Strings.Add(Output); - Output := Format('%sWindow View of %d', [ID, View]); - Strings.Add(Output); - Output := Format('%sZoom Factor of %f', [ID, ZoomFactor]); - Strings.Add(Output); - Output := Format('%sWorld Center of %f, %f, %f', - [ID, Center.X, Center.Y, Center.Z]); - Strings.Add(Output); - Output := Format('%sHorizontal Angle of %f', [ID, HorizAng]); - Strings.Add(Output); - Output := Format('%sVertical Angle of %f', [ID, VertAng]); - Strings.Add(Output); - Output := Format('%sCamera Name of %s', [ID, CamNameStr]); - Strings.Add(Output); - end; - end; - XDATA_APPNAME: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sApplication Name %s', [ID, Chunk^.Data.XDataAppName^]); - Strings.Add(Output); - end; - XDATA_STRING: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sString value of %s', [ID, Chunk^.Data.XDataString^]); - Strings.Add(Output); - end; - MAT_NAME: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMaterial Name %s', [ID, Chunk^.Data.MatName^]); - Strings.Add(Output); - end; - MAT_SHADING: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sShading value of %d', [ID, Chunk^.Data.MatShading^]); - Strings.Add(Output); - end; - MAT_ACUBIC: - begin - Source.ReadChunkData(Chunk); - with Chunk^.Data.MatAcubic^ do - begin - Output := Format('%sShade level of %d', [ID, ShadeLevel]); - Strings.Add(Output); - Output := Format('%sAntialias level of %d', [ID, AntiAlias]); - Strings.Add(Output); - Output := Format('%sFlags: %d', [ID, Flags]); - Strings.Add(Output); - Output := Format('%sMap Size of %d', [ID, MapSize]); - Strings.Add(Output); - Output := Format('%sFrame skip of %d', [ID, FrameInterval]); - Strings.Add(Output); - end; - end; - MAT_MAPNAME: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMap Name %s', [ID, Chunk^.Data.MatMapname^]); - Strings.Add(Output); - end; - MAT_WIRESIZE: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sWire frame Size of %f', [ID, Chunk^.Data.MatWireSize^]); - Strings.Add(Output); - end; - MAT_MAP_TILING: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMap Flags: ', [ID]); - if (Chunk^.Data.MatMapTiling^ = 0) then - Output := Output + ' NONE' - else - begin - if (Chunk^.Data.MatMapTiling^ and TEX_DECAL) <> 0 then - Output := Output + ' TEX_DECAL, '; - if (Chunk^.Data.MatMapTiling^ and TEX_MIRROR) <> 0 then - Output := Output + ' TEX_MIRROR, '; - if (Chunk^.Data.MatMapTiling^ and TEX_UNUSED1) <> 0 then - Output := Output + ' TEX_UNUSED1, '; - if (Chunk^.Data.MatMapTiling^ and TEX_INVERT) <> 0 then - Output := Output + ' TEX_INVERT, '; - if (Chunk^.Data.MatMapTiling^ and TEX_NOWRAP) <> 0 then - Output := Output + ' TEX_NOWRAP, '; - if (Chunk^.Data.MatMapTiling^ and TEX_SAT) <> 0 then - Output := Output + ' TEX_SAT, '; - if (Chunk^.Data.MatMapTiling^ and TEX_ALPHA_SOURCE) <> 0 then - Output := Output + ' TEX_ALPHA_SOURCE, '; - if (Chunk^.Data.MatMapTiling^ and TEX_TINT) <> 0 then - Output := Output + ' TEX_TINT, '; - if (Chunk^.Data.MatMapTiling^ and TEX_DONT_USE_ALPHA) <> 0 then - Output := Output + ' TEX_DONT_USE_ALPHA, '; - if (Chunk^.Data.MatMapTiling^ and TEX_RGB_TINT) <> 0 then - Output := Output + ' TEX_RGB_TINT, '; - Delete(Output, Length(Output) - 1, 2); // take the last comma out - end; - Strings.Add(Output); - end; - MAT_MAP_COL1: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sColor R: %d, ', [ID, Chunk^.Data.MatMapCol1^.Red]); - Output := Output + Format(' G: %d, ', [Chunk^.Data.MatMapCol1^.Green]); - Output := Output + Format(' B: %d', [Chunk^.Data.MatMapCol1^.Blue]); - Strings.Add(Output); - end; - MAT_MAP_COL2: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sColor R: %d, ', [ID, Chunk^.Data.MatMapCol2^.Red]); - Output := Output + Format(' G: %d, ', [Chunk^.Data.MatMapCol2^.Green]); - Output := Output + Format(' B: %d', [Chunk^.Data.MatMapCol2^.Blue]); - Strings.Add(Output); - end; - MAT_MAP_RCOL: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sColor R: %d, ', [ID, Chunk^.Data.MatMapRCol^.Red]); - Output := Output + Format(' G: %d, ', [Chunk^.Data.MatMapRCol^.Green]); - Output := Output + Format(' B: %d', [Chunk^.Data.MatMapRCol^.Blue]); - Strings.Add(Output); - end; - MAT_MAP_GCOL: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sColor R: %d, ', [ID, Chunk^.Data.MatMapGCol^.Red]); - Output := Output + Format(' G: %d, ', [Chunk^.Data.MatMapGCol^.Green]); - Output := Output + Format(' B: %d', [Chunk^.Data.MatMapGCol^.Blue]); - Strings.Add(Output); - end; - MAT_MAP_BCOL: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sColor R: %d, ', [ID, Chunk^.Data.MatMapBCol^.Red]); - Output := Output + Format(' G: %d, ', [Chunk^.Data.MatMapBCol^.Green]); - Output := Output + Format(' B: %d', [Chunk^.Data.MatMapBCol^.Blue]); - Strings.Add(Output); - end; - MAT_MAP_TEXBLUR: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMap bluring of %f', [ID, Chunk^.Data.MatMapTexblur^]); - Strings.Add(Output); - end; - MAT_MAP_USCALE: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMap U scale of %f', [ID, Chunk^.Data.MatMapUScale^]); - Strings.Add(Output); - end; - MAT_MAP_VSCALE: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMap V scale of %f', [ID, Chunk^.Data.MatMapVScale^]); - Strings.Add(Output); - end; - MAT_MAP_UOFFSET: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMap U offset of %f', [ID, Chunk^.Data.MatMapUOffset^]); - Strings.Add(Output); - end; - MAT_MAP_VOFFSET: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMap V offset of %f', [ID, Chunk^.Data.MatMapVOffset^]); - Strings.Add(Output); - end; - MAT_MAP_ANG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMap rotation angle of %f', [ID, Chunk^.Data.MatMapAng^]); - Strings.Add(Output); - end; - MAT_BUMP_PERCENT: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sPercentage of %d%%', [ID, Chunk^.Data.MatBumpPercent^]); - Strings.Add(Output); - end; - KFHDR: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sRevision level of $%x', [ID, Chunk^.Data.KFHdr^.Revision]); - Strings.Add(Output); - Output := Format('%sFilename %s', [ID, Chunk^.Data.KFHdr^.FileName]); - Strings.Add(Output); - Output := Format('%sAnimation length of %d', - [ID, Chunk^.Data.KFHdr^.AnimLength]); - Strings.Add(Output); - end; - KFSEG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sSegment starts at %d and ends at %d', - [ID, Chunk^.Data.KFSeg^.First, Chunk^.Data.KFSeg^.Last]); - Strings.Add(Output); - end; - KFCURTIME: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sCurrent frame is %d', [ID, Chunk^.Data.KFCurtime^]); - Strings.Add(Output); - end; - NODE_ID: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sNode ID: %d', [ID, Chunk^.Data.KFID^]); - Strings.Add(Output); - end; - NODE_HDR: - begin - Source.ReadChunkData(Chunk); - Strings.Add(Format('%sObject Name: %s', - [ID, Chunk^.Data.NodeHdr^.ObjNameStr])); - //--- Flags 1 - Strings.Add(Format('%sFlags 1: $%x', [ID, Chunk^.Data.NodeHdr^.Flags1])); - if DumpLevel = dlMaximumDump then - with Chunk^.Data.NodeHdr^ do - begin - if (Flags1 and NODE_RENDOB_HIDE) <> 0 then - Strings.Add(Format('%sNODE_RENDOB_HIDE', [ID])); - if (Flags1 and NODE_OFF) <> 0 then - Strings.Add(Format('%sNODE_OFF', [ID])); - if (Flags1 and ATKEY1) <> 0 then - Strings.Add(Format('%sATKEY1', [ID])); - if (Flags1 and ATKEY2) <> 0 then - Strings.Add(Format('%sATKEY2', [ID])); - if (Flags1 and ATKEY3) <> 0 then - Strings.Add(Format('%sATKEY3', [ID])); - if (Flags1 and ATKEY4) <> 0 then - Strings.Add(Format('%sATKEY4', [ID])); - if (Flags1 and ATKEY5) <> 0 then - Strings.Add(Format('%sATKEY5', [ID])); - if (Flags1 and ATKEYFLAGS) <> 0 then - Strings.Add(Format('%sATKEYFLAGS', [ID])); - if (Flags1 and MARK_NODE) <> 0 then - Strings.Add(Format('%sMARK_NODE', [ID])); - if (Flags1 and DISABLE_NODE) <> 0 then - Strings.Add(Format('%sDISABLE_NODE', [ID])); - if (Flags1 and HIDE_NODE) <> 0 then - Strings.Add(Format('%sHIDE_NODE', [ID])); - if (Flags1 and FAST_NODE) <> 0 then - Strings.Add(Format('%sFAST_NODE', [ID])); - if (Flags1 and PRIMARY_NODE) <> 0 then - Strings.Add(Format('%sPRIMARY_NODE', [ID])); - if (Flags1 and NODE_CALC_PATH) <> 0 then - Strings.Add(Format('%sNODE_CALC_PATH', [ID])); - end; - - //--- Flags 2 - Strings.Add(Format('%sFlags 2: $%x', [ID, Chunk^.Data.NodeHdr^.Flags2])); - if DumpLevel = dlMaximumDump then - with Chunk^.Data.NodeHdr^ do - begin - if (Flags2 and NODE_HAS_PATH) <> 0 then - Strings.Add(Format('%sNODE_HAS_PATH', [ID])); - if (Flags2 and NODE_AUTO_SMOOTH) <> 0 then - Strings.Add(Format('%sNODE_AUTO_SMOOTH', [ID])); - if (Flags2 and NODE_FROZEN) <> 0 then - Strings.Add(Format('%sNODE_FROZEN', [ID])); - if (Flags2 and NODE_ANI_HIDDEN) <> 0 then - Strings.Add(Format('%sNODE_ANI_HIDDEN', [ID])); - if (Flags2 and NODE_MOTION_BLUR) <> 0 then - Strings.Add(Format('%sNODE_MOTION_BLUR', [ID])); - if (Flags2 and NODE_BLUR_BRANCH) <> 0 then - Strings.Add(Format('%sNODE_BLUR_BRANCH', [ID])); - if (Flags2 and NODE_MORPH_MTL) <> 0 then - Strings.Add(Format('%sNODE_MORPH_MTL', [ID])); - if (Flags2 and NODE_MORPH_OB) <> 0 then - Strings.Add(Format('%sNODE_MORPH_OB', [ID])); - end; - - if Chunk^.Data.NodeHdr^.ParentIndex = -1 then - Strings.Add(Format('%sNo Parent', [ID])) - else - Strings.Add(Format('%sParent %d', [ID, Chunk^.Data.NodeHdr^.ParentIndex])); - end; - INSTANCE_NAME: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sInstance Name: %s', [ID, Chunk^.Data.InstanceName^]); - Strings.Add(Output); - end; - PARENT_NAME: - begin - Source.ReadChunkData(Chunk); - if Chunk^.Data.InstanceName = nil then - Strings.Add(Format('%sNo Parent', [ID])) - else - Strings.Add(Format('%sParent Name: %s', [ID, Chunk^.Data.InstanceName^])); - end; - PIVOT: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sPivot at %f, %f, %f', - [ID, Chunk^.Data.Pivot^.X, Chunk^.Data.Pivot^.Y, - Chunk^.Data.Pivot^.Z]); - Strings.Add(Output); - end; - BOUNDBOX: - if Assigned(Chunk^.Data.Dummy) then - begin - Output := Format('%sMinimum at %f, %f, %f', - [ID, Chunk^.Data.BoundBox^.Min.X, Chunk^.Data.BoundBox^.Min.Y, - Chunk^.Data.BoundBox^.Min.Z]); - Strings.Add(Output); - Output := Format('%sMaximum at %f, %f, %f', - [ID, Chunk^.Data.BoundBox^.Max.X, Chunk^.Data.BoundBox^.Max.Y, - Chunk^.Data.BoundBox^.Max.Z]); - Strings.Add(Output); - end; - MORPH_SMOOTH: - begin - Source.ReadChunkData(Chunk); - Output := Format('%sMorph Smoothing Angle of %f', - [ID, Chunk^.Data.MorphSmooth^]); - Strings.Add(Output); - end; - POS_TRACK_TAG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Keys, Flags: $%x', - [ID, Chunk^.Data.PosTrackTag^.TrackHdr.KeyCount, - Chunk^.Data.PosTrackTag^.TrackHdr.Flags]); - Strings.Add(Output); - for I := 0 to Chunk^.Data.PosTrackTag^.TrackHdr.KeyCount - 1 do - begin - DumpKeyHeader(Strings, Chunk^.Data.PosTrackTag^.KeyHdrList^[I], - IndentLevel + 1); - Output := Format('%sObject at %f, %f, %f', - [ID, Chunk^.Data.PosTrackTag^.PositionList^[I].X, - Chunk^.Data.PosTrackTag^.PositionList^[I].Y, - Chunk^.Data.PosTrackTag^.PositionList^[I].Z]); - Strings.Add(Output); - end; - end; - ROT_TRACK_TAG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Keys, Flags: $%x', - [ID, Chunk^.Data.RotTrackTag^.TrackHdr.KeyCount, - Chunk^.Data.RotTrackTag^.TrackHdr.Flags]); - Strings.Add(Output); - for I := 0 to Chunk^.Data.RotTrackTag^.TrackHdr.KeyCount - 1 do - begin - DumpKeyHeader(Strings, Chunk^.Data.RotTrackTag^.KeyHdrList^[I], - IndentLevel + 1); - Output := Format('%sRotation of %f', - [ID, Chunk^.Data.RotTrackTag^.RotationList^[I].Angle]); - Strings.Add(Output); - Output := Format('%sAxis of %f, %f, %f', - [ID, Chunk^.Data.RotTrackTag^.RotationList^[I].X, - Chunk^.Data.RotTrackTag^.RotationList^[I].Y, - Chunk^.Data.RotTrackTag^.RotationList^[I].Z]); - Strings.Add(Output); - end; - end; - SCL_TRACK_TAG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Keys, Flags: $%x', - [ID, Chunk^.Data.ScaleTrackTag^.TrackHdr.KeyCount, - Chunk^.Data.ScaleTrackTag^.TrackHdr.Flags]); - Strings.Add(Output); - for I := 0 to Chunk^.Data.ScaleTrackTag^.TrackHdr.KeyCount - 1 do - begin - DumpKeyHeader(Strings, Chunk^.Data.ScaleTrackTag^.KeyHdrList^[I], - IndentLevel + 1); - Output := Format('%sScale of %f, %f, %f', - [ID, Chunk^.Data.ScaleTrackTag^.ScaleList^[I].X, - Chunk^.Data.ScaleTrackTag^.ScaleList^[I].Y, - Chunk^.Data.ScaleTrackTag^.ScaleList^[I].Z]); - Strings.Add(Output); - end; - end; - FOV_TRACK_TAG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Keys, Flags: $%x', - [ID, Chunk^.Data.FovTrackTag^.TrackHdr.KeyCount, - Chunk^.Data.FovTrackTag^.TrackHdr.Flags]); - Strings.Add(Output); - for I := 0 to Chunk^.Data.FovTrackTag^.TrackHdr.KeyCount - 1 do - begin - DumpKeyHeader(Strings, Chunk^.Data.FovTrackTag^.KeyHdrList^[I], - IndentLevel + 1); - Output := Format('%sCamera FOV of %f', - [ID, Chunk^.Data.FovTrackTag^.FOVAngleList^[I]]); - Strings.Add(Output); - end; - end; - ROLL_TRACK_TAG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Keys, Flags: $%x', - [ID, Chunk^.Data.RollTrackTag^.TrackHdr.KeyCount, - Chunk^.Data.RollTrackTag^.TrackHdr.Flags]); - Strings.Add(Output); - for I := 0 to Chunk^.Data.RollTrackTag^.TrackHdr.KeyCount - 1 do - begin - DumpKeyHeader(Strings, Chunk^.Data.RollTrackTag^.KeyHdrList^[I], - IndentLevel + 1); - Output := Format('%sCamera Roll of %f', - [ID, Chunk^.Data.RollTrackTag^.RollAngleList^[I]]); - Strings.Add(Output); - end; - end; - COL_TRACK_TAG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Keys, Flags: $%x', - [ID, Chunk^.Data.ColTrackTag^.TrackHdr.KeyCount, - Chunk^.Data.ColTrackTag^.TrackHdr.Flags]); - Strings.Add(Output); - for I := 0 to Chunk^.Data.ColTrackTag^.TrackHdr.KeyCount - 1 do - begin - DumpKeyHeader(Strings, Chunk^.Data.ColTrackTag^.KeyHdrList^[I], - IndentLevel + 1); - Output := Format('%sColor R: %f, ', - [ID, Chunk^.Data.ColTrackTag^.ColorList^[I].B]); - Output := Output + Format(' G: %f, ', - [Chunk^.Data.ColTrackTag^.ColorList^[I].G]); - Output := Output + Format(' B: %f', - [Chunk^.Data.ColTrackTag^.ColorList^[I].B]); - Strings.Add(Output); - end; - end; - MORPH_TRACK_TAG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Keys, Flags: $%x', - [ID, Chunk^.Data.MorphTrackTag^.TrackHdr.KeyCount, - Chunk^.Data.MorphTrackTag^.TrackHdr.Flags]); - Strings.Add(Output); - for I := 0 to Chunk^.Data.MorphTrackTag^.TrackHdr.KeyCount - 1 do - begin - DumpKeyHeader(Strings, Chunk^.Data.MorphTrackTag^.KeyHdrList^[I], - IndentLevel + 1); - Output := Format('%sMorph to %s', - [ID, Chunk^.Data.MorphTrackTag^.MorphList^[I]]); - Strings.Add(Output); - end; - end; - HOT_TRACK_TAG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Keys, Flags: $%x', - [ID, Chunk^.Data.HotTrackTag^.TrackHdr.KeyCount, - Chunk^.Data.HotTrackTag^.TrackHdr.Flags]); - Strings.Add(Output); - for I := 0 to Chunk^.Data.HotTrackTag^.TrackHdr.KeyCount - 1 do - begin - DumpKeyHeader(Strings, Chunk^.Data.HotTrackTag^.KeyHdrList^[I], - IndentLevel + 1); - Output := Format('%sHotspot angle of %f', - [ID, Chunk^.Data.HotTrackTag^.HotspotAngleList^[I]]); - Strings.Add(Output); - end; - end; - FALL_TRACK_TAG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Keys, Flags: $%x', - [ID, Chunk^.Data.FallTrackTag^.TrackHdr.KeyCount, - Chunk^.Data.FallTrackTag^.TrackHdr.Flags]); - Strings.Add(Output); - for I := 0 to Chunk^.Data.FallTrackTag^.TrackHdr.KeyCount - 1 do - begin - DumpKeyHeader(Strings, Chunk^.Data.FallTrackTag^.KeyHdrList^[I], - IndentLevel + 1); - Output := Format('%sFalloff Angle of %f', - [ID, Chunk^.Data.FallTrackTag^.FalloffAngleList^[I]]); - Strings.Add(Output); - end; - end; - HIDE_TRACK_TAG: - begin - Source.ReadChunkData(Chunk); - Output := Format('%s%d Keys, Flags: $%x', - [ID, Chunk^.Data.HideTrackTag^.TrackHdr.KeyCount, - Chunk^.Data.HideTrackTag^.TrackHdr.Flags]); - Strings.Add(Output); - for I := 0 to Chunk^.Data.HideTrackTag^.TrackHdr.KeyCount - 1 do - DumpKeyHeader(Strings, Chunk^.Data.HideTrackTag^.KeyHdrList^[I], - IndentLevel + 1); - end; - end; // end case - end; - - Child := Chunk^.Children; - - while Assigned(Child) do - begin - DumpChunk(Source, Strings, Child, IndentLevel + 1, DumpLevel); - Child := Child^.Sibling; - end; -end; - -//----------------- common support function --------------------------------------------------------------------------- - -procedure AddChild(Parent, Child: PChunk3DS); - -// AddChild puts the chunk at the end of the Sibling list - -var - Current: PChunk3DS; - -begin - if Parent^.Children = nil then - Parent^.Children := Child - else - begin - Current := Parent^.Children; - while Assigned(Current^.Sibling) do - Current := Current^.Sibling; - Current^.Sibling := Child; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure AddChildOrdered(Parent, Child: PChunk3DS); - -// AddChildOrdered will insert the child among its siblings depending -// on the order of occurance set by the 3DS file. - -var - Current, Prev: PChunk3DS; - ChildValue: integer; - -begin - ChildValue := GetChunkValue(Child^.Tag); - - if Parent^.Children = nil then - Parent^.Children := Child - else - begin - Current := Parent^.Children; - Prev := nil; - while Assigned(Current^.Sibling) do - begin - if ChildValue > GetChunkValue(Current^.Tag) then - break; - Prev := Current; - Current := Current^.Sibling; - end; - - if ChildValue > GetChunkValue(Current^.Tag) then - begin - Child^.Sibling := Current; - if Assigned(Prev) then - Prev^.Sibling := Child - else - Parent^.Children := Child; - end - else - begin - Child^.Sibling := Current^.Sibling; - Current^.Sibling := Child; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function FindChunk(Top: PChunk3DS; Tag: word): PChunk3DS; - - // searchs the given top Chunk and its children for a match - -var - Child, Match: PChunk3DS; - -begin - Result := nil; - if Assigned(Top) then - if Top^.Tag = Tag then - Result := Top - else - begin - Child := Top^.Children; - while Assigned(Child) do - begin - Match := FindChunk(Child, Tag); - if Assigned(Match) then - begin - Result := Match; - Break; - end; - Child := Child^.Sibling; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function FindNextChunk(Local: PChunk3DS; Tag: word): PChunk3DS; - -var - Current: PChunk3DS; - -begin - Result := nil; - Current := Local; - while Assigned(Current) and (Result = nil) do - begin - if Current^.Tag = Tag then - Result := Current; - Current := Current^.Sibling; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure FreeChunkData(var Chunk: PChunk3DS); - -begin - if Assigned(Chunk^.Data.Dummy) then - begin - // do only care about Chunk^.Data fields that contain other pointers - // that need to be free - case Chunk^.Tag of - MAT_SXP_TEXT_DATA, - MAT_SXP_TEXT2_DATA, - MAT_SXP_OPAC_DATA, - MAT_SXP_BUMP_DATA, - MAT_SXP_SPEC_DATA, - MAT_SXP_SHIN_DATA, - MAT_SXP_SELFI_DATA, - MAT_SXP_TEXT_MASKDATA, - MAT_SXP_TEXT2_MASKDATA, - MAT_SXP_OPAC_MASKDATA, - MAT_SXP_BUMP_MASKDATA, - MAT_SXP_SPEC_MASKDATA, - MAT_SXP_SHIN_MASKDATA, - MAT_SXP_SELFI_MASKDATA, - MAT_SXP_REFL_MASKDATA, - PROC_DATA: - FreeMem(Chunk^.Data.IpasData^.Data); - POINT_ARRAY: - FreeMem(Chunk^.Data.PointArray^.PointList); - POINT_FLAG_ARRAY: - FreeMem(Chunk^.Data.PointFlagArray^.FlagList); - FACE_ARRAY: - Freemem(Chunk^.Data.FaceArray^.FaceList); - MSH_MAT_GROUP: - begin - Dispose(Chunk^.Data.MshMatGroup); - Chunk^.Data.MshMatGroup := nil; - end; - SMOOTH_GROUP: - FreeMem(Chunk^.Data.SmoothGroup^.GroupList); - TEX_VERTS: - FreeMem(Chunk^.Data.TexVerts^.TextVertList); - XDATA_ENTRY: - FreeMem(Chunk^.Data.XDataEntry^.Data); - POS_TRACK_TAG: - begin - FreeMem(Chunk^.Data.PosTrackTag^.KeyHdrList); - Freemem(Chunk^.Data.PosTrackTag^.PositionList); - end; - COL_TRACK_TAG: - begin - FreeMem(Chunk^.Data.ColTrackTag^.KeyHdrList); - FreeMem(Chunk^.Data.ColTrackTag^.ColorList); - end; - ROT_TRACK_TAG: - begin - FreeMem(Chunk^.Data.RotTrackTag^.KeyHdrList); - FreeMem(Chunk^.Data.RotTrackTag^.RotationList); - end; - SCL_TRACK_TAG: - begin - FreeMem(Chunk^.Data.ScaleTrackTag^.KeyHdrList); - FreeMem(Chunk^.Data.ScaleTrackTag^.ScaleList); - end; - MORPH_TRACK_TAG: - begin - FreeMem(Chunk^.Data.MorphTrackTag^.KeyHdrList); - FreeMem(Chunk^.Data.MorphTrackTag^.MorphList); - end; - FOV_TRACK_TAG: - begin - FreeMem(Chunk^.Data.FovTrackTag^.KeyHdrList); - FreeMem(Chunk^.Data.FovTrackTag^.FOVAngleList); - end; - ROLL_TRACK_TAG: - begin - FreeMem(Chunk^.Data.RollTrackTag^.KeyHdrList); - FreeMem(Chunk^.Data.RollTrackTag^.RollAngleList); - end; - HOT_TRACK_TAG: - begin - FreeMem(Chunk^.Data.HotTrackTag^.KeyHdrList); - FreeMem(Chunk^.Data.HotTrackTag^.HotspotAngleList); - end; - FALL_TRACK_TAG: - begin - FreeMem(Chunk^.Data.FallTrackTag^.KeyHdrList); - FreeMem(Chunk^.Data.FallTrackTag^.FalloffAngleList); - end; - KFHDR: - begin - Dispose(Chunk^.Data.KFHdr); - Chunk^.Data.KFHdr := nil; - end; - NODE_HDR: - begin - Dispose(Chunk^.Data.NodeHdr); - Chunk^.Data.NodeHdr := nil; - end; - HIDE_TRACK_TAG: - FreeMem(Chunk^.Data.HideTrackTag^.KeyHdrList); - end; // case end - // finally free the data chunk - FreeMem(Chunk^.Data.Dummy); - Chunk^.Data.Dummy := nil; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure InitChunk(var Chunk: PChunk3DS); - -// initializes and allocates memory for a chunk - -begin - New(Chunk); - if Chunk = nil then - ShowError(strError3DS_NO_MEM); - - // set default values - with Chunk^ do - begin - Tag := NULL_CHUNK; - Size := 0; - Position := 0; - Data.Dummy := nil; - Sibling := nil; - Children := nil; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure InitChunkList(var List: PChunklist3DS; Count: integer); - -begin - if List = nil then - begin - List := AllocMem(SizeOf(TChunklist3DS)); - if List = nil then - ShowError(strError3DS_NO_MEM); - end; - - List^.Count := Count; - - if Count > 0 then - begin - List^.List := AllocMem(Count * SizeOf(TChunkListEntry3DS)); - if List^.List = nil then - ShowError(strError3DS_NO_MEM); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function PutGenericNode(TagID: word; ParentChunk: PChunk3DS): PChunk3DS; - - // put a tag into database as a child of ParentChunk - -begin - InitChunk(Result); - Result^.Tag := TagID; - AddChildOrdered(ParentChunk, Result); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ReleaseChunk(var Chunk: PChunk3DS); - -var - Sibling: PChunk3DS; - -begin - // free memory associated with chunk and substructure - while Assigned(Chunk) do - begin - Sibling := Chunk^.Sibling; - ReleaseChunk(Chunk^.Children); - FreeChunkData(Chunk); - FreeMem(Chunk); - Chunk := Sibling; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ReleaseChunkList(var List: PChunkList3DS); - -var - I: integer; - -begin - if Assigned(List) then - begin - // tell the string management that we don't need these strings any longer - for I := 0 to List^.Count - 1 do - List^.List^[I].NameStr := ''; - if Assigned(List^.List) then - FreeMem(List^.List); - FreeMem(List); - List := nil; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function CopyChunk(Chunk: PChunk3DS): PChunk3DS; - - // copies the structure of Chunk to Result, assigned data of Chunk will not be copied, but - // moved to Result (actually references will be moved) - -var - ChildIn: PChunk3DS; - ChildOut: ^PChunk3DS; - -begin - if Chunk = nil then - ShowError(strERROR3DS_INVALID_ARG); - - InitChunk(Result); - with Result^ do - begin - Tag := Chunk^.Tag; - Size := Chunk^.Size; - Position := Chunk^.Position; - - if Assigned(Chunk^.Data.Dummy) then - begin - Data.Dummy := Chunk^.Data.Dummy; - Chunk^.Data.Dummy := nil; - end; - - ChildIn := Chunk^.Children; - ChildOut := @Children; - while Assigned(ChildIn) do - begin - ChildOut^ := CopyChunk(ChildIn); - ChildIn := ChildIn^.Sibling; - ChildOut := @ChildOut^.Sibling; - end; - end; -end; - -//----------------- list update routines ------------------------------------------------------------------------------ - -procedure UpdateMatEntryList(const Source: TFile3DS; var DB: TDatabase3DS); - -var - Parent, MatName, MatEntry: PChunk3DS; - I, MatCount: integer; - -begin - if DB.MatlistDirty then - begin - ReleaseChunkList(DB.MatList); - - Parent := FindChunk(DB.TopChunk, MDATA); - if Parent = nil then - Parent := FindChunk(DB.TopChunk, MLIBMAGIC); - - MatCount := 0; - if Assigned(Parent) then - begin - MatEntry := FindChunk(Parent, MAT_ENTRY); - while Assigned(MatEntry) do - begin - MatEntry := FindNextChunk(MatEntry^.Sibling, MAT_ENTRY); - Inc(MatCount); - end; - end; - - InitChunkList(DB.MatList, MatCount); - if Parent = nil then - Exit; - - I := 0; - MatEntry := FindChunk(Parent, MAT_ENTRY); - while Assigned(MatEntry) do - begin - MatName := FindChunk(MatEntry, MAT_NAME); - Source.ReadChunkData(MatName); - DB.MatList^.List^[I].Chunk := MatEntry; - DB.MatList^.List^[I].NameStr := string(MatName^.Data.MatName); - MatEntry := FindNextChunk(MatEntry^.Sibling, MAT_ENTRY); - Inc(I); - end; - DB.MatlistDirty := False; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure UpdateNamedObjectList(Source: TFile3DS; var DB: TDatabase3DS); - -var - MDataChunk, Current: PChunk3DS; - I: integer; - -begin - if DB.ObjListDirty then - begin - ReleaseChunkList(DB.ObjList); - - MDataChunk := FindChunk(DB.TopChunk, MDATA); - - I := 0; - if Assigned(MDataChunk) then - begin - Current := FindChunk(MDataChunk, NAMED_OBJECT); - while Assigned(Current) do - begin - Inc(I); - Current := FindNextChunk(Current^.Sibling, NAMED_OBJECT); - end; - end; - - InitChunkList(DB.ObjList, I); - if MDataChunk = nil then - Exit; - - I := 0; - Current := FindChunk(MDataChunk, NAMED_OBJECT); - while Assigned(Current) do - begin - Source.ReadChunkData(Current); - DB.ObjList^.List^[I].Chunk := Current; - DB.ObjList^.List^[I].NameStr := string(Current^.Data.NamedObject); - Current := FindNextChunk(Current^.Sibling, NAMED_OBJECT); - Inc(I); - end; - DB.ObjListDirty := False; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure UpdateNodeTagList(Source: TFile3DS; var DB: TDatabase3DS); - -var - KFDataChunk, Chunk, Current: PChunk3DS; - I: integer; - -begin - if DB.NodeListDirty then - begin - ReleaseChunkList(DB.NodeList); - KFDataChunk := FindChunk(DB.TopChunk, KFDATA); - - I := 0; - // if there is a keyframe section then count the number of node tags - if Assigned(KFDataChunk) then - begin - Current := KFDataChunk^.Children; - while Assigned(Current) do - begin - case Current^.Tag of - AMBIENT_NODE_TAG, - OBJECT_NODE_TAG, - CAMERA_NODE_TAG, - TARGET_NODE_TAG, - LIGHT_NODE_TAG, - L_TARGET_NODE_TAG, - SPOTLIGHT_NODE_TAG: - Inc(I); - end; - Current := Current^.Sibling; - end; - end; - - InitChunkList(DB.NodeList, I); - if I = 0 then - Exit; - - I := 0; - Current := KFDataChunk^.Children; - while Assigned(Current) do - begin - case Current^.Tag of - AMBIENT_NODE_TAG, - OBJECT_NODE_TAG, - CAMERA_NODE_TAG, - TARGET_NODE_TAG, - LIGHT_NODE_TAG, - L_TARGET_NODE_TAG, - SPOTLIGHT_NODE_TAG: - begin - Chunk := FindNextChunk(Current^.Children, NODE_HDR); - if Assigned(Chunk) then - begin - Source.ReadChunkData(Chunk); - DB.NodeList^.List^[I].Chunk := Current; - DB.NodeList^.List^[I].NameStr := Chunk^.Data.NodeHdr^.ObjNameStr; - FreeChunkData(Chunk); - end; - - // Object tags may have an instance name as well, which gets appended to - // the object name with a "." seperator - if Current^.Tag = OBJECT_NODE_TAG then - begin - Chunk := FindNextChunk(Current^.Children, INSTANCE_NAME); - if Assigned(Chunk) then - begin - Source.ReadChunkData(Chunk); - DB.NodeList^.List^[I].NameStr := - DB.NodeList^.List^[I].NameStr + '.' + string(Chunk^.Data.InstanceName); - FreeChunkData(Chunk); - end; - end; - Inc(I); // Increment index counter - end; - end; - Current := Current^.Sibling; - end; - - DB.NodeListDirty := False; - end; -end; - -//----------------- other support function ---------------------------------------------------------------------------- - -function GetGenericNodeCount(const Source: TFile3DS; var DB: TDatabase3DS; - Tag: word): integer; - -var - I: integer; - -begin - UpdateNodeTagList(Source, DB); - - Result := 0; - for I := 0 to DB.NodeList^.Count - 1 do - if DB.NodeList^.List^[I].Chunk^.Tag = Tag then - Inc(Result); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure GetGenericNodeNameList(const Source: TFile3DS; var DB: TDatabase3DS; - TagID: word; List: TStringList); - -var - I: cardinal; - -begin - UpdateNodeTagList(Source, DB); - List.Clear; - for I := 0 to DB.NodeList^.Count - 1 do - if DB.NodeList^.List^[I].Chunk^.Tag = TagID then - List.Add(DB.NodeList^.List^[I].NameStr); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function FindNamedAndTaggedChunk(const Source: TFile3DS; var DB: TDatabase3DS; - const Name: string; TagID: word): PChunk3DS; - - // Look through the keyframer stuff and find named chunk of the tag type TagID. - // Has to be a chunk that has a node header: CAMERA_NODE, LIGHT_NODE, , . - -var - KfChunk, NodeHdrChunk: PChunk3DS; - -begin - // find Keyframe Chunk - KfChunk := FindChunk(DB.TopChunk, KFDATA); - - // look for the target tag - Result := FindChunk(KfChunk, TagID); - while Assigned(Result) do - begin - NodeHdrChunk := FindNextChunk(Result^.Children, NODE_HDR); - if Assigned(NodeHdrChunk) then - begin - Source.ReadChunkData(NodeHdrChunk); - // match name, set pointer (case sensitive comparation!) - if CompareStr(Name, NodeHdrChunk^.Data.NodeHdr^.ObjNameStr) = 0 then - begin - FreeChunkData(NodeHdrChunk); - Break; - end; - FreeChunkData(NodeHdrChunk); - end; - Result := FindNextChunk(Result^.Sibling, TagID); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function FindNodeTagByIndexAndType(const Source: TFile3DS; var DB: TDatabase3DS; - Index: cardinal; AType: word): PChunk3DS; - -var - I, Count: cardinal; - -begin - Result := nil; - Count := 0; - UpdateNodeTagList(Source, DB); - for I := 0 to DB.NodeList^.Count - 1 do - if DB.NodeList^.List^[I].Chunk^.Tag = AType then - begin - if Count = Index then - begin - Result := DB.NodeList^.List^[I].Chunk; - Break; - end; - Inc(Count); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function FindNodeTagByNameAndType(const Source: TFile3DS; DB: TDatabase3DS; - const Name: string; AType: word): PChunk3DS; - -var - I: integer; - -begin - Result := nil; - UpdateNodeTagList(Source, DB); - for I := 0 to DB.NodeList^.Count - 1 do - if (DB.NodeList^.List^[I].Chunk^.Tag = AType) and - (CompareStr(Name, DB.NodeList^.List^[I].NameStr) = 0) then - begin - Result := DB.NodeList^.List^[I].Chunk; - Exit; - end; -end; - -//----------------- material handling --------------------------------------------------------------------------------- - -function GetMaterialCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; - -begin - UpdateMatEntryList(Source, DB); - if DB.MatList = nil then - Result := 0 - else - Result := DB.MatList^.Count; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function FindMatEntryByIndex(Source: TFile3DS; DB: TDatabase3DS; - Index: integer): PChunk3DS; - -begin - if DB.TopChunk = nil then - ShowError(strError3DS_INVALID_DATABASE); - if (DB.TopChunk^.Tag <> MLIBMAGIC) and (DB.TopChunk^.Tag <> M3DMAGIC) and - (DB.TopChunk^.Tag <> CMAGIC) then - ShowError(strError3DS_WRONG_DATABASE); - - UpdateMatEntryList(Source, DB); - if Index < DB.MatList^.Count then - Result := DB.MatList^.List^[Index].Chunk - else - Result := nil; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure InitBitmap(var Map: TBitmap3DS); - -begin - FillChar(Map, SizeOf(Map), 0); - with Map do - begin - UScale := 1; - VScale := 1; - Tint2.R := 1; - Tint2.G := 1; - Tint2.B := 1; - RedTint.R := 1; - GreenTint.G := 1; - BlueTint.B := 1; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure InitMaterial(var Mat: TMaterial3DS); - -begin - FillChar(Mat, SizeOf(Mat), 0); - with Mat do - begin - WireSize := 1; - Shading := stPhong; - Reflect.AutoMap.Size := 100; - Reflect.AutoMap.nthFrame := 1; - InitBitmap(Texture.Map); - InitBitmap(Texture.Mask); - InitBitmap(Texture2.Map); - InitBitmap(Texture2.Mask); - InitBitmap(Opacity.Map); - InitBitmap(Opacity.Mask); - InitBitmap(Reflect.Map); - InitBitmap(Reflect.Mask); - InitBitmap(Bump.Map); - InitBitmap(Bump.Mask); - InitBitmap(SpecMap.Map); - InitBitmap(SpecMap.Mask); - InitBitmap(ShinMap.Map); - InitBitmap(ShinMap.Mask); - InitBitmap(IllumMap.Map); - InitBitmap(IllumMap.Mask); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ReleaseMaterial(Mat: PMaterial3DS); - -begin - if Assigned(Mat) then - begin - FreeMem(Mat^.Texture.Map.Data); - FreeMem(Mat^.Texture.Mask.Data); - FreeMem(Mat^.Texture2.Map.Data); - FreeMem(Mat^.Texture2.Mask.Data); - FreeMem(Mat^.Opacity.Map.Data); - FreeMem(Mat^.Opacity.Mask.Data); - FreeMem(Mat^.Reflect.Mask.Data); - FreeMem(Mat^.Bump.Map.Data); - FreeMem(Mat^.Bump.Mask.Data); - FreeMem(Mat^.Specmap.Map.Data); - FreeMem(Mat^.SpecMap.Mask.Data); - FreeMem(Mat^.ShinMap.Map.Data); - FreeMem(Mat^.ShinMap.Mask.Data); - FreeMem(Mat^.IllumMap.Map.Data); - FreeMem(Mat^.IllumMap.Mask.Data); - Dispose(Mat); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function FindNamedObjectByIndex(Source: TFile3DS; DB: TDatabase3DS; - AType: word; Index: integer): PChunk3DS; - - // searches the database for a named object by index position and object type - // returns the NAMED_OBJECT chunk if found, nil otherwise - -var - Chunk: PChunk3DS; - I, Count: integer; - -begin - UpdateNamedObjectList(Source, DB); - - Count := 0; - Result := nil; - for I := 0 to DB.ObjList^.Count - 1 do - begin - if AType = DL_SPOTLIGHT then - begin - Chunk := FindChunk(DB.ObjList^.List^[I].Chunk, N_DIRECT_LIGHT); - if Assigned(Chunk) then - Chunk := FindChunk(Chunk, AType); - end - else - Chunk := FindChunk(DB.ObjList^.List^[I].Chunk, AType); - - if Assigned(Chunk) then - begin - if Count = Index then - begin - Result := DB.ObjList^.List^[I].Chunk; - Break; - end - else - Inc(Count); - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure DeleteChunk(var Chunk: PChunk3DS); - -// returns a chunk to its untagged state state, but leaves it -// connected to any siblings it might have - -begin - if Assigned(Chunk) then - begin - // release any children - if Assigned(Chunk^.Children) then - ReleaseChunk(Chunk^.Children); - // release any data - if Assigned(Chunk^.Data.Dummy) then - FreeChunkData(Chunk); - // return to a semi-uninitialized state - Chunk^.Tag := NULL_CHUNK; - Chunk^.Size := 0; - Chunk^.Position := 0; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function ReadPercentageChunk(Source: TFile3DS; Chunk: PChunk3DS): single; - -var - DataChunk: PChunk3DS; - -begin - DataChunk := FindChunk(Chunk, INT_PERCENTAGE); - if Assigned(DataChunk) then - begin - Source.ReadChunkData(DataChunk); - Result := DataChunk^.Data.IntPercentage^ / 100; - FreeChunkData(DataChunk); - end - else - begin - DataChunk := FindChunk(Chunk, FLOAT_PERCENTAGE); - if Assigned(DataChunk) then - begin - Source.ReadChunkData(DataChunk); - Result := DataChunk^.Data.FloatPercentage^; - FreeChunkData(DataChunk); - end - else - Result := 0; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure GetBitmapChunk(const DataSource: TFile3DS; Chunk: PChunk3DS; - var Bitmap: TBitmap3DS); - -var - Current: PChunk3DS; - -begin - Current := Chunk^.Children; - while Assigned(Current) do - begin - with Bitmap do - begin - case Current^.Tag of - INT_PERCENTAGE: - begin - DataSource.ReadChunkData(Current); - Percent := Current^.Data.IntPercentage^ / 100; - FreeChunkData(Current); - end; - FLOAT_PERCENTAGE: - begin - DataSource.ReadChunkData(Current); - Percent := Current^.Data.FloatPercentage^; - FreeChunkData(Current); - end; - MAT_MAPNAME: - begin - DataSource.ReadChunkData(Current); - NameStr := StrPas(Current^.Data.MatMapname); - FreeChunkData(Current); - end; - MAT_MAP_TILING: - begin - DataSource.ReadChunkData(Current); - if (Current^.Data.MatMapTiling^ and TEX_DECAL) <> 0 then - if (Current^.Data.MatMapTiling^ and TEX_NOWRAP) <> 0 then - Tiling := ttDecal - else - Tiling := ttBoth - else - tiling := ttTile; - IgnoreAlpha := (Current^.Data.MatMapTiling^ and TEX_DONT_USE_ALPHA) <> 0; - if (Current^.Data.MatMapTiling^ and TEX_SAT) <> 0 then - Filter := ftSummedArea - else - Filter := ftPyramidal; - Mirror := (Current^.Data.MatMapTiling^ and TEX_MIRROR) <> 0; - Negative := (Current^.Data.MatMapTiling^ and TEX_INVERT) <> 0; - if (Current^.Data.MatMapTiling^ and TEX_TINT) <> 0 then - if (Current^.Data.MatMapTiling^ and TEX_ALPHA_SOURCE) <> 0 then - Source := ttAlphaTint - else - Source := ttRGBLumaTint - else if (Current^.Data.MatMapTiling^ and TEX_RGB_TINT) <> 0 then - Source := ttRGBTint - else if (Current^.Data.MatMapTiling^ and TEX_ALPHA_SOURCE) <> 0 then - Source := ttAlpha - else - Source := ttRGB; - FreeChunkData(Current); - end; - MAT_MAP_USCALE: - begin - DataSource.ReadChunkData(Current); - UScale := Current^.Data.MatMapUScale^; - FreeChunkData(Current); - end; - MAT_MAP_VSCALE: - begin - DataSource.ReadChunkData(Current); - VScale := Current^.Data.MatMapVScale^; - FreeChunkData(Current); - end; - MAT_MAP_UOFFSET: - begin - DataSource.ReadChunkData(Current); - UOffset := Current^.Data.MatMapUOffset^; - FreeChunkData(Current); - end; - MAT_MAP_VOFFSET: - begin - DataSource.ReadChunkData(Current); - VOffset := Current^.Data.MatMapVOffset^; - FreeChunkData(Current); - end; - MAT_MAP_ANG: - begin - DataSource.ReadChunkData(Current); - Rotation := Current^.Data.MatMapAng^; - FreeChunkData(Current); - end; - MAT_BUMP_PERCENT: - ; // value is really stored in TMaterial3DS structure - MAT_MAP_COL1: - begin - DataSource.ReadChunkData(Current); - Tint1.R := Current^.Data.MatMapCol1^.Red / 255; - Tint1.G := Current^.Data.MatMapCol1^.Green / 255; - Tint1.B := Current^.Data.MatMapCol1^.Blue / 255; - FreeChunkData(Current); - end; - MAT_MAP_COL2: - begin - DataSource.ReadChunkData(Current); - Tint2.R := Current^.Data.MatMapCol2^.Red / 255; - Tint2.G := Current^.Data.MatMapCol2^.Green / 255; - Tint2.B := Current^.Data.MatMapCol2^.Blue / 255; - FreeChunkData(Current); - end; - MAT_MAP_RCOL: - begin - DataSource.ReadChunkData(Current); - RedTint.R := Current^.Data.MatMapRCol^.Red / 255; - RedTint.G := Current^.Data.MatMapRCol^.Green / 255; - RedTint.B := Current^.Data.MatMapRCol^.Blue / 255; - FreeChunkData(Current); - end; - MAT_MAP_GCOL: - begin - DataSource.ReadChunkData(Current); - GreenTint.R := Current^.Data.MatMapGCol^.Red / 255; - GreenTint.G := Current^.Data.MatMapGCol^.Green / 255; - GreenTint.B := Current^.Data.MatMapGCol^.Blue / 255; - FreeChunkData(Current); - end; - MAT_MAP_BCOL: - begin - DataSource.ReadChunkData(Current); - BlueTint.R := Current^.Data.MatMapBCol^.Red / 255; - BlueTint.G := Current^.Data.MatMapBCol^.Green / 255; - BlueTint.B := Current^.Data.MatMapBCol^.Blue / 255; - FreeChunkData(Current); - end; - MAT_MAP_TEXBLUR: - begin - DataSource.ReadChunkData(Current); - Blur := Current^.Data.MatMapTexBlur^; // float percents - FreeChunkData(Current); - end; - end; // case Current^.Tag of - Current := Current^.Sibling; - end; // with Bitmap do - end; // while Assigned(Current) do -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function ReadMatEntryChunk(Source: TFile3DS; MatEntry: PChunk3DS): TMaterial3DS; - -var - Current, DataChunk, Color: PChunk3DS; - MatColor: PFColor3DS; - -begin - if MatEntry^.Tag <> MAT_ENTRY then - ShowError(strError3DS_INVALID_CHUNK); - InitMaterial(Result); - - with Result do - begin - Current := MatEntry^.Children; - while Assigned(Current) do - begin - if (Current^.Tag and $FF00) <> $8000 then // ignore xdata - case Current^.Tag of - MAT_NAME: - begin - Source.ReadChunkData(Current); - NameStr := StrPas(Current^.Data.MatName); - FreeChunkData(Current); - end; - MAT_AMBIENT, - MAT_DIFFUSE, - MAT_SPECULAR: - begin - case Current^.Tag of - MAT_DIFFUSE: - MatColor := @Diffuse; - MAT_SPECULAR: - MatColor := @Specular; - else - MatColor := @Ambient; // MAT_AMBIENT - end; - Color := FindChunk(Current, COLOR_24); - if Assigned(color) then - begin - Source.ReadChunkData(Color); - MatColor^.R := Color^.Data.Color24^.Red / 255; - MatColor^.G := Color^.Data.Color24^.Green / 255; - MatColor^.B := Color^.Data.Color24^.Blue / 255; - FreeChunkData(Color); - end; - Color := FindChunk(Current, COLOR_F); - if Assigned(Color) then - begin - Source.ReadChunkData(Color); - MatColor^.R := Color^.Data.ColorF^.Red; - MatColor^.G := Color^.Data.ColorF^.Green; - MatColor^.B := Color^.Data.ColorF^.Blue; - FreeChunkData(Color); - end; - Color := FindChunk(Current, LIN_COLOR_24); - if Assigned(Color) then - begin - Source.ReadChunkData(Color); - MatColor^.R := Color^.Data.LinColor24^.Red / 255; - MatColor^.G := Color^.Data.LinColor24^.Green / 255; - MatColor^.B := Color^.Data.LinColor24^.Blue / 255; - FreeChunkData(Color); - end; - end; - MAT_SHININESS: - Shininess := ReadPercentageChunk(Source, Current); - MAT_SHIN2PCT: - ShinStrength := ReadPercentageChunk(Source, Current); - MAT_SHIN3PCT: - ; // just skip for now - MAT_REFBLUR: - Blur := ReadPercentageChunk(Source, Current); - MAT_TRANSPARENCY: - Transparency := ReadPercentageChunk(Source, Current); - MAT_XPFALL: - TransFalloff := ReadPercentageChunk(Source, Current); - MAT_SELF_ILPCT: - SelfIllumPct := ReadPercentageChunk(Source, Current); - MAT_WIRE: - Shading := stWire; - MAT_WIREABS: - UseWireAbs := True; - MAT_XPFALLIN: - Transparency := -Transparency; - MAT_WIRESIZE: - begin - Source.ReadChunkData(Current); - WireSize := Current^.Data.MatWireSize^; - FreeChunkData(Current); - end; - MAT_USE_XPFALL: - UseFall := True; - MAT_USE_REFBLUR: - Useblur := True; - MAT_SELF_ILLUM: - SelfIllum := True; - MAT_TWO_SIDE: - TwoSided := True; - MAT_ADDITIVE: - Additive := True; - MAT_SHADING: - begin - Source.ReadChunkData(Current); - Shading := TShadeType3DS(Current^.Data.MatShading^); - FreeChunkData(Current); - end; - MAT_FACEMAP: - FaceMap := True; - MAT_PHONGSOFT: - Soften := True; - MAT_TEXMAP: - GetBitmapChunk(Source, Current, Texture.Map); - MAT_TEXMASK: - GetBitmapChunk(Source, Current, Texture.Mask); - MAT_TEX2MAP: - GetBitmapChunk(Source, Current, Texture2.Map); - MAT_TEX2MASK: - GetBitmapChunk(Source, Current, Texture2.Mask); - MAT_OPACMAP: - GetBitmapChunk(Source, Current, Opacity.Map); - MAT_OPACMASK: - GetBitmapChunk(Source, Current, Opacity.Mask); - MAT_REFLMAP: - GetBitmapChunk(Source, Current, Reflect.Map); - MAT_ACUBIC: - begin - Source.ReadChunkData(Current); - Reflect.UseAuto := True; - Reflect.AutoMap.FirstFrame := - (Current^.Data.MatAcubic^.Flags and ACubicFirst3DS) <> 0; - Reflect.AutoMap.Flat := - (Current^.Data.MatAcubic^.Flags and ACubicFlat3DS) <> 0; - Reflect.AutoMap.Size := Current^.Data.MatAcubic^.MapSize; - Reflect.AutoMap.nthFrame := Current^.Data.MatAcubic^.FrameInterval; - FreeChunkData(Current); - end; - MAT_REFLMASK: - GetBitmapChunk(Source, Current, Reflect.Mask); - MAT_BUMPMAP: - begin - GetBitmapChunk(Source, Current, Bump.Map); - DataChunk := FindChunk(Current, MAT_BUMP_PERCENT); - if Assigned(DataChunk) then - begin - Source.ReadChunkData(DataChunk); - Bump.Map.Percent := DataChunk^.Data.MatBumpPercent^ / 100; - FreeChunkData(DataChunk); - end; - end; - MAT_BUMPMASK: - GetBitmapChunk(Source, Current, Bump.Mask); - MAT_SPECMAP: - GetBitmapChunk(Source, Current, SpecMap.Map); - MAT_SPECMASK: - GetBitmapChunk(Source, Current, SpecMap.Mask); - MAT_SHINMAP: - GetBitmapChunk(Source, Current, ShinMap.Map); - MAT_SHINMASK: - GetBitmapChunk(Source, Current, Shinmap.Mask); - MAT_SELFIMAP: - GetBitmapChunk(Source, Current, IllumMap.Map); - MAT_SELFIMASK: - GetBitmapChunk(Source, Current, IllumMap.Mask); - MAT_SXP_TEXT_DATA: - begin - Source.ReadChunkData(Current); - Texture.Map.DataSize := Current^.Data.IpasData^.Size; - Texture.Map.Data := Current^.Data.IpasData^.Data; - // avoid releasing the data memory - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_TEXT_MASKDATA: - begin - Source.ReadChunkData(Current); - Texture.Mask.DataSize := Current^.Data.IpasData^.Size; - Texture.Mask.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_TEXT2_DATA: - begin - Source.ReadChunkData(Current); - Texture2.Map.DataSize := Current^.Data.IpasData^.Size; - Texture2.Map.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_TEXT2_MASKDATA: - begin - Source.ReadChunkData(Current); - Texture2.Mask.DataSize := Current^.Data.IpasData^.Size; - Texture2.Mask.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_OPAC_DATA: - begin - Source.ReadChunkData(Current); - Opacity.Map.DataSize := Current^.Data.IpasData^.Size; - Opacity.Map.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_OPAC_MASKDATA: - begin - Source.ReadChunkData(Current); - Opacity.Mask.DataSize := Current^.Data.IpasData^.Size; - Opacity.Mask.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_REFL_MASKDATA: - begin - Source.ReadChunkData(Current); - Reflect.Mask.DataSize := Current^.Data.IpasData^.Size; - Reflect.Mask.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_BUMP_DATA: - begin - Source.ReadChunkData(Current); - Bump.Map.DataSize := Current^.Data.IpasData^.Size; - Bump.Map.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_BUMP_MASKDATA: - begin - Source.ReadChunkData(Current); - Bump.Mask.DataSize := Current^.Data.IpasData^.Size; - Bump.Mask.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_SPEC_DATA: - begin - Source.ReadChunkData(Current); - SpecMap.Map.DataSize := Current^.Data.IpasData^.Size; - SpecMap.Map.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_SPEC_MASKDATA: - begin - Source.ReadChunkData(Current); - Specmap.Mask.DataSize := Current^.Data.IpasData^.Size; - Specmap.Mask.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_SHIN_DATA: - begin - Source.ReadChunkData(Current); - ShinMap.Map.DataSize := Current^.Data.IpasData^.Size; - ShinMap.Map.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_SHIN_MASKDATA: - begin - Source.ReadChunkData(Current); - ShinMap.Mask.DataSize := Current^.Data.IpasData^.Size; - ShinMap.Mask.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_SELFI_DATA: - begin - Source.ReadChunkData(Current); - IllumMap.Map.DataSize := Current^.Data.IpasData^.Size; - IllumMap.Map.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_SXP_SELFI_MASKDATA: - begin - Source.ReadChunkData(Current); - IllumMap.Mask.DataSize := Current^.Data.IpasData^.Size; - IllumMap.Mask.Data := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MAT_DECAL: - ; // don't know what do to with it - else - ShowError(strError3DS_INVALID_CHUNK) - end; - Current := Current^.Sibling; - end; // while Assigned(Current) do - end; // with Result do -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetChunkValue(Tag: word): integer; - - // Computes a chunk weighting used to determine proper chunk order, - // higher values appear earlier in the parent than lower values - -begin - // only chunks where an explicit order matters are handled - Result := 0; - - case Tag of - NULL_CHUNK: - Inc(Result); // These should just be ignored - SMAGIC: - Inc(Result, 2); - LMAGIC: - Inc(Result, 3); - M3DMAGIC: - Inc(Result, 4); - M3D_VERSION: - Inc(Result, 5); - MDATA: - Inc(Result, 6); - KFDATA: - Inc(Result, 7); - COLOR_24: - Inc(Result, 8); - LIN_COLOR_24: - Inc(Result, 9); - MESH_VERSION: - Inc(Result, 10); - MAT_ENTRY: - Inc(Result, 11); - KFHDR: - Inc(Result, 12); - MASTER_SCALE: - Inc(Result, 13); - VIEWPORT_LAYOUT: - Inc(Result, 14); - LO_SHADOW_BIAS: - Inc(Result, 15); - SHADOW_MAP_SIZE: - Inc(Result, 16); - SHADOW_FILTER: - Inc(Result, 17); - RAY_BIAS: - Inc(Result, 18); - O_CONSTS: - Inc(Result, 19); - AMBIENT_LIGHT: - Inc(Result, 20); - SOLID_BGND: - Inc(Result, 21); - BIT_MAP: - Inc(Result, 22); - V_GRADIENT: - Inc(Result, 23); - USE_BIT_MAP: - Inc(Result, 24); - USE_SOLID_BGND: - Inc(Result, 25); - USE_V_GRADIENT: - Inc(Result, 26); - FOG: - Inc(Result, 27); - LAYER_FOG: - Inc(Result, 28); - DISTANCE_CUE: - Inc(Result, 29); - DEFAULT_VIEW: - Inc(Result, 30); - NAMED_OBJECT: - Inc(Result, 31); - KFSEG: - Inc(Result, 32); - KFCURTIME: - Inc(Result, 33); - TARGET_NODE_TAG, - L_TARGET_NODE_TAG, - OBJECT_NODE_TAG, - CAMERA_NODE_TAG, - SPOTLIGHT_NODE_TAG: - Inc(Result, 34); - AMBIENT_NODE_TAG: - Inc(Result, 35); - N_TRI_OBJECT, - N_CAMERA, - N_DIRECT_LIGHT: - Inc(Result); - OBJ_HIDDEN: - Inc(Result); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetMaterialByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: integer): TMaterial3DS; - -var - Chunk: PChunk3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - - Chunk := FindMatEntryByIndex(Source, DB, Index); - if Assigned(Chunk) then - Result := ReadMatEntryChunk(Source, Chunk) - else - ShowErrorFormatted(strError3DS_INVALID_INDEX, [Index]); -end; - -//----------------- mesh object handling ------------------------------------------------------------------------------ - -function GetMeshCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; - - // returns the number of mesh objects referenced in the chunk list - -var - I: integer; - Chunk: PChunk3DS; - -begin - // update the index to named objects if the list has changed recently - UpdateNamedObjectList(Source, DB); - - Result := 0; - if DB.ObjList = nil then - Exit; - - // scan through the list of named objects - for I := 0 to DB.ObjList^.Count - 1 do - begin - Chunk := FindChunk(DB.ObjList^.List^[I].Chunk, N_TRI_OBJECT); - if Assigned(Chunk) then - Inc(Result); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetMeshMatCount(Current: PChunk3DS): integer; - - // aids the GetMeshEntryChunk3DS in determining - // how many materials are defined within the mesh object - -var - Chunk: PChunk3DS; - -begin - Result := 0; - Chunk := FindChunk(Current, MSH_MAT_GROUP); - while Assigned(Chunk) do - begin - Chunk := FindNextChunk(Chunk^.Sibling, MSH_MAT_GROUP); - Inc(Result); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure RelMeshObjField(var Mesh: TMesh3DS; Field: integer); - -var - I: integer; - -begin - if ((Field and RelVertexArray3DS) <> 0) and Assigned(Mesh.VertexArray) then - begin - FreeMem(Mesh.VertexArray); - Mesh.VertexArray := nil; - end; - - if ((Field and RelTextArray3DS) <> 0) and Assigned(Mesh.TextArray) then - begin - FreeMem(Mesh.TextArray); - Mesh.TextArray := nil; - end; - - if ((Field and RelFaceArray3DS) <> 0) and Assigned(Mesh.FaceArray) then - begin - FreeMem(Mesh.FaceArray); - Mesh.FaceArray := nil; - end; - - if ((Field and RelMatArray3DS) <> 0) and Assigned(Mesh.MatArray) then - begin - for I := 0 to Mesh.NMats - 1 do - begin - // name is always assigned - Mesh.MatArray^[I].NameStr := ''; - if Assigned(Mesh.MatArray^[I].FaceIndex) then - begin - FreeMem(Mesh.MatArray^[I].FaceIndex); - Mesh.MatArray^[I].FaceIndex := nil; - end; - end; - FreeMem(Mesh.MatArray); - Mesh.MatArray := nil; - end; - - if ((Field and RelSmoothArray3DS) <> 0) and Assigned(Mesh.SmoothArray) then - begin - FreeMem(Mesh.SmoothArray); - Mesh.SmoothArray := nil; - end; - - if ((Field and RelProcData3DS) <> 0) and Assigned(Mesh.ProcData) then - begin - FreeMem(Mesh.ProcData); - Mesh.ProcData := nil; - end; - - if ((Field and RelVFlagArray3DS) <> 0) and Assigned(Mesh.VFlagArray) then - begin - FreeMem(Mesh.VFlagArray); - Mesh.VFlagArray := nil; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure InitMeshObjField(var aMesh: TMesh3DS; Field: integer); - -var - I: integer; - -begin - with aMesh do - begin - // test to see if Vertices are being allocated - if (Field and InitVertexArray3DS) <> 0 then - begin - // if the vertex count is 0 then free the array - if NVertices = 0 then - RelMeshObjField(aMesh, RelVertexArray3DS) - else - begin - // if this is the very first allocation - if VertexArray = nil then - begin - // allocate the new block of memory - VertexArray := AllocMem(NVertices * SizeOf(TPoint3DS)); - if VertexArray = nil then - ShowError(strError3DS_NO_MEM); - - // this is done by AllocMem already - // initialize the new block - //for I := 0 to NVertices - 1 do VertexArray[I] := DefPoint3DS; - end - else // else this is an existing block - begin - // just resize it - ReallocMem(VertexArray, SizeOf(TPoint3DS) * NVertices); - if VertexArray = nil then - ShowError(strError3DS_NO_MEM); - end; - end; - end; - - if (Field and InitTextArray3DS) <> 0 then - begin - if NTextVerts = 0 then - RelMeshObjField(aMesh, RelTextArray3DS) - else - begin - if TextArray = nil then - begin - TextArray := Allocmem(NTextVerts * SizeOf(TTexVert3DS)); - if TextArray = nil then - ShowError(strError3DS_NO_MEM); - - for I := 0 to NTextVerts - 1 do - TextArray^[I] := DefTextVert3DS; - end - else - begin - Reallocmem(TextArray, SizeOf(TTexVert3DS) * NTextVerts); - if TextArray = nil then - ShowError(strError3DS_NO_MEM); - end; - end; - end; - - if (Field and InitFaceArray3DS) <> 0 then - begin - if NFaces = 0 then - RelMeshObjField(aMesh, RelFaceArray3DS) - else - begin - if FaceArray = nil then - begin - FaceArray := AllocMem(NFaces * SizeOf(TFace3DS)); - if FaceArray = nil then - ShowError(strError3DS_NO_MEM); - - for I := 0 to NFaces - 1 do - FaceArray^[I] := DefFace3DS; - end - else - begin - ReallocMem(FaceArray, SizeOf(TFace3DS) * NFaces); - if FaceArray = nil then - ShowError(strError3DS_NO_MEM); - end; - end; - end; - - if (Field and InitMatArray3DS) <> 0 then - begin - if NMats = 0 then - RelMeshObjField(aMesh, RelMatArray3DS) - else - begin - if Matarray = nil then - begin - MatArray := AllocMem(NMats * SizeOf(TObjmat3DS)); - if MatArray = nil then - ShowError(strError3DS_NO_MEM); - - for I := 0 to NMats - 1 do - MatArray^[I] := DefObjMat3DS; - end - else - begin - ReallocMem(MatArray, SizeOf(TObjmat3DS) * NMats); - if MatArray = nil then - ShowError(strError3DS_NO_MEM); - end; - end; - end; - - if (Field and InitSmoothArray3DS) <> 0 then - begin - if NFaces = 0 then - RelMeshObjField(aMesh, RelSmoothArray3DS) - else - begin - if SmoothArray = nil then - begin - SmoothArray := AllocMem(NFaces * SizeOf(integer)); - if SmoothArray = nil then - ShowError(strError3DS_NO_MEM); - - // done by AllocMem - // for I := 0 to NFaces - 1 do SmoothArray[I] := 0; - end - else - begin - ReallocMem(SmoothArray, SizeOf(integer) * NFaces); - if SmoothArray = nil then - ShowError(strError3DS_NO_MEM); - end; - end; - end; - - if (Field and InitProcData3DS) <> 0 then - begin - if ProcSize = 0 then - RelMeshObjField(aMesh, RelProcData3DS) - else - begin - if ProcData = nil then - begin - ProcData := AllocMem(ProcSize * SizeOf(byte)); - if ProcData = nil then - ShowError(strError3DS_NO_MEM); - end - else - begin - ReallocMem(ProcData, SizeOf(byte) * ProcSize); - if ProcData = nil then - ShowError(strError3DS_NO_MEM); - end; - end; - end; - - if (Field and InitVFlagArray3DS) <> 0 then - begin - if NVertices = 0 then - RelMeshObjField(aMesh, RelVFlagArray3DS) - else - begin - if VFlagArray = nil then - begin - VFlagArray := AllocMem(NVertices * SizeOf(word)); - if VFlagArray = nil then - ShowError(strError3DS_NO_MEM); - end - else - begin - ReallocMem(VFlagArray, SizeOf(word) * NVertices); - if VFlagArray = nil then - ShowError(strError3DS_NO_MEM); - end; - end; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function InitMeshObj(VertexCount, FaceCount, InitFlags: word): TMesh3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - with Result do - begin - NVertices := VertexCount; - Map.TileX := 1; - Map.TileY := 1; - Map.Scale := 1; - Map.Matrix[0] := 1; - Map.Matrix[4] := 1; - Map.PW := 1; - Map.PH := 1; - Map.CH := 1; - - NFaces := FaceCount; - - InitMeshObjField(Result, InitVertexArray3DS or InitFaceArray3DS); - - if (InitFlags and InitTextArray3DS) <> 0 then - begin - NTextVerts := VertexCount; - InitMeshObjField(Result, InitTextArray3DS); - end; - - if (InitFlags and InitVFlagArray3DS) <> 0 then - begin - NVFlags := VertexCount; - InitMeshObjField(Result, InitVFlagArray3DS); - end; - - if (InitFlags and InitSmoothArray3DS) <> 0 then - InitMeshObjField(Result, InitSmoothArray3DS); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ReleaseMeshObj(Mesh: PMesh3DS); - -begin - if Assigned(Mesh) then - begin - RelMeshObjField(Mesh^, RelAll3DS); - Dispose(Mesh); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetMeshEntryChunk(const Source: TFile3DS; Chunk: PChunk3DS): TMesh3DS; - -var - NTriChunk, FaceArrayChunk, DataChunk, Current: PChunk3DS; - I: integer; - -begin - NTriChunk := FindNextChunk(Chunk^.Children, N_TRI_OBJECT); - if NTriChunk = nil then - ShowError(strError3DS_WRONG_OBJECT); - - Result := InitMeshObj(0, 0, 0); - - with Result do - begin - // get the mesh name - Source.ReadChunkData(Chunk); - NameStr := StrPas(Chunk^.Data.NamedObject); - - Current := NTriChunk^.Children; - while Assigned(Current) do - begin - case Current^.Tag of - POINT_ARRAY: - begin - Source.ReadChunkData(Current); - NVertices := Current^.Data.PointArray^.Vertices; - VertexArray := Current^.Data.PointArray^.PointList; - // avoid freeing the just allocated memory - Current^.Data.PointArray^.PointList := nil; - FreeChunkData(Current); - end; - POINT_FLAG_ARRAY: - begin - Source.ReadChunkData(Current); - NVFlags := Current^.Data.PointFlagArray^.Flags; - VFlagArray := Current^.Data.PointFlagArray^.FlagList; - Current^.Data.PointFlagArray^.FlagList := nil; - FreeChunkData(Current); - end; - FACE_ARRAY: - begin - Source.ReadChunkData(Current); - NFaces := Current^.Data.FaceArray^.Faces; - FaceArray := Current^.Data.FaceArray^.FaceList; - Current^.Data.FaceArray^.FaceList := nil; - - if Assigned(Current^.Children) then - begin - // begin search for MESH_MAT_GROUP and SMOOTH_GROUP - FaceArrayChunk := Current; - - // creates a list of all mesh mat groups - DataChunk := FindChunk(FaceArrayChunk, MSH_MAT_GROUP); - if Assigned(DataChunk) then - begin - NMats := GetMeshMatCount(DataChunk); - MatArray := AllocMem(NMats * SizeOf(TObjMat3DS)); - - for I := 0 to NMats - 1 do - begin - Source.ReadChunkData(DataChunk); - MatArray^[I].NameStr := DataChunk^.Data.MshMatGroup^.MatNameStr; - MatArray^[I].NFaces := DataChunk^.Data.MshMatGroup^.Faces; - MatArray^[I].FaceIndex := DataChunk^.Data.MshMatGroup^.FaceList; - DataChunk^.Data.MshMatGroup^.FaceList := nil; - FreeChunkData(DataChunk); - DataChunk := FindNextChunk(DataChunk^.Sibling, MSH_MAT_GROUP); - end; - end; - - DataChunk := FindNextChunk(FaceArrayChunk^.Children, SMOOTH_GROUP); - if Assigned(DataChunk) then - begin - Source.ReadChunkData(DataChunk); - SmoothArray := DataChunk^.Data.SmoothGroup^.GroupList; - DataChunk^.Data.SmoothGroup^.GroupList := nil; - FreeChunkData(DataChunk); - end; - - DataChunk := FindNextChunk(FaceArrayChunk^.Children, MSH_BOXMAP); - if Assigned(DataChunk) then - begin - Source.ReadChunkData(DataChunk); - for I := 0 to 5 do - BoxMapStr[I] := string(DataChunk^.Data.MshBoxmap^[I]); - UseBoxmap := True; - FreeChunkData(DataChunk); - end; - end; - FreeChunkData(Current); - end; - TEX_VERTS: - begin - Source.ReadChunkData(Current); - ntextverts := Current^.Data.TexVerts^.NumCoords; - TextArray := Current^.Data.TexVerts^.TextVertList; - Current^.Data.TexVerts^.TextVertList := nil; - FreeChunkData(Current); - end; - MESH_MATRIX: - begin - Source.ReadChunkData(Current); - LocMatrix := Current^.Data.MeshMatrix^; - FreeChunkData(Current); - end; - MESH_TEXTURE_INFO: - begin - UseMapInfo := True; - Source.ReadChunkData(Current); - Map.MapType := Current^.Data.MeshTextureInfo^.MapType; - Map.TileX := Current^.Data.MeshTextureInfo^.XTiling; - Map.TileY := Current^.Data.MeshTextureInfo^.YTiling; - Map.CenX := Current^.Data.MeshTextureInfo^.IconPos.X; - Map.CenY := Current^.Data.MeshTextureInfo^.IconPos.Y; - Map.CenZ := Current^.Data.MeshTextureInfo^.IconPos.Z; - Map.Scale := Current^.Data.MeshTextureInfo^.IconScaling; - Map.Matrix := Current^.Data.MeshTextureInfo^.XMatrix; - Map.PW := Current^.Data.MeshTextureInfo^.IconWidth; - Map.PH := Current^.Data.MeshTextureInfo^.IconHeight; - Map.CH := Current^.Data.MeshTextureInfo^.CylIconHeight; - FreeChunkData(Current); - end; - PROC_NAME: - begin - Source.ReadChunkData(Current); - ProcNameStr := string(StrPas(Current^.Data.ProcName)); - FreeChunkData(Current); - end; - PROC_DATA: - begin - Source.ReadChunkData(Current); - ProcSize := Current^.Data.IpasData^.Size; - ProcData := Current^.Data.IpasData^.Data; - Current^.Data.IpasData^.Data := nil; - FreeChunkData(Current); - end; - MESH_COLOR: - begin - Source.ReadChunkData(Current); - MeshColor := Current^.Data.MeshColor^; - FreeChunkData(Current); - end; - end; - Current := Current^.Sibling; - end; - - IsHidden := Assigned(FindNextChunk(Chunk^.Children, OBJ_HIDDEN)); - IsVisLofter := Assigned(FindNextChunk(Chunk^.Children, OBJ_VIS_LOFTER)); - IsNoCast := Assigned(FindNextChunk(Chunk^.Children, OBJ_DOESNT_CAST)); - IsMatte := Assigned(FindNextChunk(Chunk^.Children, OBJ_MATTE)); - IsFast := Assigned(FindNextChunk(Chunk^.Children, OBJ_FAST)); - IsFrozen := Assigned(FindNextChunk(Chunk^.Children, OBJ_FROZEN)); - IsNoRcvShad := Assigned(FindNextChunk(Chunk^.Children, OBJ_DONT_RCVSHADOW)); - UseProc := Assigned(FindNextChunk(Chunk^.Children, OBJ_PROCEDURAL)); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetMeshByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: integer): TMesh3DS; - - // fills a mesh structure from the (index)th mesh reference found in DB - -var - Current: PChunk3DS; - I, Count: integer; - -begin - FillChar(Result, SizeOf(Result), 0); - - if DB.TopChunk = nil then - ShowError(strError3DS_INVALID_DATABASE); - if (DB.TopChunk^.Tag <> M3DMAGIC) and (DB.TopChunk^.Tag <> CMAGIC) then - ShowError(strError3DS_WRONG_DATABASE); - - // update the index to named objects if the list has changed recently - UpdateNamedObjectList(Source, DB); - - // scan through the list of named objects - Count := 0; - for I := 0 to DB.ObjList^.Count - 1 do - begin - // search each named object for a mesh chunk - Current := FindChunk(DB.ObjList^.List^[I].Chunk, N_TRI_OBJECT); - - // if a mesh chunk is found - if Assigned(Current) then - begin - // increment the running total - Inc(Count); - // if this is the (index)th mesh, fill out the structure - if (Count - 1) = Index then - begin - Result := GetMeshEntryChunk(Source, DB.ObjList^.List^[I].Chunk); - Break; - end; - end; - end; -end; - -//----------------- spot and omni light handling ---------------------------------------------------------------------- - -function GetOmnilightCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; - -var - DLite, SpotL: PChunk3DS; - I: integer; - -begin - // update the index to named objects if the list has changed recently - UpdateNamedObjectList(Source, DB); - - Result := 0; - if DB.ObjList = nil then - Exit; - - // scan through the list of named objects looking for lights - for I := 0 to DB.ObjList^.Count - 1 do - begin - // search each object for a Light chunk - DLite := FindChunk(DB.ObjList^.List^[I].chunk, N_DIRECT_LIGHT); - - // if one was found, check to see if its a spotlight - if Assigned(DLite) then - begin - SpotL := FindChunk(DLite, DL_SPOTLIGHT); - // if it isn't a spotlight then increment the count - if SpotL = nil then - Inc(Result); - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetSpotlightCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; - -var - DLite, SpotL: PChunk3DS; - I: integer; - -begin - // update the index to named objects if the list has changed recently - UpdateNamedObjectList(Source, DB); - - Result := 0; - if DB.ObjList = nil then - Exit; - - // scan through the list of named objects looking for lights - for I := 0 to DB.ObjList^.Count - 1 do - begin - // search each object for a Light chunk - DLite := FindChunk(DB.ObjList^.List^[I].Chunk, N_DIRECT_LIGHT); - - // if one was found, check to see if its a spotlight - if Assigned(DLite) then - begin - SpotL := FindChunk(DLite, DL_SPOTLIGHT); - // if it is a spotlight then increment the count - if Assigned(SpotL) then - Inc(Result); - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure InitLight(var Light: TLight3DS); - -// Initializes the Light structure - -begin - FillChar(Light, SizeOf(Light), 0); - with Light do - begin - NameStr := ''; - Color.R := 0.708852; - Color.G := 0.708852; - Color.B := 0.708852; - Multiplier := 1; - Attenuation.Inner := 10; - Attenuation.Outer := 100; - Exclude := TStringList.Create; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ReleaseLight(Light: PLight3DS); - -begin - Light^.Exclude.Free; - Light^.Exclude := nil; - if Assigned(Light^.Spot) then - begin - Light^.Spot^.Projector.BitmapStr := ''; - FreeMem(Light^.Spot); - end; - Dispose(Light); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure InitSpotLight(var SpotLight: TLight3DS); - -begin - // do the common Light initialization - InitLight(SpotLight); - SpotLight.Spot := AllocMem(SizeOf(TSpotLight3DS)); - - with SpotLight.Spot^ do - begin - Target.X := 1; - Target.Y := 1; - Target.Z := 1; - Hotspot := 44; - Falloff := 45; - Aspect := 1; - - Shadows.AType := ssUseShadowMap; - Shadows.Bias := 1; - Shadows.Filter := 3; - Shadows.Mapsize := 512; - Shadows.RayBias := 1; - - Cone.AType := csCircular; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetLightEntryChunk(const Source: TFile3DS; Chunk: PChunk3DS): TLight3DS; - - // fills out the given Light structure with the Light pointed to by Chunk - -var - DLite, SpotChunk, Current: PChunk3DS; - -begin - DLite := FindNextChunk(Chunk^.Children, N_DIRECT_LIGHT); - if DLite = nil then - ShowError(strError3DS_WRONG_OBJECT); - - DLite := FindChunk(Chunk^.Children, N_DIRECT_LIGHT); - SpotChunk := FindChunk(Chunk, DL_SPOTLIGHT); - - if Assigned(DLite) then - with Result do - begin - // initilize Light - if SpotChunk = nil then - InitLight(Result) - else - InitSpotLight(Result); - - // read object name - Source.ReadChunkData(Chunk); - NameStr := StrPas(Chunk^.Data.NamedObject); - FreeChunkData(Chunk); - - // read Light postion - Source.ReadChunkData(DLite); - Pos := DLite^.Data.NDirectLight^; - - // scan all the chunks the Light contains - Current := DLite^.Children; - while Assigned(Current) do - begin - case Current^.Tag of - COLOR_F: - begin - Source.ReadChunkData(Current); - Color.R := Current^.Data.ColorF^.Red; - Color.G := Current^.Data.ColorF^.Green; - Color.B := Current^.Data.ColorF^.Blue; - FreeChunkData(Current); - end; - COLOR_24: - begin - Source.ReadChunkData(Current); - Color.R := Current^.Data.Color24^.Red / 255; - Color.G := Current^.Data.Color24^.Green / 255; - Color.B := Current^.Data.Color24^.Blue / 255; - FreeChunkData(Current); - end; - DL_MULTIPLIER: - begin - Source.ReadChunkData(Current); - Multiplier := Current^.Data.DlMultiplier^; - FreeChunkData(Current); - end; - DL_INNER_RANGE: - begin - Source.ReadChunkData(Current); - // assuming since there is a value it is on - Attenuation.Inner := Current^.Data.DlInnerRange^; - FreeChunkData(Current); - end; - DL_OUTER_RANGE: - begin - Source.ReadChunkData(Current); - // assuming since there is a value it is on - Attenuation.Outer := Current^.Data.DlOuterRange^; - FreeChunkData(Current); - end; - DL_EXCLUDE: - begin - Source.ReadChunkData(Current); - Exclude.Add(string(Current^.Data.DlExclude^)); - FreeChunkData(Current); - end; - DL_OFF: - DLOff := True; - DL_ATTENUATE: - Attenuation.IsOn := True; - end; - Current := Current^.Sibling; - end; - - // DL_SPOTLIGHT chunk - if Assigned(SpotChunk) then - begin - // read spotlight data - Source.ReadChunkData(SpotChunk); - Spot^.Target := SpotChunk^.Data.DlSpotlight^.SpotLightTarg; - Spot^.Hotspot := SpotChunk^.Data.DlSpotlight^.HotspotAngle; - Spot^.Falloff := SpotChunk^.Data.DlSpotlight^.FalloffAngle; - - // scan all the chunks the spotlight contains - Current := SpotChunk^.Children; - while Assigned(Current) do - begin - case Current^.Tag of - DL_SPOT_ROLL: - begin - Source.ReadChunkData(Current); - Spot^.Roll := Current^.Data.DlSpotRoll^; - FreeChunkData(Current); - end; - DL_LOCAL_SHADOW: - Spot^.Shadows.Cast := True; - DL_LOCAL_SHADOW2: - begin - Source.ReadChunkData(Current); - Spot^.Shadows.Bias := Current^.Data.DlLocalShadow2^.LocalShadowBias; - Spot^.Shadows.Filter := Current^.Data.DlLocalShadow2^.LocalShadowFilter; - Spot^.Shadows.Mapsize := - Current^.Data.DlLocalShadow2^.LocalShadowMapSize; - Spot^.Shadows.Local := True; - FreeChunkData(Current); - end; - DL_SHADOWED: - Spot^.Shadows.Cast := True; - DL_SPOT_RECTANGULAR: - Spot^.Cone.AType := csRectangular; - DL_SEE_CONE: - Spot^.Cone.Show := True; - DL_SPOT_OVERSHOOT: - Spot^.Cone.Overshoot := True; - DL_SPOT_ASPECT: - begin - Source.ReadChunkData(Current); - Spot^.Aspect := Current^.Data.DlSpotAspect^; - FreeChunkData(Current); - end; - DL_RAY_BIAS: - begin - Source.ReadChunkData(Current); - Spot^.Shadows.RayBias := Current^.Data.DlRayBias^; - FreeChunkData(Current); - end; - DL_RAYSHAD: - Spot^.Shadows.AType := ssUseRayTraceShadow; - DL_SPOT_PROJECTOR: - begin - Source.ReadChunkData(Current); - Spot^.Projector.BitmapStr := - string(StrPas(Current^.Data.DlSpotProjector)); - Spot^.Projector.Use := True; - FreeChunkData(Current); - end; - end; - Current := Current^.Sibling; - end; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetOmnilightByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: integer): TLight3DS; - - // fills out the omnilight structure from the (index)th mesh reference found in DB - -var - LightChunk, SpotChunk: PChunk3DS; - I, Count: integer; - -begin - FillChar(Result, SizeOf(Result), 0); - - if (DB.TopChunk = nil) then - ShowError(strError3DS_INVALID_DATABASE); - if not (DB.TopChunk^.Tag = M3DMAGIC) and not (DB.TopChunk^.Tag = CMAGIC) then - ShowError(strError3DS_WRONG_DATABASE); - - // update the list if it's changed recently - UpdateNamedObjectList(Source, DB); - - // Scan through the List - Count := 0; - for I := 0 to DB.ObjList^.Count - 1 do - begin - // search for a Light chunk - LightChunk := FindChunk(DB.ObjList^.List^[I].Chunk, N_DIRECT_LIGHT); - - // if one was found check to see if its a spot - if Assigned(LightChunk) then - begin - SpotChunk := FindChunk(LightChunk, DL_SPOTLIGHT); - // if its not a spot then increment the count - if SpotChunk = nil then - begin - Inc(Count); - // if this is the (index)th Light file out the structure - if (Count - 1) = Index then - begin - Result := GetLightEntryChunk(Source, DB.ObjList^.List^[I].Chunk); - Break; - end; - end; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetSpotlightByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: integer): TLight3DS; - - // fills out the Spot structure from the (index)th spot reference found in DB - -var - LightChunk, SpotChunk: PChunk3DS; - I, Count: integer; - -begin - FillChar(Result, SizeOf(Result), 0); - - if (DB.TopChunk = nil) then - ShowError(strError3DS_INVALID_DATABASE); - if not (DB.TopChunk^.Tag = M3DMAGIC) and not (DB.TopChunk^.Tag = CMAGIC) then - ShowError(strError3DS_WRONG_DATABASE); - - // update the list if it's changed recently - UpdateNamedObjectList(Source, DB); - - // Scan through the List - Count := 0; - for I := 0 to DB.ObjList^.Count - 1 do - begin - // search for a Light chunk - LightChunk := FindChunk(DB.ObjList^.List^[I].Chunk, N_DIRECT_LIGHT); - - // if one was found check to see if its a spot - if Assigned(LightChunk) then - begin - SpotChunk := FindChunk(LightChunk, DL_SPOTLIGHT); - // if its not a spot then increment the count - if Assigned(SpotChunk) then - begin - Inc(Count); - // if this is the (index)th Light file out the structure - if (Count - 1) = Index then - begin - Result := GetLightEntryChunk(Source, DB.ObjList^.List^[I].Chunk); - Break; - end; - end; - end; - end; -end; - -//----------------- camera handling ----------------------------------------------------------------------------------- - -procedure InitCamera(var Camera: TCamera3DS); - -begin - FillChar(Camera, SizeOf(Camera), 0); - with Camera do - begin - Target.X := 1; - Target.Y := 1; - Target.Z := 1; - FOV := 45; - Ranges.CamNear := 10; - Ranges.CamFar := 1000; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ReleaseCamera(Camera: PCamera3DS); - -begin - if Assigned(Camera) then - begin - Dispose(Camera); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetCameraCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; - -var - Chunk: PChunk3DS; - I: integer; - -begin - UpdateNamedObjectList(Source, DB); - Result := 0; - if Assigned(DB.ObjList) then - for I := 0 to DB.ObjList^.Count - 1 do - begin - Chunk := FindChunk(DB.ObjList^.List^[I].Chunk, N_CAMERA); - if Assigned(Chunk) then - Inc(Result); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetCameraEntry(const Source: TFile3DS; Chunk: PChunk3DS): TCamera3DS; - -var - Current, Camera: PChunk3DS; - -begin - if Chunk^.Tag <> NAMED_OBJECT then - ShowError(strError3DS_WRONG_OBJECT); - - Camera := FindNextChunk(Chunk^.Children, N_CAMERA); - if Camera = nil then - ShowError(strError3DS_WRONG_OBJECT); - - with Result do - begin - InitCamera(Result); - Camera := FindNextChunk(Chunk^.Children, N_CAMERA); - - Source.ReadChunkData(Chunk); - NameStr := StrPas(Chunk^.Data.NamedObject); - FreeChunkData(Chunk); - - Source.ReadChunkData(Camera); - Position.X := Camera^.Data.NCamera^.CameraPos.X; - Position.Y := Camera^.Data.NCamera^.CameraPos.Y; - Position.Z := Camera^.Data.NCamera^.CameraPos.Z; - Target.X := Camera^.Data.NCamera^.TargetPos.X; - Target.Y := Camera^.Data.NCamera^.TargetPos.Y; - Target.Z := Camera^.Data.NCamera^.TargetPos.Z; - Roll := Camera^.Data.NCamera^.CameraBank; - FOV := 2400 / Camera^.Data.NCamera^.CameraFocalLength; - FreeChunkData(Camera); - - Current := Camera^.Children; - while Assigned(Current) do - begin - case Current^.Tag of - CAM_SEE_CONE: - ShowCone := True; - CAM_RANGES: - begin - Source.ReadChunkData(Current); - Ranges.CamNear := Current^.Data.CamRanges^.NearPlane; - Ranges.CamFar := Current^.Data.CamRanges^.FarPlane; - FreeChunkData(Current); - end; - end; - Current := Current^.Sibling; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetCameraByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: integer): TCamera3DS; - -var - Camera: PChunk3DS; - I, Count: integer; - -begin - FillChar(Result, SizeOf(Result), 0); - - UpdateNamedObjectList(Source, DB); - - Count := 0; - for I := 0 to DB.ObjList^.Count - 1 do - begin - Camera := FindChunk(DB.ObjList^.List^[I].Chunk, N_CAMERA); - if Assigned(Camera) then - begin - Inc(Count); - if (Count - 1) = Index then - Result := GetCameraEntry(Source, DB.ObjList^.List^[I].Chunk); - end; - end; -end; - -//----------------- common animation settings ------------------------------------------------------------------------- - -procedure InitKfSets(var Key: TKFSets3DS); - -begin - Key.Anim.Length := 30; - Key.Anim.CurFrame := 0; - Key.Seg.Use := False; - Key.Seg.SegBegin := 0; - Key.Seg.SegEnd := 30; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetKFSeg(TopChunk: PChunk3DS): PChunk3DS; - - // all the keyframe information has to go in the appropriate segment KFDATA - -begin - // look for KFDATA - Result := FindNextChunk(TopChunk^.Children, KFDATA); - if Result = nil then - Result := PutGenericNode(KFDATA, TopChunk); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetKeyInfo(const Source: TFile3DS; var DB: TDatabase3DS): TKFKeyInfo3DS; - -var - KFData, KFHdrChunk, KFCTChunk: PChunk3DS; - -begin - KFData := GetKfSeg(DB.TopChunk); - KFHdrChunk := FindNextChunk(KFData^.Children, KFHDR); - - if Assigned(KFHdrChunk) then - begin - Source.ReadChunkData(KFHdrChunk); - Result.Length := KFHdrChunk^.Data.KFHdr^.AnimLength; - FreeChunkData(KFHdrChunk); - end; - - KFCTChunk := FindNextChunk(KFData^.Children, KFCURTIME); - - if Assigned(KFCTChunk) then - begin - Source.ReadChunkData(KFCTChunk); - Result.CurFrame := KFCTChunk^.Data.KFCurTime^; - FreeChunkData(KFCTChunk); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetKFSegment(const Source: TFile3DS; var DB: TDatabase3DS): TKFSegment3DS; -var - DataChunk, SegChunk: PChunk3DS; -begin - Result.SegBegin := 0; - Result.SegEnd := 0; - Result.Use := False; - - DataChunk := GetKFSeg(DB.TopChunk); - SegChunk := FindNextChunk(DataChunk^.Children, KFSEG); - - if Assigned(SegChunk) then - begin - Source.ReadChunkData(SegChunk); - Result.Use := True; - Result.SegBegin := SegChunk^.Data.KFSeg^.First; - Result.SegEnd := SegChunk^.Data.KFSeg^.Last; - FreeChunkData(SegChunk); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetKFSettings(const Source: TFile3DS; var DB: TDatabase3DS): TKFSets3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - - if DB.TopChunk = nil then - ShowError(strError3DS_INVALID_DATABASE); - if (DB.TopChunk^.Tag <> M3DMAGIC) and (DB.TopChunk^.Tag <> CMAGIC) then - ShowError(strError3DS_WRONG_DATABASE); - - InitKFSets(Result); - Result.Anim := GetKeyInfo(Source, DB); - Result.Seg := GetKFSegment(Source, DB); -end; - -//----------------- Camera animation ---------------------------------------------------------------------------------- - -procedure InitCameraMotion(var Camera: TKFCamera3DS; - NewNPKeys, NewNFKeys, NewNRKeys, NewNTKeys: cardinal); - -var - I: integer; - -begin - with Camera do - begin - // free any previously allocated memory first - if Assigned(PKeys) then - FreeMem(PKeys); - if Assigned(Pos) then - FreeMem(Pos); - if Assigned(FKeys) then - FreeMem(FKeys); - if Assigned(FOV) then - FreeMem(FOV); - if Assigned(RKeys) then - FreeMem(RKeys); - if Assigned(Roll) then - FreeMem(Roll); - if Assigned(TKeys) then - FreeMem(TKeys); - if Assigned(TPos) then - FreeMem(TPos); - - FillChar(Camera, SizeOf(TKFCamera3DS), 0); - NPKeys := NewNPKeys; - NFKeys := NewNFKeys; - NRKeys := NewNRKeys; - NTKeys := NewNTKeys; - - if NPKeys <> 0 then - begin - NPFlag := TrackSingle3DS; - - PKeys := AllocMem(NPKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NPKeys - 1 do - PKeys^[I] := DefKeyHeader3DS; - - Pos := AllocMem(NPKeys * SizeOf(TPoint3DS)); - for I := 0 to NPKeys - 1 do - Pos^[I] := DefPoint3DS; - end; - - if NFKeys <> 0 then - begin - NFFlag := TrackSingle3DS; - - FKeys := AllocMem(NFKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NFKeys - 1 do - FKeys^[I] := DefKeyHeader3DS; - - FOV := AllocMem(NFKeys * SizeOf(single)); - for I := 0 to NFKeys - 1 do - FOV^[I] := 60; - end; - - if NRKeys <> 0 then - begin - NRFlag := TrackSingle3DS; - - RKeys := AllocMem(NRKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NRKeys - 1 do - RKeys^[I] := DefKeyHeader3DS; - - Roll := AllocMem(NRKeys * SizeOf(single)); - end; - - if NTKeys <> 0 then - begin - NTFlag := TrackSingle3DS; - TFlags1 := 0; - TFlags2 := 0; - - TKeys := AllocMem(NTKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NTKeys - 1 do - TKeys^[I] := DefKeyHeader3DS; - - TPos := AllocMem(NTKeys * SizeOf(TPoint3DS)); - for I := 0 to NTKeys - 1 do - TPos^[I] := DefPoint3DS; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ReleaseCameraMotion(Camera: PKFCamera3DS); - -begin - if Assigned(Camera) then - begin - with Camera^ do - begin - if Assigned(PKeys) then - FreeMem(PKeys); - if Assigned(Pos) then - FreeMem(Pos); - if Assigned(FKeys) then - FreeMem(FKeys); - if Assigned(FOV) then - FreeMem(FOV); - if Assigned(RKeys) then - FreeMem(RKeys); - if Assigned(Roll) then - FreeMem(Roll); - if Assigned(TKeys) then - FreeMem(TKeys); - if Assigned(TPos) then - FreeMem(TPos); - end; - Dispose(Camera); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure GetCameraNodeNameList(const Source: TFile3DS; var DB: TDatabase3DS; - List: TStringList); - -begin - GetGenericNodeNameList(Source, DB, CAMERA_NODE_TAG, List); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetCameraNodeCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; - -begin - Result := GetGenericNodeCount(Source, DB, CAMERA_NODE_TAG); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetParentName(const Source: TFile3DS; Chunk: PChunk3DS): string; - - // get parent name if there is one - -var - NameChunk: PChunk3DS; - -begin - Result := ''; - NameChunk := FindChunk(Chunk, PARENT_NAME); - if Assigned(NameChunk) then - begin - Source.ReadChunkData(NameChunk); - Result := string(NameChunk^.Data.NamedObject); - FreeChunkData(NameChunk); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetCameraMotion(const Source: TFile3DS; - CamChunk, TargetChunk: PChunk3DS): TKFCamera3DS; - - // gets camera keyframe information from chunk - // CamChunk : CAMERA_NODE_TAG chunk to extract data from - // TargetChunk : TARGET_NODE_TAG chunk to extract target data from - // KFCamera : Structure to fill in with chunk data - -var - NodeHdrChunk, PosChunk, FovChunk, RollChunk, TargetPosChunk, - TargetHdrChunk: PChunk3DS; - PosKeys, FovKeys, RollKeys, TargetKeys: integer; - -begin - FillChar(Result, SizeOf(Result), 0); - - TargetPosChunk := nil; - TargetHdrChunk := nil; - PosKeys := 0; - FovKeys := 0; - RollKeys := 0; - TargetKeys := 0; - - // get information from chunks - // search children of camera Chunk - NodeHdrChunk := FindChunk(CamChunk, NODE_HDR); - PosChunk := FindChunk(CamChunk, POS_TRACK_TAG); - FovChunk := FindChunk(CamChunk, FOV_TRACK_TAG); - RollChunk := FindChunk(CamChunk, ROLL_TRACK_TAG); - - Source.ReadChunkData(NodeHdrChunk); - - if Assigned(PosChunk) then - begin - Source.ReadChunkData(PosChunk); - PosKeys := PosChunk^.Data.PosTrackTag^.TrackHdr.KeyCount; - end; - - if Assigned(FOVChunk) then - begin - Source.ReadChunkData(FOVChunk); - FovKeys := FOVChunk^.Data.FOVTrackTag^.TrackHdr.KeyCount; - end; - - if Assigned(RollChunk) then - begin - Source.ReadChunkData(RollChunk); - RollKeys := RollChunk^.Data.RollTrackTag^.TrackHdr.KeyCount; - end; - - if Assigned(TargetChunk) then - begin - TargetHdrChunk := FindChunk(TargetChunk, NODE_HDR); - if Assigned(TargetHdrChunk) then - Source.ReadChunkData(TargetHdrChunk); - - TargetPosChunk := FindChunk(TargetChunk, POS_TRACK_TAG); - if Assigned(TargetPosChunk) then - begin - Source.ReadChunkData(TargetPosChunk); - TargetKeys := TargetPosChunk^.Data.PosTrackTag^.TrackHdr.KeyCount; - end; - end; - - // set-up and fill-in the kfcamera structure - InitCameraMotion(Result, PosKeys, FOVKeys, RollKeys, TargetKeys); - with Result do - begin - // header Information - if Assigned(NodeHdrChunk) then - begin - NameStr := ansistring(NodeHdrChunk^.Data.NodeHdr^.ObjNameStr); - Flags1 := NodeHdrChunk^.Data.NodeHdr^.Flags1; - Flags2 := NodeHdrChunk^.Data.NodeHdr^.Flags2; - end; - // parents - ParentStr := ansistring(GetParentName(Source, NodeHdrChunk)); - TParentStr := GetParentName(Source, TargetHdrChunk); - - // target information - if TargetKeys <> 0 then - begin - NTFlag := TargetPosChunk^.Data.PosTrackTag^.TrackHdr.Flags; - Move(TargetPosChunk^.Data.PosTrackTag^.KeyHdrList^, TKeys^, - TargetKeys * SizeOf(TKeyHeader3DS)); - Move(TargetPosChunk^.Data.PosTrackTag^.PositionList^, TPos^, - TargetKeys * SizeOf(TPoint3DS)); - end; - if Assigned(TargetHdrChunk) then - begin - TFlags1 := TargetHdrChunk^.Data.NodeHdr^.Flags1; - TFlags2 := TargetHdrChunk^.Data.NodeHdr^.Flags2; - end; - - // position information - if PosKeys <> 0 then - begin - NPFlag := PosChunk^.Data.PosTrackTag^.TrackHdr.Flags; - Move(PosChunk^.Data.PosTrackTag^.KeyHdrList^, PKeys^, PosKeys * - SizeOf(TKeyHeader3DS)); - Move(PosChunk^.Data.PosTrackTag^.PositionList^, Pos^, PosKeys * SizeOf(TPoint3DS)); - end; - - // field of view information - if FOVKeys <> 0 then - begin - NFFlag := FOVChunk^.Data.FOVTrackTag^.TrackHdr.Flags; - Move(FOVChunk^.Data.FOVTrackTag^.KeyHdrList^, FKeys^, FOVKeys * - SizeOf(TKeyHeader3DS)); - Move(FOVChunk^.Data.FOVTrackTag^.FOVAngleList^, FOV^, FOVKeys * SizeOf(single)); - end; - - // roll track information - if RollKeys <> 0 then - begin - NRFlag := RollChunk^.Data.RollTrackTag^.TrackHdr.Flags; - Move(RollChunk^.Data.RollTrackTag^.KeyHdrList^, RKeys^, RollKeys * - SizeOf(TKeyHeader3DS)); - Move(RollChunk^.Data.RollTrackTag^.RollangleList^, Roll^, - RollKeys * SizeOf(single)); - end; - - // free chunk data - if Assigned(PosChunk) then - FreeChunkData(PosChunk); - if Assigned(FovChunk) then - FreeChunkData(FovChunk); - if Assigned(RollChunk) then - FreeChunkData(RollChunk); - if Assigned(NodeHdrChunk) then - FreeChunkData(NodeHdrChunk); - if Assigned(TargetPosChunk) then - FreeChunkData(TargetPosChunk); - if Assigned(TargetHdrChunk) then - FreeChunkData(TargetHdrChunk); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetCameraMotionByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: integer): TKFCamera3DS; - -var - CameraChunk, TargetChunk: PChunk3DS; - List: TStringList; - -begin - FillChar(Result, SizeOf(Result), 0); - - List := TStringList.Create; - try - GetCameraNodeNameList(Source, DB, List); - if Index < List.Count then - begin - CameraChunk := FindNamedAndTaggedChunk(Source, DB, List[Index], CAMERA_NODE_TAG); - if Assigned(CameraChunk) then - begin - TargetChunk := FindNamedAndTaggedChunk(Source, DB, List[Index], TARGET_NODE_TAG); - Result := GetCameraMotion(Source, CameraChunk, TargetChunk); - end; - end; - finally - List.Free; - end; -end; - -//----------------- Ambient Light animation --------------------------------------------------------------------------- - -procedure InitAmbientLightMotion(var Light: TKFAmbient3DS; NewNCKeys: cardinal); - -var - I: integer; - -begin - with Light do - begin - if Assigned(Color) then - FreeMem(Color); - if Assigned(CKeys) then - FreeMem(CKeys); - FillChar(Light, SizeOf(Light), 0); - NCKeys := NewNCKeys; - - if NCKeys <> 0 then - begin - NCFlag := TrackSingle3DS; - CKeys := AllocMem(NCKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NCKeys - 1 do - CKeys^[I] := DefKeyHeader3DS; - - Color := AllocMem(NCKeys * SizeOf(TFColor3DS)); - for I := 0 to NCKeys - 1 do - begin - Color^[I].R := 1; - Color^[I].G := 1; - Color^[I].B := 1; - end; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ReleaseAmbientLightMotion(Light: PKFAmbient3DS); - -begin - if Assigned(Light) then - begin - with Light^ do - begin - if Assigned(CKeys) then - FreeMem(CKeys); - if Assigned(Color) then - FreeMem(Color); - end; - Dispose(Light); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetAmbientLightMotionChunk(const Source: TFile3DS; - AmbientChunk: PChunk3DS): TKFAmbient3DS; - - // AmbientChunk : SPOTAMBIENT_NODE_TAG chunk to extract data from - // TargetChunk : L_TARGET_NODE_TAG chunk to extract target data from - // KFSpot : Structure to fill in with chunk data - - // Gets AmbientLight keyframe information from chunk - // L_TARGET - // ... - // NODE_HDR - // APP_DATA - // COL_TRACK - -var - NodeHdrChunk, ColChunk: PChunk3DS; - ColKeys: integer; - -begin - if AmbientChunk = nil then - ShowError(strERROR3DS_INVALID_ARG); - FillChar(Result, SizeOf(Result), 0); - - // get information from chunks - // search children of AmbientLight chunk - NodeHdrChunk := FindChunk(AmbientChunk, NODE_HDR); - ColChunk := FindChunk(AmbientChunk, COL_TRACK_TAG); - - if Assigned(NodeHdrChunk) then - Source.ReadChunkData(NodeHdrChunk); - if Assigned(ColChunk) then - begin - Source.ReadChunkData(ColChunk); - ColKeys := ColChunk^.Data.ColTrackTag^.TrackHdr.KeyCount; - end - else - ColKeys := 0; - - // eat-up and fill-in the PKFAmbient3DS structure - InitAmbientLightMotion(Result, ColKeys); - - // header information - if Assigned(NodeHdrChunk) then - begin - Result.Flags1 := NodeHdrChunk^.Data.NodeHdr^.Flags1; - Result.Flags2 := NodeHdrChunk^.Data.NodeHdr^.Flags2; - end; - - // color information - if Assigned(ColChunk) then - begin - if ColKeys <> 0 then - begin - Result.NCFlag := ColChunk^.Data.ColTrackTag^.TrackHdr.Flags; - Move(ColChunk^.Data.ColTrackTag^.KeyHdrList^, Result.CKeys^, - ColKeys * SizeOf(TKeyHeader3DS)); - Move(ColChunk^.Data.ColTrackTag^.ColorList^, Result.Color^, - ColKeys * SizeOf(TFColor3DS)); - end; - end; - - // free chunk data - if Assigned(NodeHdrChunk) then - FreeChunkData(NodeHdrChunk); - if Assigned(ColChunk) then - FreeChunkData(ColChunk); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetAmbientLightMotion(const Source: TFile3DS; - var DB: TDatabase3DS): TKFAmbient3DS; - - // Ambient Light a special case: only one ambient node per keyframe data Chunk^. - -var - KFChunk, Chunk: PChunk3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - // find keyframe chunk - KFChunk := FindChunk(DB.TopChunk, KFDATA); - if Assigned(KFChunk) then - begin - Chunk := FindChunk(KFChunk, AMBIENT_NODE_TAG); - if Assigned(Chunk) then - Result := GetAmbientLightMotionChunk(Source, Chunk); - end; -end; - -//----------------- Mesh object animation ----------------------------------------------------------------------------- - -procedure InitObjectMotion(var Obj: TKFMesh3DS; NewNPKeys, // Number of position keys - NewNRKeys, // Number of rot keys - NewNSKeys, // Number of scale keys - NewNMKeys, // Number of morph keys - NewNHKeys: cardinal); // Number of hide keys -var - I: integer; - -begin - with Obj do - begin - if Assigned(PKeys) then - FreeMem(PKeys); - if Assigned(Pos) then - FreeMem(Pos); - if Assigned(RKeys) then - FreeMem(RKeys); - if Assigned(Rot) then - FreeMem(Rot); - if Assigned(SKeys) then - FreeMem(SKeys); - if Assigned(Scale) then - FreeMem(Scale); - if Assigned(MKeys) then - FreeMem(MKeys); - if Assigned(Morph) then - FreeMem(Morph); - if Assigned(HKeys) then - FreeMem(HKeys); - - FillChar(Obj, SizeOf(Obj), 0); - Pivot := DefPoint3DS; - BoundMin := DefPoint3DS; - BoundMax := DefPoint3DS; - - NPKeys := NewNPKeys; - NRKeys := NewNRKeys; - NSKeys := NewNSKeys; - NMKeys := NewNMKeys; - NHKeys := NewNHKeys; - - MSAngle := 24; - - if NPKeys <> 0 then - begin - NPFlag := TrackSingle3DS; - - PKeys := AllocMem(NPKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NPKeys - 1 do - PKeys^[I] := DefKeyHeader3DS; - - Pos := AllocMem(NPKeys * SizeOf(TPoint3DS)); - for I := 0 to NPKeys - 1 do - Pos^[I] := DefPoint3DS; - end; - - if NRKeys <> 0 then - begin - NRFlag := TrackSingle3DS; - - RKeys := AllocMem(NRKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NRKeys - 1 do - RKeys^[I] := DefKeyHeader3DS; - - Rot := AllocMem(NRKeys * SizeOf(TKFRotKey3DS)); - for I := 0 to NRKeys - 1 do - Rot^[I] := DefKfRotKey3DS; - end; - - if NSKeys <> 0 then - begin - NSFlag := TrackSingle3DS; - - SKeys := AllocMem(NSKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NSKeys - 1 do - SKeys^[I] := DefKeyHeader3DS; - - Scale := AllocMem(NSKeys * SizeOf(TPoint3DS)); - for I := 0 to NSKeys - 1 do - begin - Scale^[I].X := 1; - Scale^[I].Y := 1; - Scale^[I].Z := 1; - end; - end; - - if NMKeys <> 0 then - begin - NMFlag := TrackSingle3DS; - - MKeys := AllocMem(NMKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NMKeys - 1 do - MKeys^[I] := DefKeyHeader3DS; - - Morph := AllocMem(NMKeys * SizeOf(TKFMorphKey3DS)); - for I := 0 to NMKeys - 1 do - Morph^[I] := ' '; - end; - - if NHKeys <> 0 then - begin - NHFlag := TrackSingle3DS; - - HKeys := AllocMem(NHKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NMKeys - 1 do - MKeys^[I] := DefKeyHeader3DS; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ReleaseObjectMotion(Obj: PKFMesh3DS); - -begin - if Assigned(Obj) then - begin - with Obj^ do - begin - if Assigned(PKeys) then - FreeMem(PKeys); - if Assigned(Pos) then - FreeMem(Pos); - if Assigned(RKeys) then - FreeMem(RKeys); - if Assigned(Rot) then - FreeMem(Rot); - if Assigned(SKeys) then - FreeMem(SKeys); - if Assigned(Scale) then - FreeMem(Scale); - if Assigned(MKeys) then - FreeMem(MKeys); - if Assigned(Morph) then - FreeMem(Morph); - if Assigned(HKeys) then - FreeMem(HKeys); - end; - Dispose(Obj); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetObjectNodeCount(const Source: TFile3DS; var DB: TDatabase3DS): integer; - -begin - Result := GetGenericNodeCount(Source, DB, OBJECT_NODE_TAG); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure GetObjectNodeNameList(const Source: TFile3DS; var DB: TDatabase3DS; - List: TStringList); - -begin - GetGenericNodeNameList(Source, DB, OBJECT_NODE_TAG, List); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetObjectMotion(const Source: TFile3DS; MeshChunk: PChunk3DS): TKFMesh3DS; - - // Gets mesh keyframe information from chunk - - // NODE_ID - // NODE_HDR - // APP_DATA - // INSTANCE_NAME - // PRESCALE a no-op in 3DS code - // POS_TRACK - // ROT_TRACK - // SCL_TRACK - // MORPH_TRACK - // MORPH_SMOOTH - // HIDE_TRACK - - // This function is really confusing, because instead of loading the MeshChunk and its children, reading the - // data out and freeing it, the chunk structure is copied, its data is moved to the copy (so MeshChunk is then without - // any data), the copy is parsed and then it is freed. I don't know why this is so, but I don't want to change - // the way it works in case this has (or will later have) side effects I don't see yet. ml - -var - NodeHdrChunk, InstChunk, PivotChunk, BboxChunk, MsChunk, - PosChunk, RotChunk, ScaleChunk, MorphChunk, HideChunk, - ObjTag: PChunk3DS; - - PosKeys, RotKeys, ScaleKeys, MorphKeys, HideKeys: integer; - - PivotData: PPivot; - InstData: PInstanceName; - BBoxData: PBoundBox; - MsData: PMorphSmooth; - PosData: PPosTrackTag; - RotData: PRotTrackTag; - ScaleData: PScaleTrackTag; - MorphData: PMorphTrackTag; - HideData: PHideTrackTag; - -begin - PosKeys := 0; - RotKeys := 0; - ScaleKeys := 0; - MorphKeys := 0; - HideKeys := 0; - PivotData := nil; - InstData := nil; - BboxData := nil; - MsData := nil; - PosData := nil; - RotData := nil; - ScaleData := nil; - MorphData := nil; - HideData := nil; - - if MeshChunk^.Tag <> OBJECT_NODE_TAG then - ShowError(strERROR3DS_WRONG_OBJECT); - - ObjTag := CopyChunk(MeshChunk); - - // get information from chunks - // search children of MeshLight chunk - NodeHdrChunk := FindChunk(ObjTag, NODE_HDR); - InstChunk := FindChunk(ObjTag, INSTANCE_NAME); - PivotChunk := FindChunk(ObjTag, PIVOT); - BboxChunk := FindChunk(ObjTag, BOUNDBOX); - MsChunk := FindChunk(ObjTag, MORPH_SMOOTH); - PosChunk := FindChunk(ObjTag, POS_TRACK_TAG); - RotChunk := FindChunk(ObjTag, ROT_TRACK_TAG); - ScaleChunk := FindChunk(ObjTag, SCL_TRACK_TAG); - MorphChunk := FindChunk(ObjTag, MORPH_TRACK_TAG); - HideChunk := FindChunk(ObjTag, HIDE_TRACK_TAG); - - Source.ReadChunkData(NodeHdrChunk); - - if Assigned(InstChunk) then - begin - Source.ReadChunkData(InstChunk); - InstData := InstChunk^.Data.Dummy; - InstChunk^.Data.Dummy := nil; - end; - - if Assigned(PivotChunk) then - begin - Source.ReadChunkData(PivotChunk); - PivotData := PivotChunk^.Data.Dummy; - PivotChunk^.Data.Dummy := nil; - end; - - if Assigned(BboxChunk) then - begin - Source.ReadChunkData(BboxChunk); - BboxData := BboxChunk^.Data.Dummy; - BboxChunk^.Data.Dummy := nil; - end; - - if Assigned(MsChunk) then - begin - Source.ReadChunkData(MsChunk); - MsData := MsChunk^.Data.Dummy; - MsChunk^.Data.Dummy := nil; - end; - - if Assigned(PosChunk) then - begin - Source.ReadChunkData(PosChunk); - PosData := PosChunk^.Data.Dummy; - PosKeys := PosData^.TrackHdr.KeyCount; - PosChunk^.Data.Dummy := nil; - end; - - if Assigned(RotChunk) then - begin - Source.ReadChunkData(RotChunk); - RotData := RotChunk^.Data.Dummy; - RotKeys := RotData^.TrackHdr.KeyCount; - RotChunk^.Data.Dummy := nil; - end; - - if Assigned(ScaleChunk) then - begin - Source.ReadChunkData(ScaleChunk); - ScaleData := ScaleChunk^.Data.Dummy; - ScaleKeys := ScaleData^.TrackHdr.KeyCount; - ScaleChunk^.Data.Dummy := nil; - end; - - if Assigned(MorphChunk) then - begin - Source.ReadChunkData(MorphChunk); - MorphData := MorphChunk^.Data.Dummy; - MorphKeys := MorphData^.TrackHdr.KeyCount; - MorphChunk^.Data.Dummy := nil; - end; - - if Assigned(HideChunk) then - begin - Source.ReadChunkData(HideChunk); - HideData := HideChunk^.Data.Dummy; - HideKeys := HideData^.TrackHdr.KeyCount; - HideChunk^.Data.Dummy := nil; - end; - - // set-up and fill-in the TKFMesh3DS structure - with Result do - begin - //--- header Information - NameStr := AnsiString(NodeHdrChunk^.Data.NodeHdr^.ObjNameStr); - Flags1 := NodeHdrChunk^.Data.NodeHdr^.Flags1; - Flags2 := NodeHdrChunk^.Data.NodeHdr^.Flags2; - - //--- get parent name if there is one - ParentStr := AnsiString(GetParentName(Source, NodeHdrChunk)); - - //--- Instance - if Assigned(InstData) then - begin - InstanceStr := StrPas(InstData); - NameStr := NameStr + '.' + InstanceStr; - FreeMem(InstData); - end - else - InstanceStr := ''; - - //--- Pivot - if Assigned(PivotData) then - begin - Pivot := PivotData^; - FreeMem(PivotData); - end - else - Pivot := DefPoint3DS; - - //--- Bound - if Assigned(BboxData) then - begin - BoundMin := BboxData^.Min; - BoundMax := BboxData^.Max; - FreeMem(BboxData); - end - else - begin - BoundMin := DefPoint3DS; - BoundMax := DefPoint3DS; - end; - - //--- MorphSmooth Angle - if Assigned(MsData) then - begin - MSAngle := MsData^; - FreeMem(MsData); - end - else - MSAngle := 0; - - //--- Position - NPKeys := PosKeys; - if PosKeys <> 0 then - begin - PKeys := PosData^.KeyHdrList; - Pos := PosData^.PositionList; - NPFlag := PosData^.TrackHdr.Flags; - FreeMem(PosData); - end - else - begin - PKeys := nil; - Pos := nil; - NPFlag := 0; - end; - - //--- Rotation - NRKeys := RotKeys; - if RotKeys <> 0 then - begin - RKeys := RotData^.KeyHdrList; - Rot := RotData^.RotationList; - NRFlag := RotData^.TrackHdr.Flags; - FreeMem(RotData); - end - else - begin - RKeys := nil; - Rot := nil; - NRFlag := 0; - end; - - //--- Scale - NSKeys := ScaleKeys; - if ScaleKeys <> 0 then - begin - SKeys := ScaleData^.KeyHdrList; - Scale := ScaleData^.ScaleList; - NSFlag := ScaleData^.TrackHdr.Flags; - FreeMem(ScaleData); - end - else - begin - SKeys := nil; - Scale := nil; - NSFlag := 0; - end; - - //--- Morph - NMKeys := MorphKeys; - if MorphKeys <> 0 then - begin - MKeys := MorphData^.KeyHdrList; - Morph := MorphData^.MorphList; - NMFlag := MorphData^.TrackHdr.Flags; - FreeMem(MorphData); - end - else - begin - MKeys := nil; - Morph := nil; - NMFlag := 0; - end; - - NHKeys := HideKeys; - if HideKeys <> 0 then - begin - HKeys := HideData^.KeyHdrList; - NHFlag := HideData^.TrackHdr.Flags; - FreeMem(HideData); - end - else - begin - HKeys := nil; - NHFlag := 0; - end; - end; - - //-- ADDITIONAL Morph INFO HERE - - //--- free chunk data: only free those that arent being copied - ReleaseChunk(ObjTag); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetObjectMotionByName(const Source: TFile3DS; var DB: TDatabase3DS; - const Name: string): TKFMesh3DS; - -var - ObjectChunk: PChunk3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - - ObjectChunk := FindNodeTagByNameAndType(Source, DB, Name, OBJECT_NODE_TAG); - if Assigned(ObjectChunk) then - Result := GetObjectMotion(Source, ObjectChunk); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetObjectMotionByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: cardinal): TKFMesh3DS; - -var - Chunk: PChunk3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - - Chunk := FindNodeTagByIndexAndType(Source, DB, Index, OBJECT_NODE_TAG); - if Assigned(Chunk) then - Result := GetObjectMotion(Source, Chunk); -end; - -//----------------- Omni Light animation ------------------------------------------------------------------------------ - -procedure InitOmnilightMotion(var Light: TKFOmni3DS; NewNPKeys, NewNCKeys: cardinal); - -var - I: integer; - -begin - with Light do - begin - if Assigned(PKeys) then - FreeMem(PKeys); - if Assigned(Pos) then - FreeMem(Pos); - if Assigned(CKeys) then - FreeMem(CKeys); - if Assigned(Color) then - FreeMem(Color); - - FillChar(Light, SizeOf(Light), 0); - NPKeys := NewNPKeys; - NCKeys := NewNCKeys; - - if NPKeys <> 0 then - begin - NPFlag := TrackSingle3DS; - - PKeys := AllocMem(NPKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NPKeys - 1 do - PKeys^[I] := DefKeyHeader3DS; - - Pos := AllocMem(NPKeys * SizeOf(TPoint3DS)); - for I := 0 to NPKeys - 1 do - Pos^[I] := DefPoint3DS; - end; - - if NCKeys <> 0 then - begin - NCFlag := TrackSingle3DS; - - CKeys := AllocMem(NCKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NCKeys - 1 do - CKeys^[I] := DefKeyHeader3DS; - - Color := AllocMem(NCKeys * SizeOf(TFColor3DS)); - for I := 0 to NCKeys - 1 do - begin - Color^[I].R := 1; - Color^[I].G := 1; - Color^[I].B := 1; - end; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ReleaseOmnilightMotion(Light: PKFOmni3DS); - -begin - if Assigned(Light) then - begin - with Light^ do - begin - if Assigned(PKeys) then - FreeMem(PKeys); - if Assigned(Pos) then - FreeMem(Pos); - if Assigned(CKeys) then - FreeMem(CKeys); - if Assigned(Color) then - FreeMem(Color); - end; - Dispose(Light); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetOmnilightNodeCount(const Source: TFile3DS; var DB: TDatabase3DS): cardinal; - -begin - Result := GetGenericNodeCount(Source, DB, LIGHT_NODE_TAG); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure GetOmnilightNodeNameList(const Source: TFile3DS; var DB: TDatabase3DS; - List: TStringList); - -begin - GetGenericNodeNameList(Source, DB, LIGHT_NODE_TAG, List); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetOmnilightMotion(const Source: TFile3DS; OmniChunk: PChunk3DS): TKFOmni3DS; - - // Gets Omnilight keyframe information from chunk - - // L_TARGET - // NODE_ID - // NODE_HDR - // APP_DATA - // POS_TRACK - // COL_TRACK - // HOT_TRACK - // FALL_TRACK - // ROLL_TRACK - -var - NodeHdrChunk, PosChunk, ColChunk: PChunk3DS; - PosKeys, ColKeys: cardinal; - -begin - PosKeys := 0; - ColKeys := 0; - - // get information from chunks - // search children of OmniLight chunk - NodeHdrChunk := FindChunk(OmniChunk, NODE_HDR); - PosChunk := FindChunk(OmniChunk, POS_TRACK_TAG); - ColChunk := FindChunk(OmniChunk, COL_TRACK_TAG); - - Source.ReadChunkData(NodeHdrChunk); - - if Assigned(PosChunk) then - begin - Source.ReadChunkData(PosChunk); - PosKeys := PosChunk^.Data.PosTrackTag^.TrackHdr.KeyCount; - end; - - if Assigned(ColChunk) then - begin - Source.ReadChunkData(ColChunk); - ColKeys := ColChunk^.Data.ColTrackTag^.TrackHdr.KeyCount; - end; - - // set-up and fill-in the TKFOmni3DS structure - FillChar(Result, SizeOf(Result), $00); - InitOmnilightMotion(Result, PosKeys, ColKeys); - with Result do - begin - //--- Header Information - Name := ansistring(NodeHdrChunk^.Data.NodeHdr^.ObjNameStr); - Flags1 := NodeHdrChunk^.Data.NodeHdr^.Flags1; - Flags2 := NodeHdrChunk^.Data.NodeHdr^.Flags2; - Parent := ansistring(GetParentName(Source, NodeHdrChunk)); - - //--- Position Information - if PosKeys <> 0 then - begin - NPFlag := PosChunk^.Data.PosTrackTag^.TrackHdr.Flags; - Move(PosChunk^.Data.PosTrackTag^.KeyHdrList^, PKeys^, PosKeys * - SizeOf(TKeyHeader3DS)); - Move(PosChunk^.Data.PosTrackTag^.PositionList^, Pos^, PosKeys * SizeOf(TPoint3DS)); - end; - - //--- Color Information - if ColKeys <> 0 then - begin - NCFlag := PosChunk^.Data.ColTrackTag^.TrackHdr.Flags; - Move(ColChunk^.Data.ColTrackTag^.KeyHdrList^, CKeys^, ColKeys * - SizeOf(TKeyHeader3DS)); - Move(ColChunk^.Data.ColTrackTag^.ColorList^, Color^, ColKeys * SizeOf(TFColor3DS)); - end; - - //--- Free Chunk Data - if Assigned(NodeHdrChunk) then - FreeChunkData(NodeHdrChunk); - if Assigned(PosChunk) then - FreeChunkData(PosChunk); - if Assigned(ColChunk) then - FreeChunkData(ColChunk); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetOmnilightMotionByName(const Source: TFile3DS; var DB: TDatabase3DS; - const Name: string): TKFOmni3DS; - -var - Chunk: PChunk3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - - Chunk := FindNamedAndTaggedChunk(Source, DB, Name, LIGHT_NODE_TAG); - if Assigned(Chunk) then - Result := GetOmnilightMotion(Source, Chunk); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetOmnilightMotionByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: cardinal): TKFOmni3DS; - -var - Chunk: PChunk3DS; - List: TStringList; - -begin - FillChar(Result, SizeOf(Result), 0); - - List := TStringList.Create; - try - GetOmnilightNodeNameList(Source, DB, List); - - if Index < cardinal(List.Count) then - begin - Chunk := FindNamedAndTaggedChunk(Source, DB, List[Index], LIGHT_NODE_TAG); - if Assigned(Chunk) then - Result := GetOmnilightMotion(Source, Chunk); - end; - finally - List.Free; - end; -end; - -//----------------- Spot Light animation ------------------------------------------------------------------------------ - -procedure InitSpotlightMotion(var Spot: TKFSpot3DS; - NewNPKeys, // Number of position keys - NewNCKeys, // Number of Color keys - NewNHKeys, // Number of hot spot angle keys - NewNFKeys, // Number of falloff angle keys - NewNRKeys, // Number of roll keys - NewNTKeys: cardinal); // Number of target position keys - -var - I: cardinal; - -begin - with Spot do - begin - if Assigned(PKeys) then - FreeMem(PKeys); - if Assigned(Pos) then - FreeMem(Pos); - if Assigned(CKeys) then - FreeMem(CKeys); - if Assigned(Color) then - FreeMem(Color); - if Assigned(HKeys) then - FreeMem(HKeys); - if Assigned(Hot) then - FreeMem(Hot); - if Assigned(FKeys) then - FreeMem(FKeys); - if Assigned(Fall) then - FreeMem(Fall); - if Assigned(RKeys) then - FreeMem(RKeys); - if Assigned(Roll) then - FreeMem(Roll); - if Assigned(TKeys) then - FreeMem(TKeys); - if Assigned(TPos) then - FreeMem(TPos); - - FillChar(Spot, SizeOf(Spot), 0); - NPKeys := NewNPKeys; - NCKeys := NewNCKeys; - NFKeys := NewNFKeys; - NTKeys := NewNTKeys; - NHKeys := NewNHKeys; - NRKeys := NewNRKeys; - - //--- POSITION KEYS ----------------------------------------------------- - if NPKeys <> 0 then - begin - NPFlag := TrackSingle3DS; - - PKeys := AllocMem(NPKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NPKeys - 1 do - PKeys^[I] := DefKeyHeader3DS; - - Pos := AllocMem(NPKeys * SizeOf(TPoint3DS)); - for I := 0 to NPKeys - 1 do - Pos^[I] := DefPoint3DS; - end; - - //--- Color KEYS ---------------------------------------------------------- - if NCKeys <> 0 then - begin - NCFlag := TrackSingle3DS; - CKeys := AllocMem(NCKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NCKeys - 1 do - CKeys^[I] := DefKeyHeader3DS; - - Color := AllocMem(NCKeys * SizeOf(TFColor3DS)); - // Initialization is unclear, even the original developers didn't know what's up. - // They put this part in an '#ifdef LATER #endif' block. ml - // for I := 0 to NCKeys - 1 do Color[I] := localDColor.bDefFColor3DS; - end; - - //---Hot-Spot ANGLE KEYS--------------------------------------------------- - if NHKeys <> 0 then - begin - NHFlag := TrackSingle3DS; - - HKeys := AllocMem(NHKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NHKeys - 1 do - HKeys^[I] := DefKeyHeader3DS; - - Hot := AllocMem(NHKeys * SizeOf(single)); - // default Hot Spot ange 90.0 for now, get real value later (1..174.5) - for I := 0 to NHKeys - 1 do - Hot^[I] := 90; - end; - - //---FALLOFF ANGLE KEYS---------------------------------------------------- - if NFKeys <> 0 then - begin - NFFlag := TrackSingle3DS; - - FKeys := AllocMem(NFKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NFKeys - 1 do - FKeys^[I] := DefKeyHeader3DS; - - Fall := AllocMem(NFKeys * SizeOf(single)); - - // default falloff ange 90.0 for now, get real value later (1..175) - for I := 0 to NFKeys - 1 do - Fall^[I] := 90; - end; - - //--- Roll KEYS ---------------------------------------------------------- - if NRKeys <> 0 then - begin - NRFlag := TrackSingle3DS; - - RKeys := AllocMem(NRKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NRKeys - 1 do - RKeys^[I] := DefKeyHeader3DS; - - Roll := AllocMem(NRKeys * SizeOf(single)); - for I := 0 to NRKeys - 1 do - Roll^[I] := 0; - end; - - //---L_TARGET Pos KEYS ------------------------------------------------ - if NTKeys <> 0 then - begin - NTFlag := TrackSingle3DS; - - TKeys := AllocMem(NTKeys * SizeOf(TKeyHeader3DS)); - for I := 0 to NTKeys - 1 do - TKeys^[I] := DefKeyHeader3DS; - - TPos := AllocMem(NTKeys * SizeOf(TPoint3DS)); - // default target position, 0, 0, 0 sjw fix later if necessary - for I := 0 to NTKeys - 1 do - TPos^[I] := DefPoint3DS; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure ReleaseSpotlightMotion(Spot: PKFSpot3DS); - -begin - if Assigned(Spot) then - begin - with Spot^ do - begin - if Assigned(PKeys) then - FreeMem(PKeys); - if Assigned(Pos) then - FreeMem(Pos); - if Assigned(CKeys) then - FreeMem(CKeys); - if Assigned(Color) then - FreeMem(Color); - if Assigned(HKeys) then - FreeMem(HKeys); - if Assigned(Hot) then - FreeMem(Hot); - if Assigned(FKeys) then - FreeMem(FKeys); - if Assigned(Fall) then - FreeMem(Fall); - if Assigned(RKeys) then - FreeMem(RKeys); - if Assigned(Roll) then - FreeMem(Roll); - if Assigned(TKeys) then - FreeMem(TKeys); - if Assigned(TPos) then - FreeMem(TPos); - end; - Dispose(Spot); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetSpotlightNodeCount(const Source: TFile3DS; var DB: TDatabase3DS): cardinal; - -begin - Result := GetGenericNodeCount(Source, DB, SPOTLIGHT_NODE_TAG); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -procedure GetSpotlightNodeNameList(const Source: TFile3DS; var DB: TDatabase3DS; - List: TStringList); - -begin - GetGenericNodeNameList(Source, DB, SPOTLIGHT_NODE_TAG, List); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetSpotlightMotion(const Source: TFile3DS; - SpotChunk, TargetChunk: PChunk3DS): TKFSpot3DS; - - // gets Spotlight keyframe information from chunk - - // L_TARGET - // ... - // NODE_HDR - // APP_DATA - // POS_TRACK - // COL_TRACK - // HOT_TRACK - // FALL_TRACK - // ROLL_TRACK - -var - NodeHdrChunk, PosChunk, ColChunk, TargetPosChunk, HotChunk, - FallChunk, RollChunk, TargetHdrChunk: PChunk3DS; - PosKeys, ColKeys, HotKeys, FallKeys, RollKeys, TargetKeys: cardinal; - -begin - TargetPosChunk := nil; - TargetHdrChunk := nil; - PosKeys := 0; - ColKeys := 0; - HotKeys := 0; - FallKeys := 0; - RollKeys := 0; - TargetKeys := 0; - - // get information from chunks - // search children of Spotlight chunk - NodeHdrChunk := FindChunk(SpotChunk, NODE_HDR); - PosChunk := FindChunk(SpotChunk, POS_TRACK_TAG); - ColChunk := FindChunk(SpotChunk, COL_TRACK_TAG); - HotChunk := FindChunk(SpotChunk, HOT_TRACK_TAG); - FallChunk := FindChunk(SpotChunk, FALL_TRACK_TAG); - RollChunk := FindChunk(SpotChunk, ROLL_TRACK_TAG); - - Source.ReadChunkData(NodeHdrChunk); - - if Assigned(PosChunk) then - begin - Source.ReadChunkData(PosChunk); - PosKeys := PosChunk^.Data.PosTrackTag^.TrackHdr.KeyCount; - end; - - if Assigned(ColChunk) then - begin - Source.ReadChunkData(ColChunk); - ColKeys := ColChunk^.Data.ColTrackTag^.TrackHdr.KeyCount; - end; - - if Assigned(HotChunk) then - begin - Source.ReadChunkData(HotChunk); - HotKeys := HotChunk^.Data.HotTrackTag^.TrackHdr.KeyCount; - end; - - if Assigned(FallChunk) then - begin - Source.ReadChunkData(FallChunk); - FallKeys := FallChunk^.Data.FallTrackTag^.TrackHdr.KeyCount; - end; - - if Assigned(RollChunk) then - begin - Source.ReadChunkData(RollChunk); - RollKeys := RollChunk^.Data.RollTrackTag^.TrackHdr.KeyCount; - end; - - if Assigned(TargetChunk) then - begin - TargetHdrChunk := FindChunk(TargetChunk, NODE_HDR); - if Assigned(TargetHdrChunk) then - Source.ReadChunkData(TargetHdrChunk); - - TargetPosChunk := FindChunk(TargetChunk, POS_TRACK_TAG); - if Assigned(TargetPosChunk) then - begin - Source.ReadChunkData(TargetPosChunk); - TargetKeys := TargetPosChunk^.Data.PosTrackTag^.TrackHdr.KeyCount; - end; - end; - - // set-up and fill-in the TKFSpot3DS structure - InitSpotlightMotion(Result, PosKeys, ColKeys, HotKeys, FallKeys, RollKeys, TargetKeys); - - with Result do - begin - // header Information - Name := ansistring(NodeHdrChunk^.Data.NodeHdr^.ObjNameStr); - Flags1 := NodeHdrChunk^.Data.NodeHdr^.Flags1; - Flags2 := NodeHdrChunk^.Data.NodeHdr^.Flags2; - - // get parent name if there is one - Parent := ansistring(GetParentName(Source, NodeHdrChunk)); - TParent := ansistring(GetParentName(Source, TargetHdrChunk)); - - if Assigned(TargetHdrChunk) then - begin - TFlags1 := TargetHdrChunk^.Data.NodeHdr^.Flags1; - TFlags2 := TargetHdrChunk^.Data.NodeHdr^.Flags2; - end - else - begin - TFlags1 := 0; - TFlags2 := 0; - end; - - // target information - if TargetKeys <> 0 then - begin - NTFlag := TargetPosChunk^.Data.PosTrackTag^.TrackHdr.Flags; - Move(TargetPosChunk^.Data.PosTrackTag^.KeyHdrList^, TKeys^, - TargetKeys * SizeOf(TKeyHeader3DS)); - Move(TargetPosChunk^.Data.PosTrackTag^.PositionList^, TPos^, - TargetKeys * SizeOf(TPoint3DS)); - end; - - // position information - if PosKeys <> 0 then - begin - NPFlag := PosChunk^.Data.PosTrackTag^.TrackHdr.Flags; - Move(PosChunk^.Data.PosTrackTag^.KeyHdrList^, PKeys^, PosKeys * - SizeOf(TKeyHeader3DS)); - Move(PosChunk^.Data.PosTrackTag^.PositionList^, Pos^, PosKeys * SizeOf(TPoint3DS)); - end; - - // color information - if ColKeys <> 0 then - begin - NCFlag := ColChunk^.Data.ColTrackTag^.TrackHdr.Flags; - Move(ColChunk^.Data.ColTrackTag^.KeyHdrList^, CKeys^, ColKeys * - SizeOf(TKeyHeader3DS)); - Move(ColChunk^.Data.ColTrackTag^.ColorList^, Color^, ColKeys * SizeOf(TFColor3DS)); - end; - - // hot spot information - if HotKeys <> 0 then - begin - NHFlag := HotChunk^.Data.HotTrackTag^.TrackHdr.Flags; - Move(HotChunk^.Data.HotTrackTag^.KeyHdrList^, HKeys^, HotKeys * - SizeOf(TKeyHeader3DS)); - Move(HotChunk^.Data.HotTrackTag^.HotSpotAngleList^, Hot^, HotKeys * - SizeOf(single)); - end; - - // falloff information - if FallKeys <> 0 then - begin - NFFlag := FallChunk^.Data.FallTrackTag^.TrackHdr.Flags; - Move(FallChunk^.Data.FallTrackTag^.KeyHdrList^, FKeys^, FallKeys * - SizeOf(TKeyHeader3DS)); - Move(FallChunk^.Data.FallTrackTag^.FallOffAngleList^, Fall^, - FallKeys * SizeOf(single)); - end; - - // roll track Information - if RollKeys <> 0 then - begin - NRFlag := RollChunk^.Data.RollTrackTag^.TrackHdr.Flags; - Move(RollChunk^.Data.RollTrackTag^.KeyHdrList^, RKeys^, RollKeys * - SizeOf(TKeyHeader3DS)); - Move(RollChunk^.Data.RollTrackTag^.RollAngleList^, Roll^, - RollKeys * SizeOf(single)); - end; - end; - - //--- Free Chunk Data - if Assigned(NodeHdrChunk) then - FreeChunkData(NodeHdrChunk); - if Assigned(PosChunk) then - FreeChunkData(PosChunk); - if Assigned(ColChunk) then - FreeChunkData(ColChunk); - if Assigned(HotChunk) then - FreeChunkData(HotChunk); - if Assigned(FallChunk) then - FreeChunkData(FallChunk); - if Assigned(RollChunk) then - FreeChunkData(RollChunk); - if Assigned(TargetPosChunk) then - FreeChunkData(TargetPosChunk); -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetSpotlightMotionByName(const Source: TFile3DS; var DB: TDatabase3DS; - const Name: string): TKFSpot3DS; - -var - SpotlightChunk, TargetChunk: PChunk3DS; - -begin - FillChar(Result, SizeOf(Result), 0); - - SpotlightChunk := FindNamedAndTaggedChunk(Source, DB, Name, SPOTLIGHT_NODE_TAG); - if Assigned(SpotlightChunk) then - begin - TargetChunk := FindNamedAndTaggedChunk(Source, DB, Name, L_TARGET_NODE_TAG); - Result := GetSpotlightMotion(Source, SpotlightChunk, TargetChunk); - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetSpotlightMotionByIndex(const Source: TFile3DS; var DB: TDatabase3DS; - Index: cardinal): TKFSpot3DS; - -var - SpotChunk, TargetChunk: PChunk3DS; - List: TStringList; - -begin - FillChar(Result, SizeOf(Result), 0); - - List := TStringList.Create; - try - GetSpotlightNodeNameList(Source, DB, List); - if Index < cardinal(List.Count) then - begin - SpotChunk := FindNamedAndTaggedChunk(Source, DB, List[Index], SPOTLIGHT_NODE_TAG); - if Assigned(SpotChunk) then - begin - TargetChunk := FindNamedAndTaggedChunk(Source, DB, List[Index], - L_TARGET_NODE_TAG); - if Assigned(TargetChunk) then - Result := GetSpotlightMotion(Source, SpotChunk, TargetChunk); - end; - end; - finally - List.Free; - end; -end; - -//----------------- Versioninformation -------------------------------------------------------------------------------- - -function GetM3dMagicRelease(const Source: TFile3DS; var DB: TDatabase3DS): TReleaseLevel; - - // Scans the database for M3D_VERSION chunk and returnes its release - -var - Chunk: PChunk3DS; - -begin - Result := rlReleaseNotKnown; - // If the database is a 3DS file - if DB.TopChunk^.Tag = M3DMAGIC then - begin - Chunk := FindChunk(DB.TopChunk, M3D_VERSION); - if Assigned(Chunk) then - begin - Source.ReadChunkData(Chunk); - case Chunk^.Data.M3dVersion^ of - 1: - Result := rlRelease1; - 2: - Result := rlRelease2; - 3: - Result := rlRelease3; - else - Result := rlReleaseNotKnown; - end; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetMeshRelease(const Source: TFile3DS; var DB: TDatabase3DS): TReleaseLevel; - - // Scans the database for MESH_VERSION chunk and returnes its release - -var - Chunk: PChunk3DS; - -begin - Result := rlReleaseNotKnown; - // If the database is a 3DS file - if (DB.TopChunk^.Tag = M3DMAGIC) or (DB.TopChunk^.Tag = CMAGIC) then - begin - Chunk := FindChunk(DB.TopChunk, MESH_VERSION); - if Assigned(Chunk) then - begin - Source.ReadChunkData(Chunk); - case Chunk^.Data.MeshVersion^ of - 1: - Result := rlRelease1; - 2: - Result := rlRelease2; - 3: - Result := rlRelease3; - else - Result := rlReleaseNotKnown; - end; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetKfRelease(const Source: TFile3DS; var DB: TDatabase3DS): TReleaseLevel; - - // Scans the database for KFHDR chunk and returnes its release level - -var - KFChunk, Chunk: PChunk3DS; - -begin - Result := rlReleaseNotKnown; - // If the database is a 3DS file - if (DB.TopChunk^.Tag = M3DMAGIC) or (DB.TopChunk^.Tag = CMAGIC) then - begin - KFChunk := FindChunk(DB.TopChunk, KFDATA); - if Assigned(KFChunk) then - Chunk := FindChunk(DB.TopChunk, KFHDR) - else - Chunk := nil; - if Assigned(Chunk) then - begin - Source.ReadChunkData(Chunk); - case Chunk^.Data.KFHdr^.Revision of - 1: - Result := rlRelease1; - 2: - Result := rlRelease2; - 3: - Result := rlRelease3; - else - Result := rlReleaseNotKnown; - end; - end; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -function GetDatabaseRelease(const Source: TFile3DS; var DB: TDatabase3DS): TReleaseLevel; - -begin - case DB.TopChunk^.Tag of - M3DMAGIC: - Result := GetM3dMagicRelease(Source, DB); - CMAGIC: - Result := GetMeshRelease(Source, DB); - MLIBMAGIC: - Result := rlRelease3; - else - Result := rlReleaseNotKnown; - end; -end; - -//--------------------------------------------------------------------------------------------------------------------- - -end. - diff --git a/Sourcex/GXS.AVIRecorder.pas b/Sourcex/GXS.AVIRecorder.pas index e4d71ee6..17ea49c1 100644 --- a/Sourcex/GXS.AVIRecorder.pas +++ b/Sourcex/GXS.AVIRecorder.pas @@ -25,7 +25,7 @@ interface GXS.Scene, GXS.SceneViewer, - Formatx.VFW; + Formats.VFW; type TAVICompressor = (acDefault, acShowDialog, acDivX); diff --git a/Sourcex/GXS.ApplicationFileIO.pas b/Sourcex/GXS.ApplicationFileIO.pas index 345e9d71..2acd489f 100644 --- a/Sourcex/GXS.ApplicationFileIO.pas +++ b/Sourcex/GXS.ApplicationFileIO.pas @@ -108,9 +108,7 @@ function StrToResType(const AStrRes: string): TgxApplicationResource; vGXAFIOCreateFileStream: TgxAFIOCreateFileStream = nil; vGXAFIOFileStreamExists: TgxAFIOFileStreamExists = nil; -// --------------------------------------------------------------------- -implementation -// --------------------------------------------------------------------- +implementation // ------------------------------------------------------------ var vAFIO: TgxApplicationFileIO = nil; diff --git a/Sourcex/GXS.BSP.pas b/Sourcex/GXS.BSP.pas index e9818199..4ff11ae1 100644 --- a/Sourcex/GXS.BSP.pas +++ b/Sourcex/GXS.BSP.pas @@ -4,7 +4,7 @@ unit GXS.BSP; (* Binary Space Partion mesh support for GXScene. - The classes of this unit are designed to operate within a TgxBaseMesh. + The classes of this unit are designed to operate within a TGXBaseMesh. *) interface @@ -63,13 +63,13 @@ TFGBSPNode = class; Stores the geometry information, BSP rendering options and offers some basic BSP utility methods. Geometry information is indexed in the facegroups, the 1st facegroup (of index 0) being the root node of the BSP tree. *) - TBSPMeshObject = class(TgxMeshObject) + TBSPMeshObject = class(TGXMeshObject) private FRenderSort: TBSPRenderSort; FClusterVisibility: TBSPClusterVisibility; FUseClusterVisibility: Boolean; public - constructor CreateOwned(AOwner: TgxMeshObjectList); + constructor CreateOwned(AOwner: TGXMeshObjectList); destructor Destroy; override; procedure BuildList(var mrci: TgxRenderContextInfo); override; (* Drops all unused nodes from the facegroups list. @@ -102,7 +102,7 @@ TBSPMeshObject = class(TgxMeshObject) (* A node in the BSP tree. The description does not explicitly differentiates nodes and leafs, nodes are referred by their index. *) - TFGBSPNode = class(TfgxVertexIndexList) + TFGBSPNode = class(TFGXVertexIndexList) private FSplitPlane: THmgPlane; FPositiveSubNodeIndex: Integer; @@ -112,7 +112,7 @@ TFGBSPNode = class(TfgxVertexIndexList) function AddLerp(iA, iB: Integer; fB, fA: Single): Integer; function AddLerpIfDistinct(iA, iB, iMid: Integer): Integer; public - constructor CreateOwned(AOwner: TgxFaceGroups); override; + constructor CreateOwned(AOwner: TGXFaceGroups); override; destructor Destroy; override; procedure IsCulled(const bsprci: TBSPRenderContextInfo; var positive, negative: Boolean); @@ -250,7 +250,7 @@ procedure TBSPClusterVisibility.SetData(Source: PByte; NumClusters: Integer); // ------------------ TBSPMeshObject ------------------ // ------------------ -constructor TBSPMeshObject.CreateOwned(AOwner: TgxMeshObjectList); +constructor TBSPMeshObject.CreateOwned(AOwner: TGXMeshObjectList); begin inherited; Mode := momFaceGroups; @@ -541,7 +541,7 @@ function TBSPMeshObject.FindNodeByPoint(const aPoint: TVector4f): TFGBSPNode; // ------------------ TFGBSPNode ------------------ // ------------------ -constructor TFGBSPNode.CreateOwned(AOwner: TgxFaceGroups); +constructor TFGBSPNode.CreateOwned(AOwner: TGXFaceGroups); begin inherited; FPositiveSubNodeIndex := 0; diff --git a/Sourcex/GXS.BaseMeshSilhouette.pas b/Sourcex/GXS.BaseMeshSilhouette.pas index 8611cb9e..29dfb2d1 100644 --- a/Sourcex/GXS.BaseMeshSilhouette.pas +++ b/Sourcex/GXS.BaseMeshSilhouette.pas @@ -19,40 +19,40 @@ interface type TgxFaceGroupConnectivity = class(TConnectivity) private - FMeshObject: TgxMeshObject; + FMeshObject: TGXMeshObject; FOwnsVertices: boolean; - procedure SetMeshObject(const Value: TgxMeshObject); + procedure SetMeshObject(const Value: TGXMeshObject); public procedure Clear; override; // Builds the connectivity information. procedure RebuildEdgeList; - property MeshObject: TgxMeshObject read FMeshObject write SetMeshObject; + property MeshObject: TGXMeshObject read FMeshObject write SetMeshObject; constructor Create(APrecomputeFaceNormal: boolean); override; - constructor CreateFromMesh(aMeshObject: TgxMeshObject; APrecomputeFaceNormal: boolean); + constructor CreateFromMesh(aMeshObject: TGXMeshObject; APrecomputeFaceNormal: boolean); destructor Destroy; override; end; TgxBaseMeshConnectivity = class(TBaseConnectivity) private - FBaseMesh: TgxBaseMesh; + FBaseMesh: TGXBaseMesh; FFaceGroupConnectivityList: TList; function GetFaceGroupConnectivity(i: integer): TgxFaceGroupConnectivity; function GetConnectivityCount: integer; - procedure SetBaseMesh(const Value: TgxBaseMesh); + procedure SetBaseMesh(const Value: TGXBaseMesh); protected function GetEdgeCount: integer; override; function GetFaceCount: integer; override; public property ConnectivityCount: integer read GetConnectivityCount; property FaceGroupConnectivity[i: integer]: TgxFaceGroupConnectivity read GetFaceGroupConnectivity; - property BaseMesh: TgxBaseMesh read FBaseMesh write SetBaseMesh; + property BaseMesh: TGXBaseMesh read FBaseMesh write SetBaseMesh; procedure Clear(SaveFaceGroupConnectivity: boolean); // Builds the connectivity information. procedure RebuildEdgeList; procedure CreateSilhouette(const SilhouetteParameters: TgxSilhouetteParameters; var aSilhouette: TgxSilhouette; AddToSilhouette: boolean); constructor Create(APrecomputeFaceNormal: boolean); override; - constructor CreateFromMesh(aBaseMesh: TgxBaseMesh); + constructor CreateFromMesh(aBaseMesh: TGXBaseMesh); destructor Destroy; override; end; @@ -88,7 +88,7 @@ constructor TgxFaceGroupConnectivity.Create(APrecomputeFaceNormal: boolean); FOwnsVertices := true; end; -procedure TgxFaceGroupConnectivity.SetMeshObject(const Value: TgxMeshObject); +procedure TgxFaceGroupConnectivity.SetMeshObject(const Value: TGXMeshObject); begin Clear; FMeshObject := Value; @@ -99,7 +99,7 @@ procedure TgxFaceGroupConnectivity.SetMeshObject(const Value: TgxMeshObject); RebuildEdgeList; end; -constructor TgxFaceGroupConnectivity.CreateFromMesh(aMeshObject: TgxMeshObject; APrecomputeFaceNormal: boolean); +constructor TgxFaceGroupConnectivity.CreateFromMesh(aMeshObject: TGXMeshObject; APrecomputeFaceNormal: boolean); begin Create(APrecomputeFaceNormal); MeshObject := aMeshObject; @@ -116,7 +116,7 @@ destructor TgxFaceGroupConnectivity.Destroy; procedure TgxFaceGroupConnectivity.RebuildEdgeList; var iFaceGroup, iFace, iVertex: integer; - FaceGroup: TfgxVertexIndexList; + FaceGroup: TFGXVertexIndexList; List: PIntegerArray; begin // Make sure that the connectivity information is empty @@ -124,8 +124,8 @@ procedure TgxFaceGroupConnectivity.RebuildEdgeList; // Create a list of edges for the meshobject for iFaceGroup := 0 to FMeshObject.FaceGroups.Count - 1 do begin - Assert(FMeshObject.FaceGroups[iFaceGroup] is TfgxVertexIndexList, 'Method only works for descendants of TfgxVertexIndexList.'); - FaceGroup := TfgxVertexIndexList(FMeshObject.FaceGroups[iFaceGroup]); + Assert(FMeshObject.FaceGroups[iFaceGroup] is TFGXVertexIndexList, 'Method only works for descendants of TFGXVertexIndexList.'); + FaceGroup := TFGXVertexIndexList(FMeshObject.FaceGroups[iFaceGroup]); case FaceGroup.Mode of fgmmTriangles, fgmmFlatTriangles: begin @@ -194,22 +194,22 @@ constructor TgxBaseMeshConnectivity.Create(APrecomputeFaceNormal: boolean); inherited; end; -constructor TgxBaseMeshConnectivity.CreateFromMesh(aBaseMesh: TgxBaseMesh); +constructor TgxBaseMeshConnectivity.CreateFromMesh(aBaseMesh: TGXBaseMesh); begin - Create(not(aBaseMesh is TgxActor)); + Create(not(aBaseMesh is TGXActor)); BaseMesh := aBaseMesh; end; -procedure TgxBaseMeshConnectivity.SetBaseMesh(const Value: TgxBaseMesh); +procedure TgxBaseMeshConnectivity.SetBaseMesh(const Value: TGXBaseMesh); var i: integer; - MO: TgxMeshObject; + MO: TGXMeshObject; Connectivity: TgxFaceGroupConnectivity; begin Clear(false); FBaseMesh := Value; // Only precompute normals if the basemesh isn't an actor (because they change) - FPrecomputeFaceNormal := not(Value is TgxActor); + FPrecomputeFaceNormal := not(Value is TGXActor); FBaseMesh := Value; for i := 0 to Value.MeshObjects.Count - 1 do begin diff --git a/Sourcex/GXS.BitmapFont.pas b/Sourcex/GXS.BitmapFont.pas index 61b0804c..5b55199b 100644 --- a/Sourcex/GXS.BitmapFont.pas +++ b/Sourcex/GXS.BitmapFont.pas @@ -34,7 +34,7 @@ interface GXS.Color, GLScene.BaseClasses, GXS.RenderContextInfo, - GXS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorTypes; type diff --git a/Sourcex/GXS.Blur.pas b/Sourcex/GXS.Blur.pas index 116fd565..2c6eb680 100644 --- a/Sourcex/GXS.Blur.pas +++ b/Sourcex/GXS.Blur.pas @@ -33,7 +33,7 @@ interface GXS.Context, GXS.State, GLScene.Strings, - GXS.TextureFormat, + GLScene.TextureFormat, GLScene.BaseClasses, GXS.RenderContextInfo; diff --git a/Sourcex/GXS.CUDA.Graphics.pas b/Sourcex/GXS.CUDA.Graphics.pas index ab086d29..531c10e1 100644 --- a/Sourcex/GXS.CUDA.Graphics.pas +++ b/Sourcex/GXS.CUDA.Graphics.pas @@ -223,7 +223,7 @@ implementation uses GLScene.Strings, - GXS.TextureFormat; + GLScene.TextureFormat; // ------------------ diff --git a/Sourcex/GXS.CelShader.pas b/Sourcex/GXS.CelShader.pas index ad8db7f3..7ca4d817 100644 --- a/Sourcex/GXS.CelShader.pas +++ b/Sourcex/GXS.CelShader.pas @@ -30,7 +30,7 @@ interface GXS.RenderContextInfo, GXS.Material, GXS.State, - GXS.TextureFormat; + GLScene.TextureFormat; type { Cel shading options. diff --git a/Sourcex/GXS.CgBombShader.pas b/Sourcex/GXS.CgBombShader.pas index d8e525a7..fda5b6c7 100644 --- a/Sourcex/GXS.CgBombShader.pas +++ b/Sourcex/GXS.CgBombShader.pas @@ -17,7 +17,7 @@ interface GLScene.Strings, GXS.Material, GXS.RenderContextInfo, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.State, Cg.GL, diff --git a/Sourcex/GXS.CgPostTransformationShader.pas b/Sourcex/GXS.CgPostTransformationShader.pas index 037f1f9a..16b0b902 100644 --- a/Sourcex/GXS.CgPostTransformationShader.pas +++ b/Sourcex/GXS.CgPostTransformationShader.pas @@ -18,7 +18,7 @@ interface GXS.Context, GXS.Scene, GXS.RenderContextInfo, - GXS.TextureFormat, + GLScene.TextureFormat, GXSL.CustomShader, diff --git a/Sourcex/GXS.CgShader.pas b/Sourcex/GXS.CgShader.pas index c2740b06..3107a731 100644 --- a/Sourcex/GXS.CgShader.pas +++ b/Sourcex/GXS.CgShader.pas @@ -23,7 +23,7 @@ interface GLScene.BaseClasses, GXS.RenderContextInfo, GXS.Material, - GXS.TextureFormat, + GLScene.TextureFormat, Cg.Import, Cg.GL; diff --git a/Sourcex/GXS.Collision.pas b/Sourcex/GXS.Collision.pas index a2958781..b3aec806 100644 --- a/Sourcex/GXS.Collision.pas +++ b/Sourcex/GXS.Collision.pas @@ -509,13 +509,13 @@ function FastCheckCubeVsFace(obj1, obj2: TgxBaseSceneObject): Boolean; // m1to2, m2to1 : TMatrix4f; // i:integer; begin - if (obj2 is TgxFreeForm) then + if (obj2 is TGXFreeForm) then begin // check if we are initialized correctly - if not Assigned(TgxFreeForm(obj2).Octree) then - TgxFreeForm(obj2).BuildOctree; + if not Assigned(TGXFreeForm(obj2).Octree) then + TGXFreeForm(obj2).BuildOctree; - Result := TgxFreeForm(obj2).OctreeAABBIntersect + Result := TGXFreeForm(obj2).OctreeAABBIntersect (obj1.AxisAlignedBoundingBoxUnscaled, obj1.AbsoluteMatrix, obj1.InvAbsoluteMatrix) // could then analyse triangles and return contact points @@ -547,13 +547,13 @@ function FastCheckFaceVsFace(obj1, obj2: TgxBaseSceneObject): Boolean; AABB2: TAABB; begin Result := false; - if (obj1 is TgxFreeForm) and (obj2 is TgxFreeForm) then + if (obj1 is TGXFreeForm) and (obj2 is TGXFreeForm) then begin // check if we are initialized correctly - if not Assigned(TgxFreeForm(obj1).Octree) then - TgxFreeForm(obj1).BuildOctree; - if not Assigned(TgxFreeForm(obj2).Octree) then - TgxFreeForm(obj2).BuildOctree; + if not Assigned(TGXFreeForm(obj1).Octree) then + TGXFreeForm(obj1).BuildOctree; + if not Assigned(TGXFreeForm(obj2).Octree) then + TGXFreeForm(obj2).BuildOctree; // Check triangles against the other object // check only the one that are near the destination object (using octree of obj1) @@ -563,7 +563,7 @@ function FastCheckFaceVsFace(obj1, obj2: TgxBaseSceneObject): Boolean; MatrixMultiply(obj1.AbsoluteMatrix, obj2.InvAbsoluteMatrix, m2to1); AABB2 := obj2.AxisAlignedBoundingBoxUnscaled; - triList := TgxFreeForm(obj1).Octree.GetTrianglesFromNodesIntersectingCube + triList := TGXFreeForm(obj1).Octree.GetTrianglesFromNodesIntersectingCube (AABB2, m1to2, m2to1); // in the list originally are the local coords, TransformAsPoints-> now we have obj1 absolute coords @@ -576,7 +576,7 @@ function FastCheckFaceVsFace(obj1, obj2: TgxBaseSceneObject): Boolean; // here we pass absolute coords, then these are transformed with Obj2's InvAbsoluteMatrix to match the local Obj2 System tri := @triList.List[i]; // the next function will check the given Triangle against only these ones that are close (using the octree of obj2) - if TgxFreeForm(obj2).OctreeTriangleIntersect(tri[0], tri[1], tri[2]) + if TGXFreeForm(obj2).OctreeTriangleIntersect(tri[0], tri[1], tri[2]) then begin Result := true; diff --git a/Sourcex/GXS.CompositeImage.pas b/Sourcex/GXS.CompositeImage.pas index c0adc2ad..dc97de05 100644 --- a/Sourcex/GXS.CompositeImage.pas +++ b/Sourcex/GXS.CompositeImage.pas @@ -16,7 +16,7 @@ interface GXS.Graphics, GXS.Texture, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.Context; type diff --git a/Sourcex/GXS.Context.pas b/Sourcex/GXS.Context.pas index 9074f9c3..a1e2ad3f 100644 --- a/Sourcex/GXS.Context.pas +++ b/Sourcex/GXS.Context.pas @@ -33,7 +33,7 @@ interface GLScene.Strings, GXS.State, GXS.PipelineTransformation, - GXS.TextureFormat; + GLScene.TextureFormat; // Buffer ID's for Multiple-Render-Targets (using GL_ATI_draw_buffers) const diff --git a/Sourcex/GXS.DCEMisc.pas b/Sourcex/GXS.DCEMisc.pas index bb273ad1..042b1771 100644 --- a/Sourcex/GXS.DCEMisc.pas +++ b/Sourcex/GXS.DCEMisc.pas @@ -101,8 +101,8 @@ procedure ECAddFreeForm(var MovePack: TECMovePack; FreeForm: TgxBaseSceneObject; if Master is TgxMultiProxy then if TgxMultiProxy(Master).MasterObjects.Count > 0 then Master := TgxMultiProxy(Master).MasterObjects[0].MasterObject; - Assert((Master is TgxFreeForm), 'Object must be freeform, freeformproxy or freeformbased Multiproxy.'); - Assert(Assigned(TgxFreeForm(Master).Octree), 'Octree must have been prepared and setup before use.'); + Assert((Master is TGXFreeForm), 'Object must be freeform, freeformproxy or freeformbased Multiproxy.'); + Assert(Assigned(TGXFreeForm(Master).Octree), 'Octree must have been prepared and setup before use.'); SetVector(Pos, FreeForm.AbsoluteToLocal(MovePack.Position)); //Is in boundingsphere? @@ -111,7 +111,7 @@ procedure ECAddFreeForm(var MovePack: TECMovePack; FreeForm: TgxBaseSceneObject; if d1 > d2 then exit; count := Length(MovePack.Freeforms); - with TgxFreeForm(Master).Octree do + with TGXFreeForm(Master).Octree do begin WalkSphereToLeaf(RootNode, Pos, MovePack.CollisionRange); @@ -126,7 +126,7 @@ procedure ECAddFreeForm(var MovePack: TECMovePack; FreeForm: TgxBaseSceneObject; MovePack.Freeforms[count].ObjectInfo.AbsoluteMatrix := Freeform.AbsoluteMatrix; MovePack.Freeforms[count].ObjectInfo.Solid := Solid; MovePack.Freeforms[count].ObjectInfo.ObjectID := ObjectID; - MovePack.Freeforms[count].InvertedNormals := TgxFreeForm(Master).NormalsOrientation = mnoInvert; + MovePack.Freeforms[count].InvertedNormals := TGXFreeForm(Master).NormalsOrientation = mnoInvert; end; end; diff --git a/Sourcex/GXS.DynamicTexture.pas b/Sourcex/GXS.DynamicTexture.pas index 4beb8467..2e131a34 100644 --- a/Sourcex/GXS.DynamicTexture.pas +++ b/Sourcex/GXS.DynamicTexture.pas @@ -24,7 +24,7 @@ interface GXS.Context, GXS.Texture, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.Graphics; type diff --git a/Sourcex/GXS.ExplosionFx.pas b/Sourcex/GXS.ExplosionFx.pas index 29c71147..3fd4e6fe 100644 --- a/Sourcex/GXS.ExplosionFx.pas +++ b/Sourcex/GXS.ExplosionFx.pas @@ -15,7 +15,7 @@ Pretty neat :) Note: the owner of this behaviour should be any class that derives - from TgxBaseMesh class or any other class derived from TgxBaseMesh. + from TGXBaseMesh class or any other class derived from TGXBaseMesh. Also, the structure of the mesh is lost after the caching of information, so if you'll need the mesh after exploding it, you'll have to save the MeshObjects property of the mesh, OR load it again. @@ -173,13 +173,13 @@ procedure TgxBExplosionFx.CacheInfo; Normal: TVector4f; begin // make sure we can explode this object - if not OwnerBaseSceneObject.InheritsFrom(TgxBaseMesh) then begin + if not OwnerBaseSceneObject.InheritsFrom(TGXBaseMesh) then begin FEnabled := False; Exit; end; FTriList.Free; // get all the triangles of all the meshObjects - FTriList := TgxBaseMesh(OwnerBaseSceneObject).MeshObjects.ExtractTriangles; + FTriList := TGXBaseMesh(OwnerBaseSceneObject).MeshObjects.ExtractTriangles; FaceCount := FTriList.Count div 3; // set initial direction, rotation and position for Face := 0 to Facecount - 1 do begin @@ -215,8 +215,8 @@ procedure TgxBExplosionFx.CacheInfo; FRotList.Add(DegToRadian(3.0*Random), DegToRadian(3.0*Random), DegToRadian(3.0*Random)); end; // Dispose the struture of the mesh - TgxBaseMesh(OwnerBaseSceneObject).MeshObjects.Clear; - TgxBaseMesh(OwnerBaseSceneObject).StructureChanged; + TGXBaseMesh(OwnerBaseSceneObject).MeshObjects.Clear; + TGXBaseMesh(OwnerBaseSceneObject).StructureChanged; end; procedure TgxBExplosionFX.Render(var rci : TgxRenderContextInfo); diff --git a/Sourcex/GXS.FBO.pas b/Sourcex/GXS.FBO.pas index 23508207..581729d3 100644 --- a/Sourcex/GXS.FBO.pas +++ b/Sourcex/GXS.FBO.pas @@ -25,7 +25,7 @@ interface GXS.RenderContextInfo, GXS.MultisampleImage, GXS.Graphics, - GXS.TextureFormat; + GLScene.TextureFormat; const diff --git a/Sourcex/GXS.FBORenderer.pas b/Sourcex/GXS.FBORenderer.pas index fb425091..4782eaf0 100644 --- a/Sourcex/GXS.FBORenderer.pas +++ b/Sourcex/GXS.FBORenderer.pas @@ -28,7 +28,7 @@ interface GXS.RenderContextInfo, GXS.State, GXS.PipelineTransformation, - GXS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorTypes, GXS.MultisampleImage; diff --git a/Sourcex/GXS.FPSMovement.pas b/Sourcex/GXS.FPSMovement.pas index f6418637..71244d12 100644 --- a/Sourcex/GXS.FPSMovement.pas +++ b/Sourcex/GXS.FPSMovement.pas @@ -50,11 +50,11 @@ TgxBFPSMovement = class; TgxMapCollectionItem = class(TXCollectionItem) private - FMap: TgxFreeForm; + FMap: TGXFreeForm; FMapName: string; FCollisionGroup: integer; - procedure setMap(value: TgxFreeForm); + procedure setMap(value: TGXFreeForm); protected procedure WriteToFiler(writer: TWriter); override; procedure ReadFromFiler(reader: TReader); override; @@ -64,7 +64,7 @@ TgxMapCollectionItem = class(TXCollectionItem) class function FriendlyName: String; override; published - property Map: TgxFreeForm read FMap write setMap; + property Map: TGXFreeForm read FMap write setMap; (* Indicates the collision group of this map. A Collision Group is a set of logical maps and movers that can collide between @@ -78,9 +78,9 @@ TgxMapCollectionItemClass = class of TgxMapCollectionItem; TgxMapCollection = class(TXCollection) public class function ItemsClass: TXCollectionItemClass; override; - function addMap(Map: TgxFreeForm; CollisionGroup: integer = 0) + function addMap(Map: TGXFreeForm; CollisionGroup: integer = 0) : TgxMapCollectionItem; - function findMap(mapFreeForm: TgxFreeForm): TgxMapCollectionItem; + function findMap(mapFreeForm: TGXFreeForm): TgxMapCollectionItem; end; TgxFPSMovementManager = class(TComponent) @@ -111,7 +111,7 @@ TgxFPSMovementManager = class(TComponent) Camera can collide with multiple planes (e.g. floor + multiple walls + ceiling) limit iterations to 4 or 5 for now, may need to be higher for more complex maps or fast motion *) - function SphereSweepAndSlide(freeform: TgxFreeForm; + function SphereSweepAndSlide(freeform: TGXFreeForm; behaviour: TgxBFPSMovement; SphereStart: TVector4f; var Velocity, newPosition: TVector4f; sphereRadius: single) : boolean; overload; @@ -232,7 +232,7 @@ constructor TgxMapCollectionItem.Create(aOwner: TXCollection); FCollisionGroup := 0; end; -procedure TgxMapCollectionItem.setMap(value: TgxFreeForm); +procedure TgxMapCollectionItem.setMap(value: TGXFreeForm); begin assert(owner.owner.InheritsFrom(TgxFPSMovementManager)); if assigned(FMap) then @@ -275,7 +275,7 @@ procedure TgxMapCollectionItem.Loaded; if FMapName <> '' then begin assert(owner.owner.InheritsFrom(TgxFPSMovementManager)); - Map := TgxFreeForm(TgxFPSMovementManager(owner.owner) + Map := TGXFreeForm(TgxFPSMovementManager(owner.owner) .Scene.FindSceneObject(FMapName)); end; end; @@ -293,7 +293,7 @@ class function TgxMapCollection.ItemsClass: TXCollectionItemClass; Result := TgxMapCollectionItem; end; -function TgxMapCollection.addMap(Map: TgxFreeForm; CollisionGroup: integer = 0) +function TgxMapCollection.addMap(Map: TGXFreeForm; CollisionGroup: integer = 0) : TgxMapCollectionItem; begin // no repeated maps (would only present delays...) @@ -307,7 +307,7 @@ function TgxMapCollection.addMap(Map: TgxFreeForm; CollisionGroup: integer = 0) add(Result); end; -function TgxMapCollection.findMap(mapFreeForm: TgxFreeForm) +function TgxMapCollection.findMap(mapFreeForm: TGXFreeForm) : TgxMapCollectionItem; var i: integer; @@ -424,9 +424,9 @@ procedure TgxFPSMovementManager.Notification(AComponent: TComponent; Navigator := nil; if (AComponent = FScene) then FScene := nil; - if AComponent.InheritsFrom(TgxFreeForm) then + if AComponent.InheritsFrom(TGXFreeForm) then begin - Map := Maps.findMap(TgxFreeForm(AComponent)); + Map := Maps.findMap(TGXFreeForm(AComponent)); if assigned(Map) then Map.Map := nil; end; @@ -462,7 +462,7 @@ procedure TgxFPSMovementManager.SphereSweepAndSlide(behaviour: TgxBFPSMovement; end; end; -function TgxFPSMovementManager.SphereSweepAndSlide(freeform: TgxFreeForm; +function TgxFPSMovementManager.SphereSweepAndSlide(freeform: TGXFreeForm; behaviour: TgxBFPSMovement; SphereStart: TVector4f; var Velocity, newPosition: TVector4f; sphereRadius: single): boolean; var diff --git a/Sourcex/GXS.File3DS.pas b/Sourcex/GXS.File3DS.pas index d019470a..6c5a263a 100644 --- a/Sourcex/GXS.File3DS.pas +++ b/Sourcex/GXS.File3DS.pas @@ -30,8 +30,8 @@ interface GXS.RenderContextInfo, GXS.Material, - Formatx.m3DS, - Formatx.m3DSTypes; + Formats.m3DS, + Formats.m3DSTypes; type @@ -171,8 +171,8 @@ TgxFile3DSAnimationKeyList = class(TGPersistentObject) // Used only for serialization. There probably is a more efficient way to do it. TgxFile3DSAnimKeysClassType = (ctScale, ctRot, ctPos, ctCol, ctTPos, ctFall, ctHot, ctRoll); - // A 3ds-specific TgxMorphableMeshObject. - TgxFile3DSDummyObject = class(TgxMorphableMeshObject) + // A 3ds-specific TGXMorphableMeshObject. + TgxFile3DSDummyObject = class(TGXMorphableMeshObject) private FAnimList: TgxFile3DSAnimationKeyList; FAnimData: Pointer; @@ -213,7 +213,7 @@ TgxFile3DSOmniLightObject = class(TgxFile3DSDummyObject) FLightSrcName: String64; public constructor Create; override; - procedure LoadData(const AOwner: TgxBaseMesh; const AData: PLight3DS); virtual; + procedure LoadData(const AOwner: TGXBaseMesh; const AData: PLight3DS); virtual; procedure LoadAnimation(const AData: Pointer); override; procedure SetFrame(const AFrame: real); override; procedure Assign(Source: TPersistent); override; @@ -225,7 +225,7 @@ TgxFile3DSOmniLightObject = class(TgxFile3DSDummyObject) // A 3ds-specific spot light. TgxFile3DSSpotLightObject = class(TgxFile3DSOmniLightObject) public - procedure LoadData(const AOwner: TgxBaseMesh; const AData: PLight3DS); override; + procedure LoadData(const AOwner: TGXBaseMesh; const AData: PLight3DS); override; procedure LoadAnimation(const AData: Pointer); override; procedure SetFrame(const AFrame: real); override; end; @@ -238,7 +238,7 @@ TgxFile3DSCameraObject = class(TgxFile3DSDummyObject) FCameraSrcName: String64; public constructor Create; override; - procedure LoadData(Owner: TgxBaseMesh; AData: PCamera3DS); + procedure LoadData(Owner: TGXBaseMesh; AData: PCamera3DS); procedure LoadAnimation(const AData: Pointer); override; procedure SetFrame(const AFrame: real); override; procedure WriteToFiler(Writer: TGVirtualWriter); override; @@ -249,7 +249,7 @@ TgxFile3DSCameraObject = class(TgxFile3DSDummyObject) (* The 3DStudio vector file. A 3DS file may contain material information and require textures when loading. *) - Tgx3DSVectorFile = class(TgxVectorFile) + Tgx3DSVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; @@ -267,9 +267,9 @@ Tgx3DSVectorFile = class(TgxVectorFile) (* If enabled, allows 3ds animation and fixes loading of some 3ds models, but has a few bugs: - - TgxFreeForm.AutoCentering does now work correctly. - - TgxMeshObject.vertices return values different from - TgxMeshObject.ExtractTriangles() *) + - TGXFreeForm.AutoCentering does now work correctly. + - TGXMeshObject.vertices return values different from + TGXMeshObject.ExtractTriangles() *) vFile3DS_EnableAnimation: boolean = False; (* If enabled, a -90 degrees (-PI/2) rotation will occured on X Axis. @@ -1074,7 +1074,7 @@ procedure TgxFile3DSDummyObject.MorphTo(morphTargetIndex: integer); procedure TgxFile3DSDummyObject.Lerp(morphTargetIndex1, morphTargetIndex2: integer; lerpFactor: single); begin - if (Owner.Owner is TgxActor) and ((Owner.Owner as TgxActor).AnimationMode in + if (Owner.Owner is TGXActor) and ((Owner.Owner as TGXActor).AnimationMode in [aamBounceBackward, aamLoopBackward]) then SetFrame(morphTargetIndex1 - lerpFactor) else @@ -1231,7 +1231,7 @@ constructor TgxFile3DSOmniLightObject.Create; FLightSrc := TgxFile3DSLight.Create(nil); end; -procedure TgxFile3DSOmniLightObject.LoadData(const AOwner: TgxBaseMesh; +procedure TgxFile3DSOmniLightObject.LoadData(const AOwner: TGXBaseMesh; const AData: PLight3DS); begin FLightSrc.Parent := AOwner; @@ -1334,7 +1334,7 @@ destructor TgxFile3DSOmniLightObject.Destroy; inherited; end; -procedure TgxFile3DSSpotLightObject.LoadData(const AOwner: TgxBaseMesh; +procedure TgxFile3DSSpotLightObject.LoadData(const AOwner: TGXBaseMesh; const AData: PLight3DS); begin inherited; @@ -1393,7 +1393,7 @@ constructor TgxFile3DSCameraObject.Create; FCameraSrc.TargetObject := FTargetObj; end; -procedure TgxFile3DSCameraObject.LoadData(Owner: TgxBaseMesh; AData: PCamera3DS); +procedure TgxFile3DSCameraObject.LoadData(Owner: TGXBaseMesh; AData: PCamera3DS); begin FCameraSrc.Parent := Owner; FTargetObj.Parent := Owner; @@ -1520,9 +1520,9 @@ procedure Tgx3DSVectorFile.LoadFromStream(aStream: TStream); begin material := Materials.MaterialByName[Name]; Assert(Assigned(material)); - if GetOwner is TgxBaseMesh then + if GetOwner is TGXBaseMesh then begin - matLib := TgxBaseMesh(GetOwner).MaterialLibrary; + matLib := TGXBaseMesh(GetOwner).MaterialLibrary; if Assigned(matLib) then begin Result := Name; @@ -1679,9 +1679,9 @@ procedure Tgx3DSVectorFile.LoadFromStream(aStream: TStream); Result := -1; material := Materials.MaterialByName[Name]; Assert(Assigned(material)); - if GetOwner is TgxBaseMesh then + if GetOwner is TGXBaseMesh then begin - matLib := TgxBaseMesh(GetOwner).LightmapLibrary; + matLib := TGXBaseMesh(GetOwner).LightmapLibrary; if Assigned(matLib) then begin if Trim(string(material.IllumMap.Map.NameStr)) <> '' then @@ -1943,7 +1943,7 @@ procedure Tgx3DSVectorFile.LoadFromStream(aStream: TStream); var CurrentMotionIndex, iMaterial, i, j, x: integer; - aFaceGroup: TfgxVertexIndexList; + aFaceGroup: TFGXVertexIndexList; Face, Vertex, TargetVertex: integer; SmoothingGroup: cardinal; CurrentIndex: word; @@ -1951,7 +1951,7 @@ procedure Tgx3DSVectorFile.LoadFromStream(aStream: TStream); standardNormalsOrientation: boolean; lights_mesh: TgxFile3DSOmniLightObject; camera_mesh: TgxFile3DSCameraObject; - basemesh: TgxBaseMesh; + basemesh: TGXBaseMesh; begin with TFile3DS.Create do @@ -1969,7 +1969,7 @@ procedure Tgx3DSVectorFile.LoadFromStream(aStream: TStream); mesh.Name := string(PMesh3DS(Objects.Mesh[I])^.NameStr); //dummy targets for x := KeyFramer.Settings.Seg.SegBegin to KeyFramer.Settings.Seg.SegEnd do - TgxMeshMorphTarget.CreateOwned(mesh.MorphTargets); + TGXMeshMorphTarget.CreateOwned(mesh.MorphTargets); with mesh do begin @@ -2135,10 +2135,10 @@ procedure Tgx3DSVectorFile.LoadFromStream(aStream: TStream); // face definitions and rely on the default texture of the scene object if (NMats = 0) or (not vVectorFileObjectsAllocateMaterials) then begin - aFaceGroup := TfgxVertexIndexList.CreateOwned(mesh.FaceGroups); + aFaceGroup := TFGXVertexIndexList.CreateOwned(mesh.FaceGroups); with aFaceGroup do begin - basemesh := TgxBaseMesh(Self.GetOwner); + basemesh := TGXBaseMesh(Self.GetOwner); if basemesh.MaterialLibrary <> nil then MaterialName := basemesh.MaterialLibrary.Materials.Add.Name; // copy the face list @@ -2154,7 +2154,7 @@ procedure Tgx3DSVectorFile.LoadFromStream(aStream: TStream); begin for iMaterial := 0 to NMats - 1 do begin - aFaceGroup := TfgxVertexIndexList.CreateOwned(mesh.FaceGroups); + aFaceGroup := TFGXVertexIndexList.CreateOwned(mesh.FaceGroups); with aFaceGroup do begin MaterialName := @@ -2189,7 +2189,7 @@ procedure Tgx3DSVectorFile.LoadFromStream(aStream: TStream); mesh.Name := string(KeyFramer.MeshMotion[I].NameStr); //dummy targets for x := KeyFramer.Settings.Seg.SegBegin to KeyFramer.Settings.Seg.SegEnd do - TgxMeshMorphTarget.CreateOwned(mesh.MorphTargets); + TGXMeshMorphTarget.CreateOwned(mesh.MorphTargets); mesh.LoadAnimation(KeyFramer.MeshMotion[I]); end; @@ -2214,7 +2214,7 @@ procedure Tgx3DSVectorFile.LoadFromStream(aStream: TStream); lights_mesh := TgxFile3DSOmniLightObject.CreateOwned(Owner.MeshObjects); // Dummy targets for it. for x := KeyFramer.Settings.Seg.SegBegin to KeyFramer.Settings.Seg.SegEnd do - TgxMeshMorphTarget.CreateOwned(lights_mesh.MorphTargets); + TGXMeshMorphTarget.CreateOwned(lights_mesh.MorphTargets); lights_mesh.LoadData(Owner, Objects.OmniLight[I]); lights_mesh.LoadAnimation(KeyFramer.OmniLightMotion[I]); end; @@ -2225,7 +2225,7 @@ procedure Tgx3DSVectorFile.LoadFromStream(aStream: TStream); lights_mesh := TgxFile3DSSpotLightObject.CreateOwned(Owner.MeshObjects); // Dummy targets for it. for x := KeyFramer.Settings.Seg.SegBegin to KeyFramer.Settings.Seg.SegEnd do - TgxMeshMorphTarget.CreateOwned(lights_mesh.MorphTargets); + TGXMeshMorphTarget.CreateOwned(lights_mesh.MorphTargets); lights_mesh.LoadData(Owner, Objects.SpotLight[I]); lights_mesh.LoadAnimation(KeyFramer.SpotLightMotion[I]); end; @@ -2236,7 +2236,7 @@ procedure Tgx3DSVectorFile.LoadFromStream(aStream: TStream); camera_mesh := TgxFile3DSCameraObject.CreateOwned(Owner.MeshObjects); // Dummy targets for it. for x := KeyFramer.Settings.Seg.SegBegin to KeyFramer.Settings.Seg.SegEnd do - TgxMeshMorphTarget.CreateOwned(camera_mesh.MorphTargets); + TGXMeshMorphTarget.CreateOwned(camera_mesh.MorphTargets); camera_mesh.LoadData(Owner, Objects.Camera[I]); camera_mesh.LoadAnimation(KeyFramer.CameraMotion[I]); end; diff --git a/Sourcex/GXS.File3DSSceneObjects.pas b/Sourcex/GXS.File3DSSceneObjects.pas index 484561a8..537a08e3 100644 --- a/Sourcex/GXS.File3DSSceneObjects.pas +++ b/Sourcex/GXS.File3DSSceneObjects.pas @@ -55,7 +55,7 @@ TgxFile3DSCamera = class(TgxCamera) property RollAngle; end; - TgxFile3DSActor = class(TgxActor) + TgxFile3DSActor = class(TGXActor) private procedure ReadMesh(Stream: TStream); procedure WriteMesh(Stream: TStream); @@ -63,7 +63,7 @@ TgxFile3DSActor = class(TgxActor) procedure DefineProperties(Filer: TFiler); override; end; - TgxFile3DSFreeForm = class(TgxFreeForm) + TgxFile3DSFreeForm = class(TGXFreeForm) private FTransfMat, FScaleMat, ParentMatrix: TMatrix4f; diff --git a/Sourcex/GXS.FileASE.pas b/Sourcex/GXS.FileASE.pas index c98a62c8..1934b219 100644 --- a/Sourcex/GXS.FileASE.pas +++ b/Sourcex/GXS.FileASE.pas @@ -86,7 +86,7 @@ TgxASEFaceList = class(TObject) contains: vertices, faces, vertex indices, faces and vertices normals, channels of texture coordinates and indices, scaling and location info; this object used only to store ASE data temporary to copy supported - piece of it into TgxMeshObject *) + piece of it into TGXMeshObject *) TgxASEMeshObject = class(TObject) private FFaces: TgxASEFaceList; @@ -214,7 +214,7 @@ TgxASEMaterialList = class(TObject) // ASE vector file parser - TgxASEVectorFile = class(TgxVectorFile) + TgxASEVectorFile = class(TGXVectorFile) private FStringData: TStringList; FHeader: string; @@ -632,7 +632,7 @@ procedure ASESetPreferredLightmap(aMap: TASETextureMap; aSubMaterialIndex: Integ // here ASE geom object is converted to mesh -procedure CopyASEToMesh(aASEMesh: TgxASEMeshObject; aMesh: TgxMeshObject; aASEMaterials: TgxASEMaterialList); +procedure CopyASEToMesh(aASEMesh: TgxASEMeshObject; aMesh: TGXMeshObject; aASEMaterials: TgxASEMaterialList); const ASETextureMapKinds: array [TASETextureMap] of string = ( @@ -761,9 +761,9 @@ procedure CopyASEToMesh(aASEMesh: TgxASEMeshObject; aMesh: TgxMeshObject; aASEMa end; var - vLastFG: TfgxVertexIndexList; + vLastFG: TFGXVertexIndexList; - function GetFaceGroup(aMaterialID, aSubMaterialID: Integer): TfgxVertexIndexList; + function GetFaceGroup(aMaterialID, aSubMaterialID: Integer): TFGXVertexIndexList; var i: Integer; name: string; @@ -781,12 +781,12 @@ procedure CopyASEToMesh(aASEMesh: TgxASEMeshObject; aMesh: TgxMeshObject; aASEMa vLastFG := nil; for i := 0 to aMesh.FaceGroups.Count - 1 do if aMesh.FaceGroups.Items[i].MaterialName = name then begin - Result := TfgxVertexIndexList(aMesh.FaceGroups.Items[i]); + Result := TFGXVertexIndexList(aMesh.FaceGroups.Items[i]); vLastFG := Result; Break; end; if not Assigned(Result) then begin - Result := TfgxVertexIndexList.CreateOwned(aMesh.FaceGroups); + Result := TFGXVertexIndexList.CreateOwned(aMesh.FaceGroups); if aMaterialID > -1 then begin Result.MaterialName := GetOrAllocateMaterial(aMaterialID, aSubMaterialID); Result.LightMapIndex := GetOrAllocateLightMap(aMaterialID, aSubMaterialID); @@ -797,7 +797,7 @@ procedure CopyASEToMesh(aASEMesh: TgxASEMeshObject; aMesh: TgxMeshObject; aASEMa end; var - fg: TfgxVertexIndexList; + fg: TFGXVertexIndexList; aseFace: TgxASEFace; i: Integer; norm, tex, light: Boolean; @@ -856,7 +856,7 @@ procedure CopyASEToMesh(aASEMesh: TgxASEMeshObject; aMesh: TgxMeshObject; aASEMa vi.Add(i*3 + 0, i*3 + 1, i*3 + 2); end; end else begin - fg := TfgxVertexIndexList.CreateOwned(aMesh.FaceGroups); + fg := TFGXVertexIndexList.CreateOwned(aMesh.FaceGroups); aMesh.Vertices.Assign(aASEMesh.Vertices); aMesh.Mode := momTriangles; fg.VertexIndices.Capacity := aASEMesh.Faces.Count*3; @@ -1339,13 +1339,13 @@ procedure TgxASEVectorFile.ParseFaceString(const aData: string; var Index, A, B, procedure TgxASEVectorFile.ParseGeomObject(var aLineIndex: Integer); var aseMesh: TgxASEMeshObject; - obj: TgxMeshObject; + obj: TGXMeshObject; Data: string; b: Boolean; begin aseMesh := TgxASEMeshObject.Create; try - obj := TgxMeshObject.CreateOwned(Owner.MeshObjects); + obj := TGXMeshObject.CreateOwned(Owner.MeshObjects); Inc(aLineIndex); Data := FStringData[aLineIndex]; diff --git a/Sourcex/GXS.FileB3D.pas b/Sourcex/GXS.FileB3D.pas index 282fd4b7..61dce016 100644 --- a/Sourcex/GXS.FileB3D.pas +++ b/Sourcex/GXS.FileB3D.pas @@ -14,15 +14,17 @@ interface GLScene.VectorTypes, GLScene.VectorGeometry, GLScene.VectorLists, + GLScene.TextureFormat, + GXS.ApplicationFileIO, GXS.VectorFileObjects, GXS.Texture, - GXS.TextureFormat, GXS.Material, - Formatx.B3D; + + Formats.B3D; type - TgxB3DVectorFile = class(TgxVectorFile) + TgxB3DVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(AStream: TStream); override; @@ -43,9 +45,9 @@ procedure TgxB3DVectorFile.LoadFromStream(AStream: TStream); var B3d: TFileB3D; S: string; - Mo: TgxMeshObject; + Mo: TGXMeshObject; I, J: Integer; - FaceGroup: TfgxVertexIndexList; + FaceGroup: TFGXVertexIndexList; // lightmapBmp : TBitmap; Node: PNODEChunk; B3DMat: TB3DMaterial; @@ -67,10 +69,10 @@ procedure TgxB3DVectorFile.LoadFromStream(AStream: TStream); TexName: string; LightName: string; begin - if GetOwner is TgxBaseMesh then + if GetOwner is TGXBaseMesh then begin - MatLib := TgxBaseMesh(GetOwner).MaterialLibrary; - LightLib := TgxBaseMesh(GetOwner).LightmapLibrary; + MatLib := TGXBaseMesh(GetOwner).MaterialLibrary; + LightLib := TGXBaseMesh(GetOwner).LightmapLibrary; // got a linked material library? if Assigned(MatLib) then begin @@ -211,15 +213,15 @@ procedure TgxB3DVectorFile.LoadFromStream(AStream: TStream); GetOrAllocateMaterial(I, B3DMat, B3DTex, B3DLightTex); end; - if GetOwner is TgxBaseMesh then - (GetOwner as TgxBaseMesh).NormalsOrientation := MnoDefault; + if GetOwner is TGXBaseMesh then + (GetOwner as TGXBaseMesh).NormalsOrientation := MnoDefault; Node := B3d.Nodes.NodeData; while Node <> nil do begin if Node^.Meshes <> nil then begin - Mo := TgxMeshObject.CreateOwned(Owner.MeshObjects); + Mo := TGXMeshObject.CreateOwned(Owner.MeshObjects); SetString(S, Node^.Name, Strlen(Node^.Name)); // if Pos('16', s)>1 then @@ -277,7 +279,7 @@ procedure TgxB3DVectorFile.LoadFromStream(AStream: TStream); Triangles := Node^.Meshes^.Triangles; while Assigned(Triangles) do begin - FaceGroup := TfgxVertexIndexList.CreateOwned(Mo.FaceGroups); + FaceGroup := TFGXVertexIndexList.CreateOwned(Mo.FaceGroups); if Triangles^.Brush_id >= 0 then begin FaceGroup.MaterialName := B3d.Materials[Triangles^.Brush_id] + diff --git a/Sourcex/GXS.FileBMP.pas b/Sourcex/GXS.FileBMP.pas index 986e0947..a51054f1 100644 --- a/Sourcex/GXS.FileBMP.pas +++ b/Sourcex/GXS.FileBMP.pas @@ -18,7 +18,7 @@ interface GXS.Context, GXS.Graphics, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.ApplicationFileIO; type diff --git a/Sourcex/GXS.FileDAE.pas b/Sourcex/GXS.FileDAE.pas index f80c1968..8b07ecfb 100644 --- a/Sourcex/GXS.FileDAE.pas +++ b/Sourcex/GXS.FileDAE.pas @@ -25,9 +25,9 @@ interface // { The DAE vector file (COLLADA actor file). Stores a set of "frames" describing the different postures of the actor, - it may be animated by TgxActor. The "Skin" must be loaded indepentendly + it may be animated by TGXActor. The "Skin" must be loaded indepentendly (the whole mesh uses a single texture bitmap). } - TgxFileDAE = class(TgxVectorFile) + TgxFileDAE = class(TGXVectorFile) public class function Capabilities : TDataFileCapabilities; override; @@ -55,16 +55,16 @@ procedure TgxFileDAE.LoadFromStream(aStream : TStream); var i, j : Integer; DAEFile : TgxFileDAE; - mesh : TgxMorphableMeshObject; + mesh : TGXMorphableMeshObject; faceGroup : TFGIndexTexCoordList; - morphTarget : TgxMeshMorphTarget; + morphTarget : TGXMeshMorphTarget; begin { TODO : E2035 Not enough actual parameters } (*DAEFile:=TgxFileDAE.Create();*) DAEFile.LoadFromStream(aStream); try // retrieve mesh data - mesh:=TgxMorphableMeshObject.CreateOwned(Owner.MeshObjects); + mesh:=TGXMorphableMeshObject.CreateOwned(Owner.MeshObjects); with mesh, DAEFile do begin Mode:=momFaceGroups; faceGroup:=TFGIndexTexCoordList.CreateOwned(FaceGroups); @@ -86,7 +86,7 @@ procedure TgxFileDAE.LoadFromStream(aStream : TStream); { TODO : E2003 Undeclared identifier: 'iFrames' } (* for i:=0 to iFrames-1 do begin - morphTarget:=TgxMeshMorphTarget.CreateOwned(MorphTargets); + morphTarget:=TGXMeshMorphTarget.CreateOwned(MorphTargets); with morphTarget do begin Name:='Frame'+IntToStr(i); Vertices.Capacity:=iVertices; @@ -97,7 +97,7 @@ procedure TgxFileDAE.LoadFromStream(aStream : TStream); end; *) end; - if GetOwner is TgxActor then with TgxActor(GetOwner).Animations do begin + if GetOwner is TGXActor then with TGXActor(GetOwner).Animations do begin Clear; { TODO : E2003 Undeclared identifier: 'frameNames' } (* diff --git a/Sourcex/GXS.FileDDS.pas b/Sourcex/GXS.FileDDS.pas index 53fd06b0..38a9aac5 100644 --- a/Sourcex/GXS.FileDDS.pas +++ b/Sourcex/GXS.FileDDS.pas @@ -23,8 +23,8 @@ interface GXS.Context, GXS.Graphics, - GXS.TextureFormat, - Formatx.DXTC; + GLScene.TextureFormat, + Formats.DXTC; type diff --git a/Sourcex/GXS.FileDXF.pas b/Sourcex/GXS.FileDXF.pas index 63531505..e2bd902c 100644 --- a/Sourcex/GXS.FileDXF.pas +++ b/Sourcex/GXS.FileDXF.pas @@ -4,8 +4,8 @@ unit GXS.FileDXF; (* - Support-Code to load DXF (Drawing eXchange Files) TgxFreeForm or - TgxActor Components. + Support-Code to load DXF (Drawing eXchange Files) TGXFreeForm or + TGXActor Components. Note that you must manually add this unit to one of your project's uses to enable support for DXF at run-time. @@ -29,7 +29,7 @@ interface GXS.Material; type - TgxDXFVectorFile = class(TgxVectorFile) + TgxDXFVectorFile = class(TGXVectorFile) private FSourceStream: TStream; // Load from this stream FBuffer: String; // Buffer and current line @@ -47,12 +47,12 @@ TgxDXFVectorFile = class(TgxVectorFile) procedure SkipTable; procedure SkipSection; // procedure DoProgress (Stage: TgxProgressStage; PercentDone: single; RedrawNow: Boolean; const Msg: string); - function NeedMesh(basemesh: TgxBaseMesh; layer: STRING): TgxMeshObject; - function NeedFaceGroup(m: TgxMeshObject; fgmode: TgxFaceGroupMeshMode; - fgmat: STRING): TfgxVertexIndexList; - procedure NeedMeshAndFaceGroup(basemesh: TgxBaseMesh; layer: STRING; - fgmode: TgxFaceGroupMeshMode; fgmat: STRING; var m: TgxMeshObject; - var fg: TfgxVertexIndexList); + function NeedMesh(basemesh: TGXBaseMesh; layer: STRING): TGXMeshObject; + function NeedFaceGroup(m: TGXMeshObject; fgmode: TGXFaceGroupMeshMode; + fgmat: STRING): TFGXVertexIndexList; + procedure NeedMeshAndFaceGroup(basemesh: TGXBaseMesh; layer: STRING; + fgmode: TGXFaceGroupMeshMode; fgmat: STRING; var m: TGXMeshObject; + var fg: TFGXVertexIndexList); function ReadLine: STRING; // Read a single line of text from the source stream, set FEof to true when done. function ReadInt: Integer; @@ -61,10 +61,10 @@ TgxDXFVectorFile = class(TgxVectorFile) procedure ReadLayer; procedure ReadLayerTable; procedure ReadBlocks; - procedure ReadInsert(basemesh: TgxBaseMesh); - procedure ReadEntity3Dface(basemesh: TgxBaseMesh); - procedure ReadEntityPolyLine(basemesh: TgxBaseMesh); - procedure ReadEntities(basemesh: TgxBaseMesh); + procedure ReadInsert(basemesh: TGXBaseMesh); + procedure ReadEntity3Dface(basemesh: TGXBaseMesh); + procedure ReadEntityPolyLine(basemesh: TGXBaseMesh); + procedure ReadEntities(basemesh: TGXBaseMesh); public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -74,7 +74,7 @@ TgxDXFVectorFile = class(TgxVectorFile) implementation //======================================================================== -procedure BuildNormals(m: TgxMeshObject); FORWARD; +procedure BuildNormals(m: TGXMeshObject); FORWARD; const DXFcolorsRGB: ARRAY [1 .. 255] OF LONGINT = ($FF0000, $FFFF00, $00FF00, @@ -343,7 +343,7 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; S: String; code: Integer; blockname: String; - blockmesh: TgxFreeForm; + blockmesh: TGXFreeForm; begin // This code reads blocks into orphaned TgxFreeForms. @@ -354,7 +354,7 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; S := ReadLine; if (code = 0) and (S = 'BLOCK') then begin - blockmesh := TgxFreeForm.create(owner); + blockmesh := TGXFreeForm.create(owner); blockmesh.IgnoreMissingTextures := True; blockmesh.MaterialLibrary := owner.MaterialLibrary; blockmesh.OnProgress := NIL; @@ -381,17 +381,17 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; until (code = 0) and (S = 'ENDSEC'); end; - procedure TgxDXFVectorFile.ReadInsert(basemesh: TgxBaseMesh); + procedure TgxDXFVectorFile.ReadInsert(basemesh: TGXBaseMesh); var code, idx, indexoffset: Integer; i, j, k: Integer; blockname, S: STRING; pt, insertpoint, scale: TAffineVector; - blockmesh: TgxBaseMesh; + blockmesh: TGXBaseMesh; // blockproxy :TgxProxyObject; - mo_block: TgxMeshObject; - mo_base: TgxMeshObject; - fg_block, fg_base: TfgxVertexIndexList; + mo_block: TGXMeshObject; + mo_base: TGXMeshObject; + fg_block, fg_base: TFGXVertexIndexList; begin blockname := ''; insertpoint := NullVector; @@ -422,7 +422,7 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; idx := FBlocks.IndexOf(blockname); if idx >= 0 then begin - blockmesh := FBlocks.Objects[idx] as TgxBaseMesh; + blockmesh := FBlocks.Objects[idx] as TGXBaseMesh; // FLAT STRUCTURES // Insert a block into its parent by copying the contents. @@ -441,7 +441,7 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; end; for j := 0 to mo_block.FaceGroups.count - 1 do begin - fg_block := mo_block.FaceGroups[j] as TfgxVertexIndexList; + fg_block := mo_block.FaceGroups[j] as TFGXVertexIndexList; fg_base := NeedFaceGroup(mo_base, fg_block.mode, fg_block.MaterialName); for k := 0 to fg_block.VertexIndices.count - 1 do @@ -477,8 +477,8 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; PushCode(0); end; - function TgxDXFVectorFile.NeedMesh(basemesh: TgxBaseMesh; layer: STRING) - : TgxMeshObject; + function TgxDXFVectorFile.NeedMesh(basemesh: TGXBaseMesh; layer: STRING) + : TGXMeshObject; var i: Integer; begin @@ -490,31 +490,31 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; result := basemesh.MeshObjects[i] else begin - result := TgxMeshObject.CreateOwned(basemesh.MeshObjects); + result := TGXMeshObject.CreateOwned(basemesh.MeshObjects); result.mode := momFaceGroups; result.name := layer; end; end; - function TgxDXFVectorFile.NeedFaceGroup(m: TgxMeshObject; - fgmode: TgxFaceGroupMeshMode; fgmat: STRING): TfgxVertexIndexList; + function TgxDXFVectorFile.NeedFaceGroup(m: TGXMeshObject; + fgmode: TGXFaceGroupMeshMode; fgmat: STRING): TFGXVertexIndexList; var i: Integer; acadcolor: LONGINT; libmat: TgxLibMaterial; - fg: TfgxVertexIndexList; + fg: TFGXVertexIndexList; begin i := 0; while (i < m.FaceGroups.count) and - not((m.FaceGroups[i] is TfgxVertexIndexList) and - ((m.FaceGroups[i] as TfgxVertexIndexList).mode = fgmode) and + not((m.FaceGroups[i] is TFGXVertexIndexList) and + ((m.FaceGroups[i] as TFGXVertexIndexList).mode = fgmode) and (m.FaceGroups[i].MaterialName = fgmat)) do Inc(i); if i < m.FaceGroups.count then - fg := m.FaceGroups[i] as TfgxVertexIndexList + fg := m.FaceGroups[i] as TFGXVertexIndexList else begin - fg := TfgxVertexIndexList.CreateOwned(m.FaceGroups); + fg := TFGXVertexIndexList.CreateOwned(m.FaceGroups); fg.mode := fgmode; fg.MaterialName := fgmat; if owner.MaterialLibrary <> NIL then @@ -539,22 +539,22 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; result := fg; end; - procedure TgxDXFVectorFile.NeedMeshAndFaceGroup(basemesh: TgxBaseMesh; - layer: STRING; fgmode: TgxFaceGroupMeshMode; fgmat: STRING; - var m: TgxMeshObject; var fg: TfgxVertexIndexList); + procedure TgxDXFVectorFile.NeedMeshAndFaceGroup(basemesh: TGXBaseMesh; + layer: STRING; fgmode: TGXFaceGroupMeshMode; fgmat: STRING; + var m: TGXMeshObject; var fg: TFGXVertexIndexList); begin m := NeedMesh(basemesh, layer); fg := NeedFaceGroup(m, fgmode, fgmat); end; - procedure TgxDXFVectorFile.ReadEntity3Dface(basemesh: TgxBaseMesh); + procedure TgxDXFVectorFile.ReadEntity3Dface(basemesh: TGXBaseMesh); var code, i: Integer; pts: ARRAY [0 .. 3] of TAffineVector; isquad: Boolean; - fg: TfgxVertexIndexList; + fg: TFGXVertexIndexList; color, layer: STRING; - m: TgxMeshObject; + m: TGXMeshObject; begin color := ''; layer := ''; @@ -621,13 +621,13 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; fg.Add(m.vertices.FindOrAdd(pts[3])); end; - procedure TgxDXFVectorFile.ReadEntityPolyLine(basemesh: TgxBaseMesh); + procedure TgxDXFVectorFile.ReadEntityPolyLine(basemesh: TGXBaseMesh); - procedure ReadPolylineVertex(m: TgxMeshObject; vertexindexbase: Integer); + procedure ReadPolylineVertex(m: TGXMeshObject; vertexindexbase: Integer); var color: STRING; pt: TAffineVector; - fg: TfgxVertexIndexList; + fg: TFGXVertexIndexList; code, idx, i70, i71, i72, i73, i74: Integer; begin color := ''; @@ -711,7 +711,7 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; end; var - m: TgxMeshObject; + m: TGXMeshObject; code, vertexindexbase: Integer; S, layer: STRING; begin @@ -737,7 +737,7 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; PushCode(0); end; - procedure TgxDXFVectorFile.ReadEntities(basemesh: TgxBaseMesh); + procedure TgxDXFVectorFile.ReadEntities(basemesh: TGXBaseMesh); var code: Integer; S: STRING; @@ -775,7 +775,7 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; end; // build normals - procedure BuildNormals(m: TgxMeshObject); + procedure BuildNormals(m: TGXMeshObject); var i, j: Integer; v1, v2, v3, v4, n: TAffineVector; @@ -783,8 +783,8 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; for i := 0 to m.vertices.count - 1 do m.Normals.Add(0, 0, 0); for i := 0 to m.FaceGroups.count - 1 do - if m.FaceGroups[i] is TfgxVertexIndexList then - with m.FaceGroups[i] as TfgxVertexIndexList do + if m.FaceGroups[i] is TFGXVertexIndexList then + with m.FaceGroups[i] as TFGXVertexIndexList do case mode of fgmmTriangles: begin @@ -883,7 +883,7 @@ procedure BuildNormals(m: TgxMeshObject); FORWARD; // calc normals FLayers.free; for i := FBlocks.count - 1 downto 0 do - (FBlocks.Objects[i] as TgxFreeForm).free; + (FBlocks.Objects[i] as TGXFreeForm).free; FBlocks.free; for i := 0 to owner.MeshObjects.count - 1 do BuildNormals(owner.MeshObjects[i]); diff --git a/Sourcex/GXS.FileGL2.pas b/Sourcex/GXS.FileGL2.pas index 54c0a5c8..f40f3886 100644 --- a/Sourcex/GXS.FileGL2.pas +++ b/Sourcex/GXS.FileGL2.pas @@ -23,13 +23,13 @@ interface type - TgxGLMVectorFile = class (TgxVectorFile) + TgxGLMVectorFile = class (TGXVectorFile) public class function Capabilities : TDataFileCapabilities; override; procedure LoadFromStream(aStream : TStream); override; end; - TgxGLAVectorFile = class (TgxVectorFile) + TgxGLAVectorFile = class (TGXVectorFile) public class function Capabilities : TDataFileCapabilities; override; procedure LoadFromStream(aStream : TStream); override; @@ -58,8 +58,8 @@ procedure TgxGLMVectorFile.LoadFromStream(aStream : TStream); var GLMFile : TFileGLM; i,j,k,s,c,d : integer; - mesh : TgxSkeletonMeshObject; - fg : TfgxVertexIndexList; + mesh : TGXSkeletonMeshObject; + fg : TFGXVertexIndexList; VertOfs : integer; shader : string; vec2 : Tvector2f; @@ -91,7 +91,7 @@ procedure TgxGLMVectorFile.LoadFromStream(aStream : TStream); d:=vGhoul2LevelOfDetail; if d>=Length(GLMFile.LODs) then exit; for s:=0 to Length(GLMFile.SurfaceHeirachy)-1 do begin - mesh:=TgxSkeletonMeshObject.CreateOwned(Owner.MeshObjects); + mesh:=TGXSkeletonMeshObject.CreateOwned(Owner.MeshObjects); mesh.Mode:=momFaceGroups; mesh.Name:=trim(GLMFile.SurfaceHeirachy[s].name); shader:=trim(GLMFile.SurfaceHeirachy[s].shader); @@ -134,7 +134,7 @@ procedure TgxGLMVectorFile.LoadFromStream(aStream : TStream); mesh.VerticesBonesWeights^[mesh.Vertices.Count-1]^[k].Weight:=0; end; end; - fg:=TfgxVertexIndexList.CreateOwned(mesh.FaceGroups); + fg:=TFGXVertexIndexList.CreateOwned(mesh.FaceGroups); fg.Mode:=fgmmTriangles; fg.MaterialName:=mesh.Name; for j:=0 to Length(Triangles)-1 do begin @@ -170,32 +170,32 @@ procedure TgxGLAVectorFile.LoadFromStream(aStream : TStream); var GLAFile : TFileGLA; i,j : Integer; - frame : TgxSkeletonFrame; + frame : TGXSkeletonFrame; CompBone : TgxACompQuatBone; quat : TQuaternion; pos : TAffineVector; - basepose : TgxSkeletonFrame; + basepose : TGXSkeletonFrame; bonelist : TGIntegerList; - bone : TgxSkeletonBone; + bone : TGXSkeletonBone; begin GLAFile:=TFileGLA.Create; GLAFile.LoadFromStream(aStream); try - if not (Owner is TgxActor) then exit; + if not (Owner is TGXActor) then exit; - TgxActor(Owner).Reference:=aarSkeleton; + TGXActor(Owner).Reference:=aarSkeleton; bonelist:=TGIntegerList.Create; for i:=0 to GLAFile.AnimHeader.numBones-1 do bonelist.Add(i); while bonelist.count>0 do begin if GLAFile.Skeleton[bonelist[0]].parent = -1 then - bone:=TgxSkeletonBone.CreateOwned(Owner.Skeleton.RootBones) + bone:=TGXSkeletonBone.CreateOwned(Owner.Skeleton.RootBones) else begin bone:=Owner.Skeleton.RootBones.BoneByID(GLAFile.Skeleton[bonelist[0]].parent); if Assigned(bone) then - bone:=TgxSkeletonBone.CreateOwned(bone) + bone:=TGXSkeletonBone.CreateOwned(bone) end; if Assigned(bone) then begin bone.Name:=GLAFile.Skeleton[bonelist[0]].Name; @@ -207,7 +207,7 @@ procedure TgxGLAVectorFile.LoadFromStream(aStream : TStream); bonelist.Free; // Build the base pose - basepose:=TgxSkeletonFrame.CreateOwned(TgxActor(Owner).Skeleton.Frames); + basepose:=TGXSkeletonFrame.CreateOwned(TGXActor(Owner).Skeleton.Frames); basepose.Name:='basepose'; basepose.TransformMode:=sftQuaternion; basepose.Position.AddNulls(GLAFile.AnimHeader.numBones); @@ -216,7 +216,7 @@ procedure TgxGLAVectorFile.LoadFromStream(aStream : TStream); // Load animation data for i:=0 to GLAFile.AnimHeader.numFrames-1 do begin // Create the frame - frame:=TgxSkeletonFrame.CreateOwned(TgxActor(Owner).Skeleton.Frames); + frame:=TGXSkeletonFrame.CreateOwned(TGXActor(Owner).Skeleton.Frames); frame.Name:='Frame'+IntToStr(i); frame.TransformMode:=sftQuaternion; @@ -233,7 +233,7 @@ procedure TgxGLAVectorFile.LoadFromStream(aStream : TStream); Owner.Skeleton.RootBones.PrepareGlobalMatrices; for i:=0 to Owner.MeshObjects.Count-1 do - TgxSkeletonMeshObject(Owner.MeshObjects[i]).PrepareBoneMatrixInvertedMeshes; + TGXSkeletonMeshObject(Owner.MeshObjects[i]).PrepareBoneMatrixInvertedMeshes; finally GLAFile.Free; diff --git a/Sourcex/GXS.FileGLTF.pas b/Sourcex/GXS.FileGLTF.pas index 1063d8b6..1f371d89 100644 --- a/Sourcex/GXS.FileGLTF.pas +++ b/Sourcex/GXS.FileGLTF.pas @@ -28,7 +28,7 @@ interface type (* The glTF format is a runtime asset delivery format for GL APIs: WebGL, OpenGL ES OpenGL and Vulkan. *) - TglTFVectorFile = class(TgxVectorFile) + TglTFVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -54,9 +54,9 @@ procedure TglTFVectorFile.LoadFromStream(aStream: TStream); var matLib: TgxMaterialLibrary; begin - if Owner is TgxBaseMesh then + if Owner is TGXBaseMesh then begin - matLib := TgxBaseMesh(GetOwner).MaterialLibrary; + matLib := TGXBaseMesh(GetOwner).MaterialLibrary; if Assigned(matLib) then begin if matLib.Materials.GetLibMaterialByName(name) = nil then @@ -83,14 +83,14 @@ procedure TglTFVectorFile.LoadFromStream(aStream: TStream); var i, j, k, nVert, nTex, firstFrame: Integer; nbBones, boneID: Integer; - mesh: TgxSkeletonMeshObject; + mesh: TGXSkeletonMeshObject; sl, tl: TStringList; - bone: TgxSkeletonBone; - frame: TgxSkeletonFrame; + bone: TGXSkeletonBone; + frame: TGXSkeletonFrame; faceGroup: TFGVertexNormalTexIndexList; v: TAffineVector; - boneIDs: TgxVertexBoneWeightDynArray; + boneIDs: TGXVertexBoneWeightDynArray; weightCount: Integer; begin sl := TStringList.Create; @@ -103,11 +103,11 @@ procedure TglTFVectorFile.LoadFromStream(aStream: TStream); raise Exception.Create('nodes not found'); if sl.IndexOf('triangles') >= 0 then begin - mesh := TgxSkeletonMeshObject.CreateOwned(Owner.MeshObjects); + mesh := TGXSkeletonMeshObject.CreateOwned(Owner.MeshObjects); mesh.Mode := momFaceGroups; end else if Owner.MeshObjects.Count > 0 then - mesh := (Owner.MeshObjects[0] as TgxSkeletonMeshObject) + mesh := (Owner.MeshObjects[0] as TGXSkeletonMeshObject) else raise Exception.Create('SMD is an animation, load model SMD first.'); // read skeleton nodes @@ -120,10 +120,10 @@ procedure TglTFVectorFile.LoadFromStream(aStream: TStream); tl.CommaText := sl[i]; with Owner.Skeleton do if (tl[2] <> '-1') then - bone := TgxSkeletonBone.CreateOwned + bone := TGXSkeletonBone.CreateOwned (RootBones.BoneByID(StrToInt(tl[2]))) else - bone := TgxSkeletonBone.CreateOwned(RootBones); + bone := TGXSkeletonBone.CreateOwned(RootBones); if Assigned(bone) then begin bone.boneID := StrToInt(tl[0]); @@ -149,7 +149,7 @@ procedure TglTFVectorFile.LoadFromStream(aStream: TStream); begin if Copy(sl[i], 1, 5) <> 'time ' then raise Exception.Create('time not found, got: ' + sl[i]); - frame := TgxSkeletonFrame.CreateOwned(Owner.Skeleton.Frames); + frame := TGXSkeletonFrame.CreateOwned(Owner.Skeleton.Frames); frame.name := ResourceName + ' ' + sl[i]; Inc(i); while Pos(Copy(sl[i], 1, 1), ' 1234567890') > 0 do @@ -175,8 +175,8 @@ procedure TglTFVectorFile.LoadFromStream(aStream: TStream); Assert(frame.Position.Count = nbBones, 'Invalid number of bones in frame ' + IntToStr(Owner.Skeleton.Frames.Count)); end; - if Owner is TgxActor then - with TgxActor(Owner).Animations.Add do + if Owner is TGXActor then + with TGXActor(Owner).Animations.Add do begin k := Pos('.', ResourceName); if k > 0 then @@ -264,7 +264,7 @@ procedure TGLTFVectorFile.SaveToStream(aStream: TStream); i, j, k, l, b: Integer; p, r, v, n, t: TAffineVector; - procedure GetNodesFromBonesRecurs(bone: TgxSkeletonBone; ParentID: Integer; + procedure GetNodesFromBonesRecurs(bone: TGXSkeletonBone; ParentID: Integer; bl: TStrings); var i: Integer; @@ -312,8 +312,8 @@ procedure TGLTFVectorFile.SaveToStream(aStream: TStream); begin str.Add('triangles'); for i := 0 to Owner.MeshObjects.Count - 1 do - if Owner.MeshObjects[i] is TgxSkeletonMeshObject then - with TgxSkeletonMeshObject(Owner.MeshObjects[i]) do + if Owner.MeshObjects[i] is TGXSkeletonMeshObject then + with TGXSkeletonMeshObject(Owner.MeshObjects[i]) do begin for j := 0 to FaceGroups.Count - 1 do with TFGVertexNormalTexIndexList(FaceGroups[j]) do diff --git a/Sourcex/GXS.FileGRD.pas b/Sourcex/GXS.FileGRD.pas index 6863744e..761b3713 100644 --- a/Sourcex/GXS.FileGRD.pas +++ b/Sourcex/GXS.FileGRD.pas @@ -24,7 +24,7 @@ interface This is a format for storing regular grid values as a matrices of cell centers. The format supports variations and subformats. This importer works for Sutfer, ArcInfo and GMS formats *) - TgxGRDVectorFile = class(TgxVectorFile) + TgxGRDVectorFile = class(TGXVectorFile) public HeightField: TgxHeightField; Nodes: array of TSingleArray; diff --git a/Sourcex/GXS.FileGTS.pas b/Sourcex/GXS.FileGTS.pas index 952eacac..71b22602 100644 --- a/Sourcex/GXS.FileGTS.pas +++ b/Sourcex/GXS.FileGTS.pas @@ -25,7 +25,7 @@ interface Following lines contain the x/y/z coordinates of vertices, then the edges (two indices) and the faces (three indices). http://gts.sourceforge.net/ *) - TgxGTSVectorFile = class(TgxVectorFile) + TgxGTSVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -51,15 +51,15 @@ procedure TgxGTSVectorFile.LoadFromStream(aStream: TStream); var i, nv, ne, nf, k, ei: Integer; sl: TStringList; - mesh: TgxMeshObject; - fg: TfgxVertexIndexList; + mesh: TGXMeshObject; + fg: TFGXVertexIndexList; vertIndices: array [0 .. 5] of Integer; pEdge, pTri, p: PChar; begin sl := TStringList.Create; try sl.LoadFromStream(aStream{$IFDEF Unicode}, TEncoding.ASCII{$ENDIF}); - mesh := TgxMeshObject.CreateOwned(Owner.MeshObjects); + mesh := TGXMeshObject.CreateOwned(Owner.MeshObjects); mesh.Mode := momFaceGroups; if sl.Count > 0 then begin @@ -74,7 +74,7 @@ procedure TgxGTSVectorFile.LoadFromStream(aStream: TStream); p := PChar(sl[i]); mesh.Vertices.Add(ParseFloat(p), ParseFloat(p), ParseFloat(p)); end; - fg := TfgxVertexIndexList.CreateOwned(mesh.FaceGroups); + fg := TFGXVertexIndexList.CreateOwned(mesh.FaceGroups); for i := 1 + nv + ne to nv + ne + nf do begin pTri := PChar(sl[i]); diff --git a/Sourcex/GXS.FileHDR.pas b/Sourcex/GXS.FileHDR.pas index 7a1acc79..65629b6d 100644 --- a/Sourcex/GXS.FileHDR.pas +++ b/Sourcex/GXS.FileHDR.pas @@ -22,7 +22,7 @@ interface GXS.Context, GXS.Graphics, - GXS.TextureFormat; + GLScene.TextureFormat; type diff --git a/Sourcex/GXS.FileJPEG.pas b/Sourcex/GXS.FileJPEG.pas index c8706435..15bd2aaf 100644 --- a/Sourcex/GXS.FileJPEG.pas +++ b/Sourcex/GXS.FileJPEG.pas @@ -15,7 +15,7 @@ interface GLScene.Strings, GXS.Context, GXS.Graphics, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.ApplicationFileIO; type diff --git a/Sourcex/GXS.FileLMTS.pas b/Sourcex/GXS.FileLMTS.pas index 632edc6b..773f77e5 100644 --- a/Sourcex/GXS.FileLMTS.pas +++ b/Sourcex/GXS.FileLMTS.pas @@ -94,7 +94,7 @@ TMaterialInfo = record mathash: integer; end; - TgxLMTSVectorFile = class(TgxVectorFile) + TgxLMTSVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -106,7 +106,7 @@ implementation //==================================================================== uses - GXS.TextureFormat; + GLScene.TextureFormat; // ------------------ // ------------------ TgxLMTSVectorFile ------------------ @@ -119,8 +119,8 @@ class function TgxLMTSVectorFile.Capabilities: TDataFileCapabilities; procedure TgxLMTSVectorFile.LoadFromStream(aStream: TStream); var - MO: TgxMeshObject; - FG: TfgxVertexIndexList; + MO: TGXMeshObject; + FG: TFGXVertexIndexList; LL: TgxMaterialLibrary; ML: TgxMaterialLibrary; LMTS: TLMTS; @@ -140,7 +140,7 @@ procedure TgxLMTSVectorFile.LoadFromStream(aStream: TStream); begin owner.MeshObjects.Clear; - MO := TgxMeshObject.CreateOwned(owner.MeshObjects); + MO := TGXMeshObject.CreateOwned(owner.MeshObjects); MO.Mode := momFaceGroups; vi := TGIntegerList.create; @@ -353,7 +353,7 @@ procedure TgxLMTSVectorFile.LoadFromStream(aStream: TStream); for C := LMTS.header.nSubsets - 1 downto 0 do begin aStream.Read(S, LMTS.header.subSize); - FG := TfgxVertexIndexList.CreateOwned(MO.FaceGroups); + FG := TFGXVertexIndexList.CreateOwned(MO.FaceGroups); FG.Mode := fgmmTriangles; FG.vertexindices.AddSerie(S.Offset * 3, 1, S.Count * 3); vi.AddSerie(S.Offset * 3, 1, S.Count * 3); @@ -416,8 +416,8 @@ procedure TgxLMTSVectorFile.LoadFromStream(aStream: TStream); procedure TgxLMTSVectorFile.SaveToStream(aStream: TStream); var - MO: TgxMeshObject; - FG: TfgxVertexIndexList; + MO: TGXMeshObject; + FG: TFGXVertexIndexList; i, j, k, l, lmstartindex, C, matindex: integer; h: TLMTS_Header; V: array [0 .. 2] of TLMTS_Vertex; @@ -441,7 +441,7 @@ procedure TgxLMTSVectorFile.SaveToStream(aStream: TStream); MO := owner.MeshObjects[i]; for j := 0 to MO.FaceGroups.Count - 1 do begin - FG := TfgxVertexIndexList(MO.FaceGroups[j]); + FG := TFGXVertexIndexList(MO.FaceGroups[j]); matname := AnsiString(FG.MaterialName); @@ -491,7 +491,7 @@ procedure TgxLMTSVectorFile.SaveToStream(aStream: TStream); MO := owner.MeshObjects[i]; for j := 0 to MO.FaceGroups.Count - 1 do begin - FG := TfgxVertexIndexList(MO.FaceGroups[j]); + FG := TFGXVertexIndexList(MO.FaceGroups[j]); // subset already created earlier, just finish filling the data. // we needed the "c" and "lmstartindex" to be able to do this @@ -612,7 +612,7 @@ procedure TgxLMTSVectorFile.SaveToStream(aStream: TStream); MO := owner.MeshObjects[i]; for j := 0 to MO.FaceGroups.Count - 1 do begin - FG := TfgxVertexIndexList(MO.FaceGroups[j]); + FG := TFGXVertexIndexList(MO.FaceGroups[j]); if FG.lightmapindex > -1 then begin matname := AnsiString(owner.LightmapLibrary.Materials diff --git a/Sourcex/GXS.FileLWO.pas b/Sourcex/GXS.FileLWO.pas index 75222812..d2392b9b 100644 --- a/Sourcex/GXS.FileLWO.pas +++ b/Sourcex/GXS.FileLWO.pas @@ -20,18 +20,18 @@ interface GXS.Material, GXS.VectorFileObjects, - Formatx.LWO; + Formats.LWO; type - TgxLWOVectorFile = class(TgxVectorFile) + TgxLWOVectorFile = class(TGXVectorFile) private FLWO: TLWObjectFile; FPnts: TLWPnts; procedure AddLayr(Layr: TLWLayr; LWO: TLWObjectFile); procedure AddSurf(Surf: TLWSurf; LWO: TLWObjectFile); - procedure AddPnts(Pnts: TLWPnts; Mesh: TgxMeshObject); - procedure AddPols(Pols: TLWPols; Mesh: TgxMeshObject); - procedure AddVMap(VMap: TLWVMap; Mesh: TgxMeshObject); + procedure AddPnts(Pnts: TLWPnts; Mesh: TGXMeshObject); + procedure AddPols(Pols: TLWPols; Mesh: TGXMeshObject); + procedure AddVMap(VMap: TLWVMap; Mesh: TGXMeshObject); public procedure LoadFromStream(aStream: TStream); override; end; @@ -68,11 +68,11 @@ TNormBuffer = record procedure TgxLWOVectorFile.AddLayr(Layr: TLWLayr; LWO: TLWObjectFile); var Idx: Integer; - Mesh: TgxMeshObject; + Mesh: TGXMeshObject; Pnts: TLWPnts; begin // Add mesh - Mesh := TgxMeshObject.CreateOwned(Owner.MeshObjects); + Mesh := TGXMeshObject.CreateOwned(Owner.MeshObjects); with Mesh do begin @@ -108,7 +108,7 @@ procedure TgxLWOVectorFile.AddLayr(Layr: TLWLayr; LWO: TLWObjectFile); FPnts := nil; end; -procedure TgxLWOVectorFile.AddPnts(Pnts: TLWPnts; Mesh: TgxMeshObject); +procedure TgxLWOVectorFile.AddPnts(Pnts: TLWPnts; Mesh: TGXMeshObject); var i: Integer; begin @@ -125,7 +125,7 @@ procedure TgxLWOVectorFile.AddPnts(Pnts: TLWPnts; Mesh: TgxMeshObject); end; end; -procedure TgxLWOVectorFile.AddPols(Pols: TLWPols; Mesh: TgxMeshObject); +procedure TgxLWOVectorFile.AddPols(Pols: TLWPols; Mesh: TGXMeshObject); var Idx: Integer; i, j, k, PolyIdx, NormIdx: Integer; @@ -265,9 +265,9 @@ procedure TgxLWOVectorFile.AddSurf(Surf: TLWSurf; LWO: TLWObjectFile); Idx: integer; begin // DONE: implement surface inheritance - if GetOwner is TgxBaseMesh then + if GetOwner is TGXBaseMesh then begin - matLib := TgxBaseMesh(GetOwner).MaterialLibrary; + matLib := TGXBaseMesh(GetOwner).MaterialLibrary; if Assigned(matLib) then begin libMat := matLib.Materials.GetLibMaterialByName(Surf.Name); @@ -349,7 +349,7 @@ procedure TgxLWOVectorFile.AddSurf(Surf: TLWSurf; LWO: TLWObjectFile); end; end; -procedure TgxLWOVectorFile.AddVMap(VMap: TLWVMap; Mesh: TgxMeshObject); +procedure TgxLWOVectorFile.AddVMap(VMap: TLWVMap; Mesh: TGXMeshObject); var i: integer; begin diff --git a/Sourcex/GXS.FileMD2.pas b/Sourcex/GXS.FileMD2.pas index 29599054..39162be4 100644 --- a/Sourcex/GXS.FileMD2.pas +++ b/Sourcex/GXS.FileMD2.pas @@ -23,10 +23,10 @@ interface type (* The MD2 vector file (Quake2 actor file). Stores a set of "frames" describing the different postures of the actor, - it may be animated by TgxActor. The "Skin" must be loaded indepentendly + it may be animated by TGXActor. The "Skin" must be loaded indepentendly (the whole mesh uses a single texture bitmap). Based on code by Roger Cao. *) - TgxMD2VectorFile = class(TgxVectorFile) + TgxMD2VectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -49,15 +49,15 @@ procedure TgxMD2VectorFile.LoadFromStream(aStream: TStream); var i, j: Integer; MD2File: TFileMD2; - mesh: TgxMorphableMeshObject; + mesh: TGXMorphableMeshObject; faceGroup: TFGIndexTexCoordList; - morphTarget: TgxMeshMorphTarget; + morphTarget: TGXMeshMorphTarget; begin MD2File := TFileMD2.Create; MD2File.LoadFromStream(aStream); try // retrieve mesh data - mesh := TgxMorphableMeshObject.CreateOwned(Owner.MeshObjects); + mesh := TGXMorphableMeshObject.CreateOwned(Owner.MeshObjects); with mesh, MD2File do begin Mode := momFaceGroups; @@ -79,7 +79,7 @@ procedure TgxMD2VectorFile.LoadFromStream(aStream: TStream); // retrieve frames data (morph targets) for i := 0 to iFrames - 1 do begin - morphTarget := TgxMeshMorphTarget.CreateOwned(MorphTargets); + morphTarget := TGXMeshMorphTarget.CreateOwned(MorphTargets); with morphTarget do begin Name := 'Frame' + IntToStr(i); @@ -90,8 +90,8 @@ procedure TgxMD2VectorFile.LoadFromStream(aStream: TStream); end; end; end; - if GetOwner is TgxActor then - with TgxActor(GetOwner).Animations do + if GetOwner is TGXActor then + with TGXActor(GetOwner).Animations do begin Clear; with MD2File do diff --git a/Sourcex/GXS.FileMD3.pas b/Sourcex/GXS.FileMD3.pas index 79eb8ef5..ce2a3bb9 100644 --- a/Sourcex/GXS.FileMD3.pas +++ b/Sourcex/GXS.FileMD3.pas @@ -17,11 +17,11 @@ interface GXS.Material, GXS.Texture, - Formatx.MD3; + Formats.MD3; type - TgxMD3VectorFile = class (TgxVectorFile) + TgxMD3VectorFile = class (TGXVectorFile) public class function Capabilities : TDataFileCapabilities; override; procedure LoadFromStream(aStream : TStream); override; @@ -46,9 +46,9 @@ procedure TgxMD3VectorFile.LoadFromStream(aStream : TStream); numVerts, numtris : Integer; MD3File : TFileMD3; - mesh : TgxMorphableMeshObject; + mesh : TGXMorphableMeshObject; faceGroup : TFGIndexTexCoordList; - morphTarget : TgxMeshMorphTarget; + morphTarget : TGXMeshMorphTarget; function GetNormalFromMD3Normal(n : array of Byte) : TAffineVector; var @@ -81,7 +81,7 @@ procedure TgxMD3VectorFile.LoadFromStream(aStream : TStream); MD3File.LoadFromStream(aStream); try for i:=0 to MD3File.ModelHeader.numMeshes-1 do begin - mesh:=TgxMorphableMeshObject.CreateOwned(Owner.MeshObjects); + mesh:=TGXMorphableMeshObject.CreateOwned(Owner.MeshObjects); mesh.Name:=trim(string(MD3File.MeshData[i].MeshHeader.strName)); with mesh, MD3File do begin Mode:=momFaceGroups; @@ -110,7 +110,7 @@ procedure TgxMD3VectorFile.LoadFromStream(aStream : TStream); // Get the mesh data for each morph frame for j:=0 to ModelHeader.numFrames-1 do begin - morphTarget:=TgxMeshMorphTarget.CreateOwned(MorphTargets); + morphTarget:=TGXMeshMorphTarget.CreateOwned(MorphTargets); morphTarget.Name:=Trim(string(MeshData[i].MeshHeader.strName))+'['+IntToStr(j)+']'; numVerts:=MeshData[i].MeshHeader.numVertices; morphTarget.Vertices.Capacity:=numVerts; diff --git a/Sourcex/GXS.FileMD5.pas b/Sourcex/GXS.FileMD5.pas index 80aec80b..a2f8e9e3 100644 --- a/Sourcex/GXS.FileMD5.pas +++ b/Sourcex/GXS.FileMD5.pas @@ -19,11 +19,11 @@ interface type - TgxMD5VectorFile = class(TgxVectorFile) + TgxMD5VectorFile = class(TGXVectorFile) private FMD5String, FTempString, FBoneNames: TStringList; FCurrentPos: Integer; - FBasePose: TgxSkeletonFrame; + FBasePose: TGXSkeletonFrame; FFramePositions: TGAffineVectorList; FFrameQuaternions: TGQuaternionList; FJointFlags: TGIntegerList; @@ -126,7 +126,7 @@ procedure TgxMD5VectorFile.LoadFromStream(aStream: TStream); quat: TQuaternion; mat, rmat: TMatrix4f; ParentBoneID: Integer; - bone, parentbone: TgxSkeletonBone; + bone, parentbone: TGXSkeletonBone; begin FTempString.CommaText := BoneString; @@ -148,11 +148,11 @@ procedure TgxMD5VectorFile.LoadFromStream(aStream: TStream); begin FBoneNames.Add(bonename); if ParentBoneID = -1 then - bone := TgxSkeletonBone.CreateOwned(Owner.Skeleton.RootBones) + bone := TGXSkeletonBone.CreateOwned(Owner.Skeleton.RootBones) else begin parentbone := Owner.Skeleton.RootBones.BoneByID(ParentBoneID); - bone := TgxSkeletonBone.CreateOwned(parentbone); + bone := TGXSkeletonBone.CreateOwned(parentbone); mat := QuaternionToMatrix(quat); mat.W := PointMake(pos); @@ -197,8 +197,8 @@ procedure TgxMD5VectorFile.LoadFromStream(aStream: TStream); procedure ReadMesh; var temp, shader: String; - mesh: TgxSkeletonMeshObject; - fg: TfgxVertexIndexList; + mesh: TGXSkeletonMeshObject; + fg: TFGXVertexIndexList; vnum, wnum, numverts, numweights: Integer; VertexWeightID, VertexWeightCount, VertexBoneRef: TGIntegerList; VertexWeight: TGSingleList; @@ -215,8 +215,8 @@ procedure TgxMD5VectorFile.LoadFromStream(aStream: TStream); numverts := 0; - mesh := TgxSkeletonMeshObject.CreateOwned(Owner.MeshObjects); - fg := TfgxVertexIndexList.CreateOwned(mesh.FaceGroups); + mesh := TGXSkeletonMeshObject.CreateOwned(Owner.MeshObjects); + fg := TFGXVertexIndexList.CreateOwned(mesh.FaceGroups); mesh.Mode := momFaceGroups; fg.Mode := fgmmTriangles; repeat @@ -326,7 +326,7 @@ procedure TgxMD5VectorFile.LoadFromStream(aStream: TStream); procedure ReadHierarchy; var temp: String; - bone: TgxSkeletonBone; + bone: TGXSkeletonBone; begin if not Assigned(FJointFlags) then begin @@ -376,7 +376,7 @@ procedure TgxMD5VectorFile.LoadFromStream(aStream: TStream); var temp: String; i, j: Integer; - frame: TgxSkeletonFrame; + frame: TGXSkeletonFrame; pos: TAffineVector; quat: TQuaternion; begin @@ -439,7 +439,7 @@ procedure TgxMD5VectorFile.LoadFromStream(aStream: TStream); i: Integer; begin for i := 0 to Owner.MeshObjects.Count - 1 do - TgxSkeletonMeshObject(Owner.MeshObjects[i]) + TGXSkeletonMeshObject(Owner.MeshObjects[i]) .PrepareBoneMatrixInvertedMeshes; end; @@ -480,7 +480,7 @@ procedure TgxMD5VectorFile.LoadFromStream(aStream: TStream); FFrameQuaternions := TGQuaternionList.Create; if Owner.Skeleton.Frames.Count = 0 then begin - FBasePose := TgxSkeletonFrame.CreateOwned(Owner.Skeleton.Frames); + FBasePose := TGXSkeletonFrame.CreateOwned(Owner.Skeleton.Frames); FBasePose.Position.Count := FNumJoints; FBasePose.TransformMode := sftQuaternion; FBasePose.Quaternion.Count := FNumJoints; @@ -491,8 +491,8 @@ procedure TgxMD5VectorFile.LoadFromStream(aStream: TStream); else if (temp = 'joints') then begin ReadJoints; - if Owner is TgxActor then - TgxActor(Owner).Reference := aarSkeleton; + if Owner is TGXActor then + TGXActor(Owner).Reference := aarSkeleton; end else if (temp = 'nummeshes') then begin @@ -525,10 +525,10 @@ procedure TgxMD5VectorFile.LoadFromStream(aStream: TStream); begin FFirstFrame := Owner.Skeleton.Frames.Count; for i := 1 to FNumFrames do - TgxSkeletonFrame.CreateOwned(Owner.Skeleton.Frames); - if Owner is TgxActor then + TGXSkeletonFrame.CreateOwned(Owner.Skeleton.Frames); + if Owner is TGXActor then begin - with TgxActor(Owner).Animations.Add do + with TGXActor(Owner).Animations.Add do begin Name := ChangeFileExt(ExtractFileName(ResourceName), ''); Reference := aarSkeleton; diff --git a/Sourcex/GXS.FileMDC.pas b/Sourcex/GXS.FileMDC.pas index 735e8aee..7c2e0b69 100644 --- a/Sourcex/GXS.FileMDC.pas +++ b/Sourcex/GXS.FileMDC.pas @@ -117,7 +117,7 @@ interface end; type - TgxMDCVectorFile = class(TgxVectorFile) + TgxMDCVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(AStream: TStream); override; @@ -144,9 +144,9 @@ procedure TgxMDCVectorFile.LoadFromStream(AStream: TStream); var I, J, K, NumVerts, Numtris: Integer; - Mesh: TgxMorphableMeshObject; + Mesh: TGXMorphableMeshObject; FaceGroup: TFGIndexTexCoordList; - MorphTarget: TgxMeshMorphTarget; + MorphTarget: TGXMeshMorphTarget; function UnpackNormal(Pn: TPackedNormal): TAffineVector; var @@ -228,7 +228,7 @@ procedure TgxMDCVectorFile.LoadFromStream(AStream: TStream); AStream.Position := FrameOffset + Surfheader.OffsetFrameCompFrames; AStream.Read(Compframetable[0], SizeOf(Word) * Fileheader.NumFrames); - Mesh := TgxMorphableMeshObject.CreateOwned(Owner.MeshObjects); + Mesh := TGXMorphableMeshObject.CreateOwned(Owner.MeshObjects); // easiest way to convert a char array to string ;) Mesh.Name := Trim(string(PChar(Surfheader.Name[0]))); with Mesh do @@ -257,7 +257,7 @@ procedure TgxMDCVectorFile.LoadFromStream(AStream: TStream); // Get the mesh data for each morph frame for J := 0 to Fileheader.NumFrames - 1 do begin - MorphTarget := TgxMeshMorphTarget.CreateOwned(MorphTargets); + MorphTarget := TGXMeshMorphTarget.CreateOwned(MorphTargets); MorphTarget.Name := Trim(string(Pchar(Surfheader.Name[0]))) + '[' + IntToStr(J) + ']'; NumVerts := Surfheader.NumVertices; diff --git a/Sourcex/GXS.FileMS3D.pas b/Sourcex/GXS.FileMS3D.pas index f87fd8fa..d1163f35 100644 --- a/Sourcex/GXS.FileMS3D.pas +++ b/Sourcex/GXS.FileMS3D.pas @@ -238,7 +238,7 @@ TVertexWeightList=class(TList) { The MilkShape vector file. By Mattias Fagerlund, mattias@cambrianlabs.com. Yada yada. Eric rules! } - TgxMS3DVectorFile = class(TgxVectorFile) + TgxMS3DVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -335,9 +335,9 @@ procedure TgxMS3DVectorFile.LoadFromStream(aStream: TStream); itemp: Cardinal; wtemp: word; TexCoordID: integer; - MO: TgxMeshObject; + MO: TGXMeshObject; FaceGroup: TFGVertexNormalTexIndexList; - Sk_MO: TgxSkeletonMeshObject; + Sk_MO: TGXSkeletonMeshObject; GroupList: TList; GLLibMaterial: TgxLibMaterial; @@ -366,8 +366,8 @@ procedure TgxMS3DVectorFile.LoadFromStream(aStream: TStream); ms3d_joints: PMS3DJointArray; bonelist: TStringList; - bone: TgxSkeletonBone; - frame: TgxSkeletonFrame; + bone: TGXSkeletonBone; + frame: TGXSkeletonFrame; rot, pos: TVector3f; //Tod @@ -466,13 +466,13 @@ procedure TgxMS3DVectorFile.LoadFromStream(aStream: TStream); aStream.ReadBuffer(nNumVertices, sizeof(nNumVertices)); // Create the vertex list - if Owner is TgxActor then + if Owner is TGXActor then begin - MO := TgxSkeletonMeshObject.CreateOwned(Owner.MeshObjects); - TgxSkeletonMeshObject(MO).BonesPerVertex := 4; + MO := TGXSkeletonMeshObject.CreateOwned(Owner.MeshObjects); + TGXSkeletonMeshObject(MO).BonesPerVertex := 4; end else - MO := TgxMeshObject.CreateOwned(Owner.MeshObjects); + MO := TGXMeshObject.CreateOwned(Owner.MeshObjects); MO.Mode := momFaceGroups; // Then comes nNumVertices * sizeof (ms3d_vertex_t) @@ -484,8 +484,8 @@ procedure TgxMS3DVectorFile.LoadFromStream(aStream: TStream); begin // Add the vertex to the vertexlist MO.Vertices.Add(vertex.v); - if Owner is TgxActor then - TgxSkeletonMeshObject(MO).AddWeightedBone(Byte(BoneID), 1); + if Owner is TGXActor then + TGXSkeletonMeshObject(MO).AddWeightedBone(Byte(BoneID), 1); end; // number of triangles @@ -630,9 +630,9 @@ procedure TgxMS3DVectorFile.LoadFromStream(aStream: TStream); aStream.ReadBuffer(fCurrentTime, sizeof(fCurrentTime)); aStream.ReadBuffer(iTotalFrames, sizeof(iTotalFrames)); - if Owner is TgxActor then + if Owner is TGXActor then begin - TgxActor(Owner).Interval := trunc(1 / fAnimationFPS * 1000); + TGXActor(Owner).Interval := trunc(1 / fAnimationFPS * 1000); end; // number of joints @@ -742,8 +742,8 @@ procedure TgxMS3DVectorFile.LoadFromStream(aStream: TStream); //Read in the vertex weights // aStream.ReadBuffer(subVersionVertexExtra, sizeof(subVersionVertexExtra)); - Sk_MO := TgxSkeletonMeshObject(MO); - if Owner is TgxActor then + Sk_MO := TGXSkeletonMeshObject(MO); + if Owner is TGXActor then begin for i := 0 to nNumVertices - 1 do begin @@ -808,7 +808,7 @@ procedure TgxMS3DVectorFile.LoadFromStream(aStream: TStream); // - Mete Ciragan // *** - if (Owner is TgxActor) and (nNumJoints > 0) then + if (Owner is TGXActor) and (nNumJoints > 0) then begin // Bone names are added to a list initally to sort out parents bonelist := TStringList.Create; @@ -819,15 +819,15 @@ procedure TgxMS3DVectorFile.LoadFromStream(aStream: TStream); begin j := bonelist.IndexOf(string(ms3d_joints^[i].Base.ParentName)); if j = -1 then - bone := TgxSkeletonBone.CreateOwned(Owner.Skeleton.RootBones) + bone := TGXSkeletonBone.CreateOwned(Owner.Skeleton.RootBones) else - bone := TgxSkeletonBone.CreateOwned(Owner.Skeleton.RootBones.BoneByID(j)); + bone := TGXSkeletonBone.CreateOwned(Owner.Skeleton.RootBones.BoneByID(j)); bone.Name := string(ms3d_joints^[i].Base.Name); bone.BoneID := i; end; bonelist.Free; // Set up the base pose - frame := TgxSkeletonFrame.CreateOwned(Owner.Skeleton.Frames); + frame := TGXSkeletonFrame.CreateOwned(Owner.Skeleton.Frames); for i := 0 to nNumJoints - 1 do begin pos := ms3d_joints^[i].Base.Position.V; @@ -842,7 +842,7 @@ procedure TgxMS3DVectorFile.LoadFromStream(aStream: TStream); for j := 0 to ms3d_joints^[i].Base.NumKeyFramesRot - 1 do begin if (j + 1) = Owner.Skeleton.Frames.Count then - frame := TgxSkeletonFrame.CreateOwned(Owner.Skeleton.Frames) + frame := TGXSkeletonFrame.CreateOwned(Owner.Skeleton.Frames) else frame := Owner.Skeleton.Frames[j + 1]; if ms3d_joints^[i].Base.ParentName = '' then @@ -863,8 +863,8 @@ procedure TgxMS3DVectorFile.LoadFromStream(aStream: TStream); end; end; Owner.Skeleton.RootBones.PrepareGlobalMatrices; - TgxSkeletonMeshObject(MO).PrepareBoneMatrixInvertedMeshes; - with TgxActor(Owner).Animations.Add do + TGXSkeletonMeshObject(MO).PrepareBoneMatrixInvertedMeshes; + with TGXActor(Owner).Animations.Add do begin Reference := aarSkeleton; StartFrame := 0; diff --git a/Sourcex/GXS.FileNMF.pas b/Sourcex/GXS.FileNMF.pas index cf63f02b..67acbf5e 100644 --- a/Sourcex/GXS.FileNMF.pas +++ b/Sourcex/GXS.FileNMF.pas @@ -41,7 +41,7 @@ TFileNMF = class end; type - TgxNMFVectorFile = class(TgxVectorFile) + TgxNMFVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -105,13 +105,13 @@ class function TgxNMFVectorFile.Capabilities: TDataFileCapabilities; procedure TgxNMFVectorFile.LoadFromStream(aStream: TStream); var i, j: Integer; - mesh: TgxMeshObject; + mesh: TGXMeshObject; nmf: TFileNMF; begin nmf := TFileNMF.Create; try nmf.LoadFromStream(aStream); - mesh := TgxMeshObject.CreateOwned(Owner.MeshObjects); + mesh := TGXMeshObject.CreateOwned(Owner.MeshObjects); mesh.Mode := momTriangles; for i := 0 to nmf.NumTris - 1 do begin diff --git a/Sourcex/GXS.FileNurbs.pas b/Sourcex/GXS.FileNurbs.pas index 2a29181a..895bc487 100644 --- a/Sourcex/GXS.FileNurbs.pas +++ b/Sourcex/GXS.FileNurbs.pas @@ -19,7 +19,7 @@ interface type - TgxNurbsVectorFile = class(TgxVectorFile) + TgxNurbsVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(stream: TStream); override; diff --git a/Sourcex/GXS.FileOBJ.pas b/Sourcex/GXS.FileOBJ.pas index 154ba4a2..5688490a 100644 --- a/Sourcex/GXS.FileOBJ.pas +++ b/Sourcex/GXS.FileOBJ.pas @@ -4,7 +4,7 @@ unit GXS.FileOBJ; (* - Support-Code to load Wavefront OBJ Files into TgxFreeForm-Components + Support-Code to load Wavefront OBJ Files into TGXFreeForm-Components in GLScene. Note that you must manually add this unit to one of your project's uses to enable support for OBJ & OBJF at run-time. @@ -46,7 +46,7 @@ interface type - TgxOBJVectorFile = class(TgxVectorFile) + TgxOBJVectorFile = class(TGXVectorFile) private FSourceStream: TStream; // Load from this stream FBuffer: AnsiString; // Buffer @@ -59,7 +59,7 @@ TgxOBJVectorFile = class(TgxVectorFile) procedure ReadLine; // Raise a class-specific exception procedure Error(const msg: string); - procedure CalcMissingOBJNormals(mesh: TgxMeshObject); + procedure CalcMissingOBJNormals(mesh: TGXMeshObject); public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -161,7 +161,7 @@ TOBJFGVertexNormalTexIndexList = class(TFGVertexNormalTexIndexList) procedure SetMode(aMode: TOBJFGMode); public procedure Assign(Source: TPersistent); override; - constructor CreateOwned(aOwner: TgxFaceGroups); override; + constructor CreateOwned(aOwner: TGXFaceGroups); override; destructor Destroy; override; procedure WriteToFiler(writer: TGVirtualWriter); override; procedure ReadFromFiler(reader: TGVirtualReader); override; @@ -176,7 +176,7 @@ TOBJFGVertexNormalTexIndexList = class(TFGVertexNormalTexIndexList) property ShowNormals: Boolean read FShowNormals write FShowNormals; end; -constructor TOBJFGVertexNormalTexIndexList.CreateOwned(aOwner: TgxFaceGroups); +constructor TOBJFGVertexNormalTexIndexList.CreateOwned(aOwner: TGXFaceGroups); begin inherited CreateOwned(aOwner); FMode := objfgmmTriangleStrip; @@ -525,7 +525,7 @@ class function TgxOBJVectorFile.Capabilities: TDataFileCapabilities; Result := [dfcRead, dfcWrite]; end; -procedure TgxOBJVectorFile.CalcMissingOBJNormals(mesh: TgxMeshObject); +procedure TgxOBJVectorFile.CalcMissingOBJNormals(mesh: TGXMeshObject); var VertexPool: PAffineVectorArray; N: TAffineVector; @@ -608,7 +608,7 @@ procedure TgxOBJVectorFile.LoadFromStream(aStream: TStream); var hv: THomogeneousVector; av: TAffineVector; - mesh: TgxMeshObject; + mesh: TGXMeshObject; faceGroup: TOBJFGVertexNormalTexIndexList; faceGroupNames: TStringList; @@ -763,10 +763,10 @@ procedure TgxOBJVectorFile.LoadFromStream(aStream: TStream); texName: string; libFilename: string; begin - if GetOwner is TgxBaseMesh then + if GetOwner is TGXBaseMesh then begin // got a linked material library? - matLib := TgxBaseMesh(GetOwner).MaterialLibrary; + matLib := TGXBaseMesh(GetOwner).MaterialLibrary; if Assigned(matLib) then begin Result := matName; @@ -884,7 +884,7 @@ procedure TgxOBJVectorFile.LoadFromStream(aStream: TStream); procedure SplitMesh; var i, j, Count: Integer; - newMesh: TgxMeshObject; + newMesh: TGXMeshObject; newfaceGroup: TOBJFGVertexNormalTexIndexList; VertexIdx, NormalIdx, TexCoordIdx: Integer; AffineVector: TAffineVector; @@ -893,7 +893,7 @@ procedure TgxOBJVectorFile.LoadFromStream(aStream: TStream); begin faceGroup := mesh.FaceGroups[i] as TOBJFGVertexNormalTexIndexList; - newMesh := TgxMeshObject.CreateOwned(Owner.MeshObjects); + newMesh := TGXMeshObject.CreateOwned(Owner.MeshObjects); newMesh.Mode := momFaceGroups; newMesh.Name := faceGroup.Name; @@ -945,7 +945,7 @@ procedure TgxOBJVectorFile.LoadFromStream(aStream: TStream); objMtlFileName := ''; curMtlName := ''; - mesh := TgxMeshObject.CreateOwned(Owner.MeshObjects); + mesh := TGXMeshObject.CreateOwned(Owner.MeshObjects); mesh.Mode := momFaceGroups; faceGroupNames := TStringList.Create; @@ -1173,7 +1173,7 @@ procedure TgxOBJVectorFile.SaveToStream(aStream: TStream); WriteLn(''); end; - procedure WriteVertexIndexList(fg: TfgxVertexIndexList; o: Integer = 0); + procedure WriteVertexIndexList(fg: TFGXVertexIndexList; o: Integer = 0); var i, N: Integer; begin @@ -1221,7 +1221,7 @@ procedure TgxOBJVectorFile.SaveToStream(aStream: TStream); procedure WriteFaceGroups; var j, i, k: Integer; - fg: TgxFaceGroup; + fg: TGXFaceGroup; MoName: string; begin k := 0; @@ -1237,8 +1237,8 @@ procedure TgxOBJVectorFile.SaveToStream(aStream: TStream); fg := Owner.MeshObjects[j].FaceGroups[i]; if fg is TOBJFGVertexNormalTexIndexList then WriteOBJFaceGroup(TOBJFGVertexNormalTexIndexList(fg), k) - else if fg is TfgxVertexIndexList then - WriteVertexIndexList(TfgxVertexIndexList(fg), k) + else if fg is TFGXVertexIndexList then + WriteVertexIndexList(TFGXVertexIndexList(fg), k) else Assert(False); // unsupported face group end; @@ -1248,7 +1248,7 @@ procedure TgxOBJVectorFile.SaveToStream(aStream: TStream); end; begin - Assert(Owner is TgxFreeForm, 'Can only save FreeForms.'); + Assert(Owner is TGXFreeForm, 'Can only save FreeForms.'); OldDecimalSeparator := FormatSettings.DecimalSeparator; FormatSettings.DecimalSeparator := '.'; diff --git a/Sourcex/GXS.FileOCT.pas b/Sourcex/GXS.FileOCT.pas index 1745b83c..885a7a71 100644 --- a/Sourcex/GXS.FileOCT.pas +++ b/Sourcex/GXS.FileOCT.pas @@ -3,7 +3,7 @@ // unit GXS.FileOCT; (* - Support-code to load OCT Files into TgxFreeForm-Components in GLScene. + Support-code to load OCT Files into TGXFreeForm-Components in GLScene. (OCT being the format output from FSRad, http://www.fluidstudios.com/fsrad.html). *) interface @@ -15,22 +15,23 @@ interface System.Classes, FMX.Graphics, - GXS.VectorFileObjects, GLScene.VectorGeometry, + GLScene.TextureFormat, + + GXS.VectorFileObjects, GXS.ApplicationFileIO, GXS.Texture, GXS.Material, GXS.Graphics, GXS.State, GXS.ImageUtils, - GXS.TextureFormat, - Formatx.OCT; + Formats.OCT; type // The OCT vector file (FSRad output). - TgxOCTgxVectorFile = class(TgxVectorFile) + TgxOCTgxVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -63,15 +64,15 @@ procedure TgxOCTgxVectorFile.LoadFromStream(aStream: TStream); oct: TOCTFile; octFace: POCTFace; octLightmap: POCTLightmap; - mo: TgxMeshObject; - fg: TfgxVertexIndexList; + mo: TGXMeshObject; + fg: TFGXVertexIndexList; lightmapLib: TgxMaterialLibrary; lightmapBmp: TBitmap; libMat: TgxLibMaterial; begin oct := TOCTFile.Create(aStream); try - mo := TgxMeshObject.CreateOwned(Owner.MeshObjects); + mo := TGXMeshObject.CreateOwned(Owner.MeshObjects); mo.Mode := momFaceGroups; lightmapLib := Owner.LightmapLibrary; @@ -137,7 +138,7 @@ procedure TgxOCTgxVectorFile.LoadFromStream(aStream: TStream); for i := 0 to n - 1 do begin octFace := @oct.Faces[i]; - fg := TfgxVertexIndexList.CreateOwned(mo.FaceGroups); + fg := TFGXVertexIndexList.CreateOwned(mo.FaceGroups); fg.Mode := fgmmTriangleFan; fg.VertexIndices.AddSerie(octFace.start, 1, octFace.num); if (Assigned(lightmapLib)) and (vFileOCTAllocateMaterials) then diff --git a/Sourcex/GXS.FilePGM.pas b/Sourcex/GXS.FilePGM.pas index 4f1959e9..dade302c 100644 --- a/Sourcex/GXS.FilePGM.pas +++ b/Sourcex/GXS.FilePGM.pas @@ -12,7 +12,7 @@ interface System.Classes, System.SysUtils, Winapi.OpenGL, Winapi.OpenGLext, - GXS.Context, GXS.Graphics, GXS.TextureFormat, + GXS.Context, GXS.Graphics, GLScene.TextureFormat, GXS.ApplicationFileIO; type diff --git a/Sourcex/GXS.FilePLY.pas b/Sourcex/GXS.FilePLY.pas index 9b608e72..780d0c9d 100644 --- a/Sourcex/GXS.FilePLY.pas +++ b/Sourcex/GXS.FilePLY.pas @@ -24,7 +24,7 @@ interface collection of polygons. The format is extensible, supports variations and subformats. This importer only works for the simplest variant (triangles without specified normals, and will ignore most header specifications. *) - TgxPLYVectorFile = class(TgxVectorFile) + TgxPLYVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -47,14 +47,14 @@ procedure TgxPLYVectorFile.LoadFromStream(aStream: TStream); var i, nbVertices, nbFaces: Integer; sl: TStringList; - mesh: TgxMeshObject; - fg: TfgxVertexIndexList; + mesh: TGXMeshObject; + fg: TFGXVertexIndexList; p: PChar; begin sl := TStringList.Create; try sl.LoadFromStream(aStream{$IFDEF Unicode}, TEncoding.ASCII{$ENDIF}); - mesh := TgxMeshObject.CreateOwned(Owner.MeshObjects); + mesh := TGXMeshObject.CreateOwned(Owner.MeshObjects); mesh.Mode := momFaceGroups; if sl[0] <> 'ply' then raise Exception.Create('Not a valid ply file !'); @@ -83,7 +83,7 @@ procedure TgxPLYVectorFile.LoadFromStream(aStream: TStream); Inc(i); end; // faces - fg := TfgxVertexIndexList.CreateOwned(mesh.FaceGroups); + fg := TFGXVertexIndexList.CreateOwned(mesh.FaceGroups); fg.Mode := fgmmTriangles; fg.VertexIndices.Capacity := nbFaces * 3; while (i < sl.Count) and (nbFaces > 0) do diff --git a/Sourcex/GXS.FilePNG.pas b/Sourcex/GXS.FilePNG.pas index 8538ca05..0e3a11eb 100644 --- a/Sourcex/GXS.FilePNG.pas +++ b/Sourcex/GXS.FilePNG.pas @@ -16,7 +16,7 @@ interface GXS.Context, GXS.Graphics, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.ApplicationFileIO; type diff --git a/Sourcex/GXS.FileQ3BSP.pas b/Sourcex/GXS.FileQ3BSP.pas index 797b2b4e..efc23c68 100644 --- a/Sourcex/GXS.FileQ3BSP.pas +++ b/Sourcex/GXS.FileQ3BSP.pas @@ -4,7 +4,7 @@ unit GXS.FileQ3BSP; (* - Support-code to load Q3BSP Files into TgxFreeForm-Components. + Support-code to load Q3BSP Files into TGXFreeForm-Components. Note that you must manually add this unit to one of your project's uses to enable support for OBJ & OBJF at run-time. *) @@ -29,14 +29,14 @@ interface GXS.State, GXS.ImageUtils, GXS.Material, - GXS.TextureFormat, + GLScene.TextureFormat, - Formatx.Q3BSP; + Formats.Q3BSP; type // The Q3BSP vector file (Quake III BSP). - TgxQ3BSPVectorFile = class(TgxVectorFile) + TgxQ3BSPVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -81,10 +81,10 @@ procedure TgxQ3BSPVectorFile.LoadFromStream(aStream: TStream); libMat: TgxLibMaterial; texName: string; begin - if GetOwner is TgxBaseMesh then + if GetOwner is TGXBaseMesh then begin // got a linked material library? - matLib := TgxBaseMesh(GetOwner).MaterialLibrary; + matLib := TGXBaseMesh(GetOwner).MaterialLibrary; if Assigned(matLib) then begin Result := matName; diff --git a/Sourcex/GXS.FileSMD.pas b/Sourcex/GXS.FileSMD.pas index 03c746cd..334f813d 100644 --- a/Sourcex/GXS.FileSMD.pas +++ b/Sourcex/GXS.FileSMD.pas @@ -29,7 +29,7 @@ interface Skeleton frames. This reader curently reads both, but requires that the main file (the one with mesh data) be read first. *) - TgxSMDVectorFile = class(TgxVectorFile) + TgxSMDVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -55,9 +55,9 @@ procedure TgxSMDVectorFile.LoadFromStream(aStream: TStream); var matLib: TgxMaterialLibrary; begin - if Owner is TgxBaseMesh then + if Owner is TGXBaseMesh then begin - matLib := TgxBaseMesh(GetOwner).MaterialLibrary; + matLib := TGXBaseMesh(GetOwner).MaterialLibrary; if Assigned(matLib) then begin if matLib.Materials.GetLibMaterialByName(name) = nil then @@ -84,14 +84,14 @@ procedure TgxSMDVectorFile.LoadFromStream(aStream: TStream); var i, j, k, nVert, nTex, firstFrame: Integer; nbBones, boneID: Integer; - mesh: TgxSkeletonMeshObject; + mesh: TGXSkeletonMeshObject; sl, tl: TStringList; - bone: TgxSkeletonBone; - frame: TgxSkeletonFrame; + bone: TGXSkeletonBone; + frame: TGXSkeletonFrame; faceGroup: TFGVertexNormalTexIndexList; v: TAffineVector; - boneIDs: TgxVertexBoneWeightDynArray; + boneIDs: TGXVertexBoneWeightDynArray; weightCount: Integer; begin sl := TStringList.Create; @@ -104,11 +104,11 @@ procedure TgxSMDVectorFile.LoadFromStream(aStream: TStream); raise Exception.Create('nodes not found'); if sl.IndexOf('triangles') >= 0 then begin - mesh := TgxSkeletonMeshObject.CreateOwned(Owner.MeshObjects); + mesh := TGXSkeletonMeshObject.CreateOwned(Owner.MeshObjects); mesh.Mode := momFaceGroups; end else if Owner.MeshObjects.Count > 0 then - mesh := (Owner.MeshObjects[0] as TgxSkeletonMeshObject) + mesh := (Owner.MeshObjects[0] as TGXSkeletonMeshObject) else raise Exception.Create('SMD is an animation, load model SMD first.'); // read skeleton nodes @@ -121,10 +121,10 @@ procedure TgxSMDVectorFile.LoadFromStream(aStream: TStream); tl.CommaText := sl[i]; with Owner.Skeleton do if (tl[2] <> '-1') then - bone := TgxSkeletonBone.CreateOwned + bone := TGXSkeletonBone.CreateOwned (RootBones.BoneByID(StrToInt(tl[2]))) else - bone := TgxSkeletonBone.CreateOwned(RootBones); + bone := TGXSkeletonBone.CreateOwned(RootBones); if Assigned(bone) then begin bone.boneID := StrToInt(tl[0]); @@ -150,7 +150,7 @@ procedure TgxSMDVectorFile.LoadFromStream(aStream: TStream); begin if Copy(sl[i], 1, 5) <> 'time ' then raise Exception.Create('time not found, got: ' + sl[i]); - frame := TgxSkeletonFrame.CreateOwned(Owner.Skeleton.Frames); + frame := TGXSkeletonFrame.CreateOwned(Owner.Skeleton.Frames); frame.name := ResourceName + ' ' + sl[i]; Inc(i); while Pos(Copy(sl[i], 1, 1), ' 1234567890') > 0 do @@ -176,8 +176,8 @@ procedure TgxSMDVectorFile.LoadFromStream(aStream: TStream); Assert(frame.Position.Count = nbBones, 'Invalid number of bones in frame ' + IntToStr(Owner.Skeleton.Frames.Count)); end; - if Owner is TgxActor then - with TgxActor(Owner).Animations.Add do + if Owner is TGXActor then + with TGXActor(Owner).Animations.Add do begin k := Pos('.', ResourceName); if k > 0 then @@ -269,7 +269,7 @@ procedure TgxSMDVectorFile.SaveToStream(aStream: TStream); i, j, k, l, b: Integer; p, r, v, n, t: TAffineVector; - procedure GetNodesFromBonesRecurs(bone: TgxSkeletonBone; ParentID: Integer; + procedure GetNodesFromBonesRecurs(bone: TGXSkeletonBone; ParentID: Integer; bl: TStrings); var i: Integer; @@ -317,8 +317,8 @@ procedure TgxSMDVectorFile.SaveToStream(aStream: TStream); begin str.Add('triangles'); for i := 0 to Owner.MeshObjects.Count - 1 do - if Owner.MeshObjects[i] is TgxSkeletonMeshObject then - with TgxSkeletonMeshObject(Owner.MeshObjects[i]) do + if Owner.MeshObjects[i] is TGXSkeletonMeshObject then + with TGXSkeletonMeshObject(Owner.MeshObjects[i]) do begin for j := 0 to FaceGroups.Count - 1 do with TFGVertexNormalTexIndexList(FaceGroups[j]) do diff --git a/Sourcex/GXS.FileSTL.pas b/Sourcex/GXS.FileSTL.pas index 9af39017..03719739 100644 --- a/Sourcex/GXS.FileSTL.pas +++ b/Sourcex/GXS.FileSTL.pas @@ -4,7 +4,7 @@ unit GXS.FileSTL; (* - Support-code to load STL Files into TgxFreeForm-Components. + Support-code to load STL Files into TGXFreeForm-Components. Note that you must manually add this unit to one of your project's uses to enable support for STL files at run-time. *) @@ -50,7 +50,7 @@ interface There are two flavors of STL, the "text" and the "binary", this class reads both, but exports only the "binary" version. Original Binary importer code by Paul M. Bearne, Text importer by Adem. *) - TgxSTLVectorFile = class(TgxVectorFile) + TgxSTLVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -117,7 +117,7 @@ procedure TgxSTLVectorFile.LoadFromStream(aStream: TStream); fileContent: TStringList; curLine: String; i: Integer; - mesh: TgxMeshObject; + mesh: TGXMeshObject; header: TSTLHeader; dataFace: TSTLFace; calcNormal: TAffineVector; @@ -138,7 +138,7 @@ procedure TgxSTLVectorFile.LoadFromStream(aStream: TStream); Inc(i); end; - mesh := TgxMeshObject.CreateOwned(Owner.MeshObjects); + mesh := TGXMeshObject.CreateOwned(Owner.MeshObjects); try mesh.Mode := momTriangles; diff --git a/Sourcex/GXS.FileTIN.pas b/Sourcex/GXS.FileTIN.pas index c035a0fc..d6a099cf 100644 --- a/Sourcex/GXS.FileTIN.pas +++ b/Sourcex/GXS.FileTIN.pas @@ -25,7 +25,7 @@ interface It is a simple text format, with one triangle record per line, no materials, no texturing (there may be more, but I never saw anything in this files). This format is encountered in the DEM/DTED world and used in place of grids. *) - TgxTINVectorFile = class(TgxVectorFile) + TgxTINVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -48,7 +48,7 @@ procedure TgxTINVectorFile.LoadFromStream(aStream: TStream); var i, j: Integer; sl, tl: TStringList; - mesh: TgxMeshObject; + mesh: TGXMeshObject; v1, v2, v3, n: TAffineVector; ActiveTin: Boolean; Id_Tin: Integer; @@ -63,7 +63,7 @@ procedure TgxTINVectorFile.LoadFromStream(aStream: TStream); tl := TStringList.Create; try sl.LoadFromStream(aStream); - mesh := TgxMeshObject.CreateOwned(Owner.MeshObjects); + mesh := TGXMeshObject.CreateOwned(Owner.MeshObjects); mesh.Mode := momTriangles; if sl[0] <> 'TIN' then // the file with single TIN described by vertices only diff --git a/Sourcex/GXS.FileVRML.pas b/Sourcex/GXS.FileVRML.pas index af21d26e..9b3dde7a 100644 --- a/Sourcex/GXS.FileVRML.pas +++ b/Sourcex/GXS.FileVRML.pas @@ -12,19 +12,20 @@ interface System.SysUtils, System.Math, - GXS.ApplicationFileIO, GLScene.VectorTypes, GLScene.VectorGeometry, GLScene.VectorLists, + + GXS.ApplicationFileIO, GXS.VectorFileObjects, GXS.Material, GXS.MeshUtils, - Formatx.VRML; + Formats.VRML; type - TgxVRMLVectorFile = class(TgxVectorFile) + TgxVRMLVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -161,7 +162,7 @@ class function TgxVRMLVectorFile.Capabilities: TDataFileCapabilities; procedure TgxVRMLVectorFile.LoadFromStream(aStream: TStream); var - mesh: TgxMeshObject; + mesh: TGXMeshObject; uniqueMatID: Integer; currentMaterial: TgxLibMaterial; currentTransform: TMatrix4f; @@ -238,7 +239,7 @@ procedure TgxVRMLVectorFile.LoadFromStream(aStream: TStream); procedure RebuildMesh; var i, j, k, l: Integer; - newfg: TfgxVertexIndexList; + newfg: TFGXVertexIndexList; fg: TFGVertexNormalTexIndexList; vertices, normals, texcoords, triNormals, newVertices, newNormals, newTexCoords: TGAffineVectorList; @@ -402,7 +403,7 @@ procedure TgxVRMLVectorFile.LoadFromStream(aStream: TStream); optimized.Offset(newVertices.Count); // Replace the facegroup with a vertex-only index list - newfg := TfgxVertexIndexList.Create; + newfg := TFGXVertexIndexList.Create; newfg.Owner := mesh.FaceGroups; newfg.Mode := fg.Mode; newfg.MaterialName := fg.MaterialName; @@ -495,7 +496,7 @@ procedure TgxVRMLVectorFile.LoadFromStream(aStream: TStream); if (node.Name = 'Coordinate3') and (node.Count > 0) then begin RebuildMesh; - mesh := TgxMeshObject.CreateOwned(Owner.MeshObjects); + mesh := TGXMeshObject.CreateOwned(Owner.MeshObjects); points := TVRMLSingleArray(node[0]).Values; for i := 0 to (points.Count div 3) - 1 do mesh.vertices.Add(points[3 * i], points[3 * i + 1], points[3 * i + 2]); diff --git a/Sourcex/GXS.FileX.pas b/Sourcex/GXS.FileX.pas index b29c2193..baa6fc26 100644 --- a/Sourcex/GXS.FileX.pas +++ b/Sourcex/GXS.FileX.pas @@ -21,10 +21,10 @@ interface GLScene.VectorLists, GXS.Material, - Formatx.X; + Formats.X; type - TgxXVectorFile = class(TgxVectorFile) + TgxXVectorFile = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -46,7 +46,7 @@ procedure TgxXVectorFile.LoadFromStream(aStream: TStream); procedure RecursDXFile(DXNode: TDXNode); var i, j, k, l, vertcount: integer; - mo: TgxMeshObject; + mo: TGXMeshObject; mat: TMatrix4f; libmat: TgxLibMaterial; fg: TFGVertexNormalTexIndexList; @@ -62,7 +62,7 @@ procedure TgxXVectorFile.LoadFromStream(aStream: TStream); if DXNode is TDXMesh then begin - mo := TgxMeshObject.CreateOwned(Owner.MeshObjects); + mo := TGXMeshObject.CreateOwned(Owner.MeshObjects); mo.Mode := momFaceGroups; mo.Vertices.Assign(TDXMesh(DXNode).Vertices); mo.Vertices.TransformAsPoints(mat); diff --git a/Sourcex/GXS.FireFX.pas b/Sourcex/GXS.FireFX.pas index f695b363..e806ba45 100644 --- a/Sourcex/GXS.FireFX.pas +++ b/Sourcex/GXS.FireFX.pas @@ -28,7 +28,7 @@ interface GXS.RenderContextInfo, GXS.State, GXS.PipelineTransformation, - GXS.TextureFormat; + GLScene.TextureFormat; type diff --git a/Sourcex/GXS.GeomObjects.pas b/Sourcex/GXS.GeomObjects.pas index 79c5a64c..ee065849 100644 --- a/Sourcex/GXS.GeomObjects.pas +++ b/Sourcex/GXS.GeomObjects.pas @@ -41,38 +41,38 @@ interface GXS.RenderContextInfo; type -//-------------------- TgxBaseMesh Objects ----------------------- +//-------------------- TGXBaseMesh Objects ----------------------- (* The tetrahedron has no texture coordinates defined, ie. without using a texture generation mode, no texture will be mapped. *) - TgxTetrahedron = class(TgxBaseMesh) + TgxTetrahedron = class(TGXBaseMesh) public procedure BuildList(var rci: TgxRenderContextInfo); override; end; (* The octahedron has no texture coordinates defined, ie. without using a texture generation mode, no texture will be mapped. *) - TgxOctahedron = class(TgxBaseMesh) + TgxOctahedron = class(TGXBaseMesh) public procedure BuildList(var rci: TgxRenderContextInfo); override; end; (* The hexahedron has no texture coordinates defined, ie. without using a texture generation mode, no texture will be mapped. *) - TgxHexahedron = class(TgxBaseMesh) + TgxHexahedron = class(TGXBaseMesh) public procedure BuildList(var rci: TgxRenderContextInfo); override; end; (* The dodecahedron has no texture coordinates defined, ie. without using a texture generation mode, no texture will be mapped. *) - TgxDodecahedron = class(TgxBaseMesh) + TgxDodecahedron = class(TGXBaseMesh) public procedure BuildList(var rci: TgxRenderContextInfo); override; end; (* The icosahedron has no texture coordinates defined, ie. without using a texture generation mode, no texture will be mapped. *) - TgxIcosahedron = class(TgxBaseMesh) + TgxIcosahedron = class(TGXBaseMesh) public procedure BuildList(var rci: TgxRenderContextInfo); override; end; diff --git a/Sourcex/GXS.Gizmo.pas b/Sourcex/GXS.Gizmo.pas index 57209645..d28d8d9f 100644 --- a/Sourcex/GXS.Gizmo.pas +++ b/Sourcex/GXS.Gizmo.pas @@ -1689,9 +1689,9 @@ procedure TgxGizmoUndoItem.AssignFromObject(const AObject begin SetEffectedObject(AObject); SetOldMatrix(AObject.Matrix^); - if AObject is TgxFreeForm then + if AObject is TGXFreeForm then begin - FOldAutoScaling.Assign(TgxFreeForm(AObject).AutoScaling); + FOldAutoScaling.Assign(TGXFreeForm(AObject).AutoScaling); end; FOldLibMaterialName := AObject.Material.LibMaterialName; end; @@ -1712,8 +1712,8 @@ destructor TgxGizmoUndoItem.Destroy; procedure TgxGizmoUndoItem.DoUndo; begin FEffectedObject.SetMatrix(FOldMatr); - if FEffectedObject is TgxFreeForm then - TgxFreeForm(FEffectedObject).AutoScaling.Assign(FOldAutoScaling); + if FEffectedObject is TGXFreeForm then + TGXFreeForm(FEffectedObject).AutoScaling.Assign(FOldAutoScaling); FEffectedObject.Material.LibMaterialName := FOldLibMaterialName; end; diff --git a/Sourcex/GXS.GizmoEx.pas b/Sourcex/GXS.GizmoEx.pas index 53ec8fc1..150000d5 100644 --- a/Sourcex/GXS.GizmoEx.pas +++ b/Sourcex/GXS.GizmoEx.pas @@ -4205,8 +4205,8 @@ procedure TgxGizmoExObjectItem.AssignFromObject(const AObject: TgxBaseSceneObjec begin EffectedObject := AObject; SetOldMatrix(AObject.Matrix^); - if AObject is TgxFreeForm then - FOldAutoScaling := TgxFreeForm(AObject).AutoScaling.AsVector; + if AObject is TGXFreeForm then + FOldAutoScaling := TGXFreeForm(AObject).AutoScaling.AsVector; end else begin @@ -4254,8 +4254,8 @@ procedure TgxGizmoExObjectItem.DoUndo; if not FReturnObject then begin FEffectedObject.SetMatrix(FOldMatrix); - if FEffectedObject is TgxFreeForm then - TgxFreeForm(FEffectedObject).AutoScaling.AsVector := FOldAutoScaling; + if FEffectedObject is TGXFreeForm then + TGXFreeForm(FEffectedObject).AutoScaling.AsVector := FOldAutoScaling; end else begin diff --git a/Sourcex/GXS.Graphics.pas b/Sourcex/GXS.Graphics.pas index 7c092dad..cef097e1 100644 --- a/Sourcex/GXS.Graphics.pas +++ b/Sourcex/GXS.Graphics.pas @@ -40,7 +40,7 @@ interface GXS.ImageUtils, GLScene.Utils, GXS.Color, - GXS.TextureFormat, + GLScene.TextureFormat, GLScene.Strings; type diff --git a/Sourcex/GXS.ImageUtils.pas b/Sourcex/GXS.ImageUtils.pas index 30342f14..a6a89814 100644 --- a/Sourcex/GXS.ImageUtils.pas +++ b/Sourcex/GXS.ImageUtils.pas @@ -35,7 +35,7 @@ interface GLScene.Strings, GLScene.VectorGeometry, GLScene.Utils, - GXS.TextureFormat; + GLScene.TextureFormat; var vImageScaleFilterWidth: Integer = 5; // Relative sample radius for filtering diff --git a/Sourcex/GXS.Imposter.pas b/Sourcex/GXS.Imposter.pas index 215d522b..472fe7d3 100644 --- a/Sourcex/GXS.Imposter.pas +++ b/Sourcex/GXS.Imposter.pas @@ -29,7 +29,7 @@ interface GLScene.BaseClasses, GXS.State, GXS.PipelineTransformation, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.ImageUtils; type diff --git a/Sourcex/GXS.Isolines.pas b/Sourcex/GXS.Isolines.pas index 04f7bc21..ad92a291 100644 --- a/Sourcex/GXS.Isolines.pas +++ b/Sourcex/GXS.Isolines.pas @@ -84,7 +84,7 @@ TgxIsolines = class(TgxLines) Z_Kfix - res3Dmin - *) - procedure Conrec(PlaneSFindex:Integer; PlaneSF: TgxFreeForm; + procedure Conrec(PlaneSFindex:Integer; PlaneSF: TGXFreeForm; Data: TMatrixArr; ilb, iub, jlb, jub: Integer; X: TVectorArr; Y: TVectorArr; NC: Integer; HgtL: TVectorArr; Z_Kfix: Single; res3Dmax, res3Dmin: Single); diff --git a/Sourcex/GXS.Isosurface.pas b/Sourcex/GXS.Isosurface.pas index dd376b27..a13493d5 100644 --- a/Sourcex/GXS.Isosurface.pas +++ b/Sourcex/GXS.Isosurface.pas @@ -130,7 +130,7 @@ TgxMarchingCube = class(TObject) procedure FillVoxelData(AIsoValue: TScalarValue; AScalarField: TScalarFieldInt); overload; virtual; procedure CalcVertices(Vertices: TgxVertexList; Alpha: Single = 1); - procedure CalcMeshObject(AMeshObject: TgxMeshObject; Alpha: Single = 1); + procedure CalcMeshObject(AMeshObject: TGXMeshObject; Alpha: Single = 1); property IsoValue: TScalarValue read FIsoValue write FIsoValue; // TODO end; @@ -1550,7 +1550,7 @@ procedure TgxMarchingCube.CalcVertices(Vertices: TgxVertexList; end; end; -procedure TgxMarchingCube.CalcMeshObject(AMeshObject: TgxMeshObject; Alpha: Single); +procedure TgxMarchingCube.CalcMeshObject(AMeshObject: TGXMeshObject; Alpha: Single); var i: Integer; begin @@ -1558,7 +1558,7 @@ procedure TgxMarchingCube.CalcMeshObject(AMeshObject: TgxMeshObject; Alpha: Sing AMeshObject.Vertices.Capacity := _Nverts; AMeshObject.Normals.Capacity := _Nverts; AMeshObject.Colors.Capacity := _Nverts; - with TfgxVertexIndexList.CreateOwned(AMeshObject.FaceGroups) do + with TFGXVertexIndexList.CreateOwned(AMeshObject.FaceGroups) do begin Mode := fgmmTriangles; for i := 0 to _Nverts - 1 do diff --git a/Sourcex/GXS.LensFlare.pas b/Sourcex/GXS.LensFlare.pas index 434566ae..16abdedd 100644 --- a/Sourcex/GXS.LensFlare.pas +++ b/Sourcex/GXS.LensFlare.pas @@ -30,7 +30,7 @@ interface GXS.RenderContextInfo, GXS.State, GXS.ImageUtils, - GXS.TextureFormat; + GLScene.TextureFormat; type diff --git a/Sourcex/GXS.Material.pas b/Sourcex/GXS.Material.pas index 0bb27034..1de7f996 100644 --- a/Sourcex/GXS.Material.pas +++ b/Sourcex/GXS.Material.pas @@ -33,7 +33,7 @@ interface GXS.Color, GLScene.Coordinates, GXS.State, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.Graphics, GXS.ImageUtils; diff --git a/Sourcex/GXS.MaterialScript.pas b/Sourcex/GXS.MaterialScript.pas index f04082e8..abf17e9d 100644 --- a/Sourcex/GXS.MaterialScript.pas +++ b/Sourcex/GXS.MaterialScript.pas @@ -18,7 +18,7 @@ interface GLScene.VectorTypes, GLScene.Utils, GXS.Texture, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.Graphics, GXS.ImageUtils, GXS.Color, diff --git a/Sourcex/GXS.MeshBuilder.pas b/Sourcex/GXS.MeshBuilder.pas index c6dcf216..97a7925c 100644 --- a/Sourcex/GXS.MeshBuilder.pas +++ b/Sourcex/GXS.MeshBuilder.pas @@ -21,10 +21,10 @@ interface GLScene.VectorGeometry, GLScene.VectorLists; -procedure BuildCube(Mesh: TgxMeshObject; Position, Scale: TAffineVector); -procedure BuildCylinder(Mesh: TgxMeshObject; Position, Scale: TAffineVector; +procedure BuildCube(Mesh: TGXMeshObject; Position, Scale: TAffineVector); +procedure BuildCylinder(Mesh: TGXMeshObject; Position, Scale: TAffineVector; Slices: Integer); -procedure BuildCylinder2(Mesh: TgxMeshObject; Position, Scale: TAffineVector; +procedure BuildCylinder2(Mesh: TGXMeshObject; Position, Scale: TAffineVector; TopRadius, BottomRadius, Height: single; Slices: Integer); // ---------------------------------------------------------------------------- @@ -40,7 +40,7 @@ function VectorCombineWeighted(Position, Scale: TAffineVector; X, Y, Z: single) Result.Z := Position.Z + Scale.Z * Z; end; -procedure BuildCube(Mesh: TgxMeshObject; Position, Scale: TAffineVector); +procedure BuildCube(Mesh: TGXMeshObject; Position, Scale: TAffineVector); var FGR: TFGVertexNormalTexIndexList; VertexOffset: Integer; @@ -153,7 +153,7 @@ procedure BuildCube(Mesh: TgxMeshObject; Position, Scale: TAffineVector); TextureOffset + 6); end; -procedure BuildCylinder(Mesh: TgxMeshObject; Position, Scale: TAffineVector; +procedure BuildCylinder(Mesh: TGXMeshObject; Position, Scale: TAffineVector; Slices: Integer); var FGR: TFGVertexNormalTexIndexList; @@ -239,7 +239,7 @@ procedure BuildCylinder(Mesh: TgxMeshObject; Position, Scale: TAffineVector; end; -procedure BuildCylinder2(Mesh: TgxMeshObject; Position, Scale: TAffineVector; +procedure BuildCylinder2(Mesh: TGXMeshObject; Position, Scale: TAffineVector; TopRadius, BottomRadius, Height: single; Slices: Integer); var FGR: TFGVertexNormalTexIndexList; diff --git a/Sourcex/GXS.MeshCSG.pas b/Sourcex/GXS.MeshCSG.pas index 10fb4187..4d2f88d2 100644 --- a/Sourcex/GXS.MeshCSG.pas +++ b/Sourcex/GXS.MeshCSG.pas @@ -32,7 +32,7 @@ interface type TCSGOperation = (CSG_Union, CSG_Subtraction, CSG_Intersection); -procedure CSG_Operation(obj1, obj2: TgxMeshObject; Operation: TCSGOperation; Res: TgxMeshObject; const MaterialName1, MaterialName2: string); +procedure CSG_Operation(obj1, obj2: TGXMeshObject; Operation: TCSGOperation; Res: TGXMeshObject; const MaterialName1, MaterialName2: string); //---------------------------------------------------------------------- implementation @@ -76,7 +76,7 @@ function MakeCSGTri(const V1, V2, V3: PAffineVector): TCSGTri; end; procedure CSG_Iterate_tri(const vec, nor: TCSGTri; BSP: TBSPMeshObject; - Node: TFGBSPNode; ResMesh: TgxMeshObject; ResFG: TFGVertexNormalTexIndexList; keepinside, keepoutside, inverttriangle: Boolean); + Node: TFGBSPNode; ResMesh: TGXMeshObject; ResFG: TFGVertexNormalTexIndexList; keepinside, keepoutside, inverttriangle: Boolean); var vertex_offset: Integer; @@ -507,8 +507,8 @@ procedure CSG_Iterate_tri(const vec, nor: TCSGTri; BSP: TBSPMeshObject; end; end; -procedure CSG_Operation(obj1, obj2: TgxMeshObject; Operation: TCSGOperation; - Res: TgxMeshObject; const MaterialName1, MaterialName2: string); +procedure CSG_Operation(obj1, obj2: TGXMeshObject; Operation: TCSGOperation; + Res: TGXMeshObject; const MaterialName1, MaterialName2: string); var v1, t1, n1: TGAffineVectorList; diff --git a/Sourcex/GXS.MeshLines.pas b/Sourcex/GXS.MeshLines.pas index 64af587b..8f2ba4dc 100644 --- a/Sourcex/GXS.MeshLines.pas +++ b/Sourcex/GXS.MeshLines.pas @@ -125,14 +125,14 @@ TLightmapBounds = class(TGCustomCoordinates) property Height: Single read GetHeight; end; - TgxMeshLines = class(TgxFreeForm) + TgxMeshLines = class(TGXFreeForm) private FLines: TLineCollection; - FMesh: TgxMeshObject; + FMesh: TGXMeshObject; FLightmapBounds: TLightmapBounds; FLightmapIndex: Integer; FLightmapMaterialName: String; - FFaceGroup: TfgxVertexIndexList; + FFaceGroup: TFGXVertexIndexList; FIndex: Integer; FNoZWrite: boolean; FShowNodes: Boolean; @@ -538,9 +538,9 @@ procedure TgxMeshLines.BuildGeometry; FMeshObjects.Clear; lFirstLineDone := False; - FMesh := TgxMeshObject.CreateOwned(FMeshObjects); + FMesh := TGXMeshObject.CreateOwned(FMeshObjects); FMesh.Mode := momFaceGroups; - FFaceGroup := TfgxVertexIndexList.CreateOwned(FMesh.FaceGroups); + FFaceGroup := TFGXVertexIndexList.CreateOwned(FMesh.FaceGroups); FFaceGroup.Mode := fgmmTriangleStrip; FFaceGroup.LightMapIndex := FLightmapIndex; FIndex := 0; diff --git a/Sourcex/GXS.MeshOptimizer.pas b/Sourcex/GXS.MeshOptimizer.pas index f137f67c..996fec54 100644 --- a/Sourcex/GXS.MeshOptimizer.pas +++ b/Sourcex/GXS.MeshOptimizer.pas @@ -26,28 +26,28 @@ interface var vDefaultMeshOptimizerOptions : TMeshOptimizerOptions = [mooStandardize, mooVertexCache, mooSortByMaterials, mooMergeObjects]; -procedure OptimizeMesh(aList : TgxMeshObjectList; options : TMeshOptimizerOptions); overload; -procedure OptimizeMesh(aList : TgxMeshObjectList); overload; -procedure OptimizeMesh(aMeshObject : TgxMeshObject; options : TMeshOptimizerOptions); overload; -procedure OptimizeMesh(aMeshObject : TgxMeshObject); overload; -procedure FacesSmooth(aMeshObj: TgxMeshObject; aWeldDistance: Single=0.0000001; aThreshold: Single=35.0; InvertNormals:boolean=false); +procedure OptimizeMesh(aList : TGXMeshObjectList; options : TMeshOptimizerOptions); overload; +procedure OptimizeMesh(aList : TGXMeshObjectList); overload; +procedure OptimizeMesh(aMeshObject : TGXMeshObject; options : TMeshOptimizerOptions); overload; +procedure OptimizeMesh(aMeshObject : TGXMeshObject); overload; +procedure FacesSmooth(aMeshObj: TGXMeshObject; aWeldDistance: Single=0.0000001; aThreshold: Single=35.0; InvertNormals:boolean=false); // ------------------------------------------------------------------ implementation // ------------------------------------------------------------------ -procedure OptimizeMesh(aList : TgxMeshObjectList); +procedure OptimizeMesh(aList : TGXMeshObjectList); begin OptimizeMesh(aList, vDefaultMeshOptimizerOptions); end; -procedure OptimizeMesh(aList : TgxMeshObjectList; options : TMeshOptimizerOptions); +procedure OptimizeMesh(aList : TGXMeshObjectList; options : TMeshOptimizerOptions); var i, k : Integer; - mob, mo : TgxMeshObject; - fg : TgxFaceGroup; - fgvi : TfgxVertexIndexList; + mob, mo : TGXMeshObject; + fg : TGXFaceGroup; + fgvi : TFGXVertexIndexList; begin // optimize all mesh objects for i:=0 to aList.Count-1 do begin @@ -72,7 +72,7 @@ procedure OptimizeMesh(aList : TgxMeshObjectList; options : TMeshOptimizerOption mob.TexCoords.Add(mo.TexCoords); while mo.FaceGroups.Count>0 do begin fg:=mo.FaceGroups[0]; - fgvi:=(fg as TfgxVertexIndexList); + fgvi:=(fg as TFGXVertexIndexList); fgvi.Owner:=mob.FaceGroups; mob.FaceGroups.Add(fgvi); mo.FaceGroups.Delete(0); @@ -84,15 +84,15 @@ procedure OptimizeMesh(aList : TgxMeshObjectList; options : TMeshOptimizerOption end; end; -procedure OptimizeMesh(aMeshObject : TgxMeshObject); +procedure OptimizeMesh(aMeshObject : TGXMeshObject); begin OptimizeMesh(aMeshObject, vDefaultMeshOptimizerOptions); end; -procedure OptimizeMesh(aMeshObject : TgxMeshObject; options : TMeshOptimizerOptions); +procedure OptimizeMesh(aMeshObject : TGXMeshObject; options : TMeshOptimizerOptions); var i : Integer; - fg : TgxFaceGroup; + fg : TGXFaceGroup; coords, texCoords, normals : TGAffineVectorList; il : TGIntegerList; materialName : String; @@ -126,9 +126,9 @@ procedure OptimizeMesh(aMeshObject : TgxMeshObject; options : TMeshOptimizerOpti aMeshObject.Vertices:=coords; aMeshObject.Normals:=normals; aMeshObject.TexCoords:=texCoords; - fg:=TfgxVertexIndexList.CreateOwned(aMeshObject.FaceGroups); + fg:=TFGXVertexIndexList.CreateOwned(aMeshObject.FaceGroups); fg.MaterialName:=materialName; - TfgxVertexIndexList(fg).VertexIndices:=il; + TFGXVertexIndexList(fg).VertexIndices:=il; end; finally il.Free; @@ -145,7 +145,7 @@ procedure OptimizeMesh(aMeshObject : TgxMeshObject; options : TMeshOptimizerOpti if (mooVertexCache in options) and (aMeshObject.Mode=momFaceGroups) then begin for i:=0 to aMeshObject.FaceGroups.Count-1 do begin fg:=aMeshObject.FaceGroups[i]; - if fg.ClassType=TfgxVertexIndexList then with TfgxVertexIndexList(fg) do begin + if fg.ClassType=TFGXVertexIndexList then with TFGXVertexIndexList(fg) do begin if Mode in [fgmmTriangles, fgmmFlatTriangles] then IncreaseCoherency(VertexIndices, 12); end; @@ -158,7 +158,7 @@ procedure OptimizeMesh(aMeshObject : TgxMeshObject; options : TMeshOptimizerOpti -procedure FacesSmooth(aMeshObj: TgxMeshObject; aWeldDistance: Single=0.0000001; aThreshold: Single=35.0; InvertNormals:boolean=false); +procedure FacesSmooth(aMeshObj: TGXMeshObject; aWeldDistance: Single=0.0000001; aThreshold: Single=35.0; InvertNormals:boolean=false); Var I, J, K, L: integer; WeldedVertex: TGAffineVectorList; @@ -170,8 +170,8 @@ procedure FacesSmooth(aMeshObj: TgxMeshObject; aWeldDistance: Single=0.0000001; FaceList: TGIntegerList; NormalList: TGAffineVectorList; FaceNormalList: TGAffineVectorList; - FaceGroup: TgxFaceGroup; - FG, FG1: TfgxVertexIndexList; + FaceGroup: TGXFaceGroup; + FG, FG1: TFGXVertexIndexList; Threshold: Single; Angle: Single; ReferenceMap: TGIntegerList; @@ -232,7 +232,7 @@ procedure FacesSmooth(aMeshObj: TgxMeshObject; aWeldDistance: Single=0.0000001; for I:=0 to aMeshObj.FaceGroups.Count-1 do begin FaceGroup := aMeshObj.FaceGroups[I]; - TmpIntegerList := TfgxVertexIndexList(FaceGroup).VertexIndices; + TmpIntegerList := TFGXVertexIndexList(FaceGroup).VertexIndices; for J:=0 to (TmpIntegerList.Count div 3)-1 do begin FaceList.Add(I); @@ -253,14 +253,14 @@ procedure FacesSmooth(aMeshObj: TgxMeshObject; aWeldDistance: Single=0.0000001; begin Index := FaceList[I*2+0]; Index1 := FaceList[I*2+1]; - FG := TfgxVertexIndexList(aMeshObj.FaceGroups[Index]); + FG := TFGXVertexIndexList(aMeshObj.FaceGroups[Index]); for J:=0 to 2 do begin for K:=0 to (FaceList.Count div 2)-1 do begin Index2 := FaceList[K*2+0]; Index3 := FaceList[K*2+1]; - FG1 := TfgxVertexIndexList(aMeshObj.FaceGroups[Index2]); + FG1 := TFGXVertexIndexList(aMeshObj.FaceGroups[Index2]); if I<>K then begin for L:=0 to 2 do @@ -285,7 +285,7 @@ procedure FacesSmooth(aMeshObj: TgxMeshObject; aWeldDistance: Single=0.0000001; for I:=0 to (FaceList.Count div 2)-1 do begin Index := FaceList[I*2+0]; - FG := TfgxVertexIndexList(aMeshObj.FaceGroups[Index]); + FG := TFGXVertexIndexList(aMeshObj.FaceGroups[Index]); Index := FaceList[I*2+1]; aMeshObj.Normals[FG.VertexIndices[(Index*3+0)]] := NormalList[(I*3+0)]; aMeshObj.Normals[FG.VertexIndices[(Index*3+1)]] := NormalList[(I*3+1)]; diff --git a/Sourcex/GXS.MultisampleImage.pas b/Sourcex/GXS.MultisampleImage.pas index 1934f53f..337938bd 100644 --- a/Sourcex/GXS.MultisampleImage.pas +++ b/Sourcex/GXS.MultisampleImage.pas @@ -22,7 +22,7 @@ interface GXS.Context, GXS.Texture, GXS.Graphics, - GXS.TextureFormat; + GLScene.TextureFormat; type diff --git a/Sourcex/GXS.NGDManager.pas b/Sourcex/GXS.NGDManager.pas index 6eeb27c3..49669133 100644 --- a/Sourcex/GXS.NGDManager.pas +++ b/Sourcex/GXS.NGDManager.pas @@ -1450,9 +1450,9 @@ function TgxNGDBehaviour.GetConvexCollision: PNewtonCollision; I, J: Integer; vertexArray: array of TVertex; begin - if FOwnerBaseSceneObject is TgxBaseMesh then + if FOwnerBaseSceneObject is TGXBaseMesh then begin - with (FOwnerBaseSceneObject as TgxBaseMesh) do + with (FOwnerBaseSceneObject as TGXBaseMesh) do begin for I := 0 to MeshObjects.Count - 1 do for J := 0 to MeshObjects[I].Vertices.Count - 1 do @@ -1493,9 +1493,9 @@ function TgxNGDBehaviour.GetMeshCollision: PNewtonCollision; I, J: Integer; vertexArray: array of TVertex; begin - if FOwnerBaseSceneObject is TgxBaseMesh then + if FOwnerBaseSceneObject is TGXBaseMesh then begin - with (FOwnerBaseSceneObject as TgxBaseMesh) do + with (FOwnerBaseSceneObject as TGXBaseMesh) do begin // Iterate trough mesh of GLobject @@ -1623,9 +1623,9 @@ function TgxNGDBehaviour.GetTreeCollision: PNewtonCollision; v: array [0 .. 2] of TAffineVector; begin - if FOwnerBaseSceneObject is TgxBaseMesh then + if FOwnerBaseSceneObject is TGXBaseMesh then begin - with (FOwnerBaseSceneObject as TgxBaseMesh) do + with (FOwnerBaseSceneObject as TGXBaseMesh) do begin Result := NewtonCreateTreeCollision(FManager.FNewtonWorld, 0); NewtonTreeCollisionBeginBuild(Result); diff --git a/Sourcex/GXS.NGDRagdoll.pas b/Sourcex/GXS.NGDRagdoll.pas index edf6803a..346da658 100644 --- a/Sourcex/GXS.NGDRagdoll.pas +++ b/Sourcex/GXS.NGDRagdoll.pas @@ -25,7 +25,7 @@ TNewtonRagdoll = class procedure SetEnabled(value: boolean); procedure Clean; public - Actor: TgxActor; + Actor: TGXActor; Bodies: TList; Joints: array of PNewtonJoint; Norm_matrices: array of TMatrix4f; @@ -40,7 +40,7 @@ TNewtonRagdoll = class property AngleLimit: single read FAngleLimit write SetAngleLimit; property ERP: single read FERP write SetERP; -constructor Create(model: TgxActor; world: PNewtonWorld; +constructor Create(model: TGXActor; world: PNewtonWorld; min_env_size: single = 0.8; slide_limit: single = 0.5; erp_: single = 0.8; angle_limit: single = 15; full: boolean = true); procedure Conform; @@ -50,7 +50,7 @@ procedure SaveToFile(filename: string); function TranslatePos(n: integer; add: boolean): TVector4f; end; -function GetBoneParent(actor: TgxActor; bone: integer): integer; +function GetBoneParent(actor: TGXActor; bone: integer): integer; // ===================================== implementation diff --git a/Sourcex/GXS.ODERagdoll.pas b/Sourcex/GXS.ODERagdoll.pas index a7847299..ed51124f 100644 --- a/Sourcex/GXS.ODERagdoll.pas +++ b/Sourcex/GXS.ODERagdoll.pas @@ -109,7 +109,7 @@ TgxODERagdoll = class(TgxRagdoll) FGLXceneRoot: TgxBaseSceneObject; FShowBoundingBoxes: Boolean; public - constructor Create(aOwner: TgxBaseMesh); + constructor Create(aOwner: TGXBaseMesh); property ODEWorld: TgxODERagdollWorld read FODEWorld write FODEWorld; property GLXceneRoot: TgxBaseSceneObject read FGLXceneRoot write FGLXceneRoot; @@ -385,7 +385,7 @@ procedure TgxODERagdollBone.Align; // TgxODERagdoll //------------------------------------ -constructor TgxODERagdoll.Create(aOwner: TgxBaseMesh); +constructor TgxODERagdoll.Create(aOwner: TGXBaseMesh); begin inherited Create(aOwner); FShowBoundingBoxes := False; diff --git a/Sourcex/GXS.ODESkeletonColliders.pas b/Sourcex/GXS.ODESkeletonColliders.pas index 8c39ffc1..9957c452 100644 --- a/Sourcex/GXS.ODESkeletonColliders.pas +++ b/Sourcex/GXS.ODESkeletonColliders.pas @@ -20,7 +20,7 @@ interface type // Base ODE skeleton collider class. - TSCODEBase = class(TgxSkeletonCollider) + TSCODEBase = class(TGXSkeletonCollider) private FGeom: PdxGeom; public @@ -82,7 +82,7 @@ TSCODEBox = class(TSCODEBase) (* After loading call this function to add all the geoms in a skeleton collider list to a given ODE space. *) -procedure AddSCODEGeomsToODESpace(colliders: TgxSkeletonColliderList; +procedure AddSCODEGeomsToODESpace(colliders: TGXSkeletonColliderList; Space: PdxSpace); // ------------------------------------------------------------------ @@ -94,7 +94,7 @@ implementation // ------------------ Global methods ------------------ // ------------------ -procedure AddSCODEGeomsToODESpace(colliders: TgxSkeletonColliderList; +procedure AddSCODEGeomsToODESpace(colliders: TGXSkeletonColliderList; Space: PdxSpace); var i: Integer; diff --git a/Sourcex/GXS.ODEUtils.pas b/Sourcex/GXS.ODEUtils.pas index d3d56602..72cbf883 100644 --- a/Sourcex/GXS.ODEUtils.pas +++ b/Sourcex/GXS.ODEUtils.pas @@ -67,7 +67,7 @@ function CreateBodyFromCube(var Geom: PdxGeom; Cube: TgxCube; World: PdxWorld; (* This method requires you to manually deallocate vertices and indices when you're done with the trimesh *) -function CreateTriMeshFromBaseMesh(BaseMesh: TgxBaseMesh; Space: PdxSpace; +function CreateTriMeshFromBaseMesh(BaseMesh: TGXBaseMesh; Space: PdxSpace; var Vertices: PdVector3Array; var Indices: PdIntegerArray): PdxGeom; function SceneMatrixFromGeom(Geom: PdxGeom): TMatrix4f; @@ -420,7 +420,7 @@ function CreateBodyFromCube(var Geom: PdxGeom; Cube: TgxCube; World: PdxWorld; S end; end; -function CreateTriMeshFromBaseMesh(BaseMesh: TgxBaseMesh; Space: PdxSpace; +function CreateTriMeshFromBaseMesh(BaseMesh: TGXBaseMesh; Space: PdxSpace; var Vertices: PdVector3Array; var Indices: PdIntegerArray): PdxGeom; var i, j, p: integer; diff --git a/Sourcex/GXS.Objects.pas b/Sourcex/GXS.Objects.pas index fd21b467..54fa099f 100644 --- a/Sourcex/GXS.Objects.pas +++ b/Sourcex/GXS.Objects.pas @@ -462,7 +462,7 @@ TgxLines = class(TgxNodedLines) (* A simple cube object. This cube use the same material for each of its faces, ie. all faces look the same. If you want a multi-material cube, use a mesh in conjunction - with a TgxFreeForm and a material library. *) + with a TGXFreeForm and a material library. *) TgxCube = class(TgxSceneObject) private FCubeSize: TAffineVector; diff --git a/Sourcex/GXS.OutlineShader.pas b/Sourcex/GXS.OutlineShader.pas index ed9c5dde..d2a65b19 100644 --- a/Sourcex/GXS.OutlineShader.pas +++ b/Sourcex/GXS.OutlineShader.pas @@ -9,7 +9,7 @@ Limitations: 1. Object can be transparent (color alpha < 1) if it doesn't overlap itself. Texture transparency doesn't work. - 2. Doesn't work with objects (e.g. TgxFreeForm) having it's own + 2. Doesn't work with objects (e.g. TGXFreeForm) having it's own color array. 3. Doesn't Works with visible backfaces. *) @@ -28,7 +28,7 @@ interface GXS.RenderContextInfo, GXS.Context, GXS.State, - GXS.TextureFormat; + GLScene.TextureFormat; type diff --git a/Sourcex/GXS.ParametricSurfaces.pas b/Sourcex/GXS.ParametricSurfaces.pas index 9678839d..3746dc36 100644 --- a/Sourcex/GXS.ParametricSurfaces.pas +++ b/Sourcex/GXS.ParametricSurfaces.pas @@ -7,12 +7,12 @@ Parametric surface implementation (like Bezier and BSpline surfaces) Notes: - The MOParametricSurface is a TgxMeshObject descendant that can be used + The MOParametricSurface is a TGXMeshObject descendant that can be used to render parametric surfaces. The Renderer property defines if the surface should be rendered using mesh evaluators (through GLU Nurbs for BSplines) or through GLScene using the CurvesAndSurfaces.pas routines to generate the mesh vertices and then rendered through the - standard TgxMeshObject render routine. Please note that BSplines aren't + standard TGXMeshObject render routine. Please note that BSplines aren't correctly handled yet in the CurvesAndSurfaces unit so the output mesh in rendering mode is wrong. I'll have it fixed when I know what's going wrong. The GLU Nurbs and glMeshEval Beziers work well @@ -58,7 +58,7 @@ interface control point influences on the surface. *) TParametricSurfaceBasis = (psbBezier, psbBSpline); - TMOParametricSurface = class(TgxMeshObject) + TMOParametricSurface = class(TGXMeshObject) private FControlPoints, FWeightedControlPoints: TGAffineVectorList; FKnotsU, FKnotsV, FWeights: TGSingleList; @@ -129,7 +129,7 @@ TMOParametricSurface = class(TgxMeshObject) Resolution sets the detail level of the mesh evaluation. MinU, MaxU, MinV and MaxV define the region of the surface to be rendered, this is especially useful for blending with neighbouring patches. *) - TFGBezierSurface = class(TgxFaceGroup) + TFGBezierSurface = class(TGXFaceGroup) private FCountU, FCountV: Integer; FControlPointIndices, FTexCoordIndices: TGIntegerList; @@ -327,7 +327,7 @@ procedure TMOParametricSurface.Clear; procedure TMOParametricSurface.GenerateMesh; var i, j: Integer; - fg: TfgxVertexIndexList; + fg: TFGXVertexIndexList; begin case FBasis of psbBezier: @@ -351,7 +351,7 @@ procedure TMOParametricSurface.GenerateMesh; end; Mode := momFaceGroups; - fg := TfgxVertexIndexList.CreateOwned(FaceGroups); + fg := TFGXVertexIndexList.CreateOwned(FaceGroups); fg.Mode := fgmmTriangles; for j := 0 to FResolution - 2 do with fg do diff --git a/Sourcex/GXS.ParticleFX.pas b/Sourcex/GXS.ParticleFX.pas index 645af5fd..db89b1e3 100644 --- a/Sourcex/GXS.ParticleFX.pas +++ b/Sourcex/GXS.ParticleFX.pas @@ -41,7 +41,7 @@ interface GXS.RenderContextInfo, GXS.PipelineTransformation, GXS.XCollection, - GXS.TextureFormat; + GLScene.TextureFormat; const cPFXNbRegions = 128; // number of distance regions diff --git a/Sourcex/GXS.PolygonTesselation.pas b/Sourcex/GXS.PolygonTesselation.pas index 76e474f2..85a8e79f 100644 --- a/Sourcex/GXS.PolygonTesselation.pas +++ b/Sourcex/GXS.PolygonTesselation.pas @@ -23,14 +23,14 @@ interface (* Tesselates the polygon outlined by the Vertexes. And addeds them to the first facegroup of the Mesh. *) procedure DoTesselate(Vertexes: TGAffineVectorList; - Mesh: TgxBaseMesh; normal: PAffineVector = nil; invertNormals: Boolean = False); + Mesh: TGXBaseMesh; normal: PAffineVector = nil; invertNormals: Boolean = False); //------------------------------------------------ implementation //------------------------------------------------ var - TessMesh: TgxMeshObject; + TessMesh: TGXMeshObject; TessFace: TFGIndexTexCoordList; TessExtraVertices: Integer; TessVertices: PAffineVectorArray; @@ -77,7 +77,7 @@ procedure DoTessCombine(coords: PDoubleVector; vertex_data: Pointer; weight: PGL SetVector(PAffineVector(outData)^, coords[0], coords[1], coords[2]); end; -procedure DoTesselate(Vertexes: TGAffineVectorList; Mesh: TgxBaseMesh; normal: PAffineVector = nil; invertNormals: Boolean = False); +procedure DoTesselate(Vertexes: TGAffineVectorList; Mesh: TGXBaseMesh; normal: PAffineVector = nil; invertNormals: Boolean = False); var Tess: GLUTesselator; i: Integer; @@ -86,7 +86,7 @@ procedure DoTesselate(Vertexes: TGAffineVectorList; Mesh: TgxBaseMesh; normal: P // Select or Create FaceGroup if Mesh.MeshObjects.Count = 0 then begin - TessMesh := TgxMeshObject.CreateOwned(Mesh.MeshObjects); + TessMesh := TGXMeshObject.CreateOwned(Mesh.MeshObjects); Mesh.MeshObjects[0].Mode := momFaceGroups; end else diff --git a/Sourcex/GXS.Portal.pas b/Sourcex/GXS.Portal.pas index cfc72857..6ed8c675 100644 --- a/Sourcex/GXS.Portal.pas +++ b/Sourcex/GXS.Portal.pas @@ -28,19 +28,19 @@ interface (* A mesh object list that handles portal rendering. The items are treated as being sectors. *) - TgxPortalMeshObjectList = class(TgxMeshObjectList) + TgxPortalMeshObjectList = class(TGXMeshObjectList) public - constructor CreateOwned(AOwner: TgxBaseMesh); + constructor CreateOwned(AOwner: TGXBaseMesh); destructor Destroy; override; procedure BuildList(var mrci: TgxRenderContextInfo); override; end; // A portal renderer sector. - TgxSectorMeshObject = class(TgxMorphableMeshObject) + TgxSectorMeshObject = class(TGXMorphableMeshObject) private FRenderDone: Boolean; public - constructor CreateOwned(AOwner: TgxMeshObjectList); + constructor CreateOwned(AOwner: TGXMeshObjectList); destructor Destroy; override; procedure BuildList(var mrci: TgxRenderContextInfo); override; procedure Prepare; override; @@ -52,7 +52,7 @@ TgxSectorMeshObject = class(TgxMorphableMeshObject) implements the portal. *) TFGPolygon = class(TFGVertexNormalTexIndexList) public - constructor CreateOwned(AOwner: TgxFaceGroups); override; + constructor CreateOwned(AOwner: TGXFaceGroups); override; destructor Destroy; override; procedure Prepare; override; end; @@ -66,7 +66,7 @@ TFGPortalPolygon = class(TFGPolygon) FCenter, FNormal: TAffineVector; FRadius: Single; public - constructor CreateOwned(AOwner: TgxFaceGroups); override; + constructor CreateOwned(AOwner: TGXFaceGroups); override; destructor Destroy; override; procedure BuildList(var mrci: TgxRenderContextInfo); override; procedure Prepare; override; @@ -74,7 +74,7 @@ TFGPortalPolygon = class(TFGPolygon) end; // Portal Renderer class. - TgxPortal = class(TgxBaseMesh) + TgxPortal = class(TGXBaseMesh) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -90,7 +90,7 @@ implementation // ------------------ TgxPortalMeshObjectList ------------------ // ------------------ -constructor TgxPortalMeshObjectList.CreateOwned(AOwner: TgxBaseMesh); +constructor TgxPortalMeshObjectList.CreateOwned(AOwner: TGXBaseMesh); begin inherited CreateOwned(AOwner); end; @@ -103,7 +103,7 @@ destructor TgxPortalMeshObjectList.Destroy; procedure TgxPortalMeshObjectList.BuildList(var mrci: TgxRenderContextInfo); var i: Integer; - startSector: TgxMeshObject; + startSector: TGXMeshObject; begin for i := 0 to Count - 1 do with TgxSectorMeshObject(Items[i]) do @@ -129,7 +129,7 @@ procedure TgxPortalMeshObjectList.BuildList(var mrci: TgxRenderContextInfo); // ------------------ TgxSectorMeshObject ------------------ // ------------------ -constructor TgxSectorMeshObject.CreateOwned(AOwner: TgxMeshObjectList); +constructor TgxSectorMeshObject.CreateOwned(AOwner: TGXMeshObjectList); begin inherited; Mode := momFaceGroups; @@ -190,7 +190,7 @@ procedure TgxSectorMeshObject.Prepare; // ------------------ TFGPolygon ------------------ // ------------------ -constructor TFGPolygon.CreateOwned(AOwner: TgxFaceGroups); +constructor TFGPolygon.CreateOwned(AOwner: TGXFaceGroups); begin inherited; Mode := fgmmTriangleFan; @@ -210,7 +210,7 @@ procedure TFGPolygon.Prepare; // ------------------ TFGPortalPolygon ------------------ // ------------------ -constructor TFGPortalPolygon.CreateOwned(AOwner: TgxFaceGroups); +constructor TFGPortalPolygon.CreateOwned(AOwner: TGXFaceGroups); begin inherited; end; diff --git a/Sourcex/GXS.ProcTextures.pas b/Sourcex/GXS.ProcTextures.pas index 2d8fbdae..b053830e 100644 --- a/Sourcex/GXS.ProcTextures.pas +++ b/Sourcex/GXS.ProcTextures.pas @@ -18,7 +18,7 @@ interface GXS.Texture, GXS.Graphics, - GXS.TextureFormat; + GLScene.TextureFormat; const GRADIENT_TABLE_SIZE = 256; diff --git a/Sourcex/GXS.ProxyObjects.pas b/Sourcex/GXS.ProxyObjects.pas index b41690d7..8a4ea86e 100644 --- a/Sourcex/GXS.ProxyObjects.pas +++ b/Sourcex/GXS.ProxyObjects.pas @@ -96,8 +96,8 @@ TgxMaterialProxy = class(TgxProxyObject, IgxMaterialLibrarySupported) // A proxy object specialized for FreeForms. TgxFreeFormProxy = class(TgxProxyObject) private - function GetMasterFreeFormObject: TgxFreeForm; - procedure SetMasterFreeFormObject(const Value: TgxFreeForm); + function GetMasterFreeFormObject: TGXFreeForm; + procedure SetMasterFreeFormObject(const Value: TGXFreeForm); public (* If the MasterObject is a FreeForm, you can raycast against the Octree, which is alot faster. You must build the octree before using. *) @@ -110,8 +110,8 @@ TgxFreeFormProxy = class(TgxProxyObject) intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil): Boolean; published - // Redeclare as TgxFreeForm. - property MasterObject: TgxFreeForm read GetMasterFreeFormObject write + // Redeclare as TGXFreeForm. + property MasterObject: TGXFreeForm read GetMasterFreeFormObject write SetMasterFreeFormObject; end; @@ -136,7 +136,7 @@ TgxActorProxy = class(TgxProxyObject, IgxMaterialLibrarySupported) FLastFrame: Integer; FCurrentFrameDelta: Single; FCurrentTime: TGProgressTimes; - FAnimation: TgxActorAnimationName; + FAnimation: TGXActorAnimationName; FTempLibMaterialName: string; FMasterLibMaterial: TgxLibMaterial; FMaterialLibrary: TgxMaterialLibrary; @@ -145,9 +145,9 @@ TgxActorProxy = class(TgxProxyObject, IgxMaterialLibrarySupported) FStoredBoneNames: TStrings; FOnBeforeRender: TGProgressEvent; FAnimationMode: TgxActorProxyAnimationMode; - procedure SetAnimation(const Value: TgxActorAnimationName); - procedure SetMasterActorObject(const Value: TgxActor); - function GetMasterActorObject: TgxActor; + procedure SetAnimation(const Value: TGXActorAnimationName); + procedure SetMasterActorObject(const Value: TGXActor); + function GetMasterActorObject: TGXActor; function GetLibMaterialName: TgxLibMaterialName; procedure SetLibMaterialName(const Value: TgxLibMaterialName); procedure SetMaterialLibrary(const Value: TgxMaterialLibrary); @@ -187,16 +187,16 @@ TgxActorProxy = class(TgxProxyObject, IgxMaterialLibrarySupported) This allows to pass a low-low-low-poly Actor to raycast in the "RefActor" parameter, while using a high-poly Actor in the "MasterObject" property, of course we assume that the two Masterobject Actors have same animations. *) - function RayCastIntersectEx(RefActor: TgxActor; const rayStart, rayVector: + function RayCastIntersectEx(RefActor: TGXActor; const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil): Boolean; overload; published property AnimationMode: TgxActorProxyAnimationMode read FAnimationMode write FAnimationMode default pamInherited; - property Animation: TgxActorAnimationName read FAnimation write SetAnimation; - // Redeclare as TgxActor. - property MasterObject: TgxActor read GetMasterActorObject write + property Animation: TGXActorAnimationName read FAnimation write SetAnimation; + // Redeclare as TGXActor. + property MasterObject: TGXActor read GetMasterActorObject write SetMasterActorObject; (* Redeclare without pooTransformation (Don't know why it causes the object to be oriented incorrecly.) *) @@ -380,13 +380,13 @@ function TgxFreeFormProxy.OctreeSphereSweepIntersect(const rayStart, rayVector: end; end; -function TgxFreeFormProxy.GetMasterFreeFormObject: TgxFreeForm; +function TgxFreeFormProxy.GetMasterFreeFormObject: TGXFreeForm; begin - Result := TgxFreeForm(inherited MasterObject); + Result := TGXFreeForm(inherited MasterObject); end; procedure TgxFreeFormProxy.SetMasterFreeFormObject( - const Value: TgxFreeForm); + const Value: TGXFreeForm); begin inherited SetMasterObject(Value); end; @@ -454,7 +454,7 @@ procedure TgxActorProxy.DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, cfd: Single; // General proxy stuff. gotMaster, masterGotEffects, oldProxySubObject: Boolean; - MasterActor: TgxActor; + MasterActor: TGXActor; begin try MasterActor := GetMasterActorObject; @@ -544,7 +544,7 @@ procedure TgxActorProxy.DoStoreBonesMatrices; var i, n: integer; Bmo: TBoneMatrixObj; - Bone: TgxSkeletonBone; + Bone: TGXSkeletonBone; begin if FStoredBoneNames.count > 0 then begin @@ -597,9 +597,9 @@ procedure TgxActorProxy.DoStoreBonesMatrices; end; end; -function TgxActorProxy.GetMasterActorObject: TgxActor; +function TgxActorProxy.GetMasterActorObject: TGXActor; begin - Result := TgxActor(inherited MasterObject); + Result := TGXActor(inherited MasterObject); end; function TgxActorProxy.GetLibMaterialName: TgxLibMaterialName; @@ -638,9 +638,9 @@ function TgxActorProxy.RayCastIntersect(const rayStart, rayVector: TVector4f; // Gain access to TgxDummyActor.DoAnimate(). type - TgxDummyActor = class(TgxActor); + TgxDummyActor = class(TGXActor); -function TgxActorProxy.RayCastIntersectEx(RefActor: TgxActor; const rayStart, +function TgxActorProxy.RayCastIntersectEx(RefActor: TGXActor; const rayStart, rayVector: TVector4f; intersectPoint, intersectNormal: PVector4f): Boolean; var localRayStart, localRayVector: TVector4f; @@ -710,9 +710,9 @@ function TgxActorProxy.RayCastIntersectEx(RefActor: TgxActor; const rayStart, end; end; -procedure TgxActorProxy.SetAnimation(const Value: TgxActorAnimationName); +procedure TgxActorProxy.SetAnimation(const Value: TGXActorAnimationName); var - anAnimation: TgxActorAnimation; + anAnimation: TGXActorAnimation; begin // We first assign the value (for persistency support), then check it. FAnimation := Value; @@ -736,7 +736,7 @@ procedure TgxActorProxy.SetStoredBoneNames(const Value: TStrings); FStoredBoneNames.Assign(Value); end; -procedure TgxActorProxy.SetMasterActorObject(const Value: TgxActor); +procedure TgxActorProxy.SetMasterActorObject(const Value: TGXActor); begin inherited SetMasterObject(Value); BoneMatricesClear; diff --git a/Sourcex/GXS.Ragdoll.pas b/Sourcex/GXS.Ragdoll.pas index 0c9e06b4..e06ab68c 100644 --- a/Sourcex/GXS.Ragdoll.pas +++ b/Sourcex/GXS.Ragdoll.pas @@ -41,7 +41,7 @@ TgxRagdolBone = class (TgxRagdolBoneList) private FOwner : TgxRagdolBoneList; FName : String; - FBoneID : Integer; //Refering to TgxActor Bone + FBoneID : Integer; //Refering to TGXActor Bone FBoundMax: TAffineVector; FBoundMin: TAffineVector; FBoundBoneDelta: TAffineVector; //Stores the diference from the bone.GlobalMatrix to the center of the bone's bounding box @@ -86,12 +86,12 @@ TgxRagdolBone = class (TgxRagdolBoneList) TgxRagdoll = class(TGPersistentObject) private - FOwner : TgxBaseMesh; + FOwner : TGXBaseMesh; FRootBone : TgxRagdolBone; FEnabled: Boolean; FBuilt: Boolean; public - constructor Create(AOwner : TgxBaseMesh); reintroduce; + constructor Create(AOwner : TGXBaseMesh); reintroduce; destructor Destroy; override; procedure WriteToFiler(writer : TGVirtualWriter); override; procedure ReadFromFiler(reader : TGVirtualReader); override; @@ -102,7 +102,7 @@ TgxRagdoll = class(TGPersistentObject) procedure Start; procedure Update; procedure Stop; - property Owner : TgxBaseMesh read FOwner; + property Owner : TGXBaseMesh read FOwner; property RootBone : TgxRagdolBone read FRootBone; property Enabled : Boolean read FEnabled; end; @@ -154,7 +154,7 @@ constructor TgxRagdolBone.Create(Ragdoll: TgxRagdoll); procedure TgxRagdolBone.CreateBoundingBox; var - bone: TgxSkeletonBone; + bone: TGXSkeletonBone; i, j: integer; BoneVertices : TGAffineVectorList; BoneVertex, max,min: TAffineVector; @@ -165,7 +165,7 @@ procedure TgxRagdolBone.CreateBoundingBox; //Get all vertices weighted to this bone BoneVertices:=TGAffineVectorList.Create; for i:=0 to Ragdoll.Owner.MeshObjects.Count-1 do - with TgxSkeletonMeshObject(Ragdoll.Owner.MeshObjects[i]) do + with TGXSkeletonMeshObject(Ragdoll.Owner.MeshObjects[i]) do for j:=0 to Vertices.Count-1 do if bone.BoneID = VerticesBonesWeights[j][0].BoneID then BoneVertices.FindOrAdd(Vertices[j]); @@ -223,7 +223,7 @@ destructor TgxRagdolBone.Destroy; procedure TgxRagdolBone.AlignToSkeleton; var o: TAffineVector; - bone: TgxSkeletonBone; + bone: TGXSkeletonBone; mat, posMat: TMatrix4f; noBounds: Boolean; begin @@ -318,7 +318,7 @@ procedure TgxRagdolBone.AlignChild; { TgxRagdoll } -constructor TgxRagdoll.Create(AOwner : TgxBaseMesh); +constructor TgxRagdoll.Create(AOwner : TGXBaseMesh); begin FOwner := AOwner; FEnabled := False; diff --git a/Sourcex/GXS.Scene.pas b/Sourcex/GXS.Scene.pas index a5dbf787..80c21259 100644 --- a/Sourcex/GXS.Scene.pas +++ b/Sourcex/GXS.Scene.pas @@ -36,7 +36,7 @@ interface GXS.ApplicationFileIO, - GXS.TextureFormat, + GLScene.TextureFormat, GLScene.Strings, GLScene.Utils, diff --git a/Sourcex/GXS.SceneRegister.pas b/Sourcex/GXS.SceneRegister.pas index 3dbd952d..d2414d28 100644 --- a/Sourcex/GXS.SceneRegister.pas +++ b/Sourcex/GXS.SceneRegister.pas @@ -1022,10 +1022,10 @@ function TgxAnimationNameProperty.GetAttributes: TPropertyAttributes; procedure TgxAnimationNameProperty.GetValues(Proc: TGetStrProc); var i: Integer; - animControler: TgxAnimationControler; - actor: TgxActor; + animControler: TGXAnimationControler; + actor: TGXActor; begin - animControler := (GetComponent(0) as TgxAnimationControler); + animControler := (GetComponent(0) as TGXAnimationControler); if Assigned(animControler) then begin actor := animControler.actor; @@ -1396,18 +1396,18 @@ procedure RegisterPropertiesInCategories; RegisterPropertiesInCategory(sVisualCategoryName, TgxExtrusionSolid, ['Stacks']); RegisterPropertiesInCategory(sVisualCategoryName, TgxPipeNode, ['RadiusFactor']); RegisterPropertiesInCategory(sVisualCategoryName, TgxPipe, ['Division', 'Radius', 'Slices']); - RegisterPropertiesInCategory(sOpenGLCategoryName, [TypeInfo(TgxActorAnimationMode), TypeInfo(TgxActorAnimations), + RegisterPropertiesInCategory(sOpenGLCategoryName, [TypeInfo(TgxActorAnimationMode), TypeInfo(TGXActorAnimations), TypeInfo(TMeshAutoCenterings), TypeInfo(TActorFrameInterpolation), - TypeInfo(TgxActorAnimationReference), TypeInfo(TgxActor)]); + TypeInfo(TGXActorAnimationReference), TypeInfo(TGXActor)]); RegisterPropertiesInCategory(sLayoutCategoryName, [TypeInfo(TMeshNormalsOrientation)]); RegisterPropertiesInCategory(sVisualCategoryName, [TypeInfo(TMeshAutoCenterings), - TypeInfo(TgxActorAnimationReference), TypeInfo(TMeshNormalsOrientation)]); - RegisterPropertiesInCategory(sOpenGLCategoryName, TgxFreeForm, ['UseMeshmaterials']); - RegisterPropertiesInCategory(sOpenGLCategoryName, TgxAnimationControler, ['AnimationName']); - RegisterPropertiesInCategory(sLinkageCategoryName, TgxAnimationControler, ['AnimationName']); - RegisterPropertiesInCategory(sOpenGLCategoryName, TgxActorAnimation, ['*Frame']); - RegisterPropertiesInCategory(sOpenGLCategoryName, TgxActor, ['*Frame*', 'Interval', 'OverlaySkeleton', 'UseMeshmaterials']); - RegisterPropertiesInCategory(sVisualCategoryName, TgxActor, ['OverlaySkeleton']); + TypeInfo(TGXActorAnimationReference), TypeInfo(TMeshNormalsOrientation)]); + RegisterPropertiesInCategory(sOpenGLCategoryName, TGXFreeForm, ['UseMeshmaterials']); + RegisterPropertiesInCategory(sOpenGLCategoryName, TGXAnimationControler, ['AnimationName']); + RegisterPropertiesInCategory(sLinkageCategoryName, TGXAnimationControler, ['AnimationName']); + RegisterPropertiesInCategory(sOpenGLCategoryName, TGXActorAnimation, ['*Frame']); + RegisterPropertiesInCategory(sOpenGLCategoryName, TGXActor, ['*Frame*', 'Interval', 'OverlaySkeleton', 'UseMeshmaterials']); + RegisterPropertiesInCategory(sVisualCategoryName, TGXActor, ['OverlaySkeleton']); RegisterPropertiesInCategory(sOpenGLCategoryName, [TypeInfo(TMeshMode), TypeInfo(TVertexMode)]); RegisterPropertiesInCategory(sOpenGLCategoryName, [TypeInfo(TgxHeightFieldOptions)]); RegisterPropertiesInCategory(sVisualCategoryName, [TypeInfo(TgxHeightFieldColorMode), @@ -1475,7 +1475,7 @@ procedure Register; TgxEParticleMasksManager]); RegisterComponents('GXScene Utils', [TgxAsyncTimer, TgxStaticImposterBuilder, - TgxCollisionManager, TgxAnimationControler, TgxAVIRecorder, TgxDCEManager, + TgxCollisionManager, TGXAnimationControler, TgxAVIRecorder, TgxDCEManager, TgxFPSMovementManager, TgxMaterialScripter, TgxUserInterface, TgxNavigator, TgxSmoothNavigator, TgxSmoothUserInterface, TgxTimeEventsMGR, TgxApplicationFileIO, TgxVfsPAK, TgxSimpleNavigation, TgxGizmo, @@ -1542,7 +1542,7 @@ procedure Register; TgxLibMaterialNameProperty); RegisterPropertyEditor(TypeInfo(TgxLibMaterialName), TgxFBORenderer, '', TgxLibMaterialNameProperty); - RegisterPropertyEditor(TypeInfo(TgxActorAnimationName), TgxAnimationControler, + RegisterPropertyEditor(TypeInfo(TGXActorAnimationName), TGXAnimationControler, '', TgxAnimationNameProperty); RegisterPropertyEditor(TypeInfo(TgxLibMaterialName), TgxTextureSharingShaderMaterial, 'LibMaterialName', TgxLibMaterialNameProperty); @@ -1652,8 +1652,8 @@ initialization RegisterSceneObject(TgxTorus, 'Torus', strOCAdvancedGeometry, HInstance); // Mesh objects - RegisterSceneObject(TgxActor, 'Actor', strOCMeshObjects, HInstance); - RegisterSceneObject(TgxFreeForm, 'FreeForm', strOCMeshObjects, HInstance); + RegisterSceneObject(TGXActor, 'Actor', strOCMeshObjects, HInstance); + RegisterSceneObject(TGXFreeForm, 'FreeForm', strOCMeshObjects, HInstance); RegisterSceneObject(TgxMesh, 'Mesh', strOCMeshObjects, HInstance); RegisterSceneObject(TgxTilePlane, 'TilePlane', strOCMeshObjects, HInstance); RegisterSceneObject(TgxPortal, 'Portal', strOCMeshObjects, HInstance); diff --git a/Sourcex/GXS.ShadowPlane.pas b/Sourcex/GXS.ShadowPlane.pas index 17a493ad..59079ef8 100644 --- a/Sourcex/GXS.ShadowPlane.pas +++ b/Sourcex/GXS.ShadowPlane.pas @@ -34,7 +34,7 @@ interface GXS.Color, GXS.RenderContextInfo, GXS.State, - GXS.TextureFormat; + GLScene.TextureFormat; type diff --git a/Sourcex/GXS.State.pas b/Sourcex/GXS.State.pas index 2c84e858..97bcccf7 100644 --- a/Sourcex/GXS.State.pas +++ b/Sourcex/GXS.State.pas @@ -33,16 +33,17 @@ interface System.SysUtils, GLScene.Strings, - GXS.TextureFormat, + GLScene.TextureFormat, GLScene.VectorTypes, GLScene.VectorGeometry, - GLScene.Utils; + GLScene.Utils, + + GXS.Color; const VERTEX_ATTR_NUM = 16; type - TgxStateType = (sttCurrent, sttPoint, sttLine, sttPolygon, sttPolygonStipple, sttPixelMode, sttLighting, sttFog, sttDepthBuffer, sttAccumBuffer, sttStencilBuffer, sttViewport, sttTransform, sttEnable, sttColorBuffer, @@ -54,7 +55,6 @@ interface cAllAttribBits = [Low(TgxStateType)..High(TgxStateType)]; type - TgxMeshPrimitive = ( mpNOPRIMITIVE, mpTRIANGLES, @@ -1017,13 +1017,10 @@ TgxStateRecord = record cGLBufferBindingTarget: array[TgxBufferBindingTarget] of GLEnum = (GL_UNIFORM_BUFFER, GL_TRANSFORM_FEEDBACK_BUFFER); -//------------------------------------------------------ -implementation -//------------------------------------------------------ +implementation //------------------------------------------------------ uses - GXS.Context, - GXS.Color; + GXS.Context; // ------------------ // ------------------ TgxStateCache ------------------ diff --git a/Sourcex/GXS.Texture.pas b/Sourcex/GXS.Texture.pas index 9ce52759..a2d598e2 100644 --- a/Sourcex/GXS.Texture.pas +++ b/Sourcex/GXS.Texture.pas @@ -18,7 +18,7 @@ interface FMX.Graphics, FMX.Objects, - GXS.TextureFormat, + GLScene.TextureFormat, GLScene.Strings, GXS.XOpenGL, diff --git a/Sourcex/GXS.TextureFormat.pas b/Sourcex/GXS.TextureFormat.pas deleted file mode 100644 index c3d18ed7..00000000 --- a/Sourcex/GXS.TextureFormat.pas +++ /dev/null @@ -1,949 +0,0 @@ -// -// The graphics engine GLScene https://github.com/glscene -// -unit GXS.TextureFormat; - -(* Texture formats and functions *) - -interface - -uses - Winapi.OpenGL, - Winapi.OpenGLext, - - GXS.OpenGLAdapter, - GLScene.OpenGLTokens, - GLScene.Strings; - -type - // Texture addressing rules - TglSeparateTextureWrap = (twRepeat, twClampToEdge, twClampToBorder, - twMirrorRepeat, twMirrorClampToEdge, twMirrorClampToBorder); - - (* Specifies the texture comparison mode for currently bound depth textures. - That is, a texture whose internal format is tfDEPTH_COMPONENT* *) - TglTextureCompareMode = (tcmNone, tcmCompareRtoTexture); - - // Filtering quality - TglTextureFilteringQuality = (tfIsotropic, tfAnisotropic); - - TglTextureTarget = - ( - ttNoShape, ttTexture1D, ttTexture2D, ttTexture3D, ttTexture1DArray, - ttTexture2DArray, ttTextureRect, ttTextureBuffer, ttTextureCube, - ttTexture2DMultisample, ttTexture2DMultisampleArray, ttTextureCubeArray - ); - - TglTextureSwizzle = (tswRed, tswGreen, tswBlue, tswAlpha, tswZero, tswOne); - TglSwizzleVector = array[0..3] of TglTextureSwizzle; - - TglInternalFormat = ( - tfALPHA4, - tfALPHA8, - tfALPHA12, - tfALPHA16, - tfDEPTH_COMPONENT16, - tfDEPTH_COMPONENT24, - tfDEPTH_COMPONENT32, - tfLUMINANCE4, - tfLUMINANCE8, - tfLUMINANCE12, - tfLUMINANCE16, - tfLUMINANCE4_ALPHA4, - tfLUMINANCE6_ALPHA2, - tfLUMINANCE8_ALPHA8, - tfLUMINANCE12_ALPHA4, - tfLUMINANCE12_ALPHA12, - tfLUMINANCE16_ALPHA16, - tfINTENSITY4, - tfINTENSITY8, - tfINTENSITY12, - tfINTENSITY16, - tfR3_G3_B2, - tfRGB4, - tfRGB5, - tfRGB8, - tfRGB10, - tfRGB12, - tfR16G16B16, - tfRGBA2, - tfRGBA4, - tfRGB5_A1, - tfRGBA8, - tfRGB10_A2, - tfRGBA12, - tfR16G16B16A16, - tfCOMPRESSED_RGB_S3TC_DXT1, - tfCOMPRESSED_RGBA_S3TC_DXT1, - tfCOMPRESSED_RGBA_S3TC_DXT3, - tfCOMPRESSED_RGBA_S3TC_DXT5, - tfSIGNED_LUMINANCE8, - tfSIGNED_LUMINANCE8_ALPHA8, - tfSIGNED_RGB8, - tfSIGNED_RGBA8, - tfSIGNED_RGB8_UNSIGNED_ALPHA8, - tfSIGNED_ALPHA8, - tfSIGNED_INTENSITY8, - tfHILO16, - tfSIGNED_HILO16, - tfDSDT8, - tfDSDT8_MAG8, - tfDSDT8_MAG8_INTENSITY8, - tfHILO8, - tfSIGNED_HILO8, - tfFLOAT_R16, - tfFLOAT_R32, - tfFLOAT_RG16, - tfFLOAT_RGB16, - tfFLOAT_RGBA16, - tfFLOAT_RG32, - tfFLOAT_RGB32, - tfFLOAT_RGBA32, - tfRGBA_FLOAT32, - tfRGB_FLOAT32, - tfALPHA_FLOAT32, - tfINTENSITY_FLOAT32, - tfLUMINANCE_FLOAT32, - tfLUMINANCE_ALPHA_FLOAT32, - tfRGBA_FLOAT16, - tfRGB_FLOAT16, - tfALPHA_FLOAT16, - tfINTENSITY_FLOAT16, - tfLUMINANCE_FLOAT16, - tfLUMINANCE_ALPHA_FLOAT16, - tfDEPTH24_STENCIL8, - tfDEPTH_COMPONENT32F, - tfDEPTH32F_STENCIL8, - tfSRGB8, - tfSRGB8_ALPHA8, - tfSLUMINANCE8, - tfSLUMINANCE8_ALPHA8, - tfCOMPRESSED_SRGB_S3TC_DXT1, - tfCOMPRESSED_SRGB_ALPHA_S3TC_DXT1, - tfCOMPRESSED_SRGB_ALPHA_S3TC_DXT3, - tfCOMPRESSED_SRGB_ALPHA_S3TC_DXT5, - tfRGB9_E5, - tfR11F_G11F_B10F, - tfCOMPRESSED_LUMINANCE_LATC1, - tfCOMPRESSED_SIGNED_LUMINANCE_LATC1, - tfCOMPRESSED_LUMINANCE_ALPHA_LATC2, - tfCOMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2, - tfCOMPRESSED_LUMINANCE_ALPHA_3DC, - tfRGBA32UI, - tfRGB32UI, - tfALPHA32UI, - tfINTENSITY32UI, - tfLUMINANCE32UI, - tfLUMINANCE_ALPHA32UI, - tfRGBA16UI, - tfRGB16UI, - tfALPHA16UI, - tfINTENSITY16UI, - tfLUMINANCE16UI, - tfLUMINANCE_ALPHA16UI, - tfRGBA8UI, - tfRGB8UI, - tfALPHA8UI, - tfINTENSITY8UI, - tfLUMINANCE8UI, - tfLUMINANCE_ALPHA8UI, - tfRGBA32I, - tfRGB32I, - tfALPHA32I, - tfINTENSITY32I, - tfLUMINANCE32I, - tfLUMINANCE_ALPHA32I, - tfRGBA16I, - tfRGB16I, - tfALPHA16I, - tfINTENSITY16I, - tfLUMINANCE16I, - tfLUMINANCE_ALPHA16I, - tfRGBA8I, - tfRGB8I, - tfALPHA8I, - tfINTENSITY8I, - tfLUMINANCE8I, - tfLUMINANCE_ALPHA8I, - tfRG32UI, - tfR32UI, - tfRG16UI, - tfR16UI, - tfRG8UI, - tfR8UI, - tfRG32I, - tfR32I, - tfRG16I, - tfR16I, - tfRG8I, - tfR8I, - tfRG8, - tfR8, - tfRG16, - tfR16, - tfRG16F, - tfR16F, - tfRG32F, - tfR32F, - tfCOMPRESSED_RED_RGTC1, - tfCOMPRESSED_SIGNED_RED_RGTC1, - tfCOMPRESSED_RG_RGTC2, - tfCOMPRESSED_SIGNED_RG_RGTC2, - tfR8_SNORM, - tfRG8_SNORM, - tfRGB8_SNORM, - tfRGBA8_SNORM, - tfR16_SNORM, - tfRG16_SNORM, - tfRGB16_SNORM, - tfRGBA16_SNORM - ); - - (* Texture compression option. - If OpenGL supports it, this will activate a compressed texture format: - tcDefault : uses global default compression option - tcNone : do not use compression - tcStandard : use standard compression, average quality, average rate - tcHighQuality : choose a high-quality, low-speed compression - tcHighSpeed : choose a high-speed, low-quality compression *) - TglInternalCompression = (tcDefault, tcNone, tcStandard, tcHighQuality, tcHighSpeed); - -var - vDefaultTextureFormat: TglInternalFormat = tfRGBA8; - vDefaultTextureCompression: TglInternalCompression = tcNone; - -const - cDefaultSwizzleVector: TglSwizzleVector = (tswRed, tswGreen, tswBlue, tswAlpha); - -// Give a openGL texture format from GLScene texture format -function InternalFormatToOpenGLFormat(intFormat: TglInternalFormat): Cardinal; -// Give a GLScene texture format from openGL texture format -function OpenGLFormatToInternalFormat(glFormat: Cardinal): TglInternalFormat; -// Give a pixel size in bytes from texture format or data format -function GetTextureElementSize(intFormat: TglInternalFormat): Integer; overload; -function GetTextureElementSize(colorFormat: Cardinal; dataType: Cardinal): - Integer; overload; -// Give compatible openGL image format and data type -procedure FindCompatibleDataFormat(intFormat: TglInternalFormat; out dFormat: - Cardinal; out dType: Cardinal); -(* Give a compressed openGL texture format from GLScene texture format - if format is have not compression than return same openGL format *) -function CompressedInternalFormatToOpenGL(intFormat: TglInternalFormat): Integer; -// True if texture target supported -function IsTargetSupported(glTarget: Cardinal): Boolean; overload; -function IsTargetSupported(target: TglTextureTarget): Boolean; overload; -// True if texture format is supported by hardware or software -function IsFormatSupported(intFormat: TglInternalFormat): Boolean; -// True if texture format is float -function IsFloatFormat(intFormat: TglInternalFormat): Boolean; overload; -function IsFloatFormat(glFormat: Cardinal): Boolean; overload; -// True if depth texture -function IsDepthFormat(intFormat: TglInternalFormat): boolean; overload; -function IsDepthFormat(glFormat: Cardinal): Boolean; overload; -// True if texture compressed -function IsCompressedFormat(intFormat: TglInternalFormat): Boolean; overload; -function IsCompressedFormat(glFormat: Cardinal): Boolean; overload; -// Give generic compressed OpenGL texture format -function GetGenericCompressedFormat(const intFormat: TglInternalFormat; - const colorFormat: Cardinal; out internalFormat: Cardinal): Boolean; -// Give uncompressed texture format and OpenGL color format -function GetUncompressedFormat(const intFormat: TglInternalFormat; - out internalFormat: TGLInternalFormat; out colorFormat: Cardinal): Boolean; -function DecodeTextureTarget(const TextureTarget: TglTextureTarget): Cardinal; -function EncodeGLTextureTarget(const glTarget: Cardinal): TglTextureTarget; -function IsTargetSupportMipmap(const TextureTarget: TglTextureTarget): Boolean; overload; -function IsTargetSupportMipmap(const glTarget: Cardinal): Boolean; overload; - -implementation //-------------------------------------------------------------- - -uses - GXS.Context; - -type - - TFormatDesc = record - IntFmt: Cardinal; - ClrFmt: Cardinal; - DataFmt: Cardinal; - RBit: Byte; - GBit: Byte; - BBit: Byte; - ABit: Byte; - LBit: Byte; - DBit: Byte; - Sign: Boolean; - Flt: Boolean; - Fix: Boolean; - Comp: Boolean; - end; - -const - // InternalFormat, ColorFormat, DataType - cTextureFormatToOpenGL: array[low(TglInternalFormat)..high(TglInternalFormat)] of TFormatDesc = - ( - (IntFmt: GL_ALPHA4; ClrFmt: GL_ALPHA; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 4; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_ALPHA8; ClrFmt: GL_ALPHA; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 8; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_ALPHA12; ClrFmt: GL_ALPHA; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 12; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_ALPHA16; ClrFmt: GL_ALPHA; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 16; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_DEPTH_COMPONENT16; ClrFmt: GL_DEPTH_COMPONENT; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 16; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_DEPTH_COMPONENT24; ClrFmt: GL_DEPTH_COMPONENT; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 24; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_DEPTH_COMPONENT32; ClrFmt: GL_DEPTH_COMPONENT; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 32; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE4; ClrFmt: GL_LUMINANCE; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 4; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE8; ClrFmt: GL_LUMINANCE; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 8; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE12; ClrFmt: GL_LUMINANCE; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 12; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE16; ClrFmt: GL_LUMINANCE; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 16; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE4_ALPHA4; ClrFmt: GL_LUMINANCE_ALPHA; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 4; LBit: 4; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE6_ALPHA2; ClrFmt: GL_LUMINANCE_ALPHA; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 6; LBit: 2; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE8_ALPHA8; ClrFmt: GL_LUMINANCE_ALPHA; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 8; LBit: 8; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE12_ALPHA4; ClrFmt: GL_LUMINANCE_ALPHA; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 4; LBit: 12; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE12_ALPHA12; ClrFmt: GL_LUMINANCE_ALPHA; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 12; LBit: 12; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE16_ALPHA16; ClrFmt: GL_LUMINANCE_ALPHA; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 16; LBit: 16; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_INTENSITY4; ClrFmt: GL_LUMINANCE; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 4; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_INTENSITY8; ClrFmt: GL_LUMINANCE; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 8; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_INTENSITY12; ClrFmt: GL_LUMINANCE; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 12; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_INTENSITY16; ClrFmt: GL_LUMINANCE; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 16; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_R3_G3_B2; ClrFmt: GL_RGB; DataFmt: GL_UNSIGNED_BYTE_3_3_2; RBit: 3; GBit: 3; BBit: 2; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGB4; ClrFmt: GL_RGB; DataFmt: GL_UNSIGNED_BYTE; RBit: 4; GBit: 4; BBit: 4; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGB5; ClrFmt: GL_RGB; DataFmt: GL_UNSIGNED_SHORT_5_6_5; RBit: 5; GBit: 6; BBit: 5; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGB8; ClrFmt: GL_RGB; DataFmt: GL_UNSIGNED_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGB10; ClrFmt: GL_RGBA; DataFmt: GL_UNSIGNED_INT_10_10_10_2; RBit: 10; GBit: 10; BBit: 10; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGB12; ClrFmt: GL_RGB; DataFmt: GL_UNSIGNED_BYTE; RBit: 12; GBit: 12; BBit: 12; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGB16; ClrFmt: GL_RGB; DataFmt: GL_UNSIGNED_SHORT; RBit: 16; GBit: 16; BBit: 16; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGBA2; ClrFmt: GL_RGBA; DataFmt: GL_UNSIGNED_BYTE; RBit: 2; GBit: 2; BBit: 2; ABit: 2; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGBA4; ClrFmt: GL_RGBA; DataFmt: GL_UNSIGNED_SHORT_4_4_4_4; RBit: 4; GBit: 4; BBit: 4; ABit: 4; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGB5_A1; ClrFmt: GL_RGBA; DataFmt: GL_UNSIGNED_SHORT_5_5_5_1; RBit: 5; GBit: 5; BBit: 5; ABit: 1; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGBA8; ClrFmt: GL_RGBA; DataFmt: GL_UNSIGNED_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 8; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGB10_A2; ClrFmt: GL_RGBA; DataFmt: GL_UNSIGNED_INT_10_10_10_2; RBit: 10; GBit: 10; BBit: 10; ABit: 2; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGBA12; ClrFmt: GL_RGBA; DataFmt: GL_UNSIGNED_BYTE; RBit: 12; GBit: 12; BBit: 12; ABit: 12; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGBA16; ClrFmt: GL_RGBA; DataFmt: GL_UNSIGNED_SHORT; RBit: 16; GBit: 16; BBit: 16; ABit: 16; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_COMPRESSED_RGB_S3TC_DXT1_EXT; ClrFmt: GL_COMPRESSED_RGB_S3TC_DXT1_EXT; DataFmt: GL_COMPRESSED_RGB_S3TC_DXT1_EXT; RBit: 8; GBit: 8; BBit: 8; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; ClrFmt: GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; DataFmt: GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; RBit: 8; GBit: 8; BBit: 8; ABit: 1; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; ClrFmt: GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; DataFmt: GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; RBit: 8; GBit: 8; BBit: 8; ABit: 8; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; ClrFmt: GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; DataFmt: GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; RBit: 8; GBit: 8; BBit: 0; ABit: 8; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_SIGNED_LUMINANCE8_NV; ClrFmt: GL_LUMINANCE; DataFmt: GL_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 8; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_SIGNED_LUMINANCE8_ALPHA8_NV; ClrFmt: GL_LUMINANCE_ALPHA; DataFmt: GL_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 8; LBit: 8; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_SIGNED_RGB8_NV; ClrFmt: GL_RGB; DataFmt: GL_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_SIGNED_RGBA8_NV; ClrFmt: GL_RGBA; DataFmt: GL_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 8; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_SIGNED_RGB8_UNSIGNED_ALPHA8_NV; ClrFmt: GL_RGBA; DataFmt: GL_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 8; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_SIGNED_ALPHA8_NV; ClrFmt: GL_ALPHA; DataFmt: GL_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 8; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_SIGNED_INTENSITY8_NV; ClrFmt: GL_INTENSITY; DataFmt: GL_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 8; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_HILO16_NV; ClrFmt: GL_RG; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_SIGNED_HILO16_NV; ClrFmt: GL_RG; DataFmt: GL_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_DSDT8_NV; ClrFmt: GL_RED; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_DSDT8_MAG8_NV; ClrFmt: GL_RG; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_DSDT8_MAG8_INTENSITY8_NV; ClrFmt: GL_RGB; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_HILO8_NV; ClrFmt: GL_RG; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_SIGNED_HILO8_NV; ClrFmt: GL_RG; DataFmt: GL_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_FLOAT_R16_NV; ClrFmt: GL_RED; DataFmt: GL_HALF_FLOAT; RBit: 16; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_FLOAT_R32_NV; ClrFmt: GL_RED; DataFmt: GL_FLOAT; RBit: 32; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_FLOAT_RG16_NV; ClrFmt: GL_RG; DataFmt: GL_HALF_FLOAT; RBit: 16; GBit: 16; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_FLOAT_RGB16_NV; ClrFmt: GL_RGB; DataFmt: GL_HALF_FLOAT; RBit: 16; GBit: 16; BBit: 16; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_FLOAT_RGBA16_NV; ClrFmt: GL_RGBA; DataFmt: GL_HALF_FLOAT; RBit: 16; GBit: 16; BBit: 16; ABit: 16; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_FLOAT_RG32_NV; ClrFmt: GL_RG; DataFmt: GL_FLOAT; RBit: 32; GBit: 32; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_FLOAT_RGB32_NV; ClrFmt: GL_RGB; DataFmt: GL_FLOAT; RBit: 32; GBit: 32; BBit: 32; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_FLOAT_RGBA32_NV; ClrFmt: GL_RGBA; DataFmt: GL_FLOAT; RBit: 32; GBit: 32; BBit: 32; ABit: 32; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_RGBA32F_ARB; ClrFmt: GL_RGBA; DataFmt: GL_FLOAT; RBit: 32; GBit: 32; BBit: 32; ABit: 32; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_RGB32F_ARB; ClrFmt: GL_RGB; DataFmt: GL_FLOAT; RBit: 32; GBit: 32; BBit: 32; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_ALPHA32F_ARB; ClrFmt: GL_ALPHA; DataFmt: GL_FLOAT; RBit: 0; GBit: 0; BBit: 0; ABit: 32; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_INTENSITY32F_ARB; ClrFmt: GL_LUMINANCE; DataFmt: GL_FLOAT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 32; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE32F_ARB; ClrFmt: GL_LUMINANCE; DataFmt: GL_FLOAT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 32; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE_ALPHA32F_ARB; ClrFmt: GL_LUMINANCE_ALPHA; DataFmt: GL_FLOAT; RBit: 0; GBit: 0; BBit: 0; ABit: 32; LBit: 32; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_RGBA16F_ARB; ClrFmt: GL_RGBA; DataFmt: GL_HALF_FLOAT; RBit: 16; GBit: 16; BBit: 16; ABit: 16; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_RGB16F_ARB; ClrFmt: GL_RGB; DataFmt: GL_HALF_FLOAT; RBit: 16; GBit: 16; BBit: 16; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_ALPHA16F_ARB; ClrFmt: GL_ALPHA; DataFmt: GL_HALF_FLOAT; RBit: 0; GBit: 0; BBit: 0; ABit: 16; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_INTENSITY16F_ARB; ClrFmt: GL_LUMINANCE; DataFmt: GL_HALF_FLOAT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 16; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE16F_ARB; ClrFmt: GL_LUMINANCE; DataFmt: GL_HALF_FLOAT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 16; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_LUMINANCE_ALPHA16F_ARB; ClrFmt: GL_LUMINANCE_ALPHA; DataFmt: GL_HALF_FLOAT; RBit: 0; GBit: 0; BBit: 0; ABit: 16; LBit: 16; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_DEPTH24_STENCIL8; ClrFmt: GL_DEPTH_STENCIL; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 24; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_DEPTH_COMPONENT32F; ClrFmt: GL_DEPTH_COMPONENT; DataFmt: GL_FLOAT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 32; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_DEPTH32F_STENCIL8; ClrFmt: GL_DEPTH_STENCIL; DataFmt: GL_FLOAT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 32; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_SRGB8; ClrFmt: GL_RGB; DataFmt: GL_UNSIGNED_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_SRGB8_ALPHA8; ClrFmt: GL_RGBA; DataFmt: GL_UNSIGNED_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 8; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_SLUMINANCE8; ClrFmt: GL_LUMINANCE; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 8; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_SLUMINANCE8_ALPHA8; ClrFmt: GL_LUMINANCE_ALPHA; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 8; LBit: 8; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_COMPRESSED_SRGB_S3TC_DXT1_EXT; ClrFmt: GL_COMPRESSED_SRGB_S3TC_DXT1_EXT; DataFmt: GL_COMPRESSED_SRGB_S3TC_DXT1_EXT; RBit: 8; GBit: 8; BBit: 8; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT; ClrFmt: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT; DataFmt: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT; RBit: 8; GBit: 8; BBit: 8; ABit: 1; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT; ClrFmt: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT; DataFmt: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT; RBit: 8; GBit: 8; BBit: 8; ABit: 8; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT; ClrFmt: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT; DataFmt: GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT; RBit: 8; GBit: 8; BBit: 8; ABit: 8; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_RGB9_E5; ClrFmt: GL_RGBA; DataFmt: GL_FLOAT; RBit: 8; GBit: 8; BBit: 8; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_R11F_G11F_B10F; ClrFmt: GL_RGB; DataFmt: GL_FLOAT; RBit: 11; GBit: 11; BBit: 10; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_COMPRESSED_LUMINANCE_LATC1_EXT; ClrFmt: GL_COMPRESSED_LUMINANCE_LATC1_EXT; DataFmt: GL_COMPRESSED_LUMINANCE_LATC1_EXT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 8; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_SIGNED_LUMINANCE_LATC1_EXT; ClrFmt: GL_COMPRESSED_SIGNED_LUMINANCE_LATC1_EXT; DataFmt: GL_COMPRESSED_SIGNED_LUMINANCE_LATC1_EXT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 8; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT; ClrFmt: GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT; DataFmt: GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT; RBit: 0; GBit: 0; BBit: 0; ABit: 8; LBit: 8; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2_EXT; ClrFmt: GL_COMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2_EXT; DataFmt: GL_COMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2_EXT; RBit: 0; GBit: 0; BBit: 0; ABit: 8; LBit: 8; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_LUMINANCE_ALPHA_3DC_ATI; ClrFmt: GL_COMPRESSED_LUMINANCE_ALPHA_3DC_ATI; DataFmt: GL_COMPRESSED_LUMINANCE_ALPHA_3DC_ATI; RBit: 0; GBit: 0; BBit: 0; ABit: 8; LBit: 8; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_RGBA32UI; ClrFmt: GL_RGBA_INTEGER; DataFmt: GL_UNSIGNED_INT; RBit: 32; GBit: 32; BBit: 32; ABit: 32; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RGB32UI; ClrFmt: GL_RGB_INTEGER; DataFmt: GL_UNSIGNED_INT; RBit: 32; GBit: 32; BBit: 32; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_ALPHA32UI_EXT; ClrFmt: GL_ALPHA_INTEGER; DataFmt: GL_UNSIGNED_INT; RBit: 0; GBit: 0; BBit: 0; ABit: 32; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_INTENSITY32UI_EXT; ClrFmt: GL_LUMINANCE_INTEGER_EXT; DataFmt: GL_UNSIGNED_INT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 32; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_LUMINANCE32UI_EXT; ClrFmt: GL_LUMINANCE_INTEGER_EXT; DataFmt: GL_UNSIGNED_INT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 32; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_LUMINANCE_ALPHA32UI_EXT; ClrFmt: GL_LUMINANCE_ALPHA_INTEGER_EXT; DataFmt: GL_UNSIGNED_INT; RBit: 0; GBit: 0; BBit: 0; ABit: 32; LBit: 32; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_RGBA16UI; ClrFmt: GL_RGBA_INTEGER; DataFmt: GL_UNSIGNED_SHORT; RBit: 16; GBit: 16; BBit: 16; ABit: 16; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RGB16UI; ClrFmt: GL_RGB_INTEGER; DataFmt: GL_UNSIGNED_SHORT; RBit: 16; GBit: 16; BBit: 16; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_ALPHA16UI_EXT; ClrFmt: GL_ALPHA_INTEGER; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 16; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_INTENSITY16UI_EXT; ClrFmt: GL_LUMINANCE_INTEGER_EXT; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 16; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_LUMINANCE16UI_EXT; ClrFmt: GL_LUMINANCE_INTEGER_EXT; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 16; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_LUMINANCE_ALPHA16UI_EXT; ClrFmt: GL_LUMINANCE_ALPHA_INTEGER_EXT; DataFmt: GL_UNSIGNED_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 16; LBit: 16; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RGBA8UI; ClrFmt: GL_RGBA_INTEGER; DataFmt: GL_UNSIGNED_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 8; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RGB8UI; ClrFmt: GL_RGB_INTEGER; DataFmt: GL_UNSIGNED_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_ALPHA8UI_EXT; ClrFmt: GL_ALPHA_INTEGER; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 8; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_INTENSITY8UI_EXT; ClrFmt: GL_LUMINANCE_INTEGER_EXT; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 8; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_LUMINANCE8UI_EXT; ClrFmt: GL_LUMINANCE_INTEGER_EXT; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 8; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_LUMINANCE_ALPHA8UI_EXT; ClrFmt: GL_LUMINANCE_ALPHA_INTEGER_EXT; DataFmt: GL_UNSIGNED_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 8; LBit: 8; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_RGBA32I; ClrFmt: GL_RGBA_INTEGER; DataFmt: GL_INT; RBit: 32; GBit: 32; BBit: 32; ABit: 32; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RGB32I; ClrFmt: GL_RGB_INTEGER; DataFmt: GL_INT; RBit: 32; GBit: 32; BBit: 32; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_ALPHA32I_EXT; ClrFmt: GL_ALPHA_INTEGER; DataFmt: GL_INT; RBit: 0; GBit: 0; BBit: 0; ABit: 32; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_INTENSITY32I_EXT; ClrFmt: GL_LUMINANCE_INTEGER_EXT; DataFmt: GL_INT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 32; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_LUMINANCE32I_EXT; ClrFmt: GL_LUMINANCE_INTEGER_EXT; DataFmt: GL_INT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 32; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_LUMINANCE_ALPHA32I_EXT; ClrFmt: GL_LUMINANCE_ALPHA_INTEGER_EXT; DataFmt: GL_INT; RBit: 0; GBit: 0; BBit: 0; ABit: 32; LBit: 32; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RGBA16I; ClrFmt: GL_RGBA_INTEGER; DataFmt: GL_SHORT; RBit: 16; GBit: 16; BBit: 16; ABit: 16; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RGB16I; ClrFmt: GL_RGB_INTEGER; DataFmt: GL_SHORT; RBit: 16; GBit: 16; BBit: 16; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_ALPHA16I_EXT; ClrFmt: GL_ALPHA_INTEGER; DataFmt: GL_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 16; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_INTENSITY16I_EXT; ClrFmt: GL_LUMINANCE_INTEGER_EXT; DataFmt: GL_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 16; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_LUMINANCE16I_EXT; ClrFmt: GL_LUMINANCE_INTEGER_EXT; DataFmt: GL_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 16; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_LUMINANCE_ALPHA16I_EXT; ClrFmt: GL_LUMINANCE_ALPHA_INTEGER_EXT; DataFmt: GL_SHORT; RBit: 0; GBit: 0; BBit: 0; ABit: 16; LBit: 16; DBit: 0; Sign: True; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_RGBA8I; ClrFmt: GL_RGBA_INTEGER; DataFmt: GL_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 8; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RGB8I; ClrFmt: GL_RGB_INTEGER; DataFmt: GL_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_ALPHA8I_EXT; ClrFmt: GL_ALPHA_INTEGER; DataFmt: GL_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 8; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_INTENSITY8I_EXT; ClrFmt: GL_INTENSITY; DataFmt: GL_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 8; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_LUMINANCE8I_EXT; ClrFmt: GL_LUMINANCE; DataFmt: GL_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 0; LBit: 8; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_LUMINANCE_ALPHA8I_EXT; ClrFmt: GL_LUMINANCE_ALPHA; DataFmt: GL_BYTE; RBit: 0; GBit: 0; BBit: 0; ABit: 8; LBit: 8; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RG32UI; ClrFmt: GL_RG; DataFmt: GL_UNSIGNED_INT; RBit: 8; GBit: 8; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_R32UI; ClrFmt: GL_RED_INTEGER; DataFmt: GL_UNSIGNED_INT; RBit: 8; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RG16UI; ClrFmt: GL_RG; DataFmt: GL_UNSIGNED_SHORT; RBit: 16; GBit: 16; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_R16UI; ClrFmt: GL_RED_INTEGER; DataFmt: GL_UNSIGNED_SHORT; RBit: 16; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RG8UI; ClrFmt: GL_RG; DataFmt: GL_UNSIGNED_BYTE; RBit: 8; GBit: 8; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_R8UI; ClrFmt: GL_RED_INTEGER; DataFmt: GL_UNSIGNED_BYTE; RBit: 8; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_RG32I; ClrFmt: GL_RG; DataFmt: GL_INT; RBit: 32; GBit: 32; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_R32I; ClrFmt: GL_RED_INTEGER; DataFmt: GL_INT; RBit: 16; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RG16I; ClrFmt: GL_RG; DataFmt: GL_SHORT; RBit: 16; GBit: 16; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_R16I; ClrFmt: GL_RED_INTEGER; DataFmt: GL_SHORT; RBit: 16; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RG8I; ClrFmt: GL_RG; DataFmt: GL_BYTE; RBit: 8; GBit: 8; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_R8I; ClrFmt: GL_RED_INTEGER; DataFmt: GL_BYTE; RBit: 8; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: True; Comp: False), - (IntFmt: GL_RG8; ClrFmt: GL_RG; DataFmt: GL_BYTE; RBit: 8; GBit: 8; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_R8; ClrFmt: GL_RED; DataFmt: GL_BYTE; RBit: 8; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RG16; ClrFmt: GL_RG; DataFmt: GL_SHORT; RBit: 16; GBit: 16; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_R16; ClrFmt: GL_RED; DataFmt: GL_SHORT; RBit: 16; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RG16F; ClrFmt: GL_RG; DataFmt: GL_HALF_FLOAT; RBit: 16; GBit: 16; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_R16F; ClrFmt: GL_RED; DataFmt: GL_HALF_FLOAT; RBit: 16; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_RG32F; ClrFmt: GL_RG; DataFmt: GL_FLOAT; RBit: 32; GBit: 32; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_R32F; ClrFmt: GL_LUMINANCE; DataFmt: GL_FLOAT; RBit: 32; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: True; Fix: False; Comp: False), - (IntFmt: GL_COMPRESSED_RED_RGTC1; ClrFmt: GL_COMPRESSED_RED_RGTC1; DataFmt: GL_COMPRESSED_RED_RGTC1; RBit: 8; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_SIGNED_RED_RGTC1; ClrFmt: GL_COMPRESSED_SIGNED_RED_RGTC1; DataFmt: GL_COMPRESSED_SIGNED_RED_RGTC1; RBit: 8; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_RG_RGTC2; ClrFmt: GL_COMPRESSED_RG_RGTC2; DataFmt: GL_COMPRESSED_RG_RGTC2; RBit: 8; GBit: 8; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_COMPRESSED_SIGNED_RG_RGTC2; ClrFmt: GL_COMPRESSED_SIGNED_RG_RGTC2; DataFmt: GL_COMPRESSED_SIGNED_RG_RGTC2; RBit: 8; GBit: 8; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: True; Flt: False; Fix: False; Comp: True), - (IntFmt: GL_R8_SNORM; ClrFmt: GL_R; DataFmt: GL_BYTE; RBit: 8; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RG8_SNORM; ClrFmt: GL_RG; DataFmt: GL_BYTE; RBit: 8; GBit: 8; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGB8_SNORM; ClrFmt: GL_RGB; DataFmt: GL_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGBA8_SNORM; ClrFmt: GL_RGBA; DataFmt: GL_BYTE; RBit: 8; GBit: 8; BBit: 8; ABit: 8; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_R16_SNORM; ClrFmt: GL_R; DataFmt: GL_SHORT; RBit: 16; GBit: 0; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RG16_SNORM; ClrFmt: GL_RG; DataFmt: GL_SHORT; RBit: 16; GBit: 16; BBit: 0; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGB16_SNORM; ClrFmt: GL_RGB; DataFmt: GL_SHORT; RBit: 16; GBit: 16; BBit: 16; ABit: 0; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False), - (IntFmt: GL_RGBA16_SNORM; ClrFmt: GL_RGBA; DataFmt: GL_SHORT; RBit: 16; GBit: 16; BBit: 16; ABit: 16; LBit: 0; DBit: 0; Sign: False; Flt: False; Fix: False; Comp: False) - ); - -function InternalFormatToOpenGLFormat(intFormat: TGLInternalFormat): Cardinal; -begin - Result := cTextureFormatToOpenGL[intFormat].IntFmt; -end; - -function OpenGLFormatToInternalFormat(glFormat: Cardinal): TGLInternalFormat; -var - i: TGLInternalFormat; -begin - Result := tfRGBA8; - for i := Low(cTextureFormatToOpenGL) to High(cTextureFormatToOpenGL) do - if glFormat = cTextureFormatToOpenGL[i].IntFmt then - begin - Result := i; - Exit; - end; - Assert(false); -end; - -function GetTextureElementSize(intFormat: TGLInternalFormat): Integer; -begin - Result := GetTextureElementSize( - cTextureFormatToOpenGL[intFormat].ClrFmt, - cTextureFormatToOpenGL[intFormat].DataFmt); -end; - -function GetTextureElementSize(colorFormat: Cardinal; dataType: Cardinal): - Integer; -var - components: Byte; -begin - case colorFormat of - GL_RGB, GL_BGR: components := 3; - GL_RGBA, GL_BGRA: components := 4; - GL_ALPHA: components := 1; - GL_LUMINANCE: components := 1; - GL_LUMINANCE_ALPHA: components := 2; - GL_INTENSITY: components := 1; - GL_RED: components := 1; - GL_GREEN: components := 1; - GL_BLUE: components := 1; - GL_RG: components := 2; - - GL_RGB_INTEGER: components := 3; - GL_RGBA_INTEGER: components := 4; - GL_ALPHA_INTEGER: components := 1; - GL_LUMINANCE_INTEGER_EXT: components := 1; - GL_LUMINANCE_ALPHA_INTEGER_EXT: components := 2; - GL_RED_INTEGER: components := 1; - GL_RG_INTEGER: components := 2; - else - components := 1; - end; - - case dataType of - GL_BITMAP, - GL_UNSIGNED_BYTE, - GL_BYTE: Result := components; - GL_UNSIGNED_BYTE_3_3_2, - GL_UNSIGNED_BYTE_2_3_3_REV: Result := 1; - GL_UNSIGNED_SHORT, - GL_SHORT: Result := components * 2; - GL_UNSIGNED_SHORT_4_4_4_4, - GL_UNSIGNED_SHORT_4_4_4_4_REV, - GL_UNSIGNED_SHORT_5_6_5, - GL_UNSIGNED_SHORT_5_6_5_REV, - GL_UNSIGNED_SHORT_5_5_5_1, - GL_UNSIGNED_SHORT_1_5_5_5_REV: Result := 2; - - GL_UNSIGNED_INT, - GL_INT: Result := components * 4; - GL_UNSIGNED_INT_8_8_8_8, - GL_UNSIGNED_INT_8_8_8_8_REV, - GL_UNSIGNED_INT_10_10_10_2, - GL_UNSIGNED_INT_2_10_10_10_REV: Result := 4; - - GL_FLOAT: Result := components * 4; - GL_HALF_FLOAT: Result := components * 2; - - GL_COMPRESSED_RGB_S3TC_DXT1_EXT: Result := 8; - GL_COMPRESSED_RGBA_S3TC_DXT1_EXT: Result := 8; - GL_COMPRESSED_RGBA_S3TC_DXT3_EXT: Result := 16; - GL_COMPRESSED_RGBA_S3TC_DXT5_EXT: Result := 16; - GL_COMPRESSED_SRGB_S3TC_DXT1_EXT: Result := 8; - GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT: Result := 8; - GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT: Result := 16; - GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT: Result := 16; - GL_COMPRESSED_LUMINANCE_LATC1_EXT: Result := 8; - GL_COMPRESSED_SIGNED_LUMINANCE_LATC1_EXT: Result := 8; - GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT: Result := 16; - GL_COMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2_EXT: Result := 16; - GL_COMPRESSED_LUMINANCE_ALPHA_3DC_ATI: Result := 16; - GL_COMPRESSED_RED_RGTC1: Result := 8; - GL_COMPRESSED_SIGNED_RED_RGTC1: Result := 8; - GL_COMPRESSED_RG_RGTC2: Result := 16; - GL_COMPRESSED_SIGNED_RG_RGTC2: Result := 16; - else - Result := 1; - end; -end; - -function CompressedInternalFormatToOpenGL(intFormat: TglInternalFormat): - Integer; -begin - Result := GL_COMPRESSED_RGBA; - case intFormat of - tfRGB8: Result := GL_COMPRESSED_RGB; - tfRGBA8: Result := GL_COMPRESSED_RGBA; - tfRGB5: Result := GL_COMPRESSED_RGB; - tfRGBA4: Result := GL_COMPRESSED_RGBA; - tfALPHA8: Result := GL_COMPRESSED_ALPHA; - tfLUMINANCE8: Result := GL_COMPRESSED_LUMINANCE; - tfLUMINANCE8_ALPHA8: Result := GL_COMPRESSED_LUMINANCE_ALPHA; - tfINTENSITY8: Result := GL_COMPRESSED_INTENSITY; - else - Assert(false); - end; -end; - -procedure FindCompatibleDataFormat(intFormat: TglInternalFormat; out dFormat: - Cardinal; out dType: Cardinal); -begin - dFormat := cTextureFormatToOpenGL[intFormat].ClrFmt; - dType := cTextureFormatToOpenGL[intFormat].DataFmt; -end; - -function IsTargetSupported(target: TglTextureTarget): Boolean; -begin - Result := IsTargetSupported(DecodeTextureTarget(target)); -end; - -function IsTargetSupported(glTarget: Cardinal): Boolean; -begin - case glTarget of - GL_TEXTURE_1D: Result := True; - GL_TEXTURE_2D: Result := True; - GL_TEXTURE_3D: Result := True; - GL_TEXTURE_RECTANGLE: Result := True; - GL_TEXTURE_CUBE_MAP, - GL_TEXTURE_CUBE_MAP_POSITIVE_X, - GL_TEXTURE_CUBE_MAP_NEGATIVE_X, - GL_TEXTURE_CUBE_MAP_POSITIVE_Y, - GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, - GL_TEXTURE_CUBE_MAP_POSITIVE_Z, - GL_TEXTURE_CUBE_MAP_NEGATIVE_Z: Result := True; - GL_TEXTURE_1D_ARRAY: Result := True; - GL_TEXTURE_2D_ARRAY: Result := True; - GL_TEXTURE_CUBE_MAP_ARRAY: Result := True; - GL_TEXTURE_BUFFER: Result := True; - GL_TEXTURE_2D_MULTISAMPLE, - GL_TEXTURE_2D_MULTISAMPLE_ARRAY: Result := True; - else - begin - Result := false; - // Assert(False, strErrorEx + strUnknownType); - end; - end; -end; - -function IsFormatSupported(intFormat: TGLInternalFormat): Boolean; -begin - Result := false; - - if ((intFormat >= tfALPHA4) and (intFormat <= tfALPHA16)) or - ((intFormat >= tfLUMINANCE4) and (intFormat <= tfR16G16B16A16)) then - begin - // Result := GL.VERSION_1_1; - EXIT; - end; - - if ((intFormat >= tfDEPTH_COMPONENT16) and (intFormat <= tfDEPTH_COMPONENT32)) then - begin - // Result := GL.ARB_depth_texture; - EXIT; - end; - - if ((intFormat >= tfCOMPRESSED_RGB_S3TC_DXT1) and (intFormat <= - tfCOMPRESSED_RGBA_S3TC_DXT5)) then - begin - // Result := GL.EXT_texture_compression_s3tc; - EXIT; - end; - - if ((intFormat >= tfSIGNED_LUMINANCE8) and (intFormat <= - tfDSDT8_MAG8_INTENSITY8)) then - begin - // Result := GL.NV_texture_shader; - EXIT; - end; - - if ((intFormat = tfHILO8) or (intFormat = tfSIGNED_HILO8)) then - begin - // Result := GL.NV_texture_shader3; - EXIT; - end; - - if ((intFormat >= tfFLOAT_R16) and (intFormat <= tfFLOAT_RGBA32)) then - begin - // Result := GL.NV_float_buffer; - EXIT; - end; - - if ((intFormat >= tfRGBA_FLOAT32) - and (intFormat <= tfLUMINANCE_ALPHA_FLOAT16)) then - begin - // Result := GL.ARB_texture_float or GL.ATI_texture_float; - EXIT; - end; - - if intFormat = tfDEPTH24_STENCIL8 then - begin - // Result := GL.EXT_packed_depth_stencil; - EXIT; - end; - - if ((intFormat = tfDEPTH_COMPONENT32F) or (intFormat = tfDEPTH32F_STENCIL8)) then - begin - // Result := GL.NV_depth_buffer_float; - EXIT; - end; - - if ((intFormat >= tfSRGB8) and (intFormat <= - tfCOMPRESSED_SRGB_ALPHA_S3TC_DXT5)) then - begin - // Result := GL.EXT_texture_sRGB; - EXIT; - end; - - if intFormat = tfRGB9_E5 then - begin - // Result := GL.EXT_texture_shared_exponent; - EXIT; - end; - - if intFormat = tfR11F_G11F_B10F then - begin - // Result := GL.EXT_packed_float; - EXIT; - end; - - if ((intFormat >= tfCOMPRESSED_LUMINANCE_LATC1) and (intFormat <= - tfCOMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2)) then - begin - // Result := GL.EXT_texture_compression_latc; - EXIT; - end; - - if intFormat = tfCOMPRESSED_LUMINANCE_ALPHA_3DC then - begin - // Result := GL.ATI_texture_compression_3dc; - EXIT; - end; - - if ((intFormat >= tfRGBA32UI) and (intFormat <= tfLUMINANCE_ALPHA8I)) then - begin - // Result := GL.EXT_texture_integer; - EXIT; - end; - - if ((intFormat >= tfRG32UI) and (intFormat <= tfR32F)) then - begin - // Result := GL.ARB_texture_rg; - // EXIT; - end; - - if ((intFormat >= tfCOMPRESSED_RED_RGTC1) and (intFormat <= - tfCOMPRESSED_SIGNED_RG_RGTC2)) then - begin - // Result := GL.ARB_texture_compression_rgtc; - EXIT; - end; - - if ((intFormat >= tfR8_SNORM) and (intFormat <= tfRGBA16_SNORM)) then - begin - // Result := GL.VERSION_3_1; - EXIT; - end -end; - -function IsFloatFormat(intFormat: TglInternalFormat): boolean; -begin - Result := cTextureFormatToOpenGL[intFormat].Flt; -end; - -function IsFloatFormat(glFormat: Cardinal): boolean; -begin - Result := IsFloatFormat(OpenGLFormatToInternalFormat(glFormat)); -end; - -function IsDepthFormat(intFormat: TGLInternalFormat): boolean; -begin - Result := cTextureFormatToOpenGL[intFormat].DBit > 0; -end; - -function IsDepthFormat(glFormat: Cardinal): boolean; -begin - Result := cTextureFormatToOpenGL[OpenGLFormatToInternalFormat(glFormat)].DBit > 0; -end; - -function IsCompressedFormat(intFormat: TglInternalFormat): boolean; -begin - Result := cTextureFormatToOpenGL[intFormat].Comp; -end; - -function IsCompressedFormat(glFormat: Cardinal): boolean; -begin - Result := cTextureFormatToOpenGL[OpenGLFormatToInternalFormat(glFormat)].Comp; -end; - -function GetGenericCompressedFormat(const intFormat: TglInternalFormat; - const colorFormat: Cardinal; out internalFormat: Cardinal): Boolean; - -begin - Result := false; - if IsCompressedFormat(intFormat) then - Exit; - if not IsFormatSupported(intFormat) then - Exit; - internalFormat := 0; - - if ((intFormat >= tfSRGB8) and (intFormat <= - tfCOMPRESSED_SRGB_ALPHA_S3TC_DXT5)) then - case colorFormat of - GL_RGB: internalFormat := GL_COMPRESSED_SRGB; - GL_RGBA: internalFormat := GL_COMPRESSED_SRGB_ALPHA; - GL_LUMINANCE: internalFormat := GL_COMPRESSED_SLUMINANCE; - GL_LUMINANCE_ALPHA: internalFormat := GL_COMPRESSED_SLUMINANCE_ALPHA; - end - else - case colorFormat of - GL_RGB, GL_BGR: internalFormat := GL_COMPRESSED_RGB; - GL_RGBA, GL_BGRA: internalFormat := GL_COMPRESSED_RGBA; - GL_ALPHA: internalFormat := GL_COMPRESSED_ALPHA; - GL_LUMINANCE: internalFormat := GL_COMPRESSED_LUMINANCE; - GL_LUMINANCE_ALPHA: internalFormat := GL_COMPRESSED_LUMINANCE_ALPHA; - GL_INTENSITY: internalFormat := GL_COMPRESSED_INTENSITY; - GL_RED: internalFormat := GL_COMPRESSED_RED; - GL_RG: internalFormat := GL_COMPRESSED_RG; - end; - - if internalFormat = 0 then - Exit; - Result := true; -end; - -function GetUncompressedFormat(const intFormat: TglInternalFormat; - out internalFormat: TglInternalFormat; out colorFormat: Cardinal): Boolean; -begin - Result := false; - if not IsCompressedFormat(intFormat) then - Exit; - if not IsFormatSupported(intFormat) then - Exit; - colorFormat := 0; - case intFormat of - tfCOMPRESSED_RGB_S3TC_DXT1: - begin - colorFormat := GL_RGB; - internalFormat := tfRGB8; - end; - tfCOMPRESSED_RGBA_S3TC_DXT1: - begin - colorFormat := GL_RGBA; - internalFormat := tfRGBA8; - end; - tfCOMPRESSED_RGBA_S3TC_DXT3: - begin - colorFormat := GL_RGBA; - internalFormat := tfRGBA8; - end; - tfCOMPRESSED_RGBA_S3TC_DXT5: - begin - colorFormat := GL_RGBA; - internalFormat := tfRGBA8; - end; - tfCOMPRESSED_SRGB_S3TC_DXT1: - begin - colorFormat := GL_RGBA; - internalFormat := tfSRGB8; - end; - tfCOMPRESSED_SRGB_ALPHA_S3TC_DXT1: - begin - colorFormat := GL_RGBA; - internalFormat := tfSRGB8_ALPHA8; - end; - tfCOMPRESSED_SRGB_ALPHA_S3TC_DXT3: - begin - colorFormat := GL_RGBA; - internalFormat := tfSRGB8_ALPHA8; - end; - tfCOMPRESSED_SRGB_ALPHA_S3TC_DXT5: - begin - colorFormat := GL_RGBA; - internalFormat := tfSRGB8_ALPHA8; - end; - tfCOMPRESSED_LUMINANCE_LATC1: - begin - colorFormat := GL_LUMINANCE; - internalFormat := tfLUMINANCE8; - end; - tfCOMPRESSED_SIGNED_LUMINANCE_LATC1: - begin - colorFormat := GL_LUMINANCE; - internalFormat := tfSIGNED_LUMINANCE8; - end; - tfCOMPRESSED_LUMINANCE_ALPHA_LATC2: - begin - colorFormat := GL_LUMINANCE_ALPHA; - internalFormat := tfLUMINANCE8_ALPHA8; - end; - tfCOMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2: - begin - colorFormat := GL_LUMINANCE_ALPHA; - internalFormat := tfSIGNED_LUMINANCE8_ALPHA8; - end; - tfCOMPRESSED_LUMINANCE_ALPHA_3DC: - begin - colorFormat := GL_LUMINANCE_ALPHA; - internalFormat := tfLUMINANCE8_ALPHA8; - end; - tfCOMPRESSED_RED_RGTC1: - begin - colorFormat := GL_RED; - internalFormat := tfR8; - end; - tfCOMPRESSED_SIGNED_RED_RGTC1: - begin - colorFormat := GL_RED; - internalFormat := tfR8; - end; - tfCOMPRESSED_RG_RGTC2: - begin - colorFormat := GL_RG; - internalFormat := tfRG8; - end; - tfCOMPRESSED_SIGNED_RG_RGTC2: - begin - colorFormat := GL_RG; - internalFormat := tfRG8; - end; - end; - Result := colorFormat <> 0; -end; - -function DecodeTextureTarget(const TextureTarget: TglTextureTarget): Cardinal; -const - cTargetToEnum: array[TglTextureTarget] of Cardinal = - ( - 0, - GL_TEXTURE_1D, - GL_TEXTURE_2D, - GL_TEXTURE_3D, - GL_TEXTURE_1D_ARRAY, - GL_TEXTURE_2D_ARRAY, - GL_TEXTURE_RECTANGLE, - GL_TEXTURE_BUFFER, - GL_TEXTURE_CUBE_MAP, - GL_TEXTURE_2D_MULTISAMPLE, - GL_TEXTURE_2D_MULTISAMPLE_ARRAY, - GL_TEXTURE_CUBE_MAP_ARRAY - ); -begin - // Assert(TextureTarget <> ttNoShape); - Result := cTargetToEnum[TextureTarget]; -end; - -function EncodeGLTextureTarget(const glTarget: Cardinal): TglTextureTarget; -begin - case glTarget of - GL_TEXTURE_1D: Result := ttTexture1d; - GL_TEXTURE_2D: Result := ttTexture2d; - GL_TEXTURE_3D: Result := ttTexture3d; - GL_TEXTURE_RECTANGLE: Result := ttTextureRect; - GL_TEXTURE_CUBE_MAP: Result := ttTextureCube; - GL_TEXTURE_1D_ARRAY: Result := ttTexture1dArray; - GL_TEXTURE_2D_ARRAY: Result := ttTexture2dArray; - GL_TEXTURE_CUBE_MAP_ARRAY: Result := ttTextureCubeArray; - GL_TEXTURE_2D_MULTISAMPLE: Result := ttTexture2DMultisample; - GL_TEXTURE_2D_MULTISAMPLE_ARRAY: Result := ttTexture2DMultisampleArray; - else - begin - Result := ttTexture2d; - Assert(False, strErrorEx + strUnknownType); - end; - end; -end; - -function IsTargetSupportMipmap(const TextureTarget: TglTextureTarget): Boolean; -begin - Result := (TextureTarget <> ttTextureRect) - and (TextureTarget <> ttTexture2DMultisample) - and (TextureTarget <> ttTexture2DMultisampleArray); -end; - -function IsTargetSupportMipmap(const glTarget: Cardinal): Boolean; -begin - Result := (glTarget <> GL_TEXTURE_RECTANGLE) - and (glTarget <> GL_TEXTURE_2D_MULTISAMPLE) - and (glTarget <> GL_TEXTURE_2D_MULTISAMPLE_ARRAY); -end; - -//---------------------------------------------------------------------------- - -end. - diff --git a/Sourcex/GXS.ThorFX.pas b/Sourcex/GXS.ThorFX.pas index f79e83a3..2a275080 100644 --- a/Sourcex/GXS.ThorFX.pas +++ b/Sourcex/GXS.ThorFX.pas @@ -30,7 +30,7 @@ interface GXS.RenderContextInfo, GLScene.Manager, GXS.State, - GXS.TextureFormat; + GLScene.TextureFormat; type PThorpoint = ^TThorpoint; diff --git a/Sourcex/GXS.Tree.pas b/Sourcex/GXS.Tree.pas index 948bc6d8..bdf6c150 100644 --- a/Sourcex/GXS.Tree.pas +++ b/Sourcex/GXS.Tree.pas @@ -195,7 +195,7 @@ TgxTree = class(TgxImmaterialSceneObject) ARenderSelf, ARenderChildren: Boolean); override; procedure BuildList(var rci: TgxRenderContextInfo); override; procedure StructureChanged; override; - procedure BuildMesh(GLBaseMesh: TgxBaseMesh); + procedure BuildMesh(GLBaseMesh: TGXBaseMesh); procedure RebuildTree; procedure ForceTotalRebuild; procedure Clear; @@ -828,10 +828,10 @@ procedure TgxTree.StructureChanged; inherited; end; -procedure TgxTree.BuildMesh(GLBaseMesh: TgxBaseMesh); +procedure TgxTree.BuildMesh(GLBaseMesh: TGXBaseMesh); - procedure RecursBranches(Branch: TgxTreeBranch; bone: TgxSkeletonBone; - Frame: TgxSkeletonFrame); + procedure RecursBranches(Branch: TgxTreeBranch; bone: TGXSkeletonBone; + Frame: TGXSkeletonFrame); var trans: TTransformations; mat: TMatrix4f; @@ -862,18 +862,18 @@ procedure TgxTree.BuildMesh(GLBaseMesh: TgxBaseMesh); // Recurse with child branches if Assigned(Branch.Left) then - RecursBranches(Branch.Left, TgxSkeletonBone.CreateOwned(bone), Frame); + RecursBranches(Branch.Left, TGXSkeletonBone.CreateOwned(bone), Frame); if Assigned(Branch.Right) then - RecursBranches(Branch.Right, TgxSkeletonBone.CreateOwned(bone), Frame); + RecursBranches(Branch.Right, TGXSkeletonBone.CreateOwned(bone), Frame); end; var - // SkelMesh : TgxSkeletonMeshObject; - fg: TfgxVertexIndexList; + // SkelMesh : TGXSkeletonMeshObject; + fg: TFGXVertexIndexList; fg2: TFGVertexNormalTexIndexList; i, j, stride: Integer; // parent_id : integer; - // bone : TgxSkeletonBone; + // bone : TGXSkeletonBone; begin if not Assigned(GLBaseMesh) then exit; @@ -887,22 +887,22 @@ procedure TgxTree.BuildMesh(GLBaseMesh: TgxBaseMesh); GLBaseMesh.MeshObjects.Clear; GLBaseMesh.Skeleton.Clear; - // if GLBaseMesh is TgxActor then - // TgxSkeletonMeshObject.CreateOwned(GLBaseMesh.MeshObjects) + // if GLBaseMesh is TGXActor then + // TGXSkeletonMeshObject.CreateOwned(GLBaseMesh.MeshObjects) // else - TgxMeshObject.CreateOwned(GLBaseMesh.MeshObjects); + TGXMeshObject.CreateOwned(GLBaseMesh.MeshObjects); GLBaseMesh.MeshObjects[0].Mode := momFaceGroups; // Branches GLBaseMesh.MeshObjects[0].Vertices.Add(Branches.Vertices); GLBaseMesh.MeshObjects[0].Normals.Add(Branches.Normals); GLBaseMesh.MeshObjects[0].TexCoords.Add(Branches.TexCoords); - { if GLBaseMesh is TgxActor then begin - TgxActor(GLBaseMesh).Reference:=aarSkeleton; + { if GLBaseMesh is TGXActor then begin + TGXActor(GLBaseMesh).Reference:=aarSkeleton; RecursBranches(Branches.FRoot, - TgxSkeletonBone.CreateOwned(GLBaseMesh.Skeleton.RootBones), - TgxSkeletonFrame.CreateOwned(GLBaseMesh.Skeleton.Frames)); - SkelMesh:=TgxSkeletonMeshObject(GLBaseMesh.MeshObjects[0]); + TGXSkeletonBone.CreateOwned(GLBaseMesh.Skeleton.RootBones), + TGXSkeletonFrame.CreateOwned(GLBaseMesh.Skeleton.Frames)); + SkelMesh:=TGXSkeletonMeshObject(GLBaseMesh.MeshObjects[0]); SkelMesh.BonesPerVertex:=1; SkelMesh.VerticeBoneWeightCount:=Branches.FBranchIndices.Count; for i:=0 to Branches.FBranchIndices.Count-1 do @@ -915,7 +915,7 @@ procedure TgxTree.BuildMesh(GLBaseMesh: TgxBaseMesh); stride := (BranchFacets + 1) * 2; for i := 0 to (FBranches.FIndices.Count div stride) - 1 do begin - fg := TfgxVertexIndexList.CreateOwned(GLBaseMesh.MeshObjects[0].FaceGroups); + fg := TFGXVertexIndexList.CreateOwned(GLBaseMesh.MeshObjects[0].FaceGroups); fg.MaterialName := BranchMaterialName; fg.Mode := fgmmTriangleStrip; for j := 0 to stride - 1 do @@ -923,10 +923,10 @@ procedure TgxTree.BuildMesh(GLBaseMesh: TgxBaseMesh); end; // Leaves - // if GLBaseMesh is TgxActor then - // TgxSkeletonMeshObject.CreateOwned(GLBaseMesh.MeshObjects) + // if GLBaseMesh is TGXActor then + // TGXSkeletonMeshObject.CreateOwned(GLBaseMesh.MeshObjects) // else - TgxMeshObject.CreateOwned(GLBaseMesh.MeshObjects); + TGXMeshObject.CreateOwned(GLBaseMesh.MeshObjects); GLBaseMesh.MeshObjects[1].Mode := momFaceGroups; GLBaseMesh.MeshObjects[1].Vertices.Add(Leaves.Vertices); diff --git a/Sourcex/GXS.VectorFileObjects.pas b/Sourcex/GXS.VectorFileObjects.pas index fc372e41..e6562da6 100644 --- a/Sourcex/GXS.VectorFileObjects.pas +++ b/Sourcex/GXS.VectorFileObjects.pas @@ -20,9 +20,7 @@ interface System.SysUtils, System.Types, - GXS.XOpenGL, GLScene.BaseClasses, - GLScene.VectorLists, GLScene.PersistentClasses, GLScene.VectorTypes, @@ -30,7 +28,10 @@ interface GLScene.Strings, GLScene.Utils, GLScene.GeometryBB, + GLScene.Coordinates, + GLScene.TextureFormat, + GXS.XOpenGL, GXS.ApplicationFileIO, GXS.Scene, GXS.Texture, @@ -41,25 +42,24 @@ interface GXS.Context, GXS.Color, GXS.RenderContextInfo, - GLScene.Coordinates, - GXS.TextureFormat, GXS.State, - GXS.ImageUtils; + GXS.ImageUtils, + GXS.MeshUtils; -type - TgxMeshObjectList = class; - TgxFaceGroups = class; +type + TGXMeshObjectList = class; + TGXFaceGroups = class; - TgxMeshAutoCentering = (macCenterX, macCenterY, macCenterZ, macUseBarycenter, macRestorePosition); - TgxMeshAutoCenterings = set of TgxMeshAutoCentering; + TGXMeshAutoCentering = (macCenterX, macCenterY, macCenterZ, macUseBarycenter, macRestorePosition); + TGXMeshAutoCenterings = set of TGXMeshAutoCentering; - TgxMeshObjectMode = (momTriangles, momTriangleStrip, momFaceGroups); + TGXMeshObjectMode = (momTriangles, momTriangleStrip, momFaceGroups); (* A base class for mesh objects. The class introduces a set of vertices and normals for the object but does no rendering of its own. *) - TgxBaseMeshObject = class(TGPersistentObject) + TGXBaseMeshObject = class(TGPersistentObject) private FName: string; FVertices: TGAffineVectorList; @@ -89,7 +89,7 @@ TgxBaseMeshObject = class(TGPersistentObject) normals and indices are preserved. The only valid modes are currently momTriangles and momTriangleStrip (ie. momFaceGroups not supported). *) - procedure BuildNormals(vertexIndices: TGIntegerList; mode: TgxMeshObjectMode; normalIndices: TGIntegerList = nil); + procedure BuildNormals(vertexIndices: TGIntegerList; mode: TGXMeshObjectMode; normalIndices: TGIntegerList = nil); (* Extracts all mesh triangles as a triangles list. The resulting list size is a multiple of 3, each group of 3 vertices making up and independant triangle. @@ -104,33 +104,33 @@ TgxBaseMeshObject = class(TGPersistentObject) property normals: TGAffineVectorList read FNormals write SetNormals; end; - TgxSkeletonFrameList = class; - TgxSkeletonFrameTransform = (sftRotation, sftQuaternion); + TGXSkeletonFrameList = class; + TGXSkeletonFrameTransform = (sftRotation, sftQuaternion); (* Stores position and rotation for skeleton joints. If you directly alter some values, make sure to call FlushLocalMatrixList so that the local matrices will be recalculated (the call to Flush does not recalculate the matrices, but marks the current ones as dirty). *) - TgxSkeletonFrame = class(TGPersistentObject) + TGXSkeletonFrame = class(TGPersistentObject) private - FOwner: TgxSkeletonFrameList; + FOwner: TGXSkeletonFrameList; FName: string; FPosition: TGAffineVectorList; FRotation: TGAffineVectorList; FQuaternion: TGQuaternionList; FLocalMatrixList: PMatrixArray; - FTransformMode: TgxSkeletonFrameTransform; + FTransformMode: TGXSkeletonFrameTransform; protected procedure SetPosition(const val: TGAffineVectorList); procedure SetRotation(const val: TGAffineVectorList); procedure SetQuaternion(const val: TGQuaternionList); public - constructor CreateOwned(aOwner: TgxSkeletonFrameList); + constructor CreateOwned(aOwner: TGXSkeletonFrameList); constructor Create; override; destructor Destroy; override; procedure WriteToFiler(writer: TGVirtualWriter); override; procedure ReadFromFiler(reader: TGVirtualReader); override; - property Owner: TgxSkeletonFrameList read FOwner; + property Owner: TGXSkeletonFrameList read FOwner; property Name: string read FName write FName; // Position values for the joints. property Position: TGAffineVectorList read FPosition write SetPosition; @@ -141,7 +141,7 @@ TgxSkeletonFrame = class(TGPersistentObject) property Quaternion: TGQuaternionList read FQuaternion write SetQuaternion; (* TransformMode indicates whether to use Rotation or Quaternion to build the local transform matrices. *) - property TransformMode: TgxSkeletonFrameTransform read FTransformMode write FTransformMode; + property TransformMode: TGXSkeletonFrameTransform read FTransformMode write FTransformMode; (* Calculate or retrieves an array of local bone matrices. This array is calculated on the first call after creation, and the first call following a FlushLocalMatrixList. Subsequent calls return @@ -155,12 +155,12 @@ TgxSkeletonFrame = class(TGPersistentObject) procedure ConvertRotationsToQuaternions(KeepRotations: Boolean = True); end; - // A list of TgxSkeletonFrame objects. - TgxSkeletonFrameList = class(TGPersistentObjectList) + // A list of TGXSkeletonFrame objects. + TGXSkeletonFrameList = class(TGPersistentObjectList) private FOwner: TPersistent; protected - function GetSkeletonFrame(Index: Integer): TgxSkeletonFrame; + function GetSkeletonFrame(Index: Integer): TGXSkeletonFrame; public constructor CreateOwned(aOwner: TPersistent); destructor Destroy; override; @@ -170,32 +170,32 @@ TgxSkeletonFrameList = class(TGPersistentObjectList) procedure ConvertRotationsToQuaternions(KeepRotations: Boolean = True; SetTransformMode: Boolean = True); property Owner: TPersistent read FOwner; procedure Clear; override; - property Items[Index: Integer]: TgxSkeletonFrame read GetSkeletonFrame; default; + property Items[Index: Integer]: TGXSkeletonFrame read GetSkeletonFrame; default; end; - TgxSkeleton = class; - TgxSkeletonBone = class; + TGXSkeleton = class; + TGXSkeletonBone = class; // A list of skeleton bones. - TgxSkeletonBoneList = class(TGPersistentObjectList) + TGXSkeletonBoneList = class(TGPersistentObjectList) private - FSkeleton: TgxSkeleton; // not persistent + FSkeleton: TGXSkeleton; // not persistent protected FGlobalMatrix: TMatrix4f; - function GetSkeletonBone(Index: Integer): TgxSkeletonBone; + function GetSkeletonBone(Index: Integer): TGXSkeletonBone; procedure AfterObjectCreatedByReader(Sender: TObject); override; public - constructor CreateOwned(aOwner: TgxSkeleton); + constructor CreateOwned(aOwner: TGXSkeleton); constructor Create; override; destructor Destroy; override; procedure WriteToFiler(writer: TGVirtualWriter); override; procedure ReadFromFiler(reader: TGVirtualReader); override; - property Skeleton: TgxSkeleton read FSkeleton; - property Items[Index: Integer]: TgxSkeletonBone read GetSkeletonBone; default; + property Skeleton: TGXSkeleton read FSkeleton; + property Items[Index: Integer]: TGXSkeletonBone read GetSkeletonBone; default; // Returns a bone by its BoneID, nil if not found. - function BoneByID(anID: Integer): TgxSkeletonBone; virtual; + function BoneByID(anID: Integer): TGXSkeletonBone; virtual; // Returns a bone by its Name, nil if not found. - function BoneByName(const aName: string): TgxSkeletonBone; virtual; + function BoneByName(const aName: string): TGXSkeletonBone; virtual; // Number of bones (including all children and self). function BoneCount: Integer; // Render skeleton wireframe @@ -204,7 +204,7 @@ TgxSkeletonBoneList = class(TGPersistentObjectList) end; // This list store skeleton root bones exclusively. - TgxSkeletonRootBoneList = class(TgxSkeletonBoneList) + TGXSkeletonRootBoneList = class(TGXSkeletonBoneList) public procedure WriteToFiler(writer: TGVirtualWriter); override; procedure ReadFromFiler(reader: TGVirtualReader); override; @@ -215,33 +215,33 @@ TgxSkeletonRootBoneList = class(TgxSkeletonBoneList) (* A skeleton bone or node and its children. This class is the base item of the bones hierarchy in a skeletal model. - The joint values are stored in a TgxSkeletonFrame, but the calculated bone + The joint values are stored in a TGXSkeletonFrame, but the calculated bone matrices are stored here. *) - TgxSkeletonBone = class(TgxSkeletonBoneList) + TGXSkeletonBone = class(TGXSkeletonBoneList) private - FOwner: TgxSkeletonBoneList; // indirectly persistent + FOwner: TGXSkeletonBoneList; // indirectly persistent FBoneID: Integer; FName: string; FColor: Cardinal; protected - function GetSkeletonBone(Index: Integer): TgxSkeletonBone; + function GetSkeletonBone(Index: Integer): TGXSkeletonBone; procedure SetColor(const val: Cardinal); public - constructor CreateOwned(aOwner: TgxSkeletonBoneList); + constructor CreateOwned(aOwner: TGXSkeletonBoneList); constructor Create; override; destructor Destroy; override; procedure WriteToFiler(writer: TGVirtualWriter); override; procedure ReadFromFiler(reader: TGVirtualReader); override; // Render skeleton wireframe procedure BuildList(var mrci: TgxRenderContextInfo); override; - property Owner: TgxSkeletonBoneList read FOwner; + property Owner: TGXSkeletonBoneList read FOwner; property Name: string read FName write FName; property BoneID: Integer read FBoneID write FBoneID; property Color: Cardinal read FColor write SetColor; - property Items[Index: Integer]: TgxSkeletonBone read GetSkeletonBone; default; + property Items[Index: Integer]: TGXSkeletonBone read GetSkeletonBone; default; // Returns a bone by its BoneID, nil if not found. - function BoneByID(anID: Integer): TgxSkeletonBone; override; - function BoneByName(const aName: string): TgxSkeletonBone; override; + function BoneByID(anID: Integer): TGXSkeletonBone; override; + function BoneByName(const aName: string): TGXSkeletonBone; override; // Set the bone's matrix. Becareful using this. procedure SetGlobalMatrix(Matrix: TMatrix4f); // Ragdoll // Set the bone's GlobalMatrix. Used for Ragdoll. @@ -257,34 +257,34 @@ TgxSkeletonBone = class(TgxSkeletonBoneList) procedure Clean; override; end; - TgxSkeletonColliderList = class; + TGXSkeletonColliderList = class; (* A general class storing the base level info required for skeleton based collision methods. This class is meant to be inherited from to create skeleton driven Verlet Constraints, ODE Geoms, etc. Overriden classes should be named as TSCxxxxx. *) - TgxSkeletonCollider = class(TGPersistentObject) + TGXSkeletonCollider = class(TGPersistentObject) private - FOwner: TgxSkeletonColliderList; - FBone: TgxSkeletonBone; + FOwner: TGXSkeletonColliderList; + FBone: TGXSkeletonBone; FBoneID: Integer; FLocalMatrix, FGlobalMatrix: TMatrix4f; FAutoUpdate: Boolean; protected - procedure SetBone(const val: TgxSkeletonBone); + procedure SetBone(const val: TGXSkeletonBone); procedure SetLocalMatrix(const val: TMatrix4f); public constructor Create; override; - constructor CreateOwned(aOwner: TgxSkeletonColliderList); + constructor CreateOwned(aOwner: TGXSkeletonColliderList); procedure WriteToFiler(writer: TGVirtualWriter); override; procedure ReadFromFiler(reader: TGVirtualReader); override; (* This method is used to align the colliders and their derived objects to their associated skeleton bone. Override to set up descendant class alignment properties. *) procedure AlignCollider; virtual; - property Owner: TgxSkeletonColliderList read FOwner; + property Owner: TGXSkeletonColliderList read FOwner; // The bone that this collider associates with. - property Bone: TgxSkeletonBone read FBone write SetBone; + property Bone: TGXSkeletonBone read FBone write SetBone; (* Offset and orientation of the collider in the associated bone's space. *) property LocalMatrix: TMatrix4f read FLocalMatrix write SetLocalMatrix; @@ -294,12 +294,12 @@ TgxSkeletonCollider = class(TGPersistentObject) property AutoUpdate: Boolean read FAutoUpdate write FAutoUpdate; end; - // List class for storing TgxSkeletonCollider objects. - TgxSkeletonColliderList = class(TGPersistentObjectList) + // List class for storing TGXSkeletonCollider objects. + TGXSkeletonColliderList = class(TGPersistentObjectList) private FOwner: TPersistent; protected - function GetSkeletonCollider(Index: Integer): TgxSkeletonCollider; + function GetSkeletonCollider(Index: Integer): TGXSkeletonCollider; public constructor CreateOwned(aOwner: TPersistent); destructor Destroy; override; @@ -308,13 +308,13 @@ TgxSkeletonColliderList = class(TGPersistentObjectList) // Calls AlignCollider for each collider in the list. procedure AlignColliders; property Owner: TPersistent read FOwner; - property Items[Index: Integer]: TgxSkeletonCollider read GetSkeletonCollider; default; + property Items[Index: Integer]: TGXSkeletonCollider read GetSkeletonCollider; default; end; - TgxBaseMesh = class; + TGXBaseMesh = class; // Small structure to store a weighted lerp for use in blending. - TgxBlendedLerpInfo = record + TGXBlendedLerpInfo = record frameIndex1, frameIndex2: Integer; lerpFactor: Single; weight: Single; @@ -327,41 +327,41 @@ TgxBlendedLerpInfo = record This class stores the bones hierarchy and animation frames. It is also responsible for maintaining the "CurrentFrame" and allowing various frame blending operations. *) - TgxSkeleton = class(TGPersistentObject) + TGXSkeleton = class(TGPersistentObject) private - FOwner: TgxBaseMesh; - FRootBones: TgxSkeletonRootBoneList; - FFrames: TgxSkeletonFrameList; - FCurrentFrame: TgxSkeletonFrame; // not persistent + FOwner: TGXBaseMesh; + FRootBones: TGXSkeletonRootBoneList; + FFrames: TGXSkeletonFrameList; + FCurrentFrame: TGXSkeletonFrame; // not persistent FBonesByIDCache: TList; - FColliders: TgxSkeletonColliderList; + FColliders: TGXSkeletonColliderList; FRagDollEnabled: Boolean; // ragdoll FMorphInvisibleParts: Boolean; protected - procedure SetRootBones(const val: TgxSkeletonRootBoneList); - procedure SetFrames(const val: TgxSkeletonFrameList); - function GetCurrentFrame: TgxSkeletonFrame; - procedure SetCurrentFrame(val: TgxSkeletonFrame); - procedure SetColliders(const val: TgxSkeletonColliderList); + procedure SetRootBones(const val: TGXSkeletonRootBoneList); + procedure SetFrames(const val: TGXSkeletonFrameList); + function GetCurrentFrame: TGXSkeletonFrame; + procedure SetCurrentFrame(val: TGXSkeletonFrame); + procedure SetColliders(const val: TGXSkeletonColliderList); public - constructor CreateOwned(aOwner: TgxBaseMesh); + constructor CreateOwned(aOwner: TGXBaseMesh); constructor Create; override; destructor Destroy; override; procedure WriteToFiler(writer: TGVirtualWriter); override; procedure ReadFromFiler(reader: TGVirtualReader); override; - property Owner: TgxBaseMesh read FOwner; - property RootBones: TgxSkeletonRootBoneList read FRootBones write SetRootBones; - property Frames: TgxSkeletonFrameList read FFrames write SetFrames; - property CurrentFrame: TgxSkeletonFrame read GetCurrentFrame write SetCurrentFrame; - property Colliders: TgxSkeletonColliderList read FColliders write SetColliders; + property Owner: TGXBaseMesh read FOwner; + property RootBones: TGXSkeletonRootBoneList read FRootBones write SetRootBones; + property Frames: TGXSkeletonFrameList read FFrames write SetFrames; + property CurrentFrame: TGXSkeletonFrame read GetCurrentFrame write SetCurrentFrame; + property Colliders: TGXSkeletonColliderList read FColliders write SetColliders; procedure FlushBoneByIDCache; - function BoneByID(anID: Integer): TgxSkeletonBone; - function BoneByName(const aName: string): TgxSkeletonBone; + function BoneByID(anID: Integer): TGXSkeletonBone; + function BoneByName(const aName: string): TGXSkeletonBone; function BoneCount: Integer; procedure MorphTo(frameIndex: Integer); overload; - procedure MorphTo(frame: TgxSkeletonFrame); overload; + procedure MorphTo(frame: TGXSkeletonFrame); overload; procedure Lerp(frameIndex1, frameIndex2: Integer; lerpFactor: Single); - procedure BlendedLerps(const lerpInfos: array of TgxBlendedLerpInfo); + procedure BlendedLerps(const lerpInfos: array of TGXBlendedLerpInfo); (* Linearly removes the translation component between skeletal frames. This function will compute the translation of the first bone (index 0) and linearly subtract this translation in all frames between startFrame @@ -377,7 +377,7 @@ TgxSkeleton = class(TGPersistentObject) // Applies current frame to morph all mesh objects. procedure MorphMesh(normalize: Boolean); // Copy bone rotations from reference skeleton. - procedure Synchronize(reference: TgxSkeleton); + procedure Synchronize(reference: TGXSkeleton); // Release bones and frames info. procedure Clear; // Backup and prepare the BoneMatrixInvertedMeshes to use with ragdolls @@ -390,13 +390,13 @@ TgxSkeleton = class(TGPersistentObject) property MorphInvisibleParts: Boolean read FMorphInvisibleParts write FMorphInvisibleParts; end; - (* Rendering options per TgxMeshObject. + (* Rendering options per TGXMeshObject. moroGroupByMaterial : if set, the facegroups will be rendered by material in batchs, this will optimize rendering by reducing material switches, but also implies that facegroups will not be rendered in the order they are in the list. *) - TgxMeshObjectRenderingOption = (moroGroupByMaterial); - TgxMeshObjectRenderingOptions = set of TgxMeshObjectRenderingOption; + TGXMeshObjectRenderingOption = (moroGroupByMaterial); + TGXMeshObjectRenderingOptions = set of TGXMeshObjectRenderingOption; TVBOBuffer = (vbVertices, vbNormals, vbColors, vbTexCoords, vbLightMapTexCoords, vbTexCoordsEx); TVBOBuffers = set of TVBOBuffer; @@ -404,16 +404,16 @@ TgxSkeleton = class(TGPersistentObject) (* Base mesh class. Introduces base methods and properties for mesh objects. Subclasses are named "TMOxxx". *) - TgxMeshObject = class(TgxBaseMeshObject) + TGXMeshObject = class(TGXBaseMeshObject) private - FOwner: TgxMeshObjectList; + FOwner: TGXMeshObjectList; FExtentCacheRevision: Cardinal; FTexCoords: TGAffineVectorList; // provision for 3D textures FLightMapTexCoords: TGAffineVectorList; // reserved for 2D surface needs FColors: TGVectorList; - FFaceGroups: TgxFaceGroups; - FMode: TgxMeshObjectMode; - FRenderingOptions: TgxMeshObjectRenderingOptions; + FFaceGroups: TGXFaceGroups; + FMode: TGXMeshObjectMode; + FRenderingOptions: TGXMeshObjectRenderingOptions; FArraysDeclared: Boolean; // not persistent FLightMapArrayEnabled: Boolean; // not persistent FLastLightMapIndex: Integer; // not persistent @@ -451,7 +451,7 @@ TgxMeshObject = class(TgxBaseMeshObject) property ValidBuffers: TVBOBuffers read FValidBuffers write SetValidBuffers; public // Creates, assigns Owner and adds to list. - constructor CreateOwned(aOwner: TgxMeshObjectList); + constructor CreateOwned(aOwner: TGXMeshObjectList); constructor Create; override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; @@ -487,13 +487,13 @@ TgxMeshObject = class(TgxBaseMeshObject) and texcoord data, filling the binormals and tangents where specified. *) procedure BuildTangentSpace(buildBinormals: Boolean = True; buildTangents: Boolean = True); - property Owner: TgxMeshObjectList read FOwner; - property mode: TgxMeshObjectMode read FMode write FMode; + property Owner: TGXMeshObjectList read FOwner; + property mode: TGXMeshObjectMode read FMode write FMode; property texCoords: TGAffineVectorList read FTexCoords write SetTexCoords; property LightMapTexCoords: TGAffineVectorList read FLightMapTexCoords write SetLightmapTexCoords; property Colors: TGVectorList read FColors write SetColors; - property FaceGroups: TgxFaceGroups read FFaceGroups; - property RenderingOptions: TgxMeshObjectRenderingOptions read FRenderingOptions write FRenderingOptions; + property FaceGroups: TGXFaceGroups read FFaceGroups; + property RenderingOptions: TGXMeshObjectRenderingOptions read FRenderingOptions write FRenderingOptions; // If set, rendering will use VBO's instead of vertex arrays. property UseVBO: Boolean read FUseVBO write SetUseVBO; (* The TexCoords Extension is a list of vector lists that are used @@ -518,17 +518,17 @@ TgxMeshObject = class(TgxBaseMeshObject) property TangentsTexCoordIndex: Integer read FTangentsTexCoordIndex write SetTangentsTexCoordIndex; end; - // A list of TgxMeshObject objects. - TgxMeshObjectList = class(TGPersistentObjectList) + // A list of TGXMeshObject objects. + TGXMeshObjectList = class(TGPersistentObjectList) private - FOwner: TgxBaseMesh; + FOwner: TGXBaseMesh; // Resturns True if all its MeshObjects use VBOs. function GetUseVBO: Boolean; procedure SetUseVBO(const Value: Boolean); protected - function GetMeshObject(Index: Integer): TgxMeshObject; + function GetMeshObject(Index: Integer): TGXMeshObject; public - constructor CreateOwned(aOwner: TgxBaseMesh); + constructor CreateOwned(aOwner: TGXBaseMesh); destructor Destroy; override; procedure ReadFromFiler(reader: TGVirtualReader); override; procedure PrepareMaterialLibraryCache(matLib: TgxMaterialLibrary); @@ -555,33 +555,33 @@ TgxMeshObjectList = class(TGPersistentObjectList) property UseVBO: Boolean read GetUseVBO write SetUseVBO; // Precalculate whatever is needed for rendering, called once procedure Prepare; virtual; - function FindMeshByName(MeshName: string): TgxMeshObject; - property Owner: TgxBaseMesh read FOwner; + function FindMeshByName(MeshName: string): TGXMeshObject; + property Owner: TGXBaseMesh read FOwner; procedure Clear; override; - property Items[Index: Integer]: TgxMeshObject read GetMeshObject; default; + property Items[Index: Integer]: TGXMeshObject read GetMeshObject; default; end; - TgxMeshObjectListClass = class of TgxMeshObjectList; - TgxMeshMorphTargetList = class; + TGXMeshObjectListClass = class of TGXMeshObjectList; + TGXMeshMorphTargetList = class; // A morph target, stores alternate lists of vertices and normals. - TgxMeshMorphTarget = class(TgxBaseMeshObject) + TGXMeshMorphTarget = class(TGXBaseMeshObject) private - FOwner: TgxMeshMorphTargetList; + FOwner: TGXMeshMorphTargetList; public - constructor CreateOwned(aOwner: TgxMeshMorphTargetList); + constructor CreateOwned(aOwner: TGXMeshMorphTargetList); destructor Destroy; override; procedure WriteToFiler(writer: TGVirtualWriter); override; procedure ReadFromFiler(reader: TGVirtualReader); override; - property Owner: TgxMeshMorphTargetList read FOwner; + property Owner: TGXMeshMorphTargetList read FOwner; end; - // A list of TgxMeshMorphTarget objects. - TgxMeshMorphTargetList = class(TGPersistentObjectList) + // A list of TGXMeshMorphTarget objects. + TGXMeshMorphTargetList = class(TGPersistentObjectList) private FOwner: TPersistent; protected - function GetMeshMorphTarget(Index: Integer): TgxMeshMorphTarget; + function GetMeshMorphTarget(Index: Integer): TGXMeshMorphTarget; public constructor CreateOwned(aOwner: TPersistent); destructor Destroy; override; @@ -589,15 +589,15 @@ TgxMeshMorphTargetList = class(TGPersistentObjectList) procedure Translate(const delta: TAffineVector); property Owner: TPersistent read FOwner; procedure Clear; override; - property Items[Index: Integer]: TgxMeshMorphTarget read GetMeshMorphTarget; default; + property Items[Index: Integer]: TGXMeshMorphTarget read GetMeshMorphTarget; default; end; (* Mesh object with support for morph targets. The morph targets allow to change vertices and normals according to pre- existing "morph targets". *) - TgxMorphableMeshObject = class(TgxMeshObject) + TGXMorphableMeshObject = class(TGXMeshObject) private - FMorphTargets: TgxMeshMorphTargetList; + FMorphTargets: TGXMeshMorphTargetList; public constructor Create; override; destructor Destroy; override; @@ -607,30 +607,30 @@ TgxMorphableMeshObject = class(TgxMeshObject) procedure Translate(const delta: TAffineVector); override; procedure MorphTo(morphTargetIndex: Integer); virtual; procedure Lerp(morphTargetIndex1, morphTargetIndex2: Integer; lerpFactor: Single); virtual; - property MorphTargets: TgxMeshMorphTargetList read FMorphTargets; + property MorphTargets: TGXMeshMorphTargetList read FMorphTargets; end; - TgxVertexBoneWeight = packed record + TGXVertexBoneWeight = packed record BoneID: Integer; weight: Single; end; - TgxVertexBoneWeightArray = array [0 .. MaxInt div (2 * SizeOf(TgxVertexBoneWeight))] of TgxVertexBoneWeight; - PgxVertexBoneWeightArray = ^TgxVertexBoneWeightArray; - TgxVerticesBoneWeights = array [0 .. MaxInt div (2 * SizeOf(PgxVertexBoneWeightArray))] of PgxVertexBoneWeightArray; - PgxVerticesBoneWeights = ^TgxVerticesBoneWeights; - TgxVertexBoneWeightDynArray = array of TgxVertexBoneWeight; + TGXVertexBoneWeightArray = array [0 .. MaxInt div (2 * SizeOf(TGXVertexBoneWeight))] of TGXVertexBoneWeight; + PGXVertexBoneWeightArray = ^TGXVertexBoneWeightArray; + TGXVerticesBoneWeights = array [0 .. MaxInt div (2 * SizeOf(PGXVertexBoneWeightArray))] of PGXVertexBoneWeightArray; + PGXVerticesBoneWeights = ^TGXVerticesBoneWeights; + TGXVertexBoneWeightDynArray = array of TGXVertexBoneWeight; (* A mesh object with vertice bone attachments. The class adds per vertex bone weights to the standard morphable mesh. - The TgxVertexBoneWeight structures are accessed via VerticesBonesWeights, + The TGXVertexBoneWeight structures are accessed via VerticesBonesWeights, they must be initialized by adjusting the BonesPerVertex and VerticeBoneWeightCount properties, you can also add vertex by vertex by using the AddWeightedBone method. When BonesPerVertex is 1, the weight is ignored (set to 1.0). *) - TgxSkeletonMeshObject = class(TgxMorphableMeshObject) + TGXSkeletonMeshObject = class(TGXMorphableMeshObject) private - FVerticesBonesWeights: PgxVerticesBoneWeights; + FVerticesBonesWeights: PGXVerticesBoneWeights; FVerticeBoneWeightCount, FVerticeBoneWeightCapacity: Integer; FBonesPerVertex: Integer; FLastVerticeBoneWeightCount, FLastBonesPerVertex: Integer; // not persistent @@ -649,27 +649,27 @@ TgxSkeletonMeshObject = class(TgxMorphableMeshObject) procedure WriteToFiler(writer: TGVirtualWriter); override; procedure ReadFromFiler(reader: TGVirtualReader); override; procedure Clear; override; - property VerticesBonesWeights: PgxVerticesBoneWeights read FVerticesBonesWeights; + property VerticesBonesWeights: PGXVerticesBoneWeights read FVerticesBonesWeights; property VerticeBoneWeightCount: Integer read FVerticeBoneWeightCount write SetVerticeBoneWeightCount; property VerticeBoneWeightCapacity: Integer read FVerticeBoneWeightCapacity write SetVerticeBoneWeightCapacity; property BonesPerVertex: Integer read FBonesPerVertex write SetBonesPerVertex; function FindOrAdd(BoneID: Integer; const vertex, normal: TAffineVector): Integer; overload; - function FindOrAdd(const boneIDs: TgxVertexBoneWeightDynArray; const vertex, normal: TAffineVector): Integer; overload; + function FindOrAdd(const boneIDs: TGXVertexBoneWeightDynArray; const vertex, normal: TAffineVector): Integer; overload; procedure AddWeightedBone(aBoneID: Integer; aWeight: Single); - procedure AddWeightedBones(const boneIDs: TgxVertexBoneWeightDynArray); + procedure AddWeightedBones(const boneIDs: TGXVertexBoneWeightDynArray); procedure PrepareBoneMatrixInvertedMeshes; procedure ApplyCurrentSkeletonFrame(normalize: Boolean); end; - (* Describes a face group of a TgxMeshObject. + (* Describes a face group of a TGXMeshObject. Face groups should be understood as "a way to use mesh data to render a part or the whole mesh object". Subclasses implement the actual behaviours, and should have at least one "Add" method, taking in parameters all that is required to describe a single base facegroup element. *) - TgxFaceGroup = class(TGPersistentObject) + TGXFaceGroup = class(TGPersistentObject) private - FOwner: TgxFaceGroups; + FOwner: TGXFaceGroups; FMaterialName: string; FMaterialCache: TgxLibMaterial; FLightMapIndex: Integer; @@ -679,7 +679,7 @@ TgxFaceGroup = class(TGPersistentObject) procedure AttachLightmap(lightMap: TgxTexture; var mrci: TgxRenderContextInfo); procedure AttachOrDetachLightmap(var mrci: TgxRenderContextInfo); public - constructor CreateOwned(aOwner: TgxFaceGroups); virtual; + constructor CreateOwned(aOwner: TGXFaceGroups); virtual; destructor Destroy; override; procedure WriteToFiler(writer: TGVirtualWriter); override; procedure ReadFromFiler(reader: TGVirtualReader); override; @@ -698,7 +698,7 @@ TgxFaceGroup = class(TGPersistentObject) procedure Reverse; virtual; // Precalculate whatever is needed for rendering, called once procedure Prepare; virtual; - property Owner: TgxFaceGroups read FOwner write FOwner; + property Owner: TGXFaceGroups read FOwner write FOwner; property MaterialName: string read FMaterialName write FMaterialName; property MaterialCache: TgxLibMaterial read FMaterialCache; // Index of lightmap in the lightmap library. @@ -712,17 +712,17 @@ TgxFaceGroup = class(TGPersistentObject) the same normal for all vertices of a triangle. - fgmmTriangleFan : issue all vertices with GL_TRIANGLE_FAN. - fgmmQuads : issue all vertices with GL_QUADS. *) - TgxFaceGroupMeshMode = (fgmmTriangles, fgmmTriangleStrip, fgmmFlatTriangles, fgmmTriangleFan, fgmmQuads); + TGXFaceGroupMeshMode = (fgmmTriangles, fgmmTriangleStrip, fgmmFlatTriangles, fgmmTriangleFan, fgmmQuads); (* A face group based on an indexlist. The index list refers to items in the mesh object (vertices, normals, etc.), that are all considered in sync, the render is obtained issueing the items in the order given by the vertices. *) - TfgxVertexIndexList = class(TgxFaceGroup) + TFGXVertexIndexList = class(TGXFaceGroup) private FVertexIndices: TGIntegerList; FIndexVBO: TgxVBOElementArrayHandle; - FMode: TgxFaceGroupMeshMode; + FMode: TGXFaceGroupMeshMode; procedure SetupVBO; procedure InvalidateVBO; protected @@ -744,14 +744,14 @@ TfgxVertexIndexList = class(TgxFaceGroup) procedure ConvertToList; // Return the normal from the 1st three points in the facegroup function GetNormal: TAffineVector; - property mode: TgxFaceGroupMeshMode read FMode write FMode; + property mode: TGXFaceGroupMeshMode read FMode write FMode; property vertexIndices: TGIntegerList read FVertexIndices write SetVertexIndices; end; (* Adds normals and texcoords indices. Allows very compact description of a mesh. The Normals ad TexCoords indices are optionnal, if missing (empty), VertexIndices will be used. *) - TFGVertexNormalTexIndexList = class(TfgxVertexIndexList) + TFGVertexNormalTexIndexList = class(TFGXVertexIndexList) private FNormalIndices: TGIntegerList; FTexCoordIndices: TGIntegerList; @@ -774,7 +774,7 @@ TFGVertexNormalTexIndexList = class(TfgxVertexIndexList) (* Adds per index texture coordinates to its ancestor. Per index texture coordinates allows having different texture coordinates per triangle, depending on the face it is used in. *) - TFGIndexTexCoordList = class(TfgxVertexIndexList) + TFGIndexTexCoordList = class(TFGXVertexIndexList) private FTexCoords: TGAffineVectorList; protected @@ -792,23 +792,23 @@ TFGIndexTexCoordList = class(TfgxVertexIndexList) property texCoords: TGAffineVectorList read FTexCoords write SetTexCoords; end; - // A list of TgxFaceGroup objects. - TgxFaceGroups = class(TGPersistentObjectList) + // A list of TGXFaceGroup objects. + TGXFaceGroups = class(TGPersistentObjectList) private - FOwner: TgxMeshObject; + FOwner: TGXMeshObject; protected - function GetFaceGroup(Index: Integer): TgxFaceGroup; + function GetFaceGroup(Index: Integer): TGXFaceGroup; public - constructor CreateOwned(aOwner: TgxMeshObject); + constructor CreateOwned(aOwner: TGXMeshObject); destructor Destroy; override; procedure ReadFromFiler(reader: TGVirtualReader); override; procedure PrepareMaterialLibraryCache(matLib: TgxMaterialLibrary); procedure DropMaterialLibraryCache; - property Owner: TgxMeshObject read FOwner; + property Owner: TGXMeshObject read FOwner; procedure Clear; override; - property Items[Index: Integer]: TgxFaceGroup read GetFaceGroup; default; + property Items[Index: Integer]: TGXFaceGroup read GetFaceGroup; default; procedure AddToTriangles(aList: TGAffineVectorList; aTexCoords: TGAffineVectorList = nil; aNormals: TGAffineVectorList = nil); - // Material Library of the owner TgxBaseMesh. + // Material Library of the owner TGXBaseMesh. function MaterialLibrary: TgxMaterialLibrary; (* Sort faces by material. Those without material first in list, followed by opaque materials, @@ -825,26 +825,26 @@ TgxFaceGroups = class(TGPersistentObjectList) (* Abstract base class for different vector file Formatx. The actual implementation for these files (3DS, DXF..) must be done - seperately. The concept for TgxVectorFile is very similar to TGraphic + seperately. The concept for TGXVectorFile is very similar to TGraphic (see Delphi Help). *) - TgxVectorFile = class(TgxDataFile) + TGXVectorFile = class(TgxDataFile) private FNormalsOrientation: TMeshNormalsOrientation; protected procedure SetNormalsOrientation(const val: TMeshNormalsOrientation); virtual; public constructor Create(aOwner: TPersistent); override; - function Owner: TgxBaseMesh; + function Owner: TGXBaseMesh; property NormalsOrientation: TMeshNormalsOrientation read FNormalsOrientation write SetNormalsOrientation; end; - TgxVectorFileClass = class of TgxVectorFile; + TGXVectorFileClass = class of TGXVectorFile; (* GLSM ( GXScene Mesh) vector file. This corresponds to the 'native' Scene format, and object persistence stream, which should be the 'fastest' of all formats to load, and supports all of GXScene features. *) - TgxGLSMVectorFile = class(TgxVectorFile) + TGXVectorFileGLSM = class(TGXVectorFile) public class function Capabilities: TDataFileCapabilities; override; procedure LoadFromStream(aStream: TStream); override; @@ -852,7 +852,7 @@ TgxGLSMVectorFile = class(TgxVectorFile) end; // Base class for mesh objects. - TgxBaseMesh = class(TgxSceneObject) + TGXBaseMesh = class(TgxSceneObject) private FNormalsOrientation: TMeshNormalsOrientation; FMaterialLibrary: TgxMaterialLibrary; @@ -863,14 +863,14 @@ TgxBaseMesh = class(TgxSceneObject) FUseMeshMaterials: Boolean; FOverlaySkeleton: Boolean; FIgnoreMissingTextures: Boolean; - FAutoCentering: TgxMeshAutoCenterings; + FAutoCentering: TGXMeshAutoCenterings; FAutoScaling: TGCoordinates; FMaterialLibraryCachesPrepared: Boolean; FConnectivity: TObject; FLastLoadedFilename: string; protected - FMeshObjects: TgxMeshObjectList; // a list of mesh objects - FSkeleton: TgxSkeleton; // skeleton data & frames + FMeshObjects: TGXMeshObjectList; // a list of mesh objects + FSkeleton: TGXSkeleton; // skeleton data & frames procedure SetUseMeshMaterials(const val: Boolean); procedure SetMaterialLibrary(const val: TgxMaterialLibrary); procedure SetLightmapLibrary(const val: TgxMaterialLibrary); @@ -878,10 +878,10 @@ TgxBaseMesh = class(TgxSceneObject) procedure SetOverlaySkeleton(const val: Boolean); procedure SetAutoScaling(const Value: TGCoordinates); procedure DestroyHandle; override; - (* Invoked after creating a TgxVectorFile and before loading. + (* Invoked after creating a TGXVectorFile and before loading. Triggered by LoadFromFile/Stream and AddDataFromFile/Stream. Allows to adjust/transfer subclass-specific features. *) - procedure PrepareVectorFile(aFile: TgxVectorFile); virtual; + procedure PrepareVectorFile(aFile: TGXVectorFile); virtual; (* Invoked after a mesh has been loaded/added. Triggered by LoadFromFile/Stream and AddDataFromFile/Stream. Allows to adjust/transfer subclass-specific features. *) @@ -923,8 +923,8 @@ TgxBaseMesh = class(TgxSceneObject) If your actor/mesh doesn't change, you don't need to call this. It basically caches the connectivity data. *) procedure BuildSilhouetteConnectivityData; - property MeshObjects: TgxMeshObjectList read FMeshObjects; - property Skeleton: TgxSkeleton read FSkeleton; + property MeshObjects: TGXMeshObjectList read FMeshObjects; + property Skeleton: TGXSkeleton read FSkeleton; // Computes the extents of the mesh. procedure GetExtents(out min, max: TAffineVector); // Computes the barycenter of the mesh. @@ -968,7 +968,7 @@ TgxBaseMesh = class(TgxSceneObject) no effect on already loaded mesh data or when adding from a file/stream. If you want to alter mesh data, use direct manipulation methods (on the TgxMeshObjects). *) - property AutoCentering: TgxMeshAutoCenterings read FAutoCentering write FAutoCentering default []; + property AutoCentering: TGXMeshAutoCenterings read FAutoCentering write FAutoCentering default []; (* Scales vertices to a AutoScaling. AutoScaling is performed only after loading a mesh, it has no effect on already loaded mesh data or when adding from a file/stream. @@ -1005,7 +1005,7 @@ TgxBaseMesh = class(TgxSceneObject) method. A FreeForm may contain more than one mesh, but they will all be handled as a single object in a scene. *) - TgxFreeForm = class(TgxBaseMesh) + TGXFreeForm = class(TGXBaseMesh) private FOctree: TgxOctree; protected @@ -1049,27 +1049,27 @@ TgxFreeForm = class(TgxBaseMesh) type - TgxActor = class; - TgxActorAnimationReference = (aarMorph, aarSkeleton, aarNone); + TGXActor = class; + TGXActorAnimationReference = (aarMorph, aarSkeleton, aarNone); (* An actor animation sequence. An animation sequence is a named set of contiguous frames that can be used for animating an actor. The referred frames can be either morph or skeletal frames (choose which via the Reference property). An animation can be directly "played" by the actor by selecting it with - SwitchAnimation, and can also be "blended" via a TgxAnimationControler. *) - TgxActorAnimation = class(TCollectionItem) + SwitchAnimation, and can also be "blended" via a TGXAnimationControler. *) + TGXActorAnimation = class(TCollectionItem) private FName: string; FStartFrame: Integer; FEndFrame: Integer; - FReference: TgxActorAnimationReference; + FReference: TGXActorAnimationReference; protected function GetDisplayName: string; override; function FrameCount: Integer; procedure SetStartFrame(const val: Integer); procedure SetEndFrame(const val: Integer); - procedure SetReference(val: TgxActorAnimationReference); + procedure SetReference(val: TGXActorAnimationReference); procedure SetAsString(const val: string); function GetAsString: string; public @@ -1077,7 +1077,7 @@ TgxActorAnimation = class(TCollectionItem) destructor Destroy; override; procedure Assign(Source: TPersistent); override; property AsString: string read GetAsString write SetAsString; - function OwnerActor: TgxActor; + function OwnerActor: TGXActor; (* Linearly removes the translation component between skeletal frames. This function will compute the translation of the first bone (index 0) and linearly subtract this translation in all frames between startFrame @@ -1097,68 +1097,68 @@ TgxActorAnimation = class(TCollectionItem) // Index of the final frame of the animation. property endFrame: Integer read FEndFrame write SetEndFrame; // Indicates if this is a skeletal or a morph-based animation. - property reference: TgxActorAnimationReference read FReference write SetReference default aarMorph; + property reference: TGXActorAnimationReference read FReference write SetReference default aarMorph; end; - TgxActorAnimationName = string; + TGXActorAnimationName = string; // Collection of actor animations sequences. - TgxActorAnimations = class(TCollection) + TGXActorAnimations = class(TCollection) private - FOwner: TgxActor; + FOwner: TGXActor; protected function GetOwner: TPersistent; override; - procedure SetItems(Index: Integer; const val: TgxActorAnimation); - function GetItems(Index: Integer): TgxActorAnimation; + procedure SetItems(Index: Integer; const val: TGXActorAnimation); + function GetItems(Index: Integer): TGXActorAnimation; public - constructor Create(aOwner: TgxActor); - function Add: TgxActorAnimation; - function FindItemID(ID: Integer): TgxActorAnimation; - function FindName(const aName: string): TgxActorAnimation; - function FindFrame(aFrame: Integer; aReference: TgxActorAnimationReference): TgxActorAnimation; + constructor Create(aOwner: TGXActor); + function Add: TGXActorAnimation; + function FindItemID(ID: Integer): TGXActorAnimation; + function FindName(const aName: string): TGXActorAnimation; + function FindFrame(aFrame: Integer; aReference: TGXActorAnimationReference): TGXActorAnimation; procedure SetToStrings(aStrings: TStrings); procedure SaveToStream(aStream: TStream); procedure LoadFromStream(aStream: TStream); procedure SaveToFile(const filename: string); procedure LoadFromFile(const filename: string); - property Items[index: Integer]: TgxActorAnimation read GetItems write SetItems; default; - function Last: TgxActorAnimation; + property Items[index: Integer]: TGXActorAnimation read GetItems write SetItems; default; + function Last: TGXActorAnimation; end; // Base class for skeletal animation control. - TgxBaseAnimationControler = class(TComponent) + TGXBaseAnimationControler = class(TComponent) private FEnabled: Boolean; - FActor: TgxActor; + FActor: TGXActor; protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SetEnabled(const val: Boolean); - procedure SetActor(const val: TgxActor); + procedure SetActor(const val: TGXActor); procedure DoChange; virtual; - function Apply(var lerpInfo: TgxBlendedLerpInfo): Boolean; virtual; + function Apply(var lerpInfo: TGXBlendedLerpInfo): Boolean; virtual; public constructor Create(aOwner: TComponent); override; destructor Destroy; override; published property Enabled: Boolean read FEnabled write SetEnabled default True; - property Actor: TgxActor read FActor write SetActor; + property Actor: TGXActor read FActor write SetActor; end; (* Controls the blending of an additionnal skeletal animation into an actor. The animation controler allows animating an actor with several animations at a time, for instance, you could use a "run" animation as base animation - (in TgxActor), blend an animation that makes the arms move differently + (in TGXActor), blend an animation that makes the arms move differently depending on what the actor is carrying, along with an animation that will make the head turn toward a target. *) - TgxAnimationControler = class(TgxBaseAnimationControler) + TGXAnimationControler = class(TGXBaseAnimationControler) private - FAnimationName: TgxActorAnimationName; + FAnimationName: TGXActorAnimationName; FRatio: Single; protected - procedure SetAnimationName(const val: TgxActorAnimationName); + procedure SetAnimationName(const val: TGXActorAnimationName); procedure SetRatio(const val: Single); procedure DoChange; override; - function Apply(var lerpInfo: TgxBlendedLerpInfo): Boolean; override; + function Apply(var lerpInfo: TGXBlendedLerpInfo): Boolean; override; published property AnimationName: string read FAnimationName write SetAnimationName; property Ratio: Single read FRatio write SetRatio; @@ -1183,13 +1183,13 @@ TgxAnimationControler = class(TgxBaseAnimationControler) TgxActorAnimationMode = (aamNone, aamPlayOnce, aamLoop, aamBounceForward, aamBounceBackward, aamLoopBackward, aamExternal); (* Mesh class specialized in animated meshes. - The TgxActor provides a quick interface to animated meshes based on morph + The TGXActor provides a quick interface to animated meshes based on morph or skeleton frames, it is capable of performing frame interpolation and - animation blending (via TgxAnimationControler components). *) - TgxActor = class(TgxBaseMesh) + animation blending (via TGXAnimationControler components). *) + TGXActor = class(TGXBaseMesh) private FStartFrame, FEndFrame: Integer; - FReference: TgxActorAnimationReference; + FReference: TGXActorAnimationReference; FCurrentFrame: Integer; FCurrentFrameDelta: Single; FFrameInterpolation: TActorFrameInterpolation; @@ -1197,23 +1197,23 @@ TgxActor = class(TgxBaseMesh) FAnimationMode: TgxActorAnimationMode; FOnFrameChanged: TNotifyEvent; FOnEndFrameReached, FOnStartFrameReached: TNotifyEvent; - FAnimations: TgxActorAnimations; - FTargetSmoothAnimation: TgxActorAnimation; + FAnimations: TGXActorAnimations; + FTargetSmoothAnimation: TGXActorAnimation; FControlers: TList; FOptions: TgxActorOptions; protected procedure SetCurrentFrame(val: Integer); procedure SetStartFrame(val: Integer); procedure SetEndFrame(val: Integer); - procedure SetReference(val: TgxActorAnimationReference); - procedure SetAnimations(const val: TgxActorAnimations); + procedure SetReference(val: TGXActorAnimationReference); + procedure SetAnimations(const val: TGXActorAnimations); function StoreAnimations: Boolean; procedure SetOptions(const val: TgxActorOptions); procedure PrepareMesh; override; procedure PrepareBuildList(var mrci: TgxRenderContextInfo); override; procedure DoAnimate; virtual; - procedure RegisterControler(aControler: TgxBaseAnimationControler); - procedure UnRegisterControler(aControler: TgxBaseAnimationControler); + procedure RegisterControler(aControler: TGXBaseAnimationControler); + procedure UnRegisterControler(aControler: TGXBaseAnimationControler); public constructor Create(aOwner: TComponent); override; destructor Destroy; override; @@ -1221,14 +1221,14 @@ TgxActor = class(TgxBaseMesh) procedure BuildList(var rci: TgxRenderContextInfo); override; procedure DoProgress(const progressTime: TGProgressTimes); override; procedure LoadFromStream(const filename: string; aStream: TStream); override; - procedure SwitchToAnimation(anAnimation: TgxActorAnimation; smooth: Boolean = False); overload; + procedure SwitchToAnimation(anAnimation: TGXActorAnimation; smooth: Boolean = False); overload; procedure SwitchToAnimation(const AnimationName: string; smooth: Boolean = False); overload; procedure SwitchToAnimation(animationIndex: Integer; smooth: Boolean = False); overload; function CurrentAnimation: string; (* Synchronize self animation with an other actor. Copies Start/Current/End Frame values, CurrentFrameDelta, AnimationMode and FrameInterpolation. *) - procedure Synchronize(referenceActor: TgxActor); + procedure Synchronize(referenceActor: TGXActor); (* Provides a direct access to FCurrentFrame without any checks. Used in TgxActorProxy. *) procedure SetCurrentFrameDirect(const Value: Integer); @@ -1244,7 +1244,7 @@ TgxActor = class(TgxBaseMesh) property endFrame: Integer read FEndFrame write SetEndFrame default 0; (* Reference Frame Animation mode. Allows specifying if the model is primarily morph or skeleton based. *) - property reference: TgxActorAnimationReference read FReference write FReference default aarMorph; + property reference: TGXActorAnimationReference read FReference write FReference default aarMorph; // Current animation frame. property CurrentFrame: Integer read FCurrentFrame write SetCurrentFrame default 0; // Value in the [0; 1] range expressing the delta to the next frame. @@ -1264,7 +1264,7 @@ TgxActor = class(TgxBaseMesh) // Triggered after StartFrame has been reached by progression or "nextframe" property OnStartFrameReached: TNotifyEvent read FOnStartFrameReached write FOnStartFrameReached; // Collection of animations sequences. - property Animations: TgxActorAnimations read FAnimations write SetAnimations stored StoreAnimations; + property Animations: TGXActorAnimations read FAnimations write SetAnimations stored StoreAnimations; property AutoCentering; property MaterialLibrary; property LightmapLibrary; @@ -1275,21 +1275,21 @@ TgxActor = class(TgxBaseMesh) TgxVectorFileFormat = class public - VectorFileClass: TgxVectorFileClass; + VectorFileClass: TGXVectorFileClass; Extension: string; Description: string; DescResID: Integer; end; // Stores registered vector file Formatx. - TgxVectorFileFormatsList = class(TGPersistentObjectList) + TGXVectorFileFormatsList = class(TGPersistentObjectList) public destructor Destroy; override; - procedure Add(const Ext, Desc: string; DescID: Integer; AClass: TgxVectorFileClass); - function FindExt(Ext: string): TgxVectorFileClass; - function FindFromFileName(const filename: string): TgxVectorFileClass; - procedure Remove(AClass: TgxVectorFileClass); - procedure BuildFilterStrings(VectorFileClass: TgxVectorFileClass; out descriptions, filters: string; + procedure Add(const Ext, Desc: string; DescID: Integer; AClass: TGXVectorFileClass); + function FindExt(Ext: string): TGXVectorFileClass; + function FindFromFileName(const filename: string): TGXVectorFileClass; + procedure Remove(AClass: TGXVectorFileClass); + procedure BuildFilterStrings(VectorFileClass: TGXVectorFileClass; out descriptions, filters: string; formatsThatCanBeOpened: Boolean = True; formatsThatCanBeSaved: Boolean = False); function FindExtByIndex(Index: Integer; formatsThatCanBeOpened: Boolean = True; formatsThatCanBeSaved: Boolean = False): string; @@ -1298,7 +1298,7 @@ TgxVectorFileFormatsList = class(TGPersistentObjectList) EInvalidVectorFile = class(Exception); // Read access to the list of registered vector file formats -function GetVectorFileFormats: TgxVectorFileFormatsList; +function GetVectorFileFormats: TGXVectorFileFormatsList; // A file extension filter suitable for dialog's 'Filter' property function VectorFileFormatsFilter: string; // A file extension filter suitable for a savedialog's 'Filter' property @@ -1307,33 +1307,30 @@ function VectorFileFormatsSaveFilter: string; Use VectorFileFormatsFilter to obtain the filter. *) function VectorFileFormatExtensionByIndex(Index: Integer): string; -procedure RegisterVectorFileFormat(const aExtension, aDescription: string; AClass: TgxVectorFileClass); -procedure UnregisterVectorFileClass(AClass: TgxVectorFileClass); +procedure RegisterVectorFileFormat(const aExtension, aDescription: string; AClass: TGXVectorFileClass); +procedure UnregisterVectorFileClass(AClass: TGXVectorFileClass); var vVectorFileObjectsAllocateMaterials: Boolean = True; // Flag to avoid loading materials (useful for IDE Extentions or scene editors) vVectorFileObjectsEnableVBOByDefault: Boolean = True; -// =========================================================================== -implementation -// =========================================================================== +implementation //-------------------------------------------------------------- uses - GXS.MeshUtils, GXS.BaseMeshSilhouette; var - vVectorFileFormats: TgxVectorFileFormatsList; + vVectorFileFormats: TGXVectorFileFormatsList; vNextRenderGroupID: Integer = 1; const cAAFHeader: AnsiString = 'AAF'; -function GetVectorFileFormats: TgxVectorFileFormatsList; +function GetVectorFileFormats: TGXVectorFileFormatsList; begin if not Assigned(vVectorFileFormats) then - vVectorFileFormats := TgxVectorFileFormatsList.Create; + vVectorFileFormats := TGXVectorFileFormatsList.Create; Result := vVectorFileFormats; end; @@ -1341,23 +1338,23 @@ function VectorFileFormatsFilter: string; var f: string; begin - GetVectorFileFormats.BuildFilterStrings(TgxVectorFile, Result, f); + GetVectorFileFormats.BuildFilterStrings(TGXVectorFile, Result, f); end; function VectorFileFormatsSaveFilter: string; var f: string; begin - GetVectorFileFormats.BuildFilterStrings(TgxVectorFile, Result, f, False, True); + GetVectorFileFormats.BuildFilterStrings(TGXVectorFile, Result, f, False, True); end; -procedure RegisterVectorFileFormat(const aExtension, aDescription: string; AClass: TgxVectorFileClass); +procedure RegisterVectorFileFormat(const aExtension, aDescription: string; AClass: TGXVectorFileClass); begin RegisterClass(AClass); GetVectorFileFormats.Add(aExtension, aDescription, 0, AClass); end; -procedure UnregisterVectorFileClass(AClass: TgxVectorFileClass); +procedure UnregisterVectorFileClass(AClass: TGXVectorFileClass); begin if Assigned(vVectorFileFormats) then vVectorFileFormats.Remove(AClass); @@ -1368,13 +1365,13 @@ function VectorFileFormatExtensionByIndex(Index: Integer): string; Result := GetVectorFileFormats.FindExtByIndex(index); end; -destructor TgxVectorFileFormatsList.Destroy; +destructor TGXVectorFileFormatsList.Destroy; begin Clean; inherited; end; -procedure TgxVectorFileFormatsList.Add(const Ext, Desc: string; DescID: Integer; AClass: TgxVectorFileClass); +procedure TGXVectorFileFormatsList.Add(const Ext, Desc: string; DescID: Integer; AClass: TGXVectorFileClass); var newRec: TgxVectorFileFormat; begin @@ -1389,7 +1386,7 @@ procedure TgxVectorFileFormatsList.Add(const Ext, Desc: string; DescID: Integer; inherited Add(newRec); end; -function TgxVectorFileFormatsList.FindExt(Ext: string): TgxVectorFileClass; +function TGXVectorFileFormatsList.FindExt(Ext: string): TGXVectorFileClass; var i: Integer; begin @@ -1406,7 +1403,7 @@ function TgxVectorFileFormatsList.FindExt(Ext: string): TgxVectorFileClass; Result := nil; end; -function TgxVectorFileFormatsList.FindFromFileName(const filename: string): TgxVectorFileClass; +function TGXVectorFileFormatsList.FindFromFileName(const filename: string): TGXVectorFileClass; var Ext: string; begin @@ -1417,7 +1414,7 @@ function TgxVectorFileFormatsList.FindFromFileName(const filename: string): TgxV raise EInvalidVectorFile.CreateFmt(strUnknownExtension, [Ext, 'GLFile' + UpperCase(Ext)]); end; -procedure TgxVectorFileFormatsList.Remove(AClass: TgxVectorFileClass); +procedure TGXVectorFileFormatsList.Remove(AClass: TGXVectorFileClass); var i: Integer; begin @@ -1428,7 +1425,7 @@ procedure TgxVectorFileFormatsList.Remove(AClass: TgxVectorFileClass); end; end; -procedure TgxVectorFileFormatsList.BuildFilterStrings(VectorFileClass: TgxVectorFileClass; out descriptions, filters: string; +procedure TGXVectorFileFormatsList.BuildFilterStrings(VectorFileClass: TGXVectorFileClass; out descriptions, filters: string; formatsThatCanBeOpened: Boolean = True; formatsThatCanBeSaved: Boolean = False); var k, i: Integer; @@ -1463,7 +1460,7 @@ procedure TgxVectorFileFormatsList.BuildFilterStrings(VectorFileClass: TgxVector FmtStr(descriptions, '%s (%s)|%1:s|%s', [sAllFilter, filters, descriptions]); end; -function TgxVectorFileFormatsList.FindExtByIndex(Index: Integer; formatsThatCanBeOpened: Boolean = True; +function TGXVectorFileFormatsList.FindExtByIndex(Index: Integer; formatsThatCanBeOpened: Boolean = True; formatsThatCanBeSaved: Boolean = False): string; var i: Integer; @@ -1491,10 +1488,10 @@ function TgxVectorFileFormatsList.FindExtByIndex(Index: Integer; formatsThatCanB end; // ------------------ -// ------------------ TgxBaseMeshObject ------------------ +// ------------------ TGXBaseMeshObject ------------------ // ------------------ -constructor TgxBaseMeshObject.Create; +constructor TGXBaseMeshObject.Create; begin FVertices := TGAffineVectorList.Create; FNormals := TGAffineVectorList.Create; @@ -1502,26 +1499,26 @@ constructor TgxBaseMeshObject.Create; inherited Create; end; -destructor TgxBaseMeshObject.Destroy; +destructor TGXBaseMeshObject.Destroy; begin FNormals.Free; FVertices.Free; inherited; end; -procedure TgxBaseMeshObject.Assign(Source: TPersistent); +procedure TGXBaseMeshObject.Assign(Source: TPersistent); begin - if Source is TgxBaseMeshObject then + if Source is TGXBaseMeshObject then begin - FName := TgxBaseMeshObject(Source).Name; - FVertices.Assign(TgxBaseMeshObject(Source).FVertices); - FNormals.Assign(TgxBaseMeshObject(Source).FNormals); + FName := TGXBaseMeshObject(Source).Name; + FVertices.Assign(TGXBaseMeshObject(Source).FVertices); + FNormals.Assign(TGXBaseMeshObject(Source).FNormals); end else inherited; // Die! end; -procedure TgxBaseMeshObject.WriteToFiler(writer: TGVirtualWriter); +procedure TGXBaseMeshObject.WriteToFiler(writer: TGVirtualWriter); begin inherited WriteToFiler(writer); with writer do @@ -1534,7 +1531,7 @@ procedure TgxBaseMeshObject.WriteToFiler(writer: TGVirtualWriter); end; end; -procedure TgxBaseMeshObject.ReadFromFiler(reader: TGVirtualReader); +procedure TGXBaseMeshObject.ReadFromFiler(reader: TGVirtualReader); var archiveVersion: Integer; begin @@ -1555,24 +1552,24 @@ procedure TgxBaseMeshObject.ReadFromFiler(reader: TGVirtualReader); RaiseFilerException(archiveVersion); end; -procedure TgxBaseMeshObject.Clear; +procedure TGXBaseMeshObject.Clear; begin FNormals.Clear; FVertices.Clear; end; -procedure TgxBaseMeshObject.ContributeToBarycenter(var currentSum: TAffineVector; var nb: Integer); +procedure TGXBaseMeshObject.ContributeToBarycenter(var currentSum: TAffineVector; var nb: Integer); begin AddVector(currentSum, FVertices.Sum); nb := nb + FVertices.Count; end; -procedure TgxBaseMeshObject.Translate(const delta: TAffineVector); +procedure TGXBaseMeshObject.Translate(const delta: TAffineVector); begin FVertices.Translate(delta); end; -procedure TgxBaseMeshObject.BuildNormals(vertexIndices: TGIntegerList; mode: TgxMeshObjectMode; +procedure TGXBaseMeshObject.BuildNormals(vertexIndices: TGIntegerList; mode: TGXMeshObjectMode; normalIndices: TGIntegerList = nil); var i, base: Integer; @@ -1695,7 +1692,7 @@ procedure TgxBaseMeshObject.BuildNormals(vertexIndices: TGIntegerList; mode: Tgx end; end; -function TgxBaseMeshObject.ExtractTriangles(texCoords: TGAffineVectorList = nil; normals: TGAffineVectorList = nil) +function TGXBaseMeshObject.ExtractTriangles(texCoords: TGAffineVectorList = nil; normals: TGAffineVectorList = nil) : TGAffineVectorList; begin Result := TGAffineVectorList.Create; @@ -1707,28 +1704,28 @@ function TgxBaseMeshObject.ExtractTriangles(texCoords: TGAffineVectorList = nil; end; end; -procedure TgxBaseMeshObject.SetVertices(const val: TGAffineVectorList); +procedure TGXBaseMeshObject.SetVertices(const val: TGAffineVectorList); begin FVertices.Assign(val); end; -procedure TgxBaseMeshObject.SetNormals(const val: TGAffineVectorList); +procedure TGXBaseMeshObject.SetNormals(const val: TGAffineVectorList); begin FNormals.Assign(val); end; // ------------------ -// ------------------ TgxSkeletonFrame ------------------ +// ------------------ TGXSkeletonFrame ------------------ // ------------------ -constructor TgxSkeletonFrame.CreateOwned(aOwner: TgxSkeletonFrameList); +constructor TGXSkeletonFrame.CreateOwned(aOwner: TGXSkeletonFrameList); begin FOwner := aOwner; aOwner.Add(Self); Create; end; -constructor TgxSkeletonFrame.Create; +constructor TGXSkeletonFrame.Create; begin inherited Create; FPosition := TGAffineVectorList.Create; @@ -1737,7 +1734,7 @@ constructor TgxSkeletonFrame.Create; FTransformMode := sftRotation; end; -destructor TgxSkeletonFrame.Destroy; +destructor TGXSkeletonFrame.Destroy; begin FlushLocalMatrixList; FRotation.Free; @@ -1746,7 +1743,7 @@ destructor TgxSkeletonFrame.Destroy; inherited Destroy; end; -procedure TgxSkeletonFrame.WriteToFiler(writer: TGVirtualWriter); +procedure TGXSkeletonFrame.WriteToFiler(writer: TGVirtualWriter); begin inherited WriteToFiler(writer); with writer do @@ -1760,7 +1757,7 @@ procedure TgxSkeletonFrame.WriteToFiler(writer: TGVirtualWriter); end; end; -procedure TgxSkeletonFrame.ReadFromFiler(reader: TGVirtualReader); +procedure TGXSkeletonFrame.ReadFromFiler(reader: TGVirtualReader); var archiveVersion: Integer; begin @@ -1775,7 +1772,7 @@ procedure TgxSkeletonFrame.ReadFromFiler(reader: TGVirtualReader); if (archiveVersion = 1) then begin FQuaternion.ReadFromFiler(reader); - FTransformMode := TgxSkeletonFrameTransform(ReadInteger); + FTransformMode := TGXSkeletonFrameTransform(ReadInteger); end; end else @@ -1783,22 +1780,22 @@ procedure TgxSkeletonFrame.ReadFromFiler(reader: TGVirtualReader); FlushLocalMatrixList; end; -procedure TgxSkeletonFrame.SetPosition(const val: TGAffineVectorList); +procedure TGXSkeletonFrame.SetPosition(const val: TGAffineVectorList); begin FPosition.Assign(val); end; -procedure TgxSkeletonFrame.SetRotation(const val: TGAffineVectorList); +procedure TGXSkeletonFrame.SetRotation(const val: TGAffineVectorList); begin FRotation.Assign(val); end; -procedure TgxSkeletonFrame.SetQuaternion(const val: TGQuaternionList); +procedure TGXSkeletonFrame.SetQuaternion(const val: TGQuaternionList); begin FQuaternion.Assign(val); end; -function TgxSkeletonFrame.LocalMatrixList: PMatrixArray; +function TGXSkeletonFrame.LocalMatrixList: PMatrixArray; var i: Integer; s, c: Single; @@ -1857,7 +1854,7 @@ function TgxSkeletonFrame.LocalMatrixList: PMatrixArray; Result := FLocalMatrixList; end; -procedure TgxSkeletonFrame.FlushLocalMatrixList; +procedure TGXSkeletonFrame.FlushLocalMatrixList; begin if Assigned(FLocalMatrixList) then begin @@ -1866,7 +1863,7 @@ procedure TgxSkeletonFrame.FlushLocalMatrixList; end; end; -procedure TgxSkeletonFrame.ConvertQuaternionsToRotations(KeepQuaternions: Boolean = True); +procedure TGXSkeletonFrame.ConvertQuaternionsToRotations(KeepQuaternions: Boolean = True); var i: Integer; t: TTransformations; @@ -1885,7 +1882,7 @@ procedure TgxSkeletonFrame.ConvertQuaternionsToRotations(KeepQuaternions: Boolea Quaternion.Clear; end; -procedure TgxSkeletonFrame.ConvertRotationsToQuaternions(KeepRotations: Boolean = True); +procedure TGXSkeletonFrame.ConvertRotationsToQuaternions(KeepRotations: Boolean = True); var i: Integer; mat, rmat: TMatrix4f; @@ -1911,22 +1908,22 @@ procedure TgxSkeletonFrame.ConvertRotationsToQuaternions(KeepRotations: Boolean end; // ------------------ -// ------------------ TgxSkeletonFrameList ------------------ +// ------------------ TGXSkeletonFrameList ------------------ // ------------------ -constructor TgxSkeletonFrameList.CreateOwned(aOwner: TPersistent); +constructor TGXSkeletonFrameList.CreateOwned(aOwner: TPersistent); begin FOwner := aOwner; Create; end; -destructor TgxSkeletonFrameList.Destroy; +destructor TGXSkeletonFrameList.Destroy; begin Clear; inherited; end; -procedure TgxSkeletonFrameList.ReadFromFiler(reader: TGVirtualReader); +procedure TGXSkeletonFrameList.ReadFromFiler(reader: TGVirtualReader); var i: Integer; begin @@ -1935,7 +1932,7 @@ procedure TgxSkeletonFrameList.ReadFromFiler(reader: TGVirtualReader); Items[i].FOwner := Self; end; -procedure TgxSkeletonFrameList.Clear; +procedure TGXSkeletonFrameList.Clear; var i: Integer; begin @@ -1948,12 +1945,12 @@ procedure TgxSkeletonFrameList.Clear; inherited; end; -function TgxSkeletonFrameList.GetSkeletonFrame(Index: Integer): TgxSkeletonFrame; +function TGXSkeletonFrameList.GetSkeletonFrame(Index: Integer): TGXSkeletonFrame; begin - Result := TgxSkeletonFrame(list^[Index]); + Result := TGXSkeletonFrame(list^[Index]); end; -procedure TgxSkeletonFrameList.ConvertQuaternionsToRotations(KeepQuaternions: Boolean = True; SetTransformMode: Boolean = True); +procedure TGXSkeletonFrameList.ConvertQuaternionsToRotations(KeepQuaternions: Boolean = True; SetTransformMode: Boolean = True); var i: Integer; begin @@ -1965,7 +1962,7 @@ procedure TgxSkeletonFrameList.ConvertQuaternionsToRotations(KeepQuaternions: Bo end; end; -procedure TgxSkeletonFrameList.ConvertRotationsToQuaternions(KeepRotations: Boolean = True; SetTransformMode: Boolean = True); +procedure TGXSkeletonFrameList.ConvertRotationsToQuaternions(KeepRotations: Boolean = True; SetTransformMode: Boolean = True); var i: Integer; begin @@ -1978,28 +1975,28 @@ procedure TgxSkeletonFrameList.ConvertRotationsToQuaternions(KeepRotations: Bool end; // ------------------ -// ------------------ TgxSkeletonBoneList ------------------ +// ------------------ TGXSkeletonBoneList ------------------ // ------------------ -constructor TgxSkeletonBoneList.CreateOwned(aOwner: TgxSkeleton); +constructor TGXSkeletonBoneList.CreateOwned(aOwner: TGXSkeleton); begin FSkeleton := aOwner; Create; end; -constructor TgxSkeletonBoneList.Create; +constructor TGXSkeletonBoneList.Create; begin inherited; FGlobalMatrix := IdentityHmgMatrix; end; -destructor TgxSkeletonBoneList.Destroy; +destructor TGXSkeletonBoneList.Destroy; begin Clean; inherited; end; -procedure TgxSkeletonBoneList.WriteToFiler(writer: TGVirtualWriter); +procedure TGXSkeletonBoneList.WriteToFiler(writer: TGVirtualWriter); begin inherited WriteToFiler(writer); with writer do @@ -2009,7 +2006,7 @@ procedure TgxSkeletonBoneList.WriteToFiler(writer: TGVirtualWriter); end; end; -procedure TgxSkeletonBoneList.ReadFromFiler(reader: TGVirtualReader); +procedure TGXSkeletonBoneList.ReadFromFiler(reader: TGVirtualReader); var archiveVersion, i: Integer; begin @@ -2026,21 +2023,21 @@ procedure TgxSkeletonBoneList.ReadFromFiler(reader: TGVirtualReader); Items[i].FOwner := Self; end; -procedure TgxSkeletonBoneList.AfterObjectCreatedByReader(Sender: TObject); +procedure TGXSkeletonBoneList.AfterObjectCreatedByReader(Sender: TObject); begin - with (Sender as TgxSkeletonBone) do + with (Sender as TGXSkeletonBone) do begin FOwner := Self; FSkeleton := Self.Skeleton; end; end; -function TgxSkeletonBoneList.GetSkeletonBone(Index: Integer): TgxSkeletonBone; +function TGXSkeletonBoneList.GetSkeletonBone(Index: Integer): TGXSkeletonBone; begin - Result := TgxSkeletonBone(list^[Index]); + Result := TGXSkeletonBone(list^[Index]); end; -function TgxSkeletonBoneList.BoneByID(anID: Integer): TgxSkeletonBone; +function TGXSkeletonBoneList.BoneByID(anID: Integer): TGXSkeletonBone; var i: Integer; begin @@ -2053,7 +2050,7 @@ function TgxSkeletonBoneList.BoneByID(anID: Integer): TgxSkeletonBone; end; end; -function TgxSkeletonBoneList.BoneByName(const aName: string): TgxSkeletonBone; +function TGXSkeletonBoneList.BoneByName(const aName: string): TGXSkeletonBone; var i: Integer; begin @@ -2066,7 +2063,7 @@ function TgxSkeletonBoneList.BoneByName(const aName: string): TgxSkeletonBone; end; end; -function TgxSkeletonBoneList.BoneCount: Integer; +function TGXSkeletonBoneList.BoneCount: Integer; var i: Integer; begin @@ -2075,7 +2072,7 @@ function TgxSkeletonBoneList.BoneCount: Integer; Inc(Result, Items[i].BoneCount); end; -procedure TgxSkeletonBoneList.PrepareGlobalMatrices; +procedure TGXSkeletonBoneList.PrepareGlobalMatrices; var i: Integer; begin @@ -2084,10 +2081,10 @@ procedure TgxSkeletonBoneList.PrepareGlobalMatrices; end; // ------------------ -// ------------------ TgxSkeletonRootBoneList ------------------ +// ------------------ TGXSkeletonRootBoneList ------------------ // ------------------ -procedure TgxSkeletonRootBoneList.WriteToFiler(writer: TGVirtualWriter); +procedure TGXSkeletonRootBoneList.WriteToFiler(writer: TGVirtualWriter); begin inherited WriteToFiler(writer); with writer do @@ -2097,7 +2094,7 @@ procedure TgxSkeletonRootBoneList.WriteToFiler(writer: TGVirtualWriter); end; end; -procedure TgxSkeletonRootBoneList.ReadFromFiler(reader: TGVirtualReader); +procedure TGXSkeletonRootBoneList.ReadFromFiler(reader: TGVirtualReader); var archiveVersion, i: Integer; begin @@ -2114,7 +2111,7 @@ procedure TgxSkeletonRootBoneList.ReadFromFiler(reader: TGVirtualReader); Items[i].FOwner := Self; end; -procedure TgxSkeletonRootBoneList.BuildList(var mrci: TgxRenderContextInfo); +procedure TGXSkeletonRootBoneList.BuildList(var mrci: TgxRenderContextInfo); var i: Integer; begin @@ -2128,10 +2125,10 @@ procedure TgxSkeletonRootBoneList.BuildList(var mrci: TgxRenderContextInfo); end; // ------------------ -// ------------------ TgxSkeletonBone ------------------ +// ------------------ TGXSkeletonBone ------------------ // ------------------ -constructor TgxSkeletonBone.CreateOwned(aOwner: TgxSkeletonBoneList); +constructor TGXSkeletonBone.CreateOwned(aOwner: TGXSkeletonBoneList); begin FOwner := aOwner; aOwner.Add(Self); @@ -2139,20 +2136,20 @@ constructor TgxSkeletonBone.CreateOwned(aOwner: TgxSkeletonBoneList); Create; end; -constructor TgxSkeletonBone.Create; +constructor TGXSkeletonBone.Create; begin FColor := $FFFFFFFF; // opaque white inherited; end; -destructor TgxSkeletonBone.Destroy; +destructor TGXSkeletonBone.Destroy; begin if Assigned(Owner) then Owner.Remove(Self); inherited Destroy; end; -procedure TgxSkeletonBone.WriteToFiler(writer: TGVirtualWriter); +procedure TGXSkeletonBone.WriteToFiler(writer: TGVirtualWriter); begin inherited WriteToFiler(writer); with writer do @@ -2164,7 +2161,7 @@ procedure TgxSkeletonBone.WriteToFiler(writer: TGVirtualWriter); end; end; -procedure TgxSkeletonBone.ReadFromFiler(reader: TGVirtualReader); +procedure TGXSkeletonBone.ReadFromFiler(reader: TGVirtualReader); var archiveVersion, i: Integer; begin @@ -2183,7 +2180,7 @@ procedure TgxSkeletonBone.ReadFromFiler(reader: TGVirtualReader); Items[i].FOwner := Self; end; -procedure TgxSkeletonBone.BuildList(var mrci: TgxRenderContextInfo); +procedure TGXSkeletonBone.BuildList(var mrci: TgxRenderContextInfo); procedure IssueColor(Color: Cardinal); begin @@ -2200,10 +2197,10 @@ procedure TgxSkeletonBone.BuildList(var mrci: TgxRenderContextInfo); glVertex3fv(@GlobalMatrix.W.X); glEnd; // parent-self bone line - if Owner is TgxSkeletonBone then + if Owner is TGXSkeletonBone then begin glBegin(GL_LINES); - glVertex3fv(@TgxSkeletonBone(Owner).GlobalMatrix.W.X); + glVertex3fv(@TGXSkeletonBone(Owner).GlobalMatrix.W.X); glVertex3fv(@GlobalMatrix.W.X); glEnd; end; @@ -2212,17 +2209,17 @@ procedure TgxSkeletonBone.BuildList(var mrci: TgxRenderContextInfo); Items[i].BuildList(mrci); end; -function TgxSkeletonBone.GetSkeletonBone(Index: Integer): TgxSkeletonBone; +function TGXSkeletonBone.GetSkeletonBone(Index: Integer): TGXSkeletonBone; begin - Result := TgxSkeletonBone(list^[Index]); + Result := TGXSkeletonBone(list^[Index]); end; -procedure TgxSkeletonBone.SetColor(const val: Cardinal); +procedure TGXSkeletonBone.SetColor(const val: Cardinal); begin FColor := val; end; -function TgxSkeletonBone.BoneByID(anID: Integer): TgxSkeletonBone; +function TGXSkeletonBone.BoneByID(anID: Integer): TGXSkeletonBone; begin if BoneID = anID then Result := Self @@ -2230,7 +2227,7 @@ function TgxSkeletonBone.BoneByID(anID: Integer): TgxSkeletonBone; Result := inherited BoneByID(anID); end; -function TgxSkeletonBone.BoneByName(const aName: string): TgxSkeletonBone; +function TGXSkeletonBone.BoneByName(const aName: string): TGXSkeletonBone; begin if Name = aName then Result := Self @@ -2238,27 +2235,27 @@ function TgxSkeletonBone.BoneByName(const aName: string): TgxSkeletonBone; Result := inherited BoneByName(aName); end; -procedure TgxSkeletonBone.Clean; +procedure TGXSkeletonBone.Clean; begin BoneID := 0; Name := ''; inherited; end; -procedure TgxSkeletonBone.PrepareGlobalMatrices; +procedure TGXSkeletonBone.PrepareGlobalMatrices; begin if (Skeleton.FRagDollEnabled) then Exit; // ragdoll - FGlobalMatrix := MatrixMultiply(Skeleton.CurrentFrame.LocalMatrixList^[BoneID], TgxSkeletonBoneList(Owner).FGlobalMatrix); + FGlobalMatrix := MatrixMultiply(Skeleton.CurrentFrame.LocalMatrixList^[BoneID], TGXSkeletonBoneList(Owner).FGlobalMatrix); inherited; end; -procedure TgxSkeletonBone.SetGlobalMatrix(Matrix: TMatrix4f); // ragdoll +procedure TGXSkeletonBone.SetGlobalMatrix(Matrix: TMatrix4f); // ragdoll begin FGlobalMatrix := Matrix; end; -procedure TgxSkeletonBone.SetGlobalMatrixForRagDoll(RagDollMatrix: TMatrix4f); +procedure TGXSkeletonBone.SetGlobalMatrixForRagDoll(RagDollMatrix: TMatrix4f); // ragdoll begin FGlobalMatrix := MatrixMultiply(RagDollMatrix, Skeleton.Owner.InvAbsoluteMatrix); @@ -2266,10 +2263,10 @@ procedure TgxSkeletonBone.SetGlobalMatrixForRagDoll(RagDollMatrix: TMatrix4f); end; // ------------------ -// ------------------ TgxSkeletonCollider ------------------ +// ------------------ TGXSkeletonCollider ------------------ // ------------------ -constructor TgxSkeletonCollider.Create; +constructor TGXSkeletonCollider.Create; begin inherited; FLocalMatrix := IdentityHmgMatrix; @@ -2277,7 +2274,7 @@ constructor TgxSkeletonCollider.Create; FAutoUpdate := True; end; -constructor TgxSkeletonCollider.CreateOwned(aOwner: TgxSkeletonColliderList); +constructor TGXSkeletonCollider.CreateOwned(aOwner: TGXSkeletonColliderList); begin Create; FOwner := aOwner; @@ -2285,7 +2282,7 @@ constructor TgxSkeletonCollider.CreateOwned(aOwner: TgxSkeletonColliderList); FOwner.Add(Self); end; -procedure TgxSkeletonCollider.WriteToFiler(writer: TGVirtualWriter); +procedure TGXSkeletonCollider.WriteToFiler(writer: TGVirtualWriter); begin inherited WriteToFiler(writer); with writer do @@ -2299,7 +2296,7 @@ procedure TgxSkeletonCollider.WriteToFiler(writer: TGVirtualWriter); end; end; -procedure TgxSkeletonCollider.ReadFromFiler(reader: TGVirtualReader); +procedure TGXSkeletonCollider.ReadFromFiler(reader: TGVirtualReader); var archiveVersion: Integer; begin @@ -2315,15 +2312,15 @@ procedure TgxSkeletonCollider.ReadFromFiler(reader: TGVirtualReader); RaiseFilerException(archiveVersion); end; -procedure TgxSkeletonCollider.AlignCollider; +procedure TGXSkeletonCollider.AlignCollider; var mat: TMatrix4f; begin if Assigned(FBone) then begin - if Owner.Owner is TgxSkeleton then - if TgxSkeleton(Owner.Owner).Owner is TgxBaseSceneObject then - mat := MatrixMultiply(FBone.GlobalMatrix, TgxBaseSceneObject(TgxSkeleton(Owner.Owner).Owner).AbsoluteMatrix) + if Owner.Owner is TGXSkeleton then + if TGXSkeleton(Owner.Owner).Owner is TgxBaseSceneObject then + mat := MatrixMultiply(FBone.GlobalMatrix, TgxBaseSceneObject(TGXSkeleton(Owner.Owner).Owner).AbsoluteMatrix) else mat := FBone.GlobalMatrix; MatrixMultiply(FLocalMatrix, mat, FGlobalMatrix); @@ -2332,39 +2329,39 @@ procedure TgxSkeletonCollider.AlignCollider; FGlobalMatrix := FLocalMatrix; end; -procedure TgxSkeletonCollider.SetBone(const val: TgxSkeletonBone); +procedure TGXSkeletonCollider.SetBone(const val: TGXSkeletonBone); begin if val <> FBone then FBone := val; end; -procedure TgxSkeletonCollider.SetLocalMatrix(const val: TMatrix4f); +procedure TGXSkeletonCollider.SetLocalMatrix(const val: TMatrix4f); begin FLocalMatrix := val; end; // ------------------ -// ------------------ TgxSkeletonColliderList ------------------ +// ------------------ TGXSkeletonColliderList ------------------ // ------------------ -constructor TgxSkeletonColliderList.CreateOwned(aOwner: TPersistent); +constructor TGXSkeletonColliderList.CreateOwned(aOwner: TPersistent); begin Create; FOwner := aOwner; end; -destructor TgxSkeletonColliderList.Destroy; +destructor TGXSkeletonColliderList.Destroy; begin Clear; inherited; end; -function TgxSkeletonColliderList.GetSkeletonCollider(Index: Integer): TgxSkeletonCollider; +function TGXSkeletonColliderList.GetSkeletonCollider(Index: Integer): TGXSkeletonCollider; begin - Result := TgxSkeletonCollider(inherited Get(index)); + Result := TGXSkeletonCollider(inherited Get(index)); end; -procedure TgxSkeletonColliderList.ReadFromFiler(reader: TGVirtualReader); +procedure TGXSkeletonColliderList.ReadFromFiler(reader: TGVirtualReader); var i: Integer; begin @@ -2372,12 +2369,12 @@ procedure TgxSkeletonColliderList.ReadFromFiler(reader: TGVirtualReader); for i := 0 to Count - 1 do begin Items[i].FOwner := Self; - if (Owner is TgxSkeleton) and (Items[i].FBoneID <> -1) then - Items[i].Bone := TgxSkeleton(Owner).BoneByID(Items[i].FBoneID); + if (Owner is TGXSkeleton) and (Items[i].FBoneID <> -1) then + Items[i].Bone := TGXSkeleton(Owner).BoneByID(Items[i].FBoneID); end; end; -procedure TgxSkeletonColliderList.Clear; +procedure TGXSkeletonColliderList.Clear; var i: Integer; begin @@ -2389,7 +2386,7 @@ procedure TgxSkeletonColliderList.Clear; inherited; end; -procedure TgxSkeletonColliderList.AlignColliders; +procedure TGXSkeletonColliderList.AlignColliders; var i: Integer; begin @@ -2399,24 +2396,24 @@ procedure TgxSkeletonColliderList.AlignColliders; end; // ------------------ -// ------------------ TgxSkeleton ------------------ +// ------------------ TGXSkeleton ------------------ // ------------------ -constructor TgxSkeleton.CreateOwned(aOwner: TgxBaseMesh); +constructor TGXSkeleton.CreateOwned(aOwner: TGXBaseMesh); begin FOwner := aOwner; Create; end; -constructor TgxSkeleton.Create; +constructor TGXSkeleton.Create; begin inherited Create; - FRootBones := TgxSkeletonRootBoneList.CreateOwned(Self); - FFrames := TgxSkeletonFrameList.CreateOwned(Self); - FColliders := TgxSkeletonColliderList.CreateOwned(Self); + FRootBones := TGXSkeletonRootBoneList.CreateOwned(Self); + FFrames := TGXSkeletonFrameList.CreateOwned(Self); + FColliders := TGXSkeletonColliderList.CreateOwned(Self); end; -destructor TgxSkeleton.Destroy; +destructor TGXSkeleton.Destroy; begin FlushBoneByIDCache; FCurrentFrame.Free; @@ -2426,7 +2423,7 @@ destructor TgxSkeleton.Destroy; inherited Destroy; end; -procedure TgxSkeleton.WriteToFiler(writer: TGVirtualWriter); +procedure TGXSkeleton.WriteToFiler(writer: TGVirtualWriter); begin inherited WriteToFiler(writer); with writer do @@ -2442,7 +2439,7 @@ procedure TgxSkeleton.WriteToFiler(writer: TGVirtualWriter); end; end; -procedure TgxSkeleton.ReadFromFiler(reader: TGVirtualReader); +procedure TGXSkeleton.ReadFromFiler(reader: TGVirtualReader); var archiveVersion: Integer; begin @@ -2460,44 +2457,44 @@ procedure TgxSkeleton.ReadFromFiler(reader: TGVirtualReader); RaiseFilerException(archiveVersion); end; -procedure TgxSkeleton.SetRootBones(const val: TgxSkeletonRootBoneList); +procedure TGXSkeleton.SetRootBones(const val: TGXSkeletonRootBoneList); begin FRootBones.Assign(val); end; -procedure TgxSkeleton.SetFrames(const val: TgxSkeletonFrameList); +procedure TGXSkeleton.SetFrames(const val: TGXSkeletonFrameList); begin FFrames.Assign(val); end; -function TgxSkeleton.GetCurrentFrame: TgxSkeletonFrame; +function TGXSkeleton.GetCurrentFrame: TGXSkeletonFrame; begin if not Assigned(FCurrentFrame) then - FCurrentFrame := TgxSkeletonFrame(FFrames.Items[0].CreateClone); + FCurrentFrame := TGXSkeletonFrame(FFrames.Items[0].CreateClone); Result := FCurrentFrame; end; -procedure TgxSkeleton.SetCurrentFrame(val: TgxSkeletonFrame); +procedure TGXSkeleton.SetCurrentFrame(val: TGXSkeletonFrame); begin if Assigned(FCurrentFrame) then FCurrentFrame.Free; - FCurrentFrame := TgxSkeletonFrame(val.CreateClone); + FCurrentFrame := TGXSkeletonFrame(val.CreateClone); end; -procedure TgxSkeleton.SetColliders(const val: TgxSkeletonColliderList); +procedure TGXSkeleton.SetColliders(const val: TGXSkeletonColliderList); begin FColliders.Assign(val); end; -procedure TgxSkeleton.FlushBoneByIDCache; +procedure TGXSkeleton.FlushBoneByIDCache; begin FBonesByIDCache.Free; FBonesByIDCache := nil; end; -function TgxSkeleton.BoneByID(anID: Integer): TgxSkeletonBone; +function TGXSkeleton.BoneByID(anID: Integer): TGXSkeletonBone; - procedure CollectBones(Bone: TgxSkeletonBone); + procedure CollectBones(Bone: TGXSkeletonBone); var i: Integer; begin @@ -2517,34 +2514,34 @@ function TgxSkeleton.BoneByID(anID: Integer): TgxSkeletonBone; for i := 0 to RootBones.Count - 1 do CollectBones(RootBones[i]); end; - Result := TgxSkeletonBone(FBonesByIDCache[anID]) + Result := TGXSkeletonBone(FBonesByIDCache[anID]) end; -function TgxSkeleton.BoneByName(const aName: string): TgxSkeletonBone; +function TGXSkeleton.BoneByName(const aName: string): TGXSkeletonBone; begin Result := RootBones.BoneByName(aName); end; -function TgxSkeleton.BoneCount: Integer; +function TGXSkeleton.BoneCount: Integer; begin Result := RootBones.BoneCount; end; -procedure TgxSkeleton.MorphTo(frameIndex: Integer); +procedure TGXSkeleton.MorphTo(frameIndex: Integer); begin CurrentFrame := Frames[frameIndex]; end; -procedure TgxSkeleton.MorphTo(frame: TgxSkeletonFrame); +procedure TGXSkeleton.MorphTo(frame: TGXSkeletonFrame); begin CurrentFrame := frame; end; -procedure TgxSkeleton.Lerp(frameIndex1, frameIndex2: Integer; lerpFactor: Single); +procedure TGXSkeleton.Lerp(frameIndex1, frameIndex2: Integer; lerpFactor: Single); begin if Assigned(FCurrentFrame) then FCurrentFrame.Free; - FCurrentFrame := TgxSkeletonFrame.Create; + FCurrentFrame := TGXSkeletonFrame.Create; FCurrentFrame.TransformMode := Frames[frameIndex1].TransformMode; with FCurrentFrame do begin @@ -2558,7 +2555,7 @@ procedure TgxSkeleton.Lerp(frameIndex1, frameIndex2: Integer; lerpFactor: Single end; end; -procedure TgxSkeleton.BlendedLerps(const lerpInfos: array of TgxBlendedLerpInfo); +procedure TGXSkeleton.BlendedLerps(const lerpInfos: array of TGXBlendedLerpInfo); var i, n: Integer; blendPositions: TGAffineVectorList; @@ -2578,7 +2575,7 @@ procedure TgxSkeleton.BlendedLerps(const lerpInfos: array of TgxBlendedLerpInfo) begin if Assigned(FCurrentFrame) then FCurrentFrame.Free; - FCurrentFrame := TgxSkeletonFrame.Create; + FCurrentFrame := TGXSkeletonFrame.Create; FCurrentFrame.TransformMode := Frames[lerpInfos[i].frameIndex1].TransformMode; with FCurrentFrame do begin @@ -2657,7 +2654,7 @@ procedure TgxSkeleton.BlendedLerps(const lerpInfos: array of TgxBlendedLerpInfo) end; end; -procedure TgxSkeleton.MakeSkeletalTranslationStatic(startFrame, endFrame: Integer); +procedure TGXSkeleton.MakeSkeletalTranslationStatic(startFrame, endFrame: Integer); var delta: TAffineVector; i: Integer; @@ -2671,7 +2668,7 @@ procedure TgxSkeleton.MakeSkeletalTranslationStatic(startFrame, endFrame: Intege Frames[i].Position[0] := VectorCombine(Frames[i].Position[0], delta, 1, (i - startFrame) * f); end; -procedure TgxSkeleton.MakeSkeletalRotationDelta(startFrame, endFrame: Integer); +procedure TGXSkeleton.MakeSkeletalRotationDelta(startFrame, endFrame: Integer); var i, j: Integer; v: TAffineVector; @@ -2692,10 +2689,10 @@ procedure TgxSkeleton.MakeSkeletalRotationDelta(startFrame, endFrame: Integer); end; end; -procedure TgxSkeleton.MorphMesh(normalize: Boolean); +procedure TGXSkeleton.MorphMesh(normalize: Boolean); var i: Integer; - Mesh: TgxBaseMeshObject; + Mesh: TGXBaseMeshObject; begin if Owner.MeshObjects.Count > 0 then begin @@ -2707,26 +2704,26 @@ procedure TgxSkeleton.MorphMesh(normalize: Boolean); for i := 0 to Owner.MeshObjects.Count - 1 do begin Mesh := Owner.MeshObjects.Items[i]; - if (Mesh is TgxSkeletonMeshObject) then - TgxSkeletonMeshObject(Mesh).ApplyCurrentSkeletonFrame(normalize); + if (Mesh is TGXSkeletonMeshObject) then + TGXSkeletonMeshObject(Mesh).ApplyCurrentSkeletonFrame(normalize); end else for i := 0 to Owner.MeshObjects.Count - 1 do begin Mesh := Owner.MeshObjects.Items[i]; - if (Mesh is TgxSkeletonMeshObject) and Mesh.Visible then - TgxSkeletonMeshObject(Mesh).ApplyCurrentSkeletonFrame(normalize); + if (Mesh is TGXSkeletonMeshObject) and Mesh.Visible then + TGXSkeletonMeshObject(Mesh).ApplyCurrentSkeletonFrame(normalize); end end; end; -procedure TgxSkeleton.Synchronize(reference: TgxSkeleton); +procedure TGXSkeleton.Synchronize(reference: TGXSkeleton); begin CurrentFrame.Assign(reference.CurrentFrame); MorphMesh(True); end; -procedure TgxSkeleton.Clear; +procedure TGXSkeleton.Clear; begin FlushBoneByIDCache; RootBones.Clean; @@ -2736,10 +2733,10 @@ procedure TgxSkeleton.Clear; FColliders.Clear; end; -procedure TgxSkeleton.StartRagdoll; // ragdoll +procedure TGXSkeleton.StartRagdoll; // ragdoll var i: Integer; - Mesh: TgxBaseMeshObject; + Mesh: TGXBaseMeshObject; begin if FRagDollEnabled then Exit @@ -2751,19 +2748,19 @@ procedure TgxSkeleton.StartRagdoll; // ragdoll for i := 0 to Owner.MeshObjects.Count - 1 do begin Mesh := Owner.MeshObjects.Items[i]; - if Mesh is TgxSkeletonMeshObject then + if Mesh is TGXSkeletonMeshObject then begin - TgxSkeletonMeshObject(Mesh).BackupBoneMatrixInvertedMeshes; - TgxSkeletonMeshObject(Mesh).PrepareBoneMatrixInvertedMeshes; + TGXSkeletonMeshObject(Mesh).BackupBoneMatrixInvertedMeshes; + TGXSkeletonMeshObject(Mesh).PrepareBoneMatrixInvertedMeshes; end; end; end; end; -procedure TgxSkeleton.StopRagdoll; // ragdoll +procedure TGXSkeleton.StopRagdoll; // ragdoll var i: Integer; - Mesh: TgxBaseMeshObject; + Mesh: TGXBaseMeshObject; begin FRagDollEnabled := False; if Owner.MeshObjects.Count > 0 then @@ -2771,17 +2768,17 @@ procedure TgxSkeleton.StopRagdoll; // ragdoll for i := 0 to Owner.MeshObjects.Count - 1 do begin Mesh := Owner.MeshObjects.Items[i]; - if Mesh is TgxSkeletonMeshObject then - TgxSkeletonMeshObject(Mesh).RestoreBoneMatrixInvertedMeshes; + if Mesh is TGXSkeletonMeshObject then + TGXSkeletonMeshObject(Mesh).RestoreBoneMatrixInvertedMeshes; end; end; end; // ------------------ -// ------------------ TgxMeshObject ------------------ +// ------------------ TGXMeshObject ------------------ // ------------------ -constructor TgxMeshObject.CreateOwned(aOwner: TgxMeshObjectList); +constructor TGXMeshObject.CreateOwned(aOwner: TGXMeshObjectList); begin FOwner := aOwner; Create; @@ -2789,13 +2786,13 @@ constructor TgxMeshObject.CreateOwned(aOwner: TgxMeshObjectList); FOwner.Add(Self); end; -constructor TgxMeshObject.Create; +constructor TGXMeshObject.Create; begin FMode := momTriangles; FTexCoords := TGAffineVectorList.Create; FLightMapTexCoords := TGAffineVectorList.Create; FColors := TGVectorList.Create; - FFaceGroups := TgxFaceGroups.CreateOwned(Self); + FFaceGroups := TGXFaceGroups.CreateOwned(Self); FTexCoordsEx := TList.Create; FTangentsTexCoordIndex := 1; FBinormalsTexCoordIndex := 2; @@ -2804,7 +2801,7 @@ constructor TgxMeshObject.Create; inherited; end; -destructor TgxMeshObject.Destroy; +destructor TGXMeshObject.Destroy; var i: Integer; begin @@ -2827,39 +2824,39 @@ destructor TgxMeshObject.Destroy; inherited; end; -procedure TgxMeshObject.Assign(Source: TPersistent); +procedure TGXMeshObject.Assign(Source: TPersistent); var i: Integer; begin inherited Assign(Source); - if Source is TgxMeshObject then + if Source is TGXMeshObject then begin - FTexCoords.Assign(TgxMeshObject(Source).FTexCoords); - FLightMapTexCoords.Assign(TgxMeshObject(Source).FLightMapTexCoords); - FColors.Assign(TgxMeshObject(Source).FColors); - FFaceGroups.Assign(TgxMeshObject(Source).FFaceGroups); - FMode := TgxMeshObject(Source).FMode; - FRenderingOptions := TgxMeshObject(Source).FRenderingOptions; - FBinormalsTexCoordIndex := TgxMeshObject(Source).FBinormalsTexCoordIndex; - FTangentsTexCoordIndex := TgxMeshObject(Source).FTangentsTexCoordIndex; + FTexCoords.Assign(TGXMeshObject(Source).FTexCoords); + FLightMapTexCoords.Assign(TGXMeshObject(Source).FLightMapTexCoords); + FColors.Assign(TGXMeshObject(Source).FColors); + FFaceGroups.Assign(TGXMeshObject(Source).FFaceGroups); + FMode := TGXMeshObject(Source).FMode; + FRenderingOptions := TGXMeshObject(Source).FRenderingOptions; + FBinormalsTexCoordIndex := TGXMeshObject(Source).FBinormalsTexCoordIndex; + FTangentsTexCoordIndex := TGXMeshObject(Source).FTangentsTexCoordIndex; // Clear FTexCoordsEx. for i := 0 to FTexCoordsEx.Count - 1 do TGVectorList(FTexCoordsEx[i]).Free; - FTexCoordsEx.Count := TgxMeshObject(Source).FTexCoordsEx.Count; + FTexCoordsEx.Count := TGXMeshObject(Source).FTexCoordsEx.Count; // Fill FTexCoordsEx. for i := 0 to FTexCoordsEx.Count - 1 do begin FTexCoordsEx[i] := TGVectorList.Create; - TGVectorList(FTexCoordsEx[i]).Assign(TgxMeshObject(Source).FTexCoordsEx[i]); + TGVectorList(FTexCoordsEx[i]).Assign(TGXMeshObject(Source).FTexCoordsEx[i]); end; end; end; -procedure TgxMeshObject.WriteToFiler(writer: TGVirtualWriter); +procedure TGXMeshObject.WriteToFiler(writer: TGVirtualWriter); var i: Integer; begin @@ -2882,7 +2879,7 @@ procedure TgxMeshObject.WriteToFiler(writer: TGVirtualWriter); end; end; -procedure TgxMeshObject.ReadFromFiler(reader: TGVirtualReader); +procedure TGXMeshObject.ReadFromFiler(reader: TGVirtualReader); var i, Count, archiveVersion: Integer; lOldLightMapTexCoords: TGTexPointList; @@ -2919,11 +2916,11 @@ procedure TgxMeshObject.ReadFromFiler(reader: TGVirtualReader); FColors.ReadFromFiler(reader); FFaceGroups.ReadFromFiler(reader); - FMode := TgxMeshObjectMode(ReadInteger); + FMode := TGXMeshObjectMode(ReadInteger); size := ReadInteger; ro := 0; Read(ro, size); - FRenderingOptions := TgxMeshObjectRenderingOptions(Byte(ro)); + FRenderingOptions := TGXMeshObjectRenderingOptions(Byte(ro)); if archiveVersion >= 2 then begin Count := ReadInteger; @@ -2937,7 +2934,7 @@ procedure TgxMeshObject.ReadFromFiler(reader: TGVirtualReader); RaiseFilerException(archiveVersion); end; -procedure TgxMeshObject.Clear; +procedure TGXMeshObject.Clear; var i: Integer; begin @@ -2950,7 +2947,7 @@ procedure TgxMeshObject.Clear; TexCoordsEx[i].Clear; end; -function TgxMeshObject.ExtractTriangles(texCoords: TGAffineVectorList = nil; normals: TGAffineVectorList = nil) +function TGXMeshObject.ExtractTriangles(texCoords: TGAffineVectorList = nil; normals: TGAffineVectorList = nil) : TGAffineVectorList; begin case mode of @@ -2982,7 +2979,7 @@ function TgxMeshObject.ExtractTriangles(texCoords: TGAffineVectorList = nil; nor end; end; -function TgxMeshObject.TriangleCount: Integer; +function TGXMeshObject.TriangleCount: Integer; var i: Integer; begin @@ -3007,17 +3004,17 @@ function TgxMeshObject.TriangleCount: Integer; end; end; -procedure TgxMeshObject.PrepareMaterialLibraryCache(matLib: TgxMaterialLibrary); +procedure TGXMeshObject.PrepareMaterialLibraryCache(matLib: TgxMaterialLibrary); begin FaceGroups.PrepareMaterialLibraryCache(matLib); end; -procedure TgxMeshObject.DropMaterialLibraryCache; +procedure TGXMeshObject.DropMaterialLibraryCache; begin FaceGroups.DropMaterialLibraryCache; end; -procedure TgxMeshObject.GetExtents(out min, max: TAffineVector); +procedure TGXMeshObject.GetExtents(out min, max: TAffineVector); begin if FVertices.Revision <> FExtentCacheRevision then begin @@ -3028,7 +3025,7 @@ procedure TgxMeshObject.GetExtents(out min, max: TAffineVector); max := FExtentCache.max; end; -procedure TgxMeshObject.GetExtents(out aabb: TAABB); +procedure TGXMeshObject.GetExtents(out aabb: TAABB); begin if FVertices.Revision <> FExtentCacheRevision then begin @@ -3038,7 +3035,7 @@ procedure TgxMeshObject.GetExtents(out aabb: TAABB); aabb := FExtentCache; end; -function TgxMeshObject.GetBarycenter: TVector4f; +function TGXMeshObject.GetBarycenter: TVector4f; var dMin, dMax: TAffineVector; begin @@ -3050,7 +3047,7 @@ function TgxMeshObject.GetBarycenter: TVector4f; Result.W := 0; end; -procedure TgxMeshObject.Prepare; +procedure TGXMeshObject.Prepare; var i: Integer; begin @@ -3059,7 +3056,7 @@ procedure TgxMeshObject.Prepare; FaceGroups[i].Prepare; end; -function TgxMeshObject.PointInObject(const aPoint: TAffineVector): Boolean; +function TGXMeshObject.PointInObject(const aPoint: TAffineVector): Boolean; var min, max: TAffineVector; begin @@ -3068,27 +3065,27 @@ function TgxMeshObject.PointInObject(const aPoint: TAffineVector): Boolean; and (aPoint.Z <= max.Z); end; -procedure TgxMeshObject.SetTexCoords(const val: TGAffineVectorList); +procedure TGXMeshObject.SetTexCoords(const val: TGAffineVectorList); begin FTexCoords.Assign(val); end; -procedure TgxMeshObject.SetLightmapTexCoords(const val: TGAffineVectorList); +procedure TGXMeshObject.SetLightmapTexCoords(const val: TGAffineVectorList); begin FLightMapTexCoords.Assign(val); end; -procedure TgxMeshObject.SetColors(const val: TGVectorList); +procedure TGXMeshObject.SetColors(const val: TGVectorList); begin FColors.Assign(val); end; -procedure TgxMeshObject.SetTexCoordsEx(Index: Integer; const val: TGVectorList); +procedure TGXMeshObject.SetTexCoordsEx(Index: Integer; const val: TGVectorList); begin TexCoordsEx[index].Assign(val); end; -function TgxMeshObject.GetTexCoordsEx(Index: Integer): TGVectorList; +function TGXMeshObject.GetTexCoordsEx(Index: Integer): TGVectorList; var i: Integer; begin @@ -3098,17 +3095,17 @@ function TgxMeshObject.GetTexCoordsEx(Index: Integer): TGVectorList; Result := TGVectorList(FTexCoordsEx[index]); end; -procedure TgxMeshObject.SetBinormals(const val: TGVectorList); +procedure TGXMeshObject.SetBinormals(const val: TGVectorList); begin Binormals.Assign(val); end; -function TgxMeshObject.GetBinormals: TGVectorList; +function TGXMeshObject.GetBinormals: TGVectorList; begin Result := TexCoordsEx[BinormalsTexCoordIndex]; end; -procedure TgxMeshObject.SetBinormalsTexCoordIndex(const val: Integer); +procedure TGXMeshObject.SetBinormalsTexCoordIndex(const val: Integer); begin Assert(val >= 0); if val <> FBinormalsTexCoordIndex then @@ -3117,17 +3114,17 @@ procedure TgxMeshObject.SetBinormalsTexCoordIndex(const val: Integer); end; end; -procedure TgxMeshObject.SetTangents(const val: TGVectorList); +procedure TGXMeshObject.SetTangents(const val: TGVectorList); begin Tangents.Assign(val); end; -function TgxMeshObject.GetTangents: TGVectorList; +function TGXMeshObject.GetTangents: TGVectorList; begin Result := TexCoordsEx[TangentsTexCoordIndex]; end; -procedure TgxMeshObject.SetTangentsTexCoordIndex(const val: Integer); +procedure TGXMeshObject.SetTangentsTexCoordIndex(const val: Integer); begin Assert(val >= 0); if val <> FTangentsTexCoordIndex then @@ -3136,10 +3133,10 @@ procedure TgxMeshObject.SetTangentsTexCoordIndex(const val: Integer); end; end; -procedure TgxMeshObject.GetTriangleData(tri: Integer; list: TGAffineVectorList; var v0, v1, v2: TAffineVector); +procedure TGXMeshObject.GetTriangleData(tri: Integer; list: TGAffineVectorList; var v0, v1, v2: TAffineVector); var i, LastCount, Count: Integer; - fg: TfgxVertexIndexList; + fg: TFGXVertexIndexList; begin case mode of momTriangles: @@ -3160,7 +3157,7 @@ procedure TgxMeshObject.GetTriangleData(tri: Integer; list: TGAffineVectorList; for i := 0 to FaceGroups.Count - 1 do begin LastCount := Count; - fg := TfgxVertexIndexList(FaceGroups[i]); + fg := TFGXVertexIndexList(FaceGroups[i]); Count := Count + fg.TriangleCount; if Count > tri then begin @@ -3212,10 +3209,10 @@ procedure TgxMeshObject.GetTriangleData(tri: Integer; list: TGAffineVectorList; end; end; -procedure TgxMeshObject.GetTriangleData(tri: Integer; list: TGVectorList; var v0, v1, v2: TVector4f); +procedure TGXMeshObject.GetTriangleData(tri: Integer; list: TGVectorList; var v0, v1, v2: TVector4f); var i, LastCount, Count: Integer; - fg: TfgxVertexIndexList; + fg: TFGXVertexIndexList; begin case mode of momTriangles: @@ -3236,7 +3233,7 @@ procedure TgxMeshObject.GetTriangleData(tri: Integer; list: TGVectorList; var v0 for i := 0 to FaceGroups.Count - 1 do begin LastCount := Count; - fg := TfgxVertexIndexList(FaceGroups[i]); + fg := TFGXVertexIndexList(FaceGroups[i]); Count := Count + fg.TriangleCount; if Count > tri then begin @@ -3288,10 +3285,10 @@ procedure TgxMeshObject.GetTriangleData(tri: Integer; list: TGVectorList; var v0 end; end; -procedure TgxMeshObject.SetTriangleData(tri: Integer; list: TGAffineVectorList; const v0, v1, v2: TAffineVector); +procedure TGXMeshObject.SetTriangleData(tri: Integer; list: TGAffineVectorList; const v0, v1, v2: TAffineVector); var i, LastCount, Count: Integer; - fg: TfgxVertexIndexList; + fg: TFGXVertexIndexList; begin case mode of momTriangles: @@ -3312,7 +3309,7 @@ procedure TgxMeshObject.SetTriangleData(tri: Integer; list: TGAffineVectorList; for i := 0 to FaceGroups.Count - 1 do begin LastCount := Count; - fg := TfgxVertexIndexList(FaceGroups[i]); + fg := TFGXVertexIndexList(FaceGroups[i]); Count := Count + fg.TriangleCount; if Count > tri then begin @@ -3364,10 +3361,10 @@ procedure TgxMeshObject.SetTriangleData(tri: Integer; list: TGAffineVectorList; end; end; -procedure TgxMeshObject.SetTriangleData(tri: Integer; list: TGVectorList; const v0, v1, v2: TVector4f); +procedure TGXMeshObject.SetTriangleData(tri: Integer; list: TGVectorList; const v0, v1, v2: TVector4f); var i, LastCount, Count: Integer; - fg: TfgxVertexIndexList; + fg: TFGXVertexIndexList; begin case mode of momTriangles: @@ -3388,7 +3385,7 @@ procedure TgxMeshObject.SetTriangleData(tri: Integer; list: TGVectorList; const for i := 0 to FaceGroups.Count - 1 do begin LastCount := Count; - fg := TfgxVertexIndexList(FaceGroups[i]); + fg := TFGXVertexIndexList(FaceGroups[i]); Count := Count + fg.TriangleCount; if Count > tri then begin @@ -3440,7 +3437,7 @@ procedure TgxMeshObject.SetTriangleData(tri: Integer; list: TGVectorList; const end; end; -procedure TgxMeshObject.SetUseVBO(const Value: Boolean); +procedure TGXMeshObject.SetUseVBO(const Value: Boolean); var i: Integer; begin @@ -3462,7 +3459,7 @@ procedure TgxMeshObject.SetUseVBO(const Value: Boolean); FUseVBO := Value; end; -procedure TgxMeshObject.SetValidBuffers(Value: TVBOBuffers); +procedure TGXMeshObject.SetValidBuffers(Value: TVBOBuffers); var i: Integer; begin @@ -3483,7 +3480,7 @@ procedure TgxMeshObject.SetValidBuffers(Value: TVBOBuffers); end; end; -procedure TgxMeshObject.BuildTangentSpace(buildBinormals: Boolean = True; buildTangents: Boolean = True); +procedure TGXMeshObject.BuildTangentSpace(buildBinormals: Boolean = True; buildTangents: Boolean = True); var i, j: Integer; v, n, t: array [0 .. 2] of TAffineVector; @@ -3590,7 +3587,7 @@ procedure TgxMeshObject.BuildTangentSpace(buildBinormals: Boolean = True; buildT end; end; -procedure TgxMeshObject.DeclareArraysToOpenGL(var mrci: TgxRenderContextInfo; evenIfAlreadyDeclared: Boolean = False); +procedure TGXMeshObject.DeclareArraysToOpenGL(var mrci: TgxRenderContextInfo; evenIfAlreadyDeclared: Boolean = False); var i: Integer; currentMapping: Cardinal; @@ -3718,7 +3715,7 @@ procedure TgxMeshObject.DeclareArraysToOpenGL(var mrci: TgxRenderContextInfo; ev end; end; -procedure TgxMeshObject.DisableOpenGLArrays(var mrci: TgxRenderContextInfo); +procedure TGXMeshObject.DisableOpenGLArrays(var mrci: TgxRenderContextInfo); var i: Integer; begin @@ -3783,7 +3780,7 @@ procedure TgxMeshObject.DisableOpenGLArrays(var mrci: TgxRenderContextInfo); end; end; -procedure TgxMeshObject.EnableLightMapArray(var mrci: TgxRenderContextInfo); +procedure TGXMeshObject.EnableLightMapArray(var mrci: TgxRenderContextInfo); begin if (not mrci.ignoreMaterials) then /// and GL_ARB_multitexture @@ -3799,7 +3796,7 @@ procedure TgxMeshObject.EnableLightMapArray(var mrci: TgxRenderContextInfo); end; end; -procedure TgxMeshObject.DisableLightMapArray(var mrci: TgxRenderContextInfo); +procedure TGXMeshObject.DisableLightMapArray(var mrci: TgxRenderContextInfo); begin if FLightMapArrayEnabled then /// and GL_ARB_multitexture @@ -3811,14 +3808,14 @@ procedure TgxMeshObject.DisableLightMapArray(var mrci: TgxRenderContextInfo); end; end; -procedure TgxMeshObject.PrepareBuildList(var mrci: TgxRenderContextInfo); +procedure TGXMeshObject.PrepareBuildList(var mrci: TgxRenderContextInfo); var i: Integer; begin if (mode = momFaceGroups) and Assigned(mrci.MaterialLibrary) then begin for i := 0 to FaceGroups.Count - 1 do - with TgxFaceGroup(FaceGroups.list^[i]) do + with TGXFaceGroup(FaceGroups.list^[i]) do begin if MaterialCache <> nil then MaterialCache.PrepareBuildList; @@ -3826,7 +3823,7 @@ procedure TgxMeshObject.PrepareBuildList(var mrci: TgxRenderContextInfo); end; end; -procedure TgxMeshObject.BufferArrays; +procedure TGXMeshObject.BufferArrays; const BufferUsage = GL_DYNAMIC_DRAW; var @@ -3940,13 +3937,13 @@ procedure TgxMeshObject.BufferArrays; /// CheckOpenGLError; end; -procedure TgxMeshObject.BuildList(var mrci: TgxRenderContextInfo); +procedure TGXMeshObject.BuildList(var mrci: TgxRenderContextInfo); var i, j, groupID, nbGroups: Integer; gotNormals, gotTexCoords, gotColor: Boolean; gotTexCoordsEx: array of Boolean; libMat: TgxLibMaterial; - fg: TgxFaceGroup; + fg: TGXFaceGroup; begin // Make sure no VBO is bound and states enabled FArraysDeclared := False; @@ -4084,53 +4081,53 @@ procedure TgxMeshObject.BuildList(var mrci: TgxRenderContextInfo); end; // ------------------ -// ------------------ TgxMeshObjectList ------------------ +// ------------------ TGXMeshObjectList ------------------ // ------------------ -constructor TgxMeshObjectList.CreateOwned(aOwner: TgxBaseMesh); +constructor TGXMeshObjectList.CreateOwned(aOwner: TGXBaseMesh); begin FOwner := aOwner; Create; end; -destructor TgxMeshObjectList.Destroy; +destructor TGXMeshObjectList.Destroy; begin Clear; inherited; end; -procedure TgxMeshObjectList.ReadFromFiler(reader: TGVirtualReader); +procedure TGXMeshObjectList.ReadFromFiler(reader: TGVirtualReader); var i: Integer; - Mesh: TgxMeshObject; + Mesh: TGXMeshObject; begin inherited; for i := 0 to Count - 1 do begin Mesh := Items[i]; Mesh.FOwner := Self; - if Mesh is TgxSkeletonMeshObject then - TgxSkeletonMeshObject(Mesh).PrepareBoneMatrixInvertedMeshes; + if Mesh is TGXSkeletonMeshObject then + TGXSkeletonMeshObject(Mesh).PrepareBoneMatrixInvertedMeshes; end; end; -procedure TgxMeshObjectList.PrepareMaterialLibraryCache(matLib: TgxMaterialLibrary); +procedure TGXMeshObjectList.PrepareMaterialLibraryCache(matLib: TgxMaterialLibrary); var i: Integer; begin for i := 0 to Count - 1 do - TgxMeshObject(list^[i]).PrepareMaterialLibraryCache(matLib); + TGXMeshObject(list^[i]).PrepareMaterialLibraryCache(matLib); end; -procedure TgxMeshObjectList.DropMaterialLibraryCache; +procedure TGXMeshObjectList.DropMaterialLibraryCache; var i: Integer; begin for i := 0 to Count - 1 do - TgxMeshObject(list^[i]).DropMaterialLibraryCache; + TGXMeshObject(list^[i]).DropMaterialLibraryCache; end; -procedure TgxMeshObjectList.PrepareBuildList(var mrci: TgxRenderContextInfo); +procedure TGXMeshObjectList.PrepareBuildList(var mrci: TgxRenderContextInfo); var i: Integer; begin @@ -4140,7 +4137,7 @@ procedure TgxMeshObjectList.PrepareBuildList(var mrci: TgxRenderContextInfo); PrepareBuildList(mrci); end; -procedure TgxMeshObjectList.BuildList(var mrci: TgxRenderContextInfo); +procedure TGXMeshObjectList.BuildList(var mrci: TgxRenderContextInfo); var i: Integer; begin @@ -4150,39 +4147,39 @@ procedure TgxMeshObjectList.BuildList(var mrci: TgxRenderContextInfo); BuildList(mrci); end; -procedure TgxMeshObjectList.MorphTo(morphTargetIndex: Integer); +procedure TGXMeshObjectList.MorphTo(morphTargetIndex: Integer); var i: Integer; begin for i := 0 to Count - 1 do - if Items[i] is TgxMorphableMeshObject then - TgxMorphableMeshObject(Items[i]).MorphTo(morphTargetIndex); + if Items[i] is TGXMorphableMeshObject then + TGXMorphableMeshObject(Items[i]).MorphTo(morphTargetIndex); end; -procedure TgxMeshObjectList.Lerp(morphTargetIndex1, morphTargetIndex2: Integer; lerpFactor: Single); +procedure TGXMeshObjectList.Lerp(morphTargetIndex1, morphTargetIndex2: Integer; lerpFactor: Single); var i: Integer; begin for i := 0 to Count - 1 do - if Items[i] is TgxMorphableMeshObject then - TgxMorphableMeshObject(Items[i]).Lerp(morphTargetIndex1, morphTargetIndex2, lerpFactor); + if Items[i] is TGXMorphableMeshObject then + TGXMorphableMeshObject(Items[i]).Lerp(morphTargetIndex1, morphTargetIndex2, lerpFactor); end; -function TgxMeshObjectList.MorphTargetCount: Integer; +function TGXMeshObjectList.MorphTargetCount: Integer; var i: Integer; begin Result := MaxInt; for i := 0 to Count - 1 do - if Items[i] is TgxMorphableMeshObject then - with TgxMorphableMeshObject(Items[i]) do + if Items[i] is TGXMorphableMeshObject then + with TGXMorphableMeshObject(Items[i]) do if Result > MorphTargets.Count then Result := MorphTargets.Count; if Result = MaxInt then Result := 0; end; -procedure TgxMeshObjectList.Clear; +procedure TGXMeshObjectList.Clear; var i: Integer; begin @@ -4196,12 +4193,12 @@ procedure TgxMeshObjectList.Clear; inherited; end; -function TgxMeshObjectList.GetMeshObject(Index: Integer): TgxMeshObject; +function TGXMeshObjectList.GetMeshObject(Index: Integer): TGXMeshObject; begin - Result := TgxMeshObject(list^[Index]); + Result := TGXMeshObject(list^[Index]); end; -procedure TgxMeshObjectList.GetExtents(out min, max: TAffineVector); +procedure TGXMeshObjectList.GetExtents(out min, max: TAffineVector); var i, k: Integer; lMin, lMax: TAffineVector; @@ -4224,7 +4221,7 @@ procedure TgxMeshObjectList.GetExtents(out min, max: TAffineVector); end; end; -procedure TgxMeshObjectList.Translate(const delta: TAffineVector); +procedure TGXMeshObjectList.Translate(const delta: TAffineVector); var i: Integer; begin @@ -4232,11 +4229,11 @@ procedure TgxMeshObjectList.Translate(const delta: TAffineVector); GetMeshObject(i).Translate(delta); end; -function TgxMeshObjectList.ExtractTriangles(texCoords: TGAffineVectorList = nil; normals: TGAffineVectorList = nil) +function TGXMeshObjectList.ExtractTriangles(texCoords: TGAffineVectorList = nil; normals: TGAffineVectorList = nil) : TGAffineVectorList; var i: Integer; - obj: TgxMeshObject; + obj: TGXMeshObject; objTris: TGAffineVectorList; objTexCoords: TGAffineVectorList; objNormals: TGAffineVectorList; @@ -4279,7 +4276,7 @@ function TgxMeshObjectList.ExtractTriangles(texCoords: TGAffineVectorList = nil; end; end; -function TgxMeshObjectList.TriangleCount: Integer; +function TGXMeshObjectList.TriangleCount: Integer; var i: Integer; begin @@ -4288,7 +4285,7 @@ function TgxMeshObjectList.TriangleCount: Integer; Result := Result + Items[i].TriangleCount; end; -procedure TgxMeshObjectList.Prepare; +procedure TGXMeshObjectList.Prepare; var i: Integer; begin @@ -4296,7 +4293,7 @@ procedure TgxMeshObjectList.Prepare; Items[i].Prepare; end; -function TgxMeshObjectList.FindMeshByName(MeshName: string): TgxMeshObject; +function TGXMeshObjectList.FindMeshByName(MeshName: string): TGXMeshObject; var i: Integer; begin @@ -4309,7 +4306,7 @@ function TgxMeshObjectList.FindMeshByName(MeshName: string): TgxMeshObject; end; end; -procedure TgxMeshObjectList.BuildTangentSpace(buildBinormals, buildTangents: Boolean); +procedure TGXMeshObjectList.BuildTangentSpace(buildBinormals, buildTangents: Boolean); var i: Integer; begin @@ -4318,7 +4315,7 @@ procedure TgxMeshObjectList.BuildTangentSpace(buildBinormals, buildTangents: Boo GetMeshObject(i).BuildTangentSpace(buildBinormals, buildTangents); end; -function TgxMeshObjectList.GetUseVBO: Boolean; +function TGXMeshObjectList.GetUseVBO: Boolean; var i: Integer; begin @@ -4328,7 +4325,7 @@ function TgxMeshObjectList.GetUseVBO: Boolean; Result := Result and GetMeshObject(i).FUseVBO; end; -procedure TgxMeshObjectList.SetUseVBO(const Value: Boolean); +procedure TGXMeshObjectList.SetUseVBO(const Value: Boolean); var i: Integer; begin @@ -4338,10 +4335,10 @@ procedure TgxMeshObjectList.SetUseVBO(const Value: Boolean); end; // ------------------ -// ------------------ TgxMeshMorphTarget ------------------ +// ------------------ TGXMeshMorphTarget ------------------ // ------------------ -constructor TgxMeshMorphTarget.CreateOwned(aOwner: TgxMeshMorphTargetList); +constructor TGXMeshMorphTarget.CreateOwned(aOwner: TGXMeshMorphTargetList); begin FOwner := aOwner; Create; @@ -4349,14 +4346,14 @@ constructor TgxMeshMorphTarget.CreateOwned(aOwner: TgxMeshMorphTargetList); FOwner.Add(Self); end; -destructor TgxMeshMorphTarget.Destroy; +destructor TGXMeshMorphTarget.Destroy; begin if Assigned(FOwner) then FOwner.Remove(Self); inherited; end; -procedure TgxMeshMorphTarget.WriteToFiler(writer: TGVirtualWriter); +procedure TGXMeshMorphTarget.WriteToFiler(writer: TGVirtualWriter); begin inherited WriteToFiler(writer); with writer do @@ -4366,7 +4363,7 @@ procedure TgxMeshMorphTarget.WriteToFiler(writer: TGVirtualWriter); end; end; -procedure TgxMeshMorphTarget.ReadFromFiler(reader: TGVirtualReader); +procedure TGXMeshMorphTarget.ReadFromFiler(reader: TGVirtualReader); var archiveVersion: Integer; begin @@ -4382,22 +4379,22 @@ procedure TgxMeshMorphTarget.ReadFromFiler(reader: TGVirtualReader); end; // ------------------ -// ------------------ TgxMeshMorphTargetList ------------------ +// ------------------ TGXMeshMorphTargetList ------------------ // ------------------ -constructor TgxMeshMorphTargetList.CreateOwned(aOwner: TPersistent); +constructor TGXMeshMorphTargetList.CreateOwned(aOwner: TPersistent); begin FOwner := aOwner; Create; end; -destructor TgxMeshMorphTargetList.Destroy; +destructor TGXMeshMorphTargetList.Destroy; begin Clear; inherited; end; -procedure TgxMeshMorphTargetList.ReadFromFiler(reader: TGVirtualReader); +procedure TGXMeshMorphTargetList.ReadFromFiler(reader: TGVirtualReader); var i: Integer; begin @@ -4406,7 +4403,7 @@ procedure TgxMeshMorphTargetList.ReadFromFiler(reader: TGVirtualReader); Items[i].FOwner := Self; end; -procedure TgxMeshMorphTargetList.Translate(const delta: TAffineVector); +procedure TGXMeshMorphTargetList.Translate(const delta: TAffineVector); var i: Integer; begin @@ -4414,7 +4411,7 @@ procedure TgxMeshMorphTargetList.Translate(const delta: TAffineVector); Items[i].Translate(delta); end; -procedure TgxMeshMorphTargetList.Clear; +procedure TGXMeshMorphTargetList.Clear; var i: Integer; begin @@ -4427,28 +4424,28 @@ procedure TgxMeshMorphTargetList.Clear; inherited; end; -function TgxMeshMorphTargetList.GetMeshMorphTarget(Index: Integer): TgxMeshMorphTarget; +function TGXMeshMorphTargetList.GetMeshMorphTarget(Index: Integer): TGXMeshMorphTarget; begin - Result := TgxMeshMorphTarget(list^[Index]); + Result := TGXMeshMorphTarget(list^[Index]); end; // ------------------ -// ------------------ TgxMorphableMeshObject ------------------ +// ------------------ TGXMorphableMeshObject ------------------ // ------------------ -constructor TgxMorphableMeshObject.Create; +constructor TGXMorphableMeshObject.Create; begin inherited; - FMorphTargets := TgxMeshMorphTargetList.CreateOwned(Self); + FMorphTargets := TGXMeshMorphTargetList.CreateOwned(Self); end; -destructor TgxMorphableMeshObject.Destroy; +destructor TGXMorphableMeshObject.Destroy; begin FMorphTargets.Free; inherited; end; -procedure TgxMorphableMeshObject.WriteToFiler(writer: TGVirtualWriter); +procedure TGXMorphableMeshObject.WriteToFiler(writer: TGVirtualWriter); begin inherited WriteToFiler(writer); with writer do @@ -4458,7 +4455,7 @@ procedure TgxMorphableMeshObject.WriteToFiler(writer: TGVirtualWriter); end; end; -procedure TgxMorphableMeshObject.ReadFromFiler(reader: TGVirtualReader); +procedure TGXMorphableMeshObject.ReadFromFiler(reader: TGVirtualReader); var archiveVersion: Integer; begin @@ -4473,20 +4470,20 @@ procedure TgxMorphableMeshObject.ReadFromFiler(reader: TGVirtualReader); RaiseFilerException(archiveVersion); end; -procedure TgxMorphableMeshObject.Clear; +procedure TGXMorphableMeshObject.Clear; begin inherited; FMorphTargets.Clear; end; -procedure TgxMorphableMeshObject.Translate(const delta: TAffineVector); +procedure TGXMorphableMeshObject.Translate(const delta: TAffineVector); begin inherited; MorphTargets.Translate(delta); ValidBuffers := ValidBuffers - [vbVertices]; end; -procedure TgxMorphableMeshObject.MorphTo(morphTargetIndex: Integer); +procedure TGXMorphableMeshObject.MorphTo(morphTargetIndex: Integer); begin if (morphTargetIndex = 0) and (MorphTargets.Count = 0) then Exit; @@ -4506,9 +4503,9 @@ procedure TgxMorphableMeshObject.MorphTo(morphTargetIndex: Integer); end; end; -procedure TgxMorphableMeshObject.Lerp(morphTargetIndex1, morphTargetIndex2: Integer; lerpFactor: Single); +procedure TGXMorphableMeshObject.Lerp(morphTargetIndex1, morphTargetIndex2: Integer; lerpFactor: Single); var - mt1, mt2: TgxMeshMorphTarget; + mt1, mt2: TGXMeshMorphTarget; begin Assert((Cardinal(morphTargetIndex1) < Cardinal(MorphTargets.Count)) and (Cardinal(morphTargetIndex2) < Cardinal(MorphTargets.Count))); @@ -4535,17 +4532,17 @@ procedure TgxMorphableMeshObject.Lerp(morphTargetIndex1, morphTargetIndex2: Inte end; // ------------------ -// ------------------ TgxSkeletonMeshObject ------------------ +// ------------------ TGXSkeletonMeshObject ------------------ // ------------------ -constructor TgxSkeletonMeshObject.Create; +constructor TGXSkeletonMeshObject.Create; begin FBoneMatrixInvertedMeshes := TList.Create; FBackupInvertedMeshes := TList.Create; // ragdoll inherited Create; end; -destructor TgxSkeletonMeshObject.Destroy; +destructor TGXSkeletonMeshObject.Destroy; begin Clear; FBoneMatrixInvertedMeshes.Free; @@ -4553,7 +4550,7 @@ destructor TgxSkeletonMeshObject.Destroy; inherited Destroy; end; -procedure TgxSkeletonMeshObject.WriteToFiler(writer: TGVirtualWriter); +procedure TGXSkeletonMeshObject.WriteToFiler(writer: TGVirtualWriter); var i: Integer; begin @@ -4565,11 +4562,11 @@ procedure TgxSkeletonMeshObject.WriteToFiler(writer: TGVirtualWriter); WriteInteger(FBonesPerVertex); WriteInteger(FVerticeBoneWeightCapacity); for i := 0 to FVerticeBoneWeightCount - 1 do - Write(FVerticesBonesWeights[i][0], FBonesPerVertex * SizeOf(TgxVertexBoneWeight)); + Write(FVerticesBonesWeights[i][0], FBonesPerVertex * SizeOf(TGXVertexBoneWeight)); end; end; -procedure TgxSkeletonMeshObject.ReadFromFiler(reader: TGVirtualReader); +procedure TGXSkeletonMeshObject.ReadFromFiler(reader: TGVirtualReader); var archiveVersion, i: Integer; begin @@ -4583,13 +4580,13 @@ procedure TgxSkeletonMeshObject.ReadFromFiler(reader: TGVirtualReader); FVerticeBoneWeightCapacity := ReadInteger; ResizeVerticesBonesWeights; for i := 0 to FVerticeBoneWeightCount - 1 do - Read(FVerticesBonesWeights[i][0], FBonesPerVertex * SizeOf(TgxVertexBoneWeight)); + Read(FVerticesBonesWeights[i][0], FBonesPerVertex * SizeOf(TGXVertexBoneWeight)); end else RaiseFilerException(archiveVersion); end; -procedure TgxSkeletonMeshObject.Clear; +procedure TGXSkeletonMeshObject.Clear; var i: Integer; begin @@ -4598,11 +4595,11 @@ procedure TgxSkeletonMeshObject.Clear; FBonesPerVertex := 0; ResizeVerticesBonesWeights; for i := 0 to FBoneMatrixInvertedMeshes.Count - 1 do - TgxBaseMeshObject(FBoneMatrixInvertedMeshes[i]).Free; + TGXBaseMeshObject(FBoneMatrixInvertedMeshes[i]).Free; FBoneMatrixInvertedMeshes.Clear; end; -procedure TgxSkeletonMeshObject.SetVerticeBoneWeightCount(const val: Integer); +procedure TGXSkeletonMeshObject.SetVerticeBoneWeightCount(const val: Integer); begin if val <> FVerticeBoneWeightCount then begin @@ -4613,7 +4610,7 @@ procedure TgxSkeletonMeshObject.SetVerticeBoneWeightCount(const val: Integer); end; end; -procedure TgxSkeletonMeshObject.SetVerticeBoneWeightCapacity(const val: Integer); +procedure TGXSkeletonMeshObject.SetVerticeBoneWeightCapacity(const val: Integer); begin if val <> FVerticeBoneWeightCapacity then begin @@ -4622,7 +4619,7 @@ procedure TgxSkeletonMeshObject.SetVerticeBoneWeightCapacity(const val: Integer) end; end; -procedure TgxSkeletonMeshObject.SetBonesPerVertex(const val: Integer); +procedure TGXSkeletonMeshObject.SetBonesPerVertex(const val: Integer); begin if val <> FBonesPerVertex then begin @@ -4631,10 +4628,10 @@ procedure TgxSkeletonMeshObject.SetBonesPerVertex(const val: Integer); end; end; -procedure TgxSkeletonMeshObject.ResizeVerticesBonesWeights; +procedure TGXSkeletonMeshObject.ResizeVerticesBonesWeights; var n, m, i, j: Integer; - newArea: PgxVerticesBoneWeights; + newArea: PGXVerticesBoneWeights; begin n := BonesPerVertex * VerticeBoneWeightCapacity; if n = 0 then @@ -4650,10 +4647,10 @@ procedure TgxSkeletonMeshObject.ResizeVerticesBonesWeights; else begin // allocate new area - GetMem(newArea, VerticeBoneWeightCapacity * SizeOf(PgxVertexBoneWeightArray)); - newArea[0] := AllocMem(n * SizeOf(TgxVertexBoneWeight)); + GetMem(newArea, VerticeBoneWeightCapacity * SizeOf(PGXVertexBoneWeightArray)); + newArea[0] := AllocMem(n * SizeOf(TGXVertexBoneWeight)); for i := 1 to VerticeBoneWeightCapacity - 1 do - newArea[i] := PgxVertexBoneWeightArray(Cardinal(newArea[0]) + Cardinal(i * SizeOf(TgxVertexBoneWeight) * BonesPerVertex)); + newArea[i] := PGXVertexBoneWeightArray(Cardinal(newArea[0]) + Cardinal(i * SizeOf(TGXVertexBoneWeight) * BonesPerVertex)); // transfer old data if FLastVerticeBoneWeightCount < VerticeBoneWeightCount then n := FLastVerticeBoneWeightCount @@ -4677,7 +4674,7 @@ procedure TgxSkeletonMeshObject.ResizeVerticesBonesWeights; FLastBonesPerVertex := FBonesPerVertex; end; -procedure TgxSkeletonMeshObject.AddWeightedBone(aBoneID: Integer; aWeight: Single); +procedure TGXSkeletonMeshObject.AddWeightedBone(aBoneID: Integer; aWeight: Single); begin if BonesPerVertex < 1 then BonesPerVertex := 1; @@ -4689,7 +4686,7 @@ procedure TgxSkeletonMeshObject.AddWeightedBone(aBoneID: Integer; aWeight: Singl end; end; -procedure TgxSkeletonMeshObject.AddWeightedBones(const boneIDs: TgxVertexBoneWeightDynArray); +procedure TGXSkeletonMeshObject.AddWeightedBones(const boneIDs: TGXVertexBoneWeightDynArray); var i: Integer; n: Integer; @@ -4708,10 +4705,10 @@ procedure TgxSkeletonMeshObject.AddWeightedBones(const boneIDs: TgxVertexBoneWei end; end; -function TgxSkeletonMeshObject.FindOrAdd(BoneID: Integer; const vertex, normal: TAffineVector): Integer; +function TGXSkeletonMeshObject.FindOrAdd(BoneID: Integer; const vertex, normal: TAffineVector): Integer; var i: Integer; - dynArray: TgxVertexBoneWeightDynArray; + dynArray: TGXVertexBoneWeightDynArray; begin if BonesPerVertex > 1 then begin @@ -4737,7 +4734,7 @@ function TgxSkeletonMeshObject.FindOrAdd(BoneID: Integer; const vertex, normal: end; end; -function TgxSkeletonMeshObject.FindOrAdd(const boneIDs: TgxVertexBoneWeightDynArray; const vertex, normal: TAffineVector) +function TGXSkeletonMeshObject.FindOrAdd(const boneIDs: TGXVertexBoneWeightDynArray; const vertex, normal: TAffineVector) : Integer; var i, j: Integer; @@ -4770,22 +4767,22 @@ function TgxSkeletonMeshObject.FindOrAdd(const boneIDs: TgxVertexBoneWeightDynAr end; end; -procedure TgxSkeletonMeshObject.PrepareBoneMatrixInvertedMeshes; +procedure TGXSkeletonMeshObject.PrepareBoneMatrixInvertedMeshes; var i, k, boneIndex: Integer; - invMesh: TgxBaseMeshObject; + invMesh: TGXBaseMeshObject; invMat: TMatrix4f; - Bone: TgxSkeletonBone; + Bone: TGXSkeletonBone; p: TVector4f; begin // cleanup existing stuff for i := 0 to FBoneMatrixInvertedMeshes.Count - 1 do - TgxBaseMeshObject(FBoneMatrixInvertedMeshes[i]).Free; + TGXBaseMeshObject(FBoneMatrixInvertedMeshes[i]).Free; FBoneMatrixInvertedMeshes.Clear; // calculate for k := 0 to BonesPerVertex - 1 do begin - invMesh := TgxBaseMeshObject.Create; + invMesh := TGXBaseMeshObject.Create; FBoneMatrixInvertedMeshes.Add(invMesh); invMesh.Vertices := Vertices; invMesh.normals := normals; @@ -4810,56 +4807,56 @@ procedure TgxSkeletonMeshObject.PrepareBoneMatrixInvertedMeshes; end; end; -procedure TgxSkeletonMeshObject.BackupBoneMatrixInvertedMeshes; // ragdoll +procedure TGXSkeletonMeshObject.BackupBoneMatrixInvertedMeshes; // ragdoll var i: Integer; - bm: TgxBaseMeshObject; + bm: TGXBaseMeshObject; begin // cleanup existing stuff for i := 0 to FBackupInvertedMeshes.Count - 1 do - TgxBaseMeshObject(FBackupInvertedMeshes[i]).Free; + TGXBaseMeshObject(FBackupInvertedMeshes[i]).Free; FBackupInvertedMeshes.Clear; // copy current stuff for i := 0 to FBoneMatrixInvertedMeshes.Count - 1 do begin - bm := TgxBaseMeshObject.Create; - bm.Assign(TgxBaseMeshObject(FBoneMatrixInvertedMeshes[i])); + bm := TGXBaseMeshObject.Create; + bm.Assign(TGXBaseMeshObject(FBoneMatrixInvertedMeshes[i])); FBackupInvertedMeshes.Add(bm); - TgxBaseMeshObject(FBoneMatrixInvertedMeshes[i]).Free; + TGXBaseMeshObject(FBoneMatrixInvertedMeshes[i]).Free; end; FBoneMatrixInvertedMeshes.Clear; end; -procedure TgxSkeletonMeshObject.RestoreBoneMatrixInvertedMeshes; // ragdoll +procedure TGXSkeletonMeshObject.RestoreBoneMatrixInvertedMeshes; // ragdoll var i: Integer; - bm: TgxBaseMeshObject; + bm: TGXBaseMeshObject; begin // cleanup existing stuff for i := 0 to FBoneMatrixInvertedMeshes.Count - 1 do - TgxBaseMeshObject(FBoneMatrixInvertedMeshes[i]).Free; + TGXBaseMeshObject(FBoneMatrixInvertedMeshes[i]).Free; FBoneMatrixInvertedMeshes.Clear; // restore the backup for i := 0 to FBackupInvertedMeshes.Count - 1 do begin - bm := TgxBaseMeshObject.Create; - bm.Assign(TgxBaseMeshObject(FBackupInvertedMeshes[i])); + bm := TGXBaseMeshObject.Create; + bm.Assign(TGXBaseMeshObject(FBackupInvertedMeshes[i])); FBoneMatrixInvertedMeshes.Add(bm); - TgxBaseMeshObject(FBackupInvertedMeshes[i]).Free; + TGXBaseMeshObject(FBackupInvertedMeshes[i]).Free; end; FBackupInvertedMeshes.Clear; end; -procedure TgxSkeletonMeshObject.ApplyCurrentSkeletonFrame(normalize: Boolean); +procedure TGXSkeletonMeshObject.ApplyCurrentSkeletonFrame(normalize: Boolean); var i, j, BoneID: Integer; refVertices, refNormals: TGAffineVectorList; n, nt: TVector4f; - Bone: TgxSkeletonBone; - Skeleton: TgxSkeleton; + Bone: TGXSkeletonBone; + Skeleton: TGXSkeleton; tempvert, tempnorm: TAffineVector; begin - with TgxBaseMeshObject(FBoneMatrixInvertedMeshes[0]) do + with TGXBaseMeshObject(FBoneMatrixInvertedMeshes[0]) do begin refVertices := Vertices; refNormals := normals; @@ -4888,7 +4885,7 @@ procedure TgxSkeletonMeshObject.ApplyCurrentSkeletonFrame(normalize: Boolean); normals.list^[i] := NullVector; for j := 0 to BonesPerVertex - 1 do begin - with TgxBaseMeshObject(FBoneMatrixInvertedMeshes[j]) do + with TGXBaseMeshObject(FBoneMatrixInvertedMeshes[j]) do begin refVertices := Vertices; refNormals := normals; @@ -4915,10 +4912,10 @@ procedure TgxSkeletonMeshObject.ApplyCurrentSkeletonFrame(normalize: Boolean); end; // ------------------ -// ------------------ TgxFaceGroup ------------------ +// ------------------ TGXFaceGroup ------------------ // ------------------ -constructor TgxFaceGroup.CreateOwned(aOwner: TgxFaceGroups); +constructor TGXFaceGroup.CreateOwned(aOwner: TGXFaceGroups); begin FOwner := aOwner; FLightMapIndex := -1; @@ -4927,14 +4924,14 @@ constructor TgxFaceGroup.CreateOwned(aOwner: TgxFaceGroups); FOwner.Add(Self); end; -destructor TgxFaceGroup.Destroy; +destructor TGXFaceGroup.Destroy; begin if Assigned(FOwner) then FOwner.Remove(Self); inherited; end; -procedure TgxFaceGroup.WriteToFiler(writer: TGVirtualWriter); +procedure TGXFaceGroup.WriteToFiler(writer: TGVirtualWriter); begin inherited WriteToFiler(writer); with writer do @@ -4953,7 +4950,7 @@ procedure TgxFaceGroup.WriteToFiler(writer: TGVirtualWriter); end; end; -procedure TgxFaceGroup.ReadFromFiler(reader: TGVirtualReader); +procedure TGXFaceGroup.ReadFromFiler(reader: TGVirtualReader); var archiveVersion: Integer; begin @@ -4972,7 +4969,7 @@ procedure TgxFaceGroup.ReadFromFiler(reader: TGVirtualReader); RaiseFilerException(archiveVersion); end; -procedure TgxFaceGroup.AttachLightmap(lightMap: TgxTexture; var mrci: TgxRenderContextInfo); +procedure TGXFaceGroup.AttachLightmap(lightMap: TgxTexture; var mrci: TgxRenderContextInfo); begin /// if GL_ARB_multitexture then with lightMap do @@ -4985,7 +4982,7 @@ procedure TgxFaceGroup.AttachLightmap(lightMap: TgxTexture; var mrci: TgxRenderC end; end; -procedure TgxFaceGroup.AttachOrDetachLightmap(var mrci: TgxRenderContextInfo); +procedure TGXFaceGroup.AttachOrDetachLightmap(var mrci: TgxRenderContextInfo); var libMat: TgxLibMaterial; begin @@ -5012,7 +5009,7 @@ procedure TgxFaceGroup.AttachOrDetachLightmap(var mrci: TgxRenderContextInfo); end; end; -procedure TgxFaceGroup.PrepareMaterialLibraryCache(matLib: TgxMaterialLibrary); +procedure TGXFaceGroup.PrepareMaterialLibraryCache(matLib: TgxMaterialLibrary); begin if (FMaterialName <> '') and (matLib <> nil) then FMaterialCache := matLib.Materials.GetLibMaterialByName(FMaterialName) @@ -5020,46 +5017,46 @@ procedure TgxFaceGroup.PrepareMaterialLibraryCache(matLib: TgxMaterialLibrary); FMaterialCache := nil; end; -procedure TgxFaceGroup.DropMaterialLibraryCache; +procedure TGXFaceGroup.DropMaterialLibraryCache; begin FMaterialCache := nil; end; -procedure TgxFaceGroup.AddToTriangles(aList: TGAffineVectorList; aTexCoords: TGAffineVectorList = nil; +procedure TGXFaceGroup.AddToTriangles(aList: TGAffineVectorList; aTexCoords: TGAffineVectorList = nil; aNormals: TGAffineVectorList = nil); begin // nothing end; -procedure TgxFaceGroup.Reverse; +procedure TGXFaceGroup.Reverse; begin // nothing end; -procedure TgxFaceGroup.Prepare; +procedure TGXFaceGroup.Prepare; begin // nothing end; // ------------------ -// ------------------ TfgxVertexIndexList ------------------ +// ------------------ TFGXVertexIndexList ------------------ // ------------------ -constructor TfgxVertexIndexList.Create; +constructor TFGXVertexIndexList.Create; begin inherited; FVertexIndices := TGIntegerList.Create; FMode := fgmmTriangles; end; -destructor TfgxVertexIndexList.Destroy; +destructor TFGXVertexIndexList.Destroy; begin FVertexIndices.Free; FIndexVBO.Free; inherited; end; -procedure TfgxVertexIndexList.WriteToFiler(writer: TGVirtualWriter); +procedure TFGXVertexIndexList.WriteToFiler(writer: TGVirtualWriter); begin inherited WriteToFiler(writer); with writer do @@ -5070,7 +5067,7 @@ procedure TfgxVertexIndexList.WriteToFiler(writer: TGVirtualWriter); end; end; -procedure TfgxVertexIndexList.ReadFromFiler(reader: TGVirtualReader); +procedure TFGXVertexIndexList.ReadFromFiler(reader: TGVirtualReader); var archiveVersion: Integer; begin @@ -5080,14 +5077,14 @@ procedure TfgxVertexIndexList.ReadFromFiler(reader: TGVirtualReader); with reader do begin FVertexIndices.ReadFromFiler(reader); - FMode := TgxFaceGroupMeshMode(ReadInteger); + FMode := TGXFaceGroupMeshMode(ReadInteger); InvalidateVBO; end else RaiseFilerException(archiveVersion); end; -procedure TfgxVertexIndexList.SetupVBO; +procedure TFGXVertexIndexList.SetupVBO; const BufferUsage = GL_STATIC_DRAW; begin @@ -5103,15 +5100,15 @@ procedure TfgxVertexIndexList.SetupVBO; end; end; -procedure TfgxVertexIndexList.SetVertexIndices(const val: TGIntegerList); +procedure TFGXVertexIndexList.SetVertexIndices(const val: TGIntegerList); begin FVertexIndices.Assign(val); InvalidateVBO; end; -procedure TfgxVertexIndexList.BuildList(var mrci: TgxRenderContextInfo); +procedure TFGXVertexIndexList.BuildList(var mrci: TgxRenderContextInfo); const - cFaceGroupMeshModeToOpenGL: array [TgxFaceGroupMeshMode] of Integer = (GL_TRIANGLES, GL_TRIANGLE_STRIP, GL_TRIANGLES, + cFaceGroupMeshModeToOpenGL: array [TGXFaceGroupMeshMode] of Integer = (GL_TRIANGLES, GL_TRIANGLE_STRIP, GL_TRIANGLES, GL_TRIANGLE_FAN, GL_QUADS); begin if vertexIndices.Count = 0 then @@ -5133,7 +5130,7 @@ procedure TfgxVertexIndexList.BuildList(var mrci: TgxRenderContextInfo); end; end; -procedure TfgxVertexIndexList.AddToList(Source, destination: TGAffineVectorList; indices: TGIntegerList); +procedure TFGXVertexIndexList.AddToList(Source, destination: TGAffineVectorList; indices: TGIntegerList); var i, n: Integer; begin @@ -5198,10 +5195,10 @@ procedure TfgxVertexIndexList.AddToList(Source, destination: TGAffineVectorList; end; end; -procedure TfgxVertexIndexList.AddToTriangles(aList: TGAffineVectorList; aTexCoords: TGAffineVectorList = nil; +procedure TFGXVertexIndexList.AddToTriangles(aList: TGAffineVectorList; aTexCoords: TGAffineVectorList = nil; aNormals: TGAffineVectorList = nil); var - mo: TgxMeshObject; + mo: TGXMeshObject; begin mo := Owner.Owner; AddToList(mo.Vertices, aList, vertexIndices); @@ -5210,7 +5207,7 @@ procedure TfgxVertexIndexList.AddToTriangles(aList: TGAffineVectorList; aTexCoor InvalidateVBO; end; -function TfgxVertexIndexList.TriangleCount: Integer; +function TFGXVertexIndexList.TriangleCount: Integer; begin case mode of fgmmTriangles, fgmmFlatTriangles: @@ -5229,19 +5226,19 @@ function TfgxVertexIndexList.TriangleCount: Integer; end; end; -procedure TfgxVertexIndexList.Reverse; +procedure TFGXVertexIndexList.Reverse; begin vertexIndices.Reverse; InvalidateVBO; end; -procedure TfgxVertexIndexList.Add(idx: Integer); +procedure TFGXVertexIndexList.Add(idx: Integer); begin FVertexIndices.Add(idx); InvalidateVBO; end; -procedure TfgxVertexIndexList.GetExtents(var min, max: TAffineVector); +procedure TFGXVertexIndexList.GetExtents(var min, max: TAffineVector); var i, k: Integer; f: Single; @@ -5266,7 +5263,7 @@ procedure TfgxVertexIndexList.GetExtents(var min, max: TAffineVector); end; end; -procedure TfgxVertexIndexList.ConvertToList; +procedure TFGXVertexIndexList.ConvertToList; var i: Integer; bufList: TGIntegerList; @@ -5302,7 +5299,7 @@ procedure TfgxVertexIndexList.ConvertToList; end; end; -function TfgxVertexIndexList.GetNormal: TAffineVector; +function TFGXVertexIndexList.GetNormal: TAffineVector; begin if vertexIndices.Count < 3 then Result := NullVector @@ -5311,7 +5308,7 @@ function TfgxVertexIndexList.GetNormal: TAffineVector; CalcPlaneNormal(Items[vertexIndices[0]], Items[vertexIndices[1]], Items[vertexIndices[2]], Result); end; -procedure TfgxVertexIndexList.InvalidateVBO; +procedure TFGXVertexIndexList.InvalidateVBO; begin if Assigned(FIndexVBO) then FIndexVBO.NotifyChangesOfData; @@ -5594,22 +5591,22 @@ procedure TFGIndexTexCoordList.Add(idx: Integer; const s, t: Single); end; // ------------------ -// ------------------ TgxFaceGroups ------------------ +// ------------------ TGXFaceGroups ------------------ // ------------------ -constructor TgxFaceGroups.CreateOwned(aOwner: TgxMeshObject); +constructor TGXFaceGroups.CreateOwned(aOwner: TGXMeshObject); begin FOwner := aOwner; Create; end; -destructor TgxFaceGroups.Destroy; +destructor TGXFaceGroups.Destroy; begin Clear; inherited; end; -procedure TgxFaceGroups.ReadFromFiler(reader: TGVirtualReader); +procedure TGXFaceGroups.ReadFromFiler(reader: TGVirtualReader); var i: Integer; begin @@ -5618,10 +5615,10 @@ procedure TgxFaceGroups.ReadFromFiler(reader: TGVirtualReader); Items[i].FOwner := Self; end; -procedure TgxFaceGroups.Clear; +procedure TGXFaceGroups.Clear; var i: Integer; - fg: TgxFaceGroup; + fg: TGXFaceGroup; begin for i := 0 to Count - 1 do begin @@ -5635,28 +5632,28 @@ procedure TgxFaceGroups.Clear; inherited; end; -function TgxFaceGroups.GetFaceGroup(Index: Integer): TgxFaceGroup; +function TGXFaceGroups.GetFaceGroup(Index: Integer): TGXFaceGroup; begin - Result := TgxFaceGroup(list^[Index]); + Result := TGXFaceGroup(list^[Index]); end; -procedure TgxFaceGroups.PrepareMaterialLibraryCache(matLib: TgxMaterialLibrary); +procedure TGXFaceGroups.PrepareMaterialLibraryCache(matLib: TgxMaterialLibrary); var i: Integer; begin for i := 0 to Count - 1 do - TgxFaceGroup(list^[i]).PrepareMaterialLibraryCache(matLib); + TGXFaceGroup(list^[i]).PrepareMaterialLibraryCache(matLib); end; -procedure TgxFaceGroups.DropMaterialLibraryCache; +procedure TGXFaceGroups.DropMaterialLibraryCache; var i: Integer; begin for i := 0 to Count - 1 do - TgxFaceGroup(list^[i]).DropMaterialLibraryCache; + TGXFaceGroup(list^[i]).DropMaterialLibraryCache; end; -procedure TgxFaceGroups.AddToTriangles(aList: TGAffineVectorList; aTexCoords: TGAffineVectorList = nil; +procedure TGXFaceGroups.AddToTriangles(aList: TGAffineVectorList; aTexCoords: TGAffineVectorList = nil; aNormals: TGAffineVectorList = nil); var i: Integer; @@ -5665,10 +5662,10 @@ procedure TgxFaceGroups.AddToTriangles(aList: TGAffineVectorList; aTexCoords: TG Items[i].AddToTriangles(aList, aTexCoords, aNormals); end; -function TgxFaceGroups.MaterialLibrary: TgxMaterialLibrary; +function TGXFaceGroups.MaterialLibrary: TgxMaterialLibrary; var - mol: TgxMeshObjectList; - bm: TgxBaseMesh; + mol: TGXMeshObjectList; + bm: TGXBaseMesh; begin if Assigned(Owner) then begin @@ -5688,7 +5685,7 @@ function TgxFaceGroups.MaterialLibrary: TgxMaterialLibrary; function CompareMaterials(item1, item2: TObject): Integer; - function MaterialIsOpaque(fg: TgxFaceGroup): Boolean; + function MaterialIsOpaque(fg: TGXFaceGroup): Boolean; var libMat: TgxLibMaterial; begin @@ -5697,12 +5694,12 @@ function CompareMaterials(item1, item2: TObject): Integer; end; var - fg1, fg2: TgxFaceGroup; + fg1, fg2: TGXFaceGroup; opaque1, opaque2: Boolean; begin - fg1 := TgxFaceGroup(item1); + fg1 := TGXFaceGroup(item1); opaque1 := MaterialIsOpaque(fg1); - fg2 := TgxFaceGroup(item2); + fg2 := TGXFaceGroup(item2); opaque2 := MaterialIsOpaque(fg2); if opaque1 = opaque2 then begin @@ -5716,62 +5713,62 @@ function CompareMaterials(item1, item2: TObject): Integer; Result := 1; end; -procedure TgxFaceGroups.SortByMaterial; +procedure TGXFaceGroups.SortByMaterial; begin PrepareMaterialLibraryCache(Owner.Owner.Owner.MaterialLibrary); Sort(@CompareMaterials); end; // ------------------ -// ------------------ TgxVectorFile ------------------ +// ------------------ TGXVectorFile ------------------ // ------------------ -constructor TgxVectorFile.Create(aOwner: TPersistent); +constructor TGXVectorFile.Create(aOwner: TPersistent); begin - Assert(aOwner is TgxBaseMesh); + Assert(aOwner is TGXBaseMesh); inherited; end; -function TgxVectorFile.Owner: TgxBaseMesh; +function TGXVectorFile.Owner: TGXBaseMesh; begin - Result := TgxBaseMesh(GetOwner); + Result := TGXBaseMesh(GetOwner); end; -procedure TgxVectorFile.SetNormalsOrientation(const val: TMeshNormalsOrientation); +procedure TGXVectorFile.SetNormalsOrientation(const val: TMeshNormalsOrientation); begin FNormalsOrientation := val; end; // ------------------ -// ------------------ TgxGLSMVectorFile ------------------ +// ------------------ TGXVectorFileGLSM ------------------ // ------------------ -class function TgxGLSMVectorFile.Capabilities: TDataFileCapabilities; +class function TGXVectorFileGLSM.Capabilities: TDataFileCapabilities; begin Result := [dfcRead, dfcWrite]; end; -procedure TgxGLSMVectorFile.LoadFromStream(aStream: TStream); +procedure TGXVectorFileGLSM.LoadFromStream(aStream: TStream); begin Owner.MeshObjects.LoadFromStream(aStream); end; -procedure TgxGLSMVectorFile.SaveToStream(aStream: TStream); +procedure TGXVectorFileGLSM.SaveToStream(aStream: TStream); begin Owner.MeshObjects.SaveToStream(aStream); end; // ------------------ -// ------------------ TgxBaseMesh ------------------ +// ------------------ TGXBaseMesh ------------------ // ------------------ -constructor TgxBaseMesh.Create(aOwner: TComponent); +constructor TGXBaseMesh.Create(aOwner: TComponent); begin inherited Create(aOwner); if FMeshObjects = nil then - FMeshObjects := TgxMeshObjectList.CreateOwned(Self); + FMeshObjects := TGXMeshObjectList.CreateOwned(Self); if FSkeleton = nil then - FSkeleton := TgxSkeleton.CreateOwned(Self); + FSkeleton := TGXSkeleton.CreateOwned(Self); FUseMeshMaterials := True; FAutoCentering := []; FAxisAlignedDimensionsCache.X := -1; @@ -5779,7 +5776,7 @@ constructor TgxBaseMesh.Create(aOwner: TComponent); FAutoScaling := TGCoordinates.CreateInitialized(Self, XYZWHmgVector, csPoint); end; -destructor TgxBaseMesh.Destroy; +destructor TGXBaseMesh.Destroy; begin FConnectivity.Free; DropMaterialLibraryCache; @@ -5789,29 +5786,29 @@ destructor TgxBaseMesh.Destroy; inherited Destroy; end; -procedure TgxBaseMesh.Assign(Source: TPersistent); +procedure TGXBaseMesh.Assign(Source: TPersistent); begin - if Source is TgxBaseMesh then + if Source is TGXBaseMesh then begin FSkeleton.Clear; - FNormalsOrientation := TgxBaseMesh(Source).FNormalsOrientation; - FMaterialLibrary := TgxBaseMesh(Source).FMaterialLibrary; - FLightmapLibrary := TgxBaseMesh(Source).FLightmapLibrary; - FAxisAlignedDimensionsCache := TgxBaseMesh(Source).FAxisAlignedDimensionsCache; - FBaryCenterOffset := TgxBaseMesh(Source).FBaryCenterOffset; - FUseMeshMaterials := TgxBaseMesh(Source).FUseMeshMaterials; - FOverlaySkeleton := TgxBaseMesh(Source).FOverlaySkeleton; - FIgnoreMissingTextures := TgxBaseMesh(Source).FIgnoreMissingTextures; - FAutoCentering := TgxBaseMesh(Source).FAutoCentering; - FAutoScaling.Assign(TgxBaseMesh(Source).FAutoScaling); - FSkeleton.Assign(TgxBaseMesh(Source).FSkeleton); + FNormalsOrientation := TGXBaseMesh(Source).FNormalsOrientation; + FMaterialLibrary := TGXBaseMesh(Source).FMaterialLibrary; + FLightmapLibrary := TGXBaseMesh(Source).FLightmapLibrary; + FAxisAlignedDimensionsCache := TGXBaseMesh(Source).FAxisAlignedDimensionsCache; + FBaryCenterOffset := TGXBaseMesh(Source).FBaryCenterOffset; + FUseMeshMaterials := TGXBaseMesh(Source).FUseMeshMaterials; + FOverlaySkeleton := TGXBaseMesh(Source).FOverlaySkeleton; + FIgnoreMissingTextures := TGXBaseMesh(Source).FIgnoreMissingTextures; + FAutoCentering := TGXBaseMesh(Source).FAutoCentering; + FAutoScaling.Assign(TGXBaseMesh(Source).FAutoScaling); + FSkeleton.Assign(TGXBaseMesh(Source).FSkeleton); FSkeleton.RootBones.PrepareGlobalMatrices; - FMeshObjects.Assign(TgxBaseMesh(Source).FMeshObjects); + FMeshObjects.Assign(TGXBaseMesh(Source).FMeshObjects); end; inherited Assign(Source); end; -procedure TgxBaseMesh.LoadFromFile(const filename: string); +procedure TGXBaseMesh.LoadFromFile(const filename: string); var fs: TStream; begin @@ -5828,10 +5825,10 @@ procedure TgxBaseMesh.LoadFromFile(const filename: string); end; end; -procedure TgxBaseMesh.LoadFromStream(const filename: string; aStream: TStream); +procedure TGXBaseMesh.LoadFromStream(const filename: string; aStream: TStream); var - newVectorFile: TgxVectorFile; - VectorFileClass: TgxVectorFileClass; + newVectorFile: TGXVectorFile; + VectorFileClass: TGXVectorFileClass; begin FLastLoadedFilename := ''; if filename <> '' then @@ -5861,7 +5858,7 @@ procedure TgxBaseMesh.LoadFromStream(const filename: string; aStream: TStream); end; end; -procedure TgxBaseMesh.SaveToFile(const filename: string); +procedure TGXBaseMesh.SaveToFile(const filename: string); var fs: TStream; begin @@ -5876,10 +5873,10 @@ procedure TgxBaseMesh.SaveToFile(const filename: string); end; end; -procedure TgxBaseMesh.SaveToStream(const filename: string; aStream: TStream); +procedure TGXBaseMesh.SaveToStream(const filename: string; aStream: TStream); var - newVectorFile: TgxVectorFile; - VectorFileClass: TgxVectorFileClass; + newVectorFile: TGXVectorFile; + VectorFileClass: TGXVectorFileClass; begin if filename <> '' then begin @@ -5895,7 +5892,7 @@ procedure TgxBaseMesh.SaveToStream(const filename: string; aStream: TStream); end; end; -procedure TgxBaseMesh.AddDataFromFile(const filename: string); +procedure TGXBaseMesh.AddDataFromFile(const filename: string); var fs: TStream; begin @@ -5910,10 +5907,10 @@ procedure TgxBaseMesh.AddDataFromFile(const filename: string); end; end; -procedure TgxBaseMesh.AddDataFromStream(const filename: string; aStream: TStream); +procedure TGXBaseMesh.AddDataFromStream(const filename: string; aStream: TStream); var - newVectorFile: TgxVectorFile; - VectorFileClass: TgxVectorFileClass; + newVectorFile: TGXVectorFile; + VectorFileClass: TGXVectorFileClass; begin if filename <> '' then begin @@ -5934,7 +5931,7 @@ procedure TgxBaseMesh.AddDataFromStream(const filename: string; aStream: TStream end; end; -procedure TgxBaseMesh.GetExtents(out min, max: TAffineVector); +procedure TGXBaseMesh.GetExtents(out min, max: TAffineVector); var i, k: Integer; lMin, lMax: TAffineVector; @@ -5946,7 +5943,7 @@ procedure TgxBaseMesh.GetExtents(out min, max: TAffineVector); SetVector(max, cSmallValue, cSmallValue, cSmallValue); for i := 0 to MeshObjects.Count - 1 do begin - TgxMeshObject(MeshObjects[i]).GetExtents(lMin, lMax); + TGXMeshObject(MeshObjects[i]).GetExtents(lMin, lMax); for k := 0 to 2 do begin if lMin.v[k] < min.v[k] then @@ -5957,24 +5954,24 @@ procedure TgxBaseMesh.GetExtents(out min, max: TAffineVector); end; end; -function TgxBaseMesh.GetBarycenter: TAffineVector; +function TGXBaseMesh.GetBarycenter: TAffineVector; var i, nb: Integer; begin Result := NullVector; nb := 0; for i := 0 to MeshObjects.Count - 1 do - TgxMeshObject(MeshObjects[i]).ContributeToBarycenter(Result, nb); + TGXMeshObject(MeshObjects[i]).ContributeToBarycenter(Result, nb); if nb > 0 then ScaleVector(Result, 1 / nb); end; -function TgxBaseMesh.LastLoadedFilename: string; +function TGXBaseMesh.LastLoadedFilename: string; begin Result := FLastLoadedFilename; end; -procedure TgxBaseMesh.SetMaterialLibrary(const val: TgxMaterialLibrary); +procedure TGXBaseMesh.SetMaterialLibrary(const val: TgxMaterialLibrary); begin if FMaterialLibrary <> val then begin @@ -5992,7 +5989,7 @@ procedure TgxBaseMesh.SetMaterialLibrary(const val: TgxMaterialLibrary); end; end; -procedure TgxBaseMesh.SetLightmapLibrary(const val: TgxMaterialLibrary); +procedure TGXBaseMesh.SetLightmapLibrary(const val: TgxMaterialLibrary); begin if FLightmapLibrary <> val then begin @@ -6008,7 +6005,7 @@ procedure TgxBaseMesh.SetLightmapLibrary(const val: TgxMaterialLibrary); end; end; -procedure TgxBaseMesh.SetNormalsOrientation(const val: TMeshNormalsOrientation); +procedure TGXBaseMesh.SetNormalsOrientation(const val: TMeshNormalsOrientation); begin if val <> FNormalsOrientation then begin @@ -6017,7 +6014,7 @@ procedure TgxBaseMesh.SetNormalsOrientation(const val: TMeshNormalsOrientation); end; end; -procedure TgxBaseMesh.SetOverlaySkeleton(const val: Boolean); +procedure TGXBaseMesh.SetOverlaySkeleton(const val: Boolean); begin if FOverlaySkeleton <> val then begin @@ -6026,12 +6023,12 @@ procedure TgxBaseMesh.SetOverlaySkeleton(const val: Boolean); end; end; -procedure TgxBaseMesh.SetAutoScaling(const Value: TGCoordinates); +procedure TGXBaseMesh.SetAutoScaling(const Value: TGCoordinates); begin FAutoScaling.SetPoint(Value.DirectX, Value.DirectY, Value.DirectZ); end; -procedure TgxBaseMesh.Notification(AComponent: TComponent; Operation: TOperation); +procedure TGXBaseMesh.Notification(AComponent: TComponent; Operation: TOperation); begin if Operation = opRemove then begin @@ -6043,7 +6040,7 @@ procedure TgxBaseMesh.Notification(AComponent: TComponent; Operation: TOperation inherited; end; -function TgxBaseMesh.AxisAlignedDimensionsUnscaled: TVector4f; +function TGXBaseMesh.AxisAlignedDimensionsUnscaled: TVector4f; var dMin, dMax: TAffineVector; begin @@ -6058,7 +6055,7 @@ function TgxBaseMesh.AxisAlignedDimensionsUnscaled: TVector4f; SetVector(Result, FAxisAlignedDimensionsCache); end; -function TgxBaseMesh.BarycenterOffset: TVector4f; +function TGXBaseMesh.BarycenterOffset: TVector4f; var dMin, dMax: TAffineVector; begin @@ -6075,17 +6072,17 @@ function TgxBaseMesh.BarycenterOffset: TVector4f; Result := FBaryCenterOffset; end; -function TgxBaseMesh.BarycenterPosition: TVector4f; +function TGXBaseMesh.BarycenterPosition: TVector4f; begin Result := VectorAdd(Position.DirectVector, BarycenterOffset); end; -function TgxBaseMesh.BarycenterAbsolutePosition: TVector4f; +function TGXBaseMesh.BarycenterAbsolutePosition: TVector4f; begin Result := LocalToAbsolute(BarycenterPosition); end; -procedure TgxBaseMesh.DestroyHandle; +procedure TGXBaseMesh.DestroyHandle; begin if Assigned(FMaterialLibrary) then MaterialLibrary.DestroyHandles; @@ -6094,12 +6091,12 @@ procedure TgxBaseMesh.DestroyHandle; inherited; end; -procedure TgxBaseMesh.PrepareVectorFile(aFile: TgxVectorFile); +procedure TGXBaseMesh.PrepareVectorFile(aFile: TGXVectorFile); begin aFile.NormalsOrientation := NormalsOrientation; end; -procedure TgxBaseMesh.PerformAutoCentering; +procedure TGXBaseMesh.PerformAutoCentering; var delta, min, max: TAffineVector; begin @@ -6129,7 +6126,7 @@ procedure TgxBaseMesh.PerformAutoCentering; Position.Translate(VectorNegate(delta)); end; -procedure TgxBaseMesh.PerformAutoScaling; +procedure TGXBaseMesh.PerformAutoScaling; var i: Integer; vScal: TAffineFltVector; @@ -6144,12 +6141,12 @@ procedure TgxBaseMesh.PerformAutoScaling; end; end; -procedure TgxBaseMesh.PrepareMesh; +procedure TGXBaseMesh.PrepareMesh; begin StructureChanged; end; -procedure TgxBaseMesh.PrepareMaterialLibraryCache; +procedure TGXBaseMesh.PrepareMaterialLibraryCache; begin if FMaterialLibraryCachesPrepared then DropMaterialLibraryCache; @@ -6157,7 +6154,7 @@ procedure TgxBaseMesh.PrepareMaterialLibraryCache; FMaterialLibraryCachesPrepared := True; end; -procedure TgxBaseMesh.DropMaterialLibraryCache; +procedure TGXBaseMesh.DropMaterialLibraryCache; begin if FMaterialLibraryCachesPrepared then begin @@ -6166,14 +6163,14 @@ procedure TgxBaseMesh.DropMaterialLibraryCache; end; end; -procedure TgxBaseMesh.PrepareBuildList(var mrci: TgxRenderContextInfo); +procedure TGXBaseMesh.PrepareBuildList(var mrci: TgxRenderContextInfo); begin MeshObjects.PrepareBuildList(mrci); if LightmapLibrary <> nil then LightmapLibrary.Materials.PrepareBuildList end; -procedure TgxBaseMesh.SetUseMeshMaterials(const val: Boolean); +procedure TGXBaseMesh.SetUseMeshMaterials(const val: Boolean); begin if val <> FUseMeshMaterials then begin @@ -6184,12 +6181,12 @@ procedure TgxBaseMesh.SetUseMeshMaterials(const val: Boolean); end; end; -procedure TgxBaseMesh.BuildList(var rci: TgxRenderContextInfo); +procedure TGXBaseMesh.BuildList(var rci: TgxRenderContextInfo); begin MeshObjects.BuildList(rci); end; -procedure TgxBaseMesh.DoRender(var rci: TgxRenderContextInfo; renderSelf, renderChildren: Boolean); +procedure TGXBaseMesh.DoRender(var rci: TgxRenderContextInfo; renderSelf, renderChildren: Boolean); begin if Assigned(LightmapLibrary) then xglForbidSecondTextureUnit; @@ -6245,7 +6242,7 @@ procedure TgxBaseMesh.DoRender(var rci: TgxRenderContextInfo; renderSelf, render Self.renderChildren(0, Count - 1, rci); end; -procedure TgxBaseMesh.StructureChanged; +procedure TGXBaseMesh.StructureChanged; begin FAxisAlignedDimensionsCache.X := -1; FBaryCenterOffsetChanged := True; @@ -6254,12 +6251,12 @@ procedure TgxBaseMesh.StructureChanged; inherited; end; -procedure TgxBaseMesh.StructureChangedNoPrepare; +procedure TGXBaseMesh.StructureChangedNoPrepare; begin inherited StructureChanged; end; -function TgxBaseMesh.RayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil; +function TGXBaseMesh.RayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil): Boolean; var i: Integer; @@ -6308,7 +6305,7 @@ function TgxBaseMesh.RayCastIntersect(const rayStart, rayVector: TVector4f; inte end; end; -function TgxBaseMesh.GenerateSilhouette(const SilhouetteParameters: TgxSilhouetteParameters): TgxSilhouette; +function TGXBaseMesh.GenerateSilhouette(const SilhouetteParameters: TgxSilhouetteParameters): TgxSilhouette; var mc: TgxBaseMeshConnectivity; sil: TgxSilhouette; @@ -6331,50 +6328,50 @@ function TgxBaseMesh.GenerateSilhouette(const SilhouetteParameters: TgxSilhouett Result := sil; end; -procedure TgxBaseMesh.BuildSilhouetteConnectivityData; +procedure TGXBaseMesh.BuildSilhouetteConnectivityData; var i, j: Integer; - mo: TgxMeshObject; + mo: TGXMeshObject; begin FreeAndNil(FConnectivity); - // connectivity data works only on facegroups of TfgxVertexIndexList class + // connectivity data works only on facegroups of TFGXVertexIndexList class for i := 0 to MeshObjects.Count - 1 do begin - mo := (MeshObjects[i] as TgxMeshObject); + mo := (MeshObjects[i] as TGXMeshObject); if mo.mode <> momFaceGroups then Exit; for j := 0 to mo.FaceGroups.Count - 1 do - if not mo.FaceGroups[j].InheritsFrom(TfgxVertexIndexList) then + if not mo.FaceGroups[j].InheritsFrom(TFGXVertexIndexList) then Exit; end; FConnectivity := TgxBaseMeshConnectivity.CreateFromMesh(Self); end; // ------------------ -// ------------------ TgxFreeForm ------------------ +// ------------------ TGXFreeForm ------------------ // ------------------ -constructor TgxFreeForm.Create(aOwner: TComponent); +constructor TGXFreeForm.Create(aOwner: TComponent); begin inherited; // ObjectStyle := [osDirectDraw]; FUseMeshMaterials := True; end; -destructor TgxFreeForm.Destroy; +destructor TGXFreeForm.Destroy; begin FOctree.Free; inherited Destroy; end; -function TgxFreeForm.GetOctree: TgxOctree; +function TGXFreeForm.GetOctree: TgxOctree; begin // if not Assigned(FOctree) then //If auto-created, can never use "if Assigned(GLFreeform1.Octree)" // FOctree:=TOctree.Create; //moved this code to BuildOctree Result := FOctree; end; -procedure TgxFreeForm.BuildOctree(TreeDepth: Integer = 3); +procedure TGXFreeForm.BuildOctree(TreeDepth: Integer = 3); var emin, emax: TAffineVector; tl: TGAffineVectorList; @@ -6395,7 +6392,7 @@ procedure TgxFreeForm.BuildOctree(TreeDepth: Integer = 3); end; end; -function TgxFreeForm.OctreeRayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil; +function TGXFreeForm.OctreeRayCastIntersect(const rayStart, rayVector: TVector4f; intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil): Boolean; var locRayStart, locRayVector: TVector4f; @@ -6417,7 +6414,7 @@ function TgxFreeForm.OctreeRayCastIntersect(const rayStart, rayVector: TVector4f end; end; -function TgxFreeForm.OctreePointInMesh(const Point: TVector4f): Boolean; +function TGXFreeForm.OctreePointInMesh(const Point: TVector4f): Boolean; const cPointRadiusStep = 10000; var @@ -6472,7 +6469,7 @@ function TgxFreeForm.OctreePointInMesh(const Point: TVector4f): Boolean; end; end; -function TgxFreeForm.OctreeSphereSweepIntersect(const rayStart, rayVector: TVector4f; const velocity, radius: Single; +function TGXFreeForm.OctreeSphereSweepIntersect(const rayStart, rayVector: TVector4f; const velocity, radius: Single; intersectPoint: PVector4f = nil; intersectNormal: PVector4f = nil): Boolean; var locRayStart, locRayVector: TVector4f; @@ -6494,7 +6491,7 @@ function TgxFreeForm.OctreeSphereSweepIntersect(const rayStart, rayVector: TVect end; end; -function TgxFreeForm.OctreeTriangleIntersect(const v1, v2, v3: TAffineVector): Boolean; +function TGXFreeForm.OctreeTriangleIntersect(const v1, v2, v3: TAffineVector): Boolean; var t1, t2, t3: TAffineVector; begin @@ -6506,7 +6503,7 @@ function TgxFreeForm.OctreeTriangleIntersect(const v1, v2, v3: TAffineVector): B Result := Octree.TriangleIntersect(t1, t2, t3); end; -function TgxFreeForm.OctreeAABBIntersect(const aabb: TAABB; objMatrix, invObjMatrix: TMatrix4f; +function TGXFreeForm.OctreeAABBIntersect(const aabb: TAABB; objMatrix, invObjMatrix: TMatrix4f; triangles: TGAffineVectorList = nil): Boolean; var m1to2, m2to1: TMatrix4f; @@ -6523,54 +6520,54 @@ function TgxFreeForm.OctreeAABBIntersect(const aabb: TAABB; objMatrix, invObjMat end; // ------------------ -// ------------------ TgxActorAnimation ------------------ +// ------------------ TGXActorAnimation ------------------ // ------------------ -constructor TgxActorAnimation.Create(Collection: TCollection); +constructor TGXActorAnimation.Create(Collection: TCollection); begin inherited Create(Collection); end; -destructor TgxActorAnimation.Destroy; +destructor TGXActorAnimation.Destroy; begin - with (Collection as TgxActorAnimations).FOwner do + with (Collection as TGXActorAnimations).FOwner do if FTargetSmoothAnimation = Self then FTargetSmoothAnimation := nil; inherited Destroy; end; -procedure TgxActorAnimation.Assign(Source: TPersistent); +procedure TGXActorAnimation.Assign(Source: TPersistent); begin - if Source is TgxActorAnimation then + if Source is TGXActorAnimation then begin - FName := TgxActorAnimation(Source).FName; - FStartFrame := TgxActorAnimation(Source).FStartFrame; - FEndFrame := TgxActorAnimation(Source).FEndFrame; - FReference := TgxActorAnimation(Source).FReference; + FName := TGXActorAnimation(Source).FName; + FStartFrame := TGXActorAnimation(Source).FStartFrame; + FEndFrame := TGXActorAnimation(Source).FEndFrame; + FReference := TGXActorAnimation(Source).FReference; end else inherited; end; -function TgxActorAnimation.GetDisplayName: string; +function TGXActorAnimation.GetDisplayName: string; begin Result := Format('%d - %s [%d - %d]', [Index, Name, startFrame, endFrame]); end; -function TgxActorAnimation.FrameCount: Integer; +function TGXActorAnimation.FrameCount: Integer; begin case reference of aarMorph: - Result := TgxActorAnimations(Collection).FOwner.MeshObjects.MorphTargetCount; + Result := TGXActorAnimations(Collection).FOwner.MeshObjects.MorphTargetCount; aarSkeleton: - Result := TgxActorAnimations(Collection).FOwner.Skeleton.Frames.Count; + Result := TGXActorAnimations(Collection).FOwner.Skeleton.Frames.Count; else Result := 0; Assert(False); end; end; -procedure TgxActorAnimation.SetStartFrame(const val: Integer); +procedure TGXActorAnimation.SetStartFrame(const val: Integer); var m: Integer; begin @@ -6588,7 +6585,7 @@ procedure TgxActorAnimation.SetStartFrame(const val: Integer); FEndFrame := FStartFrame; end; -procedure TgxActorAnimation.SetEndFrame(const val: Integer); +procedure TGXActorAnimation.SetEndFrame(const val: Integer); var m: Integer; begin @@ -6606,7 +6603,7 @@ procedure TgxActorAnimation.SetEndFrame(const val: Integer); FStartFrame := FEndFrame; end; -procedure TgxActorAnimation.SetReference(val: TgxActorAnimationReference); +procedure TGXActorAnimation.SetReference(val: TGXActorAnimationReference); begin if val <> FReference then begin @@ -6616,7 +6613,7 @@ procedure TgxActorAnimation.SetReference(val: TgxActorAnimationReference); end; end; -procedure TgxActorAnimation.SetAsString(const val: string); +procedure TGXActorAnimation.SetAsString(const val: string); var sl: TStringList; begin @@ -6643,72 +6640,72 @@ procedure TgxActorAnimation.SetAsString(const val: string); end; end; -function TgxActorAnimation.GetAsString: string; +function TGXActorAnimation.GetAsString: string; const cAARToString: array [aarMorph .. aarSkeleton] of string = ('morph', 'skeleton'); begin Result := Format('"%s",%d,%d,%s', [FName, FStartFrame, FEndFrame, cAARToString[reference]]); end; -function TgxActorAnimation.OwnerActor: TgxActor; +function TGXActorAnimation.OwnerActor: TGXActor; begin - Result := ((Collection as TgxActorAnimations).GetOwner as TgxActor); + Result := ((Collection as TGXActorAnimations).GetOwner as TGXActor); end; -procedure TgxActorAnimation.MakeSkeletalTranslationStatic; +procedure TGXActorAnimation.MakeSkeletalTranslationStatic; begin OwnerActor.Skeleton.MakeSkeletalTranslationStatic(startFrame, endFrame); end; -procedure TgxActorAnimation.MakeSkeletalRotationDelta; +procedure TGXActorAnimation.MakeSkeletalRotationDelta; begin OwnerActor.Skeleton.MakeSkeletalRotationDelta(startFrame, endFrame); end; // ------------------ -// ------------------ TgxActorAnimations ------------------ +// ------------------ TGXActorAnimations ------------------ // ------------------ -constructor TgxActorAnimations.Create(aOwner: TgxActor); +constructor TGXActorAnimations.Create(aOwner: TGXActor); begin FOwner := aOwner; - inherited Create(TgxActorAnimation); + inherited Create(TGXActorAnimation); end; -function TgxActorAnimations.GetOwner: TPersistent; +function TGXActorAnimations.GetOwner: TPersistent; begin Result := FOwner; end; -procedure TgxActorAnimations.SetItems(Index: Integer; const val: TgxActorAnimation); +procedure TGXActorAnimations.SetItems(Index: Integer; const val: TGXActorAnimation); begin inherited Items[index] := val; end; -function TgxActorAnimations.GetItems(Index: Integer): TgxActorAnimation; +function TGXActorAnimations.GetItems(Index: Integer): TGXActorAnimation; begin - Result := TgxActorAnimation(inherited Items[index]); + Result := TGXActorAnimation(inherited Items[index]); end; -function TgxActorAnimations.Last: TgxActorAnimation; +function TGXActorAnimations.Last: TGXActorAnimation; begin if Count > 0 then - Result := TgxActorAnimation(inherited Items[Count - 1]) + Result := TGXActorAnimation(inherited Items[Count - 1]) else Result := nil; end; -function TgxActorAnimations.Add: TgxActorAnimation; +function TGXActorAnimations.Add: TGXActorAnimation; begin - Result := (inherited Add) as TgxActorAnimation; + Result := (inherited Add) as TGXActorAnimation; end; -function TgxActorAnimations.FindItemID(ID: Integer): TgxActorAnimation; +function TGXActorAnimations.FindItemID(ID: Integer): TGXActorAnimation; begin - Result := (inherited FindItemID(ID)) as TgxActorAnimation; + Result := (inherited FindItemID(ID)) as TGXActorAnimation; end; -function TgxActorAnimations.FindName(const aName: string): TgxActorAnimation; +function TGXActorAnimations.FindName(const aName: string): TGXActorAnimation; var i: Integer; begin @@ -6721,7 +6718,7 @@ function TgxActorAnimations.FindName(const aName: string): TgxActorAnimation; end; end; -function TgxActorAnimations.FindFrame(aFrame: Integer; aReference: TgxActorAnimationReference): TgxActorAnimation; +function TGXActorAnimations.FindFrame(aFrame: Integer; aReference: TGXActorAnimationReference): TGXActorAnimation; var i: Integer; begin @@ -6735,7 +6732,7 @@ function TgxActorAnimations.FindFrame(aFrame: Integer; aReference: TgxActorAnima end; end; -procedure TgxActorAnimations.SetToStrings(aStrings: TStrings); +procedure TGXActorAnimations.SetToStrings(aStrings: TStrings); var i: Integer; @@ -6750,7 +6747,7 @@ procedure TgxActorAnimations.SetToStrings(aStrings: TStrings); end; end; -procedure TgxActorAnimations.SaveToStream(aStream: TStream); +procedure TGXActorAnimations.SaveToStream(aStream: TStream); var i: Integer; begin @@ -6760,7 +6757,7 @@ procedure TgxActorAnimations.SaveToStream(aStream: TStream); WriteCRLFString(aStream, AnsiString(Items[i].AsString)); end; -procedure TgxActorAnimations.LoadFromStream(aStream: TStream); +procedure TGXActorAnimations.LoadFromStream(aStream: TStream); var i, n: Integer; begin @@ -6772,7 +6769,7 @@ procedure TgxActorAnimations.LoadFromStream(aStream: TStream); Add.AsString := string(ReadCRLFString(aStream)); end; -procedure TgxActorAnimations.SaveToFile(const filename: string); +procedure TGXActorAnimations.SaveToFile(const filename: string); var fs: TStream; begin @@ -6784,7 +6781,7 @@ procedure TgxActorAnimations.SaveToFile(const filename: string); end; end; -procedure TgxActorAnimations.LoadFromFile(const filename: string); +procedure TGXActorAnimations.LoadFromFile(const filename: string); var fs: TStream; begin @@ -6797,35 +6794,35 @@ procedure TgxActorAnimations.LoadFromFile(const filename: string); end; // ------------------ -// ------------------ TgxBaseAnimationControler ------------------ +// ------------------ TGXBaseAnimationControler ------------------ // ------------------ -constructor TgxBaseAnimationControler.Create(aOwner: TComponent); +constructor TGXBaseAnimationControler.Create(aOwner: TComponent); begin inherited Create(aOwner); FEnabled := True; end; -destructor TgxBaseAnimationControler.Destroy; +destructor TGXBaseAnimationControler.Destroy; begin SetActor(nil); inherited Destroy; end; -procedure TgxBaseAnimationControler.Notification(AComponent: TComponent; Operation: TOperation); +procedure TGXBaseAnimationControler.Notification(AComponent: TComponent; Operation: TOperation); begin if (AComponent = FActor) and (Operation = opRemove) then SetActor(nil); inherited; end; -procedure TgxBaseAnimationControler.DoChange; +procedure TGXBaseAnimationControler.DoChange; begin if Assigned(FActor) then FActor.NotifyChange(Self); end; -procedure TgxBaseAnimationControler.SetEnabled(const val: Boolean); +procedure TGXBaseAnimationControler.SetEnabled(const val: Boolean); begin if val <> FEnabled then begin @@ -6835,7 +6832,7 @@ procedure TgxBaseAnimationControler.SetEnabled(const val: Boolean); end; end; -procedure TgxBaseAnimationControler.SetActor(const val: TgxActor); +procedure TGXBaseAnimationControler.SetActor(const val: TGXActor); begin if FActor <> val then begin @@ -6850,23 +6847,23 @@ procedure TgxBaseAnimationControler.SetActor(const val: TgxActor); end; end; -function TgxBaseAnimationControler.Apply(var lerpInfo: TgxBlendedLerpInfo): Boolean; +function TGXBaseAnimationControler.Apply(var lerpInfo: TGXBlendedLerpInfo): Boolean; begin // virtual Result := False; end; // ------------------ -// ------------------ TgxAnimationControler ------------------ +// ------------------ TGXAnimationControler ------------------ // ------------------ -procedure TgxAnimationControler.DoChange; +procedure TGXAnimationControler.DoChange; begin if AnimationName <> '' then inherited; end; -procedure TgxAnimationControler.SetAnimationName(const val: TgxActorAnimationName); +procedure TGXAnimationControler.SetAnimationName(const val: TGXActorAnimationName); begin if FAnimationName <> val then begin @@ -6875,7 +6872,7 @@ procedure TgxAnimationControler.SetAnimationName(const val: TgxActorAnimationNam end; end; -procedure TgxAnimationControler.SetRatio(const val: Single); +procedure TGXAnimationControler.SetRatio(const val: Single); begin if FRatio <> val then begin @@ -6884,9 +6881,9 @@ procedure TgxAnimationControler.SetRatio(const val: Single); end; end; -function TgxAnimationControler.Apply(var lerpInfo: TgxBlendedLerpInfo): Boolean; +function TGXAnimationControler.Apply(var lerpInfo: TGXBlendedLerpInfo): Boolean; var - anim: TgxActorAnimation; + anim: TGXActorAnimation; baseDelta: Integer; begin if not Enabled then @@ -6929,40 +6926,40 @@ function TgxAnimationControler.Apply(var lerpInfo: TgxBlendedLerpInfo): Boolean; end; // ------------------ -// ------------------ TgxActor ------------------ +// ------------------ TGXActor ------------------ // ------------------ -constructor TgxActor.Create(aOwner: TComponent); +constructor TGXActor.Create(aOwner: TComponent); begin inherited Create(aOwner); ObjectStyle := ObjectStyle + [osDirectDraw]; FFrameInterpolation := afpLinear; FAnimationMode := aamNone; FInterval := 100; // 10 animation frames per second - FAnimations := TgxActorAnimations.Create(Self); + FAnimations := TGXActorAnimations.Create(Self); FControlers := nil; // created on request FOptions := cDefaultActorOptions; end; -destructor TgxActor.Destroy; +destructor TGXActor.Destroy; begin inherited Destroy; FControlers.Free; FAnimations.Free; end; -procedure TgxActor.Assign(Source: TPersistent); +procedure TGXActor.Assign(Source: TPersistent); begin inherited Assign(Source); - if Source is TgxActor then + if Source is TGXActor then begin - FAnimations.Assign(TgxActor(Source).FAnimations); - FAnimationMode := TgxActor(Source).FAnimationMode; - Synchronize(TgxActor(Source)); + FAnimations.Assign(TGXActor(Source).FAnimations); + FAnimationMode := TGXActor(Source).FAnimationMode; + Synchronize(TGXActor(Source)); end; end; -procedure TgxActor.RegisterControler(aControler: TgxBaseAnimationControler); +procedure TGXActor.RegisterControler(aControler: TGXBaseAnimationControler); begin if not Assigned(FControlers) then FControlers := TList.Create; @@ -6970,7 +6967,7 @@ procedure TgxActor.RegisterControler(aControler: TgxBaseAnimationControler); FreeNotification(aControler); end; -procedure TgxActor.UnRegisterControler(aControler: TgxBaseAnimationControler); +procedure TGXActor.UnRegisterControler(aControler: TGXBaseAnimationControler); begin Assert(Assigned(FControlers)); FControlers.Remove(aControler); @@ -6979,7 +6976,7 @@ procedure TgxActor.UnRegisterControler(aControler: TgxBaseAnimationControler); FreeAndNil(FControlers); end; -procedure TgxActor.SetCurrentFrame(val: Integer); +procedure TGXActor.SetCurrentFrame(val: Integer); begin if val <> CurrentFrame then begin @@ -7007,12 +7004,12 @@ procedure TgxActor.SetCurrentFrame(val: Integer); end; end; -procedure TgxActor.SetCurrentFrameDirect(const Value: Integer); +procedure TGXActor.SetCurrentFrameDirect(const Value: Integer); begin FCurrentFrame := Value; end; -procedure TgxActor.SetStartFrame(val: Integer); +procedure TGXActor.SetStartFrame(val: Integer); begin if (val >= 0) and (val < FrameCount) and (val <> startFrame) then FStartFrame := val; @@ -7022,7 +7019,7 @@ procedure TgxActor.SetStartFrame(val: Integer); CurrentFrame := FStartFrame; end; -procedure TgxActor.SetEndFrame(val: Integer); +procedure TGXActor.SetEndFrame(val: Integer); begin if (val >= 0) and (val < FrameCount) and (val <> endFrame) then FEndFrame := val; @@ -7030,7 +7027,7 @@ procedure TgxActor.SetEndFrame(val: Integer); CurrentFrame := FEndFrame; end; -procedure TgxActor.SetReference(val: TgxActorAnimationReference); +procedure TGXActor.SetReference(val: TGXActorAnimationReference); begin if val <> reference then begin @@ -7042,17 +7039,17 @@ procedure TgxActor.SetReference(val: TgxActorAnimationReference); end; end; -procedure TgxActor.SetAnimations(const val: TgxActorAnimations); +procedure TGXActor.SetAnimations(const val: TGXActorAnimations); begin FAnimations.Assign(val); end; -function TgxActor.StoreAnimations: Boolean; +function TGXActor.StoreAnimations: Boolean; begin Result := (FAnimations.Count > 0); end; -procedure TgxActor.SetOptions(const val: TgxActorOptions); +procedure TGXActor.SetOptions(const val: TgxActorOptions); begin if val <> FOptions then begin @@ -7061,7 +7058,7 @@ procedure TgxActor.SetOptions(const val: TgxActorOptions); end; end; -function TgxActor.NextFrameIndex: Integer; +function TGXActor.NextFrameIndex: Integer; begin case AnimationMode of aamLoop, aamBounceForward: @@ -7113,7 +7110,7 @@ function TgxActor.NextFrameIndex: Integer; end; end; -procedure TgxActor.NextFrame(nbSteps: Integer = 1); +procedure TGXActor.NextFrame(nbSteps: Integer = 1); var n: Integer; begin @@ -7129,7 +7126,7 @@ procedure TgxActor.NextFrame(nbSteps: Integer = 1); end; end; -procedure TgxActor.PrevFrame(nbSteps: Integer = 1); +procedure TGXActor.PrevFrame(nbSteps: Integer = 1); var Value: Integer; begin @@ -7143,11 +7140,11 @@ procedure TgxActor.PrevFrame(nbSteps: Integer = 1); CurrentFrame := Value; end; -procedure TgxActor.DoAnimate(); +procedure TGXActor.DoAnimate(); var i, k: Integer; nextFrameIdx: Integer; - lerpInfos: array of TgxBlendedLerpInfo; + lerpInfos: array of TGXBlendedLerpInfo; begin nextFrameIdx := NextFrameIndex; case reference of @@ -7201,7 +7198,7 @@ procedure TgxActor.DoAnimate(); end; k := 1; for i := 0 to FControlers.Count - 1 do - if TgxBaseAnimationControler(FControlers[i]).Apply(lerpInfos[k]) then + if TGXBaseAnimationControler(FControlers[i]).Apply(lerpInfos[k]) then Inc(k); SetLength(lerpInfos, k); Skeleton.BlendedLerps(lerpInfos); @@ -7223,7 +7220,7 @@ procedure TgxActor.DoAnimate(); end; end; -procedure TgxActor.BuildList(var rci: TgxRenderContextInfo); +procedure TGXActor.BuildList(var rci: TgxRenderContextInfo); begin DoAnimate; inherited; @@ -7234,7 +7231,7 @@ procedure TgxActor.BuildList(var rci: TgxRenderContextInfo); end; end; -procedure TgxActor.PrepareMesh; +procedure TGXActor.PrepareMesh; begin FStartFrame := 0; FEndFrame := FrameCount - 1; @@ -7244,12 +7241,12 @@ procedure TgxActor.PrepareMesh; inherited; end; -procedure TgxActor.PrepareBuildList(var mrci: TgxRenderContextInfo); +procedure TGXActor.PrepareBuildList(var mrci: TgxRenderContextInfo); begin // no preparation needed for actors, they don't use buildlists end; -function TgxActor.FrameCount: Integer; +function TGXActor.FrameCount: Integer; begin case reference of aarMorph: @@ -7264,7 +7261,7 @@ function TgxActor.FrameCount: Integer; end; end; -procedure TgxActor.DoProgress(const progressTime: TGProgressTimes); +procedure TGXActor.DoProgress(const progressTime: TGProgressTimes); var fDelta: Single; begin @@ -7293,7 +7290,7 @@ procedure TgxActor.DoProgress(const progressTime: TGProgressTimes); end; end; -procedure TgxActor.LoadFromStream(const filename: string; aStream: TStream); +procedure TGXActor.LoadFromStream(const filename: string; aStream: TStream); begin if filename <> '' then begin @@ -7302,18 +7299,18 @@ procedure TgxActor.LoadFromStream(const filename: string; aStream: TStream); end; end; -procedure TgxActor.SwitchToAnimation(const AnimationName: string; smooth: Boolean = False); +procedure TGXActor.SwitchToAnimation(const AnimationName: string; smooth: Boolean = False); begin SwitchToAnimation(Animations.FindName(AnimationName), smooth); end; -procedure TgxActor.SwitchToAnimation(animationIndex: Integer; smooth: Boolean = False); +procedure TGXActor.SwitchToAnimation(animationIndex: Integer; smooth: Boolean = False); begin if (animationIndex >= 0) and (animationIndex < Animations.Count) then SwitchToAnimation(Animations[animationIndex], smooth); end; -procedure TgxActor.SwitchToAnimation(anAnimation: TgxActorAnimation; smooth: Boolean = False); +procedure TGXActor.SwitchToAnimation(anAnimation: TGXActorAnimation; smooth: Boolean = False); begin if Assigned(anAnimation) then begin @@ -7332,9 +7329,9 @@ procedure TgxActor.SwitchToAnimation(anAnimation: TgxActorAnimation; smooth: Boo end; end; -function TgxActor.CurrentAnimation: string; +function TGXActor.CurrentAnimation: string; var - aa: TgxActorAnimation; + aa: TGXActorAnimation; begin aa := Animations.FindFrame(CurrentFrame, reference); if Assigned(aa) then @@ -7343,7 +7340,7 @@ function TgxActor.CurrentAnimation: string; Result := ''; end; -procedure TgxActor.Synchronize(referenceActor: TgxActor); +procedure TGXActor.Synchronize(referenceActor: TGXActor); begin if Assigned(referenceActor) then begin @@ -7366,7 +7363,7 @@ procedure TgxActor.Synchronize(referenceActor: TgxActor); end; end; -function TgxActor.isSwitchingAnimation: Boolean; +function TGXActor.isSwitchingAnimation: Boolean; begin Result := FTargetSmoothAnimation <> nil; end; @@ -7376,11 +7373,11 @@ initialization // ------------------------------------------------------------------ -RegisterVectorFileFormat('glsm', 'GXScene Mesh', TgxGLSMVectorFile); +RegisterVectorFileFormat('glsm', 'GXScene Mesh', TGXVectorFileGLSM); -RegisterClasses([TgxFreeForm, TgxActor, TgxSkeleton, TgxSkeletonFrame, TgxSkeletonBone, TgxSkeletonMeshObject, TgxMeshObject, - TgxSkeletonFrameList, TgxMeshMorphTarget, TgxMorphableMeshObject, TgxFaceGroup, TfgxVertexIndexList, - TFGVertexNormalTexIndexList, TgxAnimationControler, TFGIndexTexCoordList, TgxSkeletonCollider, TgxSkeletonColliderList]); +RegisterClasses([TGXFreeForm, TGXActor, TGXSkeleton, TGXSkeletonFrame, TGXSkeletonBone, TGXSkeletonMeshObject, TGXMeshObject, + TGXSkeletonFrameList, TGXMeshMorphTarget, TGXMorphableMeshObject, TGXFaceGroup, TFGXVertexIndexList, + TFGVertexNormalTexIndexList, TGXAnimationControler, TFGIndexTexCoordList, TGXSkeletonCollider, TGXSkeletonColliderList]); finalization diff --git a/Sourcex/GXS.VerletClothify.pas b/Sourcex/GXS.VerletClothify.pas index 3f98675d..1abdbd5b 100644 --- a/Sourcex/GXS.VerletClothify.pas +++ b/Sourcex/GXS.VerletClothify.pas @@ -3,7 +3,7 @@ // unit GXS.VerletClothify; -(* Methods for turning a TgxBaseMesh into a Verlet cloth / jelly *) +(* Methods for turning a TGXBaseMesh into a Verlet cloth / jelly *) interface @@ -33,10 +33,10 @@ TFace = class public Vertices : array[0..2] of integer; Normal : TAffineVector; - MeshObject : TgxMeshObject; + MeshObject : TGXMeshObject; Active : boolean; procedure UpdateNormal; - constructor Create(aMeshObject : TgxMeshObject); + constructor Create(aMeshObject : TGXMeshObject); end; { List of faces } @@ -52,25 +52,25 @@ TFaceList = class(TList) TFaceExtractor = class private FFaceList : TFaceList; - FGLBaseMesh : TgxBaseMesh; + FGLBaseMesh : TGXBaseMesh; FNodeList : TgxVerletNodeList; FWeldDistance: single; FEdgeDoublesSkipped : integer; procedure SetWeldDistance(const Value: single); protected - procedure ProcessMeshObject(const MeshObject : TgxMeshObject); virtual; + procedure ProcessMeshObject(const MeshObject : TGXMeshObject); virtual; public procedure ExtractFacesFromVertexIndexList( - const FaceGroup : TfgxVertexIndexList; const MeshObject : TgxMeshObject); + const FaceGroup : TFGXVertexIndexList; const MeshObject : TGXMeshObject); property FaceList : TFaceList read FFaceList; procedure Clear; virtual; procedure ProcessMesh; virtual; property WeldDistance : single read FWeldDistance write SetWeldDistance; property EdgeDoublesSkipped : integer read FEdgeDoublesSkipped; - property GLBaseMesh : TgxBaseMesh read FGLBaseMesh; + property GLBaseMesh : TGXBaseMesh read FGLBaseMesh; property NodeList : TgxVerletNodeList read FNodeList; - function AddFace(const Vi0, Vi1, Vi2 : integer; const MeshObject : TgxMeshObject) : TFace; virtual; - constructor Create(const aGLBaseMesh : TgxBaseMesh); virtual; + function AddFace(const Vi0, Vi1, Vi2 : integer; const MeshObject : TGXMeshObject) : TFace; virtual; + constructor Create(const aGLBaseMesh : TGXBaseMesh); virtual; destructor Destroy; override; end; @@ -80,19 +80,19 @@ TEdge = class private FSolid: boolean; FLength: single; - FMeshObject: TgxMeshObject; + FMeshObject: TGXMeshObject; FOwner: TEdgeDetector; public Vertices : array[0..1] of integer; Faces : array[0..1] of TFace; procedure Contract; property Owner : TEdgeDetector read FOwner; - property MeshObject : TgxMeshObject read FMeshObject write FMeshObject; + property MeshObject : TGXMeshObject read FMeshObject write FMeshObject; property Length : single read FLength write FLength; property Solid : boolean read FSolid write FSolid; procedure UpdateEdgeLength; constructor Create(const AOwner: TEdgeDetector; AVi0, AVi1 : integer; - AFace0, AFace1 : TFace; AMeshObject : TgxMeshObject; ASolid : boolean); + AFace0, AFace1 : TFace; AMeshObject : TGXMeshObject; ASolid : boolean); end; TEdgeList = class(TList) @@ -117,9 +117,9 @@ TEdgeDetector = class(TFaceExtractor) property EdgeList : TEdgeList read FEdgeList; procedure Clear; override; procedure ProcessMesh; override; - function AddEdge(const Vi0, Vi1 : integer; const Face : TFace; const AMeshObject : TgxMeshObject) : TEdge; - function AddFace(const Vi0, Vi1, Vi2 : integer; const MeshObject : TgxMeshObject) : TFace; override; - function AddNode(const VerletWorld : TgxVerletWorld; const MeshObject : TgxMeshObject; const VertexIndex : integer) : TgxVerletNode; virtual; + function AddEdge(const Vi0, Vi1 : integer; const Face : TFace; const AMeshObject : TGXMeshObject) : TEdge; + function AddFace(const Vi0, Vi1, Vi2 : integer; const MeshObject : TGXMeshObject) : TFace; override; + function AddNode(const VerletWorld : TgxVerletWorld; const MeshObject : TGXMeshObject; const VertexIndex : integer) : TgxVerletNode; virtual; procedure AddNodes(const VerletWorld : TgxVerletWorld); procedure AddEdgesAsSticks(const VerletWorld : TgxVerletWorld; const Slack : single); procedure AddEdgesAsSprings(const VerletWorld : TgxVerletWorld; const Strength, Damping, Slack : single); @@ -129,13 +129,13 @@ TEdgeDetector = class(TFaceExtractor) property CurrentNodeOffset : integer read FCurrentNodeOffset; property NodesAdded : boolean read FNodesAdded; procedure ReplaceVertexIndex(const ViRemove, ViReplaceWith : integer); - constructor Create(const aGLBaseMesh : TgxBaseMesh); override; + constructor Create(const aGLBaseMesh : TGXBaseMesh); override; destructor Destroy; override; end; TgxMeshObjectVerletNode = class(TgxVerletNode) private - MeshObject : TgxMeshObject; + MeshObject : TGXMeshObject; VertexIndices : TGIntegerList; public procedure AfterProgress; override; @@ -163,7 +163,7 @@ procedure TFaceExtractor.Clear; FaceList.Clear; end; -constructor TFaceExtractor.Create(const aGLBaseMesh : TgxBaseMesh); +constructor TFaceExtractor.Create(const aGLBaseMesh : TGXBaseMesh); begin FFaceList := TFaceList.Create; FGLBaseMesh := aGLBaseMesh; @@ -180,7 +180,7 @@ destructor TFaceExtractor.Destroy; end; procedure TFaceExtractor.ExtractFacesFromVertexIndexList( - const FaceGroup : TfgxVertexIndexList; const MeshObject : TgxMeshObject); + const FaceGroup : TFGXVertexIndexList; const MeshObject : TGXMeshObject); var List : PIntegerArray; iFace, iVertex : integer; @@ -223,7 +223,7 @@ procedure TFaceExtractor.ExtractFacesFromVertexIndexList( procedure TFaceExtractor.ProcessMesh; var iMeshObject : integer; - MeshObject : TgxMeshObject; + MeshObject : TGXMeshObject; begin for iMeshObject := 0 to FGLBaseMesh.MeshObjects.Count - 1 do begin @@ -233,7 +233,7 @@ procedure TFaceExtractor.ProcessMesh; end; end; -procedure TFaceExtractor.ProcessMeshObject(const MeshObject : TgxMeshObject); +procedure TFaceExtractor.ProcessMeshObject(const MeshObject : TGXMeshObject); var iFaceGroup : integer; begin @@ -241,9 +241,9 @@ procedure TFaceExtractor.ProcessMeshObject(const MeshObject : TgxMeshObject); begin for iFaceGroup := 0 to MeshObject.FaceGroups.Count - 1 do begin - if MeshObject.FaceGroups[iFaceGroup] is TfgxVertexIndexList then + if MeshObject.FaceGroups[iFaceGroup] is TFGXVertexIndexList then begin - ExtractFacesFromVertexIndexList(MeshObject.FaceGroups[iFaceGroup] as TfgxVertexIndexList, MeshObject); + ExtractFacesFromVertexIndexList(MeshObject.FaceGroups[iFaceGroup] as TFGXVertexIndexList, MeshObject); end else Assert(false); end; @@ -251,7 +251,7 @@ procedure TFaceExtractor.ProcessMeshObject(const MeshObject : TgxMeshObject); Assert(false); end; -function TFaceExtractor.AddFace(const Vi0, Vi1, Vi2: integer; const MeshObject : TgxMeshObject) : TFace; +function TFaceExtractor.AddFace(const Vi0, Vi1, Vi2: integer; const MeshObject : TGXMeshObject) : TFace; var Face : TFace; begin @@ -374,7 +374,7 @@ procedure TEdgeDetector.Clear; FNodesAdded := false; end; -constructor TEdgeDetector.Create(const aGLBaseMesh: TgxBaseMesh); +constructor TEdgeDetector.Create(const aGLBaseMesh: TGXBaseMesh); begin FEdgeList := TEdgeList.Create; FCurrentNodeOffset := 0; @@ -389,7 +389,7 @@ destructor TEdgeDetector.Destroy; FreeAndNil(FEdgeList); end; -function TEdgeDetector.AddEdge(const Vi0, Vi1: integer; const Face: TFace; const AMeshObject : TgxMeshObject): TEdge; +function TEdgeDetector.AddEdge(const Vi0, Vi1: integer; const Face: TFace; const AMeshObject : TGXMeshObject): TEdge; var i : integer; Edge : TEdge; @@ -413,7 +413,7 @@ function TEdgeDetector.AddEdge(const Vi0, Vi1: integer; const Face: TFace; const end; function TEdgeDetector.AddFace(const Vi0, Vi1, Vi2: integer; - const MeshObject: TgxMeshObject): TFace; + const MeshObject: TGXMeshObject): TFace; var Face : TFace; begin @@ -431,7 +431,7 @@ function TEdgeDetector.AddFace(const Vi0, Vi1, Vi2: integer; procedure TEdgeDetector.AddNodes(const VerletWorld : TgxVerletWorld); var i : integer; - MO : TgxMeshObject; + MO : TGXMeshObject; begin FNodesAdded := true; FCurrentNodeOffset := FNodeList.Count; @@ -612,7 +612,7 @@ procedure TEdgeDetector.BuildOpposingEdges; end; end; -function TEdgeDetector.AddNode(const VerletWorld : TgxVerletWorld; const MeshObject: TgxMeshObject; +function TEdgeDetector.AddNode(const VerletWorld : TgxVerletWorld; const MeshObject: TGXMeshObject; const VertexIndex: integer): TgxVerletNode; var Location : TAffineVector; @@ -704,7 +704,7 @@ procedure TEdgeDetector.ReplaceVertexIndex(const ViRemove, // TFace //---------------------------------------- -constructor TFace.Create(aMeshObject: TgxMeshObject); +constructor TFace.Create(aMeshObject: TGXMeshObject); begin MeshObject := aMeshObject; Active := true; @@ -731,7 +731,7 @@ procedure TEdge.Contract; end; constructor TEdge.Create(const AOwner: TEdgeDetector; AVi0, AVi1 : integer; - AFace0, AFace1 : TFace; AMeshObject : TgxMeshObject; ASolid : boolean); + AFace0, AFace1 : TFace; AMeshObject : TGXMeshObject; ASolid : boolean); begin FOwner := AOwner; Vertices[0] := AVi0; diff --git a/Sourcex/GXS.VerletTypes.pas b/Sourcex/GXS.VerletTypes.pas index 916ed8ca..3bc02384 100644 --- a/Sourcex/GXS.VerletTypes.pas +++ b/Sourcex/GXS.VerletTypes.pas @@ -668,7 +668,7 @@ TgxVerletHair = class end; // Base Verlet Skeleton Collider class. - TgxVerletSkeletonCollider = class(TgxSkeletonCollider) + TgxVerletSkeletonCollider = class(TGXSkeletonCollider) private FVerletConstraint: TgxVerletConstraint; public @@ -714,7 +714,7 @@ TgxVerletCapsule = class(TgxVerletSkeletonCollider) (* After loading call this function to add all the constraints in a skeleton collider list to a given verlet world. *) procedure AddVerletConstriantsToVerletWorld - (Colliders: TgxSkeletonColliderList; World: TgxVerletWorld); + (Colliders: TGXSkeletonColliderList; World: TgxVerletWorld); function CreateVerletPlaneFromGLPlane(Plane: TgxPlane; VerletWorld: TgxVerletWorld; Offset: Single): TgxVerletFloor; @@ -2598,7 +2598,7 @@ procedure TgxVerletHair.SetStiffness(const Value: TgxStiffnessSetVH); // ------------------ procedure AddVerletConstriantsToVerletWorld - (Colliders: TgxSkeletonColliderList; World: TgxVerletWorld); + (Colliders: TGXSkeletonColliderList; World: TgxVerletWorld); var i: Integer; begin diff --git a/Sourcex/GXS.ViewerOpenGL.pas b/Sourcex/GXS.ViewerOpenGL.pas index a44c01be..71cbf685 100644 --- a/Sourcex/GXS.ViewerOpenGL.pas +++ b/Sourcex/GXS.ViewerOpenGL.pas @@ -27,7 +27,7 @@ interface GXS.Scene, GXS.Context, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.WinContext; type diff --git a/Sourcex/GXS.XCollection.pas b/Sourcex/GXS.XCollection.pas deleted file mode 100644 index ee4c1949..00000000 --- a/Sourcex/GXS.XCollection.pas +++ /dev/null @@ -1,758 +0,0 @@ -// -// The graphics engine GXScene https://github.com/glscene -// -unit GXS.XCollection; - -(* A polymorphism-enabled TCollection-like set of classes *) - -interface - -{$I GLScene.Defines.inc} - -{.$DEFINE DEBUG_XCOLLECTION } // on define the most apps will not work - -uses - System.Classes, - System.SysUtils, - System.Types, - GLScene.Strings, - GLScene.PersistentClasses - {$IFDEF DEBUG_XCOLLECTION}, System.TypInfo {$ENDIF}; - -type - TXCollection = class; - - EFilerException = class(Exception) - end; - - (* Base class for implementing a XCollection item. - NOTES : - Don't forget to override the ReadFromFiler/WriteToFiler persistence - methods if you add data in a subclass ! - Subclasses must be registered using the RegisterXCollectionItemClass - function for proper operation *) - TXCollectionItem = class(TGInterfacedPersistent) - private - FOwner: TXCollection; - FName: string; - protected - function GetName: string; virtual; - procedure SetName(const val: String); virtual; - function GetOwner: TPersistent; override; - // Override this function to write subclass data - procedure WriteToFiler(writer: TWriter); virtual; - // Override this function to read subclass data - procedure ReadFromFiler(reader: TReader); virtual; - // Override to perform things when owner form has been loaded - procedure Loaded; dynamic; - // Triggers an EFilerException with appropriate version message - procedure RaiseFilerException(const archiveVersion: integer); - public - constructor Create(aOwner: TXCollection); virtual; - destructor Destroy; override; - function GetNamePath: string; override; - property Owner: TXCollection read FOwner; - // Default implementation uses WriteToFiler/ReadFromFiler - procedure Assign(Source: TPersistent); override; - procedure MoveUp; - procedure MoveDown; - function Index: integer; - (* Returns a user-friendly denomination for the class. - This denomination is used for picking a texture image class - in the IDE expert *) - class function FriendlyName: String; virtual; abstract; - (* Returns a user-friendly description for the class. - This denomination is used for helping the user when picking a - texture image class in the IDE expert. If it's not overriden, - takes its value from FriendlyName. *) - class function FriendlyDescription: String; virtual; - (* Category of the item class. - This is a free string, it will used by the XCollectionEditor to - regroup collectionitems and menu items *) - class function ItemCategory: string; virtual; - (* If true only one such XCollectionItem is allowed per BaseSceneObject. - Inheritance is accounted for UniqueXCollectionItem resolution, ie. - if TClassA is unique, and TClassB is a subclass of TClassA, - whatever the unicity of TClassB, TClassA and TClassB won't be allowed - to mix (since TClassB is a TClassA, and TClassA is unique). - Attempting to break the unicity rules will not be possible at - design-time (in Delphi IDE) and will trigger an exception at run-time. *) - class function UniqueItem: Boolean; virtual; - (* Allows the XCollectionItem class to determine if it should be allowed - to be added to the given collection. *) - class function CanAddTo(collection: TXCollection): Boolean; virtual; - published - property Name: string read FName write SetName; - end; - - TXCollectionItemClass = class of TXCollectionItem; - - (* Holds a list of TXCollectionItem objects. - This class looks a lot like a polymorphic-enabled TCollection, it is - a much stripped down version of a proprietary TObjectList, - if the copyrights are ever partially lifted - on the originals, I'll base this code on them since they are way faster - than VCL's lists and persistence mechanisms (and unlike VCL's, - with polymorphism-support and full backward compatibility). *) - TXCollection = class(TPersistent) - private - FOwner: TPersistent; - FList: TList; - FCount: integer; - // Archive Version is used to update the way data items is loaded - FArchiveVersion: integer; - protected - function GetItems(Index: integer): TXCollectionItem; - function GetOwner: TPersistent; override; - procedure ReadFromFiler(reader: TReader); - procedure WriteToFiler(writer: TWriter); - public - constructor Create(aOwner: TPersistent); virtual; - destructor Destroy; override; - procedure Assign(Source: TPersistent); override; - procedure Loaded; - property Owner: TPersistent read FOwner write FOwner; - function GetNamePath: string; override; - (* Class of the items. - Unlike TCollection, items can be of ItemsClass OR ANY of its - subclasses, ie. this function is used only for asserting your adding - objects of the right class, and not for persistence. *) - class function ItemsClass: TXCollectionItemClass; virtual; - property Items[index: integer]: TXCollectionItem read GetItems; default; - property Count: integer read FCount; - function Add(anItem: TXCollectionItem): integer; - function GetOrCreate(anItem: TXCollectionItemClass): TXCollectionItem; - procedure Delete(Index: integer); - procedure Remove(anItem: TXCollectionItem); - procedure Clear; - function IndexOf(anItem: TXCollectionItem): integer; - // Returns the index of the first XCollectionItem of the given class (or -1) - function IndexOfClass(aClass: TXCollectionItemClass): integer; - // Returns the first XCollection of the given class (or nil) - function GetByClass(aClass: TXCollectionItemClass): TXCollectionItem; - // Returns the index of the first XCollectionItem of the given name (or -1) - function IndexOfName(const aName: string): integer; - { Indicates if an object of the given class can be added. - This function is used to enforce Unique XCollection. } - function CanAdd(aClass: TXCollectionItemClass): Boolean; virtual; - property archiveVersion: integer read FArchiveVersion; - end; - -// Registers an event to be called when an XCollection is destroyed -procedure RegisterXCollectionDestroyEvent(notifyEvent: TNotifyEvent); -// DeRegisters event -procedure DeRegisterXCollectionDestroyEvent(notifyEvent: TNotifyEvent); -// Registers a TXCollectionItem subclass for persistence requirements -procedure RegisterXCollectionItemClass(aClass: TXCollectionItemClass); -// Removes a TXCollectionItem subclass from the list -procedure UnregisterXCollectionItemClass(aClass: TXCollectionItemClass); -// Retrieves a registered TXCollectionItemClass from its classname -function FindXCollectionItemClass(const ClassName: string): TXCollectionItemClass; -(* Creates and returns a copy of internal list of TXCollectionItem classes. - Returned list should be freed by caller, the parameter defines an ancestor - class filter. If baseClass is left nil, TXCollectionItem is used as ancestor. *) -function GetXCollectionItemClassesList(baseClass: TXCollectionItemClass = nil): TList; -procedure GetXCollectionClassesList(var ClassesList: TList; baseClass: TXCollectionItemClass = nil); - -// ------------------------------------------------------------------ -implementation -// ------------------------------------------------------------------ - -const - (* Magic is a workaround that will allow us to know when the archive - version is 0 (equivalent to : there is no ArchiveVersion stored in the DFM file) *) - MAGIC: array [0 .. 3] of AnsiChar = 'XCOL'; - -var - vXCollectionItemClasses: TList; - vXCollectionDestroyEvent: TNotifyEvent; - -(* - // Dummy method for CPP -class function TXCollectionItem.FriendlyName: String; -begin - result := ''; -end; -*) - -// ---------- internal global routines (used by xcollection editor) ------------- - -procedure RegisterXCollectionDestroyEvent(notifyEvent: TNotifyEvent); -begin - vXCollectionDestroyEvent := notifyEvent; -end; - -procedure DeRegisterXCollectionDestroyEvent(notifyEvent: TNotifyEvent); -begin - vXCollectionDestroyEvent := nil; -end; - -// ------------------------------------------------------------------------------ - -procedure RegisterXCollectionItemClass(aClass: TXCollectionItemClass); -begin - if not Assigned(vXCollectionItemClasses) then - vXCollectionItemClasses := TList.Create; - if vXCollectionItemClasses.IndexOf(aClass) < 0 then - vXCollectionItemClasses.Add(aClass); -end; - -procedure UnregisterXCollectionItemClass(aClass: TXCollectionItemClass); -begin - if not Assigned(vXCollectionItemClasses) then - exit; - if vXCollectionItemClasses.IndexOf(aClass) >= 0 then - vXCollectionItemClasses.Remove(aClass); -end; - -function FindXCollectionItemClass(const ClassName: String): TXCollectionItemClass; -var - i: integer; -begin - Result := nil; - if Assigned(vXCollectionItemClasses) then - for i := 0 to vXCollectionItemClasses.Count - 1 do - if TXCollectionItemClass(vXCollectionItemClasses[i]).ClassName = ClassName then - begin - Result := TXCollectionItemClass(vXCollectionItemClasses[i]); - Break; - end; -end; - -function GetXCollectionItemClassesList(baseClass: TXCollectionItemClass = nil): TList; -begin - result := TList.Create; - GetXCollectionClassesList(result, baseClass); -end; - -procedure GetXCollectionClassesList(var ClassesList: TList; baseClass: TXCollectionItemClass = nil); -var - i: integer; -begin - if not Assigned(baseClass) then - baseClass := TXCollectionItem; - if Assigned(vXCollectionItemClasses) then - for i := 0 to vXCollectionItemClasses.Count - 1 do - if TXCollectionItemClass(vXCollectionItemClasses[i]).InheritsFrom(baseClass) then - ClassesList.Add(vXCollectionItemClasses[i]); -end; - -// ------------------ -// ------------------ TXCollectionItem ------------------ -// ------------------ - -constructor TXCollectionItem.Create(aOwner: TXCollection); -begin - inherited Create; - FOwner := aOwner; - if Assigned(aOwner) then - begin - Assert(aOwner.CanAdd(TXCollectionItemClass(Self.ClassType)), - 'Addition of ' + Self.ClassName + ' to ' + aOwner.ClassName + ' rejected.'); - aOwner.FList.Add(Self); - aOwner.FCount := aOwner.FList.Count; - end; - FName:=FriendlyName; -end; - -destructor TXCollectionItem.Destroy; -begin - if Assigned(FOwner) then - begin - FOwner.FList.Remove(Self); - FOwner.FCount := FOwner.FList.Count; - end; - inherited Destroy; -end; - -procedure TXCollectionItem.Assign(Source: TPersistent); -begin - if Source is TXCollectionItem then - begin - FName := TXCollectionItem(Source).Name; - end - else - inherited Assign(Source); -end; - -procedure TXCollectionItem.SetName(const val: string); -begin - FName := val; -end; - -function TXCollectionItem.GetOwner: TPersistent; -begin - Result := FOwner; -end; - -procedure TXCollectionItem.WriteToFiler(writer: TWriter); -begin - with writer do - begin - WriteInteger(0); // Archive Version 0 - WriteString(FName); - end; -end; - -procedure TXCollectionItem.ReadFromFiler(reader: TReader); -{$IFOPT C+} -var - ver: integer; -{$ENDIF} -begin - with reader do - begin - {$IFOPT C+} - ver := ReadInteger; - Assert(ver = 0); - {$ENDIF} - FName := ReadString; - end; -end; - -procedure TXCollectionItem.Loaded; -begin - // does nothing by default -end; - -function TXCollectionItem.GetName: string; -begin - Result := FName; -end; - -function TXCollectionItem.GetNamePath: string; -begin - if FOwner <> nil then - result := Format('%s[%d]', [FOwner.GetNamePath, Index]) - else - result := inherited GetNamePath; -end; - -procedure TXCollectionItem.MoveUp; -var - i: integer; -begin - if Assigned(Owner) then - begin - i := Owner.FList.IndexOf(Self); - if i > 0 then - Owner.FList.Exchange(i, i - 1); - end; -end; - -procedure TXCollectionItem.MoveDown; -var - i: integer; -begin - if Assigned(Owner) then - begin - i := Owner.FList.IndexOf(Self); - if Cardinal(i) < Cardinal(Owner.FList.Count - 1) then - Owner.FList.Exchange(i, i + 1); - end; -end; - -function TXCollectionItem.Index: integer; -begin - if Assigned(Owner) then - Result := Owner.FList.IndexOf(Self) - else - Result := -1; -end; - -procedure TXCollectionItem.RaiseFilerException(const archiveVersion: integer); -begin - raise EFilerException.Create(ClassName + strUnknownArchiveVersion + - IntToStr(archiveVersion)); -end; - -class function TXCollectionItem.FriendlyDescription: string; -begin - Result:=FriendlyName; -end; - -class function TXCollectionItem.ItemCategory: string; -begin - Result:=''; -end; - -class function TXCollectionItem.UniqueItem: Boolean; -begin - Result:=False; -end; - -class function TXCollectionItem.CanAddTo(collection: TXCollection): Boolean; -begin - Result:=True; -end; - - -// ------------------ -// ------------------ TXCollection ------------------ -// ------------------ - -constructor TXCollection.Create(aOwner: TPersistent); -begin - inherited Create; - FOwner := aOwner; - FList := TList.Create; -end; - -destructor TXCollection.Destroy; -begin - if Assigned(vXCollectionDestroyEvent) then - vXCollectionDestroyEvent(Self); - Clear; - FList.Free; - inherited Destroy; -end; - -procedure TXCollection.Assign(Source: TPersistent); -var - i: integer; - srcItem, newItem: TXCollectionItem; -begin - if not Assigned(Source) then - begin - Clear; - end - else - if Source.ClassType = Self.ClassType then - begin - Clear; - FList.Capacity := TXCollection(Source).FList.Count; - for i := 0 to TXCollection(Source).Count - 1 do - begin - srcItem := TXCollectionItem(TXCollection(Source).FList[i]); - newItem := TXCollectionItemClass(srcItem.ClassType).Create(Self); - newItem.Assign(srcItem); - end; - end - else - inherited Assign(Source); - FCount := FList.Count; -end; - -procedure TXCollection.Loaded; -var - i: integer; -begin - for i := 0 to FList.Count - 1 do - TXCollectionItem(FList[i]).Loaded; -end; - -procedure TXCollection.WriteToFiler(writer: TWriter); -var - i, n: Integer; - classList: TList; - XCollectionItem: TXCollectionItem; -begin - // Here, we write all listed XCollection through their WriteToFiler methods, - // but to be able to restore them, we also write their classname, and to - // avoid wasting space if the same class appears multiple times we build up - // a lookup table while writing them, if the class is anew, the name is - // written, otherwise, only the index in the table is written. - // Using a global lookup table (instead of a "per-WriteData" one) could save - // more space, but would also increase dependencies, and this I don't want 8) - FArchiveVersion := 1; - classList := TList.Create; - try - with writer do - begin - // Magic header and archive version are always written now - WriteInteger(PInteger(@MAGIC[0])^); - WriteInteger(FArchiveVersion); - - WriteInteger(FList.Count); - for i := 0 to FList.Count - 1 do - begin - XCollectionItem := TXCollectionItem(FList[i]); - n := classList.IndexOf(XCollectionItem.ClassType); - if n < 0 then - begin - WriteString(XCollectionItem.ClassName); - classList.Add(XCollectionItem.ClassType); - end - else - WriteInteger(n); - XCollectionItem.WriteToFiler(writer); - end; - end; - finally - classList.Free; - end; -end; - -procedure TXCollection.ReadFromFiler(reader: TReader); -var - vt: TValueType; - Header: array [0 .. 3] of AnsiChar; - n, lc, lcnum: integer; - classList: TList; - cName: string; - XCollectionItemClass: TXCollectionItemClass; - XCollectionItem: TXCollectionItem; -begin - // see WriteData for a description of what is going on here - Clear; - classList := TList.Create; - try - with reader do - begin - // save current reader position, it will be used to rewind the reader if the DFM is too old - try - vt := NextValue; - if vt in [vaInt32, vaInt16, vaInt8] then - PInteger(@Header[0])^ := ReadInteger - else - begin - Read(Header[0], Length(Header)); - end; - except - Header[0] := #0; - Header[1] := #0; - Header[2] := #0; - Header[3] := #0; - end; - - // after reading the header, we need to compare it with the MAGIC reference - if (Header[0] = MAGIC[0]) and (Header[1] = MAGIC[1]) and - (Header[2] = MAGIC[2]) and (Header[3] = MAGIC[3]) then - begin - // if its ok we can just read the archive version - FArchiveVersion := ReadInteger; - lc := ReadInteger; - end - else - begin - // if the header is invalid (old DFM) just assume archive version is 0 and rewind reader - FArchiveVersion := 0; - lc := PInteger(@Header[0])^; - end; - - for n := 1 to lc do - begin - if NextValue in [vaString, vaLString] then - begin - cName := ReadString; -{$IFDEF DEBUG_XCOLLECTION} - writeln('TXCollection.ReadFromFiler create class entry: ', cName); -{$ENDIF} - XCollectionItemClass := FindXCollectionItemClass(cName); - Assert(Assigned(XCollectionItemClass), - 'Class ' + cName + - ' unknown. Add the relevant unit to your "uses".'); - classList.Add(XCollectionItemClass); - end - else - begin -{$IFDEF DEBUG_XCOLLECTION} - Assert(NextValue in [vaInt8, vaInt16, vaInt32], - 'Non-Integer ValueType: ' + GetEnumName(TypeInfo(TValueType), - Ord(NextValue))); -{$ENDIF} - lcnum := ReadInteger; - Assert((lcnum >= 0) and (lcnum < classList.Count), - 'Invalid classlistIndex: ' + IntToStr(lcnum)); - XCollectionItemClass := TXCollectionItemClass(classList[lcnum]); -{$IFDEF DEBUG_XCOLLECTION} - writeln('TXCollection.ReadFromFiler create by number: ', lcnum, - ' -> ', XCollectionItemClass.ClassName); -{$ENDIF} - end; - - if Assigned(XCollectionItemClass) then - begin - XCollectionItem := XCollectionItemClass.Create(Self); - XCollectionItem.ReadFromFiler(reader); - end; - end; - end; - finally - classList.Free; - end; - FCount := FList.Count; -end; - -class function TXCollection.ItemsClass: TXCollectionItemClass; -begin - Result:=TXCollectionItem; -end; - -function TXCollection.GetItems(Index: integer): TXCollectionItem; -begin - Result:=TXCollectionItem(FList[index]); -end; - -function TXCollection.GetOwner: TPersistent; -begin - Result:=FOwner; -end; - -function TXCollection.GetNamePath: String; -var - s : String; -begin - Result:=ClassName; - if GetOwner=nil then - Exit; - s:=GetOwner.GetNamePath; - if s='' then - Exit; - Result:=s+'.XCollection'; -end; - -function TXCollection.Add(anItem : TXCollectionItem): Integer; -begin - Assert(anItem.InheritsFrom(ItemsClass)); - Assert(CanAdd(TXCollectionItemClass(anItem.ClassType))); - if Assigned(anItem.FOwner) then - begin - anItem.FOwner.FList.Remove(anItem); - anItem.FOwner.FCount := anItem.FOwner.FList.Count; - end; - anItem.FOwner := Self; - result := FList.Add(anItem); - FCount := FList.Count; -end; - -function TXCollection.GetOrCreate(anItem: TXCollectionItemClass): TXCollectionItem; -var - i: integer; -begin - Assert(anItem.InheritsFrom(ItemsClass)); - i := Self.IndexOfClass(anItem); - if i >= 0 then - result := TXCollectionItem(Self[i]) - else - result := anItem.Create(Self); -end; - -procedure TXCollection.Delete(Index: integer); -begin - Assert(cardinal(index) < cardinal(FList.Count)); - // doin' it the fast way - with TXCollectionItem(FList[index]) do - begin - FOwner := nil; - Free; - end; - FList.Delete(index); - FCount := FList.Count; -end; - -procedure TXCollection.Remove(anItem: TXCollectionItem); -var - i: integer; -begin - i := IndexOf(anItem); - if i >= 0 then - Delete(i); -end; - -procedure TXCollection.Clear; -var - i: integer; -begin - // Fast kill of owned XCollection - for i := 0 to FList.Count - 1 do - with TXCollectionItem(FList[i]) do - begin - FOwner := nil; - Free; - end; - FList.Clear; - FCount := 0; -end; - -function TXCollection.IndexOf(anItem: TXCollectionItem): integer; -begin - Result := FList.IndexOf(anItem); -end; - -function TXCollection.IndexOfClass(aClass: TXCollectionItemClass): integer; -var - i: integer; -begin - result := -1; - for i := 0 to FList.Count - 1 do - if TXCollectionItem(FList[i]) is aClass then - begin - result := i; - Break; - end; -end; - -function TXCollection.GetByClass(aClass: TXCollectionItemClass): TXCollectionItem; -var - i: integer; -begin - Result := nil; - for i := 0 to FList.Count - 1 do - if TXCollectionItem(FList[i]) is aClass then - begin - result := TXCollectionItem(FList[i]); - Break; - end; -end; - -function TXCollection.IndexOfName(const aName: string): integer; -var - i: integer; -begin - Result := -1; - for i := 0 to FList.Count - 1 do - if TXCollectionItem(FList[i]).Name = aName then - begin - result := i; - Break; - end; -end; - -function TXCollection.CanAdd(aClass: TXCollectionItemClass): Boolean; -var - i: integer; - XCollectionItemClass: TXCollectionItemClass; -begin - Result := True; - - // Test if the class allows itself to be added to this collection - if not aClass.CanAddTo(Self) then - begin - Result := False; - Exit; - end; - - // is the given class compatible with owned ones ? - if aClass.UniqueItem then - for i := 0 to Count - 1 do - begin - if Items[i] is aClass then - begin - result := False; - Break; - end; - end; - // are the owned classes compatible with the given one ? - if result then - for i := 0 to Count - 1 do - begin - XCollectionItemClass := TXCollectionItemClass(Items[i].ClassType); - if (XCollectionItemClass.UniqueItem) and - aClass.InheritsFrom(XCollectionItemClass) then - begin - result := False; - Break; - end; - end; -end; - -// ------------------------------------------------------------------ -initialization -// ------------------------------------------------------------------ - -finalization - -vXCollectionItemClasses.Free; - -end. diff --git a/Sourcex/GXS.zBuffer.pas b/Sourcex/GXS.zBuffer.pas index 3321d57a..0dc6147c 100644 --- a/Sourcex/GXS.zBuffer.pas +++ b/Sourcex/GXS.zBuffer.pas @@ -45,7 +45,7 @@ interface GXS.Color, GXS.RenderContextInfo, GXS.State, - GXS.TextureFormat; + GLScene.TextureFormat; type diff --git a/Sourcex/GXSL.BumpShaders.pas b/Sourcex/GXSL.BumpShaders.pas index 8bdb580e..e10439a8 100644 --- a/Sourcex/GXSL.BumpShaders.pas +++ b/Sourcex/GXSL.BumpShaders.pas @@ -51,7 +51,7 @@ interface GXSL.CustomShader, GXSL.Shader, - GXS.TextureFormat; + GLScene.TextureFormat; type TBumpMethod = (bmDot3TexCombiner, bmBasicARBFP); diff --git a/Sourcex/GXSL.CustomShader.pas b/Sourcex/GXSL.CustomShader.pas index d43d907e..01c1501d 100644 --- a/Sourcex/GXSL.CustomShader.pas +++ b/Sourcex/GXSL.CustomShader.pas @@ -28,7 +28,7 @@ interface GXS.RenderContextInfo, GXS.Material, GLScene.VectorLists, - GXS.TextureFormat, + GLScene.TextureFormat, GXSL.Parameter; const diff --git a/Sourcex/GXSL.LineShaders.pas b/Sourcex/GXSL.LineShaders.pas index 0657771d..f518882b 100644 --- a/Sourcex/GXSL.LineShaders.pas +++ b/Sourcex/GXSL.LineShaders.pas @@ -118,7 +118,7 @@ implementation // ------------------------------------------------------------------ uses - GXS.TextureFormat; + GLScene.TextureFormat; // ------------------ // ------------------ TgxLineSettings ------------------ diff --git a/Sourcex/GXSL.Parameter.pas b/Sourcex/GXSL.Parameter.pas index d96765e9..d947215e 100644 --- a/Sourcex/GXSL.Parameter.pas +++ b/Sourcex/GXSL.Parameter.pas @@ -14,7 +14,7 @@ interface System.Classes, GLScene.VectorTypes, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.RenderContextInfo; type diff --git a/Sourcex/GXSL.PostEffects.pas b/Sourcex/GXSL.PostEffects.pas index 8c4ea233..44f2a647 100644 --- a/Sourcex/GXSL.PostEffects.pas +++ b/Sourcex/GXSL.PostEffects.pas @@ -24,7 +24,7 @@ interface GXS.Context, GXS.RenderContextInfo, GXS.Material, - GXS.TextureFormat; + GLScene.TextureFormat; type EGLPostShaderHolderException = class(Exception); diff --git a/Sourcex/GXSL.PostShaders.pas b/Sourcex/GXSL.PostShaders.pas index 83678ef7..9be6643c 100644 --- a/Sourcex/GXSL.PostShaders.pas +++ b/Sourcex/GXSL.PostShaders.pas @@ -21,7 +21,7 @@ interface GXSL.Shader, GXSL.CustomShader, GXS.RenderContextInfo, - GXS.TextureFormat; + GLScene.TextureFormat; // Custom class for GLSLxPostBlurShader. A shader that blurs the entire scene } type diff --git a/Sourcex/GXSL.ProjectedTextures.pas b/Sourcex/GXSL.ProjectedTextures.pas index 606430df..d60e5602 100644 --- a/Sourcex/GXSL.ProjectedTextures.pas +++ b/Sourcex/GXSL.ProjectedTextures.pas @@ -33,7 +33,7 @@ interface GXS.Context, GXS.Color, GXS.RenderContextInfo, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.PipelineTransformation, GLScene.VectorTypes; diff --git a/Sourcex/GXSL.Shader.pas b/Sourcex/GXSL.Shader.pas index e41cd11f..ad4b8b61 100644 --- a/Sourcex/GXSL.Shader.pas +++ b/Sourcex/GXSL.Shader.pas @@ -20,7 +20,7 @@ interface GXS.Texture, GXS.Context, GXS.RenderContextInfo, - GXS.TextureFormat, + GLScene.TextureFormat, GXSL.CustomShader, GXSL.Parameter; diff --git a/Sourcex/GXSL.ShaderParameter.pas b/Sourcex/GXSL.ShaderParameter.pas index 5b755ba1..465e332c 100644 --- a/Sourcex/GXSL.ShaderParameter.pas +++ b/Sourcex/GXSL.ShaderParameter.pas @@ -16,7 +16,7 @@ interface GLScene.Strings, GLScene.OpenGLTokens, GLScene.VectorTypes, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.RenderContextInfo; type diff --git a/Sourcex/GXSL.ShapeShaders.pas b/Sourcex/GXSL.ShapeShaders.pas index 8358e3ec..3d29a086 100644 --- a/Sourcex/GXSL.ShapeShaders.pas +++ b/Sourcex/GXSL.ShapeShaders.pas @@ -26,7 +26,7 @@ interface GLScene.Coordinates, GLScene.VectorGeometry, GLScene.VectorTypes, - GXS.TextureFormat, + GLScene.TextureFormat, GXS.Color, GXS.Texture, GXS.Material,