unit BGRAScene3D;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, BGRABitmapTypes, BGRAColorInt, BGRASSE, BGRAMatrix3D;

type
  PSceneLightingContext = ^TSceneLightingContext;
  TSceneLightingContext = packed record
    basic: TBasicLightingContext;
    {128} diffuseColor, {144} specularColor: TColorInt65536;
    {160} vL, {176} dummy: TPoint3D_128;
    {192} vH: TPoint3D_128;
    {208} lightness: integer;
    {212} material : TObject;
    LightThroughFactor: single;
    LightThrough: LongBool;
    SaturationLow: integer;
    SaturationLowF: single;
    SaturationHigh: integer;
    SaturationHighF: single;
  end;

  TProjection3D = packed record
    Zoom, Center: TPointF;
  end;

  TBox3D = record
    min,max: TPoint3D;
  end;

  TLightingNormal3D = (lnNone, lnFace, lnVertex, lnFaceVertexMix);
  TLightingInterpolation3D = (liLowQuality, liSpecularHighQuality, liAlwaysHighQuality);
  TAntialiasingMode3D = (am3dNone, am3dMultishape, am3dResample);
  TPerspectiveMode3D = (pmLinearMapping, pmPerspectiveMapping, pmZBuffer);

type
  TRenderingOptions = record
    LightingInterpolation: TLightingInterpolation3D;
    AntialiasingMode: TAntialiasingMode3D;
    AntialiasingResampleLevel: integer;
    PerspectiveMode: TPerspectiveMode3D;
    TextureInterpolation: boolean;
    MinZ: single;
  end;

  TBGRAScene3D = class;

{$i bgrascene3Dinterface.inc}

type
  { TBGRAScene3D }

  TBGRAScene3D = class
  private
    FSurface: TBGRACustomBitmap;
    FViewCenter: TPointF;
    FAutoViewCenter: boolean;
    FObjects: array of IBGRAObject3D;
    FObjectCount: integer;
    FMaterials: array of IBGRAMaterial3D;
    FMaterialCount: integer;
    FMatrix: TMatrix3D;
    FViewPoint: TPoint3D_128;
    FLookWhere, FTopDir: TPoint3D_128;
    FZoom: TPointF;
    FAutoZoom: Boolean;
    FLights: TList;
    FAmbiantLightness: integer;
    FAmbiantLightColor: TColorInt65536;
    FRenderedFaceCount: integer;
    FProjection: TProjection3D;
    function GetAmbiantLightColorF: TColorF;
    function GetAmbiantLightness: single;
    function GetAmbiantLightColor: TBGRAPixel;
    function GetFaceCount: integer;
    function GetLight(AIndex: integer): IBGRALight3D;
    function GetLightCount: integer;
    function GetMaterial(AIndex: integer): IBGRAMaterial3D;
    function GetObject(AIndex: integer): IBGRAObject3D;
    function GetVertexCount: integer;
    function GetViewCenter: TPointF;
    function GetViewPoint: TPoint3D;
    function GetZoom: TPointF;
    procedure SetAmbiantLightColorF(const AValue: TColorF);
    procedure SetAmbiantLightness(const AValue: single);
    procedure SetAmbiantLightColor(const AValue: TBGRAPixel);
    procedure SetAutoViewCenter(const AValue: boolean);
    procedure SetAutoZoom(const AValue: boolean);
    procedure SetViewCenter(const AValue: TPointF);
    procedure SetViewPoint(const AValue: TPoint3D);
    procedure ComputeView(ScaleX,ScaleY: single);
    function ComputeCoordinate(ASceneCoord: TPoint3D_128; APart: IBGRAPart3D): TPointF; overload;
    function ComputeCoordinate(AViewCoord: TPoint3D_128): TPointF; overload;
    procedure ComputeLight;
    procedure ComputeMatrix;
    procedure AddObject(AObj: IBGRAObject3D);
    procedure AddLight(ALight: TObject);
    procedure AddMaterial(AMaterial: IBGRAMaterial3D);
    procedure Init;
    procedure InternalRender(ASurface: TBGRACustomBitmap; AAntialiasingMode: TAntialiasingMode3D; GlobalScale: single); virtual;

  protected
    function ApplyLightingWithLightness(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
    function ApplyLightingWithDiffuseColor(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
    function ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
    function ApplyLightingWithAmbiantLightnessOnly(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
    function ApplyNoLighting(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
    procedure UseMaterial(AMaterialName: string; AFace: IBGRAFace3D); virtual;

  public
    DefaultLightingNormal: TLightingNormal3D;
    DefaultMaterial : IBGRAMaterial3D;
    RenderingOptions: TRenderingOptions;

    constructor Create;
    constructor Create(ASurface: TBGRACustomBitmap);
    destructor Destroy; override;
    procedure Clear;
    function LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D;
    procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D);
    procedure LookLeft(angleDeg: single);
    procedure LookRight(angleDeg: single);
    procedure LookUp(angleDeg: single);
    procedure LookDown(angleDeg: single);
    procedure Render; virtual;
    function CreateObject: IBGRAObject3D; overload;
    function CreateObject(ATexture: IBGRAScanner): IBGRAObject3D; overload;
    function CreateObject(AColor: TBGRAPixel): IBGRAObject3D; overload;
    function CreateSphere(ARadius: Single; AHorizPrecision: integer = 8; AVerticalPrecision : integer = 6): IBGRAObject3D; overload;
    function CreateSphere(ARadius: Single; AColor: TBGRAPixel; AHorizPrecision: integer = 8; AVerticalPrecision : integer = 6): IBGRAObject3D; overload;
    function CreateHalfSphere(ARadius: Single; AHorizPrecision: integer = 6; AVerticalPrecision : integer = 6): IBGRAObject3D; overload;
    function CreateHalfSphere(ARadius: Single; AColor: TBGRAPixel; AHorizPrecision: integer = 6; AVerticalPrecision : integer = 6): IBGRAObject3D; overload;
    procedure RemoveObject(AObject: IBGRAObject3D);
    function AddDirectionalLight(ADirection: TPoint3D; ALightness: single = 1; AMinIntensity : single = 0): IBGRADirectionalLight3D;
    function AddDirectionalLight(ADirection: TPoint3D; AColor: TBGRAPixel; AMinIntensity: single = 0): IBGRADirectionalLight3D;
    function AddPointLight(AVertex: IBGRAVertex3D; AOptimalDistance: single; ALightness: single = 1; AMinIntensity : single = 0): IBGRAPointLight3D;
    function AddPointLight(AVertex: IBGRAVertex3D; AOptimalDistance: single; AColor: TBGRAPixel; AMinIntensity: single = 0): IBGRAPointLight3D;
    procedure RemoveLight(ALight: IBGRALight3D);
    procedure SetZoom(value: Single); overload;
    procedure SetZoom(value: TPointF); overload;
    function CreateMaterial: IBGRAMaterial3D;
    function CreateMaterial(ASpecularIndex: integer): IBGRAMaterial3D;
    procedure UpdateMaterials; virtual;
    procedure UpdateMaterial(AMaterialName: string); virtual;
    property ViewCenter: TPointF read GetViewCenter write SetViewCenter;
    property AutoViewCenter: boolean read FAutoViewCenter write SetAutoViewCenter;
    property AutoZoom: boolean read FAutoZoom write SetAutoZoom;
    property Surface: TBGRACustomBitmap read FSurface write FSurface;
    property Object3D[AIndex: integer]: IBGRAObject3D read GetObject;
    property Object3DCount: integer read FObjectCount;
    property VertexCount: integer read GetVertexCount;
    property FaceCount: integer read GetFaceCount;
    property Zoom: TPointF read GetZoom write SetZoom;
    property AmbiantLightness: single read GetAmbiantLightness write SetAmbiantLightness;
    property AmbiantLightColor: TBGRAPixel read GetAmbiantLightColor write SetAmbiantLightColor;
    property AmbiantLightColorF: TColorF read GetAmbiantLightColorF write SetAmbiantLightColorF;
    property LightCount: integer read GetLightCount;
    property Light[AIndex: integer]: IBGRALight3D read GetLight;
    property ViewPoint: TPoint3D read GetViewPoint write SetViewPoint;
    property RenderedFaceCount : integer read FRenderedFaceCount;
    property Material[AIndex: integer] : IBGRAMaterial3D read GetMaterial;
    property MaterialCount: integer read FMaterialCount;
  end;

implementation

uses BGRAPolygon, BGRAPolygonAliased, BGRACoordPool3D;

{$i lightingclasses3d.inc}

type
  { TBGRAObject3D }

  TBGRAObject3D = class(TInterfacedObject,IBGRAObject3D)
  private
    FColor: TBGRAPixel;
    FLight: Single;
    FTexture: IBGRAScanner;
    FMainPart: IBGRAPart3D;
    FFaces: array of IBGRAFace3D;
    FFaceCount: integer;
    FLightingNormal : TLightingNormal3D;
    FParentLighting: boolean;
    FMaterial: IBGRAMaterial3D;
    FScene: TBGRAScene3D;
    procedure AddFace(AFace: IBGRAFace3D);
  public
    constructor Create(AScene: TBGRAScene3D);
    destructor Destroy; override;
    procedure Clear;

    function AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
    function AddFace(const AVertices: array of IBGRAVertex3D; ABiface: boolean): IBGRAFace3D;
    function AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D;
    function AddFace(const AVertices: array of IBGRAVertex3D; AColor: TBGRAPixel): IBGRAFace3D;
    function AddFace(const AVertices: array of IBGRAVertex3D; AColors: array of TBGRAPixel): IBGRAFace3D;
    function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
    procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D);
    function GetColor: TBGRAPixel;
    function GetLight: Single;
    function GetTexture: IBGRAScanner;
    function GetMainPart: IBGRAPart3D;
    function GetLightingNormal: TLightingNormal3D;
    function GetParentLighting: boolean;
    function GetFace(AIndex: integer): IBGRAFace3D;
    function GetFaceCount: integer;
    function GetTotalVertexCount: integer;
    function GetMaterial: IBGRAMaterial3D;
    procedure SetLightingNormal(const AValue: TLightingNormal3D);
    procedure SetParentLighting(const AValue: boolean);
    procedure SetColor(const AValue: TBGRAPixel);
    procedure SetLight(const AValue: Single);
    procedure SetTexture(const AValue: IBGRAScanner);
    procedure SetMaterial(const AValue: IBGRAMaterial3D);
    procedure RemoveUnusedVertices;
    procedure SeparatePart(APart: IBGRAPart3D);
    function GetScene: TBGRAScene3D;
    function GetRefCount: integer;
    procedure SetBiface(AValue : boolean);
  end;

{$i shape3D.inc}

type
  { TBGRAPart3D }

  TBGRAPart3D = class(TInterfacedObject,IBGRAPart3D)
  private
    FVertices: array of IBGRAVertex3D;
    FVertexCount: integer;
    FMatrix: TMatrix3D;
    FParts: array of IBGRAPart3D;
    FPartCount: integer;
    FContainer: IBGRAPart3D;
    FCoordPool: TBGRACoordPool3D;
  public
    constructor Create(AContainer: IBGRAPart3D);
    destructor Destroy; override;
    procedure Clear(ARecursive: boolean);
    function Add(x,y,z: single): IBGRAVertex3D;
    function Add(pt: TPoint3D): IBGRAVertex3D;
    function Add(pt: TPoint3D_128): IBGRAVertex3D;
    function Add(const coords: array of single): arrayOfIBGRAVertex3D;
    function Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D;
    function Add(const pts: array of TPoint3D_128): arrayOfIBGRAVertex3D;
    procedure Add(const pts: array of IBGRAVertex3D);
    procedure Add(AVertex: IBGRAVertex3D);
    procedure RemoveVertex(Index: integer);
    function GetBoundingBox: TBox3D;
    function GetRadius: single;
    function GetMatrix: TMatrix3D;
    function GetPart(AIndex: Integer): IBGRAPart3D;
    function GetPartCount: integer;
    function GetVertex(AIndex: Integer): IBGRAVertex3D;
    function GetVertexCount: integer;
    function GetTotalVertexCount: integer;
    function GetContainer: IBGRAPart3D;
    procedure SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
    procedure ResetTransform;
    procedure Translate(x,y,z: single; Before: boolean = true);
    procedure Translate(ofs: TPoint3D; Before: boolean = true);
    procedure Scale(size: single; Before: boolean = true);
    procedure Scale(x,y,z: single; Before: boolean = true);
    procedure Scale(size: TPoint3D; Before: boolean = true);
    procedure RotateXDeg(angle: single; Before: boolean = true);
    procedure RotateYDeg(angle: single; Before: boolean = true);
    procedure RotateZDeg(angle: single; Before: boolean = true);
    procedure RotateXRad(angle: single; Before: boolean = true);
    procedure RotateYRad(angle: single; Before: boolean = true);
    procedure RotateZRad(angle: single; Before: boolean = true);
    procedure SetMatrix(const AValue: TMatrix3D);
    procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
    function ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF;
    procedure NormalizeViewNormal;
    function CreatePart: IBGRAPart3D;
    procedure LookAt(ALookWhere,ATopDir: TPoint3D);
    procedure RemoveUnusedVertices;
    function IndexOf(AVertex: IBGRAVertex3D): integer;
  end;

  { TBGRAFace3D }

  PBGRAFaceVertexDescription = ^TBGRAFaceVertexDescription;
  TBGRAFaceVertexDescription = record
       Vertex: IBGRAVertex3D;
       Color: TBGRAPixel;
       TexCoord: TPointF;
       ColorOverride: boolean;
       TexCoordOverride: boolean;
     end;

  TBGRAFace3D = class(TInterfacedObject,IBGRAFace3D)
  private
    FVertices: packed array of TBGRAFaceVertexDescription;
    FVertexCount: integer;
    FTexture: IBGRAScanner;
    FMaterial: IBGRAMaterial3D;
    FMaterialName: string;
    FParentTexture: boolean;
    FViewNormal: TPoint3D_128;
    FViewCenter: TPoint3D_128;
    FObject3D : IBGRAObject3D;
    FBiface: boolean;
    FLightThroughFactor: single;
    FLightThroughFactorOverride: boolean;
    function GetVertexDescription(AIndex : integer): PBGRAFaceVertexDescription;
  public
    function GetObject3D: IBGRAObject3D;
    constructor Create(AObject3D: IBGRAObject3D; AVertices: array of IBGRAVertex3D);
    destructor Destroy; override;
    procedure AddVertex(AVertex: IBGRAVertex3D);
    function GetParentTexture: boolean;
    function GetTexture: IBGRAScanner;
    function GetVertex(AIndex: Integer): IBGRAVertex3D;
    function GetVertexColor(AIndex: Integer): TBGRAPixel;
    function GetVertexColorOverride(AIndex: Integer): boolean;
    function GetVertexCount: integer;
    function GetMaterial: IBGRAMaterial3D;
    function GetMaterialName: string;
    function GetTexCoord(AIndex: Integer): TPointF;
    function GetTexCoordOverride(AIndex: Integer): boolean;
    function GetViewNormal: TPoint3D;
    function GetViewNormal_128: TPoint3D_128;
    function GetViewCenter: TPoint3D;
    function GetViewCenter_128: TPoint3D_128;
    function GetViewCenterZ: single;
    function GetBiface: boolean;
    function GetLightThroughFactor: single;
    function GetLightThroughFactorOverride: boolean;
    procedure SetParentTexture(const AValue: boolean);
    procedure SetTexture(const AValue: IBGRAScanner);
    procedure SetColor(AColor: TBGRAPixel);
    procedure SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel);
    procedure SetVertexColorOverride(AIndex: Integer; const AValue: boolean);
    procedure SetTexCoord(AIndex: Integer; const AValue: TPointF);
    procedure SetTexCoordOverride(AIndex: Integer; const AValue: boolean);
    procedure SetBiface(const AValue: boolean);
    procedure SetLightThroughFactor(const AValue: single);
    procedure SetLightThroughFactorOverride(const AValue: boolean);
    procedure SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
    procedure ComputeViewNormalAndCenter;
    procedure SetMaterial(const AValue: IBGRAMaterial3D);
    procedure SetMaterialName(const AValue: string);
    function GetAsObject: TObject;
    property Texture: IBGRAScanner read GetTexture write SetTexture;
    property ParentTexture: boolean read GetParentTexture write SetParentTexture;
    property VertexCount: integer read GetVertexCount;
    property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex;
    property VertexColor[AIndex: Integer]: TBGRAPixel read GetVertexColor write SetVertexColor;
    property VertexColorOverride[AIndex: Integer]: boolean read GetVertexColorOverride write SetVertexColorOverride;
    property TexCoord[AIndex: Integer]: TPointF read GetTexCoord write SetTexCoord;
    property TexCoordOverride[AIndex: Integer]: boolean read GetTexCoordOverride write SetTexCoordOverride;
    property ViewNormal: TPoint3D read GetViewNormal;
    property ViewNormal_128: TPoint3D_128 read GetViewNormal_128;
    property ViewCenter: TPoint3D read GetViewCenter;
    property ViewCenter_128: TPoint3D_128 read GetViewCenter_128;
    property ViewCenterZ: single read GetViewCenterZ;
    property Object3D: IBGRAObject3D read GetObject3D;
    property Biface: boolean read GetBiface write SetBiface;
    property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor;
    property LightThroughFactorOverride: boolean read GetLightThroughFactorOverride write SetLightThroughFactorOverride;
    property Material: IBGRAMaterial3D read GetMaterial write SetMaterial;
    property VertexDescription[AIndex : integer]: PBGRAFaceVertexDescription read GetVertexDescription;
  end;

  { TBGRAVertex3D }

  TBGRAVertex3D = class(TInterfacedObject,IBGRAVertex3D)
  private
    FColor: TBGRAPixel;
    FParentColor: boolean;
    FLight: Single;
    FTexCoord: TPointF;
    FCoordPool: TBGRACoordPool3D;
    FCoordPoolIndex: integer;
    function GetCoordData: PBGRACoordData3D;
    procedure Init(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
  public
    constructor Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D); overload;
    constructor Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); overload;
    destructor Destroy; override;
    function GetColor: TBGRAPixel;
    function GetLight: Single;
    function GetViewNormal: TPoint3D;
    function GetViewNormal_128: TPoint3D_128;
    function GetSceneCoord: TPoint3D;
    function GetSceneCoord_128: TPoint3D_128;
    function GetTexCoord: TPointF;
    function GetViewCoord: TPoint3D;
    function GetViewCoord_128: TPoint3D_128;
    function GetUsage: integer;
    procedure SetColor(const AValue: TBGRAPixel);
    procedure SetLight(const AValue: Single);
    procedure SetViewNormal(const AValue: TPoint3D);
    procedure SetViewNormal_128(const AValue: TPoint3D_128);
    procedure NormalizeViewNormal;
    procedure AddViewNormal(const AValue: TPoint3D_128);
    procedure SetSceneCoord(const AValue: TPoint3D);
    procedure SetSceneCoord_128(const AValue: TPoint3D_128);
    procedure SetTexCoord(const AValue: TPointF);
    procedure SetViewCoord(const AValue: TPoint3D);
    procedure SetViewCoord_128(const AValue: TPoint3D_128);
    function GetViewCoordZ: single;
    function GetParentColor: Boolean;
    procedure SetParentColor(const AValue: Boolean);
    function GetProjectedCoord: TPointF;
    procedure SetProjectedCoord(const AValue: TPointF);
    procedure ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
    property SceneCoord: TPoint3D read GetSceneCoord write SetSceneCoord;
    property SceneCoord_128: TPoint3D_128 read GetSceneCoord_128 write SetSceneCoord_128;
    property ViewCoord: TPoint3D read GetViewCoord write SetViewCoord;
    property ViewCoord_128: TPoint3D_128 read GetViewCoord_128 write SetViewCoord_128;
    property ViewCoordZ: single read GetViewCoordZ;
    property ProjectedCoord: TPointF read GetProjectedCoord write SetProjectedCoord;
    property TexCoord: TPointF read GetTexCoord write SetTexCoord;
    property Color: TBGRAPixel read GetColor write SetColor;
    property ParentColor: Boolean read GetParentColor write SetParentColor;
    property Light: Single read GetLight write SetLight;
    property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal;
    property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128;
    property Usage: integer read GetUsage;
    property CoordData: PBGRACoordData3D read GetCoordData;
    function GetAsObject: TObject;
  end;

