GLScene/Source/FileLWObjects.pas

//
// This unit is part of the GLScene Engine, http://glscene.org
//
(*-------------------------------------------------------------------------------
 Unit Name:  Lightwave
 Author:     Brian Johns [email protected]
 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 FileLWObjects;

interface

{$I GLScene.inc}

uses
  System.Classes,
  System.SysUtils,
  System.Math,
  GLVectorGeometry;

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
//--------------------------------------------------------------------
//--------------------------------------------------------------------
//--------------------------------------------------------------------
uses
  GLApplicationFileIO;

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;

// 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;
  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 }

{
*********************************** 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;
  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(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);

      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 := 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);

    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.