Ignore:
Timestamp:
Dec 22, 2016, 8:49:19 PM (7 years ago)
Author:
chronos
Message:
  • Modified: Updated BGRABitmap package.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/Packages/bgrabitmap/bgrascene3d.pas

    r472 r494  
    66
    77uses
    8   Classes, SysUtils, BGRABitmapTypes, BGRAColorInt, BGRASSE, BGRAMatrix3D;
     8  Classes, SysUtils, BGRABitmapTypes, BGRAColorInt,
     9  BGRASSE, BGRAMatrix3D,
     10  BGRASceneTypes, BGRARenderer3D;
    911
    1012type
    1113  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 
    30   PSceneLightingContext = ^TSceneLightingContext;
    31   TSceneLightingContext = packed record
    32     basic: TBasicLightingContext;
    33     {128} diffuseColor, {144} specularColor: TColorInt65536;
    34     {160} vL, {176} dummy: TPoint3D_128;
    35     {192} vH: TPoint3D_128;
    36     {208} lightness: integer;
    37     {212} material : TObject;
    38     LightThroughFactor: single;
    39     LightThrough: LongBool;
    40     SaturationLow: integer;
    41     SaturationLowF: single;
    42     SaturationHigh: integer;
    43     SaturationHighF: single;
    44   end;
    45 
    46   TBGRAScene3D = class;
    47 
    48 {$i bgrascene3Dinterface.inc}
     14  TLightingNormal3D = BGRASceneTypes.TLightingNormal3D;
     15  TLightingInterpolation3D = BGRASceneTypes.TLightingInterpolation3D;
     16  TAntialiasingMode3D = BGRASceneTypes.TAntialiasingMode3D;
     17  TPerspectiveMode3D = BGRASceneTypes.TPerspectiveMode3D;
     18  TRenderingOptions = BGRASceneTypes.TRenderingOptions;
     19
     20  IBGRAVertex3D = BGRASceneTypes.IBGRAVertex3D;
     21  IBGRANormal3D = BGRASceneTypes.IBGRANormal3D;
     22  IBGRALight3D = BGRASceneTypes.IBGRALight3D;
     23  IBGRADirectionalLight3D = BGRASceneTypes.IBGRADirectionalLight3D;
     24  IBGRAPointLight3D = BGRASceneTypes.IBGRAPointLight3D;
     25  IBGRAMaterial3D = BGRASceneTypes.IBGRAMaterial3D;
     26  IBGRAFace3D = BGRASceneTypes.IBGRAFace3D;
     27  IBGRAPart3D = BGRASceneTypes.IBGRAPart3D;
     28  IBGRAObject3D = BGRASceneTypes.IBGRAObject3D;
     29
     30  arrayOfIBGRAVertex3D = BGRASceneTypes.arrayOfIBGRAVertex3D;
     31
     32const
     33  lnNone = BGRASceneTypes.lnNone;
     34  lnFace = BGRASceneTypes.lnFace;
     35  lnVertex = BGRASceneTypes.lnVertex;
     36  lnFaceVertexMix = BGRASceneTypes.lnFaceVertexMix;
     37
     38  liLowQuality = BGRASceneTypes.liLowQuality;
     39  liSpecularHighQuality = BGRASceneTypes.liSpecularHighQuality;
     40  liAlwaysHighQuality = BGRASceneTypes.liAlwaysHighQuality;
     41
     42  am3dNone = BGRASceneTypes.am3dNone;
     43  am3dMultishape = BGRASceneTypes.am3dMultishape;
     44  am3dResample = BGRASceneTypes.am3dResample;
     45
     46  pmLinearMapping = BGRASceneTypes.pmLinearMapping;
     47  pmPerspectiveMapping = BGRASceneTypes.pmPerspectiveMapping;
     48  pmZBuffer = BGRASceneTypes.pmZBuffer;
    4949
    5050type
     51
     52  { TCamera3D }
     53
     54  TCamera3D = class
     55  private
     56    procedure ComputeMatrix;
     57    function GetLookWhere: TPoint3D;
     58    function GetMatrix: TMatrix3D;
     59    function GetViewPoint: TPoint3D;
     60    procedure SetMatrix(AValue: TMatrix3D);
     61    procedure SetViewPoint(AValue: TPoint3D);
     62  protected
     63    FMatrix: TMatrix3D;
     64    FMatrixComputed: boolean;
     65    FViewPoint: TPoint3D_128;
     66    FLookWhere, FTopDir: TPoint3D_128;
     67  public
     68    procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D);
     69    procedure LookDown(angleDeg: single);
     70    procedure LookLeft(angleDeg: single);
     71    procedure LookRight(angleDeg: single);
     72    procedure LookUp(angleDeg: single);
     73    property ViewPoint: TPoint3D read GetViewPoint write SetViewPoint;
     74    property LookWhere: TPoint3D read GetLookWhere;
     75    property Matrix: TMatrix3D read GetMatrix write SetMatrix;
     76  end;
     77
    5178  { TBGRAScene3D }
    5279
    5380  TBGRAScene3D = class
    5481  private
    55     FSurface: TBGRACustomBitmap;
    56     FViewCenter: TPointF;
    57     FAutoViewCenter: boolean;
     82    FSurface: TBGRACustomBitmap; //destination of software renderer
     83    FViewCenter: TPointF;        //where origin is drawn
     84    FAutoViewCenter: boolean;    //use middle of the screen
     85    FZoom: TPointF;              //how much the drawing is zoomed
     86    FAutoZoom: Boolean;          //display 1 as 80% of surface size
     87    FProjection: TProjection3D;  //current projection
     88    FRenderedFaceCount: integer; //current counter of rendered faces
     89
     90    FCamera: TCamera3D;
     91
    5892    FObjects: array of IBGRAObject3D;
    5993    FObjectCount: integer;
    6094    FMaterials: array of IBGRAMaterial3D;
    6195    FMaterialCount: integer;
    62     FMatrix: TMatrix3D;
    63     FViewPoint: TPoint3D_128;
    64     FLookWhere, FTopDir: TPoint3D_128;
    65     FZoom: TPointF;
    66     FAutoZoom: Boolean;
    67     FLights: TList;
    68     FAmbiantLightness: integer;
    69     FAmbiantLightColor: TColorInt65536;
    70     FRenderedFaceCount: integer;
    71     FProjection: TProjection3D;
     96    FDefaultMaterial : IBGRAMaterial3D;
     97
     98    FAmbiantLightColorF: TColorF;        //lightness without light sources
     99    FLights: TList;                      //individual light sources
     100
    72101    function GetAmbiantLightColorF: TColorF;
    73102    function GetAmbiantLightness: single;
    … …  
    91120    procedure SetViewPoint(const AValue: TPoint3D);
    92121    procedure ComputeView(ScaleX,ScaleY: single);
    93     function ComputeCoordinate(ASceneCoord: TPoint3D_128; APart: IBGRAPart3D): TPointF; overload;
    94     function ComputeCoordinate(AViewCoord: TPoint3D_128): TPointF; overload;
    95     procedure ComputeLight;
    96     procedure ComputeMatrix;
     122    function ComputeCoordinate(AViewCoord: TPoint3D_128): TPointF;
    97123    procedure AddObject(AObj: IBGRAObject3D);
    98124    procedure AddLight(ALight: TObject);
    99125    procedure AddMaterial(AMaterial: IBGRAMaterial3D);
    100126    procedure Init;
    101     procedure InternalRender(ASurface: TBGRACustomBitmap; AAntialiasingMode: TAntialiasingMode3D; GlobalScale: single); virtual;
    102127
    103128  protected
    104     function ApplyLightingWithLightness(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
    105     function ApplyLightingWithDiffuseColor(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
    106     function ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
    107     function ApplyLightingWithAmbiantLightnessOnly(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
    108     function ApplyNoLighting(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
     129    FRenderer: TCustomRenderer3D;
     130    FMaterialLibrariesFetched: array of string;
     131    FTexturesFetched: array of record
     132        Name: string;
     133        Bitmap: TBGRACustomBitmap;
     134      end;
    109135    procedure UseMaterial(AMaterialName: string; AFace: IBGRAFace3D); virtual;
    110     function FetchTexture({%H-}AName: string; out texSize: TPointF): IBGRAScanner; virtual;
     136    function LoadBitmapFromFileUTF8(AFilenameUTF8: string): TBGRACustomBitmap; virtual;
     137    function FetchTexture(AName: string; out texSize: TPointF): IBGRAScanner; virtual;
     138    procedure HandleFetchException(AException: Exception); virtual;
     139    procedure DoRender; virtual;
     140    procedure DoClear; virtual;
     141    function GetRenderWidth: integer;
     142    function GetRenderHeight: integer;
     143    procedure OnMaterialTextureChanged({%H-}ASender: TObject); virtual;
     144    procedure SetDefaultMaterial(AValue: IBGRAMaterial3D);
     145    procedure InvalidateMaterial;
    111146
    112147  public
    113148    DefaultLightingNormal: TLightingNormal3D;
    114     DefaultMaterial : IBGRAMaterial3D;
    115149    RenderingOptions: TRenderingOptions;
    116150    UnknownColor: TBGRAPixel;
     151    FetchDirectory: string;
     152    FetchThrowsException: boolean;
    117153
    118154    constructor Create;
    … …  
    120156    destructor Destroy; override;
    121157    procedure Clear; virtual;
     158    function FetchObject(AName: string; SwapFacesOrientation: boolean = true): IBGRAObject3D;
     159    procedure FetchMaterials(ALibraryName: string); virtual;
    122160    function LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D;
    123161    function LoadObjectFromFileUTF8(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D;
    … …  
    132170    procedure LookDown(angleDeg: single);
    133171    procedure Render; virtual;
     172    procedure Render(ARenderer: TCustomRenderer3D);
    134173    function CreateObject: IBGRAObject3D; overload;
    135174    function CreateObject(ATexture: IBGRAScanner): IBGRAObject3D; overload;
    … …  
    154193    procedure ForEachVertex(ACallback: TVertex3DCallback);
    155194    procedure ForEachFace(ACallback: TFace3DCallback);
     195    function MakeLightList: TList;
     196
    156197    property ViewCenter: TPointF read GetViewCenter write SetViewCenter;
    157198    property AutoViewCenter: boolean read FAutoViewCenter write SetAutoViewCenter;
    … …  
    173214    property Material[AIndex: integer] : IBGRAMaterial3D read GetMaterial;
    174215    property MaterialCount: integer read FMaterialCount;
     216    property Camera: TCamera3D read FCamera;
     217    property DefaultMaterial: IBGRAMaterial3D read FDefaultMaterial write SetDefaultMaterial;
    175218  end;
    176219
    177220implementation
    178221
    179 uses BGRAPolygon, BGRAPolygonAliased, BGRACoordPool3D, BGRAResample,
    180   lazutf8classes;
     222uses BGRACoordPool3D, BGRAUTF8;
    181223
    182224{$i lightingclasses3d.inc}
    183225{$i vertex3d.inc}
    184226{$i face3d.inc}
    185 
    186 type
    187   { TBGRAObject3D }
    188 
    189   TBGRAObject3D = class(TInterfacedObject,IBGRAObject3D)
    190   private
    191     FColor: TBGRAPixel;
    192     FLight: Single;
    193     FTexture: IBGRAScanner;
    194     FMainPart: IBGRAPart3D;
    195     FFaces: array of IBGRAFace3D;
    196     FFaceCount: integer;
    197     FLightingNormal : TLightingNormal3D;
    198     FParentLighting: boolean;
    199     FMaterial: IBGRAMaterial3D;
    200     FScene: TBGRAScene3D;
    201     procedure AddFace(AFace: IBGRAFace3D);
    202   public
    203     constructor Create(AScene: TBGRAScene3D);
    204     destructor Destroy; override;
    205     procedure Clear;
    206 
    207     function AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
    208     function AddFace(const AVertices: array of IBGRAVertex3D; ABiface: boolean): IBGRAFace3D;
    209     function AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D;
    210     function AddFace(const AVertices: array of IBGRAVertex3D; AColor: TBGRAPixel): IBGRAFace3D;
    211     function AddFace(const AVertices: array of IBGRAVertex3D; AColors: array of TBGRAPixel): IBGRAFace3D;
    212     function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
    213     procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D);
    214     function GetColor: TBGRAPixel;
    215     function GetLight: Single;
    216     function GetTexture: IBGRAScanner;
    217     function GetMainPart: IBGRAPart3D;
    218     function GetLightingNormal: TLightingNormal3D;
    219     function GetParentLighting: boolean;
    220     function GetFace(AIndex: integer): IBGRAFace3D;
    221     function GetFaceCount: integer;
    222     function GetTotalVertexCount: integer;
    223     function GetTotalNormalCount: integer;
    224     function GetMaterial: IBGRAMaterial3D;
    225     procedure SetLightingNormal(const AValue: TLightingNormal3D);
    226     procedure SetParentLighting(const AValue: boolean);
    227     procedure SetColor(const AValue: TBGRAPixel);
    228     procedure SetLight(const AValue: Single);
    229     procedure SetTexture(const AValue: IBGRAScanner);
    230     procedure SetMaterial(const AValue: IBGRAMaterial3D);
    231     procedure RemoveUnusedVertices;
    232     procedure SeparatePart(APart: IBGRAPart3D);
    233     function GetScene: TBGRAScene3D;
    234     function GetRefCount: integer;
    235     procedure SetBiface(AValue : boolean);
    236     procedure ForEachVertex(ACallback: TVertex3DCallback);
    237     procedure ForEachFace(ACallback: TFace3DCallback);
    238   end;
    239 
    240227{$i part3d.inc}
    241228{$i object3d.inc}
    242229{$i shapes3d.inc}
    243230
     231{ TCamera3D }
     232
     233function TCamera3D.GetLookWhere: TPoint3D;
     234begin
     235  result := Point3D(FLookWhere);
     236end;
     237
     238function TCamera3D.GetMatrix: TMatrix3D;
     239begin
     240  if not FMatrixComputed then
     241  begin
     242    ComputeMatrix;
     243    FMatrixComputed := true;
     244  end;
     245  result := FMatrix;
     246end;
     247
     248function TCamera3D.GetViewPoint: TPoint3D;
     249begin
     250  result := Point3D(FViewPoint);
     251end;
     252
     253procedure TCamera3D.SetMatrix(AValue: TMatrix3D);
     254begin
     255  FMatrix := AValue;
     256  FMatrixComputed:= true;
     257  FViewPoint := Point3D_128(FMatrix[1,4],FMatrix[2,4],FMatrix[3,4]);
     258end;
     259
     260procedure TCamera3D.SetViewPoint(AValue: TPoint3D);
     261begin
     262  FViewPoint := Point3D_128(AValue);
     263  FMatrix[1,4] := FViewPoint.x;
     264  FMatrix[2,4] := FViewPoint.y;
     265  FMatrix[3,4] := FViewPoint.z;
     266  FMatrixComputed := false;
     267end;
     268
     269procedure TCamera3D.ComputeMatrix;
     270var ZDir, XDir, YDir: TPoint3D_128;
     271begin
     272  if IsPoint3D_128_Zero(FTopDir) then exit;
     273  YDir := -FTopDir;
     274  Normalize3D_128(YDir);
     275
     276  ZDir := FLookWhere-FViewPoint;
     277  if IsPoint3D_128_Zero(ZDir) then exit;
     278  Normalize3D_128(ZDir);
     279
     280  VectProduct3D_128(YDir,ZDir,XDir);
     281  VectProduct3D_128(ZDir,XDir,YDir); //correct Y dir
     282  Normalize3D_128(XDir);
     283  Normalize3D_128(YDir);
     284
     285  FMatrix := Matrix3D(XDir,YDir,ZDir,FViewPoint);
     286  FMatrix := MatrixInverse3D(FMatrix);
     287end;
     288
     289procedure TCamera3D.LookAt(AWhere: TPoint3D; ATopDir: TPoint3D);
     290begin
     291  FLookWhere := Point3D_128(AWhere);
     292  FTopDir := Point3D_128(ATopDir);
     293  FMatrixComputed := false;
     294end;
     295
     296procedure TCamera3D.LookLeft(angleDeg: single);
     297var m,inv: TMatrix3D;
     298begin
     299  inv := MatrixInverse3D(Matrix);
     300  m := MatrixRotateY(angleDeg*Pi/180);
     301  FLookWhere := inv*m*Matrix*FLookWhere;
     302  FMatrixComputed := false;
     303end;
     304
     305procedure TCamera3D.LookRight(angleDeg: single);
     306begin
     307  LookLeft(-angleDeg);
     308end;
     309
     310procedure TCamera3D.LookUp(angleDeg: single);
     311var m,inv: TMatrix3D;
     312begin
     313  inv := MatrixInverse3D(Matrix);
     314  m := MatrixRotateX(-angleDeg*Pi/180);
     315  FLookWhere := inv*m*Matrix*FLookWhere;
     316  FMatrixComputed := false;
     317end;
     318
     319procedure TCamera3D.LookDown(angleDeg: single);
     320begin
     321  LookUp(-angleDeg);
     322end;
     323
     324
    244325{ TBGRAScene3D }
    245326
    … …  
    248329  if FAutoViewCenter then
    249330  begin
    250     if Surface = nil then
    251       result := PointF(0,0)
    252     else
    253       result := PointF((Surface.Width-1)/2,(Surface.Height-1)/2)
     331    result := PointF((GetRenderWidth-1)/2,(GetRenderHeight-1)/2)
    254332  end
    255333  else
    … …  
    259337function TBGRAScene3D.GetViewPoint: TPoint3D;
    260338begin
    261   result := Point3D(FViewPoint);
     339  result := Camera.ViewPoint;
    262340end;
    263341
    … …  
    267345  if FAutoZoom then
    268346  begin
    269     if FSurface = nil then
     347    Size := sqrt(GetRenderWidth*GetRenderHeight)*0.8;
     348    if Size = 0 then
    270349      result := PointF(1,1)
    271350    else
    272     begin
    273       Size := sqrt(FSurface.Width*FSurface.Height)*0.8;
    274351      result := PointF(size,size);
    275     end;
    276352  end else
    277353    result := FZoom;
    … …  
    280356procedure TBGRAScene3D.SetAmbiantLightColorF(const AValue: TColorF);
    281357begin
    282   FAmbiantLightColor := ColorFToColorInt65536(AValue);
    283   FAmbiantLightness := (FAmbiantLightColor.r + FAmbiantLightColor.g + FAmbiantLightColor.b) div 6;
     358  FAmbiantLightColorF := AValue;
    284359end;
    285360
    286361procedure TBGRAScene3D.SetAmbiantLightness(const AValue: single);
    287362begin
    288   FAmbiantLightness:= round(AValue*32768);
    289   FAmbiantLightColor := ColorInt65536(FAmbiantLightness*2, FAmbiantLightness*2, FAmbiantLightness*2);
     363  FAmbiantLightColorF := ColorF(AValue, AValue, AValue, 1);
    290364end;
    291365
    292366procedure TBGRAScene3D.SetAmbiantLightColor(const AValue: TBGRAPixel);
    293367begin
    294   FAmbiantLightColor := BGRAToColorInt(AValue);
    295   FAmbiantLightness := (FAmbiantLightColor.r + FAmbiantLightColor.g + FAmbiantLightColor.b) div 6;
     368  FAmbiantLightColorF := ColorInt65536ToColorF(BGRAToColorInt(AValue,True));
    296369end;
    297370
    … …  
    313386function TBGRAScene3D.GetAmbiantLightColor: TBGRAPixel;
    314387begin
    315   result := ColorIntToBGRA(FAmbiantLightColor);
     388  result := ColorIntToBGRA(ColorFToColorInt65536(FAmbiantLightColorF),True);
    316389end;
    317390
    … …  
    354427function TBGRAScene3D.GetAmbiantLightness: single;
    355428begin
    356   result := FAmbiantLightness/32768;
     429  result := (FAmbiantLightColorF[1]+FAmbiantLightColorF[2]+FAmbiantLightColorF[3])/3;
    357430end;
    358431
    359432function TBGRAScene3D.GetAmbiantLightColorF: TColorF;
    360433begin
    361   result := ColorInt65536ToColorF(FAmbiantLightColor);
     434  result := FAmbiantLightColorF;
    362435end;
    363436
    … …  
    378451end;
    379452
     453procedure TBGRAScene3D.SetDefaultMaterial(AValue: IBGRAMaterial3D);
     454begin
     455  if FDefaultMaterial=AValue then Exit;
     456  FDefaultMaterial:=AValue;
     457  InvalidateMaterial;
     458end;
     459
    380460procedure TBGRAScene3D.SetViewCenter(const AValue: TPointF);
    381461begin
    … …  
    384464end;
    385465
    386 procedure TBGRAScene3D.ComputeMatrix;
    387 var ZDir, XDir, YDir: TPoint3D_128;
    388 begin
    389   if IsPoint3D_128_Zero(FTopDir) then exit;
    390   YDir := -FTopDir;
    391   Normalize3D_128(YDir);
    392 
    393   ZDir := FLookWhere-FViewPoint;
    394   if IsPoint3D_128_Zero(ZDir) then exit;
    395   Normalize3D_128(ZDir);
    396 
    397   VectProduct3D_128(YDir,ZDir,XDir);
    398   VectProduct3D_128(ZDir,XDir,YDir); //correct Y dir
    399   Normalize3D_128(XDir);
    400   Normalize3D_128(YDir);
    401 
    402   FMatrix := Matrix3D(XDir,YDir,ZDir,FViewPoint);
    403   FMatrix := MatrixInverse3D(FMatrix);
     466procedure TBGRAScene3D.SetViewPoint(const AValue: TPoint3D);
     467begin
     468  Camera.ViewPoint := AValue;
    404469end;
    405470
    … …  
    431496  FAutoZoom := True;
    432497  FAutoViewCenter := True;
    433   ViewPoint := Point3D(0,0,-100);
    434   LookAt(Point3D(0,0,0), Point3D(0,-1,0));
     498
     499  FCamera := TCamera3D.Create;
     500  Camera.ViewPoint := Point3D(0,0,-100);
     501  Camera.LookAt(Point3D(0,0,0), Point3D(0,-1,0));
    435502  with RenderingOptions do
    436503  begin
    … …  
    464531
    465532destructor TBGRAScene3D.Destroy;
    466 begin
    467   Clear;
    468   FLights.Free;
     533var
     534  i: Integer;
     535begin
     536  DoClear;
     537  FreeAndNil(FLights);
     538  FreeAndNil(FCamera);
     539  for i := 0 to high(FTexturesFetched) do
     540    FTexturesFetched[i].Bitmap.Free;
    469541  inherited Destroy;
    470542end;
    471543
    472544procedure TBGRAScene3D.Clear;
    473 var i: integer;
    474 begin
    475   for i := 0 to FLights.Count-1 do
    476     TBGRALight3D(FLights[i])._Release;
    477   FLights.Clear;
    478 
    479   for i := 0 to FObjectCount-1 do
    480     FObjects[i].Clear;
    481   FObjects := nil;
    482   FObjectCount := 0;
    483 
    484   FMaterials := nil;
    485   FMaterialCount := 0;
     545begin
     546  DoClear;
    486547  DefaultMaterial := CreateMaterial;
     548end;
     549
     550function TBGRAScene3D.FetchObject(AName: string; SwapFacesOrientation: boolean
     551  ): IBGRAObject3D;
     552begin
     553  if FetchDirectory = '' then raise exception.Create('Please define first the FetchDirectory');
     554  try
     555    result := LoadObjectFromFileUTF8(ConcatPaths([FetchDirectory,AName]), SwapFacesOrientation);
     556  except
     557    on ex:Exception do
     558      HandleFetchException(ex);
     559  end;
    487560end;
    488561
    … …  
    529602end;
    530603
     604function TBGRAScene3D.LoadBitmapFromFileUTF8(AFilenameUTF8: string): TBGRACustomBitmap;
     605begin
     606  result := BGRABitmapFactory.Create(AfileNameUTF8,True);
     607end;
     608
    531609function TBGRAScene3D.FetchTexture(AName: string; out texSize: TPointF): IBGRAScanner;
    532 begin
    533   result := nil;
    534   texSize := PointF(1,1);
     610var
     611  i: Integer;
     612  bmp: TBGRACustomBitmap;
     613begin
     614  bmp := nil;
     615  for i := 0 to high(FTexturesFetched) do
     616    if FTexturesFetched[i].Name = AName then
     617    begin
     618      bmp := FTexturesFetched[i].Bitmap;
     619      result := bmp;
     620      texSize := PointF(bmp.Width,bmp.Height);
     621      exit;
     622    end;
     623  if FetchDirectory <> '' then
     624  begin
     625    try
     626      bmp := LoadBitmapFromFileUTF8(ConcatPaths([FetchDirectory,AName]));
     627    except
     628      on ex:Exception do
     629        HandleFetchException(ex);
     630    end;
     631  end;
     632  if bmp = nil then
     633  begin
     634    result := nil;
     635    texSize := PointF(1,1);
     636  end else
     637  begin
     638    setlength(FTexturesFetched, length(FTexturesFetched)+1);
     639    FTexturesFetched[high(FTexturesFetched)].Name := AName;
     640    FTexturesFetched[high(FTexturesFetched)].Bitmap := bmp;
     641    result := bmp;
     642    texSize := PointF(bmp.Width,bmp.Height);
     643  end;
     644end;
     645
     646procedure TBGRAScene3D.FetchMaterials(ALibraryName: string);
     647var
     648  i: Integer;
     649begin
     650  if FetchDirectory <> '' then
     651  begin
     652    for i := 0 to high(FMaterialLibrariesFetched) do
     653      if FMaterialLibrariesFetched[i]=ALibraryName then exit;
     654    setlength(FMaterialLibrariesFetched,length(FMaterialLibrariesFetched)+1);
     655    FMaterialLibrariesFetched[high(FMaterialLibrariesFetched)] := ALibraryName;
     656    try
     657      LoadMaterialsFromFile(ConcatPaths([FetchDirectory,ALibraryName]));
     658    except
     659      on ex:Exception do
     660        HandleFetchException(ex);
     661    end;
     662  end;
     663end;
     664
     665procedure TBGRAScene3D.HandleFetchException(AException: Exception);
     666begin
     667  if FetchThrowsException then
     668    raise AException;
     669end;
     670
     671procedure TBGRAScene3D.DoClear;
     672var i: integer;
     673begin
     674  for i := 0 to FLights.Count-1 do
     675    TBGRALight3D(FLights[i]).ReleaseInterface;
     676  FLights.Clear;
     677
     678  for i := 0 to FObjectCount-1 do
     679  begin
     680    FObjects[i].Clear;
     681    FObjects[i] := nil;
     682  end;
     683  FObjects := nil;
     684  FObjectCount := 0;
     685
     686  FMaterials := nil;
     687  FMaterialCount := 0;
     688  DefaultMaterial := nil;
     689end;
     690
     691function TBGRAScene3D.GetRenderWidth: integer;
     692begin
     693  if Assigned(FRenderer) then
     694    result := FRenderer.SurfaceWidth
     695  else
     696  if Assigned(FSurface) then
     697    result := FSurface.Width
     698  else
     699    result := 0;
     700end;
     701
     702function TBGRAScene3D.GetRenderHeight: integer;
     703begin
     704  if Assigned(FRenderer) then
     705    result := FRenderer.SurfaceHeight
     706  else
     707  if Assigned(FSurface) then
     708    result := FSurface.Height
     709  else
     710    result := 0;
     711end;
     712
     713procedure TBGRAScene3D.OnMaterialTextureChanged(ASender: TObject);
     714begin
     715  InvalidateMaterial;
     716end;
     717
     718procedure TBGRAScene3D.InvalidateMaterial;
     719var
     720  i: Integer;
     721begin
     722  for i := 0 to FObjectCount-1 do
     723    FObjects[i].InvalidateMaterial;
    535724end;
    536725
    537726function TBGRAScene3D.LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean): IBGRAObject3D;
    538 var source: TFileStream;
    539 begin
    540   source := TFileStream.Create(AFilename,fmOpenRead,fmShareDenyWrite);
    541   try
    542     result := LoadObjectFromStream(source,SwapFacesOrientation);
    543   finally
    544     source.free;
    545   end;
     727begin
     728  result := LoadObjectFromFileUTF8(SysToUTF8(AFilename), SwapFacesOrientation);
    546729end;
    547730
    … …  
    659842      result.LightingNormal := lnVertex;
    660843    end else
     844    if lineType = 'mtllib' then
     845      FetchMaterials(trim(s))
     846    else
    661847    if lineType = 'usemtl' then
    662848      materialname := trim(s)
    … …  
    8371023procedure TBGRAScene3D.LookAt(AWhere: TPoint3D; ATopDir: TPoint3D);
    8381024begin
    839   FLookWhere := Point3D_128(AWhere);
    840   FTopDir := Point3D_128(ATopDir);
     1025  Camera.LookAt(AWhere,ATopDir);
    8411026end;
    8421027
    8431028procedure TBGRAScene3D.LookLeft(angleDeg: single);
    844 var m,inv: TMatrix3D;
    845 begin
    846   inv := MatrixInverse3D(FMatrix);
    847   m := MatrixRotateY(angleDeg*Pi/180);
    848   FLookWhere := inv*m*FMatrix*FLookWhere;
     1029begin
     1030  Camera.LookLeft(angleDeg);
    8491031end;
    8501032
    8511033procedure TBGRAScene3D.LookRight(angleDeg: single);
    8521034begin
    853   LookLeft(-angleDeg);
     1035  Camera.LookRight(angleDeg);
    8541036end;
    8551037
    8561038procedure TBGRAScene3D.LookUp(angleDeg: single);
    857 var m,inv: TMatrix3D;
    858 begin
    859   inv := MatrixInverse3D(FMatrix);
    860   m := MatrixRotateX(-angleDeg*Pi/180);
    861   FLookWhere := inv*m*FMatrix*FLookWhere;
     1039begin
     1040  Camera.LookUp(angleDeg);
    8621041end;
    8631042
    8641043procedure TBGRAScene3D.LookDown(angleDeg: single);
    8651044begin
    866   LookUp(-angleDeg);
     1045  Camera.LookDown(angleDeg);
    8671046end;
    8681047
    8691048procedure TBGRAScene3D.Render;
    8701049begin
    871   InternalRender(FSurface, RenderingOptions.AntialiasingMode, 1);
     1050  FRenderer := TBGRARenderer3D.Create(FSurface, RenderingOptions,
     1051    FAmbiantLightColorF,
     1052    FLights);
     1053  DoRender;
     1054  FRenderer.Free;
     1055end;
     1056
     1057procedure TBGRAScene3D.Render(ARenderer: TCustomRenderer3D);
     1058begin
     1059  FRenderer := ARenderer;
     1060  DoRender;
     1061  FRenderer := nil;
    8721062end;
    8731063
    … …  
    8761066  i: Integer;
    8771067begin
    878   ComputeMatrix;
    879 
    8801068  FProjection.Zoom := Zoom;
    8811069  FProjection.Zoom.X *= ScaleX;
    … …  
    8851073  FProjection.Center.Y *= ScaleY;
    8861074  for i := 0 to FObjectCount-1 do
    887     FObjects[i].ComputeWithMatrix(FMatrix, FProjection);
    888 end;
    889 
    890 function TBGRAScene3D.ComputeCoordinate(ASceneCoord: TPoint3D_128; APart: IBGRAPart3D): TPointF;
    891 begin
    892   result := APart.ComputeCoordinate(ASceneCoord, FProjection);
     1075    FObjects[i].ComputeWithMatrix(Camera.Matrix, FProjection);
    8931076end;
    8941077
    … …  
    9031086  end else
    9041087    result := PointF(0,0);
    905 end;
    906 
    907 procedure TBGRAScene3D.ComputeLight;
    908 begin
    909 
    9101088end;
    9111089
    … …  
    9981176end;
    9991177
    1000 procedure TBGRAScene3D.InternalRender(ASurface: TBGRACustomBitmap; AAntialiasingMode: TAntialiasingMode3D; GlobalScale: single);
     1178procedure TBGRAScene3D.DoRender;
    10011179var
    10021180  LFaces: array of TBGRAFace3D;
    … …  
    10141192      obj := FObjects[i];
    10151193      inc(LFaceCount, obj.GetFaceCount);
    1016       if obj.GetParentLighting then
    1017       begin
    1018         obj.SetLightingNormal(Self.DefaultLightingNormal);
    1019         obj.SetParentLighting(True);
    1020       end;
     1194      obj.Update;
    10211195    end;
    10221196    setlength(LFaces, LFaceCount);
    … …  
    10341208
    10351209var
    1036   multi: TBGRAMultishapeFiller;
    1037   ColorGradientTempBmp: TBGRACustomBitmap;
    1038   zbuffer: psingle;
    1039 
     1210  faceDesc: TFaceRenderingDescription;
    10401211  LVertices: array of TBGRAVertex3D;
    1041   LColors: array of TBGRAPixel;
    1042   LTexCoord: array of TPointF;
    1043   LZ: array of single;
    1044   LProj: array of TPointF;
    1045   LPos3D, LNormal3D: array of TPoint3D_128;
    1046   LLighting: array of word;
    1047   shaderContext: TMemoryBlockAlign128;
    1048   lightingProc: TShaderFunction3D;
    1049   UseAmbiantColor: boolean;
    10501212
    10511213  procedure DrawFace(numFace: integer);
    1052 
    1053     procedure DrawAliasedColoredFace(shader: TShaderFunction3D; VCount: integer; context: PBasicLightingContext);
    1054     var j,k: integer;
    1055         SameColor: boolean;
    1056         center: record
    1057           proj: TPointF;
    1058           pos3D,normal3D: TPoint3D_128;
    1059           color: TBGRAPixel;
    1060         end;
    1061 
    1062     begin
    1063       SameColor := True;
    1064       for j := 1 to VCount-1 do
    1065         if (LColors[j]<>LColors[j-1]) then SameColor := False;
    1066 
    1067       if shader <> nil then
    1068       begin
    1069         if SameColor then
    1070         begin
    1071           BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
    1072             slice(LProj,VCount),slice(LPos3D,VCount),slice(LNormal3D,VCount),nil,
    1073               slice(LTexCoord,VCount),False,shader,True,LColors[0],zbuffer,context);
    1074         end else
    1075         if VCount = 3 then
    1076         begin
    1077           ColorGradientTempBmp.SetPixel(0,0,LColors[0]);
    1078           ColorGradientTempBmp.SetPixel(1,0,LColors[1]);
    1079           ColorGradientTempBmp.SetPixel(0,1,LColors[2]);
    1080           ColorGradientTempBmp.SetPixel(1,1,MergeBGRA(LColors[1],LColors[2]));
    1081           BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
    1082             slice(LProj,VCount),slice(LPos3D,VCount),slice(LNormal3D,VCount),ColorGradientTempBmp,
    1083               [PointF(0,0),PointF(1,0),PointF(0,1)],True,shader,True, BGRAPixelTransparent,zbuffer,context);
    1084         end else
    1085         if VCount = 4 then
    1086         begin
    1087           ColorGradientTempBmp.SetPixel(0,0,LColors[0]);
    1088           ColorGradientTempBmp.SetPixel(1,0,LColors[1]);
    1089           ColorGradientTempBmp.SetPixel(1,1,LColors[2]);
    1090           ColorGradientTempBmp.SetPixel(0,1,LColors[3]);
    1091           BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
    1092             slice(LProj,VCount),slice(LPos3D,VCount),slice(LNormal3D,VCount),ColorGradientTempBmp,
    1093               [PointF(0,0),PointF(1,0),PointF(1,1),PointF(0,1)],True,shader,True, BGRAPixelTransparent,zbuffer,context);
    1094         end else
    1095         if VCount >= 3 then
    1096         begin //split into triangles
    1097           with center do
    1098           begin
    1099             ClearPoint3D_128(pos3D);
    1100             ClearPoint3D_128(normal3D);
    1101             color := MergeBGRA(slice(LColors,VCount));
    1102           end;
    1103           for j := 0 to VCount-1 do
    1104           begin
    1105             center.pos3D += LPos3D[j];
    1106             center.normal3D += LNormal3D[j];
    1107           end;
    1108           with center do
    1109           begin
    1110             pos3D *= (1/VCount);
    1111             Normalize3D_128(normal3D);
    1112           end;
    1113           center.proj := ComputeCoordinate(center.pos3D);
    1114           k := VCount-1;
    1115           for j := 0 to VCount-1 do
    1116           begin
    1117             ColorGradientTempBmp.SetPixel(0,0,LColors[k]);
    1118             ColorGradientTempBmp.SetPixel(1,0,LColors[j]);
    1119             ColorGradientTempBmp.SetPixel(0,1,center.color);
    1120             ColorGradientTempBmp.SetPixel(1,1,MergeBGRA(LColors[j],center.color));
    1121             BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
    1122               [LProj[k],LProj[j],center.proj], [LPos3D[k],LPos3D[j],center.pos3D],
    1123               [LNormal3D[k],LNormal3D[j],center.normal3D], ColorGradientTempBmp,
    1124                 [PointF(0,0),PointF(1,0),PointF(0,1)],True,shader,True, BGRAPixelTransparent,zbuffer,context);
    1125             k := j;
    1126           end;
    1127         end;
    1128       end else
    1129       begin
    1130         if SameColor then
    1131         begin
    1132           if RenderingOptions.PerspectiveMode = pmZBuffer then
    1133             BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(ASurface, slice(LProj,VCount),
    1134             slice(LZ,VCount), slice(LColors,VCount),True,zbuffer)
    1135           else
    1136             ASurface.FillPoly(slice(LProj,VCount),LColors[0],dmDrawWithTransparency);
    1137         end
    1138         else
    1139         begin
    1140           if VCount > 4 then
    1141           begin //split into triangles
    1142             with center do
    1143             begin
    1144               ClearPoint3D_128(pos3D);
    1145               color := MergeBGRA(slice(LColors,VCount));
    1146             end;
    1147             for j := 0 to VCount-1 do
    1148               center.pos3D += LPos3D[j];
    1149             with center do
    1150               pos3D *= (1/VCount);
    1151             center.proj := ComputeCoordinate(center.pos3D);
    1152             k := VCount-1;
    1153             if RenderingOptions.PerspectiveMode = pmLinearMapping then
    1154             begin
    1155               for j := 0 to VCount-1 do
    1156               begin
    1157                 ASurface.FillPolyLinearColor([LProj[k],LProj[j],center.proj],[LColors[k],LColors[j],center.color]);
    1158                 k := j;
    1159               end;
    1160             end else
    1161             begin
    1162               for j := 0 to VCount-1 do
    1163               begin
    1164                 BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(ASurface, [LProj[k],LProj[j],center.proj],
    1165                  [LZ[k],LZ[j],center.pos3D.z], [LColors[k],LColors[j],center.color],True,zbuffer);
    1166                 k := j;
    1167               end;
    1168             end;
    1169           end else
    1170           begin
    1171             if RenderingOptions.PerspectiveMode = pmLinearMapping then
    1172               ASurface.FillPolyLinearColor(slice(LProj,VCount),slice(LColors,VCount))
    1173             else
    1174               BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(ASurface, slice(LProj,VCount),
    1175                slice(LZ,VCount), slice(LColors,VCount),True,zbuffer);
    1176           end;
    1177         end;
    1178       end;
    1179     end;
    1180 
    11811214  var
    11821215    j,k: Integer;
    1183     LTexture: IBGRAScanner;
    1184     LMaterial: TBGRAMaterial3D;
    1185     SameColor: boolean;
    1186     LLightNormal : TLightingNormal3D;
    1187     LNoLighting: boolean;
    1188     PtCenter: TPointF;
    1189     PtCenter3D: TPoint3D_128;
    1190     ColorCenter: TBGRAPixel;
    11911216    VCount,NewVCount: integer;
    1192     ctx: PSceneLightingContext;
    1193     NegNormals, UseDiffuseColor,
    1194     UseDiffuseLightness{, OnlyDirectionalLight}: boolean;
     1217    NegNormals: boolean;
    11951218    LastVisibleVertex: integer;
    11961219
    … …  
    12041227       LVertices[NewVCount] := nil; //computed
    12051228
    1206        LColors[NewVCount] := MergeBGRA(LColors[n1],round((1-t)*65536),LColors[n2],round(t*65536));
    1207        LTexCoord[NewVCount] := LTexCoord[n1]*(1-t) + LTexCoord[n2]*t;
    1208        LPos3D[NewVCount] := LPos3D[n1]*(1-t) + LPos3D[n2]*t;
    1209        LNormal3D[NewVCount] := LNormal3D[n1]*(1-t) + LNormal3D[n2]*t;
    1210        LZ[NewVCount] := LZ[n1]*(1-t) + LZ[n2]*t;
    1211        LProj[NewVCount] := ComputeCoordinate(LPos3D[NewVCount]);
     1229       faceDesc.Colors[NewVCount] := MergeBGRA(faceDesc.Colors[n1],round((1-t)*65536),faceDesc.Colors[n2],round(t*65536));
     1230       faceDesc.TexCoords[NewVCount] := faceDesc.TexCoords[n1]*(1-t) + faceDesc.TexCoords[n2]*t;
     1231       faceDesc.Positions3D[NewVCount] := faceDesc.Positions3D[n1]*(1-t) + faceDesc.Positions3D[n2]*t;
     1232       faceDesc.Normals3D[NewVCount] := faceDesc.Normals3D[n1]*(1-t) + faceDesc.Normals3D[n2]*t;
     1233       faceDesc.Projections[NewVCount] := ComputeCoordinate(faceDesc.Positions3D[NewVCount]);
    12121234       NewVCount += 1;
    12131235    end;
    12141236
    12151237    procedure LoadVertex(idxL: integer; idxV: integer);
    1216     var desc: PBGRAFaceVertexDescription;
     1238    var vertexDesc: PBGRAFaceVertexDescription;
    12171239        tempV: TBGRAVertex3D;
    12181240    begin
    12191241      with LFaces[numFace] do
    12201242      begin
    1221         desc := VertexDescription[idxV];
    1222         with desc^ do
     1243        vertexDesc := VertexDescription[idxV];
     1244        with vertexDesc^ do
    12231245        begin
    12241246          tempV := TBGRAVertex3D(vertex.GetAsObject);
    12251247          LVertices[idxL] := tempV;
    12261248
    1227           if LTexture <> nil then
    1228             LColors[idxL] := BGRA(128,128,128)
    1229           else
    1230           begin
    1231             if ColorOverride then
    1232               LColors[idxL] := Color
    1233             else
    1234             begin
    1235               if tempV.ParentColor then
    1236                 LColors[idxL] := Object3D.Color
    1237               else
    1238                 LColors[idxL] := tempV.Color;
    1239             end;
    1240           end;
    1241 
    1242           if TexCoordOverride then
    1243             LTexCoord[idxL] := TexCoord
    1244           else
    1245             LTexCoord[idxL] := tempV.TexCoord;
    1246           with LMaterial.GetTextureZoom do
    1247           begin
    1248             LTexCoord[idxL].x *= x;
    1249             LTexCoord[idxL].y *= y;
    1250           end;
     1249          faceDesc.Colors[idxL] := ActualColor;
     1250          faceDesc.TexCoords[idxL] := ActualTexCoord;
    12511251
    12521252          with tempV.CoordData^ do
    12531253          begin
    1254             LPos3D[idxL] := viewCoord;
    1255             LNormal3D[idxL] := viewNormal;
    1256             LProj[idxL] := projectedCoord;
    1257             LZ[idxL] := viewCoord.Z;
     1254            faceDesc.Positions3D[idxL] := viewCoord;
     1255            facedesc.Normals3D[idxL] := viewNormal;
     1256            faceDesc.Projections[idxL] := projectedCoord;
    12581257          end;
    12591258          if Normal <> nil then
    1260             LNormal3D[idxL] := Normal.ViewNormal_128;
     1259            facedesc.Normals3D[idxL] := Normal.ViewNormal_128;
     1260          Normalize3D_128(facedesc.Normals3D[idxL]);
    12611261        end;
    12621262      end;
    … …  
    12691269       if VCount < 3 then exit;
    12701270
    1271        if Material <> nil then
    1272          LMaterial := TBGRAMaterial3D(Material.GetAsObject)
    1273        else if Object3D.Material <> nil then
    1274          LMaterial := TBGRAMaterial3D(Object3D.Material.GetAsObject)
    1275        else if self.DefaultMaterial <> nil then
    1276          LMaterial := TBGRAMaterial3D(self.DefaultMaterial.GetAsObject)
    1277        else
    1278          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;
    1289 
    1290        LLightNormal := Object3D.LightingNormal;
     1271       faceDesc.NormalsMode := Object3D.LightingNormal;
     1272
     1273       faceDesc.Material := ActualMaterial;
     1274       if faceDesc.Material = nil then exit;
     1275       faceDesc.Texture := ActualTexture;
    12911276
    12921277       if length(LVertices) < VCount+3 then  //keep margin for z-clip
    12931278       begin
    12941279         setlength(LVertices, (VCount+3)*2);
    1295          setlength(LColors, length(LVertices));
    1296          setlength(LTexCoord, length(LVertices));
    1297          setlength(LZ, length(LVertices));
    1298          setlength(LProj, length(LVertices));
    1299          setlength(LPos3D, length(LVertices));
    1300          setlength(LNormal3D, length(LVertices));
    1301          setlength(LLighting, length(LVertices));
     1280         setlength(faceDesc.Colors, length(LVertices));
     1281         setlength(faceDesc.TexCoords, length(LVertices));
     1282         setlength(faceDesc.Projections, length(LVertices));
     1283         setlength(faceDesc.Positions3D, length(LVertices));
     1284         setlength(faceDesc.Normals3D, length(LVertices));
    13021285       end;
    13031286
    1304        NewVCount := 0;
    1305        LastVisibleVertex := -1;
    1306        for k := VCount-1 downto 0 do
    1307          if Vertex[k].ViewCoordZ >= RenderingOptions.MinZ then
    1308          begin
    1309            LastVisibleVertex := k;
    1310            break;
    1311          end;
    1312        if LastVisibleVertex = -1 then exit;
    1313 
    1314        k := VCount-1;
    1315        for j := 0 to VCount-1 do
     1287       if FRenderer.HandlesNearClipping then
    13161288       begin
    1317          if Vertex[j].ViewCoordZ >= RenderingOptions.MinZ then
    1318          begin
    1319            if k <> LastVisibleVertex then   //one or more vertices is out
    1320            begin
    1321              LoadVertex(NewVCount+1, LastVisibleVertex);
    1322              LoadVertex(NewVCount+2, (LastVisibleVertex+1) mod VertexCount);
    1323              AddZIntermediate(NewVCount+1,NewVCount+2);
    1324 
    1325              LoadVertex(NewVCount+1, j);
    1326              LoadVertex(NewVCount+2, k);
    1327 
    1328              AddZIntermediate(NewVCount+1,NewVCount+2);
    1329              inc(NewVCount);
    1330            end else
    1331            begin
    1332              LoadVertex(NewVCount, j);
    1333              NewVCount += 1;
    1334            end;
    1335            LastVisibleVertex := j;
    1336          end;
    1337          k := j;
    1338        end;
    1339        VCount := NewVCount;
    1340        if VCount < 3 then exit; //after z-clipping
    1341 
    1342        if not IsPolyVisible(slice(LProj,VCount)) then
    1343        begin
    1344          if not Biface then exit;
    1345          NegNormals := True;
     1289         for j := 0 to VCount-1 do
     1290           LoadVertex(j,j);
    13461291       end else
    13471292       begin
    1348          NegNormals := False;
     1293         NewVCount := 0;
     1294         LastVisibleVertex := -1;
     1295         for k := VCount-1 downto 0 do
     1296           if Vertex[k].ViewCoordZ >= RenderingOptions.MinZ then
     1297           begin
     1298             LastVisibleVertex := k;
     1299             break;
     1300           end;
     1301         if LastVisibleVertex = -1 then exit;
     1302
     1303         k := VCount-1;
     1304         for j := 0 to VCount-1 do
     1305         begin
     1306           if Vertex[j].ViewCoordZ >= RenderingOptions.MinZ then
     1307           begin
     1308             if k <> LastVisibleVertex then   //one or more vertices is out
     1309             begin
     1310               LoadVertex(NewVCount+1, LastVisibleVertex);
     1311               LoadVertex(NewVCount+2, (LastVisibleVertex+1) mod VertexCount);
     1312               AddZIntermediate(NewVCount+1,NewVCount+2);
     1313
     1314               LoadVertex(NewVCount+1, j);
     1315               LoadVertex(NewVCount+2, k);
     1316
     1317               AddZIntermediate(NewVCount+1,NewVCount+2);
     1318               inc(NewVCount);
     1319             end else
     1320             begin
     1321               LoadVertex(NewVCount, j);
     1322               NewVCount += 1;
     1323             end;
     1324             LastVisibleVertex := j;
     1325           end;
     1326           k := j;
     1327         end;
     1328         VCount := NewVCount;
     1329         if VCount < 3 then exit; //after z-clipping
    13491330       end;
    13501331
    1351        //from here we assume the face will be drawn
    1352        inc(FRenderedFaceCount);
     1332       if not FRenderer.HandlesFaceCulling then
     1333       begin
     1334         if not IsPolyVisible(slice(faceDesc.Projections,VCount)) then
     1335         begin
     1336           if not Biface then exit;
     1337           NegNormals := True;
     1338         end else
     1339         begin
     1340           NegNormals := False;
     1341         end;
     1342       end else
     1343         NegNormals := false;
    13531344
    13541345       //compute normals
    1355        case LLightNormal of
     1346       case faceDesc.NormalsMode of
    13561347         lnFace: for j := 0 to VCount-1 do
    1357                    LNormal3D[j] := ViewNormal_128;
     1348                   faceDesc.Normals3D[j] := ViewNormal_128;
    13581349         lnFaceVertexMix:
    13591350             for j := 0 to VCount-1 do
    13601351             begin
    1361                LNormal3D[j] += ViewNormal_128;
    1362                Normalize3D_128(LNormal3D[j]);
     1352               faceDesc.Normals3D[j] += ViewNormal_128;
     1353               Normalize3D_128(faceDesc.Normals3D[j]);
    13631354             end;
    13641355       end;
    13651356       if NegNormals then
    13661357         for j := 0 to VCount-1 do
    1367            LNormal3D[j] := -LNormal3D[j];
    1368 
    1369        //prepare lighting
    1370        {OnlyDirectionalLight := true;
    1371        for j := 0 to LightCount-1 do
    1372          if not Light[j].IsDirectional then OnlyDirectionalLight := false; }
    1373 
    1374        if LMaterial.GetSpecularOn then
    1375         lightingProc:= TShaderFunction3D(@ApplyLightingWithDiffuseAndSpecularColor) else
    1376        begin
    1377          UseDiffuseColor := UseAmbiantColor;
    1378          if not UseDiffuseColor then
    1379          begin
    1380            with LMaterial.GetDiffuseColorInt do
    1381             UseDiffuseColor := (r <> g) or (g <> b);
    1382            if not UseDiffuseColor and LMaterial.GetAutoDiffuseColor then
    1383            begin
    1384              for j := 0 to LightCount-1 do
    1385                if Light[j].ColoredLight then
    1386                begin
    1387                  UseDiffuseColor := true;
    1388                  break;
    1389                end;
    1390            end;
    1391          end;
    1392          if UseDiffuseColor then
    1393            lightingProc := TShaderFunction3D(@ApplyLightingWithDiffuseColor) else
    1394          begin
    1395            UseDiffuseLightness := FAmbiantLightness <> 32768;
    1396            if not UseDiffuseLightness then
    1397            begin
    1398              if LightCount <> 0 then
    1399                UseDiffuseLightness := true;
    1400            end;
    1401 
    1402            if UseDiffuseLightness then
    1403              lightingProc := TShaderFunction3D(@ApplyLightingWithLightness) else
    1404            if FAmbiantLightness <> 32768 then
    1405             lightingProc := TShaderFunction3D(@ApplyLightingWithAmbiantLightnessOnly) else
    1406               lightingProc := TShaderFunction3D(@ApplyNoLighting);
    1407          end;
    1408        end;
    1409 
    1410        ctx := PSceneLightingContext( shaderContext.Data );
    1411        ctx^.material := LMaterial;
     1358           faceDesc.Normals3D[j] := -faceDesc.Normals3D[j];
     1359
    14121360       if LightThroughFactorOverride then
    1413          ctx^.LightThroughFactor := LightThroughFactor
     1361         faceDesc.LightThroughFactor := LightThroughFactor
    14141362       else
    1415          ctx^.LightThroughFactor := LMaterial.GetLightThroughFactor;
    1416        ctx^.LightThrough := ctx^.LightThroughFactor > 0;
    1417        ctx^.SaturationHighF := LMaterial.GetSaturationHigh;
    1418        ctx^.SaturationLowF := LMaterial.GetSaturationLow;
    1419        ctx^.SaturationHigh := round(LMaterial.GetSaturationHigh*32768);
    1420        ctx^.SaturationLow := round(LMaterial.GetSaturationLow*32768);
    1421 
    1422        //high-quality lighting interpolation, necessary for Phong and high-quality Gouraud
    1423        if (
    1424            (RenderingOptions.LightingInterpolation = liAlwaysHighQuality) or
    1425            ((RenderingOptions.LightingInterpolation = liSpecularHighQuality) and LMaterial.GetSpecularOn)
    1426        ) and (LLightNormal <> lnNone) {and (not (LLightNormal = lnFace) and OnlyDirectionalLight) }then
    1427        begin
    1428          if LTexture = nil then
    1429            DrawAliasedColoredFace(lightingProc,VCount,PBasicLightingContext(ctx)) //use shader
    1430          else
    1431            BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
    1432                slice(LProj,VCount),slice(LPos3D,VCount),slice(LNormal3D,VCount),LTexture,
    1433                  slice(LTexCoord,VCount),RenderingOptions.TextureInterpolation,lightingProc,True, BGRAPixelTransparent,zbuffer,PBasicLightingContext(ctx));
    1434 
    1435          exit;
    1436        end;
    1437 
    1438        //Vertex lighting interpolation (low-quality Gouraud, low-quality Phong)
    1439        LNoLighting := True;
    1440        for j := 0 to VCount-1 do
    1441        begin
    1442          with ctx^ do
    1443          begin
    1444            basic.Position := LPos3D[j];
    1445            basic.Normal := LNormal3D[j];
    1446          end;
    1447          LColors[j] := lightingProc(PBasicLightingContext(ctx),LColors[j]);
    1448          if LColors[j] <> BGRA(128,128,128) then
    1449            LNoLighting := false;
    1450        end;
    1451 
    1452        if (AAntialiasingMode = am3dMultishape) and not (RenderingOptions.PerspectiveMode = pmZBuffer) then //high-quality antialiasing
    1453        begin
    1454          if LTexture <> nil then
    1455          begin
    1456            if (RenderingOptions.PerspectiveMode <> pmLinearMapping) and (VCount=4) then
    1457              multi.AddQuadPerspectiveMapping(LProj[0],LProj[1],LProj[2],LProj[3],LTexture,LTexCoord[0],LTexCoord[1],LTexCoord[2],LTexCoord[3])
    1458            else
    1459            if VCount>=3 then
    1460            begin
    1461              for j := 0 to VCount-3 do
    1462                multi.AddTriangleLinearMapping(LProj[j],LProj[j+1],LProj[j+2],LTexture,LTexCoord[j],LTexCoord[j+1],LTexCoord[j+2]);
    1463            end;
    1464          end
    1465          else
    1466          begin
    1467            SameColor := True;
    1468            for j := 1 to VCount-1 do
    1469              if (LColors[j]<>LColors[j-1]) then SameColor := False;
    1470 
    1471            if SameColor then
    1472              multi.AddPolygon(slice(LProj,VCount),LColors[0])
    1473            else
    1474            if VCount=3 then
    1475              multi.AddTriangleLinearColor(LProj[0],LProj[1],LProj[2],LColors[0],LColors[1],LColors[2])
    1476            else
    1477            if VCount>=3 then
    1478            begin  //split into triangles
    1479              PtCenter3D := Point3D_128_Zero;
    1480              for j := 0 to VCount-1 do
    1481                PtCenter3D += LPos3D[j];
    1482              PtCenter3D *= (1/VCount);
    1483              PtCenter := ComputeCoordinate(PtCenter3D);
    1484              ColorCenter := MergeBGRA(slice(LColors,VCount));
    1485              k := VCount-1;
    1486              for j := 0 to VCount-1 do
    1487              begin
    1488                multi.AddTriangleLinearColor(LProj[k],LProj[j],PtCenter,LColors[k],LColors[j],ColorCenter);
    1489                k := j;
    1490              end;
    1491            end;
    1492          end;
    1493        end else
    1494        begin
    1495          if LTexture <> nil then
    1496          begin
    1497            if LNoLighting then
    1498            begin
    1499              if RenderingOptions.PerspectiveMode <> pmLinearMapping then
    1500                ASurface.FillPolyPerspectiveMapping(slice(LProj,VCount),slice(LZ,VCount),LTexture,slice(LTexCoord,VCount),RenderingOptions.TextureInterpolation, zbuffer)
    1501              else
    1502                ASurface.FillPolyLinearMapping(slice(LProj,VCount),LTexture,slice(LTexCoord,VCount),RenderingOptions.TextureInterpolation);
    1503            end else
    1504            begin
    1505              for j := 0 to VCount-1 do
    1506                LLighting[j] := LColors[j].green shl 8;
    1507              if RenderingOptions.PerspectiveMode <> pmLinearMapping then
    1508                ASurface.FillPolyPerspectiveMappingLightness(slice(LProj,VCount),slice(LZ,VCount),LTexture,slice(LTexCoord,VCount),slice(LLighting,VCount),RenderingOptions.TextureInterpolation, zbuffer)
    1509              else
    1510                ASurface.FillPolyLinearMappingLightness(slice(LProj,VCount),LTexture,slice(LTexCoord,VCount),slice(LLighting,VCount),RenderingOptions.TextureInterpolation);
    1511            end;
    1512          end
    1513          else
    1514            DrawAliasedColoredFace(nil,VCount,PBasicLightingContext(ctx));  //already low-quality shaded
    1515        end;
     1363         faceDesc.LightThroughFactor := faceDesc.Material.GetLightThroughFactor;
     1364
     1365       faceDesc.NbVertices:= VCount;
     1366       faceDesc.Biface := Biface;
     1367
     1368       if FRenderer.RenderFace(faceDesc, @ComputeCoordinate) then
     1369         inc(FRenderedFaceCount);
    15161370     end;
    15171371  end;
    15181372
    1519   procedure DrawWithResample;
    1520   var
    1521     tempSurface: TBGRACustomBitmap;
    1522   begin
    1523     tempSurface := ASurface.NewBitmap(ASurface.Width*RenderingOptions.AntialiasingResampleLevel,ASurface.Height*RenderingOptions.AntialiasingResampleLevel);
    1524     InternalRender(tempSurface, am3dNone, RenderingOptions.AntialiasingResampleLevel);
    1525     BGRAResample.DownSamplePutImage(tempSurface,RenderingOptions.AntialiasingResampleLevel,RenderingOptions.AntialiasingResampleLevel,
    1526                  ASurface, 0,0, dmDrawWithTransparency);
    1527     tempSurface.Free;
    1528   end;
    1529 
    15301373var i,j: integer;
    15311374
    … …  
    15331376  FRenderedFaceCount:= 0;
    15341377
    1535   if ASurface = nil then
    1536     raise exception.Create('No surface specified');
    1537 
    1538   if (AAntialiasingMode = am3dResample) and (RenderingOptions.AntialiasingResampleLevel > 1) then
    1539   begin
    1540     DrawWithResample;
    1541     exit;
    1542   end;
    1543 
    15441378  PrepareFaces;
    1545   ComputeView(GlobalScale,GlobalScale);
    1546   ComputeLight;
    1547   UseAmbiantColor := (FAmbiantLightColor.r <> FAmbiantLightColor.g) or (FAmbiantLightColor.g <> FAmbiantLightColor.b);
     1379  ComputeView(FRenderer.GlobalScale,FRenderer.GlobalScale);
     1380  FRenderer.Projection := FProjection;
    15481381
    15491382  SortFaces(LFaces);
    15501383  LVertices := nil;
    15511384
    1552   if AAntialiasingMode = am3dMultishape then
    1553   begin
    1554     multi := TBGRAMultishapeFiller.Create;
    1555     multi.PolygonOrder := poLastOnTop;
    1556   end
    1557   else
    1558     multi := nil;
    1559 
    1560   ColorGradientTempBmp := ASurface.NewBitmap(2,2);
    1561   ColorGradientTempBmp.ScanInterpolationFilter := rfLinear;
    1562 
    1563   if RenderingOptions.PerspectiveMode = pmZBuffer then
    1564   begin
    1565     getmem(zbuffer, ASurface.NbPixels*sizeof(single));
    1566     FillDWord(zbuffer^, ASurface.NbPixels, dword(single(0)));
    1567   end
    1568   else
    1569     zbuffer := nil;
    1570 
    1571   shaderContext := TMemoryBlockAlign128.Create(sizeof(TSceneLightingContext));
    1572 
    1573   if zbuffer <> nil then
     1385  //if there is a Z-Buffer, it is possible to avoid drawing things that
     1386  //are hidden by opaque faces by drawing first all opaque faces
     1387  if FRenderer.HasZBuffer then
    15741388  begin
    15751389    setlength(LFaceOpaque, length(LFaces));
    … …  
    16021416      DrawFace(i);
    16031417  end;
    1604 
    1605   shaderContext.Free;
    1606   if zbuffer <> nil then freemem(zbuffer);
    1607   ColorGradientTempBmp.Free;
    1608 
    1609   if multi <> nil then
    1610   begin
    1611     multi.Draw(ASurface);
    1612     multi.Free;
    1613   end;
    1614 end;
    1615 
    1616 procedure TBGRAScene3D.SetViewPoint(const AValue: TPoint3D);
    1617 begin
    1618   FViewPoint := Point3D_128(AValue);
    1619 end;
    1620 
    1621 function TBGRAScene3D.ApplyLightingWithLightness(Context: PSceneLightingContext;
    1622   Color: TBGRAPixel): TBGRAPixel;
    1623 var i: Integer;
    1624   m: TBGRAMaterial3D;
    1625 begin
    1626   m := TBGRAMaterial3D(Context^.material);
    1627   if not m.GetAutoSimpleColor then Color := ColorIntToBGRA(BGRAToColorIntMultiply(Color, m.GetSimpleColorInt));
    1628 
    1629   Context^.lightness := FAmbiantLightness;
    1630 
    1631   i := FLights.Count-1;
    1632   while i >= 0 do
    1633   begin
    1634     TBGRALight3D(FLights[i]).ComputeDiffuseLightness(Context);
    1635     dec(i);
    1636   end;
    1637 
    1638   with Context^ do
    1639     if Lightness <= 0 then
    1640       result := BGRA(0,0,0,color.alpha)
    1641     else
    1642     begin
    1643       if Lightness <= SaturationLow then
    1644         result := ApplyIntensityFast(Color, Lightness)
    1645       else if Lightness >= SaturationHigh then
    1646         result := BGRA(255,255,255,color.alpha)
    1647       else
    1648         result := ApplyLightnessFast( ApplyIntensityFast(Color, SaturationLow),
    1649                               (Lightness - SaturationLow)*32767 div (SaturationHigh-SaturationLow)+32768 );
    1650     end;
    1651 end;
    1652 
    1653 function TBGRAScene3D.ApplyLightingWithDiffuseColor(Context: PSceneLightingContext;
    1654   Color: TBGRAPixel): TBGRAPixel;
    1655 var i: Integer;
    1656   m: TBGRAMaterial3D;
    1657 begin
    1658   m := TBGRAMaterial3D(Context^.material);
    1659 
    1660   if m.GetAutoAmbiantColor then
    1661     Context^.diffuseColor := FAmbiantLightColor
    1662   else
    1663     Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt;
    1664 
    1665   i := FLights.Count-1;
    1666   while i >= 0 do
    1667   begin
    1668     TBGRALight3D(FLights[i]).ComputeDiffuseColor(Context);
    1669     dec(i);
    1670   end;
    1671 
    1672   result := ColorIntToBGRA(BGRAToColorIntMultiply(Color,Context^.diffuseColor));
    1673   result.alpha := Color.alpha;
    1674 end;
    1675 
    1676 function TBGRAScene3D.ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext;
    1677   Color: TBGRAPixel): TBGRAPixel;
    1678 var i: Integer;
    1679   m: TBGRAMaterial3D;
    1680 begin
    1681   m := TBGRAMaterial3D(Context^.material);
    1682 
    1683   if m.GetAutoAmbiantColor then
    1684     Context^.diffuseColor := FAmbiantLightColor
    1685   else
    1686     Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt;
    1687   Context^.specularColor := ColorInt65536(0,0,0,0);
    1688 
    1689   i := FLights.Count-1;
    1690   while i >= 0 do
    1691   begin
    1692     TBGRALight3D(FLights[i]).ComputeDiffuseAndSpecularColor(Context);
    1693     dec(i);
    1694   end;
    1695 
    1696   with Context^ do
    1697   begin
    1698     diffuseColor.a := 65536;
    1699     result := ColorIntToBGRA(BGRAToColorIntMultiply(Color,diffuseColor) + specularColor);
    1700   end;
    1701 end;
    1702 
    1703 function TBGRAScene3D.ApplyNoLighting(Context: PSceneLightingContext;
    1704   Color: TBGRAPixel): TBGRAPixel;
    1705 var
    1706   m: TBGRAMaterial3D;
    1707 begin
    1708   m := TBGRAMaterial3D(Context^.material);
    1709 
    1710   if not m.GetAutoAmbiantColor then
    1711     result := ColorIntToBGRA(BGRAToColorIntMultiply(Color, m.GetAmbiantColorInt))
    1712   else
    1713     result := Color;
    1714 end;
    1715 
    1716 function TBGRAScene3D.ApplyLightingWithAmbiantLightnessOnly(
    1717   Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel;
    1718 var
    1719   m: TBGRAMaterial3D;
    1720 begin
    1721   m := TBGRAMaterial3D(Context^.material);
    1722 
    1723   if not m.GetAutoAmbiantColor then
    1724     Color := ColorIntToBGRA(BGRAToColorIntMultiply(Color, m.GetAmbiantColorInt));
    1725 
    1726   if FAmbiantLightness <= 0 then
    1727     result := BGRA(0,0,0,color.alpha)
    1728   else
    1729     result := ApplyIntensityFast(Color, FAmbiantLightness);
    17301418end;
    17311419
    … …  
    18601548
    18611549function TBGRAScene3D.CreateMaterial: IBGRAMaterial3D;
    1862 begin
    1863   result := TBGRAMaterial3D.Create;
     1550var m: TBGRAMaterial3D;
     1551begin
     1552  m := TBGRAMaterial3D.Create;
     1553  m.OnTextureChanged := @OnMaterialTextureChanged;
     1554  result := m;
    18641555  AddMaterial(result);
    18651556end;
    18661557
    18671558function TBGRAScene3D.CreateMaterial(ASpecularIndex: integer): IBGRAMaterial3D;
    1868 begin
    1869   result := TBGRAMaterial3D.Create;
    1870   result.SpecularIndex := ASpecularIndex;
    1871   result.SpecularColor := BGRAWhite;
     1559var m: TBGRAMaterial3D;
     1560begin
     1561  m := TBGRAMaterial3D.Create;
     1562  m.SetSpecularIndex(ASpecularIndex);
     1563  m.SetSpecularColor(BGRAWhite);
     1564  m.OnTextureChanged := @OnMaterialTextureChanged;
     1565  result := m;
    18721566  AddMaterial(result);
    18731567end;
    … …  
    19331627end;
    19341628
     1629function TBGRAScene3D.MakeLightList: TList;
     1630var i: integer;
     1631begin
     1632  result := TList.Create;
     1633  for i := 0 to FLights.Count-1 do
     1634    result.Add(FLights[i]);
     1635end;
     1636
    19351637initialization
    19361638
Note: See TracChangeset for help on using the changeset viewer.