{ TBGRAVertex3D }

procedure TBGRAVertex3D.Init(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
begin
  FCoordPool := ACoordPool;
  FCoordPoolIndex := FCoordPool.Add;
  FColor := BGRAWhite;
  FParentColor := True;
  FLight := 1;
  SceneCoord_128 := ASceneCoord;
end;

function TBGRAVertex3D.GetCoordData: PBGRACoordData3D;
begin
  result := FCoordPool.CoordData[FCoordPoolIndex];
end;

constructor TBGRAVertex3D.Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D);
begin
  Init(ACoordPool, Point3D_128(ASceneCoord));
end;

constructor TBGRAVertex3D.Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
begin
  Init(ACoordPool, ASceneCoord);
end;

destructor TBGRAVertex3D.Destroy;
begin
  FCoordPool.Remove(FCoordPoolIndex);
  inherited Destroy;
end;

function TBGRAVertex3D.GetColor: TBGRAPixel;
begin
  result := FColor;
end;

function TBGRAVertex3D.GetLight: Single;
begin
  result := FLight;
end;

function TBGRAVertex3D.GetViewNormal: TPoint3D;
begin
  result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal);
end;

function TBGRAVertex3D.GetViewNormal_128: TPoint3D_128;
begin
  result := FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal;
end;

function TBGRAVertex3D.GetSceneCoord: TPoint3D;
begin
  result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord);
end;

function TBGRAVertex3D.GetSceneCoord_128: TPoint3D_128;
begin
  result := FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord;
end;

function TBGRAVertex3D.GetTexCoord: TPointF;
begin
  result := FTexCoord;
end;

function TBGRAVertex3D.GetViewCoord: TPoint3D;
begin
  result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord);
end;

function TBGRAVertex3D.GetViewCoord_128: TPoint3D_128;
begin
  result := FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord;
end;

function TBGRAVertex3D.GetUsage: integer;
begin
  result := frefcount;
end;

procedure TBGRAVertex3D.SetColor(const AValue: TBGRAPixel);
begin
  FColor := AValue;
  FParentColor := false;
end;

procedure TBGRAVertex3D.SetLight(const AValue: Single);
begin
  FLight := AValue;
end;

procedure TBGRAVertex3D.SetViewNormal(const AValue: TPoint3D);
begin
  FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal := Point3D_128(AValue);
end;

procedure TBGRAVertex3D.SetViewNormal_128(const AValue: TPoint3D_128);
begin
  FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal := AValue;
end;

procedure TBGRAVertex3D.SetSceneCoord(const AValue: TPoint3D);
begin
  FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord := Point3D_128(AValue);
end;

procedure TBGRAVertex3D.SetSceneCoord_128(const AValue: TPoint3D_128);
begin
  FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord := AValue;
end;

procedure TBGRAVertex3D.SetTexCoord(const AValue: TPointF);
begin
  FTexCoord := AValue;
end;

procedure TBGRAVertex3D.SetViewCoord(const AValue: TPoint3D);
begin
  FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord := Point3D_128(AValue);
end;

procedure TBGRAVertex3D.SetViewCoord_128(const AValue: TPoint3D_128);
begin
  FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord := AValue;
end;

function TBGRAVertex3D.GetViewCoordZ: single;
begin
  result := FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord.Z;
end;

function TBGRAVertex3D.GetParentColor: Boolean;
begin
  result := FParentColor;
end;

procedure TBGRAVertex3D.SetParentColor(const AValue: Boolean);
begin
  FParentColor := AValue;
end;

function TBGRAVertex3D.GetProjectedCoord: TPointF;
begin
  result := FCoordPool.CoordData[FCoordPoolIndex]^.projectedCoord;
end;

procedure TBGRAVertex3D.SetProjectedCoord(const AValue: TPointF);
begin
  FCoordPool.CoordData[FCoordPoolIndex]^.projectedCoord := AValue;
end;

procedure TBGRAVertex3D.ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection : TProjection3D);
var P: PBGRACoordData3D;
begin
  P := FCoordPool.CoordData[FCoordPoolIndex];
  with p^ do
  begin
    viewCoord := AMatrix*sceneCoord;
    ClearPoint3D_128(viewNormal);
    if viewCoord.z > 0 then
    begin
      InvZ := 1/viewCoord.z;
      projectedCoord := PointF(viewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x,
                               viewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y);
    end else
      projectedCoord := PointF(0,0);
  end;
end;

function TBGRAVertex3D.GetAsObject: TObject;
begin
  result := self;
end;

procedure TBGRAVertex3D.NormalizeViewNormal;
begin
  Normalize3D_128(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal);
end;

procedure TBGRAVertex3D.AddViewNormal(const AValue: TPoint3D_128);
begin
  Add3D_Aligned(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal, AValue);
end;

{ TBGRAFace3D }

