Ignore:
Timestamp:
Apr 9, 2015, 9:58:36 PM (9 years ago)
Author:
chronos
Message:
  • Fixed: Use csOpaque control style also to Image, PaintBox and OpenGLControl.
  • Modified: Change size of test frame with SpinEdits as delayed using timer.
  • Updated: BRGABitmap package to version 8.1.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/Packages/bgrabitmap/bgrascene3d.pas

    r452 r472  
    99
    1010type
     11  TProjection3D = BGRAMatrix3D.TProjection3D;
     12  TBox3D = record
     13    min,max: TPoint3D;
     14  end;
     15
     16  TLightingNormal3D = (lnNone, lnFace, lnVertex, lnFaceVertexMix);
     17  TLightingInterpolation3D = (liLowQuality, liSpecularHighQuality, liAlwaysHighQuality);
     18  TAntialiasingMode3D = (am3dNone, am3dMultishape, am3dResample);
     19  TPerspectiveMode3D = (pmLinearMapping, pmPerspectiveMapping, pmZBuffer);
     20
     21  TRenderingOptions = record
     22    LightingInterpolation: TLightingInterpolation3D;
     23    AntialiasingMode: TAntialiasingMode3D;
     24    AntialiasingResampleLevel: integer;
     25    PerspectiveMode: TPerspectiveMode3D;
     26    TextureInterpolation: boolean;
     27    MinZ: single;
     28  end;
     29
    1130  PSceneLightingContext = ^TSceneLightingContext;
    1231  TSceneLightingContext = packed record
    … …  
    2342    SaturationHigh: integer;
    2443    SaturationHighF: single;
    25   end;
    26 
    27   TProjection3D = packed record
    28     Zoom, Center: TPointF;
    29   end;
    30 
    31   TBox3D = record
    32     min,max: TPoint3D;
    33   end;
    34 
    35   TLightingNormal3D = (lnNone, lnFace, lnVertex, lnFaceVertexMix);
    36   TLightingInterpolation3D = (liLowQuality, liSpecularHighQuality, liAlwaysHighQuality);
    37   TAntialiasingMode3D = (am3dNone, am3dMultishape, am3dResample);
    38   TPerspectiveMode3D = (pmLinearMapping, pmPerspectiveMapping, pmZBuffer);
    39 
    40 type
    41   TRenderingOptions = record
    42     LightingInterpolation: TLightingInterpolation3D;
    43     AntialiasingMode: TAntialiasingMode3D;
    44     AntialiasingResampleLevel: integer;
    45     PerspectiveMode: TPerspectiveMode3D;
    46     TextureInterpolation: boolean;
    47     MinZ: single;
    4844  end;
    4945
    … …  
    8177    function GetLightCount: integer;
    8278    function GetMaterial(AIndex: integer): IBGRAMaterial3D;
     79    function GetNormalCount: integer;
    8380    function GetObject(AIndex: integer): IBGRAObject3D;
    8481    function GetVertexCount: integer;
    … …  
    111108    function ApplyNoLighting(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
    112109    procedure UseMaterial(AMaterialName: string; AFace: IBGRAFace3D); virtual;
     110    function FetchTexture({%H-}AName: string; out texSize: TPointF): IBGRAScanner; virtual;
    113111
    114112  public
    … …  
    116114    DefaultMaterial : IBGRAMaterial3D;
    117115    RenderingOptions: TRenderingOptions;
     116    UnknownColor: TBGRAPixel;
    118117
    119118    constructor Create;
    120119    constructor Create(ASurface: TBGRACustomBitmap);
    121120    destructor Destroy; override;
    122     procedure Clear;
     121    procedure Clear; virtual;
    123122    function LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D;
     123    function LoadObjectFromFileUTF8(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D;
     124    function LoadObjectFromStream(AStream: TStream; SwapFacesOrientation: boolean = true): IBGRAObject3D;
     125    procedure LoadMaterialsFromFile(AFilename: string);
     126    procedure LoadMaterialsFromFileUTF8(AFilename: string);
     127    procedure LoadMaterialsFromStream(AStream: TStream);
    124128    procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D);
    125129    procedure LookLeft(angleDeg: single);
    … …  
    145149    function CreateMaterial: IBGRAMaterial3D;
    146150    function CreateMaterial(ASpecularIndex: integer): IBGRAMaterial3D;
     151    function GetMaterialByName(AName: string): IBGRAMaterial3D;
    147152    procedure UpdateMaterials; virtual;
    148153    procedure UpdateMaterial(AMaterialName: string); virtual;
     154    procedure ForEachVertex(ACallback: TVertex3DCallback);
     155    procedure ForEachFace(ACallback: TFace3DCallback);
    149156    property ViewCenter: TPointF read GetViewCenter write SetViewCenter;
    150157    property AutoViewCenter: boolean read FAutoViewCenter write SetAutoViewCenter;
    … …  
    154161    property Object3DCount: integer read FObjectCount;
    155162    property VertexCount: integer read GetVertexCount;
     163    property NormalCount: integer read GetNormalCount;
    156164    property FaceCount: integer read GetFaceCount;
    157165    property Zoom: TPointF read GetZoom write SetZoom;
    … …  
    169177implementation
    170178
    171 uses BGRAPolygon, BGRAPolygonAliased, BGRACoordPool3D;
     179uses BGRAPolygon, BGRAPolygonAliased, BGRACoordPool3D, BGRAResample,
     180  lazutf8classes;
    172181
    173182{$i lightingclasses3d.inc}
     183{$i vertex3d.inc}
     184{$i face3d.inc}
    174185
    175186type
    … …  
    200211    function AddFace(const AVertices: array of IBGRAVertex3D; AColors: array of TBGRAPixel): IBGRAFace3D;
    201212    function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
    202     procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
     213    procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D);
    203214    function GetColor: TBGRAPixel;
    204215    function GetLight: Single;
    … …  
    210221    function GetFaceCount: integer;
    211222    function GetTotalVertexCount: integer;
     223    function GetTotalNormalCount: integer;
    212224    function GetMaterial: IBGRAMaterial3D;
    213225    procedure SetLightingNormal(const AValue: TLightingNormal3D);
    … …  
    222234    function GetRefCount: integer;
    223235    procedure SetBiface(AValue : boolean);
    224   end;
    225 
    226 {$i shape3D.inc}
    227 
    228 type
    229   { TBGRAPart3D }
    230 
    231   TBGRAPart3D = class(TInterfacedObject,IBGRAPart3D)
    232   private
    233     FVertices: array of IBGRAVertex3D;
    234     FVertexCount: integer;
    235     FMatrix: TMatrix3D;
    236     FParts: array of IBGRAPart3D;
    237     FPartCount: integer;
    238     FContainer: IBGRAPart3D;
    239     FCoordPool: TBGRACoordPool3D;
    240   public
    241     constructor Create(AContainer: IBGRAPart3D);
    242     destructor Destroy; override;
    243     procedure Clear(ARecursive: boolean);
    244     function Add(x,y,z: single): IBGRAVertex3D;
    245     function Add(pt: TPoint3D): IBGRAVertex3D;
    246     function Add(pt: TPoint3D_128): IBGRAVertex3D;
    247     function Add(const coords: array of single): arrayOfIBGRAVertex3D;
    248     function Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D;
    249     function Add(const pts: array of TPoint3D_128): arrayOfIBGRAVertex3D;
    250     procedure Add(const pts: array of IBGRAVertex3D);
    251     procedure Add(AVertex: IBGRAVertex3D);
    252     procedure RemoveVertex(Index: integer);
    253     function GetBoundingBox: TBox3D;
    254     function GetRadius: single;
    255     function GetMatrix: TMatrix3D;
    256     function GetPart(AIndex: Integer): IBGRAPart3D;
    257     function GetPartCount: integer;
    258     function GetVertex(AIndex: Integer): IBGRAVertex3D;
    259     function GetVertexCount: integer;
    260     function GetTotalVertexCount: integer;
    261     function GetContainer: IBGRAPart3D;
    262     procedure SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
    263     procedure ResetTransform;
    264     procedure Translate(x,y,z: single; Before: boolean = true);
    265     procedure Translate(ofs: TPoint3D; Before: boolean = true);
    266     procedure Scale(size: single; Before: boolean = true);
    267     procedure Scale(x,y,z: single; Before: boolean = true);
    268     procedure Scale(size: TPoint3D; Before: boolean = true);
    269     procedure RotateXDeg(angle: single; Before: boolean = true);
    270     procedure RotateYDeg(angle: single; Before: boolean = true);
    271     procedure RotateZDeg(angle: single; Before: boolean = true);
    272     procedure RotateXRad(angle: single; Before: boolean = true);
    273     procedure RotateYRad(angle: single; Before: boolean = true);
    274     procedure RotateZRad(angle: single; Before: boolean = true);
    275     procedure SetMatrix(const AValue: TMatrix3D);
    276     procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
    277     function ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF;
    278     procedure NormalizeViewNormal;
    279     function CreatePart: IBGRAPart3D;
    280     procedure LookAt(ALookWhere,ATopDir: TPoint3D);
    281     procedure RemoveUnusedVertices;
    282     function IndexOf(AVertex: IBGRAVertex3D): integer;
    283   end;
    284 
    285   { TBGRAFace3D }
    286 
    287   PBGRAFaceVertexDescription = ^TBGRAFaceVertexDescription;
    288   TBGRAFaceVertexDescription = record
    289        Vertex: IBGRAVertex3D;
    290        Color: TBGRAPixel;
    291        TexCoord: TPointF;
    292        ColorOverride: boolean;
    293        TexCoordOverride: boolean;
    294      end;
    295 
    296   TBGRAFace3D = class(TInterfacedObject,IBGRAFace3D)
    297   private
    298     FVertices: packed array of TBGRAFaceVertexDescription;
    299     FVertexCount: integer;
    300     FTexture: IBGRAScanner;
    301     FMaterial: IBGRAMaterial3D;
    302     FMaterialName: string;
    303     FParentTexture: boolean;
    304     FViewNormal: TPoint3D_128;
    305     FViewCenter: TPoint3D_128;
    306     FObject3D : IBGRAObject3D;
    307     FBiface: boolean;
    308     FLightThroughFactor: single;
    309     FLightThroughFactorOverride: boolean;
    310     function GetVertexDescription(AIndex : integer): PBGRAFaceVertexDescription;
    311   public
    312     function GetObject3D: IBGRAObject3D;
    313     constructor Create(AObject3D: IBGRAObject3D; AVertices: array of IBGRAVertex3D);
    314     destructor Destroy; override;
    315     procedure AddVertex(AVertex: IBGRAVertex3D);
    316     function GetParentTexture: boolean;
    317     function GetTexture: IBGRAScanner;
    318     function GetVertex(AIndex: Integer): IBGRAVertex3D;
    319     function GetVertexColor(AIndex: Integer): TBGRAPixel;
    320     function GetVertexColorOverride(AIndex: Integer): boolean;
    321     function GetVertexCount: integer;
    322     function GetMaterial: IBGRAMaterial3D;
    323     function GetMaterialName: string;
    324     function GetTexCoord(AIndex: Integer): TPointF;
    325     function GetTexCoordOverride(AIndex: Integer): boolean;
    326     function GetViewNormal: TPoint3D;
    327     function GetViewNormal_128: TPoint3D_128;
    328     function GetViewCenter: TPoint3D;
    329     function GetViewCenter_128: TPoint3D_128;
    330     function GetViewCenterZ: single;
    331     function GetBiface: boolean;
    332     function GetLightThroughFactor: single;
    333     function GetLightThroughFactorOverride: boolean;
    334     procedure SetParentTexture(const AValue: boolean);
    335     procedure SetTexture(const AValue: IBGRAScanner);
    336     procedure SetColor(AColor: TBGRAPixel);
    337     procedure SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel);
    338     procedure SetVertexColorOverride(AIndex: Integer; const AValue: boolean);
    339     procedure SetTexCoord(AIndex: Integer; const AValue: TPointF);
    340     procedure SetTexCoordOverride(AIndex: Integer; const AValue: boolean);
    341     procedure SetBiface(const AValue: boolean);
    342     procedure SetLightThroughFactor(const AValue: single);
    343     procedure SetLightThroughFactorOverride(const AValue: boolean);
    344     procedure SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
    345     procedure ComputeViewNormalAndCenter;
    346     procedure SetMaterial(const AValue: IBGRAMaterial3D);
    347     procedure SetMaterialName(const AValue: string);
    348     function GetAsObject: TObject;
    349     property Texture: IBGRAScanner read GetTexture write SetTexture;
    350     property ParentTexture: boolean read GetParentTexture write SetParentTexture;
    351     property VertexCount: integer read GetVertexCount;
    352     property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex;
    353     property VertexColor[AIndex: Integer]: TBGRAPixel read GetVertexColor write SetVertexColor;
    354     property VertexColorOverride[AIndex: Integer]: boolean read GetVertexColorOverride write SetVertexColorOverride;
    355     property TexCoord[AIndex: Integer]: TPointF read GetTexCoord write SetTexCoord;
    356     property TexCoordOverride[AIndex: Integer]: boolean read GetTexCoordOverride write SetTexCoordOverride;
    357     property ViewNormal: TPoint3D read GetViewNormal;
    358     property ViewNormal_128: TPoint3D_128 read GetViewNormal_128;
    359     property ViewCenter: TPoint3D read GetViewCenter;
    360     property ViewCenter_128: TPoint3D_128 read GetViewCenter_128;
    361     property ViewCenterZ: single read GetViewCenterZ;
    362     property Object3D: IBGRAObject3D read GetObject3D;
    363     property Biface: boolean read GetBiface write SetBiface;
    364     property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor;
    365     property LightThroughFactorOverride: boolean read GetLightThroughFactorOverride write SetLightThroughFactorOverride;
    366     property Material: IBGRAMaterial3D read GetMaterial write SetMaterial;
    367     property VertexDescription[AIndex : integer]: PBGRAFaceVertexDescription read GetVertexDescription;
    368   end;
    369 
    370   { TBGRAVertex3D }
    371 
    372   TBGRAVertex3D = class(TInterfacedObject,IBGRAVertex3D)
    373   private
    374     FColor: TBGRAPixel;
    375     FParentColor: boolean;
    376     FLight: Single;
    377     FTexCoord: TPointF;
    378     FCoordPool: TBGRACoordPool3D;
    379     FCoordPoolIndex: integer;
    380     function GetCoordData: PBGRACoordData3D;
    381     procedure Init(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
    382   public
    383     constructor Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D); overload;
    384     constructor Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); overload;
    385     destructor Destroy; override;
    386     function GetColor: TBGRAPixel;
    387     function GetLight: Single;
    388     function GetViewNormal: TPoint3D;
    389     function GetViewNormal_128: TPoint3D_128;
    390     function GetSceneCoord: TPoint3D;
    391     function GetSceneCoord_128: TPoint3D_128;
    392     function GetTexCoord: TPointF;
    393     function GetViewCoord: TPoint3D;
    394     function GetViewCoord_128: TPoint3D_128;
    395     function GetUsage: integer;
    396     procedure SetColor(const AValue: TBGRAPixel);
    397     procedure SetLight(const AValue: Single);
    398     procedure SetViewNormal(const AValue: TPoint3D);
    399     procedure SetViewNormal_128(const AValue: TPoint3D_128);
    400     procedure NormalizeViewNormal;
    401     procedure AddViewNormal(const AValue: TPoint3D_128);
    402     procedure SetSceneCoord(const AValue: TPoint3D);
    403     procedure SetSceneCoord_128(const AValue: TPoint3D_128);
    404     procedure SetTexCoord(const AValue: TPointF);
    405     procedure SetViewCoord(const AValue: TPoint3D);
    406     procedure SetViewCoord_128(const AValue: TPoint3D_128);
    407     function GetViewCoordZ: single;
    408     function GetParentColor: Boolean;
    409     procedure SetParentColor(const AValue: Boolean);
    410     function GetProjectedCoord: TPointF;
    411     procedure SetProjectedCoord(const AValue: TPointF);
    412     procedure ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
    413     property SceneCoord: TPoint3D read GetSceneCoord write SetSceneCoord;
    414     property SceneCoord_128: TPoint3D_128 read GetSceneCoord_128 write SetSceneCoord_128;
    415     property ViewCoord: TPoint3D read GetViewCoord write SetViewCoord;
    416     property ViewCoord_128: TPoint3D_128 read GetViewCoord_128 write SetViewCoord_128;
    417     property ViewCoordZ: single read GetViewCoordZ;
    418     property ProjectedCoord: TPointF read GetProjectedCoord write SetProjectedCoord;
    419     property TexCoord: TPointF read GetTexCoord write SetTexCoord;
    420     property Color: TBGRAPixel read GetColor write SetColor;
    421     property ParentColor: Boolean read GetParentColor write SetParentColor;
    422     property Light: Single read GetLight write SetLight;
    423     property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal;
    424     property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128;
    425     property Usage: integer read GetUsage;
    426     property CoordData: PBGRACoordData3D read GetCoordData;
    427     function GetAsObject: TObject;
    428   end;
    429 
    430 { TBGRAVertex3D }
    431 
    432 procedure TBGRAVertex3D.Init(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
    433 begin
    434   FCoordPool := ACoordPool;
    435   FCoordPoolIndex := FCoordPool.Add;
    436   FColor := BGRAWhite;
    437   FParentColor := True;
    438   FLight := 1;
    439   SceneCoord_128 := ASceneCoord;
    440 end;
    441 
    442 function TBGRAVertex3D.GetCoordData: PBGRACoordData3D;
    443 begin
    444   result := FCoordPool.CoordData[FCoordPoolIndex];
    445 end;
    446 
    447 constructor TBGRAVertex3D.Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D);
    448 begin
    449   Init(ACoordPool, Point3D_128(ASceneCoord));
    450 end;
    451 
    452 constructor TBGRAVertex3D.Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
    453 begin
    454   Init(ACoordPool, ASceneCoord);
    455 end;
    456 
    457 destructor TBGRAVertex3D.Destroy;
    458 begin
    459   FCoordPool.Remove(FCoordPoolIndex);
    460   inherited Destroy;
    461 end;
    462 
    463 function TBGRAVertex3D.GetColor: TBGRAPixel;
    464 begin
    465   result := FColor;
    466 end;
    467 
    468 function TBGRAVertex3D.GetLight: Single;
    469 begin
    470   result := FLight;
    471 end;
    472 
    473 function TBGRAVertex3D.GetViewNormal: TPoint3D;
    474 begin
    475   result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal);
    476 end;
    477 
    478 function TBGRAVertex3D.GetViewNormal_128: TPoint3D_128;
    479 begin
    480   result := FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal;
    481 end;
    482 
    483 function TBGRAVertex3D.GetSceneCoord: TPoint3D;
    484 begin
    485   result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord);
    486 end;
    487 
    488 function TBGRAVertex3D.GetSceneCoord_128: TPoint3D_128;
    489 begin
    490   result := FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord;
    491 end;
    492 
    493 function TBGRAVertex3D.GetTexCoord: TPointF;
    494 begin
    495   result := FTexCoord;
    496 end;
    497 
    498 function TBGRAVertex3D.GetViewCoord: TPoint3D;
    499 begin
    500   result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord);
    501 end;
    502 
    503 function TBGRAVertex3D.GetViewCoord_128: TPoint3D_128;
    504 begin
    505   result := FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord;
    506 end;
    507 
    508 function TBGRAVertex3D.GetUsage: integer;
    509 begin
    510   result := frefcount;
    511 end;
    512 
    513 procedure TBGRAVertex3D.SetColor(const AValue: TBGRAPixel);
    514 begin
    515   FColor := AValue;
    516   FParentColor := false;
    517 end;
    518 
    519 procedure TBGRAVertex3D.SetLight(const AValue: Single);
    520 begin
    521   FLight := AValue;
    522 end;
    523 
    524 procedure TBGRAVertex3D.SetViewNormal(const AValue: TPoint3D);
    525 begin
    526   FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal := Point3D_128(AValue);
    527 end;
    528 
    529 procedure TBGRAVertex3D.SetViewNormal_128(const AValue: TPoint3D_128);
    530 begin
    531   FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal := AValue;
    532 end;
    533 
    534 procedure TBGRAVertex3D.SetSceneCoord(const AValue: TPoint3D);
    535 begin
    536   FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord := Point3D_128(AValue);
    537 end;
    538 
    539 procedure TBGRAVertex3D.SetSceneCoord_128(const AValue: TPoint3D_128);
    540 begin
    541   FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord := AValue;
    542 end;
    543 
    544 procedure TBGRAVertex3D.SetTexCoord(const AValue: TPointF);
    545 begin
    546   FTexCoord := AValue;
    547 end;
    548 
    549 procedure TBGRAVertex3D.SetViewCoord(const AValue: TPoint3D);
    550 begin
    551   FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord := Point3D_128(AValue);
    552 end;
    553 
    554 procedure TBGRAVertex3D.SetViewCoord_128(const AValue: TPoint3D_128);
    555 begin
    556   FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord := AValue;
    557 end;
    558 
    559 function TBGRAVertex3D.GetViewCoordZ: single;
    560 begin
    561   result := FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord.Z;
    562 end;
    563 
    564 function TBGRAVertex3D.GetParentColor: Boolean;
    565 begin
    566   result := FParentColor;
    567 end;
    568 
    569 procedure TBGRAVertex3D.SetParentColor(const AValue: Boolean);
    570 begin
    571   FParentColor := AValue;
    572 end;
    573 
    574 function TBGRAVertex3D.GetProjectedCoord: TPointF;
    575 begin
    576   result := FCoordPool.CoordData[FCoordPoolIndex]^.projectedCoord;
    577 end;
    578 
    579 procedure TBGRAVertex3D.SetProjectedCoord(const AValue: TPointF);
    580 begin
    581   FCoordPool.CoordData[FCoordPoolIndex]^.projectedCoord := AValue;
    582 end;
    583 
    584 procedure TBGRAVertex3D.ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection : TProjection3D);
    585 var P: PBGRACoordData3D;
    586 begin
    587   P := FCoordPool.CoordData[FCoordPoolIndex];
    588   with p^ do
    589   begin
    590     viewCoord := AMatrix*sceneCoord;
    591     ClearPoint3D_128(viewNormal);
    592     if viewCoord.z > 0 then
    593     begin
    594       InvZ := 1/viewCoord.z;
    595       projectedCoord := PointF(viewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x,
    596                                viewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y);
    597     end else
    598       projectedCoord := PointF(0,0);
    599   end;
    600 end;
    601 
    602 function TBGRAVertex3D.GetAsObject: TObject;
    603 begin
    604   result := self;
    605 end;
    606 
    607 procedure TBGRAVertex3D.NormalizeViewNormal;
    608 begin
    609   Normalize3D_128(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal);
    610 end;
    611 
    612 procedure TBGRAVertex3D.AddViewNormal(const AValue: TPoint3D_128);
    613 begin
    614   Add3D_Aligned(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal, AValue);
    615 end;
    616 
    617 { TBGRAFace3D }
    618 
    619 function TBGRAFace3D.GetVertexDescription(AIndex : integer
    620   ): PBGRAFaceVertexDescription;
    621 begin
    622   result := @FVertices[AIndex];
    623 end;
    624 
    625 function TBGRAFace3D.GetObject3D: IBGRAObject3D;
    626 begin
    627   result := FObject3D;
    628 end;
    629 
    630 constructor TBGRAFace3D.Create(AObject3D: IBGRAObject3D;
    631   AVertices: array of IBGRAVertex3D);
    632 var
    633   i: Integer;
    634 begin
    635   SetLength(FVertices, length(AVertices));
    636   for i:= 0 to high(AVertices) do
    637     AddVertex(AVertices[i]);
    638   FObject3D := AObject3D;
    639   FBiface := false;
    640   FParentTexture := True;
    641   FLightThroughFactor:= 0;
    642   FLightThroughFactorOverride:= false;
    643 end;
    644 
    645 destructor TBGRAFace3D.Destroy;
    646 begin
    647   fillchar(FTexture,sizeof(FTexture),0);
    648   inherited Destroy;
    649 end;
    650 
    651 procedure TBGRAFace3D.AddVertex(AVertex: IBGRAVertex3D);
    652 begin
    653   if FVertexCount = length(FVertices) then
    654     setlength(FVertices, FVertexCount*2+3);
    655   with FVertices[FVertexCount] do
    656   begin
    657     Color := BGRAWhite;
    658     ColorOverride := false;
    659     TexCoord := PointF(0,0);
    660     TexCoordOverride := false;
    661     Vertex := AVertex;
    662   end;
    663   inc(FVertexCount);
    664 end;
    665 
    666 function TBGRAFace3D.GetParentTexture: boolean;
    667 begin
    668   result := FParentTexture;
    669 end;
    670 
    671 function TBGRAFace3D.GetTexture: IBGRAScanner;
    672 begin
    673   result := FTexture;
    674 end;
    675 
    676 function TBGRAFace3D.GetVertex(AIndex: Integer): IBGRAVertex3D;
    677 begin
    678   if (AIndex < 0) or (AIndex >= FVertexCount) then
    679     raise Exception.Create('Index out of bounds');
    680   result := FVertices[AIndex].Vertex;
    681 end;
    682 
    683 procedure TBGRAFace3D.SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
    684 begin
    685   if (AIndex < 0) or (AIndex >= FVertexCount) then
    686     raise Exception.Create('Index out of bounds');
    687   FVertices[AIndex].Vertex := AValue;
    688 end;
    689 
    690 function TBGRAFace3D.GetVertexColor(AIndex: Integer): TBGRAPixel;
    691 begin
    692   if (AIndex < 0) or (AIndex >= FVertexCount) then
    693     raise Exception.Create('Index out of bounds');
    694   result := FVertices[AIndex].Color;
    695 end;
    696 
    697 function TBGRAFace3D.GetVertexColorOverride(AIndex: Integer): boolean;
    698 begin
    699   if (AIndex < 0) or (AIndex >= FVertexCount) then
    700     raise Exception.Create('Index out of bounds');
    701   result := FVertices[AIndex].ColorOverride;
    702 end;
    703 
    704 function TBGRAFace3D.GetVertexCount: integer;
    705 begin
    706   result := FVertexCount;
    707 end;
    708 
    709 function TBGRAFace3D.GetMaterial: IBGRAMaterial3D;
    710 begin
    711   result := FMaterial;
    712 end;
    713 
    714 function TBGRAFace3D.GetMaterialName: string;
    715 begin
    716   result := FMaterialName;
    717 end;
    718 
    719 procedure TBGRAFace3D.SetParentTexture(const AValue: boolean);
    720 begin
    721   FParentTexture := AValue;
    722 end;
    723 
    724 procedure TBGRAFace3D.SetTexture(const AValue: IBGRAScanner);
    725 begin
    726   FTexture := AValue;
    727   FParentTexture := false;
    728 end;
    729 
    730 procedure TBGRAFace3D.SetColor(AColor: TBGRAPixel);
    731 var i: integer;
    732 begin
    733   for i := 0 to GetVertexCount-1 do
    734     SetVertexColor(i,AColor);
    735 end;
    736 
    737 procedure TBGRAFace3D.SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel
    738   );
    739 begin
    740   if (AIndex < 0) or (AIndex >= FVertexCount) then
    741     raise Exception.Create('Index out of bounds');
    742   with FVertices[AIndex] do
    743   begin
    744     Color := AValue;
    745     ColorOverride := true;
    746   end;
    747 end;
    748 
    749 procedure TBGRAFace3D.SetVertexColorOverride(AIndex: Integer;
    750   const AValue: boolean);
    751 begin
    752   if (AIndex < 0) or (AIndex >= FVertexCount) then
    753     raise Exception.Create('Index out of bounds');
    754   FVertices[AIndex].ColorOverride := AValue;
    755 end;
    756 
    757 function TBGRAFace3D.GetTexCoord(AIndex: Integer): TPointF;
    758 begin
    759   if (AIndex < 0) or (AIndex >= FVertexCount) then
    760     raise Exception.Create('Index out of bounds');
    761   result := FVertices[AIndex].TexCoord;
    762 end;
    763 
    764 function TBGRAFace3D.GetTexCoordOverride(AIndex: Integer): boolean;
    765 begin
    766   if (AIndex < 0) or (AIndex >= FVertexCount) then
    767     raise Exception.Create('Index out of bounds');
    768   result := FVertices[AIndex].TexCoordOverride;
    769 end;
    770 
    771 procedure TBGRAFace3D.SetTexCoord(AIndex: Integer; const AValue: TPointF);
    772 begin
    773   if (AIndex < 0) or (AIndex >= FVertexCount) then
    774     raise Exception.Create('Index out of bounds');
    775   FVertices[AIndex].TexCoord := AValue;
    776   FVertices[AIndex].TexCoordOverride := true;
    777 end;
    778 
    779 procedure TBGRAFace3D.SetTexCoordOverride(AIndex: Integer; const AValue: boolean
    780   );
    781 begin
    782   if (AIndex < 0) or (AIndex >= FVertexCount) then
    783     raise Exception.Create('Index out of bounds');
    784   FVertices[AIndex].TexCoordOverride := AValue;
    785 end;
    786 
    787 function TBGRAFace3D.GetViewNormal: TPoint3D;
    788 begin
    789   result := Point3D(FViewNormal);
    790 end;
    791 
    792 function TBGRAFace3D.GetViewNormal_128: TPoint3D_128;
    793 begin
    794   result := FViewNormal;
    795 end;
    796 
    797 function TBGRAFace3D.GetViewCenter: TPoint3D;
    798 begin
    799   result := Point3D(FViewCenter);
    800 end;
    801 
    802 function TBGRAFace3D.GetViewCenter_128: TPoint3D_128;
    803 begin
    804   result := FViewCenter;
    805 end;
    806 
    807 function TBGRAFace3D.GetViewCenterZ: single;
    808 begin
    809   result := FViewCenter.Z;
    810 end;
    811 
    812 function TBGRAFace3D.GetBiface: boolean;
    813 begin
    814   result := FBiface;
    815 end;
    816 
    817 procedure TBGRAFace3D.SetBiface(const AValue: boolean);
    818 begin
    819   FBiface := AValue;
    820 end;
    821 
    822 function TBGRAFace3D.GetLightThroughFactor: single;
    823 begin
    824   result := FLightThroughFactor;
    825 end;
    826 
    827 function TBGRAFace3D.GetLightThroughFactorOverride: boolean;
    828 begin
    829   result := FLightThroughFactorOverride;
    830 end;
    831 
    832 procedure TBGRAFace3D.SetLightThroughFactor(const AValue: single);
    833 begin
    834   if AValue < 0 then
    835     FLightThroughFactor := 0
    836   else
    837     FLightThroughFactor:= AValue;
    838   FLightThroughFactorOverride := true;
    839 end;
    840 
    841 procedure TBGRAFace3D.SetLightThroughFactorOverride(const AValue: boolean);
    842 begin
    843   FLightThroughFactorOverride := AValue;
    844 end;
    845 
    846 procedure TBGRAFace3D.ComputeViewNormalAndCenter;
    847 var v1,v2: TPoint3D_128;
    848   i: Integer;
    849   p0,p1,p2: IBGRAVertex3D;
    850 begin
    851   if FVertexCount < 3 then
    852     ClearPoint3D_128(FViewNormal)
    853   else
    854   begin
    855     p0 := FVertices[0].Vertex;
    856     p1 := FVertices[1].Vertex;
    857     p2 := FVertices[2].Vertex;
    858     v1 := p1.ViewCoord_128 - p0.ViewCoord_128;
    859     v2 := p2.ViewCoord_128 - p1.ViewCoord_128;
    860     VectProduct3D_128(v2,v1,FViewNormal);
    861     Normalize3D_128(FViewNormal);
    862     for i := 0 to FVertexCount-1 do
    863       FVertices[i].Vertex.AddViewNormal(FViewNormal);
    864   end;
    865   ClearPoint3D_128(FViewCenter);
    866   if FVertexCount > 0 then
    867   begin
    868     for i := 0 to FVertexCount-1 do
    869       FViewCenter += FVertices[i].Vertex.ViewCoord_128;
    870     FViewCenter *= 1/FVertexCount;
    871   end;
    872 end;
    873 
    874 procedure TBGRAFace3D.SetMaterial(const AValue: IBGRAMaterial3D);
    875 begin
    876   FMaterial := AValue;
    877 end;
    878 
    879 procedure TBGRAFace3D.SetMaterialName(const AValue: string);
    880 begin
    881   if AValue <> FMaterialName then
    882   begin
    883     FMaterialName := AValue;
    884     FObject3D.Scene.UseMaterial(FMaterialName, self);
    885   end;
    886 end;
    887 
    888 function TBGRAFace3D.GetAsObject: TObject;
    889 begin
    890   result := self;
    891 end;
    892 
    893 { TBGRAPart3D }
    894 
    895 procedure TBGRAPart3D.LookAt(ALookWhere,ATopDir: TPoint3D);
    896 var ZDir, XDir, YDir: TPoint3D_128;
    897     ViewPoint: TPoint3D_128;
    898     CurPart: IBGRAPart3D;
    899     ComposedMatrix: TMatrix3D;
    900 begin
    901   YDir := -Point3D_128(ATopDir);
    902   if IsPoint3D_128_Zero(YDir) then exit;
    903   Normalize3D_128(YDir);
    904 
    905   ComposedMatrix := FMatrix;
    906   CurPart := self.FContainer;
    907   while CurPart <> nil do
    908   begin
    909     ComposedMatrix := CurPart.Matrix*ComposedMatrix;
    910     CurPart := CurPart.Container;
    911   end;
    912   ViewPoint := ComposedMatrix*Point3D_128_Zero;
    913 
    914   ZDir := Point3D_128(ALookWhere)-ViewPoint;
    915   if IsPoint3D_128_Zero(ZDir) then exit;
    916   Normalize3D_128(ZDir);
    917 
    918   VectProduct3D_128(YDir,ZDir,XDir);
    919   VectProduct3D_128(ZDir,XDir,YDir); //correct Y dir
    920 
    921   FMatrix := Matrix3D(XDir,YDir,ZDir,ViewPoint);
    922   ComposedMatrix := MatrixIdentity3D;
    923   CurPart := self.FContainer;
    924   while CurPart <> nil do
    925   begin
    926     ComposedMatrix := CurPart.Matrix*ComposedMatrix;
    927     CurPart := CurPart.Container;
    928   end;
    929   FMatrix := MatrixInverse3D(ComposedMatrix)*FMatrix;
    930 end;
    931 
    932 procedure TBGRAPart3D.RemoveUnusedVertices;
    933 var
    934   i: Integer;
    935 begin
    936   for i := FVertexCount-1 downto 0 do
    937     if FVertices[i].Usage <= 2 then RemoveVertex(i);
    938   for i := 0 to FPartCount-1 do
    939     FParts[i].RemoveUnusedVertices;
    940 end;
    941 
    942 function TBGRAPart3D.IndexOf(AVertex: IBGRAVertex3D): integer;
    943 var i: integer;
    944 begin
    945   for i := 0 to FVertexCount-1 do
    946     if FVertices[i] = AVertex then
    947     begin
    948       result := i;
    949       exit;
    950     end;
    951   result := -1;
    952 end;
    953 
    954 procedure TBGRAPart3D.Add(AVertex: IBGRAVertex3D);
    955 begin
    956   if FVertexCount = length(FVertices) then
    957     setlength(FVertices, FVertexCount*2+3);
    958   FVertices[FVertexCount] := AVertex;
    959   inc(FVertexCount);
    960 end;
    961 
    962 procedure TBGRAPart3D.RemoveVertex(Index: integer);
    963 var i: integer;
    964 begin
    965   if (Index >= 0) and (Index < FVertexCount) then
    966   begin
    967     for i := Index to FVertexCount-2 do
    968       FVertices[i] := FVertices[i+1];
    969     FVertices[FVertexCount-1] := nil;
    970     dec(FVertexCount);
    971   end;
    972 end;
    973 
    974 function TBGRAPart3D.GetRadius: single;
    975 var i: integer;
    976     pt: TPoint3D_128;
    977     d: single;
    978 begin
    979   result := 0;
    980   for i := 0 to GetVertexCount-1 do
    981   begin
    982     pt := GetVertex(i).SceneCoord_128;
    983     d:= sqrt(DotProduct3D_128(pt,pt));
    984     if d > result then result := d;
    985   end;
    986 end;
    987 
    988 constructor TBGRAPart3D.Create(AContainer: IBGRAPart3D);
    989 begin
    990   FContainer := AContainer;
    991   FMatrix := MatrixIdentity3D;
    992   FCoordPool := TBGRACoordPool3D.Create(4);
    993 end;
    994 
    995 destructor TBGRAPart3D.Destroy;
    996 begin
    997   FCoordPool.Free;
    998   inherited Destroy;
    999 end;
    1000 
    1001 procedure TBGRAPart3D.Clear(ARecursive: boolean);
    1002 var i: integer;
    1003 begin
    1004   FVertices := nil;
    1005   FVertexCount := 0;
    1006   if ARecursive then
    1007   begin
    1008     for i := 0 to FPartCount-1 do
    1009       FParts[i].Clear(ARecursive);
    1010     FParts := nil;
    1011     FPartCount := 0;
    1012   end;
    1013 end;
    1014 
    1015 function TBGRAPart3D.Add(x, y, z: single): IBGRAVertex3D;
    1016 begin
    1017   result := TBGRAVertex3D.Create(FCoordPool,Point3D(x,y,z));
    1018   Add(result);
    1019 end;
    1020 
    1021 function TBGRAPart3D.Add(pt: TPoint3D): IBGRAVertex3D;
    1022 begin
    1023   result := TBGRAVertex3D.Create(FCoordPool,pt);
    1024   Add(result);
    1025 end;
    1026 
    1027 function TBGRAPart3D.Add(pt: TPoint3D_128): IBGRAVertex3D;
    1028 begin
    1029   result := TBGRAVertex3D.Create(FCoordPool,pt);
    1030   Add(result);
    1031 end;
    1032 
    1033 function TBGRAPart3D.Add(const coords: array of single
    1034   ): arrayOfIBGRAVertex3D;
    1035 var pts: array of TPoint3D;
    1036     CoordsIdx: integer;
    1037     i: Integer;
    1038 begin
    1039   if length(coords) mod 3 <> 0 then
    1040     raise exception.Create('Array size must be a multiple of 3');
    1041   setlength(pts, length(coords) div 3);
    1042   coordsIdx := 0;
    1043   for i := 0 to high(pts) do
    1044   begin
    1045     pts[i] := Point3D(coords[CoordsIdx],coords[CoordsIdx+1],coords[CoordsIdx+2]);
    1046     inc(coordsIdx,3);
    1047   end;
    1048   result := Add(pts);
    1049 end;
    1050 
    1051 function TBGRAPart3D.Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D;
    1052 var
    1053   i: Integer;
    1054 begin
    1055   setlength(result, length(pts));
    1056   for i := 0 to high(pts) do
    1057     result[i] := TBGRAVertex3D.Create(FCoordPool,pts[i]);
    1058   Add(result);
    1059 end;
    1060 
    1061 function TBGRAPart3D.Add(const pts: array of TPoint3D_128
    1062   ): arrayOfIBGRAVertex3D;
    1063 var
    1064   i: Integer;
    1065 begin
    1066   setlength(result, length(pts));
    1067   for i := 0 to high(pts) do
    1068     result[i] := TBGRAVertex3D.Create(FCoordPool,pts[i]);
    1069   Add(result);
    1070 end;
    1071 
    1072 procedure TBGRAPart3D.Add(const pts: array of IBGRAVertex3D);
    1073 var
    1074   i: Integer;
    1075 begin
    1076   if FVertexCount + length(pts) > length(FVertices) then
    1077     setlength(FVertices, (FVertexCount*2 + length(pts))+1);
    1078   for i := 0 to high(pts) do
    1079   begin
    1080     FVertices[FVertexCount] := pts[i];
    1081     inc(FVertexCount);
    1082   end;
    1083 end;
    1084 
    1085 function TBGRAPart3D.GetBoundingBox: TBox3D;
    1086 var i: integer;
    1087     pt: TPoint3D_128;
    1088 begin
    1089   if GetVertexCount > 0 then
    1090   begin
    1091     result.min := GetVertex(0).SceneCoord;
    1092     result.max := result.min;
    1093   end else
    1094   begin
    1095     result.min := Point3D(0,0,0);
    1096     result.max := Point3D(0,0,0);
    1097     exit;
    1098   end;
    1099   for i := 1 to GetVertexCount-1 do
    1100   begin
    1101     pt := GetVertex(i).SceneCoord_128;
    1102     if pt.x < result.min.x then result.min.x := pt.x else
    1103     if pt.x > result.max.x then result.max.x := pt.x;
    1104     if pt.y < result.min.y then result.min.y := pt.y else
    1105     if pt.y > result.max.y then result.max.y := pt.y;
    1106     if pt.z < result.min.z then result.min.z := pt.z else
    1107     if pt.z > result.max.z then result.max.z := pt.z;
    1108   end;
    1109 end;
    1110 
    1111 function TBGRAPart3D.GetMatrix: TMatrix3D;
    1112 begin
    1113   result := FMatrix;
    1114 end;
    1115 
    1116 function TBGRAPart3D.GetPart(AIndex: Integer): IBGRAPart3D;
    1117 begin
    1118   if (AIndex < 0) or (AIndex >= FPartCount) then
    1119     raise exception.Create('Index of out bounds');
    1120   result := FParts[AIndex];
    1121 end;
    1122 
    1123 function TBGRAPart3D.GetPartCount: integer;
    1124 begin
    1125   result := FPartCount;
    1126 end;
    1127 
    1128 function TBGRAPart3D.GetVertex(AIndex: Integer): IBGRAVertex3D;
    1129 begin
    1130   if (AIndex < 0) or (AIndex >= FVertexCount) then
    1131     raise exception.Create('Index of out bounds');
    1132   result := FVertices[AIndex];
    1133 end;
    1134 
    1135 function TBGRAPart3D.GetVertexCount: integer;
    1136 begin
    1137   result := FVertexCount;
    1138 end;
    1139 
    1140 function TBGRAPart3D.GetTotalVertexCount: integer;
    1141 var i: integer;
    1142 begin
    1143   result := GetVertexCount;
    1144   for i := 0 to GetPartCount-1 do
    1145     result += GetPart(i).GetTotalVertexCount;
    1146 end;
    1147 
    1148 procedure TBGRAPart3D.ResetTransform;
    1149 begin
    1150   FMatrix := MatrixIdentity3D;
    1151 end;
    1152 
    1153 procedure TBGRAPart3D.Scale(size: single; Before: boolean = true);
    1154 begin
    1155   Scale(size,size,size,Before);
    1156 end;
    1157 
    1158 procedure TBGRAPart3D.Scale(x, y, z: single; Before: boolean = true);
    1159 begin
    1160   Scale(Point3D(x,y,z),Before);
    1161 end;
    1162 
    1163 procedure TBGRAPart3D.Scale(size: TPoint3D; Before: boolean = true);
    1164 begin
    1165   if Before then
    1166     FMatrix *= MatrixScale3D(size)
    1167   else
    1168     FMatrix := MatrixScale3D(size)*FMatrix;
    1169 end;
    1170 
    1171 procedure TBGRAPart3D.RotateXDeg(angle: single; Before: boolean = true);
    1172 begin
    1173   RotateXRad(-angle*Pi/180, Before);
    1174 end;
    1175 
    1176 procedure TBGRAPart3D.RotateYDeg(angle: single; Before: boolean = true);
    1177 begin
    1178   RotateYRad(-angle*Pi/180, Before);
    1179 end;
    1180 
    1181 procedure TBGRAPart3D.RotateZDeg(angle: single; Before: boolean = true);
    1182 begin
    1183   RotateZRad(-angle*Pi/180, Before);
    1184 end;
    1185 
    1186 procedure TBGRAPart3D.RotateXRad(angle: single; Before: boolean = true);
    1187 begin
    1188   if Before then
    1189     FMatrix *= MatrixRotateX(angle)
    1190   else
    1191     FMatrix := MatrixRotateX(angle) * FMatrix;
    1192 end;
    1193 
    1194 procedure TBGRAPart3D.RotateYRad(angle: single; Before: boolean = true);
    1195 begin
    1196   if Before then
    1197     FMatrix *= MatrixRotateY(angle)
    1198   else
    1199     FMatrix := MatrixRotateY(angle) * FMatrix;
    1200 end;
    1201 
    1202 procedure TBGRAPart3D.RotateZRad(angle: single; Before: boolean = true);
    1203 begin
    1204   if Before then
    1205     FMatrix *= MatrixRotateZ(angle)
    1206   else
    1207     FMatrix := MatrixRotateZ(angle) * FMatrix;
    1208 end;
    1209 
    1210 procedure TBGRAPart3D.SetMatrix(const AValue: TMatrix3D);
    1211 begin
    1212   FMatrix := AValue;
    1213 end;
    1214 
    1215 procedure TBGRAPart3D.ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
    1216 var
    1217   i: Integer;
    1218   Composed: TMatrix3D;
    1219   P: PBGRACoordData3D;
    1220 begin
    1221   Composed := AMatrix* self.FMatrix;
    1222   {$IFDEF CPUI386}
    1223   if UseSSE then
    1224   begin
    1225     Matrix3D_SSE_Load(Composed);
    1226     asm
    1227       mov eax,[AProjection]
    1228       movups xmm4,[eax]
    1229       xorps xmm1,xmm1
    1230     end;
    1231     P := FCoordPool.CoordData[0];
    1232     i := FCoordPool.UsedCapacity;
    1233     if UseSSE3 then
    1234     begin
    1235       while i > 0 do
    1236       with P^ do
    1237       begin
    1238         MatrixMultiplyVect3D_SSE3_Aligned(sceneCoord,viewCoord);
    1239         if viewCoord.z > 0 then
    1240         begin
    1241           asm
    1242             mov eax, P
    1243             movaps xmm3, [eax+16] //viewCoord
    1244             movaps xmm2,xmm3
    1245             shufps xmm2,xmm3,2+8+32+128
    1246             rcpps xmm2,xmm2  //xmm2 = InvZ
    1247             movss [eax+40],xmm2 //-> InvZ
    1248 
    1249             mulps xmm3,xmm4  //xmm3 *= Projection.Zoom
    1250             mulps xmm3,xmm2  //xmm3 *= InvZ
    1251 
    1252             movhlps xmm0,xmm4  //xmm2 = Projection.Center
    1253             addps xmm3,xmm0  //xmm3 += Projection.Center
    1254 
    1255             movlps [eax+32],xmm3 //->projectedCoord
    1256             movaps [eax+48],xmm1 //->normal
    1257           end;
    1258         end else
    1259         asm
    1260           mov eax, P
    1261           movlps [eax+32],xmm1  //0 ->projectedCoord
    1262           movaps [eax+48],xmm1 //->normal
    1263         end;
    1264         dec(i);
    1265         inc(p);
    1266       end;
    1267     end else
    1268     begin
    1269       while i > 0 do
    1270       with P^ do
    1271       begin
    1272         MatrixMultiplyVect3D_SSE_Aligned(sceneCoord,viewCoord);
    1273         if viewCoord.z > 0 then
    1274         begin
    1275           asm
    1276             mov eax, P
    1277             movaps xmm3, [eax+16] //viewCoord
    1278             movaps xmm2,xmm3
    1279             shufps xmm2,xmm3,2+8+32+128
    1280             rcpps xmm2,xmm2  //xmm2 = InvZ
    1281             movss [eax+40],xmm2 //-> InvZ
    1282 
    1283             mulps xmm3,xmm4  //xmm3 *= Projection.Zoom
    1284             mulps xmm3,xmm2  //xmm3 *= InvZ
    1285 
    1286             movhlps xmm0,xmm4  //xmm2 = Projection.Center
    1287             addps xmm3,xmm0  //xmm3 += Projection.Center
    1288 
    1289             movlps [eax+32],xmm3 //->projectedCoord
    1290             movaps [eax+48],xmm1 //->normal
    1291           end;
    1292         end else
    1293         asm
    1294           mov eax, P
    1295           movlps [eax+32],xmm1  //0 ->projectedCoord
    1296           movaps [eax+48],xmm1 //->normal
    1297         end;
    1298         dec(i);
    1299         inc(p);
    1300       end;
    1301     end;
    1302   end
    1303   else
    1304   {$ENDIF}
    1305   begin
    1306     P := FCoordPool.CoordData[0];
    1307     i := FCoordPool.UsedCapacity;
    1308     while i > 0 do
    1309     with P^ do
    1310     begin
    1311       viewCoord := Composed*sceneCoord;
    1312       ClearPoint3D_128(viewNormal);
    1313       if viewCoord.z > 0 then
    1314       begin
    1315         InvZ := 1/viewCoord.z;
    1316         projectedCoord := PointF(viewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x,
    1317                                  viewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y);
    1318       end else
    1319         projectedCoord := PointF(0,0);
    1320       dec(i);
    1321       inc(p);
    1322     end;
    1323   end;
    1324   for i := 0 to FPartCount-1 do
    1325     FParts[i].ComputeWithMatrix(Composed,AProjection);
    1326 end;
    1327 
    1328 function TBGRAPart3D.ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF;
    1329 var part: IBGRAPart3D;
    1330   newViewCoord: TPoint3D_128;
    1331   InvZ: single;
    1332 begin
    1333   newViewCoord := FMatrix * ASceneCoord;
    1334   part := FContainer;
    1335   while part <> nil do
    1336   begin
    1337     newViewCoord := part.Matrix * newViewCoord;
    1338     part := part.Container;
    1339   end;
    1340   if NewViewCoord.z > 0 then
    1341   begin
    1342     InvZ := 1/NewViewCoord.z;
    1343     result := PointF(NewViewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x,
    1344                      NewViewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y);
    1345   end else
    1346     result := PointF(0,0);
    1347 end;
    1348 
    1349 procedure TBGRAPart3D.NormalizeViewNormal;
    1350 var
    1351   i: Integer;
    1352 begin
    1353   for i := 0 to FVertexCount-1 do
    1354     FVertices[i].NormalizeViewNormal;
    1355   for i := 0 to FPartCount-1 do
    1356     FParts[i].NormalizeViewNormal;
    1357 end;
    1358 
    1359 procedure TBGRAPart3D.Translate(x, y, z: single; Before: boolean = true);
    1360 begin
    1361   Translate(Point3D(x,y,z),Before);
    1362 end;
    1363 
    1364 procedure TBGRAPart3D.Translate(ofs: TPoint3D; Before: boolean = true);
    1365 begin
    1366   if Before then
    1367     FMatrix *= MatrixTranslation3D(ofs)
    1368   else
    1369     FMatrix := MatrixTranslation3D(ofs)*FMatrix;
    1370 end;
    1371 
    1372 function TBGRAPart3D.CreatePart: IBGRAPart3D;
    1373 begin
    1374   if FPartCount = length(FParts) then
    1375     setlength(FParts, FPartCount*2+1);
    1376   result := TBGRAPart3D.Create(self);
    1377   FParts[FPartCount] := result;
    1378   inc(FPartCount);
    1379 end;
    1380 
    1381 function TBGRAPart3D.GetContainer: IBGRAPart3D;
    1382 begin
    1383   result := FContainer;
    1384 end;
    1385 
    1386 procedure TBGRAPart3D.SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
    1387 begin
    1388   if (AIndex < 0) or (AIndex >= FVertexCount) then
    1389     raise exception.Create('Index of out bounds');
    1390   FVertices[AIndex] := AValue;
    1391 end;
    1392 
    1393 { TBGRAObject3D }
    1394 
    1395 procedure TBGRAObject3D.AddFace(AFace: IBGRAFace3D);
    1396 begin
    1397   if FFaceCount = length(FFaces) then
    1398      setlength(FFaces,FFaceCount*2+3);
    1399   FFaces[FFaceCount] := AFace;
    1400   inc(FFaceCount);
    1401 end;
    1402 
    1403 constructor TBGRAObject3D.Create(AScene: TBGRAScene3D);
    1404 begin
    1405   FColor := BGRAWhite;
    1406   FLight := 1;
    1407   FTexture := nil;
    1408   FMainPart := TBGRAPart3D.Create(nil);
    1409   FLightingNormal:= AScene.DefaultLightingNormal;
    1410   FParentLighting:= True;
    1411   FScene := AScene;
    1412 end;
    1413 
    1414 destructor TBGRAObject3D.Destroy;
    1415 begin
    1416   fillchar(FTexture,sizeof(FTexture),0);
    1417   inherited Destroy;
    1418 end;
    1419 
    1420 procedure TBGRAObject3D.Clear;
    1421 begin
    1422   FFaces := nil;
    1423   FFaceCount := 0;
    1424   FMainPart.Clear(True);
    1425 end;
    1426 
    1427 function TBGRAObject3D.GetColor: TBGRAPixel;
    1428 begin
    1429   result := FColor;
    1430 end;
    1431 
    1432 function TBGRAObject3D.GetLight: Single;
    1433 begin
    1434   result := FLight;
    1435 end;
    1436 
    1437 function TBGRAObject3D.GetTexture: IBGRAScanner;
    1438 begin
    1439   result := FTexture;
    1440 end;
    1441 
    1442 function TBGRAObject3D.GetMainPart: IBGRAPart3D;
    1443 begin
    1444   result := FMainPart;
    1445 end;
    1446 
    1447 procedure TBGRAObject3D.SetColor(const AValue: TBGRAPixel);
    1448 begin
    1449   FColor := AValue;
    1450   FTexture := nil;
    1451 end;
    1452 
    1453 procedure TBGRAObject3D.SetLight(const AValue: Single);
    1454 begin
    1455   FLight := AValue;
    1456 end;
    1457 
    1458 procedure TBGRAObject3D.SetTexture(const AValue: IBGRAScanner);
    1459 begin
    1460   FTexture := AValue;
    1461 end;
    1462 
    1463 procedure TBGRAObject3D.SetMaterial(const AValue: IBGRAMaterial3D);
    1464 begin
    1465   FMaterial := AValue;
    1466 end;
    1467 
    1468 procedure TBGRAObject3D.RemoveUnusedVertices;
    1469 begin
    1470   GetMainPart.RemoveUnusedVertices;
    1471 end;
    1472 
    1473 procedure TBGRAObject3D.SeparatePart(APart: IBGRAPart3D);
    1474 var
    1475   vertexInfo: array of record
    1476        orig,dup: IBGRAVertex3D;
    1477      end;
    1478 
    1479   i,j: integer;
    1480   inPart,outPart: boolean;
    1481   idxV: integer;
    1482 begin
    1483   setlength(vertexInfo, APart.VertexCount);
    1484   for i := 0 to high(vertexInfo) do
    1485     with vertexInfo[i] do
    1486     begin
    1487       orig := APart.Vertex[i];
    1488       dup := APart.Add(orig.SceneCoord_128);
    1489     end;
    1490 
    1491   for i := 0 to GetFaceCount-1 do
    1492     with GetFace(i) do
    1493     begin
    1494       inPart := false;
    1495       outPart := false;
    1496       for j := 0 to VertexCount-1 do
    1497         if (APart.IndexOf(Vertex[j]) <> -1) then
    1498           inPart := true
    1499         else
    1500           outPart := true;
    1501 
    1502       if inPart and not outPart then
    1503       begin
    1504         for j := 0 to VertexCount-1 do
    1505         begin
    1506           idxV := APart.IndexOf(Vertex[j]);
    1507           if idxV <> -1 then
    1508             Vertex[j] := vertexInfo[idxV].dup;
    1509         end;
    1510       end;
    1511     end;
    1512 
    1513   for i := APart.VertexCount-1 downto 0 do
    1514     APart.RemoveVertex(i);
    1515 end;
    1516 
    1517 function TBGRAObject3D.GetScene: TBGRAScene3D;
    1518 begin
    1519   result := FScene;
    1520 end;
    1521 
    1522 function TBGRAObject3D.GetRefCount: integer;
    1523 begin
    1524   result := RefCount;
    1525 end;
    1526 
    1527 procedure TBGRAObject3D.SetBiface(AValue: boolean);
    1528 var i: integer;
    1529 begin
    1530   for i := 0 to GetFaceCount-1 do
    1531     GetFace(i).Biface := AValue;
    1532 end;
    1533 
    1534 function TBGRAObject3D.GetLightingNormal: TLightingNormal3D;
    1535 begin
    1536   result := FLightingNormal;
    1537 end;
    1538 
    1539 function TBGRAObject3D.GetParentLighting: boolean;
    1540 begin
    1541   result := FParentLighting;
    1542 end;
    1543 
    1544 procedure TBGRAObject3D.SetLightingNormal(const AValue: TLightingNormal3D);
    1545 begin
    1546   FLightingNormal := AValue;
    1547   FParentLighting:= False;
    1548 end;
    1549 
    1550 procedure TBGRAObject3D.SetParentLighting(const AValue: boolean);
    1551 begin
    1552   FParentLighting:= AValue;
    1553 end;
    1554 
    1555 procedure TBGRAObject3D.ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
    1556 var
    1557   i: Integer;
    1558 begin
    1559   FMainPart.ComputeWithMatrix(AMatrix,AProjection);
    1560   for i := 0 to FFaceCount-1 do
    1561     FFaces[i].ComputeViewNormalAndCenter;
    1562   FMainPart.NormalizeViewNormal;
    1563 end;
    1564 
    1565 function TBGRAObject3D.AddFaceReversed(const AVertices: array of IBGRAVertex3D
    1566   ): IBGRAFace3D;
    1567 var
    1568   tempVertices: array of IBGRAVertex3D;
    1569   i: Integer;
    1570 begin
    1571   setlength(tempVertices,length(AVertices));
    1572   for i := 0 to high(tempVertices) do
    1573     tempVertices[i] := AVertices[high(AVertices)-i];
    1574   result := AddFace(tempVertices);
    1575 end;
    1576 
    1577 function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
    1578 begin
    1579   result := TBGRAFace3D.Create(self,AVertices);
    1580   AddFace(result);
    1581 end;
    1582 
    1583 function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D;
    1584   ABiface: boolean): IBGRAFace3D;
    1585 begin
    1586   result := TBGRAFace3D.Create(self,AVertices);
    1587   result.Biface := ABiface;
    1588   AddFace(result);
    1589 end;
    1590 
    1591 function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D;
    1592 var Face: IBGRAFace3D;
    1593 begin
    1594   Face := TBGRAFace3D.Create(self,AVertices);
    1595   Face.Texture := ATexture;
    1596   AddFace(Face);
    1597   result := face;
    1598 end;
    1599 
    1600 function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D;
    1601   AColor: TBGRAPixel): IBGRAFace3D;
    1602 var Face: IBGRAFace3D;
    1603 begin
    1604   Face := TBGRAFace3D.Create(self,AVertices);
    1605   Face.SetColor(AColor);
    1606   Face.Texture := nil;
    1607   AddFace(Face);
    1608   result := face;
    1609 end;
    1610 
    1611 function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D;
    1612   AColors: array of TBGRAPixel): IBGRAFace3D;
    1613 var
    1614   i: Integer;
    1615 begin
    1616   if length(AColors) <> length(AVertices) then
    1617     raise Exception.Create('Dimension mismatch');
    1618   result := TBGRAFace3D.Create(self,AVertices);
    1619   for i := 0 to high(AColors) do
    1620     result.VertexColor[i] := AColors[i];
    1621   AddFace(result);
    1622 end;
    1623 
    1624 function TBGRAObject3D.GetFace(AIndex: integer): IBGRAFace3D;
    1625 begin
    1626   if (AIndex < 0) or (AIndex >= FFaceCount) then
    1627     raise Exception.Create('Index out of bounds');
    1628   result := FFaces[AIndex];
    1629 end;
    1630 
    1631 function TBGRAObject3D.GetFaceCount: integer;
    1632 begin
    1633   result := FFaceCount;
    1634 end;
    1635 
    1636 function TBGRAObject3D.GetTotalVertexCount: integer;
    1637 begin
    1638   result := GetMainPart.TotalVertexCount;
    1639 end;
    1640 
    1641 function TBGRAObject3D.GetMaterial: IBGRAMaterial3D;
    1642 begin
    1643   result := FMaterial;
    1644 end;
     236    procedure ForEachVertex(ACallback: TVertex3DCallback);
     237    procedure ForEachFace(ACallback: TFace3DCallback);
     238  end;
     239
     240{$i part3d.inc}
     241{$i object3d.inc}
     242{$i shapes3d.inc}
    1645243
    1646244{ TBGRAScene3D }
    … …  
    1746344end;
    1747345
     346function TBGRAScene3D.GetNormalCount: integer;
     347var i: integer;
     348begin
     349  result := 0;
     350  for i := 0 to Object3DCount-1 do
     351    result += Object3D[i].TotalNormalCount;
     352end;
     353
    1748354function TBGRAScene3D.GetAmbiantLightness: single;
    1749355begin
    … …  
    1822428procedure TBGRAScene3D.Init;
    1823429begin
     430  UnknownColor := BGRA(0,128,255);
    1824431  FAutoZoom := True;
    1825432  FAutoViewCenter := True;
    … …  
    1866473var i: integer;
    1867474begin
     475  for i := 0 to FLights.Count-1 do
     476    TBGRALight3D(FLights[i])._Release;
     477  FLights.Clear;
     478
    1868479  for i := 0 to FObjectCount-1 do
    1869480    FObjects[i].Clear;
    1870481  FObjects := nil;
    1871482  FObjectCount := 0;
    1872   for i := 0 to FLights.Count-1 do
    1873     IBGRALight3D(TBGRALight3D(FLights[i]))._Release;
    1874   FLights.Clear;
    1875 end;
    1876 
    1877 {$hints off}
     483
     484  FMaterials := nil;
     485  FMaterialCount := 0;
     486  DefaultMaterial := CreateMaterial;
     487end;
     488
    1878489procedure TBGRAScene3D.UseMaterial(AMaterialName: string; AFace: IBGRAFace3D);
    1879 var color: TBGRAPixel;
    1880 begin
    1881   color := BGRA(0,128,255);
    1882   AFace.SetColor(color);
    1883 end;
    1884 {$hints on}
     490
     491  function ParseColor(text: string): TBGRAPixel;
     492  var
     493    color,tempColor: TBGRAPixel;
     494  begin
     495    color := UnknownColor;
     496
     497    if copy(text,1,2) = 'dk' then
     498    begin
     499      tempcolor := ParseColor(copy(text,3,length(text)-2));
     500      tempcolor := MergeBGRA(tempcolor,3,BGRABlack,1);
     501      color := StrToBGRA('dark'+copy(text,3,length(text)-2),tempcolor);
     502    end;
     503    if copy(text,1,2) = 'lt' then
     504    begin
     505      tempcolor := ParseColor(copy(text,3,length(text)-2));
     506      tempcolor := MergeBGRA(tempcolor,3,BGRAWhite,1);
     507      color := StrToBGRA('light'+copy(text,3,length(text)-2),tempcolor);
     508    end;
     509    Color := StrToBGRA(StringReplace(text,'deep','dark',[]),Color);
     510    Color := StrToBGRA(StringReplace(text,'dark','deep',[]),Color);
     511    Color := StrToBGRA(text,Color);
     512    result := color;
     513  end;
     514
     515var
     516  mat: IBGRAMaterial3D;
     517  c: TBGRAPixel;
     518begin
     519  mat := GetMaterialByName(AMaterialName);
     520  if mat = nil then
     521  begin
     522    mat := CreateMaterial;
     523    mat.Name := AMaterialName;
     524    c := ParseColor(AMaterialName);
     525    mat.AmbiantColor := c;
     526    mat.DiffuseColor := c;
     527  end;
     528  AFace.Material := mat;
     529end;
     530
     531function TBGRAScene3D.FetchTexture(AName: string; out texSize: TPointF): IBGRAScanner;
     532begin
     533  result := nil;
     534  texSize := PointF(1,1);
     535end;
    1885536
    1886537function TBGRAScene3D.LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean): IBGRAObject3D;
    1887 var t: textfile;
    1888     s: string;
     538var source: TFileStream;
     539begin
     540  source := TFileStream.Create(AFilename,fmOpenRead,fmShareDenyWrite);
     541  try
     542    result := LoadObjectFromStream(source,SwapFacesOrientation);
     543  finally
     544    source.free;
     545  end;
     546end;
     547
     548function TBGRAScene3D.LoadObjectFromFileUTF8(AFilename: string;
     549  SwapFacesOrientation: boolean): IBGRAObject3D;
     550var source: TFileStreamUTF8;
     551begin
     552  source := TFileStreamUTF8.Create(AFilename,fmOpenRead,fmShareDenyWrite);
     553  try
     554    result := LoadObjectFromStream(source,SwapFacesOrientation);
     555  finally
     556    source.free;
     557  end;
     558end;
     559
     560function TBGRAScene3D.LoadObjectFromStream(AStream: TStream;
     561  SwapFacesOrientation: boolean): IBGRAObject3D;
     562var s: string;
     563  secondValue,thirdValue: string;
    1889564
    1890565  function GetNextToken: string;
    1891   var idxStart,idxEnd: integer;
     566  var idxStart,idxEnd,idxSlash: integer;
    1892567  begin
    1893568    idxStart := 1;
    1894     while (idxStart <= length(s)) and (s[idxStart]=' ') do inc(idxStart);
     569    while (idxStart <= length(s)) and (s[idxStart]in[' ',#9]) do inc(idxStart);
    1895570    if idxStart > length(s) then
    1896571    begin
    … …  
    1899574    end;
    1900575    idxEnd := idxStart;
    1901     while (idxEnd < length(s)) and (s[idxEnd+1]<> ' ') do inc(idxEnd);
     576    while (idxEnd < length(s)) and not (s[idxEnd+1]in[' ',#9]) do inc(idxEnd);
    1902577    result := copy(s,idxStart, idxEnd-idxStart+1);
    1903578    delete(s,1,idxEnd);
    1904     if pos('/',result) <> 0 then result := copy(result,1,pos('/',result)-1);
     579    idxSlash := pos('/',result);
     580    if idxSlash <> 0 then
     581    begin
     582      secondValue:= copy(result,idxSlash+1,length(result)-idxSlash);
     583      result := copy(result,1,idxSlash-1);
     584      idxSlash:= pos('/',secondValue);
     585      if idxSlash <> 0 then
     586      begin
     587        thirdValue:= copy(secondValue,idxSlash+1,length(secondValue)-idxSlash);
     588        secondValue:= copy(secondValue,1,idxSlash-1);
     589      end else
     590        thirdValue:= '';
     591    end else
     592    begin
     593      secondValue:= '';
     594      thirdValue:= '';
     595    end;
     596  end;
     597
     598type
     599  TFaceVertexExtra = record
     600    normal: IBGRANormal3D;
     601    texCoord: TPointF;
    1905602  end;
    1906603
    … …  
    1908605    x,y,z : single;
    1909606    code : integer;
    1910     vertices: array of IBGRAVertex3D;
    1911     NbVertices,v,i: integer;
     607    faceVertices: array of IBGRAVertex3D;
     608    faceExtra: array of TFaceVertexExtra;
     609    NbFaceVertices,v,v2,v3,i: integer;
    1912610    tempV: IBGRAVertex3D;
     611    tempN: TFaceVertexExtra;
    1913612    materialname: string;
    1914613    face: IBGRAFace3D;
    1915 
    1916 begin
     614    lines: TStringList;
     615    lineIndex: integer;
     616    texCoords: array of TPointF;
     617    nbTexCoords: integer;
     618
     619begin
     620  lines := TStringList.Create;
     621  lines.LoadFromStream(AStream);
    1917622  result := CreateObject;
    1918   assignfile(t,AFilename);
    1919   reset(t);
    1920   vertices := nil;
    1921   NbVertices:= 0;
     623  faceVertices := nil;
     624  faceExtra := nil;
     625  NbFaceVertices:= 0;
    1922626  materialname := 'default';
    1923   while not eof(t) do
    1924   begin
    1925     readln(t,s);
     627  lineIndex := 0;
     628  texCoords := nil;
     629  nbTexCoords:= 0;
     630  while lineIndex < lines.Count do
     631  begin
     632    s := lines[lineIndex];
     633    if pos('#',s) <> 0 then
     634      s := copy(s,1,pos('#',s)-1);
     635    inc(lineIndex);
    1926636    lineType := GetNextToken;
    1927637    if lineType = 'v' then
    … …  
    1932642      result.MainPart.Add(x,y,z);
    1933643    end else
     644    if lineType = 'vt' then
     645    begin
     646      val(GetNextToken,x,code);
     647      val(GetNextToken,y,code);
     648      if nbTexCoords >= length(texCoords) then
     649        setlength(texCoords, length(texCoords)*2+1);
     650      texCoords[nbTexCoords] := PointF(x,y);
     651      inc(nbTexCoords);
     652    end else
     653    if lineType = 'vn' then
     654    begin
     655      val(GetNextToken,x,code);
     656      val(GetNextToken,y,code);
     657      val(GetNextToken,z,code);
     658      result.MainPart.AddNormal(x,y,z);
     659      result.LightingNormal := lnVertex;
     660    end else
    1934661    if lineType = 'usemtl' then
    1935662      materialname := trim(s)
    … …  
    1937664    if lineType = 'f' then
    1938665    begin
    1939       NbVertices:= 0;
     666      NbFaceVertices:= 0;
    1940667      repeat
    1941668        val(GetNextToken,v,code);
     669        if (code = 0) and (v < 0) then v := result.MainPart.VertexCount+1+v;
    1942670        if (code = 0) and (v >= 1) and (v <= result.MainPart.VertexCount) then
    1943671        begin
    1944           if length(vertices) = nbvertices then
    1945             setlength(vertices, length(vertices)*2+1);
    1946           vertices[NbVertices] := result.MainPart.Vertex[v-1];
    1947           inc(NbVertices);
     672          if length(faceVertices) = NbFaceVertices then
     673          begin
     674            setlength(faceVertices, length(faceVertices)*2+1);
     675            setlength(faceExtra, length(faceExtra)*2+1);
     676          end;
     677          faceVertices[NbFaceVertices] := result.MainPart.Vertex[v-1];
     678          val(secondValue,v2,code);
     679          if (code = 0) and (v2 < 0) then v2 := nbTexCoords+1+v2;
     680          if (code = 0) and (v2 >= 1) and (v2-1 < nbTexCoords) then
     681            faceExtra[NbFaceVertices].texCoord := texCoords[v2-1]
     682          else if nbTexCoords > v-1 then
     683            faceExtra[NbFaceVertices].texCoord := texCoords[v-1]
     684          else
     685            faceExtra[NbFaceVertices].texCoord := PointF(0,0);
     686          val(thirdValue,v3,code);
     687          if (code = 0) and (v3 < 0) then v3 := result.MainPart.NormalCount+1+v3;
     688          if code = 0 then
     689            faceExtra[NbFaceVertices].normal := result.MainPart.Normal[v3-1]
     690          else if result.MainPart.NormalCount > v-1 then
     691            faceExtra[NbFaceVertices].normal := result.MainPart.Normal[v-1]
     692          else
     693            faceExtra[NbFaceVertices].normal := nil;
     694          inc(NbFaceVertices);
    1948695        end else break;
    1949696      until false;
    1950       if NbVertices > 2 then
     697      if NbFaceVertices > 2 then
    1951698      begin
    1952699        if SwapFacesOrientation then
    1953           for i := 0 to NbVertices div 2-1 do
     700          for i := 0 to NbFaceVertices div 2-1 do
    1954701          begin
    1955             tempV := vertices[i];
    1956             vertices[i] := vertices[NbVertices-1-i];
    1957             vertices[NbVertices-1-i] := tempV;
     702            tempV := faceVertices[i];
     703            faceVertices[i] := faceVertices[NbFaceVertices-1-i];
     704            faceVertices[NbFaceVertices-1-i] := tempV;
     705            tempN := faceExtra[i];
     706            faceExtra[i] := faceExtra[NbFaceVertices-1-i];
     707            faceExtra[NbFaceVertices-1-i] := tempN;
    1958708          end;
    1959         face := result.AddFace(slice(vertices,NbVertices));
     709        face := result.AddFace(slice(faceVertices,NbFaceVertices));
     710        for i := 0 to NbFaceVertices-1 do
     711        begin
     712          face.SetNormal(i, faceExtra[i].normal);
     713          face.SetTexCoord(i, faceExtra[i].texCoord);
     714        end;
    1960715        face.MaterialName := materialname;
    1961716      end;
    1962717    end;
    1963718  end;
    1964   closefile(t);
     719  lines.Free;
     720end;
     721
     722procedure TBGRAScene3D.LoadMaterialsFromFile(AFilename: string);
     723var source: TFileStream;
     724begin
     725  source := TFileStream.Create(AFilename,fmOpenRead,fmShareDenyWrite);
     726  try
     727    LoadMaterialsFromStream(source);
     728  finally
     729    source.free;
     730  end;
     731end;
     732
     733procedure TBGRAScene3D.LoadMaterialsFromFileUTF8(AFilename: string);
     734var source: TFileStreamUTF8;
     735begin
     736  source := TFileStreamUTF8.Create(AFilename,fmOpenRead,fmShareDenyWrite);
     737  try
     738    LoadMaterialsFromStream(source);
     739  finally
     740    source.free;
     741  end;
     742end;
     743
     744procedure TBGRAScene3D.LoadMaterialsFromStream(AStream: TStream);
     745var
     746  s: String;
     747
     748  function GetNextToken: string;
     749  var idxStart,idxEnd: integer;
     750  begin
     751    idxStart := 1;
     752    while (idxStart <= length(s)) and (s[idxStart]in[#9,' ']) do inc(idxStart);
     753    if idxStart > length(s) then
     754    begin
     755      result := '';
     756      exit;
     757    end;
     758    idxEnd := idxStart;
     759    while (idxEnd < length(s)) and not (s[idxEnd+1]in[#9,' ']) do inc(idxEnd);
     760    result := copy(s,idxStart, idxEnd-idxStart+1);
     761    delete(s,1,idxEnd);
     762  end;
     763
     764  function GetSingle: single;
     765  var code: integer;
     766  begin
     767    val(GetNextToken,result,code);
     768  end;
     769
     770  function GetColorF: TColorF;
     771  var r,g,b: single;
     772    code: integer;
     773  begin
     774    val(GetNextToken,r,code);
     775    val(GetNextToken,g,code);
     776    val(GetNextToken,b,code);
     777    result := ColorF(r,g,b,1);
     778  end;
     779
     780var
     781  lines: TStringList;
     782  lineIndex: integer;
     783  lineType: String;
     784  currentMaterial: IBGRAMaterial3D;
     785  materialName: string;
     786  texZoom: TPointF;
     787  v: single;
     788
     789begin
     790  lines := TStringList.Create;
     791  lines.LoadFromStream(AStream);
     792  lineIndex := 0;
     793  while lineIndex < lines.Count do
     794  begin
     795    s := lines[lineIndex];
     796    if pos('#',s) <> 0 then
     797      s := copy(s,1,pos('#',s)-1);
     798    inc(lineIndex);
     799    lineType := GetNextToken;
     800    if lineType = 'newmtl' then
     801    begin
     802      materialName := trim(s);
     803      currentMaterial := GetMaterialByName(materialName);
     804      if currentMaterial = nil then
     805      begin
     806        currentMaterial := CreateMaterial;
     807        currentMaterial.Name := materialName;
     808      end;
     809    end else
     810    if currentMaterial <> nil then
     811    begin
     812      if lineType = 'Ka' then currentMaterial.AmbiantColorF := GetColorF else
     813      if lineType = 'Kd' then currentMaterial.DiffuseColorF := GetColorF else
     814      if lineType = 'Ks' then currentMaterial.SpecularColorF := GetColorF else
     815      if (lineType = 'map_Ka') or (lineType = 'map_Kd') then
     816      begin
     817        currentMaterial.Texture := FetchTexture(trim(s),texZoom);
     818        texZoom.y := -texZoom.y;
     819        currentMaterial.TextureZoom := texZoom;
     820      end else
     821      if lineType = 'Ns' then currentMaterial.SpecularIndex := round(GetSingle) else
     822      if lineType = 'd' then
     823      begin
     824        v := GetSingle;
     825        if v > 1 then
     826          currentMaterial.SimpleAlpha := 255
     827        else if v < 0 then
     828          currentMaterial.SimpleAlpha := 0
     829        else
     830          currentMaterial.SimpleAlpha := round(v*255);
     831      end;
     832    end;
     833  end;
     834  lines.Free;
    1965835end;
    1966836
    … …  
    23581228            LColors[idxL] := BGRA(128,128,128)
    23591229          else
     1230          begin
    23601231            if ColorOverride then
    23611232              LColors[idxL] := Color
    … …  
    23671238                LColors[idxL] := tempV.Color;
    23681239            end;
     1240          end;
    23691241
    23701242          if TexCoordOverride then
    … …  
    23721244          else
    23731245            LTexCoord[idxL] := tempV.TexCoord;
     1246          with LMaterial.GetTextureZoom do
     1247          begin
     1248            LTexCoord[idxL].x *= x;
     1249            LTexCoord[idxL].y *= y;
     1250          end;
    23741251
    23751252          with tempV.CoordData^ do
    … …  
    23801257            LZ[idxL] := viewCoord.Z;
    23811258          end;
     1259          if Normal <> nil then
     1260            LNormal3D[idxL] := Normal.ViewNormal_128;
    23821261        end;
    23831262      end;
    … …  
    23891268       VCount := VertexCount;
    23901269       if VCount < 3 then exit;
    2391 
    2392        if ParentTexture then
    2393          LTexture := Object3D.Texture
    2394        else
    2395          LTexture := Texture;
    23961270
    23971271       if Material <> nil then
    … …  
    24031277       else
    24041278         exit;
     1279
     1280       if ParentTexture then
     1281       begin
     1282         if LMaterial.GetTexture <> nil then
     1283           LTexture := LMaterial.GetTexture
     1284         else
     1285           LTexture := Object3D.Texture
     1286       end
     1287       else
     1288         LTexture := Texture;
    24051289
    24061290       LLightNormal := Object3D.LightingNormal;
    … …  
    26351519  procedure DrawWithResample;
    26361520  var
    2637     tempSurface,resampledTempSurface: TBGRACustomBitmap;
     1521    tempSurface: TBGRACustomBitmap;
    26381522  begin
    26391523    tempSurface := ASurface.NewBitmap(ASurface.Width*RenderingOptions.AntialiasingResampleLevel,ASurface.Height*RenderingOptions.AntialiasingResampleLevel);
    26401524    InternalRender(tempSurface, am3dNone, RenderingOptions.AntialiasingResampleLevel);
    2641     resampledTempSurface := tempSurface.Resample(ASurface.Width,ASurface.Height,rmSimpleStretch);
     1525    BGRAResample.DownSamplePutImage(tempSurface,RenderingOptions.AntialiasingResampleLevel,RenderingOptions.AntialiasingResampleLevel,
     1526                 ASurface, 0,0, dmDrawWithTransparency);
    26421527    tempSurface.Free;
    2643     ASurface.PutImage(0,0,resampledTempSurface,dmDrawWithTransparency);
    2644     resampledTempSurface.Free;
    26451528  end;
    26461529
    … …  
    27391622  Color: TBGRAPixel): TBGRAPixel;
    27401623var i: Integer;
    2741 begin
     1624  m: TBGRAMaterial3D;
     1625begin
     1626  m := TBGRAMaterial3D(Context^.material);
     1627  if not m.GetAutoSimpleColor then Color := ColorIntToBGRA(BGRAToColorIntMultiply(Color, m.GetSimpleColorInt));
     1628
    27421629  Context^.lightness := FAmbiantLightness;
    27431630
    … …  
    27671654  Color: TBGRAPixel): TBGRAPixel;
    27681655var i: Integer;
    2769 begin
    2770   Context^.diffuseColor := FAmbiantLightColor;
     1656  m: TBGRAMaterial3D;
     1657begin
     1658  m := TBGRAMaterial3D(Context^.material);
     1659
     1660  if m.GetAutoAmbiantColor then
     1661    Context^.diffuseColor := FAmbiantLightColor
     1662  else
     1663    Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt;
    27711664
    27721665  i := FLights.Count-1;
    … …  
    27841677  Color: TBGRAPixel): TBGRAPixel;
    27851678var i: Integer;
    2786 begin
    2787   Context^.diffuseColor := FAmbiantLightColor;
     1679  m: TBGRAMaterial3D;
     1680begin
     1681  m := TBGRAMaterial3D(Context^.material);
     1682
     1683  if m.GetAutoAmbiantColor then
     1684    Context^.diffuseColor := FAmbiantLightColor
     1685  else
     1686    Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt;
    27881687  Context^.specularColor := ColorInt65536(0,0,0,0);
    27891688
    … …  
    28021701end;
    28031702
    2804 {$hints off}
    28051703function TBGRAScene3D.ApplyNoLighting(Context: PSceneLightingContext;
    28061704  Color: TBGRAPixel): TBGRAPixel;
    2807 begin
    2808   result := Color;
     1705var
     1706  m: TBGRAMaterial3D;
     1707begin
     1708  m := TBGRAMaterial3D(Context^.material);
     1709
     1710  if not m.GetAutoAmbiantColor then
     1711    result := ColorIntToBGRA(BGRAToColorIntMultiply(Color, m.GetAmbiantColorInt))
     1712  else
     1713    result := Color;
    28091714end;
    28101715
    28111716function TBGRAScene3D.ApplyLightingWithAmbiantLightnessOnly(
    28121717  Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel;
    2813 begin
     1718var
     1719  m: TBGRAMaterial3D;
     1720begin
     1721  m := TBGRAMaterial3D(Context^.material);
     1722
     1723  if not m.GetAutoAmbiantColor then
     1724    Color := ColorIntToBGRA(BGRAToColorIntMultiply(Color, m.GetAmbiantColorInt));
     1725
    28141726  if FAmbiantLightness <= 0 then
    28151727    result := BGRA(0,0,0,color.alpha)
    … …  
    28171729    result := ApplyIntensityFast(Color, FAmbiantLightness);
    28181730end;
    2819 
    2820 {$hints on}
    28211731
    28221732function TBGRAScene3D.CreateObject: IBGRAObject3D;
    … …  
    29631873end;
    29641874
     1875function TBGRAScene3D.GetMaterialByName(AName: string): IBGRAMaterial3D;
     1876var i: integer;
     1877begin
     1878  for i := 0 to MaterialCount-1 do
     1879    if AName = Material[i].Name then
     1880    begin
     1881      result := Material[i];
     1882      exit;
     1883    end;
     1884  result := nil;
     1885end;
     1886
    29651887procedure TBGRAScene3D.UpdateMaterials;
    29661888var i,j: integer;
    … …  
    29971919end;
    29981920
     1921procedure TBGRAScene3D.ForEachVertex(ACallback: TVertex3DCallback);
     1922var i: integer;
     1923begin
     1924  for i := 0 to Object3DCount-1 do
     1925    Object3D[i].ForEachVertex(ACallback);
     1926end;
     1927
     1928procedure TBGRAScene3D.ForEachFace(ACallback: TFace3DCallback);
     1929var i: integer;
     1930begin
     1931  for i := 0 to Object3DCount-1 do
     1932    Object3D[i].ForEachFace(ACallback);
     1933end;
     1934
     1935initialization
     1936
     1937  Randomize;
     1938
    29991939end.
    30001940
Note: See TracChangeset for help on using the changeset viewer.