source: trunk/Packages/bgrabitmap/bgrascenetypes.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 42.3 KB
Line 
1unit BGRASceneTypes;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses BGRABitmapTypes, BGRASSE, BGRAMatrix3D, BGRAColorInt;
8
9type
10 TLightingNormal3D = (lnNone, lnFace, lnVertex, lnFaceVertexMix);
11 TLightingInterpolation3D = (liLowQuality, liSpecularHighQuality, liAlwaysHighQuality);
12 TAntialiasingMode3D = (am3dNone, am3dMultishape, am3dResample);
13 TPerspectiveMode3D = (pmLinearMapping, pmPerspectiveMapping, pmZBuffer);
14
15 TRenderingOptions = record
16 LightingInterpolation: TLightingInterpolation3D;
17 AntialiasingMode: TAntialiasingMode3D;
18 AntialiasingResampleLevel: integer;
19 PerspectiveMode: TPerspectiveMode3D;
20 TextureInterpolation: boolean;
21 MinZ: single;
22 end;
23
24 PSceneLightingContext = ^TSceneLightingContext;
25 TSceneLightingContext = packed record
26 basic: TBasicLightingContext;
27 {128} diffuseColor, {144} specularColor: TColorInt65536;
28 {160} vL, {176} dummy: TPoint3D_128;
29 {192} vH: TPoint3D_128;
30 {208} lightness: integer;
31 {212} material : TObject;
32 LightThroughFactor: single;
33 LightThrough: LongBool;
34 SaturationLow: integer;
35 SaturationLowF: single;
36 SaturationHigh: integer;
37 SaturationHighF: single;
38 end;
39
40 TBox3D = record
41 min,max: TPoint3D;
42 end;
43
44 IBGRAVertex3D = interface;
45
46 { IBGRALight3D }
47
48 IBGRALight3D = interface ['{85C683B6-07AC-4B8D-9324-06BC22882433}']
49 procedure ComputeDiffuseLightness(Context: PSceneLightingContext);
50 procedure ComputeDiffuseColor(Context: PSceneLightingContext);
51 procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext);
52
53 function GetColor: TBGRAPixel;
54 function GetColoredLight: boolean;
55 function GetColorF: TColorF;
56 function GetColorInt: TColorInt65536;
57 function GetLightnessF: single;
58 function GetAsObject: TObject;
59 procedure SetColor(const AValue: TBGRAPixel);
60 procedure SetColorF(const AValue: TColorF);
61 procedure SetColorInt(const AValue: TColorInt65536);
62 property Color: TBGRAPixel read GetColor write SetColor;
63 property ColorF: TColorF read GetColorF write SetColorF;
64 property ColorInt: TColorInt65536 read GetColorInt write SetColorInt;
65 property LightnessF: single read GetLightnessF;
66 property ColoredLight: boolean read GetColoredLight;
67
68 function GetMinIntensity: single;
69 procedure SetMinIntensity(const AValue: single);
70 property MinIntensity: single read GetMinIntensity write SetMinIntensity;
71 function IsDirectional: boolean;
72 end;
73
74 IBGRAPointLight3D = interface(IBGRALight3D) ['{C939900D-DDD6-49F0-B1E9-E29F94FDB4C8}']
75 function GetVertex: IBGRAVertex3D;
76 procedure SetVertex(const AValue: IBGRAVertex3D);
77 property Vertex: IBGRAVertex3D read GetVertex write SetVertex;
78 end;
79
80 IBGRADirectionalLight3D = interface(IBGRALight3D) ['{8D575CEE-8DD2-46FB-9BCC-17DE3DAAF53D}']
81 function GetDirection: TPoint3D;
82 procedure SetDirection(const AValue: TPoint3D);
83 property Direction: TPoint3D read GetDirection write SetDirection;
84 end;
85
86 { IBGRAMaterial3D }
87
88 IBGRAMaterial3D = interface
89 function GetAmbiantAlpha: byte;
90 function GetAutoAmbiantColor: boolean;
91 function GetAutoDiffuseColor: boolean;
92 function GetAutoSimpleColor: boolean;
93 function GetAutoSpecularColor: boolean;
94 function GetAmbiantColor: TBGRAPixel;
95 function GetAmbiantColorF: TColorF;
96 function GetAmbiantColorInt: TColorInt65536;
97 function GetDiffuseAlpha: byte;
98 function GetDiffuseColor: TBGRAPixel;
99 function GetDiffuseColorF: TColorF;
100 function GetDiffuseColorInt: TColorInt65536;
101 function GetLightThroughFactor: single;
102 function GetName: string;
103 function GetSaturationHigh: single;
104 function GetSaturationLow: single;
105 function GetSimpleAlpha: byte;
106 function GetSimpleColor: TBGRAPixel;
107 function GetSimpleColorF: TColorF;
108 function GetSimpleColorInt: TColorInt65536;
109 function GetSpecularColor: TBGRAPixel;
110 function GetSpecularColorF: TColorF;
111 function GetSpecularColorInt: TColorInt65536;
112 function GetSpecularIndex: integer;
113 function GetSpecularOn: boolean;
114 function GetTexture: IBGRAScanner;
115 function GetTextureZoom: TPointF;
116 function GetAsObject: TObject;
117
118 procedure SetAmbiantAlpha(AValue: byte);
119 procedure SetAutoDiffuseColor(const AValue: boolean);
120 procedure SetAutoSpecularColor(const AValue: boolean);
121 procedure SetAmbiantColor(const AValue: TBGRAPixel);
122 procedure SetAmbiantColorF(const AValue: TColorF);
123 procedure SetAmbiantColorInt(const AValue: TColorInt65536);
124 procedure SetDiffuseAlpha(AValue: byte);
125 procedure SetDiffuseColor(const AValue: TBGRAPixel);
126 procedure SetDiffuseColorF(const AValue: TColorF);
127 procedure SetDiffuseColorInt(const AValue: TColorInt65536);
128 procedure SetLightThroughFactor(const AValue: single);
129 procedure SetName(const AValue: string);
130 procedure SetSaturationHigh(const AValue: single);
131 procedure SetSaturationLow(const AValue: single);
132 procedure SetSimpleAlpha(AValue: byte);
133 procedure SetSimpleColor(AValue: TBGRAPixel);
134 procedure SetSimpleColorF(AValue: TColorF);
135 procedure SetSimpleColorInt(AValue: TColorInt65536);
136 procedure SetSpecularColor(const AValue: TBGRAPixel);
137 procedure SetSpecularColorF(const AValue: TColorF);
138 procedure SetSpecularColorInt(const AValue: TColorInt65536);
139 procedure SetSpecularIndex(const AValue: integer);
140 procedure SetTexture(AValue: IBGRAScanner);
141 procedure SetTextureZoom(AValue: TPointF);
142
143 property AutoSimpleColor: boolean read GetAutoSimpleColor;
144 property SimpleColor: TBGRAPixel read GetSimpleColor write SetSimpleColor;
145 property SimpleColorF: TColorF read GetSimpleColorF write SetSimpleColorF;
146 property SimpleColorInt: TColorInt65536 read GetSimpleColorInt write SetSimpleColorInt;
147 property SimpleAlpha: byte read GetSimpleAlpha write SetSimpleAlpha;
148
149 property AmbiantColor: TBGRAPixel read GetAmbiantColor write SetAmbiantColor;
150 property AmbiantColorF: TColorF read GetAmbiantColorF write SetAmbiantColorF;
151 property AmbiantColorInt: TColorInt65536 read GetAmbiantColorInt write SetAmbiantColorInt;
152 property AutoAmbiantColor: boolean read GetAutoAmbiantColor;
153 property AmbiantAlpha: byte read GetAmbiantAlpha write SetAmbiantAlpha;
154 property Texture: IBGRAScanner read GetTexture write SetTexture;
155 property TextureZoom: TPointF read GetTextureZoom write SetTextureZoom;
156
157 property DiffuseColor: TBGRAPixel read GetDiffuseColor write SetDiffuseColor;
158 property DiffuseColorF: TColorF read GetDiffuseColorF write SetDiffuseColorF;
159 property DiffuseColorInt: TColorInt65536 read GetDiffuseColorInt write SetDiffuseColorInt;
160 property AutoDiffuseColor: boolean read GetAutoDiffuseColor write SetAutoDiffuseColor;
161 property DiffuseAlpha: byte read GetDiffuseAlpha write SetDiffuseAlpha;
162 property SaturationLow: single read GetSaturationLow write SetSaturationLow;
163 property SaturationHigh: single read GetSaturationHigh write SetSaturationHigh;
164
165 property SpecularColor: TBGRAPixel read GetSpecularColor write SetSpecularColor;
166 property SpecularColorF: TColorF read GetSpecularColorF write SetSpecularColorF;
167 property SpecularColorInt: TColorInt65536 read GetSpecularColorInt write SetSpecularColorInt;
168 property AutoSpecularColor: boolean read GetAutoSpecularColor write SetAutoSpecularColor;
169 property SpecularIndex: integer read GetSpecularIndex write SetSpecularIndex;
170 property SpecularOn: boolean read GetSpecularOn;
171
172 property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor;
173 property Name: string read GetName write SetName;
174 end;
175
176 { IBGRANormal3D }
177
178 IBGRANormal3D = interface
179 function GetCustomNormal: TPoint3D;
180 function GetCustomNormal_128: TPoint3D_128;
181 function GetViewNormal: TPoint3D;
182 function GetViewNormal_128: TPoint3D_128;
183 procedure SetCustomNormal(AValue: TPoint3D);
184 procedure SetCustomNormal_128(AValue: TPoint3D_128);
185 procedure SetViewNormal(AValue: TPoint3D);
186 procedure SetViewNormal_128(AValue: TPoint3D_128);
187 property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal;
188 property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128;
189 property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal;
190 property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128;
191 end;
192
193 { IBGRAVertex3D }
194
195 IBGRAVertex3D = interface
196 function GetColor: TBGRAPixel;
197 function GetCustomFlags: DWord;
198 function GetCustomNormal: TPoint3D;
199 function GetCustomNormal_128: TPoint3D_128;
200 function GetLight: Single;
201 function GetProjectedCoord: TPointF;
202 function GetUsage: integer;
203 function GetViewNormal: TPoint3D;
204 function GetViewNormal_128: TPoint3D_128;
205 function GetParentColor: Boolean;
206 function GetSceneCoord: TPoint3D;
207 function GetSceneCoord_128: TPoint3D_128;
208 function GetTexCoord: TPointF;
209 function GetViewCoord: TPoint3D;
210 function GetViewCoord_128: TPoint3D_128;
211 procedure ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
212 function GetViewCoordZ: single;
213 procedure SetColor(const AValue: TBGRAPixel);
214 procedure SetCustomFlags(AValue: DWord);
215 procedure SetCustomNormal(AValue: TPoint3D);
216 procedure SetCustomNormal_128(AValue: TPoint3D_128);
217 procedure SetLight(const AValue: Single);
218 procedure SetProjectedCoord(const AValue: TPointF);
219 procedure SetViewNormal(const AValue: TPoint3D);
220 procedure SetViewNormal_128(const AValue: TPoint3D_128);
221 procedure SetParentColor(const AValue: Boolean);
222 procedure SetSceneCoord(const AValue: TPoint3D);
223 procedure SetSceneCoord_128(const AValue: TPoint3D_128);
224 procedure SetTexCoord(const AValue: TPointF);
225 procedure SetViewCoord(const AValue: TPoint3D);
226 procedure SetViewCoord_128(const AValue: TPoint3D_128);
227 procedure NormalizeViewNormal;
228 procedure AddViewNormal(const AValue: TPoint3D_128);
229 property SceneCoord: TPoint3D read GetSceneCoord write SetSceneCoord;
230 property SceneCoord_128: TPoint3D_128 read GetSceneCoord_128 write SetSceneCoord_128;
231 property ViewCoord: TPoint3D read GetViewCoord write SetViewCoord;
232 property ViewCoord_128: TPoint3D_128 read GetViewCoord_128 write SetViewCoord_128;
233 property ViewCoordZ: single read GetViewCoordZ;
234 property ProjectedCoord: TPointF read GetProjectedCoord write SetProjectedCoord;
235 property TexCoord: TPointF read GetTexCoord write SetTexCoord;
236 property Color: TBGRAPixel read GetColor write SetColor;
237 property ParentColor: Boolean read GetParentColor write SetParentColor;
238 property Light: Single read GetLight write SetLight;
239 property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal;
240 property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128;
241 property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal;
242 property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128;
243 property Usage: integer read GetUsage;
244 property CustomFlags: DWord read GetCustomFlags write SetCustomFlags;
245 function GetAsObject: TObject;
246 end;
247
248 arrayOfIBGRAVertex3D = array of IBGRAVertex3D;
249 TVertex3DCallback = procedure(AVertex: IBGRAVertex3D) of object;
250
251 { IBGRAPart3D }
252
253 IBGRAPart3D = interface
254 procedure Clear(ARecursive: boolean);
255 function Add(x,y,z: single): IBGRAVertex3D; overload;
256 function Add(pt: TPoint3D): IBGRAVertex3D; overload;
257 function Add(pt: TPoint3D; normal: TPoint3D): IBGRAVertex3D; overload;
258 function Add(pt: TPoint3D_128): IBGRAVertex3D; overload;
259 function Add(pt: TPoint3D_128; normal: TPoint3D_128): IBGRAVertex3D; overload;
260 function AddNormal(x,y,z: single): IBGRANormal3D; overload;
261 function AddNormal(pt: TPoint3D): IBGRANormal3D; overload;
262 function AddNormal(pt: TPoint3D_128): IBGRANormal3D; overload;
263 function Add(const coords: array of single): arrayOfIBGRAVertex3D; overload;
264 function Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D; overload;
265 function Add(const pts_128: array of TPoint3D_128): arrayOfIBGRAVertex3D; overload;
266 procedure Add(const pts: array of IBGRAVertex3D); overload;
267 procedure Add(AVertex: IBGRAVertex3D); overload;
268 function GetTotalNormalCount: integer;
269 function IndexOf(AVertex: IBGRAVertex3D): integer;
270 procedure RemoveVertex(Index: integer);
271 procedure RemoveNormal(Index: integer);
272 function GetBoundingBox: TBox3D;
273 function GetMatrix: TMatrix3D;
274 function GetPart(AIndex: Integer): IBGRAPart3D;
275 function GetPartCount: integer;
276 function GetRadius: single;
277 function GetVertex(AIndex: Integer): IBGRAVertex3D;
278 function GetVertexCount: integer;
279 function GetNormal(AIndex: Integer): IBGRANormal3D;
280 function GetNormalCount: integer;
281 function GetTotalVertexCount: integer;
282 function GetContainer: IBGRAPart3D;
283 procedure ResetTransform;
284 procedure Scale(size: single; Before: boolean = true); overload;
285 procedure Scale(x,y,z: single; Before: boolean = true); overload;
286 procedure Scale(size: TPoint3D; Before: boolean = true); overload;
287 procedure SetMatrix(const AValue: TMatrix3D);
288 procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D);
289 procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D);
290 procedure Translate(x,y,z: single; Before: boolean = true); overload;
291 procedure Translate(ofs: TPoint3D; Before: boolean = true); overload;
292 procedure RotateXDeg(angle: single; Before: boolean = true);
293 procedure RotateYDeg(angle: single; Before: boolean = true);
294 procedure RotateZDeg(angle: single; Before: boolean = true);
295 procedure RotateXRad(angle: single; Before: boolean = true);
296 procedure RotateYRad(angle: single; Before: boolean = true);
297 procedure RotateZRad(angle: single; Before: boolean = true);
298 procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
299 function ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF;
300 procedure NormalizeViewNormal;
301 procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D);
302 procedure RemoveUnusedVertices;
303 function CreatePart: IBGRAPart3D;
304 procedure ForEachVertex(ACallback: TVertex3DCallback);
305 property VertexCount: integer read GetVertexCount;
306 property NormalCount: integer read GetNormalCount;
307 property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex;
308 property Normal[AIndex: Integer]: IBGRANormal3D read GetNormal write SetNormal;
309 property Matrix: TMatrix3D read GetMatrix write SetMatrix;
310 property PartCount: integer read GetPartCount;
311 property Part[AIndex: Integer]: IBGRAPart3D read GetPart;
312 property Radius: single read GetRadius;
313 property BoundingBox: TBox3D read GetBoundingBox;
314 property TotalVertexCount: integer read GetTotalVertexCount;
315 property TotalNormalCount: integer read GetTotalNormalCount;
316 property Container: IBGRAPart3D read GetContainer;
317 end;
318
319 IBGRAObject3D = interface;
320
321 { IBGRAFace3D }
322
323 IBGRAFace3D = interface
324 procedure FlipFace;
325 function AddVertex(AVertex: IBGRAVertex3D): integer;
326 function GetBiface: boolean;
327 function GetCustomFlags: DWord;
328 function GetLightThroughFactorOverride: boolean;
329 function GetMaterial: IBGRAMaterial3D;
330 function GetMaterialName: string;
331 function GetObject3D: IBGRAObject3D;
332 function GetParentTexture: boolean;
333 function GetTexCoord(AIndex: Integer): TPointF;
334 function GetTexCoordOverride(AIndex: Integer): boolean;
335 function GetTexture: IBGRAScanner;
336 function GetVertex(AIndex: Integer): IBGRAVertex3D;
337 function GetNormal(AIndex: Integer): IBGRANormal3D;
338 function GetVertexColor(AIndex: Integer): TBGRAPixel;
339 function GetVertexColorOverride(AIndex: Integer): boolean;
340 function GetVertexCount: integer;
341 function GetViewCenter: TPoint3D;
342 function GetViewCenter_128: TPoint3D_128;
343 function GetViewCenterZ: single;
344 function GetViewNormal: TPoint3D;
345 function GetViewNormal_128: TPoint3D_128;
346 function GetLightThroughFactor: single;
347 procedure SetCustomFlags(AValue: DWord);
348 procedure SetLightThroughFactor(const AValue: single);
349 procedure SetBiface(const AValue: boolean);
350 procedure SetLightThroughFactorOverride(const AValue: boolean);
351 procedure SetMaterial(const AValue: IBGRAMaterial3D);
352 procedure SetMaterialName(const AValue: string);
353 procedure SetParentTexture(const AValue: boolean);
354 procedure SetTexCoord(AIndex: Integer; const AValue: TPointF);
355 procedure SetTexCoordOverride(AIndex: Integer; const AValue: boolean);
356 procedure SetTexture(const AValue: IBGRAScanner);
357 procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D);
358 procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D);
359 procedure SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel);
360 procedure SetVertexColorOverride(AIndex: Integer; const AValue: boolean);
361 procedure ComputeViewNormalAndCenter;
362 procedure ComputeVertexColors;
363 procedure UpdateMaterial;
364 procedure SetColor(AColor: TBGRAPixel);
365 property Texture: IBGRAScanner read GetTexture write SetTexture;
366 property ParentTexture: boolean read GetParentTexture write SetParentTexture;
367 property VertexCount: integer read GetVertexCount;
368 property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex;
369 property VertexColor[AIndex: Integer]: TBGRAPixel read GetVertexColor write SetVertexColor;
370 property VertexColorOverride[AIndex: Integer]: boolean read GetVertexColorOverride write SetVertexColorOverride;
371 property TexCoord[AIndex: Integer]: TPointF read GetTexCoord write SetTexCoord;
372 property TexCoordOverride[AIndex: Integer]: boolean read GetTexCoordOverride write SetTexCoordOverride;
373 property ViewNormal: TPoint3D read GetViewNormal;
374 property ViewNormal_128: TPoint3D_128 read GetViewNormal_128;
375 property ViewCenter: TPoint3D read GetViewCenter;
376 property ViewCenter_128: TPoint3D_128 read GetViewCenter_128;
377 property ViewCenterZ: single read GetViewCenterZ;
378 property Object3D: IBGRAObject3D read GetObject3D;
379 property Biface: boolean read GetBiface write SetBiface;
380 property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor;
381 property LightThroughFactorOverride: boolean read GetLightThroughFactorOverride write SetLightThroughFactorOverride;
382 property Material: IBGRAMaterial3D read GetMaterial write SetMaterial;
383 property MaterialName: string read GetMaterialName write SetMaterialName;
384 function GetAsObject: TObject;
385 property CustomFlags: DWord read GetCustomFlags write SetCustomFlags;
386 end;
387
388 TFace3DCallback = procedure(AFace: IBGRAFace3D) of object;
389
390 { IBGRAObject3D }
391
392 IBGRAObject3D = interface
393 procedure Clear;
394 function GetColor: TBGRAPixel;
395 function GetFace(AIndex: integer): IBGRAFace3D;
396 function GetFaceCount: integer;
397 function GetMaterial: IBGRAMaterial3D;
398 function GetRefCount: integer;
399 function GetTotalNormalCount: integer;
400 function GetTotalVertexCount: integer;
401 function GetLight: Single;
402 function GetLightingNormal: TLightingNormal3D;
403 function GetParentLighting: boolean;
404 function GetTexture: IBGRAScanner;
405 function GetMainPart: IBGRAPart3D;
406 function GetScene: TObject;
407 procedure SetColor(const AValue: TBGRAPixel);
408 procedure SetLight(const AValue: Single);
409 procedure SetLightingNormal(const AValue: TLightingNormal3D);
410 procedure SetMaterial(const AValue: IBGRAMaterial3D);
411 procedure SetParentLighting(const AValue: boolean);
412 procedure SetTexture(const AValue: IBGRAScanner);
413 procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D);
414 procedure RemoveUnusedVertices;
415 procedure InvalidateColor;
416 procedure InvalidateMaterial;
417 procedure ForEachVertex(ACallback: TVertex3DCallback);
418 procedure ForEachFace(ACallback: TFace3DCallback);
419 function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
420 function AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D; overload;
421 function AddFace(const AVertices: array of IBGRAVertex3D; ABiface: boolean): IBGRAFace3D; overload;
422 function AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D; overload;
423 function AddFace(const AVertices: array of IBGRAVertex3D; AColor: TBGRAPixel): IBGRAFace3D; overload;
424 function AddFace(const AVertices: array of IBGRAVertex3D; AColors: array of TBGRAPixel): IBGRAFace3D; overload;
425 procedure Update;
426 procedure SetBiface(AValue : boolean);
427 procedure SeparatePart(APart: IBGRAPart3D);
428 property MainPart: IBGRAPart3D read GetMainPart;
429 property Texture: IBGRAScanner read GetTexture write SetTexture;
430 property Light: Single read GetLight write SetLight;
431 property Color: TBGRAPixel read GetColor write SetColor;
432 property Face[AIndex: integer]: IBGRAFace3D read GetFace;
433 property FaceCount: integer read GetFaceCount;
434 property LightingNormal: TLightingNormal3D read GetLightingNormal write SetLightingNormal;
435 property ParentLighting: boolean read GetParentLighting write SetParentLighting;
436 property TotalVertexCount: integer read GetTotalVertexCount;
437 property TotalNormalCount: integer read GetTotalNormalCount;
438 property Material: IBGRAMaterial3D read GetMaterial write SetMaterial;
439 property Scene: TObject read GetScene;
440 property RefCount: integer read GetRefCount;
441 end;
442
443 TBGRAMaterialTextureChangedEvent = procedure(ASender: TObject) of object;
444
445 { TBGRAMaterial3D }
446
447 TBGRAMaterial3D = class(TInterfacedObject, IBGRAMaterial3D)
448 private
449 FName: string;
450 FAutoSimpleColor,FAutoAmbiantColor,FAutoDiffuseColor,FAutoSpecularColor: boolean;
451 FSimpleColorInt, FAmbiantColorInt, FDiffuseColorInt: TColorInt65536;
452 FDiffuseLightness: integer;
453
454 FSpecularColorInt: TColorInt65536;
455 FSpecularIndex: integer;
456 FSpecularOn: boolean;
457
458 FSaturationLowF: single;
459 FSaturationHighF: single;
460 FLightThroughFactor: single;
461
462 FTexture: IBGRAScanner;
463 FTextureZoom: TPointF;
464 FOnTextureChanged: TBGRAMaterialTextureChangedEvent;
465
466 //phong precalc
467 FPowerTable: array of single;
468 FPowerTableSize, FPowerTableExp2: integer;
469 FPowerTableSizeF: single;
470
471 procedure UpdateSpecular;
472 procedure UpdateSimpleColor;
473 procedure ComputePowerTable;
474 public
475 constructor Create;
476 destructor Destroy; override;
477
478 function GetAutoAmbiantColor: boolean;
479 function GetAutoDiffuseColor: boolean;
480 function GetAutoSpecularColor: boolean;
481 function GetAutoSimpleColor: boolean;
482 function GetAmbiantAlpha: byte;
483 function GetAmbiantColor: TBGRAPixel;
484 function GetAmbiantColorF: TColorF;
485 function GetAmbiantColorInt: TColorInt65536;
486 function GetDiffuseAlpha: byte;
487 function GetDiffuseColor: TBGRAPixel;
488 function GetDiffuseColorF: TColorF;
489 function GetDiffuseColorInt: TColorInt65536;
490 function GetLightThroughFactor: single;
491 function GetSpecularColor: TBGRAPixel;
492 function GetSpecularColorF: TColorF;
493 function GetSpecularColorInt: TColorInt65536;
494 function GetSpecularIndex: integer;
495 function GetSaturationHigh: single;
496 function GetSaturationLow: single;
497 function GetSimpleAlpha: byte;
498 function GetSimpleColor: TBGRAPixel;
499 function GetSimpleColorF: TColorF;
500 function GetSimpleColorInt: TColorInt65536;
501 function GetTextureZoom: TPointF;
502 function GetSpecularOn: boolean;
503 function GetAsObject: TObject;
504 function GetName: string;
505
506 procedure SetAutoAmbiantColor(const AValue: boolean);
507 procedure SetAutoDiffuseColor(const AValue: boolean);
508 procedure SetAutoSpecularColor(const AValue: boolean);
509 procedure SetAmbiantAlpha(AValue: byte);
510 procedure SetAmbiantColor(const AValue: TBGRAPixel);
511 procedure SetAmbiantColorF(const AValue: TColorF);
512 procedure SetAmbiantColorInt(const AValue: TColorInt65536);
513 procedure SetDiffuseAlpha(AValue: byte);
514 procedure SetDiffuseColor(const AValue: TBGRAPixel);
515 procedure SetDiffuseColorF(const AValue: TColorF);
516 procedure SetDiffuseColorInt(const AValue: TColorInt65536);
517 procedure SetLightThroughFactor(const AValue: single);
518 procedure SetSpecularColor(const AValue: TBGRAPixel);
519 procedure SetSpecularColorF(const AValue: TColorF);
520 procedure SetSpecularColorInt(const AValue: TColorInt65536);
521 procedure SetSpecularIndex(const AValue: integer); virtual;
522 procedure SetSaturationHigh(const AValue: single);
523 procedure SetSaturationLow(const AValue: single);
524 procedure SetSimpleAlpha(AValue: byte);
525 procedure SetSimpleColor(AValue: TBGRAPixel);
526 procedure SetSimpleColorF(AValue: TColorF);
527 procedure SetSimpleColorInt(AValue: TColorInt65536);
528 procedure SetTextureZoom(AValue: TPointF);
529 procedure SetName(const AValue: string);
530
531 function GetTexture: IBGRAScanner;
532 procedure SetTexture(AValue: IBGRAScanner);
533
534 procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext; DiffuseIntensity, SpecularIntensity, SpecularCosine: single; const ALightColor: TColorInt65536);
535 procedure ComputeDiffuseColor(Context: PSceneLightingContext; const DiffuseIntensity: single; const ALightColor: TColorInt65536);
536 procedure ComputeDiffuseLightness(Context: PSceneLightingContext; DiffuseLightnessTerm32768: integer; ALightLightness: integer);
537
538 property OnTextureChanged: TBGRAMaterialTextureChangedEvent read FOnTextureChanged write FOnTextureChanged;
539
540 end;
541
542 TFaceRenderingDescription = record
543 NormalsMode: TLightingNormal3D;
544
545 Material: TBGRAMaterial3D;
546 Texture: IBGRAScanner;
547 LightThroughFactor: single;
548 Biface: boolean;
549
550 NbVertices: Integer;
551 Projections: array of TPointF;
552 Colors: array of TBGRAPixel;
553 Positions3D, Normals3D: array of TPoint3D_128;
554 TexCoords: array of TPointF;
555 end;
556
557 { TCustomRenderer3D }
558
559 TCustomRenderer3D = class
560 private
561 FProjection: TProjection3D;
562 FProjectionDefined: boolean;
563 function GetProjectionDefined: boolean;
564 protected
565 function GetGlobalScale: single; virtual; abstract;
566 function GetHasZBuffer: boolean; virtual; abstract;
567 function GetHandlesNearClipping: boolean; virtual; abstract;
568 function GetHandlesFaceCulling: boolean; virtual; abstract;
569 function GetSurfaceWidth: integer; virtual; abstract;
570 function GetSurfaceHeight: integer; virtual; abstract;
571 procedure SetProjection(const AValue: TProjection3D); virtual;
572 public
573 function RenderFace(var ADescription: TFaceRenderingDescription;
574 AComputeCoordinate: TComputeProjectionFunc): boolean; virtual; abstract;
575 property GlobalScale: single read GetGlobalScale;
576 property HasZBuffer: boolean read GetHasZBuffer;
577 property SurfaceWidth: integer read GetSurfaceWidth;
578 property SurfaceHeight: integer read GetSurfaceHeight;
579 property Projection: TProjection3D read FProjection write SetProjection;
580 property ProjectionDefined: boolean read GetProjectionDefined;
581 property HandlesNearClipping: boolean read GetHandlesNearClipping;
582 property HandlesFaceCulling: boolean read GetHandlesFaceCulling;
583 end;
584
585 { TBGRALight3D }
586
587 TBGRALight3D = class(TInterfacedObject,IBGRALight3D)
588 protected
589 FMinIntensity: single;
590 FColorInt: TColorInt65536;
591 FViewVector : TPoint3D_128;
592 FLightness: integer;
593 public
594 constructor Create;
595 destructor Destroy; override;
596 procedure ReleaseInterface;
597
598 procedure ComputeDiffuseLightness(Context: PSceneLightingContext); virtual; abstract;
599 procedure ComputeDiffuseColor(Context: PSceneLightingContext); virtual; abstract;
600 procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); virtual; abstract;
601
602 function GetLightnessF: single;
603 function GetColor: TBGRAPixel;
604 function GetColorF: TColorF;
605 function GetColorInt: TColorInt65536;
606 function GetAsObject: TObject;
607 procedure SetColor(const AValue: TBGRAPixel);
608 procedure SetColorF(const AValue: TColorF);
609 procedure SetColorInt(const AValue: TColorInt65536);
610 function GetColoredLight: boolean;
611
612 function GetMinIntensity: single;
613 procedure SetMinIntensity(const AValue: single);
614 function IsDirectional: boolean; virtual; abstract;
615
616 function GetIntensity: single; virtual;
617 function GetPosition: TPoint3D; virtual;
618 function GetDirection: TPoint3D; virtual;
619 end;
620
621implementation
622
623{ TCustomRenderer3D }
624
625function TCustomRenderer3D.GetProjectionDefined: boolean;
626begin
627 result := FProjectionDefined;
628end;
629
630{$PUSH}{$OPTIMIZATION OFF} // avoids internal error 2012090607
631procedure TCustomRenderer3D.SetProjection(const AValue: TProjection3D);
632begin
633 FProjection := AValue;
634 FProjectionDefined := true;
635end;
636{$POP}
637
638{ TBGRAMaterial3D }
639
640procedure TBGRAMaterial3D.UpdateSpecular;
641begin
642 FAutoSpecularColor := (FSpecularColorInt.r = 65536) and (FSpecularColorInt.g = 65536) and (FSpecularColorInt.b = 65536) and (FSpecularColorInt.a = 65536);
643 FSpecularOn := (FSpecularIndex > 0) and ((FSpecularColorInt.r <> 0) or (FSpecularColorInt.g <> 0) or (FSpecularColorInt.b <> 0) or
644 FAutoSpecularColor);
645end;
646
647procedure TBGRAMaterial3D.UpdateSimpleColor;
648begin
649 FSimpleColorInt := (FAmbiantColorInt+FDiffuseColorInt)*32768;
650 FAutoSimpleColor := (FSimpleColorInt.r = 65536) and (FSimpleColorInt.g = 65536) and (FSimpleColorInt.b = 65536) and (FSimpleColorInt.a = 65536);
651end;
652
653procedure TBGRAMaterial3D.ComputePowerTable;
654var i: integer;
655 Exponent: single;
656begin
657 //exponent computed by squares
658 Exponent := 1;
659 FPowerTableExp2 := 0;
660 While Exponent*FPowerTableSize/16 < FSpecularIndex do
661 begin
662 Exponent *= 2;
663 Inc(FPowerTableExp2);
664 end;
665
666 //remaining exponent
667 setlength(FPowerTable,FPowerTableSize+3);
668 FPowerTable[0] := 0; //out of bound
669 FPowerTable[1] := 0; //image of zero
670 for i := 1 to FPowerTableSize do // ]0;1]
671 FPowerTable[i+1] := Exp(ln(i/(FPowerTableSize-1))*FSpecularIndex/Exponent);
672 FPowerTable[FPowerTableSize+2] := 1; //out of bound
673end;
674
675constructor TBGRAMaterial3D.Create;
676begin
677 SetAmbiantColorInt(ColorInt65536(65536,65536,65536));
678 SetDiffuseColorInt(ColorInt65536(65536,65536,65536));
679 FSpecularIndex := 10;
680 SetSpecularColorInt(ColorInt65536(0,0,0));
681 FLightThroughFactor:= 0;
682 SetSaturationLow(2);
683 SetSaturationHigh(3);
684
685 FTexture := nil;
686 FTextureZoom := PointF(1,1);
687
688 FPowerTableSize := 128;
689 FPowerTableSizeF := FPowerTableSize;
690 FPowerTable := nil;
691end;
692
693destructor TBGRAMaterial3D.Destroy;
694begin
695 inherited Destroy;
696end;
697
698function TBGRAMaterial3D.GetAutoAmbiantColor: boolean;
699begin
700 result := FAutoAmbiantColor;
701end;
702
703procedure TBGRAMaterial3D.SetDiffuseAlpha(AValue: byte);
704begin
705 if AValue = 0 then
706 FDiffuseColorInt.a := 0
707 else
708 FDiffuseColorInt.a := AValue*257+1;
709 UpdateSimpleColor;
710end;
711
712function TBGRAMaterial3D.GetAutoDiffuseColor: boolean;
713begin
714 result := FAutoDiffuseColor;
715end;
716
717function TBGRAMaterial3D.GetAutoSpecularColor: boolean;
718begin
719 result := FAutoSpecularColor;
720end;
721
722function TBGRAMaterial3D.GetAutoSimpleColor: boolean;
723begin
724 result := FAutoSimpleColor;
725end;
726
727function TBGRAMaterial3D.GetAmbiantAlpha: byte;
728var v: integer;
729begin
730 if FAmbiantColorInt.a < 128 then
731 result := 0
732 else
733 begin
734 v := (FAmbiantColorInt.a-128) shr 8;
735 if v > 255 then v := 255;
736 result := v;
737 end;
738end;
739
740function TBGRAMaterial3D.GetAmbiantColor: TBGRAPixel;
741begin
742 result := ColorIntToBGRA(FAmbiantColorInt,True);
743end;
744
745function TBGRAMaterial3D.GetAmbiantColorF: TColorF;
746begin
747 result := ColorInt65536ToColorF(FAmbiantColorInt);
748end;
749
750function TBGRAMaterial3D.GetAmbiantColorInt: TColorInt65536;
751begin
752 result := FAmbiantColorInt;
753end;
754
755function TBGRAMaterial3D.GetDiffuseAlpha: byte;
756var v: integer;
757begin
758 if FDiffuseColorInt.a < 128 then
759 result := 0
760 else
761 begin
762 v := (FDiffuseColorInt.a-128) shr 8;
763 if v > 255 then v := 255;
764 result := v;
765 end;
766end;
767
768function TBGRAMaterial3D.GetDiffuseColor: TBGRAPixel;
769begin
770 result := ColorIntToBGRA(FDiffuseColorInt,True);
771end;
772
773function TBGRAMaterial3D.GetDiffuseColorF: TColorF;
774begin
775 result := ColorInt65536ToColorF(FDiffuseColorInt);
776end;
777
778function TBGRAMaterial3D.GetDiffuseColorInt: TColorInt65536;
779begin
780 result := FDiffuseColorInt;
781end;
782
783function TBGRAMaterial3D.GetLightThroughFactor: single;
784begin
785 result := FLightThroughFactor;
786end;
787
788function TBGRAMaterial3D.GetSpecularColor: TBGRAPixel;
789begin
790 result := ColorIntToBGRA(FSpecularColorInt,True);
791end;
792
793function TBGRAMaterial3D.GetSpecularColorF: TColorF;
794begin
795 result := ColorInt65536ToColorF(FSpecularColorInt);
796end;
797
798function TBGRAMaterial3D.GetSpecularColorInt: TColorInt65536;
799begin
800 result := FSpecularColorInt;
801end;
802
803function TBGRAMaterial3D.GetSpecularIndex: integer;
804begin
805 result := FSpecularIndex;
806end;
807
808function TBGRAMaterial3D.GetSaturationHigh: single;
809begin
810 result := FSaturationHighF;
811end;
812
813function TBGRAMaterial3D.GetSaturationLow: single;
814begin
815 result := FSaturationLowF;
816end;
817
818function TBGRAMaterial3D.GetSimpleAlpha: byte;
819begin
820 result := (GetAmbiantAlpha + GetDiffuseAlpha) shr 1;
821end;
822
823function TBGRAMaterial3D.GetSimpleColor: TBGRAPixel;
824begin
825 result := ColorIntToBGRA(GetSimpleColorInt,True);
826end;
827
828function TBGRAMaterial3D.GetSimpleColorF: TColorF;
829begin
830 result := ColorInt65536ToColorF(GetSimpleColorInt);
831end;
832
833function TBGRAMaterial3D.GetSimpleColorInt: TColorInt65536;
834begin
835 result := (GetAmbiantColorInt + GetDiffuseColorInt)*32768;
836end;
837
838function TBGRAMaterial3D.GetTexture: IBGRAScanner;
839begin
840 result := FTexture;
841end;
842
843function TBGRAMaterial3D.GetTextureZoom: TPointF;
844begin
845 result := FTextureZoom;
846end;
847
848procedure TBGRAMaterial3D.SetAutoAmbiantColor(const AValue: boolean);
849begin
850 If AValue then
851 SetAmbiantColorInt(ColorInt65536(65536,65536,65536));
852end;
853
854procedure TBGRAMaterial3D.SetAutoDiffuseColor(const AValue: boolean);
855begin
856 If AValue then
857 SetDiffuseColorInt(ColorInt65536(65536,65536,65536));
858end;
859
860procedure TBGRAMaterial3D.SetAutoSpecularColor(const AValue: boolean);
861begin
862 If AValue then
863 SetSpecularColorInt(ColorInt65536(65536,65536,65536));
864end;
865
866procedure TBGRAMaterial3D.SetAmbiantAlpha(AValue: byte);
867begin
868 if AValue = 0 then
869 FAmbiantColorInt.a := 0
870 else
871 FAmbiantColorInt.a := AValue*257+1;
872 UpdateSimpleColor;
873end;
874
875procedure TBGRAMaterial3D.SetAmbiantColor(const AValue: TBGRAPixel);
876begin
877 FAmbiantColorInt := BGRAToColorInt(AValue,True);
878 FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536);
879 UpdateSimpleColor;
880end;
881
882procedure TBGRAMaterial3D.SetAmbiantColorF(const AValue: TColorF);
883begin
884 FAmbiantColorInt := ColorFToColorInt65536(AValue);
885 FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536);
886 UpdateSimpleColor;
887end;
888
889procedure TBGRAMaterial3D.SetAmbiantColorInt(const AValue: TColorInt65536);
890begin
891 FAmbiantColorInt := AValue;
892 FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536);
893 UpdateSimpleColor;
894end;
895
896procedure TBGRAMaterial3D.SetDiffuseColor(const AValue: TBGRAPixel);
897begin
898 FDiffuseColorInt := BGRAToColorInt(AValue,True);
899 FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6;
900 FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536);
901 UpdateSimpleColor;
902end;
903
904procedure TBGRAMaterial3D.SetDiffuseColorF(const AValue: TColorF);
905begin
906 FDiffuseColorInt := ColorFToColorInt65536(AValue);
907 FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6;
908 FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536);
909 UpdateSimpleColor;
910end;
911
912procedure TBGRAMaterial3D.SetDiffuseColorInt(const AValue: TColorInt65536);
913begin
914 FDiffuseColorInt := AValue;
915 FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6;
916 FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536);
917 UpdateSimpleColor;
918end;
919
920procedure TBGRAMaterial3D.SetLightThroughFactor(const AValue: single);
921begin
922 FLightThroughFactor:= AValue;
923end;
924
925procedure TBGRAMaterial3D.SetSpecularColor(const AValue: TBGRAPixel);
926begin
927 FSpecularColorInt := BGRAToColorInt(AValue,True);
928 UpdateSpecular;
929end;
930
931procedure TBGRAMaterial3D.SetSpecularColorF(const AValue: TColorF);
932begin
933 FSpecularColorInt := ColorFToColorInt65536(AValue);
934 UpdateSpecular;
935end;
936
937procedure TBGRAMaterial3D.SetSpecularColorInt(const AValue: TColorInt65536);
938begin
939 FSpecularColorInt := AValue;
940 UpdateSpecular;
941end;
942
943procedure TBGRAMaterial3D.SetSpecularIndex(const AValue: integer);
944begin
945 FSpecularIndex := AValue;
946 UpdateSpecular;
947
948 FPowerTable := nil;
949end;
950
951procedure TBGRAMaterial3D.SetSaturationHigh(const AValue: single);
952begin
953 FSaturationHighF:= AValue;
954end;
955
956procedure TBGRAMaterial3D.SetSaturationLow(const AValue: single);
957begin
958 FSaturationLowF:= AValue;
959end;
960
961procedure TBGRAMaterial3D.SetSimpleAlpha(AValue: byte);
962begin
963 SetAmbiantAlpha(AValue);
964 SetDiffuseAlpha(AValue);
965end;
966
967procedure TBGRAMaterial3D.SetSimpleColor(AValue: TBGRAPixel);
968begin
969 SetAmbiantColor(AValue);
970 SetDiffuseColor(AValue);
971end;
972
973procedure TBGRAMaterial3D.SetSimpleColorF(AValue: TColorF);
974begin
975 SetAmbiantColorF(AValue);
976 SetDiffuseColorF(AValue);
977end;
978
979procedure TBGRAMaterial3D.SetSimpleColorInt(AValue: TColorInt65536);
980begin
981 SetAmbiantColorInt(AValue);
982 SetDiffuseColorInt(AValue);
983end;
984
985procedure TBGRAMaterial3D.SetTexture(AValue: IBGRAScanner);
986begin
987 If AValue <> FTexture then
988 begin
989 FTexture := AValue;
990 if Assigned(FOnTextureChanged) then
991 FOnTextureChanged(self);
992 end;
993end;
994
995procedure TBGRAMaterial3D.SetTextureZoom(AValue: TPointF);
996begin
997 if AValue <> FTextureZoom then
998 begin
999 FTextureZoom := AValue;
1000 if Assigned(FOnTextureChanged) then
1001 FOnTextureChanged(self);
1002 end;
1003end;
1004
1005function TBGRAMaterial3D.GetName: string;
1006begin
1007 result := FName;
1008end;
1009
1010procedure TBGRAMaterial3D.SetName(const AValue: string);
1011begin
1012 FName := AValue;
1013end;
1014
1015function TBGRAMaterial3D.GetSpecularOn: boolean;
1016begin
1017 result := FSpecularOn;
1018end;
1019
1020function TBGRAMaterial3D.GetAsObject: TObject;
1021begin
1022 result := self;
1023end;
1024
1025procedure TBGRAMaterial3D.ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext; DiffuseIntensity, SpecularIntensity, SpecularCosine: single; const ALightColor: TColorInt65536);
1026var
1027 NH,PowerTablePos: single; //keep first for asm
1028
1029 NnH: single;
1030 PowerTableFPos: single;
1031 PowerTableIPos,i: NativeInt;
1032begin
1033 if SpecularCosine <= 0 then
1034 NnH := 0
1035 else
1036 if SpecularCosine >= 1 then
1037 NnH := 1 else
1038 begin
1039 NH := SpecularCosine;
1040 if FPowerTable = nil then ComputePowerTable;
1041 {$IFDEF CPUI386} {$asmmode intel}
1042 i := FPowerTableExp2;
1043 if i > 0 then
1044 begin
1045 PowerTablePos := FPowerTableSize;
1046 asm
1047 db $d9,$45,$f0 //flds NH
1048 mov ecx,i
1049 @loop:
1050 db $dc,$c8 //fmul st,st(0)
1051 dec ecx
1052 jnz @loop
1053 db $d8,$4d,$ec //fmuls PowerTablePos
1054 db $d9,$5d,$ec //fstps PowerTablePos
1055 end;
1056 end
1057 else
1058 PowerTablePos := NH*FPowerTableSize;
1059 {$ELSE}
1060 PowerTablePos := NH;
1061 for i := FPowerTableExp2-1 downto 0 do
1062 PowerTablePos := PowerTablePos*PowerTablePos;
1063 PowerTablePos *= FPowerTableSize;
1064 {$ENDIF}
1065 PowerTableIPos := round(PowerTablePos+0.5);
1066 PowerTableFPos := PowerTablePos-PowerTableIPos;
1067 NnH := FPowerTable[PowerTableIPos]*(1-PowerTableFPos)+FPowerTable[PowerTableIPos+1]*PowerTableFPos;
1068 end; //faster than NnH := exp(FSpecularIndex*ln(NH)); !
1069
1070 if FAutoDiffuseColor then
1071 Context^.diffuseColor += ALightColor*round(DiffuseIntensity*65536)
1072 else
1073 Context^.diffuseColor += ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536);
1074
1075 if FAutoSpecularColor then
1076 Context^.specularColor += ALightColor*round(SpecularIntensity* NnH*65536)
1077 else
1078 Context^.specularColor += ALightColor*FSpecularColorInt*round(SpecularIntensity* NnH*65536);
1079end;
1080
1081procedure TBGRAMaterial3D.ComputeDiffuseColor(Context: PSceneLightingContext;
1082 const DiffuseIntensity: single; const ALightColor: TColorInt65536);
1083begin
1084 if FAutoDiffuseColor then
1085 Context^.diffuseColor += ALightColor*round(DiffuseIntensity*65536)
1086 else
1087 Context^.diffuseColor += ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536);
1088end;
1089
1090procedure TBGRAMaterial3D.ComputeDiffuseLightness(
1091 Context: PSceneLightingContext; DiffuseLightnessTerm32768: integer; ALightLightness: integer);
1092begin
1093 if FAutoDiffuseColor then
1094 begin
1095 if ALightLightness <> 32768 then
1096 Context^.lightness += CombineLightness(DiffuseLightnessTerm32768,ALightLightness)
1097 else
1098 Context^.lightness += DiffuseLightnessTerm32768;
1099 end else
1100 begin
1101 if FDiffuseLightness <> 32768 then
1102 Context^.lightness += CombineLightness(DiffuseLightnessTerm32768,CombineLightness(FDiffuseLightness,ALightLightness))
1103 else
1104 Context^.lightness += CombineLightness(DiffuseLightnessTerm32768,ALightLightness);
1105 end;
1106end;
1107
1108{ TBGRALight3D }
1109
1110constructor TBGRALight3D.Create;
1111begin
1112 SetColorF(ColorF(1,1,1,1));
1113 FViewVector := Point3D_128(0,0,-1);
1114 FMinIntensity:= 0;
1115end;
1116
1117destructor TBGRALight3D.Destroy;
1118begin
1119 inherited Destroy;
1120end;
1121
1122procedure TBGRALight3D.ReleaseInterface;
1123begin
1124 _Release;
1125end;
1126
1127function TBGRALight3D.GetLightnessF: single;
1128begin
1129 result := FLightness/32768;
1130end;
1131
1132function TBGRALight3D.GetColor: TBGRAPixel;
1133begin
1134 result := ColorIntToBGRA(FColorInt,True);
1135end;
1136
1137function TBGRALight3D.GetColorF: TColorF;
1138begin
1139 result := ColorInt65536ToColorF(FColorInt);
1140end;
1141
1142function TBGRALight3D.GetColorInt: TColorInt65536;
1143begin
1144 result := FColorInt;
1145end;
1146
1147function TBGRALight3D.GetAsObject: TObject;
1148begin
1149 result := self;
1150end;
1151
1152procedure TBGRALight3D.SetColor(const AValue: TBGRAPixel);
1153begin
1154 SetColorInt(BGRAToColorInt(AValue,True));
1155end;
1156
1157procedure TBGRALight3D.SetColorF(const AValue: TColorF);
1158begin
1159 SetColorInt(ColorFToColorInt65536(AValue));
1160end;
1161
1162procedure TBGRALight3D.SetColorInt(const AValue: TColorInt65536);
1163begin
1164 FColorInt := AValue;
1165 FLightness:= (AValue.r+AValue.g+AValue.b) div 6;
1166end;
1167
1168function TBGRALight3D.GetColoredLight: boolean;
1169begin
1170 result := (FColorInt.r <> FColorInt.g) or (FColorInt.g <> FColorInt.b);
1171end;
1172
1173function TBGRALight3D.GetMinIntensity: single;
1174begin
1175 result := FMinIntensity;
1176end;
1177
1178procedure TBGRALight3D.SetMinIntensity(const AValue: single);
1179begin
1180 FMinIntensity := AValue;
1181end;
1182
1183function TBGRALight3D.GetIntensity: single;
1184begin
1185 result := 1;
1186end;
1187
1188function TBGRALight3D.GetPosition: TPoint3D;
1189begin
1190 result := Point3D(0,0,0);
1191end;
1192
1193function TBGRALight3D.GetDirection: TPoint3D;
1194begin
1195 result := Point3D(0,0,0);
1196end;
1197
1198end.
Note: See TracBrowser for help on using the repository browser.