function TBGRAFace3D.GetVertexDescription(AIndex : integer
  ): PBGRAFaceVertexDescription;
begin
  result := @FVertices[AIndex];
end;

function TBGRAFace3D.GetObject3D: IBGRAObject3D;
begin
  result := FObject3D;
end;

constructor TBGRAFace3D.Create(AObject3D: IBGRAObject3D;
  AVertices: array of IBGRAVertex3D);
var
  i: Integer;
begin
  SetLength(FVertices, length(AVertices));
  for i:= 0 to high(AVertices) do
    AddVertex(AVertices[i]);
  FObject3D := AObject3D;
  FBiface := false;
  FParentTexture := True;
  FLightThroughFactor:= 0;
  FLightThroughFactorOverride:= false;
end;

destructor TBGRAFace3D.Destroy;
begin
  fillchar(FTexture,sizeof(FTexture),0);
  inherited Destroy;
end;

procedure TBGRAFace3D.AddVertex(AVertex: IBGRAVertex3D);
begin
  if FVertexCount = length(FVertices) then
    setlength(FVertices, FVertexCount*2+3);
  with FVertices[FVertexCount] do
  begin
    Color := BGRAWhite;
    ColorOverride := false;
    TexCoord := PointF(0,0);
    TexCoordOverride := false;
    Vertex := AVertex;
  end;
  inc(FVertexCount);
end;

function TBGRAFace3D.GetParentTexture: boolean;
begin
  result := FParentTexture;
end;

function TBGRAFace3D.GetTexture: IBGRAScanner;
begin
  result := FTexture;
end;

function TBGRAFace3D.GetVertex(AIndex: Integer): IBGRAVertex3D;
begin
  if (AIndex < 0) or (AIndex >= FVertexCount) then
    raise Exception.Create('Index out of bounds');
  result := FVertices[AIndex].Vertex;
end;

procedure TBGRAFace3D.SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
begin
  if (AIndex < 0) or (AIndex >= FVertexCount) then
    raise Exception.Create('Index out of bounds');
  FVertices[AIndex].Vertex := AValue;
end;

function TBGRAFace3D.GetVertexColor(AIndex: Integer): TBGRAPixel;
begin
  if (AIndex < 0) or (AIndex >= FVertexCount) then
    raise Exception.Create('Index out of bounds');
  result := FVertices[AIndex].Color;
end;

function TBGRAFace3D.GetVertexColorOverride(AIndex: Integer): boolean;
begin
  if (AIndex < 0) or (AIndex >= FVertexCount) then
    raise Exception.Create('Index out of bounds');
  result := FVertices[AIndex].ColorOverride;
end;

function TBGRAFace3D.GetVertexCount: integer;
begin
  result := FVertexCount;
end;

function TBGRAFace3D.GetMaterial: IBGRAMaterial3D;
begin
  result := FMaterial;
end;

function TBGRAFace3D.GetMaterialName: string;
begin
  result := FMaterialName;
end;

procedure TBGRAFace3D.SetParentTexture(const AValue: boolean);
begin
  FParentTexture := AValue;
end;

procedure TBGRAFace3D.SetTexture(const AValue: IBGRAScanner);
begin
  FTexture := AValue;
  FParentTexture := false;
end;

procedure TBGRAFace3D.SetColor(AColor: TBGRAPixel);
var i: integer;
begin
  for i := 0 to GetVertexCount-1 do
    SetVertexColor(i,AColor);
end;

procedure TBGRAFace3D.SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel
  );
begin
  if (AIndex < 0) or (AIndex >= FVertexCount) then
    raise Exception.Create('Index out of bounds');
  with FVertices[AIndex] do
  begin
    Color := AValue;
    ColorOverride := true;
  end;
end;

procedure TBGRAFace3D.SetVertexColorOverride(AIndex: Integer;
  const AValue: boolean);
begin
  if (AIndex < 0) or (AIndex >= FVertexCount) then
    raise Exception.Create('Index out of bounds');
  FVertices[AIndex].ColorOverride := AValue;
end;

function TBGRAFace3D.GetTexCoord(AIndex: Integer): TPointF;
begin
  if (AIndex < 0) or (AIndex >= FVertexCount) then
    raise Exception.Create('Index out of bounds');
  result := FVertices[AIndex].TexCoord;
end;

function TBGRAFace3D.GetTexCoordOverride(AIndex: Integer): boolean;
begin
  if (AIndex < 0) or (AIndex >= FVertexCount) then
    raise Exception.Create('Index out of bounds');
  result := FVertices[AIndex].TexCoordOverride;
end;

procedure TBGRAFace3D.SetTexCoord(AIndex: Integer; const AValue: TPointF);
begin
  if (AIndex < 0) or (AIndex >= FVertexCount) then
    raise Exception.Create('Index out of bounds');
  FVertices[AIndex].TexCoord := AValue;
  FVertices[AIndex].TexCoordOverride := true;
end;

procedure TBGRAFace3D.SetTexCoordOverride(AIndex: Integer; const AValue: boolean
  );
begin
  if (AIndex < 0) or (AIndex >= FVertexCount) then
    raise Exception.Create('Index out of bounds');
  FVertices[AIndex].TexCoordOverride := AValue;
end;

function TBGRAFace3D.GetViewNormal: TPoint3D;
begin
  result := Point3D(FViewNormal);
end;

function TBGRAFace3D.GetViewNormal_128: TPoint3D_128;
begin
  result := FViewNormal;
end;

function TBGRAFace3D.GetViewCenter: TPoint3D;
begin
  result := Point3D(FViewCenter);
end;

function TBGRAFace3D.GetViewCenter_128: TPoint3D_128;
begin
  result := FViewCenter;
end;

function TBGRAFace3D.GetViewCenterZ: single;
begin
  result := FViewCenter.Z;
end;

function TBGRAFace3D.GetBiface: boolean;
begin
  result := FBiface;
end;

procedure TBGRAFace3D.SetBiface(const AValue: boolean);
begin
  FBiface := AValue;
end;

function TBGRAFace3D.GetLightThroughFactor: single;
begin
  result := FLightThroughFactor;
end;

function TBGRAFace3D.GetLightThroughFactorOverride: boolean;
begin
  result := FLightThroughFactorOverride;
end;

procedure TBGRAFace3D.SetLightThroughFactor(const AValue: single);
begin
  if AValue < 0 then
    FLightThroughFactor := 0
  else
    FLightThroughFactor:= AValue;
  FLightThroughFactorOverride := true;
end;

procedure TBGRAFace3D.SetLightThroughFactorOverride(const AValue: boolean);
begin
  FLightThroughFactorOverride := AValue;
end;

procedure TBGRAFace3D.ComputeViewNormalAndCenter;
var v1,v2: TPoint3D_128;
  i: Integer;
  p0,p1,p2: IBGRAVertex3D;
begin
  if FVertexCount < 3 then
    ClearPoint3D_128(FViewNormal)
  else
  begin
    p0 := FVertices[0].Vertex;
    p1 := FVertices[1].Vertex;
    p2 := FVertices[2].Vertex;
    v1 := p1.ViewCoord_128 - p0.ViewCoord_128;
    v2 := p2.ViewCoord_128 - p1.ViewCoord_128;
    VectProduct3D_128(v2,v1,FViewNormal);
    Normalize3D_128(FViewNormal);
    for i := 0 to FVertexCount-1 do
      FVertices[i].Vertex.AddViewNormal(FViewNormal);
  end;
  ClearPoint3D_128(FViewCenter);
  if FVertexCount > 0 then
  begin
    for i := 0 to FVertexCount-1 do
      FViewCenter += FVertices[i].Vertex.ViewCoord_128;
    FViewCenter *= 1/FVertexCount;
  end;
end;

procedure TBGRAFace3D.SetMaterial(const AValue: IBGRAMaterial3D);
begin
  FMaterial := AValue;
end;

procedure TBGRAFace3D.SetMaterialName(const AValue: string);
begin
  if AValue <> FMaterialName then
  begin
    FMaterialName := AValue;
    FObject3D.Scene.UseMaterial(FMaterialName, self);
  end;
end;

function TBGRAFace3D.GetAsObject: TObject;
begin
  result := self;
end;

{ TBGRAPart3D }

procedure TBGRAPart3D.LookAt(ALookWhere,ATopDir: TPoint3D);
var ZDir, XDir, YDir: TPoint3D_128;
    ViewPoint: TPoint3D_128;
    CurPart: IBGRAPart3D;
    ComposedMatrix: TMatrix3D;
begin
  YDir := -Point3D_128(ATopDir);
  if IsPoint3D_128_Zero(YDir) then exit;
  Normalize3D_128(YDir);

  ComposedMatrix := FMatrix;
  CurPart := self.FContainer;
  while CurPart <> nil do
  begin
    ComposedMatrix := CurPart.Matrix*ComposedMatrix;
    CurPart := CurPart.Container;
  end;
  ViewPoint := ComposedMatrix*Point3D_128_Zero;

  ZDir := Point3D_128(ALookWhere)-ViewPoint;
  if IsPoint3D_128_Zero(ZDir) then exit;
  Normalize3D_128(ZDir);

  VectProduct3D_128(YDir,ZDir,XDir);
  VectProduct3D_128(ZDir,XDir,YDir); //correct Y dir

  FMatrix := Matrix3D(XDir,YDir,ZDir,ViewPoint);
  ComposedMatrix := MatrixIdentity3D;
  CurPart := self.FContainer;
  while CurPart <> nil do
  begin
    ComposedMatrix := CurPart.Matrix*ComposedMatrix;
    CurPart := CurPart.Container;
  end;
  FMatrix := MatrixInverse3D(ComposedMatrix)*FMatrix;
end;

procedure TBGRAPart3D.RemoveUnusedVertices;
var
  i: Integer;
begin
  for i := FVertexCount-1 downto 0 do
    if FVertices[i].Usage <= 2 then RemoveVertex(i);
  for i := 0 to FPartCount-1 do
    FParts[i].RemoveUnusedVertices;
end;

function TBGRAPart3D.IndexOf(AVertex: IBGRAVertex3D): integer;
var i: integer;
begin
  for i := 0 to FVertexCount-1 do
    if FVertices[i] = AVertex then
    begin
      result := i;
      exit;
    end;
  result := -1;
end;

procedure TBGRAPart3D.Add(AVertex: IBGRAVertex3D);
begin
  if FVertexCount = length(FVertices) then
    setlength(FVertices, FVertexCount*2+3);
  FVertices[FVertexCount] := AVertex;
  inc(FVertexCount);
end;

procedure TBGRAPart3D.RemoveVertex(Index: integer);
var i: integer;
begin
  if (Index >= 0) and (Index < FVertexCount) then
  begin
    for i := Index to FVertexCount-2 do
      FVertices[i] := FVertices[i+1];
    FVertices[FVertexCount-1] := nil;
    dec(FVertexCount);
  end;
end;

function TBGRAPart3D.GetRadius: single;
var i: integer;
    pt: TPoint3D_128;
    d: single;
begin
  result := 0;
  for i := 0 to GetVertexCount-1 do
  begin
    pt := GetVertex(i).SceneCoord_128;
    d:= sqrt(DotProduct3D_128(pt,pt));
    if d > result then result := d;
  end;
end;

constructor TBGRAPart3D.Create(AContainer: IBGRAPart3D);
begin
  FContainer := AContainer;
  FMatrix := MatrixIdentity3D;
  FCoordPool := TBGRACoordPool3D.Create(4);
end;

destructor TBGRAPart3D.Destroy;
begin
  FCoordPool.Free;
  inherited Destroy;
end;

procedure TBGRAPart3D.Clear(ARecursive: boolean);
var i: integer;
begin
  FVertices := nil;
  FVertexCount := 0;
  if ARecursive then
  begin
    for i := 0 to FPartCount-1 do
      FParts[i].Clear(ARecursive);
    FParts := nil;
    FPartCount := 0;
  end;
end;

function TBGRAPart3D.Add(x, y, z: single): IBGRAVertex3D;
begin
  result := TBGRAVertex3D.Create(FCoordPool,Point3D(x,y,z));
  Add(result);
end;

function TBGRAPart3D.Add(pt: TPoint3D): IBGRAVertex3D;
begin
  result := TBGRAVertex3D.Create(FCoordPool,pt);
  Add(result);
end;

function TBGRAPart3D.Add(pt: TPoint3D_128): IBGRAVertex3D;
begin
  result := TBGRAVertex3D.Create(FCoordPool,pt);
  Add(result);
end;

function TBGRAPart3D.Add(const coords: array of single
  ): arrayOfIBGRAVertex3D;
var pts: array of TPoint3D;
    CoordsIdx: integer;
    i: Integer;
