source: trunk/Packages/bgrabitmap/bgrapolygonaliased.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 33.5 KB
Line 
1unit BGRAPolygonAliased;
2
3{$mode objfpc}{$H+}
4
5{$i bgrasse.inc}
6
7interface
8
9{ This unit provides fast aliased polygon routines.
10
11 To do aliased drawing, only one line is intersected with polygons for each output scanline.
12 Along with intersection coordinates, color and texture coordinates are computed using
13 linear interpolation. Inverse values are used for projective transform. }
14
15uses
16 Classes, SysUtils, BGRABitmapTypes, BGRAFillInfo, BGRASSE;
17
18type
19 //segment information for linear color
20 TLinearColorInfo = record
21 Color, ColorSlopes: TColorF;
22 end;
23 PLinearColorInfo = ^TLinearColorInfo;
24 ArrayOfTColorF = array of TColorF;
25
26 //add a color information to intersection info
27 TLinearColorGradientIntersectionInfo = class(TIntersectionInfo)
28 Color: TColorF;
29 end;
30
31 { TPolygonLinearColorGradientInfo }
32
33 TPolygonLinearColorGradientInfo = class(TOnePassFillPolyInfo)
34 protected
35 FColors: array of TColorF;
36 procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
37 ANumSegment: integer; dy: single; AData: pointer); override;
38 public
39 constructor Create(const points: array of TPointF; const Colors: array of TBGRAPixel);
40 function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
41 function CreateIntersectionInfo: TIntersectionInfo; override;
42 end;
43
44procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonLinearColorGradientInfo;
45 NonZeroWinding: boolean); overload;
46procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap; const points: array of TPointF;
47 const Colors: array of TBGRAPixel; NonZeroWinding: boolean); overload;
48
49type
50 //segment information for linear color
51 TPerspectiveColorInfo = record
52 ColorDivZ, ColorSlopesDivZ: TColorF;
53 InvZ, InvZSlope: single;
54 end;
55 PPerspectiveColorInfo = ^TPerspectiveColorInfo;
56
57 //add a color information to intersection info
58 TPerspectiveColorGradientIntersectionInfo = class(TIntersectionInfo)
59 ColorDivZ: TColorF;
60 coordInvZ: single;
61 end;
62
63 { TPolygonPerspectiveColorGradientInfo }
64
65 TPolygonPerspectiveColorGradientInfo = class(TOnePassFillPolyInfo)
66 protected
67 FColors: array of TColorF;
68 FPointsZ: array of single;
69 procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
70 ANumSegment: integer; dy: single; AData: pointer); override;
71 public
72 constructor Create(const points: array of TPointF; const pointsZ: array of single; const Colors: array of TBGRAPixel);
73 function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
74 function CreateIntersectionInfo: TIntersectionInfo; override;
75 end;
76
77procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonPerspectiveColorGradientInfo;
78 NonZeroWinding: boolean; zbuffer: psingle = nil); overload;
79procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap; const points: array of TPointF;
80 const pointsZ: array of single; const Colors: array of TBGRAPixel; NonZeroWinding: boolean; zbuffer: psingle = nil); overload;
81
82type
83 //segment information for linear texture
84 TLinearTextureInfo = record
85 TexCoord: TPointF;
86 TexCoordSlopes: TPointF;
87 lightness: single;
88 lightnessSlope: single;
89 end;
90 PLinearTextureInfo = ^TLinearTextureInfo;
91
92 //add a texture coordinate to intersection info
93 TLinearTextureMappingIntersectionInfo = class(TIntersectionInfo)
94 texCoord: TPointF;
95 lightness: word;
96 end;
97
98 { TPolygonLinearTextureMappingInfo }
99
100 TPolygonLinearTextureMappingInfo = class(TOnePassFillPolyInfo)
101 protected
102 FTexCoords: array of TPointF;
103 FLightnesses: array of Word;
104 procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
105 ANumSegment: integer; dy: single; AData: pointer); override;
106 public
107 constructor Create(const points: array of TPointF; const texCoords: array of TPointF); overload;
108 constructor Create(const points: array of TPointF; const texCoords: array of TPointF; const lightnesses: array of word); overload;
109 function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
110 function CreateIntersectionInfo: TIntersectionInfo; override;
111 end;
112
113procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonLinearTextureMappingInfo;
114 texture: IBGRAScanner; TextureInterpolation: Boolean; NonZeroWinding: boolean); overload;
115
116procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; texture: IBGRAScanner;
117 const texCoords: array of TPointF; TextureInterpolation: Boolean; NonZeroWinding: boolean); overload;
118procedure PolygonLinearTextureMappingAliasedWithLightness(bmp: TBGRACustomBitmap; const points: array of TPointF; texture: IBGRAScanner;
119 const texCoords: array of TPointF; TextureInterpolation: Boolean; lightnesses: array of word; NonZeroWinding: boolean); overload;
120
121type
122 //segment information for perspective texture. Use inverse Z and slopes.
123 TPerspectiveTextureInfo = record
124 InvZ,InvZSlope: Single;
125 TexCoordDivByZ: TPointF;
126 TexCoordDivByZSlopes: TPointF;
127 lightness: single;
128 lightnessSlope: single;
129 Position3D, Normal3D: TPoint3D_128;
130 Position3DSlope, Normal3DSlope: TPoint3D_128;
131 end;
132 PPerspectiveTextureInfo = ^TPerspectiveTextureInfo;
133
134 //add a texture coordinate and depth to intersection info (stored as inverse)
135 TPerspectiveTextureMappingIntersectionInfo = class(TIntersectionInfo)
136 texCoordDivByZ: TPointF;
137 coordInvZ: single;
138 lightness: word;
139 Position3D, Normal3D: TPoint3D_128;
140 end;
141
142 { TPolygonPerspectiveTextureMappingInfo }
143
144 TPolygonPerspectiveTextureMappingInfo = class(TOnePassFillPolyInfo)
145 protected
146 FTexCoords: array of TPointF;
147 FPointsZ: array of single;
148 FLightnesses: array of Word;
149 procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
150 ANumSegment: integer; dy: single; AData: pointer); override;
151 public
152 constructor Create(const points: array of TPointF; const pointsZ: array of single; const texCoords: array of TPointF); overload;
153 constructor Create(const points: array of TPointF; const pointsZ: array of single; const texCoords: array of TPointF; const lightnesses: array of word); overload;
154 function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
155 function CreateIntersectionInfo: TIntersectionInfo; override;
156 end;
157
158 { TPolygonPerspectiveMappingShaderInfo }
159
160 TPolygonPerspectiveMappingShaderInfo = class(TOnePassFillPolyInfo)
161 protected
162 FTexCoords: array of TPointF;
163 FPositions3D, FNormals3D: array of TPoint3D_128;
164 procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
165 ANumSegment: integer; dy: single; AData: pointer); override;
166 public
167 constructor Create(const points: array of TPointF; const points3D: array of TPoint3D; const normals: array of TPoint3D; const texCoords: array of TPointF); overload;
168 constructor Create(const points: array of TPointF; const points3D: array of TPoint3D_128; const normals: array of TPoint3D_128; const texCoords: array of TPointF); overload;
169 function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
170 function CreateIntersectionInfo: TIntersectionInfo; override;
171 end;
172
173 TShaderFunction3D = function (Context: PBasicLightingContext; Color: TBGRAPixel): TBGRAPixel of object;
174
175procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonPerspectiveTextureMappingInfo;
176 texture: IBGRAScanner; TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle = nil); overload;
177procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner;
178 const texCoords: array of TPointF; TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle = nil); overload;
179procedure PolygonPerspectiveTextureMappingAliasedWithLightness(bmp: TBGRACustomBitmap; const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner;
180 const texCoords: array of TPointF; TextureInterpolation: Boolean; lightnesses: array of word; NonZeroWinding: boolean; zbuffer: psingle = nil); overload;
181
182procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonPerspectiveMappingShaderInfo;
183 texture: IBGRAScanner; TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean;
184 solidColor: TBGRAPixel; zbuffer: psingle = nil; ShaderContext: PBasicLightingContext= nil); overload;
185procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; const points3D: array of TPoint3D;
186 const normals: array of TPoint3D; texture: IBGRAScanner; const texCoords: array of TPointF;
187 TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean;
188 solidColor: TBGRAPixel; zbuffer: psingle = nil; ShaderContext: PBasicLightingContext= nil); overload;
189procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; const points3D: array of TPoint3D_128;
190 const normals: array of TPoint3D_128; texture: IBGRAScanner; const texCoords: array of TPointF;
191 TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean;
192 solidColor: TBGRAPixel; zbuffer: psingle = nil; ShaderContext: PBasicLightingContext= nil); overload;
193
194{ Aliased round rectangle }
195procedure BGRARoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer;
196 DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency;
197 skipFill: boolean = false);
198procedure BGRAFillRoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer;
199 DX, DY: integer; FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency);
200
201implementation
202
203uses Math, BGRABlend, BGRAPolygon;
204
205{ TPolygonPerspectiveColorGradientInfo }
206
207procedure TPolygonPerspectiveColorGradientInfo.SetIntersectionValues(
208 AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
209 dy: single; AData: pointer);
210var
211 info: PPerspectiveColorInfo;
212begin
213 AInter.SetValues(AInterX,AWinding,ANumSegment);
214 info := PPerspectiveColorInfo(AData);
215 TPerspectiveColorGradientIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ;
216 TPerspectiveColorGradientIntersectionInfo(AInter).ColorDivZ := info^.ColorDivZ + info^.ColorSlopesDivZ*dy;
217end;
218
219constructor TPolygonPerspectiveColorGradientInfo.Create(
220 const points: array of TPointF; const pointsZ: array of single;
221 const Colors: array of TBGRAPixel);
222var
223 i: Integer;
224 lPoints: array of TPointF;
225 nbP: integer;
226 ec: TExpandedPixel;
227begin
228 if (length(Colors) <> length(points)) or (length(points) <> length(pointsZ)) then
229 raise Exception.Create('Dimensions mismatch');
230
231 setlength(lPoints, length(points));
232 SetLength(FColors, length(points));
233 SetLength(FPointsZ, length(points));
234 nbP := 0;
235 for i := 0 to high(points) do
236 if (i=0) or (points[i]<>points[i-1]) then
237 begin
238 lPoints[nbP] := points[i];
239 FPointsZ[nbP] := PointsZ[i];
240 ec := GammaExpansion(Colors[i]);
241 FColors[nbP] := ColorF(ec.red,ec.green,ec.blue,ec.alpha);
242 inc(nbP);
243 end;
244 if (nbP>0) and (lPoints[nbP-1] = lPoints[0]) then dec(NbP);
245 setlength(lPoints, nbP);
246 SetLength(FPointsZ, nbP);
247 SetLength(FColors, nbP);
248
249 inherited Create(lPoints);
250end;
251
252{$hints off}
253function TPolygonPerspectiveColorGradientInfo.CreateSegmentData(numPt,
254 nextPt: integer; x, y: single): pointer;
255var
256 info: PPerspectiveColorInfo;
257 InvTy,dy: single;
258 CurColorDivByZ,NextColorDivByZ: TColorF;
259 CurInvZ,NextInvZ: single;
260begin
261 New(info);
262 InvTy := 1/(FPoints[nextPt].y-FPoints[numPt].y);
263
264 CurInvZ := 1/FPointsZ[numPt];
265 CurColorDivByZ := FColors[numPt]*CurInvZ;
266 NextInvZ := 1/FPointsZ[nextPt];
267 NextColorDivByZ := FColors[nextPt]*NextInvZ;
268
269 info^.ColorSlopesDivZ := (NextColorDivByZ - CurColorDivByZ)*InvTy;
270 dy := y-FPoints[numPt].y;
271 info^.ColorDivZ := CurColorDivByZ + info^.ColorSlopesDivZ*dy;
272
273 info^.InvZSlope := (NextInvZ-CurInvZ)*InvTy;
274 info^.InvZ := CurInvZ+dy*info^.InvZSlope;
275
276 Result:= info;
277end;
278{$hints on}
279
280function TPolygonPerspectiveColorGradientInfo.CreateIntersectionInfo: TIntersectionInfo;
281begin
282 Result:= TPerspectiveColorGradientIntersectionInfo.Create;
283end;
284
285{ TPolygonLinearColorGradientInfo }
286
287procedure TPolygonLinearColorGradientInfo.SetIntersectionValues(
288 AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
289 dy: single; AData: pointer);
290var
291 info: PLinearColorInfo;
292begin
293 AInter.SetValues(AInterX,AWinding,ANumSegment);
294 info := PLinearColorInfo(AData);
295 TLinearColorGradientIntersectionInfo(AInter).color := info^.Color + info^.ColorSlopes*dy;
296end;
297
298constructor TPolygonLinearColorGradientInfo.Create(
299 const points: array of TPointF; const Colors: array of TBGRAPixel);
300var
301 i: Integer;
302 lPoints: array of TPointF;
303 nbP: integer;
304 ec: TExpandedPixel;
305begin
306 if length(Colors) <> length(points) then
307 raise Exception.Create('Dimensions mismatch');
308
309 setlength(lPoints, length(points));
310 SetLength(FColors, length(points));
311 nbP := 0;
312 for i := 0 to high(points) do
313 if (i=0) or (points[i]<>points[i-1]) then
314 begin
315 lPoints[nbP] := points[i];
316 ec := GammaExpansion(Colors[i]);
317 FColors[nbP] := ColorF(ec.red,ec.green,ec.blue,ec.alpha);
318 inc(nbP);
319 end;
320 if (nbP>0) and (lPoints[nbP-1] = lPoints[0]) then dec(NbP);
321 setlength(lPoints, nbP);
322 SetLength(FColors, nbP);
323
324 inherited Create(lPoints);
325end;
326
327{$hints off}
328function TPolygonLinearColorGradientInfo.CreateSegmentData(numPt, nextPt: integer; x,
329 y: single): pointer;
330var
331 info: PLinearColorInfo;
332 ty,dy: single;
333begin
334 New(info);
335 ty := FPoints[nextPt].y-FPoints[numPt].y;
336 info^.ColorSlopes := (FColors[nextPt] - FColors[numPt])*(1/ty);
337 dy := y-FPoints[numPt].y;
338 info^.Color := FColors[numPt] + info^.ColorSlopes*dy;
339 Result:= info;
340end;
341{$hints on}
342
343function TPolygonLinearColorGradientInfo.CreateIntersectionInfo: TIntersectionInfo;
344begin
345 Result:= TLinearColorGradientIntersectionInfo.Create;
346end;
347
348procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap;
349 polyInfo: TPolygonLinearColorGradientInfo; NonZeroWinding: boolean);
350var
351 inter: array of TIntersectionInfo;
352 nbInter: integer;
353
354 procedure DrawGradientLine(yb: integer; ix1: integer; ix2: integer;
355 x1: Single; c1: TColorF; x2: Single; c2: TColorF);
356 var
357 colorPos: TColorF;
358 colorStep: TColorF;
359 t: single;
360 pdest: PBGRAPixel;
361 i: LongInt;
362 ec: TExpandedPixel;
363 {%H-}cInt: packed record
364 r,g,b,a: integer;
365 end;
366 {$IFDEF BGRASSE_AVAILABLE} c: TBGRAPixel; {$ENDIF}
367 begin
368 t := ((ix1+0.5)-x1)/(x2-x1);
369 colorPos := c1 + (c2-c1)*t;
370 colorStep := (c2-c1)*(1/(x2-x1));
371 pdest := bmp.ScanLine[yb]+ix1;
372
373 {$IFDEF BGRASSE_AVAILABLE} {$asmmode intel}
374 If UseSSE then
375 begin
376 asm
377 movups xmm4, colorPos
378 movups xmm5, colorStep
379 end;
380 If UseSSE2 then
381 begin
382 for i := ix1 to ix2 do
383 begin
384 asm
385 cvtps2dq xmm0,xmm4
386 movups cInt, xmm0
387 addps xmm4,xmm5
388 end;
389 c.red := GammaCompressionTab[cInt.r];
390 c.green := GammaCompressionTab[cInt.g];
391 c.blue := GammaCompressionTab[cInt.b];
392 c.alpha := GammaCompressionTab[cInt.a];
393 DrawPixelInlineWithAlphaCheck(pdest, c);
394 inc(pdest);
395 end;
396 end else
397 begin
398 for i := ix1 to ix2 do
399 begin
400 asm
401 movups colorPos, xmm4
402 addps xmm4,xmm5
403 end;
404 ec.red := round(colorPos[1]);
405 ec.green := round(colorPos[2]);
406 ec.blue := round(colorPos[3]);
407 ec.alpha := round(colorPos[4]);
408 DrawPixelInlineWithAlphaCheck(pdest, GammaCompression(ec));
409 inc(pdest);
410 end;
411 end;
412 end else
413 {$ENDIF}
414 for i := ix1 to ix2 do
415 begin
416 ec.red := round(colorPos[1]);
417 ec.green := round(colorPos[2]);
418 ec.blue := round(colorPos[3]);
419 ec.alpha := round(colorPos[4]);
420 DrawPixelInlineWithAlphaCheck(pdest, GammaCompression(ec));
421 colorPos += colorStep;
422 inc(pdest);
423 end;
424 end;
425
426var
427 miny, maxy, minx, maxx: integer;
428
429 yb, i: integer;
430 x1, x2: single;
431
432 ix1, ix2: integer;
433
434begin
435 If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
436 inter := polyInfo.CreateIntersectionArray;
437
438 //vertical scan
439 for yb := miny to maxy do
440 begin
441 //find intersections
442 polyInfo.ComputeAndSort(yb+0.5001,inter,nbInter,NonZeroWinding);
443
444 for i := 0 to nbinter div 2 - 1 do
445 begin
446 x1 := inter[i + i].interX;
447 x2 := inter[i + i+ 1].interX;
448
449 if x1 <> x2 then
450 begin
451 ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2);
452 if ix1 <= ix2 then
453 DrawGradientLine(yb,ix1,ix2,
454 x1,TLinearColorGradientIntersectionInfo(inter[i+i]).Color,
455 x2,TLinearColorGradientIntersectionInfo(inter[i+i+1]).Color);
456 end;
457 end;
458 end;
459
460 polyInfo.FreeIntersectionArray(inter);
461 bmp.InvalidateBitmap;
462end;
463
464procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap;
465 const points: array of TPointF; const Colors: array of TBGRAPixel;
466 NonZeroWinding: boolean);
467var polyInfo: TPolygonLinearColorGradientInfo;
468begin
469 polyInfo := TPolygonLinearColorGradientInfo.Create(points,Colors);
470 PolygonLinearColorGradientAliased(bmp,polyInfo,NonZeroWinding);
471 polyInfo.Free;
472end;
473
474{ TPolygonLinearTextureMappingInfo }
475
476procedure TPolygonLinearTextureMappingInfo.SetIntersectionValues(
477 AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
478 dy: single; AData: pointer);
479var
480 info: PLinearTextureInfo;
481begin
482 AInter.SetValues(AInterX,AWinding,ANumSegment);
483 info := PLinearTextureInfo(AData);
484 TLinearTextureMappingIntersectionInfo(AInter).texCoord := info^.TexCoord + info^.TexCoordSlopes*dy;
485 if FLightnesses<>nil then
486 TLinearTextureMappingIntersectionInfo(AInter).lightness := round(info^.lightness + info^.lightnessSlope*dy)
487 else
488 TLinearTextureMappingIntersectionInfo(AInter).lightness := 32768;
489end;
490
491constructor TPolygonLinearTextureMappingInfo.Create(const points: array of TPointF;
492 const texCoords: array of TPointF);
493var
494 i: Integer;
495 lPoints: array of TPointF;
496 nbP: integer;
497begin
498 if length(texCoords) <> length(points) then
499 raise Exception.Create('Dimensions mismatch');
500
501 setlength(lPoints, length(points));
502 SetLength(FTexCoords, length(points));
503 nbP := 0;
504 for i := 0 to high(points) do
505 if (i=0) or (points[i]<>points[i-1]) then
506 begin
507 lPoints[nbP] := points[i];
508 FTexCoords[nbP] := texCoords[i];
509 inc(nbP);
510 end;
511 if (nbP>0) and (lPoints[nbP-1] = lPoints[0]) then dec(NbP);
512 setlength(lPoints, nbP);
513 SetLength(FTexCoords, nbP);
514
515 inherited Create(lPoints);
516end;
517
518constructor TPolygonLinearTextureMappingInfo.Create(
519 const points: array of TPointF; const texCoords: array of TPointF;
520 const lightnesses: array of word);
521var
522 i: Integer;
523 lPoints: array of TPointF;
524 nbP: integer;
525begin
526 if (length(texCoords) <> length(points)) or (length(lightnesses) <> length(points)) then
527 raise Exception.Create('Dimensions mismatch');
528
529 setlength(lPoints, length(points));
530 SetLength(FTexCoords, length(points));
531 setlength(FLightnesses, length(lightnesses));
532 nbP := 0;
533 for i := 0 to high(points) do
534 if (i=0) or (points[i]<>points[i-1]) then
535 begin
536 lPoints[nbP] := points[i];
537 FTexCoords[nbP] := texCoords[i];
538 FLightnesses[nbP] := lightnesses[i];
539 inc(nbP);
540 end;
541 if (nbP>0) and (lPoints[nbP-1] = lPoints[0]) then dec(NbP);
542 setlength(lPoints, nbP);
543 SetLength(FTexCoords, nbP);
544 SetLength(FLightnesses, nbP);
545
546 inherited Create(lPoints);
547end;
548
549{$hints off}
550function TPolygonLinearTextureMappingInfo.CreateSegmentData(numPt, nextPt: integer; x,
551 y: single): pointer;
552var
553 info: PLinearTextureInfo;
554 ty,dy: single;
555begin
556 New(info);
557 ty := FPoints[nextPt].y-FPoints[numPt].y;
558 dy := y-FPoints[numPt].y;
559 info^.TexCoordSlopes := (FTexCoords[nextPt] - FTexCoords[numPt])*(1/ty);
560 info^.TexCoord := FTexCoords[numPt] + info^.TexCoordSlopes*dy;
561 if FLightnesses <> nil then
562 begin
563 info^.lightnessSlope := (FLightnesses[nextPt] - FLightnesses[numPt])*(1/ty);
564 info^.lightness := FLightnesses[numPt] + info^.lightnessSlope*dy;
565 end else
566 begin
567 info^.lightness := 32768;
568 info^.lightnessSlope := 0;
569 end;
570 Result:= info;
571end;
572{$hints on}
573
574function TPolygonLinearTextureMappingInfo.CreateIntersectionInfo: TIntersectionInfo;
575begin
576 result := TLinearTextureMappingIntersectionInfo.Create;
577end;
578
579{$hints off}
580
581procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap;
582 polyInfo: TPolygonPerspectiveColorGradientInfo; NonZeroWinding: boolean; zbuffer: psingle);
583var
584 inter: array of TIntersectionInfo;
585 nbInter: integer;
586
587 procedure DrawGradientLine(yb: integer; ix1: integer; ix2: integer;
588 x1: Single; info1: TPerspectiveColorGradientIntersectionInfo; x2: Single; info2: TPerspectiveColorGradientIntersectionInfo);
589 var
590 diff,colorPos,{%H-}colorPosByZ: TColorF;
591 colorStep: TColorF;
592 t: single;
593 pdest: PBGRAPixel;
594 i: LongInt;
595 ec: TExpandedPixel;
596 invDx: single;
597 z,invZ,InvZStep: single;
598 r,g,b,a: integer;
599 {$IFDEF BGRASSE_AVAILABLE}minVal,maxVal: single;
600 cInt: packed record
601 r,g,b,a: integer;
602 end;
603 c: TBGRAPixel;{$ENDIF}
604 zbufferpos: psingle;
605
606 begin
607 invDx := 1/(x2-x1);
608 t := ((ix1+0.5)-x1)*InvDx;
609 diff := info2.ColorDivZ-info1.ColorDivZ;
610 colorPos := info1.ColorDivZ + diff*t;
611 colorStep := diff*InvDx;
612 invZ := info1.coordInvZ + (info2.coordInvZ-info1.coordInvZ)*t;
613 InvZStep := (info2.coordInvZ-info1.coordInvZ)*InvDx;
614 pdest := bmp.ScanLine[yb]+ix1;
615 if zbuffer <> nil then
616 begin
617 {$DEFINE PARAM_USEZBUFFER}
618 zbufferpos := zbuffer + yb*bmp.Width + ix1;
619 {$IFDEF BGRASSE_AVAILABLE}
620 If UseSSE then
621 begin
622 {$DEFINE PARAM_USESSE}
623 If UseSSE2 then
624 begin
625 {$DEFINE PARAM_USESSE2}
626 {$i perspectivecolorscan.inc}
627 {$UNDEF PARAM_USESSE2}
628 end else
629 begin
630 {$i perspectivecolorscan.inc}
631 end;
632 {$UNDEF PARAM_USESSE}
633 end else
634 {$ENDIF}
635 begin
636 {$i perspectivecolorscan.inc}
637 end;
638 {$UNDEF PARAM_USEZBUFFER}
639 end else
640 begin
641 {$IFDEF BGRASSE_AVAILABLE}
642 If UseSSE then
643 begin
644 {$DEFINE PARAM_USESSE}
645 If UseSSE2 then
646 begin
647 {$DEFINE PARAM_USESSE2}
648 {$i perspectivecolorscan.inc}
649 {$UNDEF PARAM_USESSE2}
650 end else
651 begin
652 {$i perspectivecolorscan.inc}
653 end;
654 {$UNDEF PARAM_USESSE}
655 end else
656 {$ENDIF}
657 begin
658 {$i perspectivecolorscan.inc}
659 end;
660 end;
661 end;
662
663var
664 miny, maxy, minx, maxx: integer;
665
666 yb, i: integer;
667 x1, x2: single;
668
669 ix1, ix2: integer;
670
671begin
672 If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
673 inter := polyInfo.CreateIntersectionArray;
674
675 //vertical scan
676 for yb := miny to maxy do
677 begin
678 //find intersections
679 polyInfo.ComputeAndSort(yb+0.5001,inter,nbInter,NonZeroWinding);
680
681 for i := 0 to nbinter div 2 - 1 do
682 begin
683 x1 := inter[i + i].interX;
684 x2 := inter[i + i+ 1].interX;
685
686 if x1 <> x2 then
687 begin
688 ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2);
689 if ix1 <= ix2 then
690 DrawGradientLine(yb,ix1,ix2,
691 x1,TPerspectiveColorGradientIntersectionInfo(inter[i+i]),
692 x2,TPerspectiveColorGradientIntersectionInfo(inter[i+i+1]));
693 end;
694 end;
695 end;
696
697 polyInfo.FreeIntersectionArray(inter);
698 bmp.InvalidateBitmap;
699end;
700
701procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap;
702 const points: array of TPointF; const pointsZ: array of single;
703 const Colors: array of TBGRAPixel; NonZeroWinding: boolean; zbuffer: psingle);
704var polyInfo: TPolygonPerspectiveColorGradientInfo;
705begin
706 polyInfo := TPolygonPerspectiveColorGradientInfo.Create(points,pointsZ,Colors);
707 PolygonPerspectiveColorGradientAliased(bmp,polyInfo,NonZeroWinding,zbuffer);
708 polyInfo.Free;
709end;
710
711procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonLinearTextureMappingInfo;
712 texture: IBGRAScanner; TextureInterpolation: Boolean; NonZeroWinding: boolean);
713var
714 inter: array of TIntersectionInfo;
715 nbInter: integer;
716 scanAtFunc: function(X,Y: Single): TBGRAPixel of object;
717 scanAtIntegerFunc: function(X,Y: integer): TBGRAPixel of object;
718
719 procedure DrawTextureLineWithoutLight(yb: integer; ix1: integer; ix2: integer;
720 info1,info2: TLinearTextureMappingIntersectionInfo;
721 WithInterpolation: boolean);
722 {$i lineartexscan.inc}
723
724 procedure DrawTextureLineWithLight(yb: integer; ix1: integer; ix2: integer;
725 info1,info2: TLinearTextureMappingIntersectionInfo;
726 WithInterpolation: boolean);
727 {$define PARAM_USELIGHTING}
728 {$i lineartexscan.inc}
729
730var
731 miny, maxy, minx, maxx: integer;
732
733 yb, i: integer;
734 x1, x2: single;
735
736 ix1, ix2: integer;
737
738begin
739 If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
740
741 scanAtFunc := @texture.ScanAt;
742 scanAtIntegerFunc := @texture.ScanAtInteger;
743
744 inter := polyInfo.CreateIntersectionArray;
745
746 //vertical scan
747 for yb := miny to maxy do
748 begin
749 //find intersections
750 polyInfo.ComputeAndSort(yb+0.5001,inter,nbInter,NonZeroWinding);
751 for i := 0 to nbinter div 2 - 1 do
752 begin
753 x1 := inter[i + i].interX;
754 x2 := inter[i + i+ 1].interX;
755
756 if x1 <> x2 then
757 begin
758 ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2);
759 if ix1 <= ix2 then
760 begin
761 if (TLinearTextureMappingIntersectionInfo(inter[i+i]).lightness = 32768) and
762 (TLinearTextureMappingIntersectionInfo(inter[i+i+1]).lightness = 32768) then
763 DrawTextureLineWithoutLight(yb,ix1,ix2,
764 TLinearTextureMappingIntersectionInfo(inter[i+i]),
765 TLinearTextureMappingIntersectionInfo(inter[i+i+1]),
766 TextureInterpolation)
767 else
768 DrawTextureLineWithLight(yb,ix1,ix2,
769 TLinearTextureMappingIntersectionInfo(inter[i+i]),
770 TLinearTextureMappingIntersectionInfo(inter[i+i+1]),
771 TextureInterpolation);
772 end;
773 end;
774 end;
775 end;
776
777 polyInfo.FreeIntersectionArray(inter);
778 bmp.InvalidateBitmap;
779end;
780{$hints on}
781
782procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap;
783 const points: array of TPointF; texture: IBGRAScanner;
784 const texCoords: array of TPointF; TextureInterpolation: Boolean; NonZeroWinding: boolean);
785var polyInfo: TPolygonLinearTextureMappingInfo;
786begin
787 polyInfo := TPolygonLinearTextureMappingInfo.Create(points,texCoords);
788 PolygonLinearTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation,NonZeroWinding);
789 polyInfo.Free;
790end;
791
792procedure PolygonLinearTextureMappingAliasedWithLightness(
793 bmp: TBGRACustomBitmap; const points: array of TPointF;
794 texture: IBGRAScanner; const texCoords: array of TPointF;
795 TextureInterpolation: Boolean; lightnesses: array of word;
796 NonZeroWinding: boolean);
797var polyInfo: TPolygonLinearTextureMappingInfo;
798begin
799 polyInfo := TPolygonLinearTextureMappingInfo.Create(points,texCoords,lightnesses);
800 PolygonLinearTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation,NonZeroWinding);
801 polyInfo.Free;
802end;
803
804{$i polyaliaspersp.inc}
805
806{From LazRGBGraphics}
807procedure BGRARoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer;
808 DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency;
809 skipFill: boolean = false);
810var
811 CX, CY, CX1, CY1, A, B, NX, NY: single;
812 X, Y, EX, EY: integer;
813 LX1, LY1: integer;
814 LX2, LY2: integer;
815 DivSqrA, DivSqrB: single;
816 I, J, S: integer;
817 EdgeList: array of TPoint;
818 temp: integer;
819 LX, LY: integer;
820 RowStart,RowEnd: integer;
821 PixelProc: procedure (x, y: int32or64; c: TBGRAPixel) of object;
822 skipBorder: boolean;
823
824 procedure AddEdge(X, Y: integer);
825 begin
826 If (Y > High(EdgeList)) or (Y < 0) then exit;
827 if (EdgeList[Y].X = -1) or (X < EdgeList[Y].X) then
828 EdgeList[Y].X := X;
829 if (EdgeList[Y].Y = -1) or (X > EdgeList[Y].Y) then
830 EdgeList[Y].Y := X;
831 end;
832
833begin
834 if (x1 > x2) then
835 begin
836 temp := x1;
837 x1 := x2;
838 x2 := temp;
839 end;
840 if (y1 > y2) then
841 begin
842 temp := y1;
843 y1 := y2;
844 y2 := temp;
845 end;
846 if (x2 - x1 <= 0) or (y2 - y1 <= 0) then
847 exit;
848 LX := x2 - x1 - DX;
849 LY := y2 - y1 - DY;
850 if LX < 0 then LX := 0;
851 if LY < 0 then LY := 0;
852 Dec(x2);
853 Dec(y2);
854
855 if (X1 = X2) and (Y1 = Y2) then
856 begin
857 dest.DrawPixel(X1, Y1, BorderColor, ADrawMode);
858 Exit;
859 end;
860
861 if (X2 - X1 = 1) or (Y2 - Y1 = 1) then
862 begin
863 dest.FillRect(X1, Y1, X2 + 1, Y2 + 1, BorderColor, ADrawMode);
864 Exit;
865 end;
866
867 if (LX > X2 - X1) or (LY > Y2 - Y1) then
868 begin
869 dest.Rectangle(X1, Y1, X2 + 1, Y2 + 1, BorderColor, ADrawMode);
870 if not skipFill then
871 if FillTexture <> nil then
872 dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillTexture, ADrawMode) else
873 dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillColor, ADrawMode);
874 Exit;
875 end;
876
877 SetLength(EdgeList, Ceil((Y2 - Y1 + 1) / 2));
878 for I := 0 to Pred(High(EdgeList)) do
879 EdgeList[I] := Point(-1, -1);
880 EdgeList[High(EdgeList)] := Point(0, 0);
881
882 A := (X2 - X1 + 1 - LX) / 2;
883 B := (Y2 - Y1 + 1 - LY) / 2;
884 CX := (X2 + X1 + 1) / 2;
885 CY := (Y2 + Y1 + 1) / 2;
886
887 CX1 := X2 + 1 - A - Floor(CX);
888 CY1 := Y2 + 1 - B - Floor(CY);
889
890 EX := Floor(Sqr(A) / Sqrt(Sqr(A) + Sqr(B)) + Frac(A));
891 EY := Floor(Sqr(B) / Sqrt(Sqr(A) + Sqr(B)) + Frac(B));
892
893 DivSqrA := 1 / Sqr(A);
894 DivSqrB := 1 / Sqr(B);
895
896 NY := B;
897 AddEdge(Floor(CX1), Round(CY1 + B) - 1);
898 for X := 1 to Pred(EX) do
899 begin
900 NY := B * Sqrt(1 - Sqr(X + 0.5 - Frac(A)) * DivSqrA);
901
902 AddEdge(Floor(CX1) + X, Round(CY1 + NY) - 1);
903 end;
904
905 LX1 := Floor(CX1) + Pred(EX);
906 LY1 := Round(CY1 + NY) - 1;
907
908 NX := A;
909 AddEdge(Round(CX1 + A) - 1, Floor(CY1));
910 for Y := 1 to Pred(EY) do
911 begin
912 NX := A * Sqrt(1 - Sqr(Y + 0.5 - Frac(B)) * DivSqrB);
913
914 AddEdge(Round(CX1 + NX) - 1, Floor(CY1) + Y);
915 end;
916
917 LX2 := Round(CX1 + NX) - 1;
918 LY2 := Floor(CY1) + Pred(EY);
919
920 if Abs(LX1 - LX2) > 1 then
921 begin
922 if Abs(LY1 - LY2) > 1 then
923 AddEdge(LX1 + 1, LY1 - 1)
924 else
925 AddEdge(LX1 + 1, LY1);
926 end
927 else
928 if Abs(LY1 - LY2) > 1 then
929 AddEdge(LX2, LY1 - 1);
930
931 for I := 0 to High(EdgeList) do
932 begin
933 if EdgeList[I].X = -1 then
934 EdgeList[I] := Point(Round(CX1 + A) - 1, Round(CX1 + A) - 1)
935 else
936 Break;
937 end;
938
939 case ADrawMode of
940 dmSetExceptTransparent: begin PixelProc := @dest.SetPixel; skipBorder:= BorderColor.alpha <> 255; end; dmDrawWithTransparency: begin PixelProc := @dest.DrawPixel; skipBorder:= BorderColor.alpha = 0; end;
941 dmXor: begin PixelProc := @dest.XorPixel; skipBorder:= DWord(BorderColor) = 0; end;
942 dmLinearBlend: begin PixelProc := @dest.FastBlendPixel; skipBorder:= BorderColor.alpha = 0; end;
943 else
944 begin PixelProc := @dest.SetPixel; skipBorder := false; end;
945 end;
946
947 J := 0;
948 while J < Length(EdgeList) do
949 begin
950 if (J = 0) and (Frac(CY) > 0) then
951 begin
952 if not skipBorder then
953 for I := EdgeList[J].X to EdgeList[J].Y do
954 begin
955 PixelProc(Floor(CX) + I, Floor(CY) + J, BorderColor);
956 PixelProc(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor);
957 end;
958
959 if not SkipFill then
960 if FillTexture <> nil then
961 dest.HorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
962 Pred(EdgeList[J].X), FillTexture, ADrawMode) else
963 dest.HorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
964 Pred(EdgeList[J].X), FillColor, ADrawMode);
965 end
966 else
967 if (J = High(EdgeList)) then
968 begin
969 if Frac(CX) > 0 then
970 S := -EdgeList[J].Y
971 else
972 S := -Succ(EdgeList[J].Y);
973
974 if not skipBorder then
975 for I := S to EdgeList[J].Y do
976 begin
977 PixelProc(Floor(CX) + I, Floor(CY) + J, BorderColor);
978 PixelProc(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor);
979 end;
980 end
981 else
982 begin
983 if not skipBorder then
984 for I := EdgeList[J].X to EdgeList[J].Y do
985 begin
986 PixelProc(Floor(CX) + I, Floor(CY) + J, BorderColor);
987 PixelProc(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor);
988 if Floor(CX) + I <> Ceil(CX) - Succ(I) then
989 begin
990 PixelProc(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor);
991 PixelProc(Ceil(CX) - Succ(I), Ceil(CY) - Succ(J), BorderColor);
992 end;
993 end;
994
995 if not SkipFill then
996 begin
997 RowStart := Ceil(CX) - EdgeList[J].X;
998 RowEnd := Floor(CX) + Pred(EdgeList[J].X);
999 if RowEnd >= RowStart then
1000 begin
1001 if FillTexture <> nil then
1002 begin
1003 dest.HorizLine(RowStart, Floor(CY) + J,
1004 RowEnd, FillTexture, ADrawMode);
1005 dest.HorizLine(RowStart, Ceil(CY) - Succ(J),
1006 RowEnd, FillTexture, ADrawMode);
1007 end else
1008 begin
1009 dest.HorizLine(RowStart, Floor(CY) + J,
1010 RowEnd, FillColor, ADrawMode);
1011 dest.HorizLine(RowStart, Ceil(CY) - Succ(J),
1012 RowEnd, FillColor, ADrawMode);
1013 end;
1014 end;
1015 end;
1016
1017 end;
1018 Inc(J);
1019 end;
1020end;
1021
1022procedure BGRAFillRoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2,
1023 Y2: integer; DX, DY: integer; FillColor: TBGRAPixel;
1024 FillTexture: IBGRAScanner; ADrawMode: TDrawMode);
1025var
1026 fi: TFillRoundRectangleInfo;
1027begin
1028 fi := TFillRoundRectangleInfo.Create(x1,y1,x2,y2,dx/2,dy/2,[rrDefault],false);
1029 FillShapeAliased(dest, fi, FillColor, false, FillTexture, true, ADrawMode);
1030 fi.Free;
1031end;
1032
1033end.
1034
Note: See TracBrowser for help on using the repository browser.