Changeset 494 for GraphicTest/Packages/bgrabitmap/bgrascene3d.pas
- Timestamp:
- Dec 22, 2016, 8:49:19 PM (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
GraphicTest/Packages/bgrabitmap/bgrascene3d.pas
r472 r494 6 6 7 7 uses 8 Classes, SysUtils, BGRABitmapTypes, BGRAColorInt, BGRASSE, BGRAMatrix3D; 8 Classes, SysUtils, BGRABitmapTypes, BGRAColorInt, 9 BGRASSE, BGRAMatrix3D, 10 BGRASceneTypes, BGRARenderer3D; 9 11 10 12 type 11 13 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 32 const 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; 49 49 50 50 type 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 51 78 { TBGRAScene3D } 52 79 53 80 TBGRAScene3D = class 54 81 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 58 92 FObjects: array of IBGRAObject3D; 59 93 FObjectCount: integer; 60 94 FMaterials: array of IBGRAMaterial3D; 61 95 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 72 101 function GetAmbiantLightColorF: TColorF; 73 102 function GetAmbiantLightness: single; … … 91 120 procedure SetViewPoint(const AValue: TPoint3D); 92 121 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; 97 123 procedure AddObject(AObj: IBGRAObject3D); 98 124 procedure AddLight(ALight: TObject); 99 125 procedure AddMaterial(AMaterial: IBGRAMaterial3D); 100 126 procedure Init; 101 procedure InternalRender(ASurface: TBGRACustomBitmap; AAntialiasingMode: TAntialiasingMode3D; GlobalScale: single); virtual;102 127 103 128 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; 109 135 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; 111 146 112 147 public 113 148 DefaultLightingNormal: TLightingNormal3D; 114 DefaultMaterial : IBGRAMaterial3D;115 149 RenderingOptions: TRenderingOptions; 116 150 UnknownColor: TBGRAPixel; 151 FetchDirectory: string; 152 FetchThrowsException: boolean; 117 153 118 154 constructor Create; … … 120 156 destructor Destroy; override; 121 157 procedure Clear; virtual; 158 function FetchObject(AName: string; SwapFacesOrientation: boolean = true): IBGRAObject3D; 159 procedure FetchMaterials(ALibraryName: string); virtual; 122 160 function LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D; 123 161 function LoadObjectFromFileUTF8(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D; … … 132 170 procedure LookDown(angleDeg: single); 133 171 procedure Render; virtual; 172 procedure Render(ARenderer: TCustomRenderer3D); 134 173 function CreateObject: IBGRAObject3D; overload; 135 174 function CreateObject(ATexture: IBGRAScanner): IBGRAObject3D; overload; … … 154 193 procedure ForEachVertex(ACallback: TVertex3DCallback); 155 194 procedure ForEachFace(ACallback: TFace3DCallback); 195 function MakeLightList: TList; 196 156 197 property ViewCenter: TPointF read GetViewCenter write SetViewCenter; 157 198 property AutoViewCenter: boolean read FAutoViewCenter write SetAutoViewCenter; … … 173 214 property Material[AIndex: integer] : IBGRAMaterial3D read GetMaterial; 174 215 property MaterialCount: integer read FMaterialCount; 216 property Camera: TCamera3D read FCamera; 217 property DefaultMaterial: IBGRAMaterial3D read FDefaultMaterial write SetDefaultMaterial; 175 218 end; 176 219 177 220 implementation 178 221 179 uses BGRAPolygon, BGRAPolygonAliased, BGRACoordPool3D, BGRAResample, 180 lazutf8classes; 222 uses BGRACoordPool3D, BGRAUTF8; 181 223 182 224 {$i lightingclasses3d.inc} 183 225 {$i vertex3d.inc} 184 226 {$i face3d.inc} 185 186 type187 { TBGRAObject3D }188 189 TBGRAObject3D = class(TInterfacedObject,IBGRAObject3D)190 private191 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 public203 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 240 227 {$i part3d.inc} 241 228 {$i object3d.inc} 242 229 {$i shapes3d.inc} 243 230 231 { TCamera3D } 232 233 function TCamera3D.GetLookWhere: TPoint3D; 234 begin 235 result := Point3D(FLookWhere); 236 end; 237 238 function TCamera3D.GetMatrix: TMatrix3D; 239 begin 240 if not FMatrixComputed then 241 begin 242 ComputeMatrix; 243 FMatrixComputed := true; 244 end; 245 result := FMatrix; 246 end; 247 248 function TCamera3D.GetViewPoint: TPoint3D; 249 begin 250 result := Point3D(FViewPoint); 251 end; 252 253 procedure TCamera3D.SetMatrix(AValue: TMatrix3D); 254 begin 255 FMatrix := AValue; 256 FMatrixComputed:= true; 257 FViewPoint := Point3D_128(FMatrix[1,4],FMatrix[2,4],FMatrix[3,4]); 258 end; 259 260 procedure TCamera3D.SetViewPoint(AValue: TPoint3D); 261 begin 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; 267 end; 268 269 procedure TCamera3D.ComputeMatrix; 270 var ZDir, XDir, YDir: TPoint3D_128; 271 begin 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); 287 end; 288 289 procedure TCamera3D.LookAt(AWhere: TPoint3D; ATopDir: TPoint3D); 290 begin 291 FLookWhere := Point3D_128(AWhere); 292 FTopDir := Point3D_128(ATopDir); 293 FMatrixComputed := false; 294 end; 295 296 procedure TCamera3D.LookLeft(angleDeg: single); 297 var m,inv: TMatrix3D; 298 begin 299 inv := MatrixInverse3D(Matrix); 300 m := MatrixRotateY(angleDeg*Pi/180); 301 FLookWhere := inv*m*Matrix*FLookWhere; 302 FMatrixComputed := false; 303 end; 304 305 procedure TCamera3D.LookRight(angleDeg: single); 306 begin 307 LookLeft(-angleDeg); 308 end; 309 310 procedure TCamera3D.LookUp(angleDeg: single); 311 var m,inv: TMatrix3D; 312 begin 313 inv := MatrixInverse3D(Matrix); 314 m := MatrixRotateX(-angleDeg*Pi/180); 315 FLookWhere := inv*m*Matrix*FLookWhere; 316 FMatrixComputed := false; 317 end; 318 319 procedure TCamera3D.LookDown(angleDeg: single); 320 begin 321 LookUp(-angleDeg); 322 end; 323 324 244 325 { TBGRAScene3D } 245 326 … … 248 329 if FAutoViewCenter then 249 330 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) 254 332 end 255 333 else … … 259 337 function TBGRAScene3D.GetViewPoint: TPoint3D; 260 338 begin 261 result := Point3D(FViewPoint);339 result := Camera.ViewPoint; 262 340 end; 263 341 … … 267 345 if FAutoZoom then 268 346 begin 269 if FSurface = nil then 347 Size := sqrt(GetRenderWidth*GetRenderHeight)*0.8; 348 if Size = 0 then 270 349 result := PointF(1,1) 271 350 else 272 begin273 Size := sqrt(FSurface.Width*FSurface.Height)*0.8;274 351 result := PointF(size,size); 275 end;276 352 end else 277 353 result := FZoom; … … 280 356 procedure TBGRAScene3D.SetAmbiantLightColorF(const AValue: TColorF); 281 357 begin 282 FAmbiantLightColor := ColorFToColorInt65536(AValue); 283 FAmbiantLightness := (FAmbiantLightColor.r + FAmbiantLightColor.g + FAmbiantLightColor.b) div 6; 358 FAmbiantLightColorF := AValue; 284 359 end; 285 360 286 361 procedure TBGRAScene3D.SetAmbiantLightness(const AValue: single); 287 362 begin 288 FAmbiantLightness:= round(AValue*32768); 289 FAmbiantLightColor := ColorInt65536(FAmbiantLightness*2, FAmbiantLightness*2, FAmbiantLightness*2); 363 FAmbiantLightColorF := ColorF(AValue, AValue, AValue, 1); 290 364 end; 291 365 292 366 procedure TBGRAScene3D.SetAmbiantLightColor(const AValue: TBGRAPixel); 293 367 begin 294 FAmbiantLightColor := BGRAToColorInt(AValue); 295 FAmbiantLightness := (FAmbiantLightColor.r + FAmbiantLightColor.g + FAmbiantLightColor.b) div 6; 368 FAmbiantLightColorF := ColorInt65536ToColorF(BGRAToColorInt(AValue,True)); 296 369 end; 297 370 … … 313 386 function TBGRAScene3D.GetAmbiantLightColor: TBGRAPixel; 314 387 begin 315 result := ColorIntToBGRA( FAmbiantLightColor);388 result := ColorIntToBGRA(ColorFToColorInt65536(FAmbiantLightColorF),True); 316 389 end; 317 390 … … 354 427 function TBGRAScene3D.GetAmbiantLightness: single; 355 428 begin 356 result := FAmbiantLightness/32768;429 result := (FAmbiantLightColorF[1]+FAmbiantLightColorF[2]+FAmbiantLightColorF[3])/3; 357 430 end; 358 431 359 432 function TBGRAScene3D.GetAmbiantLightColorF: TColorF; 360 433 begin 361 result := ColorInt65536ToColorF(FAmbiantLightColor);434 result := FAmbiantLightColorF; 362 435 end; 363 436 … … 378 451 end; 379 452 453 procedure TBGRAScene3D.SetDefaultMaterial(AValue: IBGRAMaterial3D); 454 begin 455 if FDefaultMaterial=AValue then Exit; 456 FDefaultMaterial:=AValue; 457 InvalidateMaterial; 458 end; 459 380 460 procedure TBGRAScene3D.SetViewCenter(const AValue: TPointF); 381 461 begin … … 384 464 end; 385 465 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); 466 procedure TBGRAScene3D.SetViewPoint(const AValue: TPoint3D); 467 begin 468 Camera.ViewPoint := AValue; 404 469 end; 405 470 … … 431 496 FAutoZoom := True; 432 497 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)); 435 502 with RenderingOptions do 436 503 begin … … 464 531 465 532 destructor TBGRAScene3D.Destroy; 466 begin 467 Clear; 468 FLights.Free; 533 var 534 i: Integer; 535 begin 536 DoClear; 537 FreeAndNil(FLights); 538 FreeAndNil(FCamera); 539 for i := 0 to high(FTexturesFetched) do 540 FTexturesFetched[i].Bitmap.Free; 469 541 inherited Destroy; 470 542 end; 471 543 472 544 procedure 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; 545 begin 546 DoClear; 486 547 DefaultMaterial := CreateMaterial; 548 end; 549 550 function TBGRAScene3D.FetchObject(AName: string; SwapFacesOrientation: boolean 551 ): IBGRAObject3D; 552 begin 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; 487 560 end; 488 561 … … 529 602 end; 530 603 604 function TBGRAScene3D.LoadBitmapFromFileUTF8(AFilenameUTF8: string): TBGRACustomBitmap; 605 begin 606 result := BGRABitmapFactory.Create(AfileNameUTF8,True); 607 end; 608 531 609 function TBGRAScene3D.FetchTexture(AName: string; out texSize: TPointF): IBGRAScanner; 532 begin 533 result := nil; 534 texSize := PointF(1,1); 610 var 611 i: Integer; 612 bmp: TBGRACustomBitmap; 613 begin 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; 644 end; 645 646 procedure TBGRAScene3D.FetchMaterials(ALibraryName: string); 647 var 648 i: Integer; 649 begin 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; 663 end; 664 665 procedure TBGRAScene3D.HandleFetchException(AException: Exception); 666 begin 667 if FetchThrowsException then 668 raise AException; 669 end; 670 671 procedure TBGRAScene3D.DoClear; 672 var i: integer; 673 begin 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; 689 end; 690 691 function TBGRAScene3D.GetRenderWidth: integer; 692 begin 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; 700 end; 701 702 function TBGRAScene3D.GetRenderHeight: integer; 703 begin 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; 711 end; 712 713 procedure TBGRAScene3D.OnMaterialTextureChanged(ASender: TObject); 714 begin 715 InvalidateMaterial; 716 end; 717 718 procedure TBGRAScene3D.InvalidateMaterial; 719 var 720 i: Integer; 721 begin 722 for i := 0 to FObjectCount-1 do 723 FObjects[i].InvalidateMaterial; 535 724 end; 536 725 537 726 function 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; 727 begin 728 result := LoadObjectFromFileUTF8(SysToUTF8(AFilename), SwapFacesOrientation); 546 729 end; 547 730 … … 659 842 result.LightingNormal := lnVertex; 660 843 end else 844 if lineType = 'mtllib' then 845 FetchMaterials(trim(s)) 846 else 661 847 if lineType = 'usemtl' then 662 848 materialname := trim(s) … … 837 1023 procedure TBGRAScene3D.LookAt(AWhere: TPoint3D; ATopDir: TPoint3D); 838 1024 begin 839 FLookWhere := Point3D_128(AWhere); 840 FTopDir := Point3D_128(ATopDir); 1025 Camera.LookAt(AWhere,ATopDir); 841 1026 end; 842 1027 843 1028 procedure 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; 1029 begin 1030 Camera.LookLeft(angleDeg); 849 1031 end; 850 1032 851 1033 procedure TBGRAScene3D.LookRight(angleDeg: single); 852 1034 begin 853 LookLeft(-angleDeg);1035 Camera.LookRight(angleDeg); 854 1036 end; 855 1037 856 1038 procedure 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; 1039 begin 1040 Camera.LookUp(angleDeg); 862 1041 end; 863 1042 864 1043 procedure TBGRAScene3D.LookDown(angleDeg: single); 865 1044 begin 866 LookUp(-angleDeg);1045 Camera.LookDown(angleDeg); 867 1046 end; 868 1047 869 1048 procedure TBGRAScene3D.Render; 870 1049 begin 871 InternalRender(FSurface, RenderingOptions.AntialiasingMode, 1); 1050 FRenderer := TBGRARenderer3D.Create(FSurface, RenderingOptions, 1051 FAmbiantLightColorF, 1052 FLights); 1053 DoRender; 1054 FRenderer.Free; 1055 end; 1056 1057 procedure TBGRAScene3D.Render(ARenderer: TCustomRenderer3D); 1058 begin 1059 FRenderer := ARenderer; 1060 DoRender; 1061 FRenderer := nil; 872 1062 end; 873 1063 … … 876 1066 i: Integer; 877 1067 begin 878 ComputeMatrix;879 880 1068 FProjection.Zoom := Zoom; 881 1069 FProjection.Zoom.X *= ScaleX; … … 885 1073 FProjection.Center.Y *= ScaleY; 886 1074 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); 893 1076 end; 894 1077 … … 903 1086 end else 904 1087 result := PointF(0,0); 905 end;906 907 procedure TBGRAScene3D.ComputeLight;908 begin909 910 1088 end; 911 1089 … … 998 1176 end; 999 1177 1000 procedure TBGRAScene3D. InternalRender(ASurface: TBGRACustomBitmap; AAntialiasingMode: TAntialiasingMode3D; GlobalScale: single);1178 procedure TBGRAScene3D.DoRender; 1001 1179 var 1002 1180 LFaces: array of TBGRAFace3D; … … 1014 1192 obj := FObjects[i]; 1015 1193 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; 1021 1195 end; 1022 1196 setlength(LFaces, LFaceCount); … … 1034 1208 1035 1209 var 1036 multi: TBGRAMultishapeFiller; 1037 ColorGradientTempBmp: TBGRACustomBitmap; 1038 zbuffer: psingle; 1039 1210 faceDesc: TFaceRenderingDescription; 1040 1211 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;1050 1212 1051 1213 procedure DrawFace(numFace: integer); 1052 1053 procedure DrawAliasedColoredFace(shader: TShaderFunction3D; VCount: integer; context: PBasicLightingContext);1054 var j,k: integer;1055 SameColor: boolean;1056 center: record1057 proj: TPointF;1058 pos3D,normal3D: TPoint3D_128;1059 color: TBGRAPixel;1060 end;1061 1062 begin1063 SameColor := True;1064 for j := 1 to VCount-1 do1065 if (LColors[j]<>LColors[j-1]) then SameColor := False;1066 1067 if shader <> nil then1068 begin1069 if SameColor then1070 begin1071 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 else1075 if VCount = 3 then1076 begin1077 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 else1085 if VCount = 4 then1086 begin1087 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 else1095 if VCount >= 3 then1096 begin //split into triangles1097 with center do1098 begin1099 ClearPoint3D_128(pos3D);1100 ClearPoint3D_128(normal3D);1101 color := MergeBGRA(slice(LColors,VCount));1102 end;1103 for j := 0 to VCount-1 do1104 begin1105 center.pos3D += LPos3D[j];1106 center.normal3D += LNormal3D[j];1107 end;1108 with center do1109 begin1110 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 do1116 begin1117 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 else1129 begin1130 if SameColor then1131 begin1132 if RenderingOptions.PerspectiveMode = pmZBuffer then1133 BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(ASurface, slice(LProj,VCount),1134 slice(LZ,VCount), slice(LColors,VCount),True,zbuffer)1135 else1136 ASurface.FillPoly(slice(LProj,VCount),LColors[0],dmDrawWithTransparency);1137 end1138 else1139 begin1140 if VCount > 4 then1141 begin //split into triangles1142 with center do1143 begin1144 ClearPoint3D_128(pos3D);1145 color := MergeBGRA(slice(LColors,VCount));1146 end;1147 for j := 0 to VCount-1 do1148 center.pos3D += LPos3D[j];1149 with center do1150 pos3D *= (1/VCount);1151 center.proj := ComputeCoordinate(center.pos3D);1152 k := VCount-1;1153 if RenderingOptions.PerspectiveMode = pmLinearMapping then1154 begin1155 for j := 0 to VCount-1 do1156 begin1157 ASurface.FillPolyLinearColor([LProj[k],LProj[j],center.proj],[LColors[k],LColors[j],center.color]);1158 k := j;1159 end;1160 end else1161 begin1162 for j := 0 to VCount-1 do1163 begin1164 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 else1170 begin1171 if RenderingOptions.PerspectiveMode = pmLinearMapping then1172 ASurface.FillPolyLinearColor(slice(LProj,VCount),slice(LColors,VCount))1173 else1174 BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(ASurface, slice(LProj,VCount),1175 slice(LZ,VCount), slice(LColors,VCount),True,zbuffer);1176 end;1177 end;1178 end;1179 end;1180 1181 1214 var 1182 1215 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;1191 1216 VCount,NewVCount: integer; 1192 ctx: PSceneLightingContext; 1193 NegNormals, UseDiffuseColor, 1194 UseDiffuseLightness{, OnlyDirectionalLight}: boolean; 1217 NegNormals: boolean; 1195 1218 LastVisibleVertex: integer; 1196 1219 … … 1204 1227 LVertices[NewVCount] := nil; //computed 1205 1228 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]); 1212 1234 NewVCount += 1; 1213 1235 end; 1214 1236 1215 1237 procedure LoadVertex(idxL: integer; idxV: integer); 1216 var desc: PBGRAFaceVertexDescription;1238 var vertexDesc: PBGRAFaceVertexDescription; 1217 1239 tempV: TBGRAVertex3D; 1218 1240 begin 1219 1241 with LFaces[numFace] do 1220 1242 begin 1221 desc := VertexDescription[idxV];1222 with desc^ do1243 vertexDesc := VertexDescription[idxV]; 1244 with vertexDesc^ do 1223 1245 begin 1224 1246 tempV := TBGRAVertex3D(vertex.GetAsObject); 1225 1247 LVertices[idxL] := tempV; 1226 1248 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; 1251 1251 1252 1252 with tempV.CoordData^ do 1253 1253 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; 1258 1257 end; 1259 1258 if Normal <> nil then 1260 LNormal3D[idxL] := Normal.ViewNormal_128; 1259 facedesc.Normals3D[idxL] := Normal.ViewNormal_128; 1260 Normalize3D_128(facedesc.Normals3D[idxL]); 1261 1261 end; 1262 1262 end; … … 1269 1269 if VCount < 3 then exit; 1270 1270 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; 1291 1276 1292 1277 if length(LVertices) < VCount+3 then //keep margin for z-clip 1293 1278 begin 1294 1279 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)); 1302 1285 end; 1303 1286 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 1316 1288 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); 1346 1291 end else 1347 1292 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 1349 1330 end; 1350 1331 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; 1353 1344 1354 1345 //compute normals 1355 case LLightNormalof1346 case faceDesc.NormalsMode of 1356 1347 lnFace: for j := 0 to VCount-1 do 1357 LNormal3D[j] := ViewNormal_128;1348 faceDesc.Normals3D[j] := ViewNormal_128; 1358 1349 lnFaceVertexMix: 1359 1350 for j := 0 to VCount-1 do 1360 1351 begin 1361 LNormal3D[j] += ViewNormal_128;1362 Normalize3D_128( LNormal3D[j]);1352 faceDesc.Normals3D[j] += ViewNormal_128; 1353 Normalize3D_128(faceDesc.Normals3D[j]); 1363 1354 end; 1364 1355 end; 1365 1356 if NegNormals then 1366 1357 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 1412 1360 if LightThroughFactorOverride then 1413 ctx^.LightThroughFactor := LightThroughFactor1361 faceDesc.LightThroughFactor := LightThroughFactor 1414 1362 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); 1516 1370 end; 1517 1371 end; 1518 1372 1519 procedure DrawWithResample;1520 var1521 tempSurface: TBGRACustomBitmap;1522 begin1523 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 1530 1373 var i,j: integer; 1531 1374 … … 1533 1376 FRenderedFaceCount:= 0; 1534 1377 1535 if ASurface = nil then1536 raise exception.Create('No surface specified');1537 1538 if (AAntialiasingMode = am3dResample) and (RenderingOptions.AntialiasingResampleLevel > 1) then1539 begin1540 DrawWithResample;1541 exit;1542 end;1543 1544 1378 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; 1548 1381 1549 1382 SortFaces(LFaces); 1550 1383 LVertices := nil; 1551 1384 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 1574 1388 begin 1575 1389 setlength(LFaceOpaque, length(LFaces)); … … 1602 1416 DrawFace(i); 1603 1417 end; 1604 1605 shaderContext.Free;1606 if zbuffer <> nil then freemem(zbuffer);1607 ColorGradientTempBmp.Free;1608 1609 if multi <> nil then1610 begin1611 multi.Draw(ASurface);1612 multi.Free;1613 end;1614 end;1615 1616 procedure TBGRAScene3D.SetViewPoint(const AValue: TPoint3D);1617 begin1618 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 begin1626 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 do1633 begin1634 TBGRALight3D(FLights[i]).ComputeDiffuseLightness(Context);1635 dec(i);1636 end;1637 1638 with Context^ do1639 if Lightness <= 0 then1640 result := BGRA(0,0,0,color.alpha)1641 else1642 begin1643 if Lightness <= SaturationLow then1644 result := ApplyIntensityFast(Color, Lightness)1645 else if Lightness >= SaturationHigh then1646 result := BGRA(255,255,255,color.alpha)1647 else1648 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 begin1658 m := TBGRAMaterial3D(Context^.material);1659 1660 if m.GetAutoAmbiantColor then1661 Context^.diffuseColor := FAmbiantLightColor1662 else1663 Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt;1664 1665 i := FLights.Count-1;1666 while i >= 0 do1667 begin1668 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 begin1681 m := TBGRAMaterial3D(Context^.material);1682 1683 if m.GetAutoAmbiantColor then1684 Context^.diffuseColor := FAmbiantLightColor1685 else1686 Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt;1687 Context^.specularColor := ColorInt65536(0,0,0,0);1688 1689 i := FLights.Count-1;1690 while i >= 0 do1691 begin1692 TBGRALight3D(FLights[i]).ComputeDiffuseAndSpecularColor(Context);1693 dec(i);1694 end;1695 1696 with Context^ do1697 begin1698 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 var1706 m: TBGRAMaterial3D;1707 begin1708 m := TBGRAMaterial3D(Context^.material);1709 1710 if not m.GetAutoAmbiantColor then1711 result := ColorIntToBGRA(BGRAToColorIntMultiply(Color, m.GetAmbiantColorInt))1712 else1713 result := Color;1714 end;1715 1716 function TBGRAScene3D.ApplyLightingWithAmbiantLightnessOnly(1717 Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel;1718 var1719 m: TBGRAMaterial3D;1720 begin1721 m := TBGRAMaterial3D(Context^.material);1722 1723 if not m.GetAutoAmbiantColor then1724 Color := ColorIntToBGRA(BGRAToColorIntMultiply(Color, m.GetAmbiantColorInt));1725 1726 if FAmbiantLightness <= 0 then1727 result := BGRA(0,0,0,color.alpha)1728 else1729 result := ApplyIntensityFast(Color, FAmbiantLightness);1730 1418 end; 1731 1419 … … 1860 1548 1861 1549 function TBGRAScene3D.CreateMaterial: IBGRAMaterial3D; 1862 begin 1863 result := TBGRAMaterial3D.Create; 1550 var m: TBGRAMaterial3D; 1551 begin 1552 m := TBGRAMaterial3D.Create; 1553 m.OnTextureChanged := @OnMaterialTextureChanged; 1554 result := m; 1864 1555 AddMaterial(result); 1865 1556 end; 1866 1557 1867 1558 function TBGRAScene3D.CreateMaterial(ASpecularIndex: integer): IBGRAMaterial3D; 1868 begin 1869 result := TBGRAMaterial3D.Create; 1870 result.SpecularIndex := ASpecularIndex; 1871 result.SpecularColor := BGRAWhite; 1559 var m: TBGRAMaterial3D; 1560 begin 1561 m := TBGRAMaterial3D.Create; 1562 m.SetSpecularIndex(ASpecularIndex); 1563 m.SetSpecularColor(BGRAWhite); 1564 m.OnTextureChanged := @OnMaterialTextureChanged; 1565 result := m; 1872 1566 AddMaterial(result); 1873 1567 end; … … 1933 1627 end; 1934 1628 1629 function TBGRAScene3D.MakeLightList: TList; 1630 var i: integer; 1631 begin 1632 result := TList.Create; 1633 for i := 0 to FLights.Count-1 do 1634 result.Add(FLights[i]); 1635 end; 1636 1935 1637 initialization 1936 1638
Note:
See TracChangeset
for help on using the changeset viewer.