begin
  if length(coords) mod 3 <> 0 then
    raise exception.Create('Array size must be a multiple of 3');
  setlength(pts, length(coords) div 3);
  coordsIdx := 0;
  for i := 0 to high(pts) do
  begin
    pts[i] := Point3D(coords[CoordsIdx],coords[CoordsIdx+1],coords[CoordsIdx+2]);
    inc(coordsIdx,3);
  end;
  result := Add(pts);
end;

function TBGRAPart3D.Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D;
var
  i: Integer;
begin
  setlength(result, length(pts));
  for i := 0 to high(pts) do
    result[i] := TBGRAVertex3D.Create(FCoordPool,pts[i]);
  Add(result);
end;

function TBGRAPart3D.Add(const pts: array of TPoint3D_128
  ): arrayOfIBGRAVertex3D;
var
  i: Integer;
begin
  setlength(result, length(pts));
  for i := 0 to high(pts) do
    result[i] := TBGRAVertex3D.Create(FCoordPool,pts[i]);
  Add(result);
end;

procedure TBGRAPart3D.Add(const pts: array of IBGRAVertex3D);
var
  i: Integer;
begin
  if FVertexCount + length(pts) > length(FVertices) then
    setlength(FVertices, (FVertexCount*2 + length(pts))+1);
  for i := 0 to high(pts) do
  begin
    FVertices[FVertexCount] := pts[i];
    inc(FVertexCount);
  end;
end;

function TBGRAPart3D.GetBoundingBox: TBox3D;
var i: integer;
    pt: TPoint3D_128;
begin
  if GetVertexCount > 0 then
  begin
    result.min := GetVertex(0).SceneCoord;
    result.max := result.min;
  end else
  begin
    result.min := Point3D(0,0,0);
    result.max := Point3D(0,0,0);
    exit;
  end;
  for i := 1 to GetVertexCount-1 do
  begin
    pt := GetVertex(i).SceneCoord_128;
    if pt.x < result.min.x then result.min.x := pt.x else
    if pt.x > result.max.x then result.max.x := pt.x;
    if pt.y < result.min.y then result.min.y := pt.y else
    if pt.y > result.max.y then result.max.y := pt.y;
    if pt.z < result.min.z then result.min.z := pt.z else
    if pt.z > result.max.z then result.max.z := pt.z;
  end;
end;

function TBGRAPart3D.GetMatrix: TMatrix3D;
begin
  result := FMatrix;
end;

function TBGRAPart3D.GetPart(AIndex: Integer): IBGRAPart3D;
begin
  if (AIndex < 0) or (AIndex >= FPartCount) then
    raise exception.Create('Index of out bounds');
  result := FParts[AIndex];
end;

function TBGRAPart3D.GetPartCount: integer;
begin
  result := FPartCount;
end;

function TBGRAPart3D.GetVertex(AIndex: Integer): IBGRAVertex3D;
begin
  if (AIndex < 0) or (AIndex >= FVertexCount) then
    raise exception.Create('Index of out bounds');
  result := FVertices[AIndex];
end;

function TBGRAPart3D.GetVertexCount: integer;
begin
  result := FVertexCount;
end;

function TBGRAPart3D.GetTotalVertexCount: integer;
var i: integer;
begin
  result := GetVertexCount;
  for i := 0 to GetPartCount-1 do
    result += GetPart(i).GetTotalVertexCount;
end;

procedure TBGRAPart3D.ResetTransform;
begin
  FMatrix := MatrixIdentity3D;
end;

procedure TBGRAPart3D.Scale(size: single; Before: boolean = true);
begin
  Scale(size,size,size,Before);
end;

procedure TBGRAPart3D.Scale(x, y, z: single; Before: boolean = true);
begin
  Scale(Point3D(x,y,z),Before);
end;

procedure TBGRAPart3D.Scale(size: TPoint3D; Before: boolean = true);
begin
  if Before then
    FMatrix *= MatrixScale3D(size)
  else
    FMatrix := MatrixScale3D(size)*FMatrix;
end;

procedure TBGRAPart3D.RotateXDeg(angle: single; Before: boolean = true);
begin
  RotateXRad(-angle*Pi/180, Before);
end;

procedure TBGRAPart3D.RotateYDeg(angle: single; Before: boolean = true);
begin
  RotateYRad(-angle*Pi/180, Before);
end;

procedure TBGRAPart3D.RotateZDeg(angle: single; Before: boolean = true);
begin
  RotateZRad(-angle*Pi/180, Before);
end;

procedure TBGRAPart3D.RotateXRad(angle: single; Before: boolean = true);
begin
  if Before then
    FMatrix *= MatrixRotateX(angle)
  else
    FMatrix := MatrixRotateX(angle) * FMatrix;
end;

procedure TBGRAPart3D.RotateYRad(angle: single; Before: boolean = true);
begin
  if Before then
    FMatrix *= MatrixRotateY(angle)
  else
    FMatrix := MatrixRotateY(angle) * FMatrix;
end;

procedure TBGRAPart3D.RotateZRad(angle: single; Before: boolean = true);
begin
  if Before then
    FMatrix *= MatrixRotateZ(angle)
  else
    FMatrix := MatrixRotateZ(angle) * FMatrix;
end;

procedure TBGRAPart3D.SetMatrix(const AValue: TMatrix3D);
begin
  FMatrix := AValue;
end;

procedure TBGRAPart3D.ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
var
  i: Integer;
  Composed: TMatrix3D;
  P: PBGRACoordData3D;
begin
  Composed := AMatrix* self.FMatrix;
  {$IFDEF CPUI386}
  if UseSSE then
  begin
    Matrix3D_SSE_Load(Composed);
    asm
      mov eax,[AProjection]
      movups xmm4,[eax]
      xorps xmm1,xmm1
    end;
    P := FCoordPool.CoordData[0];
    i := FCoordPool.UsedCapacity;
    if UseSSE3 then
    begin
      while i > 0 do
      with P^ do
      begin
        MatrixMultiplyVect3D_SSE3_Aligned(sceneCoord,viewCoord);
        if viewCoord.z > 0 then
        begin
          asm
            mov eax, P
            movaps xmm3, [eax+16] //viewCoord
            movaps xmm2,xmm3
            shufps xmm2,xmm3,2+8+32+128
            rcpps xmm2,xmm2  //xmm2 = InvZ
            movss [eax+40],xmm2 //-> InvZ

            mulps xmm3,xmm4  //xmm3 *= Projection.Zoom
            mulps xmm3,xmm2  //xmm3 *= InvZ

            movhlps xmm0,xmm4  //xmm2 = Projection.Center
            addps xmm3,xmm0  //xmm3 += Projection.Center

            movlps [eax+32],xmm3 //->projectedCoord
            movaps [eax+48],xmm1 //->normal
          end;
        end else
        asm
          mov eax, P
          movlps [eax+32],xmm1  //0 ->projectedCoord
          movaps [eax+48],xmm1 //->normal
        end;
        dec(i);
        inc(p);
      end;
    end else
    begin
      while i > 0 do
      with P^ do
      begin
        MatrixMultiplyVect3D_SSE_Aligned(sceneCoord,viewCoord);
        if viewCoord.z > 0 then
        begin
          asm
            mov eax, P
            movaps xmm3, [eax+16] //viewCoord
            movaps xmm2,xmm3
            shufps xmm2,xmm3,2+8+32+128
            rcpps xmm2,xmm2  //xmm2 = InvZ
            movss [eax+40],xmm2 //-> InvZ

            mulps xmm3,xmm4  //xmm3 *= Projection.Zoom
            mulps xmm3,xmm2  //xmm3 *= InvZ

            movhlps xmm0,xmm4  //xmm2 = Projection.Center
            addps xmm3,xmm0  //xmm3 += Projection.Center

            movlps [eax+32],xmm3 //->projectedCoord
            movaps [eax+48],xmm1 //->normal
          end;
        end else
        asm
          mov eax, P
          movlps [eax+32],xmm1  //0 ->projectedCoord
          movaps [eax+48],xmm1 //->normal
        end;
        dec(i);
        inc(p);
      end;
    end;
  end
  else
  {$ENDIF}
  begin
    P := FCoordPool.CoordData[0];
    i := FCoordPool.UsedCapacity;
    while i > 0 do
    with P^ do
    begin
      viewCoord := Composed*sceneCoord;
      ClearPoint3D_128(viewNormal);
      if viewCoord.z > 0 then
      begin
        InvZ := 1/viewCoord.z;
        projectedCoord := PointF(viewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x,
                                 viewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y);
      end else
        projectedCoord := PointF(0,0);
      dec(i);
      inc(p);
    end;
  end;
  for i := 0 to FPartCount-1 do
    FParts[i].ComputeWithMatrix(Composed,AProjection);
end;

function TBGRAPart3D.ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF;
var part: IBGRAPart3D;
  newViewCoord: TPoint3D_128;
  InvZ: single;
begin
  newViewCoord := FMatrix * ASceneCoord;
  part := FContainer;
  while part <> nil do
  begin
    newViewCoord := part.Matrix * newViewCoord;
    part := part.Container;
  end;
  if NewViewCoord.z > 0 then
  begin
    InvZ := 1/NewViewCoord.z;
    result := PointF(NewViewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x,
                     NewViewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y);
  end else
    result := PointF(0,0);
end;

procedure TBGRAPart3D.NormalizeViewNormal;
var
  i: Integer;
begin
  for i := 0 to FVertexCount-1 do
    FVertices[i].NormalizeViewNormal;
  for i := 0 to FPartCount-1 do
    FParts[i].NormalizeViewNormal;
end;

procedure TBGRAPart3D.Translate(x, y, z: single; Before: boolean = true);
begin
  Translate(Point3D(x,y,z),Before);
end;

procedure TBGRAPart3D.Translate(ofs: TPoint3D; Before: boolean = true);
begin
  if Before then
    FMatrix *= MatrixTranslation3D(ofs)
  else
    FMatrix := MatrixTranslation3D(ofs)*FMatrix;
end;

function TBGRAPart3D.CreatePart: IBGRAPart3D;
begin
  if FPartCount = length(FParts) then
    setlength(FParts, FPartCount*2+1);
  result := TBGRAPart3D.Create(self);
  FParts[FPartCount] := result;
  inc(FPartCount);
end;

function TBGRAPart3D.GetContainer: IBGRAPart3D;
begin
  result := FContainer;
end;

procedure TBGRAPart3D.SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
begin
  if (AIndex < 0) or (AIndex >= FVertexCount) then
    raise exception.Create('Index of out bounds');
  FVertices[AIndex] := AValue;
end;

{ TBGRAObject3D }

procedure TBGRAObject3D.AddFace(AFace: IBGRAFace3D);
begin
  if FFaceCount = length(FFaces) then
     setlength(FFaces,FFaceCount*2+3);
  FFaces[FFaceCount] := AFace;
  inc(FFaceCount);
end;

constructor TBGRAObject3D.Create(AScene: TBGRAScene3D);
begin
  FColor := BGRAWhite;
  FLight := 1;
  FTexture := nil;
  FMainPart := TBGRAPart3D.Create(nil);
  FLightingNormal:= AScene.DefaultLightingNormal;
  FParentLighting:= True;
  FScene := AScene;
end;

destructor TBGRAObject3D.Destroy;
begin
  fillchar(FTexture,sizeof(FTexture),0);
  inherited Destroy;
end;

procedure TBGRAObject3D.Clear;
begin
  FFaces := nil;
  FFaceCount := 0;
  FMainPart.Clear(True);
end;

function TBGRAObject3D.GetColor: TBGRAPixel;
begin
  result := FColor;
end;

function TBGRAObject3D.GetLight: Single;
begin
  result := FLight;
end;

function TBGRAObject3D.GetTexture: IBGRAScanner;
begin
  result := FTexture;
end;

function TBGRAObject3D.GetMainPart: IBGRAPart3D;
begin
  result := FMainPart;
end;

procedure TBGRAObject3D.SetColor(const AValue: TBGRAPixel);
begin
  FColor := AValue;
  FTexture := nil;
end;

procedure TBGRAObject3D.SetLight(const AValue: Single);
begin
  FLight := AValue;
end;

procedure TBGRAObject3D.SetTexture(const AValue: IBGRAScanner);
begin
  FTexture := AValue;
end;

procedure TBGRAObject3D.SetMaterial(const AValue: IBGRAMaterial3D);
begin
  FMaterial := AValue;
end;

procedure TBGRAObject3D.RemoveUnusedVertices;
begin
  GetMainPart.RemoveUnusedVertices;
end;

