source: trunk/Packages/bgrabitmap/polyaliaspersp.inc

Last change on this file was 2, checked in by chronos, 6 years ago
File size: 22.9 KB
Line 
1{*****************************************TEXTURE WITHOUT SHADING *********************************}
2{with shading: second part of this file}
3
4{ TPolygonPerspectiveTextureMappingInfo }
5
6procedure TPolygonPerspectiveTextureMappingInfo.SetIntersectionValues(
7 AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
8 dy: single; AData: pointer);
9var info: PPerspectiveTextureInfo;
10begin
11 AInter.SetValues(AInterX,AWinding,ANumSegment);
12 info := PPerspectiveTextureInfo(AData);
13 TPerspectiveTextureMappingIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ;
14 TPerspectiveTextureMappingIntersectionInfo(AInter).texCoordDivByZ := info^.TexCoordDivByZ + info^.TexCoordDivByZSlopes*dy;
15 if FLightnesses<>nil then
16 TPerspectiveTextureMappingIntersectionInfo(AInter).lightness := round(info^.lightness + info^.lightnessSlope*dy)
17 else
18 TPerspectiveTextureMappingIntersectionInfo(AInter).lightness := 32768;
19end;
20
21constructor TPolygonPerspectiveTextureMappingInfo.Create(
22 const points: array of TPointF; const pointsZ: array of single;
23 const texCoords: array of TPointF);
24var
25 i: Integer;
26 lPoints: array of TPointF;
27 nbP: integer;
28begin
29 if (length(texCoords) <> length(points)) or (length(pointsZ) <> length(points)) then
30 raise Exception.Create('Dimensions mismatch');
31
32 setlength(lPoints, length(points));
33 SetLength(FTexCoords, length(points));
34 SetLength(FPointsZ, length(points));
35 nbP := 0;
36 for i := 0 to high(points) do
37 if (i=0) or (points[i].x<>points[i-1].X) or (points[i].y<>points[i-1].y) then
38 begin
39 lPoints[nbP] := points[i];
40 FTexCoords[nbP] := texCoords[i];
41 FPointsZ[nbP] := abs(pointsZ[i]);
42 inc(nbP);
43 end;
44 if (nbP>0) and (lPoints[nbP-1].X = lPoints[0].X) and (lPoints[nbP-1].Y = lPoints[0].Y) then dec(NbP);
45 setlength(lPoints, nbP);
46 SetLength(FTexCoords, nbP);
47 SetLength(FPointsZ, nbP);
48
49 inherited Create(lPoints);
50end;
51
52constructor TPolygonPerspectiveTextureMappingInfo.Create(
53 const points: array of TPointF; const pointsZ: array of single;
54 const texCoords: array of TPointF; const lightnesses: array of word);
55var
56 i: Integer;
57 lPoints: array of TPointF;
58 nbP: integer;
59begin
60 if (length(texCoords) <> length(points)) or (length(pointsZ) <> length(points)) or
61 (length(lightnesses) <> length(points)) then
62 raise Exception.Create('Dimensions mismatch');
63
64 setlength(lPoints, length(points));
65 SetLength(FTexCoords, length(points));
66 SetLength(FPointsZ, length(points));
67 setLength(FLightnesses, length(points));
68 nbP := 0;
69 for i := 0 to high(points) do
70 if (i=0) or (points[i].x<>points[i-1].X) or (points[i].y<>points[i-1].y) then
71 begin
72 lPoints[nbP] := points[i];
73 FTexCoords[nbP] := texCoords[i];
74 FPointsZ[nbP] := abs(pointsZ[i]);
75 FLightnesses[nbP] := lightnesses[i];
76 inc(nbP);
77 end;
78 if (nbP>0) and (lPoints[nbP-1].X = lPoints[0].X) and (lPoints[nbP-1].Y = lPoints[0].Y) then dec(NbP);
79 setlength(lPoints, nbP);
80 SetLength(FTexCoords, nbP);
81 SetLength(FPointsZ, nbP);
82 SetLength(FLightnesses, nbP);
83
84 inherited Create(lPoints);
85end;
86
87{$hints off}
88
89function TPolygonPerspectiveTextureMappingInfo.CreateSegmentData(numPt,
90 nextPt: integer; x, y: single): pointer;
91var
92 info: PPerspectiveTextureInfo;
93 ty,dy: single;
94 CurInvZ,NextInvZ: single;
95 CurTexCoordDivByZ: TPointF;
96 NextTexCoordDivByZ: TPointF;
97begin
98 New(info);
99 CurInvZ := 1/FPointsZ[numPt];
100 CurTexCoordDivByZ := FTexCoords[numPt]*CurInvZ;
101 NextInvZ := 1/FPointsZ[nextPt];
102 NextTexCoordDivByZ := FTexCoords[nextPt]*NextInvZ;
103 ty := FPoints[nextPt].y-FPoints[numPt].y;
104 info^.TexCoordDivByZSlopes := (NextTexCoordDivByZ - CurTexCoordDivByZ)*(1/ty);
105 dy := y-FPoints[numPt].y;
106 info^.TexCoordDivByZ := CurTexCoordDivByZ + info^.TexCoordDivByZSlopes*dy;
107 info^.InvZSlope := (NextInvZ-CurInvZ)/ty;
108 info^.InvZ := CurInvZ+dy*info^.InvZSlope;
109 if FLightnesses <> nil then
110 begin
111 info^.lightnessSlope := (FLightnesses[nextPt] - FLightnesses[numPt])*(1/ty);
112 info^.lightness := FLightnesses[numPt] + info^.lightnessSlope*dy;
113 end else
114 begin
115 info^.lightness := 32768;
116 info^.lightnessSlope := 0;
117 end;
118 Result:= info;
119end;
120{$hints on}
121
122function TPolygonPerspectiveTextureMappingInfo.CreateIntersectionInfo: TIntersectionInfo;
123begin
124 Result:= TPerspectiveTextureMappingIntersectionInfo.Create;
125end;
126
127{$hints off}
128procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap;
129 polyInfo: TPolygonPerspectiveTextureMappingInfo; texture: IBGRAScanner;
130 TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle);
131var
132 inter: array of TIntersectionInfo;
133 nbInter: integer;
134
135 scanAtFunc: TScanAtFunction;
136 scanAtIntegerFunc: TScanAtIntegerFunction;
137
138 procedure DrawTextureLineWithoutLight(yb: integer; ix1: integer; ix2: integer;
139 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
140 {$i perspectivescan.inc}
141
142 procedure DrawTextureLineWithLight(yb: integer; ix1: integer; ix2: integer;
143 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
144 {$define PARAM_USELIGHTING}
145 {$i perspectivescan.inc}
146
147 procedure DrawTextureLineWithoutLightZBuffer(yb: integer; ix1: integer; ix2: integer;
148 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
149 {$define PARAM_USEZBUFFER}
150 {$i perspectivescan.inc}
151
152 procedure DrawTextureLineWithLightZBuffer(yb: integer; ix1: integer; ix2: integer;
153 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
154 {$define PARAM_USEZBUFFER}
155 {$define PARAM_USELIGHTING}
156 {$i perspectivescan.inc}
157
158var
159 miny, maxy, minx, maxx: integer;
160
161 yb, i : integer;
162 x1, x2: single;
163
164 ix1, ix2: integer;
165
166begin
167 If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
168
169 inter := polyInfo.CreateIntersectionArray;
170 scanAtFunc := @texture.ScanAt;
171 scanAtIntegerFunc := @texture.ScanAtInteger;
172
173 if zbuffer = nil then
174 begin
175 //vertical scan
176 for yb := miny to maxy do
177 begin
178 //find intersections
179 polyInfo.ComputeAndSort(yb+0.5001,inter,nbInter,NonZeroWinding);
180
181 for i := 0 to nbinter div 2 - 1 do
182 begin
183 x1 := inter[i + i].interX;
184 x2 := inter[i + i+ 1].interX;
185
186 if x1 <> x2 then
187 begin
188 ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2);
189 if ix1 <= ix2 then
190 begin
191 if (TPerspectiveTextureMappingIntersectionInfo(inter[i+i]).lightness = 32768) and
192 (TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]).lightness = 32768) then
193 DrawTextureLineWithoutLight(yb,ix1,ix2,
194 TPerspectiveTextureMappingIntersectionInfo(inter[i+i]),
195 TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]),
196 TextureInterpolation)
197 else
198 DrawTextureLineWithLight(yb,ix1,ix2,
199 TPerspectiveTextureMappingIntersectionInfo(inter[i+i]),
200 TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]),
201 TextureInterpolation);
202 end;
203 end;
204 end;
205 end;
206 end else
207 begin
208 //vertical scan
209 for yb := miny to maxy do
210 begin
211 //find intersections
212 polyInfo.ComputeAndSort(yb+0.5001,inter,nbInter,NonZeroWinding);
213
214 for i := 0 to nbinter div 2 - 1 do
215 begin
216 x1 := inter[i + i].interX;
217 x2 := inter[i + i+ 1].interX;
218
219 if x1 <> x2 then
220 begin
221 ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2);
222 if ix1 <= ix2 then
223 begin
224 if (TPerspectiveTextureMappingIntersectionInfo(inter[i+i]).lightness = 32768) and
225 (TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]).lightness = 32768) then
226 DrawTextureLineWithoutLightZBuffer(yb,ix1,ix2,
227 TPerspectiveTextureMappingIntersectionInfo(inter[i+i]),
228 TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]),
229 TextureInterpolation)
230 else
231 DrawTextureLineWithLightZBuffer(yb,ix1,ix2,
232 TPerspectiveTextureMappingIntersectionInfo(inter[i+i]),
233 TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]),
234 TextureInterpolation);
235 end;
236 end;
237 end;
238 end;
239 end;
240
241 polyInfo.FreeIntersectionArray(inter);
242 bmp.InvalidateBitmap;
243end;
244{$hints on}
245
246procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap;
247 const points: array of TPointF; const pointsZ: array of single;
248 texture: IBGRAScanner; const texCoords: array of TPointF;
249 TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle);
250var polyInfo: TPolygonPerspectiveTextureMappingInfo;
251begin
252 polyInfo := TPolygonPerspectiveTextureMappingInfo.Create(points,pointsZ,texCoords);
253 PolygonPerspectiveTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation, NonZeroWinding, zbuffer);
254 polyInfo.Free;
255end;
256
257procedure PolygonPerspectiveTextureMappingAliasedWithLightness(
258 bmp: TBGRACustomBitmap; const points: array of TPointF;
259 const pointsZ: array of single; texture: IBGRAScanner;
260 const texCoords: array of TPointF; TextureInterpolation: Boolean;
261 lightnesses: array of word; NonZeroWinding: boolean; zbuffer: psingle);
262var polyInfo: TPolygonPerspectiveTextureMappingInfo;
263begin
264 polyInfo := TPolygonPerspectiveTextureMappingInfo.Create(points,pointsZ,texCoords,lightnesses);
265 PolygonPerspectiveTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation, NonZeroWinding, zbuffer);
266 polyInfo.Free;
267end;
268
269{****************************************** WITH SHADING ******************************************}
270
271{$hints off}
272procedure PolygonPerspectiveMappingShaderAliased_DrawTextureLine(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext;
273 solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle;
274 yb: integer; ix1: integer; ix2: integer;
275 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
276 {$define PARAM_USESHADER}
277 {$i perspectivescan.inc}
278
279procedure PolygonPerspectiveMappingShaderAliased_DrawSolidColorLine(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext;
280 solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle;
281 yb: integer; ix1: integer; ix2: integer;
282 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
283 {$define PARAM_USESOLIDCOLOR}
284 {$define PARAM_USESHADER}
285 {$i perspectivescan.inc}
286
287procedure PolygonPerspectiveMappingShaderAliased_DrawTextureLineZBuffer(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext;
288 solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle;
289 yb: integer; ix1: integer; ix2: integer;
290 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
291 {$define PARAM_USESHADER}
292 {$define PARAM_USEZBUFFER}
293 {$i perspectivescan.inc}
294
295procedure PolygonPerspectiveMappingShaderAliased_DrawSolidColorLineZBuffer(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext;
296 solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle;
297 yb: integer; ix1: integer; ix2: integer;
298 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
299 {$define PARAM_USESOLIDCOLOR}
300 {$define PARAM_USESHADER}
301 {$define PARAM_USEZBUFFER}
302 {$i perspectivescan.inc}
303
304procedure PolygonPerspectiveMappingAliased_DrawTextureLine(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext;
305 solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle;
306 yb: integer; ix1: integer; ix2: integer;
307 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
308 {$i perspectivescan.inc}
309
310procedure PolygonPerspectiveMappingAliased_DrawSolidColorLine(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext;
311 solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle;
312 yb: integer; ix1: integer; ix2: integer;
313 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
314 {$define PARAM_USESOLIDCOLOR}
315 {$i perspectivescan.inc}
316
317procedure PolygonPerspectiveMappingAliased_DrawTextureLineZBuffer(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext;
318 solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle;
319 yb: integer; ix1: integer; ix2: integer;
320 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
321 {$define PARAM_USEZBUFFER}
322 {$i perspectivescan.inc}
323
324procedure PolygonPerspectiveMappingAliased_DrawSolidColorLineZBuffer(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext;
325 solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle;
326 yb: integer; ix1: integer; ix2: integer;
327 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
328 {$define PARAM_USESOLIDCOLOR}
329 {$define PARAM_USEZBUFFER}
330 {$i perspectivescan.inc}
331{$hints on}
332
333{$hints off}
334procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap;
335 polyInfo: TPolygonPerspectiveMappingShaderInfo; texture: IBGRAScanner;
336 TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D;
337 NonZeroWinding: boolean; solidColor: TBGRAPixel; zbuffer: psingle; ShaderContext: PBasicLightingContext);
338var
339 inter: array of TIntersectionInfo;
340 nbInter: integer;
341
342 scanAtFunc: TScanAtFunction;
343 scanAtIntegerFunc: TScanAtIntegerFunction;
344
345 drawFunc : procedure(bmp: TBGRACustomBitmap; ShaderFunction: TShaderFunction3D; ShaderContext: PBasicLightingContext;
346 solidColor: TBGRAPixel; scanAtFunc: TScanAtFunction; scanAtIntegerFunc: TScanAtIntegerFunction; zbuffer: psingle;
347 yb: integer; ix1: integer; ix2: integer;
348 info1, info2 : TPerspectiveTextureMappingIntersectionInfo; WithInterpolation: boolean);
349
350var
351 miny, maxy, minx, maxx: integer;
352
353 yb, i : integer;
354 x1, x2: single;
355
356 ix1, ix2: integer;
357 shaderContextMem: TMemoryBlockAlign128;
358 shaderContextPtr: PBasicLightingContext;
359
360 inter1,inter2: TPerspectiveTextureMappingIntersectionInfo;
361
362begin
363 If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
364
365 inter := polyInfo.CreateIntersectionArray;
366
367 if texture <> nil then
368 begin
369 scanAtFunc := @texture.ScanAt;
370 scanAtIntegerFunc := @texture.ScanAtInteger;
371 end else
372 begin
373 scanAtFunc := nil;
374 scanAtIntegerFunc := nil;
375 end;
376
377 shaderContextMem := nil;
378 shaderContextPtr := nil;
379
380 if ShaderFunction <> nil then
381 begin
382 if ShaderContext = nil then
383 begin
384 shaderContextMem := TMemoryBlockAlign128.Create(sizeof(TBasicLightingContext));
385 shaderContextPtr := PBasicLightingContext( shaderContextMem.Data);
386 end
387 else
388 shaderContextPtr := shaderContext;
389 if texture <> nil then
390 begin
391 if zbuffer = nil then
392 drawFunc := @PolygonPerspectiveMappingShaderAliased_DrawTextureLine
393 else
394 drawFunc := @PolygonPerspectiveMappingShaderAliased_DrawTextureLineZBuffer;
395 end
396 else
397 begin
398 if zbuffer = nil then
399 drawFunc := @PolygonPerspectiveMappingShaderAliased_DrawSolidColorLine
400 else
401 drawFunc := @PolygonPerspectiveMappingShaderAliased_DrawSolidColorLineZBuffer;
402 end;
403 end else
404 begin
405 if texture <> nil then
406 begin
407 if zbuffer = nil then
408 drawFunc := @PolygonPerspectiveMappingAliased_DrawTextureLine
409 else
410 drawFunc := @PolygonPerspectiveMappingAliased_DrawTextureLineZBuffer;
411 end
412 else
413 begin
414 if zbuffer = nil then
415 drawFunc := @PolygonPerspectiveMappingAliased_DrawSolidColorLine
416 else
417 drawFunc := @PolygonPerspectiveMappingAliased_DrawSolidColorLineZBuffer;
418 end;
419 end;
420
421 //vertical scan
422 for yb := miny to maxy do
423 begin
424 //find intersections
425 polyInfo.ComputeAndSort(yb+0.5001,inter,nbInter,NonZeroWinding);
426
427 for i := 0 to nbinter div 2 - 1 do
428 begin
429 inter1 := TPerspectiveTextureMappingIntersectionInfo(inter[i+i]);
430 inter2 := TPerspectiveTextureMappingIntersectionInfo(inter[i+i+1]);
431 x1 := inter1.interX;
432 x2 := inter2.interX;
433
434 if x1 <> x2 then
435 begin
436 ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2);
437 if ix1 <= ix2 then
438 begin
439 drawFunc(bmp,ShaderFunction,shaderContextPtr,
440 solidColor,scanAtFunc,scanAtIntegerFunc,zbuffer,
441 yb,ix1,ix2,
442 inter1,inter2,TextureInterpolation);
443 end;
444 end;
445 end;
446 end;
447
448 polyInfo.FreeIntersectionArray(inter);
449 bmp.InvalidateBitmap;
450 shaderContextMem.Free;
451end;
452{$hints on}
453
454procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap;
455 const points: array of TPointF; const points3D: array of TPoint3D;
456 const normals: array of TPoint3D; texture: IBGRAScanner;
457 const texCoords: array of TPointF; TextureInterpolation: Boolean;
458 ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean; solidColor: TBGRAPixel; zbuffer: psingle; ShaderContext: PBasicLightingContext);
459var polyInfo: TPolygonPerspectiveMappingShaderInfo;
460begin
461 polyInfo := TPolygonPerspectiveMappingShaderInfo.Create(points,points3D,normals,texCoords);
462 PolygonPerspectiveMappingShaderAliased(bmp,polyInfo,texture,TextureInterpolation, ShaderFunction, NonZeroWinding, solidColor, zbuffer, ShaderContext);
463 polyInfo.Free;
464end;
465
466procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap;
467 const points: array of TPointF; const points3D: array of TPoint3D_128;
468 const normals: array of TPoint3D_128; texture: IBGRAScanner;
469 const texCoords: array of TPointF; TextureInterpolation: Boolean;
470 ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean;
471 solidColor: TBGRAPixel; zbuffer: psingle; ShaderContext: PBasicLightingContext);
472var polyInfo: TPolygonPerspectiveMappingShaderInfo;
473begin
474 polyInfo := TPolygonPerspectiveMappingShaderInfo.Create(points,points3D,normals,texCoords);
475 PolygonPerspectiveMappingShaderAliased(bmp,polyInfo,texture,TextureInterpolation, ShaderFunction, NonZeroWinding, solidColor, zbuffer, ShaderContext);
476 polyInfo.Free;
477end;
478
479{ TPolygonPerspectiveMappingShaderInfo }
480
481procedure TPolygonPerspectiveMappingShaderInfo.SetIntersectionValues(
482 AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
483 dy: single; AData: pointer);
484var info : PPerspectiveTextureInfo;
485begin
486 AInter.SetValues(AInterX,AWinding,ANumSegment);
487 info := PPerspectiveTextureInfo(AData);
488 TPerspectiveTextureMappingIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ;
489 TPerspectiveTextureMappingIntersectionInfo(AInter).texCoordDivByZ := info^.TexCoordDivByZ + info^.TexCoordDivByZSlopes*dy;
490 TPerspectiveTextureMappingIntersectionInfo(AInter).Position3D := info^.Position3D + info^.Position3DSlope*dy;
491 TPerspectiveTextureMappingIntersectionInfo(AInter).Normal3D := info^.Normal3D + info^.Normal3DSlope*dy;
492end;
493
494constructor TPolygonPerspectiveMappingShaderInfo.Create(
495 const points: array of TPointF; const points3D: array of TPoint3D;
496 const normals: array of TPoint3D; const texCoords: array of TPointF);
497var
498 i: Integer;
499 lPoints: array of TPointF;
500 nbP: integer;
501begin
502 if (length(texCoords) <> length(points)) or (length(points3D) <> length(points)) or (length(normals) <> length(points)) then
503 raise Exception.Create('Dimensions mismatch');
504
505 setlength(lPoints, length(points));
506 SetLength(FTexCoords, length(points));
507 SetLength(FPositions3D, length(points));
508 SetLength(FNormals3D, length(points));
509 nbP := 0;
510 for i := 0 to high(points) do
511 if (i=0) or (points[i]<>points[i-1]) then
512 begin
513 lPoints[nbP] := points[i];
514 FTexCoords[nbP] := texCoords[i];
515 FPositions3D[nbP] := Point3D_128(points3D[i]);
516 FNormals3D[nbP] := Point3D_128(normals[i]);
517 inc(nbP);
518 end;
519 if (nbP>0) and (lPoints[nbP-1].X = lPoints[0].X) and (lPoints[nbP-1].Y = lPoints[0].Y) then dec(NbP);
520 setlength(lPoints, nbP);
521 SetLength(FTexCoords, nbP);
522 SetLength(FPositions3D, nbP);
523 SetLength(FNormals3D, nbP);
524
525 inherited Create(lPoints);
526end;
527
528constructor TPolygonPerspectiveMappingShaderInfo.Create(
529 const points: array of TPointF; const points3D: array of TPoint3D_128;
530 const normals: array of TPoint3D_128; const texCoords: array of TPointF);
531var
532 i: Integer;
533 lPoints: array of TPointF;
534 nbP: integer;
535begin
536 if (length(texCoords) <> length(points)) or (length(points3D) <> length(points)) or (length(normals) <> length(points)) then
537 raise Exception.Create('Dimensions mismatch');
538
539 setlength(lPoints, length(points));
540 SetLength(FTexCoords, length(points));
541 SetLength(FPositions3D, length(points));
542 SetLength(FNormals3D, length(points));
543 nbP := 0;
544 for i := 0 to high(points) do
545 if (i=0) or (points[i]<>points[i-1]) then
546 begin
547 lPoints[nbP] := points[i];
548 FTexCoords[nbP] := texCoords[i];
549 FPositions3D[nbP] := points3D[i];
550 FNormals3D[nbP] := normals[i];
551 inc(nbP);
552 end;
553 if (nbP>0) and (lPoints[nbP-1].X = lPoints[0].X) and (lPoints[nbP-1].Y = lPoints[0].Y) then dec(NbP);
554 setlength(lPoints, nbP);
555 SetLength(FTexCoords, nbP);
556 SetLength(FPositions3D, nbP);
557 SetLength(FNormals3D, nbP);
558
559 inherited Create(lPoints);
560end;
561
562{$hints off}
563function TPolygonPerspectiveMappingShaderInfo.CreateSegmentData(numPt,
564 nextPt: integer; x, y: single): pointer;
565var
566 info: PPerspectiveTextureInfo;
567 ty,dy: single;
568 CurInvZ,NextInvZ: single;
569 CurTexCoordDivByZ: TPointF;
570 NextTexCoordDivByZ: TPointF;
571
572 Cur3DDivByZ,Next3DDivByZ: TPoint3D_128;
573begin
574 New(info);
575 CurInvZ := FPositions3D[numPt].z;
576 if CurInvZ = 0 then CurInvZ := 1 else CurInvZ := 1/CurInvZ;
577 CurTexCoordDivByZ := FTexCoords[numPt]*CurInvZ;
578 NextInvZ := FPositions3D[nextPt].z;
579 if NextInvZ = 0 then NextInvZ := 1 else NextInvZ := 1/NextInvZ;
580 NextTexCoordDivByZ := FTexCoords[nextPt]*NextInvZ;
581 ty := FPoints[nextPt].y-FPoints[numPt].y;
582 info^.TexCoordDivByZSlopes := (NextTexCoordDivByZ - CurTexCoordDivByZ)*(1/ty);
583 dy := y-FPoints[numPt].y;
584 info^.TexCoordDivByZ := CurTexCoordDivByZ + info^.TexCoordDivByZSlopes*dy;
585 info^.InvZSlope := (NextInvZ-CurInvZ)/ty;
586 info^.InvZ := CurInvZ+dy*info^.InvZSlope;
587
588 Cur3DDivByZ := FPositions3D[numPt]*CurInvZ;
589 Next3DDivByZ := FPositions3D[nextPt]*NextInvZ;
590 info^.Position3DSlope := (Next3DDivByZ - Cur3DDivByZ)*(1/ty);
591 info^.Position3D := Cur3DDivByZ + info^.Position3DSlope*dy;
592
593 Cur3DDivByZ := FNormals3D[numPt]*CurInvZ;
594 Next3DDivByZ := FNormals3D[nextPt]*NextInvZ;
595 info^.Normal3DSlope := (Next3DDivByZ - Cur3DDivByZ)*(1/ty);
596 info^.Normal3D := Cur3DDivByZ + info^.Normal3DSlope*dy;
597
598 Result:= info;
599end;
600{$hints on}
601
602function TPolygonPerspectiveMappingShaderInfo.CreateIntersectionInfo: TIntersectionInfo;
603begin
604 Result:= TPerspectiveTextureMappingIntersectionInfo.Create;
605end;
606
Note: See TracBrowser for help on using the repository browser.