Единственный минус, там вначале всех значений стоит визуально непонятный символ и он каждый раз разный...
И сами значения визуально, тоже не отображаются (вместо них кракозябры), т.к. они в little-endian,
а все DAT1, DAT2, DAT3, DAT4, DAT5 - разделяет точно, вот только перед ними - стоит непонятный символ или половинка UTF8...
PS: изначальный код модуля вот такой (здесь кстати исправлена ошибка из-за которой LWO модуль рушил программу):
Код: Выделить всё
//
// This unit is part of the GLScene Project, http://glscene.org
//
// 16/10/08 - UweR - Compatibility fix for Delphi 2009
// 30/03/07 - DaStr - Moved all UNSAFE_TYPE, UNSAFE_CODE checks to GLSCene.inc
// 29/03/07 - DaStr - Renamed parameters in some methods
// Added more explicit pointer dereferencing
// Initialized local string variables in two places
// (thanks Burkhard Carstens) (Bugtracker ID = 1678658)
// 25/03/07 - DaStr - Turned off UNSAFE_TYPE, UNSAFE_CODE warnings
// 24/03/07 - DaStr - Added explicit pointer dereferencing
// (thanks Burkhard Carstens) (Bugtracker ID = 1678644)
// 08/03/06 - ur - Fixed warnings for Delphi 2006
// 14/11/02 - EG - Fixed warnings
// 16/11/02 - BJ - Replaced TLWChunkList.FindChunk search mechanism
// - BJ - Added v. method TLWChunk.Loaded. Called on Loading complete.
// - BJ - Added surface smooth normal generation
// 18/11/02 - BJ - Added surface param inheritance
// - BJ - Added Get and SetContentDir to unit
// 20/11/02 - BJ - Moved ParamAddr from TLWSurf to TLWParentChunk as v. method
{-------------------------------------------------------------------------------
Unit Name: Lightwave
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.
License: This unit is distributed under the Mozilla Public License.
For license details, refer to http://www.mozilla.org
Lightwave3D is a registered trademark of Newtek Incorporated.
-------------------------------------------------------------------------------}
unit LWObjects;
interface
{$I GLScene.inc}
uses Classes;
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): DWord; //cdecl;//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
uses SysUtils, Dialogs, ApplicationFileIO;
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 ArcTan2(const y, x : Single) : Single;
begin
asm
FLD Y
FLD X
FPATAN
end;
end;
function ArcCos(X: Single): Single;
begin
Result:=ArcTan2(Sqrt(1 - Sqr(X)), X);
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): DWord;//LongWord;
var
Chunk: TLWChunkRec;
CurId: TID4;
StartPos, CurSize: TU4;
begin
try
Stream.Read(CurId,4);
ReadMotorolaNumber(Stream,@CurSize,4);
if UpperCase(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;
// LoadLWOFromFile
//
function LoadLWOFromFile(const aFilename : String; readCallback : TLWOReadCallback; userData : Pointer) : LongWord;
var
stream : TStream;
begin
stream:=CreateFileStream(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;
L: LongWord;
i: Integer;
begin
i:=0;
case Size of
2: begin
while i < Count do
begin
W := PU2Array(ValueIn)^[i];
asm
mov ax,w; { move w into ax register }
xchg al,ah; { swap lo and hi byte of word }
mov w,ax; { move "swapped" ax back to w }
end;
PU2Array(ValueIn)^[i] := w;
Inc(i);
end;
end;
4: begin
while i < Count do
begin
L := PU4Array(ValueIn)^[i];
asm
mov eax,l; { move l into eax register }
BSWAP eax; { reverse the order of bytes in eax }
mov l,eax; { move "swapped" eax back to 1 }
end;
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 + 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 := UpperCase(Id);
result := PInteger(@TmpId)^;
end;
{ TLWChunk }
{
*********************************** 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;
{ TLWChunks }
{
********************************* TLWChunkList *********************************
}
constructor TLWChunkList.Create(AOwnsItems: boolean; AOwner: TObject);
begin
inherited Create; //<=== vit добавление привело к работоспособности и чтению LWO.
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 }
{
******************************** 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(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);
ShowMessage(CurId);
if (CurId = ID_PTAG) then
begin
CurPols.Add(GetChunkClass(CurId, TLWChunk).Create);
with CurPols[CurPols.Count - 1] do
begin
FID := CurId;
LoadFromStream(AStream);
end;
end else
if (CurId = ID_VMAP) or (CurId = ID_VMAD) then
begin
CurPnts.Add(GetChunkClass(CurId, TLWChunk).Create);
with CurPnts[CurPnts.Count - 1] do
begin
FID := CurId;
LoadFromStream(AStream);
end;
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);
with CurItems[CurItems.Count - 1] do
begin
FID := CurId;
LoadFromStream(AStream);
end;
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 }
{
*********************************** 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 }
{
*********************************** 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 }
{
*********************************** 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 }
{
*********************************** 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 }
{
********************************* 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 }
{
*********************************** 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 := 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);
with Items[Items.Count - 1] do
begin
FID:=CurId;
LoadFromStream(AStream);
end;
end;
end;
{ TLWPTag }
{
*********************************** 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 }
{
******************************** 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);
with Items[Items.Count - 1] do
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.
.
Вот так делит, но здесь не все символы передаются в Notepad++ символы видно и у них даже есть названия, а здесь сохранился только bCNTR, а на самом там почти перед каждым стоит непонятный символ...
.
Почему буквы отображаются нормально(ASCI), а цифры нужно переводить в Hex16???