procedure TBGRAObject3D.SeparatePart(APart: IBGRAPart3D);
var
  vertexInfo: array of record
       orig,dup: IBGRAVertex3D;
     end;

  i,j: integer;
  inPart,outPart: boolean;
  idxV: integer;
begin
  setlength(vertexInfo, APart.VertexCount);
  for i := 0 to high(vertexInfo) do
    with vertexInfo[i] do
    begin
      orig := APart.Vertex[i];
      dup := APart.Add(orig.SceneCoord_128);
    end;

  for i := 0 to GetFaceCount-1 do
    with GetFace(i) do
    begin
      inPart := false;
      outPart := false;
      for j := 0 to VertexCount-1 do
        if (APart.IndexOf(Vertex[j]) <> -1) then
          inPart := true
        else
          outPart := true;

      if inPart and not outPart then
      begin
        for j := 0 to VertexCount-1 do
        begin
          idxV := APart.IndexOf(Vertex[j]);
          if idxV <> -1 then
            Vertex[j] := vertexInfo[idxV].dup;
        end;
      end;
    end;

  for i := APart.VertexCount-1 downto 0 do
    APart.RemoveVertex(i);
end;

function TBGRAObject3D.GetScene: TBGRAScene3D;
begin
  result := FScene;
end;

function TBGRAObject3D.GetRefCount: integer;
begin
  result := RefCount;
end;

procedure TBGRAObject3D.SetBiface(AValue: boolean);
var i: integer;
begin
  for i := 0 to GetFaceCount-1 do
    GetFace(i).Biface := AValue;
end;

function TBGRAObject3D.GetLightingNormal: TLightingNormal3D;
begin
  result := FLightingNormal;
end;

function TBGRAObject3D.GetParentLighting: boolean;
begin
  result := FParentLighting;
end;

procedure TBGRAObject3D.SetLightingNormal(const AValue: TLightingNormal3D);
begin
  FLightingNormal := AValue;
  FParentLighting:= False;
end;

procedure TBGRAObject3D.SetParentLighting(const AValue: boolean);
begin
  FParentLighting:= AValue;
end;

procedure TBGRAObject3D.ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D);
var
  i: Integer;
begin
  FMainPart.ComputeWithMatrix(AMatrix,AProjection);
  for i := 0 to FFaceCount-1 do
    FFaces[i].ComputeViewNormalAndCenter;
  FMainPart.NormalizeViewNormal;
end;

function TBGRAObject3D.AddFaceReversed(const AVertices: array of IBGRAVertex3D
  ): IBGRAFace3D;
var
  tempVertices: array of IBGRAVertex3D;
  i: Integer;
begin
  setlength(tempVertices,length(AVertices));
  for i := 0 to high(tempVertices) do
    tempVertices[i] := AVertices[high(AVertices)-i];
  result := AddFace(tempVertices);
end;

function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
begin
  result := TBGRAFace3D.Create(self,AVertices);
  AddFace(result);
end;

function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D;
  ABiface: boolean): IBGRAFace3D;
begin
  result := TBGRAFace3D.Create(self,AVertices);
  result.Biface := ABiface;
  AddFace(result);
end;

function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D;
var Face: IBGRAFace3D;
begin
  Face := TBGRAFace3D.Create(self,AVertices);
  Face.Texture := ATexture;
  AddFace(Face);
  result := face;
end;

function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D;
  AColor: TBGRAPixel): IBGRAFace3D;
var Face: IBGRAFace3D;
begin
  Face := TBGRAFace3D.Create(self,AVertices);
  Face.SetColor(AColor);
  Face.Texture := nil;
  AddFace(Face);
  result := face;
end;

function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D;
  AColors: array of TBGRAPixel): IBGRAFace3D;
var
  i: Integer;
begin
  if length(AColors) <> length(AVertices) then
    raise Exception.Create('Dimension mismatch');
  result := TBGRAFace3D.Create(self,AVertices);
  for i := 0 to high(AColors) do
    result.VertexColor[i] := AColors[i];
  AddFace(result);
end;

function TBGRAObject3D.GetFace(AIndex: integer): IBGRAFace3D;
begin
  if (AIndex < 0) or (AIndex >= FFaceCount) then
    raise Exception.Create('Index out of bounds');
  result := FFaces[AIndex];
end;

function TBGRAObject3D.GetFaceCount: integer;
begin
  result := FFaceCount;
end;

function TBGRAObject3D.GetTotalVertexCount: integer;
begin
  result := GetMainPart.TotalVertexCount;
end;

function TBGRAObject3D.GetMaterial: IBGRAMaterial3D;
begin
  result := FMaterial;
end;

{ TBGRAScene3D }

function TBGRAScene3D.GetViewCenter: TPointF;
begin
  if FAutoViewCenter then
  begin
    if Surface = nil then
      result := PointF(0,0)
    else
      result := PointF((Surface.Width-1)/2,(Surface.Height-1)/2)
  end
  else
    result := FViewCenter;
end;

function TBGRAScene3D.GetViewPoint: TPoint3D;
begin
  result := Point3D(FViewPoint);
end;

function TBGRAScene3D.GetZoom: TPointF;
var size: single;
begin
  if FAutoZoom then
  begin
    if FSurface = nil then
      result := PointF(1,1)
    else
    begin
      Size := sqrt(FSurface.Width*FSurface.Height)*0.8;
      result := PointF(size,size);
    end;
  end else
    result := FZoom;
end;

procedure TBGRAScene3D.SetAmbiantLightColorF(const AValue: TColorF);
begin
  FAmbiantLightColor := ColorFToColorInt65536(AValue);
  FAmbiantLightness := (FAmbiantLightColor.r + FAmbiantLightColor.g + FAmbiantLightColor.b) div 6;
end;

procedure TBGRAScene3D.SetAmbiantLightness(const AValue: single);
begin
  FAmbiantLightness:= round(AValue*32768);
  FAmbiantLightColor := ColorInt65536(FAmbiantLightness*2, FAmbiantLightness*2, FAmbiantLightness*2);
end;

procedure TBGRAScene3D.SetAmbiantLightColor(const AValue: TBGRAPixel);
begin
  FAmbiantLightColor := BGRAToColorInt(AValue);
  FAmbiantLightness := (FAmbiantLightColor.r + FAmbiantLightColor.g + FAmbiantLightColor.b) div 6;
end;

function TBGRAScene3D.GetObject(AIndex: integer): IBGRAObject3D;
begin
  if (AIndex < 0) or (AIndex >= FObjectCount) then
    raise exception.Create('Index out of bounds');
  result := FObjects[AIndex];
end;

function TBGRAScene3D.GetVertexCount: integer;
var i: integer;
begin
  result := 0;
  for i := 0 to Object3DCount-1 do
    result += Object3D[i].TotalVertexCount;
end;

function TBGRAScene3D.GetAmbiantLightColor: TBGRAPixel;
begin
  result := ColorIntToBGRA(FAmbiantLightColor);
end;

function TBGRAScene3D.GetFaceCount: integer;
var i: integer;
begin
  result := 0;
  for i := 0 to Object3DCount-1 do
    result += Object3D[i].FaceCount;
end;

function TBGRAScene3D.GetLight(AIndex: integer): IBGRALight3D;
begin
  if (AIndex < 0) or (AIndex >= FLights.Count) then
    result := nil
  else
    result := TBGRALight3D(FLights[AIndex]);
end;

function TBGRAScene3D.GetLightCount: integer;
begin
  result := FLights.Count;
end;

function TBGRAScene3D.GetMaterial(AIndex: integer): IBGRAMaterial3D;
begin
  if (AIndex < 0) or (AIndex >= FMaterialCount) then
    raise exception.Create('Index out of bounds');
  result := FMaterials[AIndex];
end;

function TBGRAScene3D.GetAmbiantLightness: single;
begin
  result := FAmbiantLightness/32768;
end;

function TBGRAScene3D.GetAmbiantLightColorF: TColorF;
begin
  result := ColorInt65536ToColorF(FAmbiantLightColor);
end;

procedure TBGRAScene3D.SetAutoViewCenter(const AValue: boolean);
begin
  if FAutoViewCenter=AValue then exit;
  if not AValue then
    FViewCenter := ViewCenter;
  FAutoViewCenter:=AValue;
end;

procedure TBGRAScene3D.SetAutoZoom(const AValue: boolean);
begin
  if FAutoZoom=AValue then exit;
  if not AValue then
    FZoom := Zoom;
  FAutoZoom:=AValue;
end;

procedure TBGRAScene3D.SetViewCenter(const AValue: TPointF);
begin
  FViewCenter := AValue;
  FAutoViewCenter:= False;
end;

procedure TBGRAScene3D.ComputeMatrix;
var ZDir, XDir, YDir: TPoint3D_128;
begin
  if IsPoint3D_128_Zero(FTopDir) then exit;
  YDir := -FTopDir;
  Normalize3D_128(YDir);

  ZDir := FLookWhere-FViewPoint;
  if IsPoint3D_128_Zero(ZDir) then exit;
  Normalize3D_128(ZDir);

  VectProduct3D_128(YDir,ZDir,XDir);
  VectProduct3D_128(ZDir,XDir,YDir); //correct Y dir
  Normalize3D_128(XDir);
  Normalize3D_128(YDir);

  FMatrix := Matrix3D(XDir,YDir,ZDir,FViewPoint);
  FMatrix := MatrixInverse3D(FMatrix);
end;

procedure TBGRAScene3D.AddObject(AObj: IBGRAObject3D);
begin
  if FObjectCount = length(FObjects) then
    setlength(FObjects, FObjectCount*2+1);
  FObjects[FObjectCount] := AObj;
  inc(FObjectCount);
end;

procedure TBGRAScene3D.AddLight(ALight: TObject);
begin
  FLights.Add(ALight);
  IBGRALight3D(TBGRALight3D(ALight))._AddRef;
end;

procedure TBGRAScene3D.AddMaterial(AMaterial: IBGRAMaterial3D);
begin
  if FMaterialCount = length(FMaterials) then
    setlength(FMaterials, FMaterialCount*2+1);
  FMaterials[FMaterialCount] := AMaterial;
  inc(FMaterialCount);
end;

procedure TBGRAScene3D.Init;
begin
  FAutoZoom := True;
  FAutoViewCenter := True;
  ViewPoint := Point3D(0,0,-100);
  LookAt(Point3D(0,0,0), Point3D(0,-1,0));
  with RenderingOptions do
  begin
    TextureInterpolation := False;
    PerspectiveMode := pmPerspectiveMapping;
    LightingInterpolation := liSpecularHighQuality;
    AntialiasingMode := am3dNone;
    AntialiasingResampleLevel := 2;
  end;
  AmbiantLightness := 1;
  AmbiantLightColor := BGRAWhite;
  DefaultLightingNormal := lnFaceVertexMix;
  FLights := TList.Create;
  FRenderedFaceCount:= 0;
  FMaterialCount := 0;
  FObjectCount := 0;
  DefaultMaterial := CreateMaterial;
  RenderingOptions.MinZ := 1;
end;

constructor TBGRAScene3D.Create;
begin
  Init;
end;

constructor TBGRAScene3D.Create(ASurface: TBGRACustomBitmap);
begin
  FSurface := ASurface;
  Init;
end;

destructor TBGRAScene3D.Destroy;
begin
  Clear;
  FLights.Free;
  inherited Destroy;
end;

procedure TBGRAScene3D.Clear;
var i: integer;
begin
  for i := 0 to FObjectCount-1 do
    FObjects[i].Clear;
  FObjects := nil;
  FObjectCount := 0;
  for i := 0 to FLights.Count-1 do
    IBGRALight3D(TBGRALight3D(FLights[i]))._Release;
  FLights.Clear;
end;

{$hints off}
procedure TBGRAScene3D.UseMaterial(AMaterialName: string; AFace: IBGRAFace3D);
var color: TBGRAPixel;
begin
  color := BGRA(0,128,255);
  AFace.SetColor(color);
end;
{$hints on}

function TBGRAScene3D.LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean): IBGRAObject3D;
var t: textfile;
    s: string;

  function GetNextToken: string;
  var idxStart,idxEnd: integer;
  begin
    idxStart := 1;
    while (idxStart <= length(s)) and (s[idxStart]=' ') do inc(idxStart);
    if idxStart > length(s) then
    begin
      result := '';
      exit;
    end;
    idxEnd := idxStart;
    while (idxEnd < length(s)) and (s[idxEnd+1]<> ' ') do inc(idxEnd);
    result := copy(s,idxStart, idxEnd-idxStart+1);
    delete(s,1,idxEnd);
    if pos('/',result) <> 0 then result := copy(result,1,pos('/',result)-1);
  end;

