1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit BGRASceneTypes;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses BGRABitmapTypes, BGRASSE, BGRAMatrix3D, BGRAColorInt;
9
10 type
11 TLightingNormal3D = (lnNone, lnFace, lnVertex, lnFaceVertexMix);
12 TLightingInterpolation3D = (liLowQuality, liSpecularHighQuality, liAlwaysHighQuality);
13 TAntialiasingMode3D = (am3dNone, am3dMultishape, am3dResample);
14 TPerspectiveMode3D = (pmLinearMapping, pmPerspectiveMapping, pmZBuffer);
15
16 TRenderingOptions = record
17 LightingInterpolation: TLightingInterpolation3D;
18 AntialiasingMode: TAntialiasingMode3D;
19 AntialiasingResampleLevel: integer;
20 PerspectiveMode: TPerspectiveMode3D;
21 TextureInterpolation: boolean;
22 MinZ: single;
23 end;
24
25 PSceneLightingContext = ^TSceneLightingContext;
26 TSceneLightingContext = packed record
27 basic: TBasicLightingContext;
28 {128} diffuseColor, {144} specularColor: TColorInt65536;
29 {160} vL, {176} dummy: TPoint3D_128;
30 {192} vH: TPoint3D_128;
31 {208} lightness: integer;
32 {212} material : TObject;
33 LightThroughFactor: single;
34 LightThrough: LongBool;
35 SaturationLow: integer;
36 SaturationLowF: single;
37 SaturationHigh: integer;
38 SaturationHighF: single;
39 end;
40
41 TBox3D = record
42 min,max: TPoint3D;
43 end;
44
45 IBGRAVertex3D = interface;
46
47 { IBGRALight3D }
48
49 IBGRALight3D = interface ['{85C683B6-07AC-4B8D-9324-06BC22882433}']
50 procedure ComputeDiffuseLightness(Context: PSceneLightingContext);
51 procedure ComputeDiffuseColor(Context: PSceneLightingContext);
52 procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext);
53
GetColornull54 function GetColor: TBGRAPixel;
GetColoredLightnull55 function GetColoredLight: boolean;
GetColorFnull56 function GetColorF: TColorF;
GetColorIntnull57 function GetColorInt: TColorInt65536;
GetLightnessFnull58 function GetLightnessF: single;
GetAsObjectnull59 function GetAsObject: TObject;
60 procedure SetColor(const AValue: TBGRAPixel);
61 procedure SetColorF(const AValue: TColorF);
62 procedure SetColorInt(const AValue: TColorInt65536);
63 property Color: TBGRAPixel read GetColor write SetColor;
64 property ColorF: TColorF read GetColorF write SetColorF;
65 property ColorInt: TColorInt65536 read GetColorInt write SetColorInt;
66 property LightnessF: single read GetLightnessF;
67 property ColoredLight: boolean read GetColoredLight;
68
GetMinIntensitynull69 function GetMinIntensity: single;
70 procedure SetMinIntensity(const AValue: single);
71 property MinIntensity: single read GetMinIntensity write SetMinIntensity;
IsDirectionalnull72 function IsDirectional: boolean;
73 end;
74
75 IBGRAPointLight3D = interface(IBGRALight3D) ['{C939900D-DDD6-49F0-B1E9-E29F94FDB4C8}']
GetVertexnull76 function GetVertex: IBGRAVertex3D;
77 procedure SetVertex(const AValue: IBGRAVertex3D);
78 property Vertex: IBGRAVertex3D read GetVertex write SetVertex;
79 end;
80
81 IBGRADirectionalLight3D = interface(IBGRALight3D) ['{8D575CEE-8DD2-46FB-9BCC-17DE3DAAF53D}']
GetDirectionnull82 function GetDirection: TPoint3D;
83 procedure SetDirection(const AValue: TPoint3D);
84 property Direction: TPoint3D read GetDirection write SetDirection;
85 end;
86
87 { IBGRAMaterial3D }
88
89 IBGRAMaterial3D = interface
GetAmbiantAlphanull90 function GetAmbiantAlpha: byte;
GetAutoAmbiantColornull91 function GetAutoAmbiantColor: boolean;
GetAutoDiffuseColornull92 function GetAutoDiffuseColor: boolean;
GetAutoSimpleColornull93 function GetAutoSimpleColor: boolean;
GetAutoSpecularColornull94 function GetAutoSpecularColor: boolean;
GetAmbiantColornull95 function GetAmbiantColor: TBGRAPixel;
GetAmbiantColorFnull96 function GetAmbiantColorF: TColorF;
GetAmbiantColorIntnull97 function GetAmbiantColorInt: TColorInt65536;
GetDiffuseAlphanull98 function GetDiffuseAlpha: byte;
GetDiffuseColornull99 function GetDiffuseColor: TBGRAPixel;
GetDiffuseColorFnull100 function GetDiffuseColorF: TColorF;
GetDiffuseColorIntnull101 function GetDiffuseColorInt: TColorInt65536;
GetLightThroughFactornull102 function GetLightThroughFactor: single;
GetNamenull103 function GetName: string;
GetSaturationHighnull104 function GetSaturationHigh: single;
GetSaturationLownull105 function GetSaturationLow: single;
GetSimpleAlphanull106 function GetSimpleAlpha: byte;
GetSimpleColornull107 function GetSimpleColor: TBGRAPixel;
GetSimpleColorFnull108 function GetSimpleColorF: TColorF;
GetSimpleColorIntnull109 function GetSimpleColorInt: TColorInt65536;
GetSpecularColornull110 function GetSpecularColor: TBGRAPixel;
GetSpecularColorFnull111 function GetSpecularColorF: TColorF;
GetSpecularColorIntnull112 function GetSpecularColorInt: TColorInt65536;
GetSpecularIndexnull113 function GetSpecularIndex: integer;
GetSpecularOnnull114 function GetSpecularOn: boolean;
GetTexturenull115 function GetTexture: IBGRAScanner;
GetTextureZoomnull116 function GetTextureZoom: TPointF;
GetAsObjectnull117 function GetAsObject: TObject;
118
119 procedure SetAmbiantAlpha(AValue: byte);
120 procedure SetAutoDiffuseColor(const AValue: boolean);
121 procedure SetAutoSpecularColor(const AValue: boolean);
122 procedure SetAmbiantColor(const AValue: TBGRAPixel);
123 procedure SetAmbiantColorF(const AValue: TColorF);
124 procedure SetAmbiantColorInt(const AValue: TColorInt65536);
125 procedure SetDiffuseAlpha(AValue: byte);
126 procedure SetDiffuseColor(const AValue: TBGRAPixel);
127 procedure SetDiffuseColorF(const AValue: TColorF);
128 procedure SetDiffuseColorInt(const AValue: TColorInt65536);
129 procedure SetLightThroughFactor(const AValue: single);
130 procedure SetName(const AValue: string);
131 procedure SetSaturationHigh(const AValue: single);
132 procedure SetSaturationLow(const AValue: single);
133 procedure SetSimpleAlpha(AValue: byte);
134 procedure SetSimpleColor(AValue: TBGRAPixel);
135 procedure SetSimpleColorF(AValue: TColorF);
136 procedure SetSimpleColorInt(AValue: TColorInt65536);
137 procedure SetSpecularColor(const AValue: TBGRAPixel);
138 procedure SetSpecularColorF(const AValue: TColorF);
139 procedure SetSpecularColorInt(const AValue: TColorInt65536);
140 procedure SetSpecularIndex(const AValue: integer);
141 procedure SetTexture(AValue: IBGRAScanner);
142 procedure SetTextureZoom(AValue: TPointF);
143
144 property AutoSimpleColor: boolean read GetAutoSimpleColor;
145 property SimpleColor: TBGRAPixel read GetSimpleColor write SetSimpleColor;
146 property SimpleColorF: TColorF read GetSimpleColorF write SetSimpleColorF;
147 property SimpleColorInt: TColorInt65536 read GetSimpleColorInt write SetSimpleColorInt;
148 property SimpleAlpha: byte read GetSimpleAlpha write SetSimpleAlpha;
149
150 property AmbiantColor: TBGRAPixel read GetAmbiantColor write SetAmbiantColor;
151 property AmbiantColorF: TColorF read GetAmbiantColorF write SetAmbiantColorF;
152 property AmbiantColorInt: TColorInt65536 read GetAmbiantColorInt write SetAmbiantColorInt;
153 property AutoAmbiantColor: boolean read GetAutoAmbiantColor;
154 property AmbiantAlpha: byte read GetAmbiantAlpha write SetAmbiantAlpha;
155 property Texture: IBGRAScanner read GetTexture write SetTexture;
156 property TextureZoom: TPointF read GetTextureZoom write SetTextureZoom;
157
158 property DiffuseColor: TBGRAPixel read GetDiffuseColor write SetDiffuseColor;
159 property DiffuseColorF: TColorF read GetDiffuseColorF write SetDiffuseColorF;
160 property DiffuseColorInt: TColorInt65536 read GetDiffuseColorInt write SetDiffuseColorInt;
161 property AutoDiffuseColor: boolean read GetAutoDiffuseColor write SetAutoDiffuseColor;
162 property DiffuseAlpha: byte read GetDiffuseAlpha write SetDiffuseAlpha;
163 property SaturationLow: single read GetSaturationLow write SetSaturationLow;
164 property SaturationHigh: single read GetSaturationHigh write SetSaturationHigh;
165
166 property SpecularColor: TBGRAPixel read GetSpecularColor write SetSpecularColor;
167 property SpecularColorF: TColorF read GetSpecularColorF write SetSpecularColorF;
168 property SpecularColorInt: TColorInt65536 read GetSpecularColorInt write SetSpecularColorInt;
169 property AutoSpecularColor: boolean read GetAutoSpecularColor write SetAutoSpecularColor;
170 property SpecularIndex: integer read GetSpecularIndex write SetSpecularIndex;
171 property SpecularOn: boolean read GetSpecularOn;
172
173 property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor;
174 property Name: string read GetName write SetName;
175 end;
176
177 { IBGRANormal3D }
178
179 IBGRANormal3D = interface
GetCustomNormalnull180 function GetCustomNormal: TPoint3D;
GetCustomNormal_128null181 function GetCustomNormal_128: TPoint3D_128;
GetViewNormalnull182 function GetViewNormal: TPoint3D;
GetViewNormal_128null183 function GetViewNormal_128: TPoint3D_128;
184 procedure SetCustomNormal(AValue: TPoint3D);
185 procedure SetCustomNormal_128(AValue: TPoint3D_128);
186 procedure SetViewNormal(AValue: TPoint3D);
187 procedure SetViewNormal_128(AValue: TPoint3D_128);
188 property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal;
189 property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128;
190 property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal;
191 property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128;
192 end;
193
194 { IBGRAVertex3D }
195
196 IBGRAVertex3D = interface
GetColornull197 function GetColor: TBGRAPixel;
GetCustomFlagsnull198 function GetCustomFlags: LongWord;
GetCustomNormalnull199 function GetCustomNormal: TPoint3D;
GetCustomNormal_128null200 function GetCustomNormal_128: TPoint3D_128;
GetLightnull201 function GetLight: Single;
GetProjectedCoordnull202 function GetProjectedCoord: TPointF;
GetUsagenull203 function GetUsage: integer;
GetViewNormalnull204 function GetViewNormal: TPoint3D;
GetViewNormal_128null205 function GetViewNormal_128: TPoint3D_128;
GetParentColornull206 function GetParentColor: Boolean;
GetSceneCoordnull207 function GetSceneCoord: TPoint3D;
GetSceneCoord_128null208 function GetSceneCoord_128: TPoint3D_128;
GetTexCoordnull209 function GetTexCoord: TPointF;
GetViewCoordnull210 function GetViewCoord: TPoint3D;
GetViewCoord_128null211 function GetViewCoord_128: TPoint3D_128;
212 procedure ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
GetViewCoordZnull213 function GetViewCoordZ: single;
214 procedure SetColor(const AValue: TBGRAPixel);
215 procedure SetCustomFlags(AValue: LongWord);
216 procedure SetCustomNormal(AValue: TPoint3D);
217 procedure SetCustomNormal_128(AValue: TPoint3D_128);
218 procedure SetLight(const AValue: Single);
219 procedure SetProjectedCoord(const AValue: TPointF);
220 procedure SetViewNormal(const AValue: TPoint3D);
221 procedure SetViewNormal_128(const AValue: TPoint3D_128);
222 procedure SetParentColor(const AValue: Boolean);
223 procedure SetSceneCoord(const AValue: TPoint3D);
224 procedure SetSceneCoord_128(const AValue: TPoint3D_128);
225 procedure SetTexCoord(const AValue: TPointF);
226 procedure SetViewCoord(const AValue: TPoint3D);
227 procedure SetViewCoord_128(const AValue: TPoint3D_128);
228 procedure NormalizeViewNormal;
229 procedure AddViewNormal(const AValue: TPoint3D_128);
230 property SceneCoord: TPoint3D read GetSceneCoord write SetSceneCoord;
231 property SceneCoord_128: TPoint3D_128 read GetSceneCoord_128 write SetSceneCoord_128;
232 property ViewCoord: TPoint3D read GetViewCoord write SetViewCoord;
233 property ViewCoord_128: TPoint3D_128 read GetViewCoord_128 write SetViewCoord_128;
234 property ViewCoordZ: single read GetViewCoordZ;
235 property ProjectedCoord: TPointF read GetProjectedCoord write SetProjectedCoord;
236 property TexCoord: TPointF read GetTexCoord write SetTexCoord;
237 property Color: TBGRAPixel read GetColor write SetColor;
238 property ParentColor: Boolean read GetParentColor write SetParentColor;
239 property Light: Single read GetLight write SetLight;
240 property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal;
241 property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128;
242 property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal;
243 property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128;
244 property Usage: integer read GetUsage;
245 property CustomFlags: LongWord read GetCustomFlags write SetCustomFlags;
GetAsObjectnull246 function GetAsObject: TObject;
247 end;
248
249 arrayOfIBGRAVertex3D = array of IBGRAVertex3D;
250 TVertex3DCallback = procedure(AVertex: IBGRAVertex3D) of object;
251
252 { IBGRAPart3D }
253
254 IBGRAPart3D = interface
255 procedure Clear(ARecursive: boolean);
Addnull256 function Add(x,y,z: single): IBGRAVertex3D; overload;
Addnull257 function Add(pt: TPoint3D): IBGRAVertex3D; overload;
Addnull258 function Add(pt: TPoint3D; normal: TPoint3D): IBGRAVertex3D; overload;
Addnull259 function Add(pt: TPoint3D_128): IBGRAVertex3D; overload;
Addnull260 function Add(pt: TPoint3D_128; normal: TPoint3D_128): IBGRAVertex3D; overload;
AddNormalnull261 function AddNormal(x,y,z: single): IBGRANormal3D; overload;
AddNormalnull262 function AddNormal(pt: TPoint3D): IBGRANormal3D; overload;
AddNormalnull263 function AddNormal(pt: TPoint3D_128): IBGRANormal3D; overload;
Addnull264 function Add(const coords: array of single): arrayOfIBGRAVertex3D; overload;
Addnull265 function Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D; overload;
Addnull266 function Add(const pts_128: array of TPoint3D_128): arrayOfIBGRAVertex3D; overload;
267 procedure Add(const pts: array of IBGRAVertex3D); overload;
268 procedure Add(AVertex: IBGRAVertex3D); overload;
GetTotalNormalCountnull269 function GetTotalNormalCount: integer;
IndexOfnull270 function IndexOf(AVertex: IBGRAVertex3D): integer;
271 procedure RemoveVertex(Index: integer);
272 procedure RemoveNormal(Index: integer);
GetBoundingBoxnull273 function GetBoundingBox: TBox3D;
GetMatrixnull274 function GetMatrix: TMatrix3D;
GetPartnull275 function GetPart(AIndex: Integer): IBGRAPart3D;
GetPartCountnull276 function GetPartCount: integer;
GetRadiusnull277 function GetRadius: single;
GetVertexnull278 function GetVertex(AIndex: Integer): IBGRAVertex3D;
GetVertexCountnull279 function GetVertexCount: integer;
GetNormalnull280 function GetNormal(AIndex: Integer): IBGRANormal3D;
GetNormalCountnull281 function GetNormalCount: integer;
GetTotalVertexCountnull282 function GetTotalVertexCount: integer;
GetContainernull283 function GetContainer: IBGRAPart3D;
284 procedure ResetTransform;
285 procedure Scale(size: single; Before: boolean = true); overload;
286 procedure Scale(x,y,z: single; Before: boolean = true); overload;
287 procedure Scale(size: TPoint3D; Before: boolean = true); overload;
288 procedure SetMatrix(const AValue: TMatrix3D);
289 procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D);
290 procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D);
291 procedure Translate(x,y,z: single; Before: boolean = true); overload;
292 procedure Translate(ofs: TPoint3D; Before: boolean = true); overload;
293 procedure RotateXDeg(angle: single; Before: boolean = true);
294 procedure RotateYDeg(angle: single; Before: boolean = true);
295 procedure RotateZDeg(angle: single; Before: boolean = true);
296 procedure RotateXRad(angle: single; Before: boolean = true);
297 procedure RotateYRad(angle: single; Before: boolean = true);
298 procedure RotateZRad(angle: single; Before: boolean = true);
299 procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
ComputeCoordinatenull300 function ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF;
301 procedure NormalizeViewNormal;
302 procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D);
303 procedure RemoveUnusedVertices;
CreatePartnull304 function CreatePart: IBGRAPart3D;
305 procedure ForEachVertex(ACallback: TVertex3DCallback);
306 property VertexCount: integer read GetVertexCount;
307 property NormalCount: integer read GetNormalCount;
308 property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex;
309 property Normal[AIndex: Integer]: IBGRANormal3D read GetNormal write SetNormal;
310 property Matrix: TMatrix3D read GetMatrix write SetMatrix;
311 property PartCount: integer read GetPartCount;
312 property Part[AIndex: Integer]: IBGRAPart3D read GetPart;
313 property Radius: single read GetRadius;
314 property BoundingBox: TBox3D read GetBoundingBox;
315 property TotalVertexCount: integer read GetTotalVertexCount;
316 property TotalNormalCount: integer read GetTotalNormalCount;
317 property Container: IBGRAPart3D read GetContainer;
318 end;
319
320 IBGRAObject3D = interface;
321
322 { IBGRAFace3D }
323
324 IBGRAFace3D = interface
325 procedure FlipFace;
AddVertexnull326 function AddVertex(AVertex: IBGRAVertex3D): integer;
GetBifacenull327 function GetBiface: boolean;
GetCustomFlagsnull328 function GetCustomFlags: LongWord;
GetLightThroughFactorOverridenull329 function GetLightThroughFactorOverride: boolean;
GetMaterialnull330 function GetMaterial: IBGRAMaterial3D;
GetMaterialNamenull331 function GetMaterialName: string;
GetObject3Dnull332 function GetObject3D: IBGRAObject3D;
GetParentTexturenull333 function GetParentTexture: boolean;
GetTexCoordnull334 function GetTexCoord(AIndex: Integer): TPointF;
GetTexCoordOverridenull335 function GetTexCoordOverride(AIndex: Integer): boolean;
GetTexturenull336 function GetTexture: IBGRAScanner;
GetVertexnull337 function GetVertex(AIndex: Integer): IBGRAVertex3D;
GetNormalnull338 function GetNormal(AIndex: Integer): IBGRANormal3D;
GetVertexColornull339 function GetVertexColor(AIndex: Integer): TBGRAPixel;
GetVertexColorOverridenull340 function GetVertexColorOverride(AIndex: Integer): boolean;
GetVertexCountnull341 function GetVertexCount: integer;
GetViewCenternull342 function GetViewCenter: TPoint3D;
GetViewCenter_128null343 function GetViewCenter_128: TPoint3D_128;
GetViewCenterZnull344 function GetViewCenterZ: single;
GetViewNormalnull345 function GetViewNormal: TPoint3D;
GetViewNormal_128null346 function GetViewNormal_128: TPoint3D_128;
GetLightThroughFactornull347 function GetLightThroughFactor: single;
348 procedure SetCustomFlags(AValue: LongWord);
349 procedure SetLightThroughFactor(const AValue: single);
350 procedure SetBiface(const AValue: boolean);
351 procedure SetLightThroughFactorOverride(const AValue: boolean);
352 procedure SetMaterial(const AValue: IBGRAMaterial3D);
353 procedure SetMaterialName(const AValue: string);
354 procedure SetParentTexture(const AValue: boolean);
355 procedure SetTexCoord(AIndex: Integer; const AValue: TPointF);
356 procedure SetTexCoordOverride(AIndex: Integer; const AValue: boolean);
357 procedure SetTexture(const AValue: IBGRAScanner);
358 procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D);
359 procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D);
360 procedure SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel);
361 procedure SetVertexColorOverride(AIndex: Integer; const AValue: boolean);
362 procedure ComputeViewNormalAndCenter;
363 procedure ComputeVertexColors;
364 procedure UpdateMaterial;
365 procedure SetColor(AColor: TBGRAPixel);
366 property Texture: IBGRAScanner read GetTexture write SetTexture;
367 property ParentTexture: boolean read GetParentTexture write SetParentTexture;
368 property VertexCount: integer read GetVertexCount;
369 property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex;
370 property VertexColor[AIndex: Integer]: TBGRAPixel read GetVertexColor write SetVertexColor;
371 property VertexColorOverride[AIndex: Integer]: boolean read GetVertexColorOverride write SetVertexColorOverride;
372 property TexCoord[AIndex: Integer]: TPointF read GetTexCoord write SetTexCoord;
373 property TexCoordOverride[AIndex: Integer]: boolean read GetTexCoordOverride write SetTexCoordOverride;
374 property ViewNormal: TPoint3D read GetViewNormal;
375 property ViewNormal_128: TPoint3D_128 read GetViewNormal_128;
376 property ViewCenter: TPoint3D read GetViewCenter;
377 property ViewCenter_128: TPoint3D_128 read GetViewCenter_128;
378 property ViewCenterZ: single read GetViewCenterZ;
379 property Object3D: IBGRAObject3D read GetObject3D;
380 property Biface: boolean read GetBiface write SetBiface;
381 property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor;
382 property LightThroughFactorOverride: boolean read GetLightThroughFactorOverride write SetLightThroughFactorOverride;
383 property Material: IBGRAMaterial3D read GetMaterial write SetMaterial;
384 property MaterialName: string read GetMaterialName write SetMaterialName;
GetAsObjectnull385 function GetAsObject: TObject;
386 property CustomFlags: LongWord read GetCustomFlags write SetCustomFlags;
387 end;
388
389 TFace3DCallback = procedure(AFace: IBGRAFace3D) of object;
390
391 { IBGRAObject3D }
392
393 IBGRAObject3D = interface
394 procedure Clear;
GetColornull395 function GetColor: TBGRAPixel;
GetFacenull396 function GetFace(AIndex: integer): IBGRAFace3D;
GetFaceCountnull397 function GetFaceCount: integer;
GetMaterialnull398 function GetMaterial: IBGRAMaterial3D;
GetRefCountnull399 function GetRefCount: integer;
GetTotalNormalCountnull400 function GetTotalNormalCount: integer;
GetTotalVertexCountnull401 function GetTotalVertexCount: integer;
GetLightnull402 function GetLight: Single;
GetLightingNormalnull403 function GetLightingNormal: TLightingNormal3D;
GetParentLightingnull404 function GetParentLighting: boolean;
GetTexturenull405 function GetTexture: IBGRAScanner;
GetMainPartnull406 function GetMainPart: IBGRAPart3D;
GetScenenull407 function GetScene: TObject;
408 procedure SetColor(const AValue: TBGRAPixel);
409 procedure SetLight(const AValue: Single);
410 procedure SetLightingNormal(const AValue: TLightingNormal3D);
411 procedure SetMaterial(const AValue: IBGRAMaterial3D);
412 procedure SetParentLighting(const AValue: boolean);
413 procedure SetTexture(const AValue: IBGRAScanner);
414 procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D);
415 procedure RemoveUnusedVertices;
416 procedure InvalidateColor;
417 procedure InvalidateMaterial;
418 procedure ForEachVertex(ACallback: TVertex3DCallback);
419 procedure ForEachFace(ACallback: TFace3DCallback);
AddFaceReversednull420 function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
AddFacenull421 function AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D; overload;
AddFacenull422 function AddFace(const AVertices: array of IBGRAVertex3D; ABiface: boolean): IBGRAFace3D; overload;
AddFacenull423 function AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D; overload;
AddFacenull424 function AddFace(const AVertices: array of IBGRAVertex3D; AColor: TBGRAPixel): IBGRAFace3D; overload;
AddFacenull425 function AddFace(const AVertices: array of IBGRAVertex3D; AColors: array of TBGRAPixel): IBGRAFace3D; overload;
426 procedure Update;
427 procedure SetBiface(AValue : boolean);
428 procedure SeparatePart(APart: IBGRAPart3D);
429 property MainPart: IBGRAPart3D read GetMainPart;
430 property Texture: IBGRAScanner read GetTexture write SetTexture;
431 property Light: Single read GetLight write SetLight;
432 property Color: TBGRAPixel read GetColor write SetColor;
433 property Face[AIndex: integer]: IBGRAFace3D read GetFace;
434 property FaceCount: integer read GetFaceCount;
435 property LightingNormal: TLightingNormal3D read GetLightingNormal write SetLightingNormal;
436 property ParentLighting: boolean read GetParentLighting write SetParentLighting;
437 property TotalVertexCount: integer read GetTotalVertexCount;
438 property TotalNormalCount: integer read GetTotalNormalCount;
439 property Material: IBGRAMaterial3D read GetMaterial write SetMaterial;
440 property Scene: TObject read GetScene;
441 property RefCount: integer read GetRefCount;
442 end;
443
444 TBGRAMaterialTextureChangedEvent = procedure(ASender: TObject) of object;
445
446 { TBGRAMaterial3D }
447
448 TBGRAMaterial3D = class(TInterfacedObject, IBGRAMaterial3D)
449 private
450 FName: string;
451 FAutoSimpleColor,FAutoAmbiantColor,FAutoDiffuseColor,FAutoSpecularColor: boolean;
452 FSimpleColorInt, FAmbiantColorInt, FDiffuseColorInt: TColorInt65536;
453 FDiffuseLightness: integer;
454
455 FSpecularColorInt: TColorInt65536;
456 FSpecularIndex: integer;
457 FSpecularOn: boolean;
458
459 FSaturationLowF: single;
460 FSaturationHighF: single;
461 FLightThroughFactor: single;
462
463 FTexture: IBGRAScanner;
464 FTextureZoom: TPointF;
465 FOnTextureChanged: TBGRAMaterialTextureChangedEvent;
466
467 //phong precalc
468 FPowerTable: array of single;
469 FPowerTableSize, FPowerTableExp2: integer;
470 FPowerTableSizeF: single;
471
472 procedure UpdateSpecular;
473 procedure UpdateSimpleColor;
474 procedure ComputePowerTable;
475 public
476 constructor Create;
477 destructor Destroy; override;
478
GetAutoAmbiantColornull479 function GetAutoAmbiantColor: boolean;
GetAutoDiffuseColornull480 function GetAutoDiffuseColor: boolean;
GetAutoSpecularColornull481 function GetAutoSpecularColor: boolean;
GetAutoSimpleColornull482 function GetAutoSimpleColor: boolean;
GetAmbiantAlphanull483 function GetAmbiantAlpha: byte;
GetAmbiantColornull484 function GetAmbiantColor: TBGRAPixel;
GetAmbiantColorFnull485 function GetAmbiantColorF: TColorF;
GetAmbiantColorIntnull486 function GetAmbiantColorInt: TColorInt65536;
GetDiffuseAlphanull487 function GetDiffuseAlpha: byte;
GetDiffuseColornull488 function GetDiffuseColor: TBGRAPixel;
GetDiffuseColorFnull489 function GetDiffuseColorF: TColorF;
GetDiffuseColorIntnull490 function GetDiffuseColorInt: TColorInt65536;
GetLightThroughFactornull491 function GetLightThroughFactor: single;
GetSpecularColornull492 function GetSpecularColor: TBGRAPixel;
GetSpecularColorFnull493 function GetSpecularColorF: TColorF;
GetSpecularColorIntnull494 function GetSpecularColorInt: TColorInt65536;
GetSpecularIndexnull495 function GetSpecularIndex: integer;
GetSaturationHighnull496 function GetSaturationHigh: single;
GetSaturationLownull497 function GetSaturationLow: single;
GetSimpleAlphanull498 function GetSimpleAlpha: byte;
GetSimpleColornull499 function GetSimpleColor: TBGRAPixel;
GetSimpleColorFnull500 function GetSimpleColorF: TColorF;
GetSimpleColorIntnull501 function GetSimpleColorInt: TColorInt65536;
GetTextureZoomnull502 function GetTextureZoom: TPointF;
GetSpecularOnnull503 function GetSpecularOn: boolean;
GetAsObjectnull504 function GetAsObject: TObject;
GetNamenull505 function GetName: string;
506
507 procedure SetAutoAmbiantColor(const AValue: boolean);
508 procedure SetAutoDiffuseColor(const AValue: boolean);
509 procedure SetAutoSpecularColor(const AValue: boolean);
510 procedure SetAmbiantAlpha(AValue: byte);
511 procedure SetAmbiantColor(const AValue: TBGRAPixel);
512 procedure SetAmbiantColorF(const AValue: TColorF);
513 procedure SetAmbiantColorInt(const AValue: TColorInt65536);
514 procedure SetDiffuseAlpha(AValue: byte);
515 procedure SetDiffuseColor(const AValue: TBGRAPixel);
516 procedure SetDiffuseColorF(const AValue: TColorF);
517 procedure SetDiffuseColorInt(const AValue: TColorInt65536);
518 procedure SetLightThroughFactor(const AValue: single);
519 procedure SetSpecularColor(const AValue: TBGRAPixel);
520 procedure SetSpecularColorF(const AValue: TColorF);
521 procedure SetSpecularColorInt(const AValue: TColorInt65536);
522 procedure SetSpecularIndex(const AValue: integer); virtual;
523 procedure SetSaturationHigh(const AValue: single);
524 procedure SetSaturationLow(const AValue: single);
525 procedure SetSimpleAlpha(AValue: byte);
526 procedure SetSimpleColor(AValue: TBGRAPixel);
527 procedure SetSimpleColorF(AValue: TColorF);
528 procedure SetSimpleColorInt(AValue: TColorInt65536);
529 procedure SetTextureZoom(AValue: TPointF);
530 procedure SetName(const AValue: string);
531
GetTexturenull532 function GetTexture: IBGRAScanner;
533 procedure SetTexture(AValue: IBGRAScanner);
534
535 procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext; DiffuseIntensity, SpecularIntensity, SpecularCosine: single; const ALightColor: TColorInt65536);
536 procedure ComputeDiffuseColor(Context: PSceneLightingContext; const DiffuseIntensity: single; const ALightColor: TColorInt65536);
537 procedure ComputeDiffuseLightness(Context: PSceneLightingContext; DiffuseLightnessTerm32768: integer; ALightLightness: integer);
538
539 property OnTextureChanged: TBGRAMaterialTextureChangedEvent read FOnTextureChanged write FOnTextureChanged;
540
541 end;
542
543 TFaceRenderingDescription = record
544 NormalsMode: TLightingNormal3D;
545
546 Material: TBGRAMaterial3D;
547 Texture: IBGRAScanner;
548 LightThroughFactor: single;
549 Biface: boolean;
550
551 NbVertices: Integer;
552 Projections: array of TPointF;
553 Colors: array of TBGRAPixel;
554 Positions3D, Normals3D: array of TPoint3D_128;
555 TexCoords: array of TPointF;
556 end;
557
558 { TCustomRenderer3D }
559
560 TCustomRenderer3D = class
561 private
562 FProjection: TProjection3D;
563 FProjectionDefined: boolean;
GetProjectionDefinednull564 function GetProjectionDefined: boolean;
565 protected
GetGlobalScalenull566 function GetGlobalScale: single; virtual; abstract;
GetHasZBuffernull567 function GetHasZBuffer: boolean; virtual; abstract;
GetHandlesNearClippingnull568 function GetHandlesNearClipping: boolean; virtual; abstract;
GetHandlesFaceCullingnull569 function GetHandlesFaceCulling: boolean; virtual; abstract;
GetSurfaceWidthnull570 function GetSurfaceWidth: integer; virtual; abstract;
GetSurfaceHeightnull571 function GetSurfaceHeight: integer; virtual; abstract;
572 procedure SetProjection(const AValue: TProjection3D); virtual;
573 public
RenderFacenull574 function RenderFace(var ADescription: TFaceRenderingDescription;
575 AComputeCoordinate: TComputeProjectionFunc): boolean; virtual; abstract;
576 property GlobalScale: single read GetGlobalScale;
577 property HasZBuffer: boolean read GetHasZBuffer;
578 property SurfaceWidth: integer read GetSurfaceWidth;
579 property SurfaceHeight: integer read GetSurfaceHeight;
580 property Projection: TProjection3D read FProjection write SetProjection;
581 property ProjectionDefined: boolean read GetProjectionDefined;
582 property HandlesNearClipping: boolean read GetHandlesNearClipping;
583 property HandlesFaceCulling: boolean read GetHandlesFaceCulling;
584 end;
585
586 { TBGRALight3D }
587
588 TBGRALight3D = class(TInterfacedObject,IBGRALight3D)
589 protected
590 FMinIntensity: single;
591 FColorInt: TColorInt65536;
592 FViewVector : TPoint3D_128;
593 FLightness: integer;
594 public
595 constructor Create;
596 destructor Destroy; override;
597 procedure ReleaseInterface;
598
599 procedure ComputeDiffuseLightness(Context: PSceneLightingContext); virtual; abstract;
600 procedure ComputeDiffuseColor(Context: PSceneLightingContext); virtual; abstract;
601 procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); virtual; abstract;
602
GetLightnessFnull603 function GetLightnessF: single;
GetColornull604 function GetColor: TBGRAPixel;
GetColorFnull605 function GetColorF: TColorF;
GetColorIntnull606 function GetColorInt: TColorInt65536;
GetAsObjectnull607 function GetAsObject: TObject;
608 procedure SetColor(const AValue: TBGRAPixel);
609 procedure SetColorF(const AValue: TColorF);
610 procedure SetColorInt(const AValue: TColorInt65536);
GetColoredLightnull611 function GetColoredLight: boolean;
612
GetMinIntensitynull613 function GetMinIntensity: single;
614 procedure SetMinIntensity(const AValue: single);
IsDirectionalnull615 function IsDirectional: boolean; virtual; abstract;
616
GetIntensitynull617 function GetIntensity: single; virtual;
GetPositionnull618 function GetPosition: TPoint3D; virtual;
GetDirectionnull619 function GetDirection: TPoint3D; virtual;
620 end;
621
622 implementation
623
624 { TCustomRenderer3D }
625
TCustomRenderer3D.GetProjectionDefinednull626 function TCustomRenderer3D.GetProjectionDefined: boolean;
627 begin
628 result := FProjectionDefined;
629 end;
630
631 {$PUSH}{$OPTIMIZATION OFF} // avoids internal error 2012090607
632 procedure TCustomRenderer3D.SetProjection(const AValue: TProjection3D);
633 begin
634 FProjection := AValue;
635 FProjectionDefined := true;
636 end;
637 {$POP}
638
639 { TBGRAMaterial3D }
640
641 procedure TBGRAMaterial3D.UpdateSpecular;
642 begin
643 FAutoSpecularColor := (FSpecularColorInt.r = 65536) and (FSpecularColorInt.g = 65536) and (FSpecularColorInt.b = 65536) and (FSpecularColorInt.a = 65536);
644 FSpecularOn := (FSpecularIndex > 0) and ((FSpecularColorInt.r <> 0) or (FSpecularColorInt.g <> 0) or (FSpecularColorInt.b <> 0) or
645 FAutoSpecularColor);
646 end;
647
648 procedure TBGRAMaterial3D.UpdateSimpleColor;
649 begin
650 FSimpleColorInt := (FAmbiantColorInt+FDiffuseColorInt)*32768;
651 FAutoSimpleColor := (FSimpleColorInt.r = 65536) and (FSimpleColorInt.g = 65536) and (FSimpleColorInt.b = 65536) and (FSimpleColorInt.a = 65536);
652 end;
653
654 procedure TBGRAMaterial3D.ComputePowerTable;
655 var i: integer;
656 Exponent: single;
657 begin
658 //exponent computed by squares
659 Exponent := 1;
660 FPowerTableExp2 := 0;
661 While Exponent*FPowerTableSize/16 < FSpecularIndex do
662 begin
663 Exponent := Exponent * 2;
664 Inc(FPowerTableExp2);
665 end;
666
667 //remaining exponent
668 setlength(FPowerTable,FPowerTableSize+3);
669 FPowerTable[0] := 0; //out of bound
670 FPowerTable[1] := 0; //image of zero
671 for i := 1 to FPowerTableSize do // ]0;1]
672 FPowerTable[i+1] := Exp(ln(i/(FPowerTableSize-1))*FSpecularIndex/Exponent);
673 FPowerTable[FPowerTableSize+2] := 1; //out of bound
674 end;
675
676 constructor TBGRAMaterial3D.Create;
677 begin
678 SetAmbiantColorInt(ColorInt65536(65536,65536,65536));
679 SetDiffuseColorInt(ColorInt65536(65536,65536,65536));
680 FSpecularIndex := 10;
681 SetSpecularColorInt(ColorInt65536(0,0,0));
682 FLightThroughFactor:= 0;
683 SetSaturationLow(2);
684 SetSaturationHigh(3);
685
686 FTexture := nil;
687 FTextureZoom := PointF(1,1);
688
689 FPowerTableSize := 128;
690 FPowerTableSizeF := FPowerTableSize;
691 FPowerTable := nil;
692 end;
693
694 destructor TBGRAMaterial3D.Destroy;
695 begin
696 inherited Destroy;
697 end;
698
GetAutoAmbiantColornull699 function TBGRAMaterial3D.GetAutoAmbiantColor: boolean;
700 begin
701 result := FAutoAmbiantColor;
702 end;
703
704 procedure TBGRAMaterial3D.SetDiffuseAlpha(AValue: byte);
705 begin
706 if AValue = 0 then
707 FDiffuseColorInt.a := 0
708 else
709 FDiffuseColorInt.a := AValue*257+1;
710 UpdateSimpleColor;
711 end;
712
GetAutoDiffuseColornull713 function TBGRAMaterial3D.GetAutoDiffuseColor: boolean;
714 begin
715 result := FAutoDiffuseColor;
716 end;
717
GetAutoSpecularColornull718 function TBGRAMaterial3D.GetAutoSpecularColor: boolean;
719 begin
720 result := FAutoSpecularColor;
721 end;
722
TBGRAMaterial3D.GetAutoSimpleColornull723 function TBGRAMaterial3D.GetAutoSimpleColor: boolean;
724 begin
725 result := FAutoSimpleColor;
726 end;
727
TBGRAMaterial3D.GetAmbiantAlphanull728 function TBGRAMaterial3D.GetAmbiantAlpha: byte;
729 var v: integer;
730 begin
731 if FAmbiantColorInt.a < 128 then
732 result := 0
733 else
734 begin
735 v := (FAmbiantColorInt.a-128) shr 8;
736 if v > 255 then v := 255;
737 result := v;
738 end;
739 end;
740
TBGRAMaterial3D.GetAmbiantColornull741 function TBGRAMaterial3D.GetAmbiantColor: TBGRAPixel;
742 begin
743 result := ColorIntToBGRA(FAmbiantColorInt,True);
744 end;
745
TBGRAMaterial3D.GetAmbiantColorFnull746 function TBGRAMaterial3D.GetAmbiantColorF: TColorF;
747 begin
748 result := ColorInt65536ToColorF(FAmbiantColorInt);
749 end;
750
TBGRAMaterial3D.GetAmbiantColorIntnull751 function TBGRAMaterial3D.GetAmbiantColorInt: TColorInt65536;
752 begin
753 result := FAmbiantColorInt;
754 end;
755
TBGRAMaterial3D.GetDiffuseAlphanull756 function TBGRAMaterial3D.GetDiffuseAlpha: byte;
757 var v: integer;
758 begin
759 if FDiffuseColorInt.a < 128 then
760 result := 0
761 else
762 begin
763 v := (FDiffuseColorInt.a-128) shr 8;
764 if v > 255 then v := 255;
765 result := v;
766 end;
767 end;
768
TBGRAMaterial3D.GetDiffuseColornull769 function TBGRAMaterial3D.GetDiffuseColor: TBGRAPixel;
770 begin
771 result := ColorIntToBGRA(FDiffuseColorInt,True);
772 end;
773
TBGRAMaterial3D.GetDiffuseColorFnull774 function TBGRAMaterial3D.GetDiffuseColorF: TColorF;
775 begin
776 result := ColorInt65536ToColorF(FDiffuseColorInt);
777 end;
778
GetDiffuseColorIntnull779 function TBGRAMaterial3D.GetDiffuseColorInt: TColorInt65536;
780 begin
781 result := FDiffuseColorInt;
782 end;
783
GetLightThroughFactornull784 function TBGRAMaterial3D.GetLightThroughFactor: single;
785 begin
786 result := FLightThroughFactor;
787 end;
788
GetSpecularColornull789 function TBGRAMaterial3D.GetSpecularColor: TBGRAPixel;
790 begin
791 result := ColorIntToBGRA(FSpecularColorInt,True);
792 end;
793
TBGRAMaterial3D.GetSpecularColorFnull794 function TBGRAMaterial3D.GetSpecularColorF: TColorF;
795 begin
796 result := ColorInt65536ToColorF(FSpecularColorInt);
797 end;
798
GetSpecularColorIntnull799 function TBGRAMaterial3D.GetSpecularColorInt: TColorInt65536;
800 begin
801 result := FSpecularColorInt;
802 end;
803
GetSpecularIndexnull804 function TBGRAMaterial3D.GetSpecularIndex: integer;
805 begin
806 result := FSpecularIndex;
807 end;
808
GetSaturationHighnull809 function TBGRAMaterial3D.GetSaturationHigh: single;
810 begin
811 result := FSaturationHighF;
812 end;
813
TBGRAMaterial3D.GetSaturationLownull814 function TBGRAMaterial3D.GetSaturationLow: single;
815 begin
816 result := FSaturationLowF;
817 end;
818
TBGRAMaterial3D.GetSimpleAlphanull819 function TBGRAMaterial3D.GetSimpleAlpha: byte;
820 begin
821 result := (GetAmbiantAlpha + GetDiffuseAlpha) shr 1;
822 end;
823
GetSimpleColornull824 function TBGRAMaterial3D.GetSimpleColor: TBGRAPixel;
825 begin
826 result := ColorIntToBGRA(GetSimpleColorInt,True);
827 end;
828
TBGRAMaterial3D.GetSimpleColorFnull829 function TBGRAMaterial3D.GetSimpleColorF: TColorF;
830 begin
831 result := ColorInt65536ToColorF(GetSimpleColorInt);
832 end;
833
GetSimpleColorIntnull834 function TBGRAMaterial3D.GetSimpleColorInt: TColorInt65536;
835 begin
836 result := (GetAmbiantColorInt + GetDiffuseColorInt)*32768;
837 end;
838
GetTexturenull839 function TBGRAMaterial3D.GetTexture: IBGRAScanner;
840 begin
841 result := FTexture;
842 end;
843
TBGRAMaterial3D.GetTextureZoomnull844 function TBGRAMaterial3D.GetTextureZoom: TPointF;
845 begin
846 result := FTextureZoom;
847 end;
848
849 procedure TBGRAMaterial3D.SetAutoAmbiantColor(const AValue: boolean);
850 begin
851 If AValue then
852 SetAmbiantColorInt(ColorInt65536(65536,65536,65536));
853 end;
854
855 procedure TBGRAMaterial3D.SetAutoDiffuseColor(const AValue: boolean);
856 begin
857 If AValue then
858 SetDiffuseColorInt(ColorInt65536(65536,65536,65536));
859 end;
860
861 procedure TBGRAMaterial3D.SetAutoSpecularColor(const AValue: boolean);
862 begin
863 If AValue then
864 SetSpecularColorInt(ColorInt65536(65536,65536,65536));
865 end;
866
867 procedure TBGRAMaterial3D.SetAmbiantAlpha(AValue: byte);
868 begin
869 if AValue = 0 then
870 FAmbiantColorInt.a := 0
871 else
872 FAmbiantColorInt.a := AValue*257+1;
873 UpdateSimpleColor;
874 end;
875
876 procedure TBGRAMaterial3D.SetAmbiantColor(const AValue: TBGRAPixel);
877 begin
878 FAmbiantColorInt := BGRAToColorInt(AValue,True);
879 FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536);
880 UpdateSimpleColor;
881 end;
882
883 procedure TBGRAMaterial3D.SetAmbiantColorF(const AValue: TColorF);
884 begin
885 FAmbiantColorInt := ColorFToColorInt65536(AValue);
886 FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536);
887 UpdateSimpleColor;
888 end;
889
890 procedure TBGRAMaterial3D.SetAmbiantColorInt(const AValue: TColorInt65536);
891 begin
892 FAmbiantColorInt := AValue;
893 FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536);
894 UpdateSimpleColor;
895 end;
896
897 procedure TBGRAMaterial3D.SetDiffuseColor(const AValue: TBGRAPixel);
898 begin
899 FDiffuseColorInt := BGRAToColorInt(AValue,True);
900 FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6;
901 FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536);
902 UpdateSimpleColor;
903 end;
904
905 procedure TBGRAMaterial3D.SetDiffuseColorF(const AValue: TColorF);
906 begin
907 FDiffuseColorInt := ColorFToColorInt65536(AValue);
908 FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6;
909 FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536);
910 UpdateSimpleColor;
911 end;
912
913 procedure TBGRAMaterial3D.SetDiffuseColorInt(const AValue: TColorInt65536);
914 begin
915 FDiffuseColorInt := AValue;
916 FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6;
917 FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536);
918 UpdateSimpleColor;
919 end;
920
921 procedure TBGRAMaterial3D.SetLightThroughFactor(const AValue: single);
922 begin
923 FLightThroughFactor:= AValue;
924 end;
925
926 procedure TBGRAMaterial3D.SetSpecularColor(const AValue: TBGRAPixel);
927 begin
928 FSpecularColorInt := BGRAToColorInt(AValue,True);
929 UpdateSpecular;
930 end;
931
932 procedure TBGRAMaterial3D.SetSpecularColorF(const AValue: TColorF);
933 begin
934 FSpecularColorInt := ColorFToColorInt65536(AValue);
935 UpdateSpecular;
936 end;
937
938 procedure TBGRAMaterial3D.SetSpecularColorInt(const AValue: TColorInt65536);
939 begin
940 FSpecularColorInt := AValue;
941 UpdateSpecular;
942 end;
943
944 procedure TBGRAMaterial3D.SetSpecularIndex(const AValue: integer);
945 begin
946 FSpecularIndex := AValue;
947 UpdateSpecular;
948
949 FPowerTable := nil;
950 end;
951
952 procedure TBGRAMaterial3D.SetSaturationHigh(const AValue: single);
953 begin
954 FSaturationHighF:= AValue;
955 end;
956
957 procedure TBGRAMaterial3D.SetSaturationLow(const AValue: single);
958 begin
959 FSaturationLowF:= AValue;
960 end;
961
962 procedure TBGRAMaterial3D.SetSimpleAlpha(AValue: byte);
963 begin
964 SetAmbiantAlpha(AValue);
965 SetDiffuseAlpha(AValue);
966 end;
967
968 procedure TBGRAMaterial3D.SetSimpleColor(AValue: TBGRAPixel);
969 begin
970 SetAmbiantColor(AValue);
971 SetDiffuseColor(AValue);
972 end;
973
974 procedure TBGRAMaterial3D.SetSimpleColorF(AValue: TColorF);
975 begin
976 SetAmbiantColorF(AValue);
977 SetDiffuseColorF(AValue);
978 end;
979
980 procedure TBGRAMaterial3D.SetSimpleColorInt(AValue: TColorInt65536);
981 begin
982 SetAmbiantColorInt(AValue);
983 SetDiffuseColorInt(AValue);
984 end;
985
986 procedure TBGRAMaterial3D.SetTexture(AValue: IBGRAScanner);
987 begin
988 If AValue <> FTexture then
989 begin
990 FTexture := AValue;
991 if Assigned(FOnTextureChanged) then
992 FOnTextureChanged(self);
993 end;
994 end;
995
996 procedure TBGRAMaterial3D.SetTextureZoom(AValue: TPointF);
997 begin
998 if AValue <> FTextureZoom then
999 begin
1000 FTextureZoom := AValue;
1001 if Assigned(FOnTextureChanged) then
1002 FOnTextureChanged(self);
1003 end;
1004 end;
1005
TBGRAMaterial3D.GetNamenull1006 function TBGRAMaterial3D.GetName: string;
1007 begin
1008 result := FName;
1009 end;
1010
1011 procedure TBGRAMaterial3D.SetName(const AValue: string);
1012 begin
1013 FName := AValue;
1014 end;
1015
GetSpecularOnnull1016 function TBGRAMaterial3D.GetSpecularOn: boolean;
1017 begin
1018 result := FSpecularOn;
1019 end;
1020
TBGRAMaterial3D.GetAsObjectnull1021 function TBGRAMaterial3D.GetAsObject: TObject;
1022 begin
1023 result := self;
1024 end;
1025
1026 procedure TBGRAMaterial3D.ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext; DiffuseIntensity, SpecularIntensity, SpecularCosine: single; const ALightColor: TColorInt65536);
1027 var
1028 NH,PowerTablePos: single; //keep first for asm
1029
1030 NnH: single;
1031 PowerTableFPos: single;
1032 PowerTableIPos,i: Int32or64;
1033 begin
1034 if SpecularCosine <= 0 then
1035 NnH := 0
1036 else
1037 if SpecularCosine >= 1 then
1038 NnH := 1 else
1039 begin
1040 NH := SpecularCosine;
1041 if FPowerTable = nil then ComputePowerTable;
1042 {$IFDEF CPUI386} {$asmmode intel}
1043 i := FPowerTableExp2;
1044 if i > 0 then
1045 begin
1046 PowerTablePos := FPowerTableSize;
1047 asm
1048 db $d9,$45,$f0 //flds NH
1049 mov ecx,i
1050 @loop:
1051 db $dc,$c8 //fmul st,st(0)
1052 dec ecx
1053 jnz @loop
1054 db $d8,$4d,$ec //fmuls PowerTablePos
1055 db $d9,$5d,$ec //fstps PowerTablePos
1056 end;
1057 end
1058 else
1059 PowerTablePos := NH*FPowerTableSize;
1060 {$ELSE}
1061 PowerTablePos := NH;
1062 for i := FPowerTableExp2-1 downto 0 do
1063 PowerTablePos := PowerTablePos*PowerTablePos;
1064 PowerTablePos := PowerTablePos * FPowerTableSize;
1065 {$ENDIF}
1066 PowerTableIPos := round(PowerTablePos+0.5);
1067 PowerTableFPos := PowerTablePos-PowerTableIPos;
1068 NnH := FPowerTable[PowerTableIPos]*(1-PowerTableFPos)+FPowerTable[PowerTableIPos+1]*PowerTableFPos;
1069 end; //faster than NnH := exp(FSpecularIndex*ln(NH)); !
1070
1071 if FAutoDiffuseColor then
1072 Context^.diffuseColor := Context^.diffuseColor + ALightColor*round(DiffuseIntensity*65536)
1073 else
1074 Context^.diffuseColor := Context^.diffuseColor + ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536);
1075
1076 if FAutoSpecularColor then
1077 Context^.specularColor := Context^.specularColor + ALightColor*round(SpecularIntensity* NnH*65536)
1078 else
1079 Context^.specularColor := Context^.specularColor + ALightColor*FSpecularColorInt*round(SpecularIntensity* NnH*65536);
1080 end;
1081
1082 procedure TBGRAMaterial3D.ComputeDiffuseColor(Context: PSceneLightingContext;
1083 const DiffuseIntensity: single; const ALightColor: TColorInt65536);
1084 begin
1085 if FAutoDiffuseColor then
1086 Context^.diffuseColor := Context^.diffuseColor + ALightColor*round(DiffuseIntensity*65536)
1087 else
1088 Context^.diffuseColor := Context^.diffuseColor + ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536);
1089 end;
1090
1091 procedure TBGRAMaterial3D.ComputeDiffuseLightness(
1092 Context: PSceneLightingContext; DiffuseLightnessTerm32768: integer; ALightLightness: integer);
1093 begin
1094 if FAutoDiffuseColor then
1095 begin
1096 if ALightLightness <> 32768 then
1097 inc(Context^.lightness, CombineLightness(DiffuseLightnessTerm32768,ALightLightness) )
1098 else
1099 inc(Context^.lightness, DiffuseLightnessTerm32768 );
1100 end else
1101 begin
1102 if FDiffuseLightness <> 32768 then
1103 inc(Context^.lightness, CombineLightness(DiffuseLightnessTerm32768,CombineLightness(FDiffuseLightness,ALightLightness)) )
1104 else
1105 inc(Context^.lightness, CombineLightness(DiffuseLightnessTerm32768,ALightLightness) );
1106 end;
1107 end;
1108
1109 { TBGRALight3D }
1110
1111 constructor TBGRALight3D.Create;
1112 begin
1113 SetColorF(ColorF(1,1,1,1));
1114 FViewVector := Point3D_128(0,0,-1);
1115 FMinIntensity:= 0;
1116 end;
1117
1118 destructor TBGRALight3D.Destroy;
1119 begin
1120 inherited Destroy;
1121 end;
1122
1123 procedure TBGRALight3D.ReleaseInterface;
1124 begin
1125 _Release;
1126 end;
1127
GetLightnessFnull1128 function TBGRALight3D.GetLightnessF: single;
1129 begin
1130 result := FLightness/32768;
1131 end;
1132
GetColornull1133 function TBGRALight3D.GetColor: TBGRAPixel;
1134 begin
1135 result := ColorIntToBGRA(FColorInt,True);
1136 end;
1137
GetColorFnull1138 function TBGRALight3D.GetColorF: TColorF;
1139 begin
1140 result := ColorInt65536ToColorF(FColorInt);
1141 end;
1142
TBGRALight3D.GetColorIntnull1143 function TBGRALight3D.GetColorInt: TColorInt65536;
1144 begin
1145 result := FColorInt;
1146 end;
1147
TBGRALight3D.GetAsObjectnull1148 function TBGRALight3D.GetAsObject: TObject;
1149 begin
1150 result := self;
1151 end;
1152
1153 procedure TBGRALight3D.SetColor(const AValue: TBGRAPixel);
1154 begin
1155 SetColorInt(BGRAToColorInt(AValue,True));
1156 end;
1157
1158 procedure TBGRALight3D.SetColorF(const AValue: TColorF);
1159 begin
1160 SetColorInt(ColorFToColorInt65536(AValue));
1161 end;
1162
1163 procedure TBGRALight3D.SetColorInt(const AValue: TColorInt65536);
1164 begin
1165 FColorInt := AValue;
1166 FLightness:= (AValue.r+AValue.g+AValue.b) div 6;
1167 end;
1168
GetColoredLightnull1169 function TBGRALight3D.GetColoredLight: boolean;
1170 begin
1171 result := (FColorInt.r <> FColorInt.g) or (FColorInt.g <> FColorInt.b);
1172 end;
1173
TBGRALight3D.GetMinIntensitynull1174 function TBGRALight3D.GetMinIntensity: single;
1175 begin
1176 result := FMinIntensity;
1177 end;
1178
1179 procedure TBGRALight3D.SetMinIntensity(const AValue: single);
1180 begin
1181 FMinIntensity := AValue;
1182 end;
1183
TBGRALight3D.GetIntensitynull1184 function TBGRALight3D.GetIntensity: single;
1185 begin
1186 result := 1;
1187 end;
1188
GetPositionnull1189 function TBGRALight3D.GetPosition: TPoint3D;
1190 begin
1191 result := Point3D(0,0,0);
1192 end;
1193
GetDirectionnull1194 function TBGRALight3D.GetDirection: TPoint3D;
1195 begin
1196 result := Point3D(0,0,0);
1197 end;
1198
1199 end.
1200