var lineType : string;
    x,y,z : single;
    code : integer;
    vertices: array of IBGRAVertex3D;
    NbVertices,v,i: integer;
    tempV: IBGRAVertex3D;
    materialname: string;
    face: IBGRAFace3D;

begin
  result := CreateObject;
  assignfile(t,AFilename);
  reset(t);
  vertices := nil;
  NbVertices:= 0;
  materialname := 'default';
  while not eof(t) do
  begin
    readln(t,s);
    lineType := GetNextToken;
    if lineType = 'v' then
    begin
      val(GetNextToken,x,code);
      val(GetNextToken,y,code);
      val(GetNextToken,z,code);
      result.MainPart.Add(x,y,z);
    end else
    if lineType = 'usemtl' then
      materialname := trim(s)
    else
    if lineType = 'f' then
    begin
      NbVertices:= 0;
      repeat
        val(GetNextToken,v,code);
        if (code = 0) and (v >= 1) and (v <= result.MainPart.VertexCount) then
        begin
          if length(vertices) = nbvertices then
            setlength(vertices, length(vertices)*2+1);
          vertices[NbVertices] := result.MainPart.Vertex[v-1];
          inc(NbVertices);
        end else break;
      until false;
      if NbVertices > 2 then
      begin
        if SwapFacesOrientation then
          for i := 0 to NbVertices div 2-1 do
          begin
            tempV := vertices[i];
            vertices[i] := vertices[NbVertices-1-i];
            vertices[NbVertices-1-i] := tempV;
          end;
        face := result.AddFace(slice(vertices,NbVertices));
        face.MaterialName := materialname;
      end;
    end;
  end;
  closefile(t);
end;

procedure TBGRAScene3D.LookAt(AWhere: TPoint3D; ATopDir: TPoint3D);
begin
  FLookWhere := Point3D_128(AWhere);
  FTopDir := Point3D_128(ATopDir);
end;

procedure TBGRAScene3D.LookLeft(angleDeg: single);
var m,inv: TMatrix3D;
begin
  inv := MatrixInverse3D(FMatrix);
  m := MatrixRotateY(angleDeg*Pi/180);
  FLookWhere := inv*m*FMatrix*FLookWhere;
end;

procedure TBGRAScene3D.LookRight(angleDeg: single);
begin
  LookLeft(-angleDeg);
end;

procedure TBGRAScene3D.LookUp(angleDeg: single);
var m,inv: TMatrix3D;
begin
  inv := MatrixInverse3D(FMatrix);
  m := MatrixRotateX(-angleDeg*Pi/180);
  FLookWhere := inv*m*FMatrix*FLookWhere;
end;

procedure TBGRAScene3D.LookDown(angleDeg: single);
begin
  LookUp(-angleDeg);
end;

procedure TBGRAScene3D.Render;
begin
  InternalRender(FSurface, RenderingOptions.AntialiasingMode, 1);
end;

procedure TBGRAScene3D.ComputeView(ScaleX,ScaleY: single);
var
  i: Integer;
begin
  ComputeMatrix;

  FProjection.Zoom := Zoom;
  FProjection.Zoom.X *= ScaleX;
  FProjection.Zoom.Y *= ScaleY;
  FProjection.Center := ViewCenter;
  FProjection.Center.X *= ScaleX;
  FProjection.Center.Y *= ScaleY;
  for i := 0 to FObjectCount-1 do
    FObjects[i].ComputeWithMatrix(FMatrix, FProjection);
end;

function TBGRAScene3D.ComputeCoordinate(ASceneCoord: TPoint3D_128; APart: IBGRAPart3D): TPointF;
begin
  result := APart.ComputeCoordinate(ASceneCoord, FProjection);
end;

function TBGRAScene3D.ComputeCoordinate(AViewCoord: TPoint3D_128): TPointF;
var InvZ: single;
begin
  if AViewCoord.z > 0 then
  begin
    InvZ := 1/AViewCoord.z;
    result := PointF(AViewCoord.x*InvZ*FProjection.Zoom.x + FProjection.Center.x,
                     AViewCoord.y*InvZ*FProjection.Zoom.Y + FProjection.Center.y);
  end else
    result := PointF(0,0);
end;

procedure TBGRAScene3D.ComputeLight;
begin

end;

type
  arrayOfTBGRAFace3D = array of TBGRAFace3D;

procedure InsertionSortFaces(var a: arrayOfTBGRAFace3D);
var i,j: integer;
    temp: TBGRAFace3D;
begin
  for i := 1 to high(a) do
  begin
    Temp := a[i];
    j := i;
    while (j>0) and (a[j-1].ViewCenterZ > Temp.ViewCenterZ) do
    begin
      a[j] := a[j-1];
      dec(j);
    end;
    a[j] := Temp;
  end;
end;

function PartitionFaces(var a: arrayOfTBGRAFace3D; left,right: integer): integer;

  procedure Swap(idx1,idx2: integer); inline;
  var temp: TBGRAFace3D;
  begin
    temp := a[idx1];
    a[idx1] := a[idx2];
    a[idx2] := temp;
  end;

var pivotIndex: integer;
    pivotValue: TBGRAFace3D;
    storeIndex: integer;
    i: integer;

begin
  pivotIndex := left + random(right-left+1);
  pivotValue := a[pivotIndex];
  swap(pivotIndex,right);
  storeIndex := left;
  for i := left to right-1 do
    if a[i].ViewCenterZ <= pivotValue.ViewCenterZ then
    begin
      swap(i,storeIndex);
      inc(storeIndex);
    end;
  swap(storeIndex,right);
  result := storeIndex;
end;

procedure QuickSortFaces(var a: arrayOfTBGRAFace3D; left,right: integer);
var pivotNewIndex: integer;
begin
  if right > left+9 then
  begin
    pivotNewIndex := PartitionFaces(a,left,right);
    QuickSortFaces(a,left,pivotNewIndex-1);
    QuickSortFaces(a,pivotNewIndex+1,right);
  end;
end;

procedure SortFaces(var a: arrayOfTBGRAFace3D);
begin
  if length(a) < 10 then InsertionSortFaces(a) else
  begin
    QuickSortFaces(a,0,high(a));
    InsertionSortFaces(a);
  end;
end;

function IsPolyVisible(const p : array of TPointF; ori: integer = 1) : boolean;
var i: integer;
begin
  i := 0;
  while i<=high(p)-2 do
  begin
    if ori*
    ( (p[i+1].x-p[i].x)*(p[i+2].y-p[i].y) -
      (p[i+1].y-p[i].y)*(p[i+2].x-p[i].x)) > 0 then
    begin
        result := true;
        exit;
    end;
    inc(i);
  end;
  result := false;
end;

procedure TBGRAScene3D.InternalRender(ASurface: TBGRACustomBitmap; AAntialiasingMode: TAntialiasingMode3D; GlobalScale: single);
var
  LFaces: array of TBGRAFace3D;
  LFaceOpaque: array of boolean;
  LFaceCount: integer;

  procedure PrepareFaces;
  var i,j, LFaceIndex: integer;
      obj: IBGRAObject3D;
  begin
    LFaces := nil;
    LFaceCount := 0;
    for i := 0 to FObjectCount-1 do
    begin
      obj := FObjects[i];
      inc(LFaceCount, obj.GetFaceCount);
      if obj.GetParentLighting then
      begin
        obj.SetLightingNormal(Self.DefaultLightingNormal);
        obj.SetParentLighting(True);
      end;
    end;
    setlength(LFaces, LFaceCount);
    LFaceIndex := 0;
    for i := 0 to FObjectCount-1 do
      with FObjects[i] do
      begin
        for j := 0 to GetFaceCount-1 do
        begin
          LFaces[LFaceIndex] := TBGRAFace3D(GetFace(j).GetAsObject);
          inc(LFaceIndex);
        end;
      end;
  end;

var
  multi: TBGRAMultishapeFiller;
  ColorGradientTempBmp: TBGRACustomBitmap;
  zbuffer: psingle;

  LVertices: array of TBGRAVertex3D;
  LColors: array of TBGRAPixel;
  LTexCoord: array of TPointF;
  LZ: array of single;
  LProj: array of TPointF;
  LPos3D, LNormal3D: array of TPoint3D_128;
  LLighting: array of word;
  shaderContext: TMemoryBlockAlign128;
  lightingProc: TShaderFunction3D;
  UseAmbiantColor: boolean;

  procedure DrawFace(numFace: integer);

    procedure DrawAliasedColoredFace(shader: TShaderFunction3D; VCount: integer; context: PBasicLightingContext);
    var j,k: integer;
        SameColor: boolean;
        center: record
          proj: TPointF;
          pos3D,normal3D: TPoint3D_128;
          color: TBGRAPixel;
        end;

    begin
      SameColor := True;
      for j := 1 to VCount-1 do
        if (LColors[j]<>LColors[j-1]) then SameColor := False;

      if shader <> nil then
      begin
        if SameColor then
        begin
          BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
            slice(LProj,VCount),slice(LPos3D,VCount),slice(LNormal3D,VCount),nil,
              slice(LTexCoord,VCount),False,shader,True,LColors[0],zbuffer,context);
        end else
        if VCount = 3 then
        begin
          ColorGradientTempBmp.SetPixel(0,0,LColors[0]);
          ColorGradientTempBmp.SetPixel(1,0,LColors[1]);
          ColorGradientTempBmp.SetPixel(0,1,LColors[2]);
          ColorGradientTempBmp.SetPixel(1,1,MergeBGRA(LColors[1],LColors[2]));
          BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
            slice(LProj,VCount),slice(LPos3D,VCount),slice(LNormal3D,VCount),ColorGradientTempBmp,
              [PointF(0,0),PointF(1,0),PointF(0,1)],True,shader,True, BGRAPixelTransparent,zbuffer,context);
        end else
        if VCount = 4 then
        begin
          ColorGradientTempBmp.SetPixel(0,0,LColors[0]);
          ColorGradientTempBmp.SetPixel(1,0,LColors[1]);
          ColorGradientTempBmp.SetPixel(1,1,LColors[2]);
          ColorGradientTempBmp.SetPixel(0,1,LColors[3]);
          BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
            slice(LProj,VCount),slice(LPos3D,VCount),slice(LNormal3D,VCount),ColorGradientTempBmp,
              [PointF(0,0),PointF(1,0),PointF(1,1),PointF(0,1)],True,shader,True, BGRAPixelTransparent,zbuffer,context);
        end else
        if VCount >= 3 then
        begin //split into triangles
          with center do
          begin
            ClearPoint3D_128(pos3D);
            ClearPoint3D_128(normal3D);
            color := MergeBGRA(slice(LColors,VCount));
          end;
          for j := 0 to VCount-1 do
          begin
            center.pos3D += LPos3D[j];
            center.normal3D += LNormal3D[j];
          end;
          with center do
          begin
            pos3D *= (1/VCount);
            Normalize3D_128(normal3D);
          end;
          center.proj := ComputeCoordinate(center.pos3D);
          k := VCount-1;
          for j := 0 to VCount-1 do
          begin
            ColorGradientTempBmp.SetPixel(0,0,LColors[k]);
            ColorGradientTempBmp.SetPixel(1,0,LColors[j]);
            ColorGradientTempBmp.SetPixel(0,1,center.color);
            ColorGradientTempBmp.SetPixel(1,1,MergeBGRA(LColors[j],center.color));
            BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
              [LProj[k],LProj[j],center.proj], [LPos3D[k],LPos3D[j],center.pos3D],
              [LNormal3D[k],LNormal3D[j],center.normal3D], ColorGradientTempBmp,
                [PointF(0,0),PointF(1,0),PointF(0,1)],True,shader,True, BGRAPixelTransparent,zbuffer,context);
            k := j;
          end;
        end;
      end else
      begin
        if SameColor then
        begin
          if RenderingOptions.PerspectiveMode = pmZBuffer then
            BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(ASurface, slice(LProj,VCount),
            slice(LZ,VCount), slice(LColors,VCount),True,zbuffer)
          else
            ASurface.FillPoly(slice(LProj,VCount),LColors[0],dmDrawWithTransparency);
        end
        else
        begin
          if VCount > 4 then
          begin //split into triangles
            with center do
            begin
              ClearPoint3D_128(pos3D);
              color := MergeBGRA(slice(LColors,VCount));
            end;
            for j := 0 to VCount-1 do
              center.pos3D += LPos3D[j];
            with center do
              pos3D *= (1/VCount);
            center.proj := ComputeCoordinate(center.pos3D);
            k := VCount-1;
            if RenderingOptions.PerspectiveMode = pmLinearMapping then
            begin
              for j := 0 to VCount-1 do
              begin
                ASurface.FillPolyLinearColor([LProj[k],LProj[j],center.proj],[LColors[k],LColors[j],center.color]);
                k := j;
              end;
            end else
            begin
              for j := 0 to VCount-1 do
              begin
                BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(ASurface, [LProj[k],LProj[j],center.proj],
                 [LZ[k],LZ[j],center.pos3D.z], [LColors[k],LColors[j],center.color],True,zbuffer);
                k := j;
              end;
            end;
          end else
          begin
            if RenderingOptions.PerspectiveMode = pmLinearMapping then
              ASurface.FillPolyLinearColor(slice(LProj,VCount),slice(LColors,VCount))
            else
              BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(ASurface, slice(LProj,VCount),
               slice(LZ,VCount), slice(LColors,VCount),True,zbuffer);
          end;
        end;
      end;
    end;

  var
    j,k: Integer;
    LTexture: IBGRAScanner;
    LMaterial: TBGRAMaterial3D;
    SameColor: boolean;
    LLightNormal : TLightingNormal3D;
    LNoLighting: boolean;
    PtCenter: TPointF;
    PtCenter3D: TPoint3D_128;
    ColorCenter: TBGRAPixel;
    VCount,NewVCount: integer;
    ctx: PSceneLightingContext;
    NegNormals, UseDiffuseColor,
    UseDiffuseLightness{, OnlyDirectionalLight}: boolean;
    LastVisibleVertex: integer;

    procedure AddZIntermediate(n1,n2: integer);
    var t: single;
        v1,v2: TBGRAVertex3D;
    begin
       v1 := LVertices[n1];
       v2 := LVertices[n2];
       t := (RenderingOptions.MinZ - v1.ViewCoord.z)/(v2.ViewCoord.z - v1.ViewCoord.z);
       LVertices[NewVCount] := nil; //computed

       LColors[NewVCount] := MergeBGRA(LColors[n1],round((1-t)*65536),LColors[n2],round(t*65536));
       LTexCoord[NewVCount] := LTexCoord[n1]*(1-t) + LTexCoord[n2]*t;
       LPos3D[NewVCount] := LPos3D[n1]*(1-t) + LPos3D[n2]*t;
       LNormal3D[NewVCount] := LNormal3D[n1]*(1-t) + LNormal3D[n2]*t;
       LZ[NewVCount] := LZ[n1]*(1-t) + LZ[n2]*t;
       LProj[NewVCount] := ComputeCoordinate(LPos3D[NewVCount]);
       NewVCount += 1;
    end;

    procedure LoadVertex(idxL: integer; idxV: integer);
    var desc: PBGRAFaceVertexDescription;
        tempV: TBGRAVertex3D;
    begin
      with LFaces[numFace] do
      begin
        desc := VertexDescription[idxV];
        with desc^ do
        begin
          tempV := TBGRAVertex3D(vertex.GetAsObject);
          LVertices[idxL] := tempV;

          if LTexture <> nil then
            LColors[idxL] := BGRA(128,128,128)
          else
            if ColorOverride then
              LColors[idxL] := Color
            else
            begin
              if tempV.ParentColor then
                LColors[idxL] := Object3D.Color
              else
                LColors[idxL] := tempV.Color;
            end;

          if TexCoordOverride then
            LTexCoord[idxL] := TexCoord
          else
            LTexCoord[idxL] := tempV.TexCoord;

          with tempV.CoordData^ do
          begin
            LPos3D[idxL] := viewCoord;
            LNormal3D[idxL] := viewNormal;
            LProj[idxL] := projectedCoord;
            LZ[idxL] := viewCoord.Z;
          end;
        end;
      end;
    end;

  begin
     with LFaces[numFace] do
     begin
       VCount := VertexCount;
       if VCount < 3 then exit;

       if ParentTexture then
         LTexture := Object3D.Texture
       else
         LTexture := Texture;

       if Material <> nil then
         LMaterial := TBGRAMaterial3D(Material.GetAsObject)
       else if Object3D.Material <> nil then
         LMaterial := TBGRAMaterial3D(Object3D.Material.GetAsObject)
       else if self.DefaultMaterial <> nil then
         LMaterial := TBGRAMaterial3D(self.DefaultMaterial.GetAsObject)
       else
         exit;

       LLightNormal := Object3D.LightingNormal;

       if length(LVertices) < VCount+3 then  //keep margin for z-clip
       begin
         setlength(LVertices, (VCount+3)*2);
         setlength(LColors, length(LVertices));
         setlength(LTexCoord, length(LVertices));
         setlength(LZ, length(LVertices));
         setlength(LProj, length(LVertices));
         setlength(LPos3D, length(LVertices));
         setlength(LNormal3D, length(LVertices));
         setlength(LLighting, length(LVertices));
       end;

       NewVCount := 0;
       LastVisibleVertex := -1;
       for k := VCount-1 downto 0 do
         if Vertex[k].ViewCoordZ >= RenderingOptions.MinZ then
         begin
           LastVisibleVertex := k;
           break;
         end;
       if LastVisibleVertex = -1 then exit;

       k := VCount-1;
       for j := 0 to VCount-1 do
       begin
         if Vertex[j].ViewCoordZ >= RenderingOptions.MinZ then
         begin
           if k <> LastVisibleVertex then   //one or more vertices is out
           begin
             LoadVertex(NewVCount+1, LastVisibleVertex);
             LoadVertex(NewVCount+2, (LastVisibleVertex+1) mod VertexCount);
             AddZIntermediate(NewVCount+1,NewVCount+2);

             LoadVertex(NewVCount+1, j);
             LoadVertex(NewVCount+2, k);

             AddZIntermediate(NewVCount+1,NewVCount+2);
             inc(NewVCount);
           end else
           begin
             LoadVertex(NewVCount, j);
             NewVCount += 1;
           end;
           LastVisibleVertex := j;
         end;
         k := j;
       end;
       VCount := NewVCount;
       if VCount < 3 then exit; //after z-clipping

       if not IsPolyVisible(slice(LProj,VCount)) then
       begin
         if not Biface then exit;
         NegNormals := True;
       end else
       begin
         NegNormals := False;
       end;

       //from here we assume the face will be drawn
       inc(FRenderedFaceCount);

       //compute normals
       case LLightNormal of
         lnFace: for j := 0 to VCount-1 do
                   LNormal3D[j] := ViewNormal_128;
         lnFaceVertexMix:
             for j := 0 to VCount-1 do
             begin
               LNormal3D[j] += ViewNormal_128;
               Normalize3D_128(LNormal3D[j]);
             end;
       end;
       if NegNormals then
         for j := 0 to VCount-1 do
           LNormal3D[j] := -LNormal3D[j];

       //prepare lighting
       {OnlyDirectionalLight := true;
       for j := 0 to LightCount-1 do
         if not Light[j].IsDirectional then OnlyDirectionalLight := false; }

       if LMaterial.GetSpecularOn then
        lightingProc:= TShaderFunction3D(@ApplyLightingWithDiffuseAndSpecularColor) else
       begin
         UseDiffuseColor := UseAmbiantColor;
         if not UseDiffuseColor then
         begin
           with LMaterial.GetDiffuseColorInt do
            UseDiffuseColor := (r <> g) or (g <> b);
           if not UseDiffuseColor and LMaterial.GetAutoDiffuseColor then
           begin
             for j := 0 to LightCount-1 do
               if Light[j].ColoredLight then
               begin
                 UseDiffuseColor := true;
                 break;
               end;
           end;
         end;
         if UseDiffuseColor then
           lightingProc := TShaderFunction3D(@ApplyLightingWithDiffuseColor) else
         begin
           UseDiffuseLightness := FAmbiantLightness <> 32768;
           if not UseDiffuseLightness then
           begin
             if LightCount <> 0 then
               UseDiffuseLightness := true;
           end;

           if UseDiffuseLightness then
             lightingProc := TShaderFunction3D(@ApplyLightingWithLightness) else
           if FAmbiantLightness <> 32768 then
            lightingProc := TShaderFunction3D(@ApplyLightingWithAmbiantLightnessOnly) else
              lightingProc := TShaderFunction3D(@ApplyNoLighting);
         end;
       end;

       ctx := PSceneLightingContext( shaderContext.Data );
       ctx^.material := LMaterial;
       if LightThroughFactorOverride then
         ctx^.LightThroughFactor := LightThroughFactor
       else
         ctx^.LightThroughFactor := LMaterial.GetLightThroughFactor;
       ctx^.LightThrough := ctx^.LightThroughFactor > 0;
       ctx^.SaturationHighF := LMaterial.GetSaturationHigh;
       ctx^.SaturationLowF := LMaterial.GetSaturationLow;
       ctx^.SaturationHigh := round(LMaterial.GetSaturationHigh*32768);
       ctx^.SaturationLow := round(LMaterial.GetSaturationLow*32768);

       //high-quality lighting interpolation, necessary for Phong and high-quality Gouraud
       if (
           (RenderingOptions.LightingInterpolation = liAlwaysHighQuality) or
           ((RenderingOptions.LightingInterpolation = liSpecularHighQuality) and LMaterial.GetSpecularOn)
       ) and (LLightNormal <> lnNone) {and (not (LLightNormal = lnFace) and OnlyDirectionalLight) }then
       begin
         if LTexture = nil then
           DrawAliasedColoredFace(lightingProc,VCount,PBasicLightingContext(ctx)) //use shader
         else
           BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
               slice(LProj,VCount),slice(LPos3D,VCount),slice(LNormal3D,VCount),LTexture,
                 slice(LTexCoord,VCount),RenderingOptions.TextureInterpolation,lightingProc,True, BGRAPixelTransparent,zbuffer,PBasicLightingContext(ctx));

         exit;
       end;

       //Vertex lighting interpolation (low-quality Gouraud, low-quality Phong)
       LNoLighting := True;
       for j := 0 to VCount-1 do
       begin
         with ctx^ do
         begin
           basic.Position := LPos3D[j];
           basic.Normal := LNormal3D[j];
         end;
         LColors[j] := lightingProc(PBasicLightingContext(ctx),LColors[j]);
         if LColors[j] <> BGRA(128,128,128) then
           LNoLighting := false;
       end;

       if (AAntialiasingMode = am3dMultishape) and not (RenderingOptions.PerspectiveMode = pmZBuffer) then //high-quality antialiasing
       begin
         if LTexture <> nil then
         begin
           if (RenderingOptions.PerspectiveMode <> pmLinearMapping) and (VCount=4) then
             multi.AddQuadPerspectiveMapping(LProj[0],LProj[1],LProj[2],LProj[3],LTexture,LTexCoord[0],LTexCoord[1],LTexCoord[2],LTexCoord[3])
           else
           if VCount>=3 then
           begin
             for j := 0 to VCount-3 do
               multi.AddTriangleLinearMapping(LProj[j],LProj[j+1],LProj[j+2],LTexture,LTexCoord[j],LTexCoord[j+1],LTexCoord[j+2]);
           end;
         end
         else
         begin
           SameColor := True;
           for j := 1 to VCount-1 do
             if (LColors[j]<>LColors[j-1]) then SameColor := False;

           if SameColor then
             multi.AddPolygon(slice(LProj,VCount),LColors[0])
           else
           if VCount=3 then
             multi.AddTriangleLinearColor(LProj[0],LProj[1],LProj[2],LColors[0],LColors[1],LColors[2])
           else
           if VCount>=3 then
           begin  //split into triangles
             PtCenter3D := Point3D_128_Zero;
             for j := 0 to VCount-1 do
               PtCenter3D += LPos3D[j];
             PtCenter3D *= (1/VCount);
             PtCenter := ComputeCoordinate(PtCenter3D);
             ColorCenter := MergeBGRA(slice(LColors,VCount));
             k := VCount-1;
             for j := 0 to VCount-1 do
             begin
               multi.AddTriangleLinearColor(LProj[k],LProj[j],PtCenter,LColors[k],LColors[j],ColorCenter);
               k := j;
             end;
           end;
         end;
       end else
       begin
         if LTexture <> nil then
         begin
           if LNoLighting then
           begin
             if RenderingOptions.PerspectiveMode <> pmLinearMapping then
               ASurface.FillPolyPerspectiveMapping(slice(LProj,VCount),slice(LZ,VCount),LTexture,slice(LTexCoord,VCount),RenderingOptions.TextureInterpolation, zbuffer)
             else
               ASurface.FillPolyLinearMapping(slice(LProj,VCount),LTexture,slice(LTexCoord,VCount),RenderingOptions.TextureInterpolation);
           end else
           begin
             for j := 0 to VCount-1 do
               LLighting[j] := LColors[j].green shl 8;
             if RenderingOptions.PerspectiveMode <> pmLinearMapping then
               ASurface.FillPolyPerspectiveMappingLightness(slice(LProj,VCount),slice(LZ,VCount),LTexture,slice(LTexCoord,VCount),slice(LLighting,VCount),RenderingOptions.TextureInterpolation, zbuffer)
             else
               ASurface.FillPolyLinearMappingLightness(slice(LProj,VCount),LTexture,slice(LTexCoord,VCount),slice(LLighting,VCount),RenderingOptions.TextureInterpolation);
           end;
         end
         else
           DrawAliasedColoredFace(nil,VCount,PBasicLightingContext(ctx));  //already low-quality shaded
       end;
     end;
  end;

  procedure DrawWithResample;
  var
    tempSurface,resampledTempSurface: TBGRACustomBitmap;
  begin
    tempSurface := ASurface.NewBitmap(ASurface.Width*RenderingOptions.AntialiasingResampleLevel,ASurface.Height*RenderingOptions.AntialiasingResampleLevel);
    InternalRender(tempSurface, am3dNone, RenderingOptions.AntialiasingResampleLevel);
    resampledTempSurface := tempSurface.Resample(ASurface.Width,ASurface.Height,rmSimpleStretch);
    tempSurface.Free;
    ASurface.PutImage(0,0,resampledTempSurface,dmDrawWithTransparency);
    resampledTempSurface.Free;
  end;

var i,j: integer;

begin
  FRenderedFaceCount:= 0;

  if ASurface = nil then
    raise exception.Create('No surface specified');

  if (AAntialiasingMode = am3dResample) and (RenderingOptions.AntialiasingResampleLevel > 1) then
  begin
    DrawWithResample;
    exit;
  end;

  PrepareFaces;
  ComputeView(GlobalScale,GlobalScale);
  ComputeLight;
  UseAmbiantColor := (FAmbiantLightColor.r <> FAmbiantLightColor.g) or (FAmbiantLightColor.g <> FAmbiantLightColor.b);

  SortFaces(LFaces);
  LVertices := nil;

  if AAntialiasingMode = am3dMultishape then
  begin
    multi := TBGRAMultishapeFiller.Create;
    multi.PolygonOrder := poLastOnTop;
  end
  else
    multi := nil;

  ColorGradientTempBmp := ASurface.NewBitmap(2,2);
  ColorGradientTempBmp.ScanInterpolationFilter := rfLinear;

  if RenderingOptions.PerspectiveMode = pmZBuffer then
  begin
    getmem(zbuffer, ASurface.NbPixels*sizeof(single));
    FillDWord(zbuffer^, ASurface.NbPixels, dword(single(0)));
  end
  else
    zbuffer := nil;

  shaderContext := TMemoryBlockAlign128.Create(sizeof(TSceneLightingContext));

  if zbuffer <> nil then
  begin
    setlength(LFaceOpaque, length(LFaces));
    for i := 0 to High(LFaces) do
    begin
      if (LFaces[i].Texture = nil) then
      begin
        LFaceOpaque[i] := true;
        with LFaces[i] do
          for j := 0 to VertexCount-1 do
            if VertexColor[j].alpha <> 255 then
            begin
              LFaceOpaque[i] := false;
              break;
            end;
      end else
        LFaceOpaque[i] := true;
    end;

    //draw near opaque faces first
    for i := 0 to High(LFaces) do
      if LFaceOpaque[i] then DrawFace(i);

    //draw other faces
    for i := High(LFaces) downto 0 do
      if not LFaceOpaque[i] then DrawFace(i);
  end else
  begin
    for i := High(LFaces) downto 0 do
      DrawFace(i);
  end;

  shaderContext.Free;
  if zbuffer <> nil then freemem(zbuffer);
  ColorGradientTempBmp.Free;

  if multi <> nil then
  begin
    multi.Draw(ASurface);
    multi.Free;
  end;
end;

procedure TBGRAScene3D.SetViewPoint(const AValue: TPoint3D);
begin
  FViewPoint := Point3D_128(AValue);
end;

function TBGRAScene3D.ApplyLightingWithLightness(Context: PSceneLightingContext;
  Color: TBGRAPixel): TBGRAPixel;
var i: Integer;
begin
  Context^.lightness := FAmbiantLightness;

  i := FLights.Count-1;
  while i >= 0 do
  begin
    TBGRALight3D(FLights[i]).ComputeDiffuseLightness(Context);
    dec(i);
  end;

  with Context^ do
    if Lightness <= 0 then
      result := BGRA(0,0,0,color.alpha)
    else
    begin
      if Lightness <= SaturationLow then
        result := ApplyIntensityFast(Color, Lightness)
      else if Lightness >= SaturationHigh then
        result := BGRA(255,255,255,color.alpha)
      else
        result := ApplyLightnessFast( ApplyIntensityFast(Color, SaturationLow),
                              (Lightness - SaturationLow)*32767 div (SaturationHigh-SaturationLow)+32768 );
    end;
end;

function TBGRAScene3D.ApplyLightingWithDiffuseColor(Context: PSceneLightingContext;
  Color: TBGRAPixel): TBGRAPixel;
var i: Integer;
begin
  Context^.diffuseColor := FAmbiantLightColor;

  i := FLights.Count-1;
  while i >= 0 do
  begin
    TBGRALight3D(FLights[i]).ComputeDiffuseColor(Context);
    dec(i);
  end;

  result := ColorIntToBGRA(BGRAToColorIntMultiply(Color,Context^.diffuseColor));
  result.alpha := Color.alpha;
end;

function TBGRAScene3D.ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext;
  Color: TBGRAPixel): TBGRAPixel;
var i: Integer;
begin
  Context^.diffuseColor := FAmbiantLightColor;
  Context^.specularColor := ColorInt65536(0,0,0,0);

  i := FLights.Count-1;
  while i >= 0 do
  begin
    TBGRALight3D(FLights[i]).ComputeDiffuseAndSpecularColor(Context);
    dec(i);
  end;

  with Context^ do
  begin
    diffuseColor.a := 65536;
    result := ColorIntToBGRA(BGRAToColorIntMultiply(Color,diffuseColor) + specularColor);
  end;
end;

{$hints off}
function TBGRAScene3D.ApplyNoLighting(Context: PSceneLightingContext;
  Color: TBGRAPixel): TBGRAPixel;
begin
  result := Color;
end;

function TBGRAScene3D.ApplyLightingWithAmbiantLightnessOnly(
  Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel;
begin
  if FAmbiantLightness <= 0 then
    result := BGRA(0,0,0,color.alpha)
  else
    result := ApplyIntensityFast(Color, FAmbiantLightness);
end;

{$hints on}

function TBGRAScene3D.CreateObject: IBGRAObject3D;
begin
  result := TBGRAObject3D.Create(self);
  AddObject(result);
end;

function TBGRAScene3D.CreateObject(ATexture: IBGRAScanner): IBGRAObject3D;
begin
  result := TBGRAObject3D.Create(self);
  result.Texture := ATexture;
  AddObject(result);
end;

function TBGRAScene3D.CreateObject(AColor: TBGRAPixel): IBGRAObject3D;
begin
  result := TBGRAObject3D.Create(self);
  result.Color := AColor;
  AddObject(result);
end;

function TBGRAScene3D.CreateSphere(ARadius: Single; AHorizPrecision: integer; AVerticalPrecision : integer): IBGRAObject3D;
begin
  result := TBGRASphere3D.Create(self, ARadius, AHorizPrecision, AVerticalPrecision);
  AddObject(result);
end;

function TBGRAScene3D.CreateSphere(ARadius: Single; AColor: TBGRAPixel; AHorizPrecision: integer; AVerticalPrecision : integer): IBGRAObject3D;
begin
  result := TBGRASphere3D.Create(self, ARadius, AHorizPrecision, AVerticalPrecision);
  result.Color := AColor;
  AddObject(result);
end;

function TBGRAScene3D.CreateHalfSphere(ARadius: Single;
  AHorizPrecision: integer; AVerticalPrecision: integer): IBGRAObject3D;
begin
  result := TBGRASphere3D.Create(self, ARadius, AHorizPrecision, AVerticalPrecision, True);
  AddObject(result);
end;

function TBGRAScene3D.CreateHalfSphere(ARadius: Single; AColor: TBGRAPixel;
  AHorizPrecision: integer; AVerticalPrecision: integer): IBGRAObject3D;
begin
  result := TBGRASphere3D.Create(self, ARadius, AHorizPrecision, AVerticalPrecision, True);
  result.Color := AColor;
  AddObject(result);
end;

procedure TBGRAScene3D.RemoveObject(AObject: IBGRAObject3D);
var
  i,j: Integer;
begin
  for i := FObjectCount-1 downto 0 do
    if FObjects[i] = AObject then
    begin
      dec(FObjectCount);
      FObjects[i] := nil;
      for j := i to FObjectCount-1 do
        FObjects[j] := FObjects[j+1];
    end;
end;

function TBGRAScene3D.AddDirectionalLight(ADirection: TPoint3D;
  ALightness: single; AMinIntensity: single): IBGRADirectionalLight3D;
var lightObj: TBGRADirectionalLight3D;
begin
  lightObj := TBGRADirectionalLight3D.Create(ADirection);
  result := lightObj;
  result.ColorF := ColorF(ALightness,ALightness,ALightness,1);
  result.MinIntensity := AMinIntensity;
  AddLight(lightObj);
end;

function TBGRAScene3D.AddPointLight(AVertex: IBGRAVertex3D;
  AOptimalDistance: single; ALightness: single; AMinIntensity: single
  ): IBGRAPointLight3D;
var lightObj: TBGRAPointLight3D;
begin
  lightObj := TBGRAPointLight3D.Create(AVertex, ALightness*sqr(AOptimalDistance));
  result := lightObj;
  result.MinIntensity := AMinIntensity;
  AddLight(lightObj);
end;

function TBGRAScene3D.AddDirectionalLight(ADirection: TPoint3D;
  AColor: TBGRAPixel; AMinIntensity: single): IBGRADirectionalLight3D;
var lightObj: TBGRADirectionalLight3D;
begin
  lightObj := TBGRADirectionalLight3D.Create(ADirection);
  result := lightObj;
  result.MinIntensity := AMinIntensity;
  result.Color := AColor;
  AddLight(lightObj);
end;

function TBGRAScene3D.AddPointLight(AVertex: IBGRAVertex3D;
  AOptimalDistance: single; AColor: TBGRAPixel; AMinIntensity: single
  ): IBGRAPointLight3D;
var lightObj: TBGRAPointLight3D;
begin
  lightObj := TBGRAPointLight3D.Create(AVertex,sqr(AOptimalDistance));
  result := lightObj;
  result.Color := AColor;
  result.MinIntensity := AMinIntensity;
  AddLight(lightObj);
end;

procedure TBGRAScene3D.RemoveLight(ALight: IBGRALight3D);
var idx: integer;
begin
  idx := FLights.IndexOf(ALight.GetAsObject);
  if idx <> -1 then
  begin
    ALight._Release;
    FLights.Delete(Idx);
  end;
end;

procedure TBGRAScene3D.SetZoom(value: Single);
begin
  SetZoom(PointF(value,value));
end;

procedure TBGRAScene3D.SetZoom(value: TPointF);
begin
  FZoom := value;
  FAutoZoom := false;
end;

function TBGRAScene3D.CreateMaterial: IBGRAMaterial3D;
begin
  result := TBGRAMaterial3D.Create;
  AddMaterial(result);
end;

function TBGRAScene3D.CreateMaterial(ASpecularIndex: integer): IBGRAMaterial3D;
begin
  result := TBGRAMaterial3D.Create;
  result.SpecularIndex := ASpecularIndex;
  result.SpecularColor := BGRAWhite;
  AddMaterial(result);
end;

procedure TBGRAScene3D.UpdateMaterials;
var i,j: integer;
  obj: IBGRAObject3D;
  face: IBGRAFace3D;
begin
  for i := 0 to Object3DCount-1 do
  begin
    obj := Object3D[i];
    for j := 0 to obj.FaceCount-1 do
    begin
      face := obj.Face[j];
      if face.MaterialName <> '' then
        UseMaterial(face.MaterialName,face);
    end;
  end;
end;

procedure TBGRAScene3D.UpdateMaterial(AMaterialName: string);
var i,j: integer;
  obj: IBGRAObject3D;
  face: IBGRAFace3D;
begin
  for i := 0 to Object3DCount-1 do
  begin
    obj := Object3D[i];
    for j := 0 to obj.FaceCount-1 do
    begin
      face := obj.Face[j];
      if face.MaterialName = AMaterialName then
        UseMaterial(face.MaterialName,face);
    end;
  end;
end;

end.

