source: trunk/Packages/Graphics32/GR32_PolygonsAggLite.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 50.4 KB
Line 
1unit GR32_PolygonsAggLite;
2
3(* ***** BEGIN LICENSE BLOCK *****
4 * Version: MPL 1.1 or LGPL 2.1 with linking exception
5 *
6 * The contents of this file are subject to the Mozilla Public License Version
7 * 1.1 (the "License"); you may not use this file except in compliance with
8 * the License. You may obtain a copy of the License at
9 * http://www.mozilla.org/MPL/
10 *
11 * Software distributed under the License is distributed on an "AS IS" basis,
12 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13 * for the specific language governing rights and limitations under the
14 * License.
15 *
16 * Alternatively, the contents of this file may be used under the terms of the
17 * Free Pascal modified version of the GNU Lesser General Public License
18 * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
19 * of this license are applicable instead of those above.
20 * Please see the file LICENSE.txt for additional information concerning this
21 * license.
22 *
23 * The Original Code is a mixture of AggLite and the other polygon renderers of
24 * Graphics32
25 *
26 * The Initial Developer is
27 * Christian-W. Budde <Christian@savioursofsoul.de>
28 *
29 * Portions created by the Initial Developer are Copyright (C) 2008-2012
30 * the Initial Developer. All Rights Reserved.
31 *
32 * AggLite is based on Anti-Grain Geometry (Version 2.0)
33 * Copyright (C) 2002-2004 Maxim Shemanarev (McSeem)
34 *
35 * Permission to copy, use, modify, sell and distribute this software
36 * is granted provided this copyright notice appears in all copies.
37 * This software is provided "as is" without express or implied
38 * warranty, and with no claim as to its suitability for any purpose.
39 *
40 * Contributor(s):
41 *
42 * ***** END LICENSE BLOCK ***** *)
43
44interface
45
46{$I GR32.inc}
47
48uses
49 Types, GR32, GR32_Polygons, GR32_Transforms;
50
51type
52 TPolygonRenderer32AggLite = class(TPolygonRenderer32)
53 protected
54 procedure Render(CellsPtr: Pointer; MinX, MaxX: Integer);
55 public
56 procedure PolygonFS(const Points: TArrayOfFloatPoint;
57 const ClipRect: TFloatRect); override;
58 procedure PolyPolygonFS(const Points: TArrayOfArrayOfFloatPoint;
59 const ClipRect: TFloatRect); override;
60 end;
61
62procedure PolyPolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
63 Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
64 Transformation: TTransformation = nil); overload;
65procedure PolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
66 Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
67 Transformation: TTransformation = nil); overload;
68procedure PolyPolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
69 Filler: TCustomPolygonFiller; FillMode: TPolyFillMode = pfAlternate;
70 Transformation: TTransformation = nil); overload;
71procedure PolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
72 Filler: TCustomPolygonFiller; FillMode: TPolyFillMode = pfAlternate;
73 Transformation: TTransformation = nil); overload;
74procedure PolyPolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
75 ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
76 Transformation: TTransformation = nil); overload;
77procedure PolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
78 ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode = pfAlternate;
79 Transformation: TTransformation = nil); overload;
80procedure PolyPolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
81 ClipRect: TRect; Filler: TCustomPolygonFiller; FillMode: TPolyFillMode = pfAlternate;
82 Transformation: TTransformation = nil); overload;
83procedure PolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
84 ClipRect: TRect; Filler: TCustomPolygonFiller; FillMode: TPolyFillMode = pfAlternate;
85 Transformation: TTransformation = nil); overload;
86procedure PolyPolylineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
87 Color: TColor32; Closed: Boolean = False; StrokeWidth: TFloat = 1.0;
88 JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
89 MiterLimit: TFloat = 4.0; Transformation: TTransformation = nil); overload;
90procedure PolyPolylineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
91 Filler: TCustomPolygonFiller; Closed: Boolean = False; StrokeWidth: TFloat = 1.0;
92 JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
93 MiterLimit: TFloat = 4.0; Transformation: TTransformation = nil); overload;
94procedure PolylineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
95 Color: TColor32; Closed: Boolean = False; StrokeWidth: TFloat = 1.0;
96 JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
97 MiterLimit: TFloat = 4.0; Transformation: TTransformation = nil); overload;
98procedure PolylineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
99 Filler: TCustomPolygonFiller; Closed: Boolean = False; StrokeWidth: TFloat = 1.0;
100 JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
101 MiterLimit: TFloat = 4.0; Transformation: TTransformation = nil); overload;
102procedure DashLineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
103 const Dashes: TArrayOfFloat; Color: TColor32;
104 Closed: Boolean = False; Width: TFloat = 1.0); overload;
105procedure DashLineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
106 const Dashes: TArrayOfFloat; FillColor, StrokeColor: TColor32;
107 Closed: Boolean; Width: TFloat; StrokeWidth: TFloat = 2.0); overload;
108procedure DashLineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
109 const Dashes: TArrayOfFloat; Filler: TCustomPolygonFiller;
110 Closed: Boolean = False; Width: TFloat = 1.0); overload;
111procedure DashLineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
112 const Dashes: TArrayOfFloat; Filler: TCustomPolygonFiller; StrokeColor: TColor32;
113 Closed: Boolean; Width: TFloat; StrokeWidth: TFloat = 2.0); overload;
114
115implementation
116
117uses
118 Math, GR32_Blend, GR32_Gamma, GR32_LowLevel, GR32_System, GR32_Bindings,
119 GR32_VectorUtils;
120
121procedure PolyPolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
122 Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
123var
124 Renderer: TPolygonRenderer32AggLite;
125begin
126 Renderer := TPolygonRenderer32AggLite.Create;
127 try
128 Renderer.Bitmap := Bitmap;
129 Renderer.Color := Color;
130 Renderer.FillMode := FillMode;
131 Renderer.PolyPolygonFS(Points, FloatRect(Bitmap.ClipRect), Transformation);
132 finally
133 Renderer.Free;
134 end;
135end;
136
137procedure PolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
138 Color: TColor32; FillMode: TPolyFillMode; Transformation: TTransformation);
139var
140 Renderer: TPolygonRenderer32AggLite;
141begin
142 Renderer := TPolygonRenderer32AggLite.Create;
143 try
144 Renderer.Bitmap := Bitmap;
145 Renderer.Color := Color;
146 Renderer.FillMode := FillMode;
147 Renderer.PolygonFS(Points, FloatRect(Bitmap.ClipRect), Transformation);
148 finally
149 Renderer.Free;
150 end;
151end;
152
153procedure PolyPolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
154 Filler: TCustomPolygonFiller; FillMode: TPolyFillMode; Transformation: TTransformation);
155var
156 Renderer: TPolygonRenderer32AggLite;
157begin
158 if not Assigned(Filler) then Exit;
159 Renderer := TPolygonRenderer32AggLite.Create;
160 try
161 Renderer.Bitmap := Bitmap;
162 Renderer.Filler := Filler;
163 Renderer.FillMode := FillMode;
164 Renderer.PolyPolygonFS(Points, FloatRect(Bitmap.ClipRect), Transformation);
165 finally
166 Renderer.Free;
167 end;
168end;
169
170procedure PolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
171 Filler: TCustomPolygonFiller; FillMode: TPolyFillMode; Transformation: TTransformation);
172var
173 Renderer: TPolygonRenderer32AggLite;
174begin
175 if not Assigned(Filler) then Exit;
176 Renderer := TPolygonRenderer32AggLite.Create;
177 try
178 Renderer.Bitmap := Bitmap;
179 Renderer.Filler := Filler;
180 Renderer.FillMode := FillMode;
181 Renderer.PolygonFS(Points, FloatRect(Bitmap.ClipRect), Transformation);
182 finally
183 Renderer.Free;
184 end;
185end;
186
187procedure PolyPolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
188 ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode;
189 Transformation: TTransformation);
190var
191 Renderer: TPolygonRenderer32AggLite;
192 IntersectedClipRect: TRect;
193begin
194 Renderer := TPolygonRenderer32AggLite.Create;
195 try
196 Renderer.Bitmap := Bitmap;
197 Renderer.Color := Color;
198 Renderer.FillMode := FillMode;
199 GR32.IntersectRect(IntersectedClipRect, Bitmap.ClipRect, ClipRect);
200 Renderer.PolyPolygonFS(Points, FloatRect(IntersectedClipRect), Transformation);
201 finally
202 Renderer.Free;
203 end;
204end;
205
206procedure PolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
207 ClipRect: TRect; Color: TColor32; FillMode: TPolyFillMode;
208 Transformation: TTransformation);
209var
210 Renderer: TPolygonRenderer32AggLite;
211 IntersectedClipRect: TRect;
212begin
213 Renderer := TPolygonRenderer32AggLite.Create;
214 try
215 Renderer.Bitmap := Bitmap;
216 Renderer.Color := Color;
217 Renderer.FillMode := FillMode;
218 GR32.IntersectRect(IntersectedClipRect, Bitmap.ClipRect, ClipRect);
219 Renderer.PolygonFS(Points, FloatRect(IntersectedClipRect), Transformation);
220 finally
221 Renderer.Free;
222 end;
223end;
224
225procedure PolyPolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
226 ClipRect: TRect; Filler: TCustomPolygonFiller; FillMode: TPolyFillMode;
227 Transformation: TTransformation);
228var
229 Renderer: TPolygonRenderer32AggLite;
230 IntersectedClipRect: TRect;
231begin
232 if not Assigned(Filler) then Exit;
233 Renderer := TPolygonRenderer32AggLite.Create;
234 try
235 Renderer.Bitmap := Bitmap;
236 Renderer.Filler := Filler;
237 Renderer.FillMode := FillMode;
238 GR32.IntersectRect(IntersectedClipRect, Bitmap.ClipRect, ClipRect);
239 Renderer.PolyPolygonFS(Points, FloatRect(IntersectedClipRect), Transformation);
240 finally
241 Renderer.Free;
242 end;
243end;
244
245procedure PolygonFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
246 ClipRect: TRect; Filler: TCustomPolygonFiller; FillMode: TPolyFillMode;
247 Transformation: TTransformation);
248var
249 Renderer: TPolygonRenderer32AggLite;
250 IntersectedClipRect: TRect;
251begin
252 if not Assigned(Filler) then Exit;
253 Renderer := TPolygonRenderer32AggLite.Create;
254 try
255 Renderer.Bitmap := Bitmap;
256 Renderer.Filler := Filler;
257 Renderer.FillMode := FillMode;
258 GR32.IntersectRect(IntersectedClipRect, Bitmap.ClipRect, ClipRect);
259 Renderer.PolygonFS(Points, FloatRect(IntersectedClipRect), Transformation);
260 finally
261 Renderer.Free;
262 end;
263end;
264
265procedure PolyPolylineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
266 Color: TColor32; Closed: Boolean; StrokeWidth: TFloat;
267 JoinStyle: TJoinStyle; EndStyle: TEndStyle;
268 MiterLimit: TFloat; Transformation: TTransformation);
269var
270 Dst: TArrayOfArrayOfFloatPoint;
271begin
272 Dst := BuildPolyPolyLine(Points, Closed, StrokeWidth, JoinStyle, EndStyle, MiterLimit);
273 PolyPolygonFS_AggLite(Bitmap, Dst, Color, pfWinding, Transformation);
274end;
275
276procedure PolyPolylineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFloatPoint;
277 Filler: TCustomPolygonFiller; Closed: Boolean = False; StrokeWidth: TFloat = 1.0;
278 JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
279 MiterLimit: TFloat = 4.0; Transformation: TTransformation = nil);
280var
281 Dst: TArrayOfArrayOfFloatPoint;
282begin
283 Dst := BuildPolyPolyLine(Points, Closed, StrokeWidth, JoinStyle, EndStyle, MiterLimit);
284 PolyPolygonFS(Bitmap, Dst, Filler, pfWinding, Transformation);
285end;
286
287procedure PolylineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
288 Color: TColor32; Closed: Boolean; StrokeWidth: TFloat;
289 JoinStyle: TJoinStyle; EndStyle: TEndStyle;
290 MiterLimit: TFloat; Transformation: TTransformation);
291begin
292 PolyPolylineFS_AggLite(Bitmap, PolyPolygon(Points), Color, Closed, StrokeWidth,
293 JoinStyle, EndStyle, MiterLimit, Transformation);
294end;
295
296procedure PolylineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
297 Filler: TCustomPolygonFiller; Closed: Boolean = False; StrokeWidth: TFloat = 1.0;
298 JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
299 MiterLimit: TFloat = 4.0; Transformation: TTransformation = nil);
300begin
301 PolyPolylineFS_AggLite(Bitmap, PolyPolygon(Points), Filler, Closed, StrokeWidth,
302 JoinStyle, EndStyle, MiterLimit, Transformation);
303end;
304
305procedure DashLineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
306 const Dashes: TArrayOfFloat; Color: TColor32;
307 Closed: Boolean = False; Width: TFloat = 1.0);
308var
309 MultiPoly: TArrayOfArrayOfFloatPoint;
310begin
311 MultiPoly := GR32_VectorUtils.BuildDashedLine(Points, Dashes, 0, Closed);
312 PolyPolylineFS_AggLite(Bitmap, MultiPoly, Color, False, Width);
313end;
314
315procedure DashLineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
316 const Dashes: TArrayOfFloat; FillColor, StrokeColor: TColor32;
317 Closed: Boolean; Width: TFloat; StrokeWidth: TFloat = 2.0);
318var
319 MultiPoly: TArrayOfArrayOfFloatPoint;
320begin
321 MultiPoly := GR32_VectorUtils.BuildDashedLine(Points, Dashes, 0, Closed);
322 MultiPoly := BuildPolyPolyLine(MultiPoly, False, Width);
323 PolyPolygonFS_AggLite(Bitmap, MultiPoly, FillColor);
324 PolyPolylineFS_AggLite(Bitmap, MultiPoly, StrokeColor, True, StrokeWidth);
325end;
326
327procedure DashLineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
328 const Dashes: TArrayOfFloat; Filler: TCustomPolygonFiller;
329 Closed: Boolean = False; Width: TFloat = 1.0);
330var
331 MultiPoly: TArrayOfArrayOfFloatPoint;
332begin
333 MultiPoly := GR32_VectorUtils.BuildDashedLine(Points, Dashes, 0, Closed);
334 PolyPolylineFS_AggLite(Bitmap, MultiPoly, Filler, False, Width);
335end;
336
337procedure DashLineFS_AggLite(Bitmap: TBitmap32; const Points: TArrayOfFloatPoint;
338 const Dashes: TArrayOfFloat; Filler: TCustomPolygonFiller; StrokeColor: TColor32;
339 Closed: Boolean; Width: TFloat; StrokeWidth: TFloat = 2.0);
340var
341 MultiPoly: TArrayOfArrayOfFloatPoint;
342begin
343 MultiPoly := GR32_VectorUtils.BuildDashedLine(Points, Dashes, 0, Closed);
344 MultiPoly := BuildPolyPolyLine(MultiPoly, False, Width);
345 PolyPolygonFS_AggLite(Bitmap, MultiPoly, Filler);
346 PolyPolylineFS_AggLite(Bitmap, MultiPoly, StrokeColor, True, StrokeWidth);
347end;
348
349const
350 CPolyBaseShift = 8;
351 CPolyBaseSize = 1 shl CPolyBaseShift;
352 CPolyBaseMask = CPolyBaseSize - 1;
353
354 CCellBlockShift = 12;
355 CCellBlockSize = 1 shl CCellBlockShift;
356 CCellBlockMask = CCellBlockSize - 1;
357 CCellBlockPool = 256;
358 CCellBlockLimit = 1024;
359
360type
361 PPColor32 = ^PColor32;
362
363 TPointWord = record
364 case Byte of
365 0: (X, Y: SmallInt);
366 1: (PackedCoord: Integer);
367 end;
368
369 TCell = packed record
370 Pnt: TPointWord;
371 PackedCoord: Integer;
372 Cover: Integer;
373 Area: Integer;
374 end;
375 PCell = ^TCell;
376 PPCell = ^PCell;
377
378 TScanLine = class(TObject)
379 private
380 FCounts: PWord;
381 FCovers: PColor32Array;
382 FCurCount: PWord;
383 FCurStartPtr: PPColor32;
384 FLastX: Integer;
385 FLastY: Integer;
386 FMaxLen: Cardinal;
387 FMinX: Integer;
388 FNumSpans: Cardinal;
389 FStartPtrs: PPColor32;
390 public
391 constructor Create(MinX, MaxX: Integer);
392 destructor Destroy; override;
393
394 procedure AddCell(X, Y: Integer; Cover: Cardinal);
395 procedure AddSpan(X, Y: Integer; Len, Cover: Cardinal);
396 function IsReady(Y: Integer): Integer;
397 procedure ResetSpans;
398
399 property BaseX: Integer read FMinX;
400 property Y: Integer read FLastY;
401 property NumSpans: Cardinal read FNumSpans;
402 property CountsPtr: PWord read FCounts;
403 property CoversPtr: PColor32Array read FCovers;
404 property StartPtrs: PPColor32 read FStartPtrs;
405 end;
406
407 TOutlineFlag = (ofNotClosed, ofSortRequired);
408 TOutlineFlags = set of TOutlineFlag;
409
410 TOutline = class(TObject)
411 private
412 FCells: PPCell;
413 FClose: TPoint;
414 FCurBlock: Cardinal;
415 FCurCell: TCell;
416 FCurCellPtr: PCell;
417 FCur: TPoint;
418 FFlags: TOutlineFlags;
419 FMaxBlocks: Cardinal;
420 FMax: TPoint;
421 FMin: TPoint;
422 FNumBlocks: Cardinal;
423 FNumCells: Cardinal;
424 FSortedCells: PPCell;
425 FSortedSize: Cardinal;
426 procedure AddCurCell;
427 procedure AllocateBlock;
428 function GetCells: PPCell;
429 procedure RenderLine(X1, Y1, X2, Y2: Integer);
430 procedure RenderScanLine(EY, X1, Y1, X2, Y2: Integer);
431 procedure SetCurCell(X, Y: Integer);
432 procedure SortCells;
433 procedure InternalReset;
434 public
435 constructor Create;
436 destructor Destroy; override;
437
438 procedure LineTo(X, Y: Integer);
439 procedure MoveTo(X, Y: Integer);
440 procedure Reset;
441
442 property Cells: PPCell read GetCells;
443 property MaxX: Integer read FMax.X;
444 property MaxY: Integer read FMax.Y;
445 property MinX: Integer read FMin.X;
446 property MinY: Integer read FMin.Y;
447 property NumCells: Cardinal read FNumCells;
448 end;
449
450function Fixed8(C: TFloat): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
451begin
452 Result := Trunc(C * CPolyBaseSize);
453end;
454
455
456{ TCell }
457
458procedure SetCell(var Cell: TCell; CX, CY: Integer); {$IFDEF USEINLINING} inline; {$ENDIF}
459begin
460 with Cell do
461 begin
462 Pnt.X := SmallInt(CX);
463 Pnt.Y := SmallInt(CY);
464 PackedCoord := (CY shl 16) + CX;
465 Cover := 0;
466 Area := 0;
467 end;
468end;
469
470procedure PartSort(var A, B: PPCell; const Stop: PCell);
471{$IFDEF PUREPASCAL}
472 {$IFDEF USEINLINING} inline; {$ENDIF}
473
474 procedure SwapCells(A, B: PPCell); {$IFDEF USEINLINING} inline; {$ENDIF}
475 var
476 Temp: PCell;
477 begin
478 Temp := A^;
479 A^ := B^;
480 B^ := Temp;
481 end;
482
483begin
484 while True do
485 begin
486 repeat
487 Inc(A)
488 until (A^^.PackedCoord >= Stop^.PackedCoord);
489 repeat
490 Dec(B)
491 until (B^^.PackedCoord <= Stop^.PackedCoord);
492
493 {$IFDEF FPC}
494 if PtrInt(A) > PtrInt(B) then
495 Break;
496 {$ELSE}
497 {$IFDEF HAS_NATIVEINT}
498 if NativeInt(A) > NativeInt(B) then
499 Break;
500 {$ELSE}
501 if Integer(A) > Integer(B) then
502 Break;
503 {$ENDIF}
504 {$ENDIF}
505
506 SwapCells(A, B);
507 end;
508{$ELSE}
509asm
510{$IFDEF CPUX86}
511 PUSH EBX
512 PUSH EDI
513 PUSH ESI
514 PUSH EBP
515
516 MOV ECX, [ECX + 4]
517@0:
518 MOV EDI, [EAX]
519@1:
520 ADD EDI, $04
521 MOV EBX, [EDI]
522 CMP ECX, [EBX + 4]
523 JG @1
524 MOV [EAX], EDI
525
526 MOV EDI, [EDX]
527@2:
528 SUB EDI, $04
529 MOV EBX, [EDI]
530 CMP ECX, [EBX + 4]
531 JL @2
532 MOV [EDX], EDI
533
534 CMP EDI, [EAX]
535 JLE @3
536 MOV EBX, [EAX]
537
538 MOV ESI, [EBX]
539 MOV EBP, [EDI]
540 MOV [EDI], ESI
541 MOV [EBX], EBP
542
543 JMP @0
544
545@3:
546 POP EBP
547 POP ESI
548 POP EDI
549 POP EBX
550{$ENDIF}
551{$IFDEF CPUX64}
552 MOV R8D, [R8 + 4]
553@0:
554 MOV R9, [RCX]
555@1:
556 ADD R9, $08
557 MOV RAX, [R9]
558 CMP R8D, [RAX + 4]
559 JG @1
560 MOV [RCX], R9
561
562
563 MOV R9, [RDX]
564@2:
565 SUB R9, $08
566 MOV RAX, [R9]
567 CMP R8D, [RAX + 4]
568 JL @2
569 MOV [RDX], R9
570
571 CMP R9, [RCX]
572 JLE @3
573 MOV RAX, [RCX]
574
575 MOV R10, [RAX]
576 MOV R11, [R9]
577 MOV [RAX], R11
578 MOV [R9], R10
579 JMP @0
580@3:
581{$ENDIF}
582{$ENDIF}
583end;
584
585
586procedure QSortCells(Start: PPCell; Num: Cardinal);
587const
588 QSortThreshold = 9;
589var
590 Stack: array [0 .. 79] of PPCell;
591 Top: ^PPCell;
592 Limit, Base, I, J, Pivot: PPCell;
593 Len: Integer;
594
595 procedure CheckCells(var A, B: PCell); {$IFDEF USEINLINING} inline; {$ENDIF}
596 var
597 Temp: PCell;
598 begin
599 if A^.PackedCoord < B^.PackedCoord then
600 begin
601 Temp := A;
602 A := B;
603 B := Temp;
604 end;
605 end;
606
607 procedure SwapCells(A, B: PPCell); {$IFDEF USEINLINING} inline; {$ENDIF}
608 var
609 Temp: PCell;
610 begin
611 Temp := A^;
612 A^ := B^;
613 B^ := Temp;
614 end;
615
616 function LessThan(A, B: PPCell): Boolean; {$IFDEF USEINLINING} inline; {$ENDIF}
617 begin
618 Result := A^^.PackedCoord < B^^.PackedCoord;
619 end;
620
621begin
622 {$IFDEF FPC}
623 Limit := PPCell(PtrInt(Start) + Num * SizeOf(PCell));
624 {$ELSE}
625 {$IFDEF HAS_NATIVEINT}
626 Limit := PPCell(NativeUInt(Start) + Num * SizeOf(PCell));
627 {$ELSE}
628 Limit := PPCell(Cardinal(Start) + Num * SizeOf(PCell));
629 {$ENDIF}
630 {$ENDIF}
631 Base := Start;
632 Top := @Stack[0];
633
634 while True do
635 begin
636 {$IFDEF FPC}
637 Len := (PtrInt(Limit) - PtrInt(Base)) div SizeOf(PCell);
638 {$ELSE}
639 {$IFDEF HAS_NATIVEINT}
640 Len := (NativeInt(Limit) - NativeInt(Base)) div SizeOf(PCell);
641 {$ELSE}
642 Len := (Integer(Limit) - Integer(Base)) div SizeOf(PCell);
643 {$ENDIF}
644 {$ENDIF}
645
646 if Len > QSortThreshold then
647 begin
648 // we use Base + (Len div 2) as the pivot
649 Pivot := Base;
650 Inc(Pivot, Len div 2);
651 SwapCells(Base, Pivot);
652
653 I := Base;
654 Inc(I);
655 J := Limit;
656 Dec(J);
657
658 // now ensure that I^ <= Base^ <= J^
659 CheckCells(J^, I^);
660 CheckCells(Base^, I^);
661 CheckCells(J^, Base^);
662
663 PartSort(I, J, Base^);
664 SwapCells(Base, J);
665
666 // now, push the largest sub-array
667 {$IFDEF FPC}
668 if PtrInt(J) - PtrInt(Base) > PtrInt(Limit) - PtrInt(I) then
669 {$ELSE}
670 {$IFDEF HAS_NATIVEINT}
671 if NativeInt(J) - NativeInt(Base) > NativeInt(Limit) - NativeInt(I) then
672 {$ELSE}
673 if Integer(J) - Integer(Base) > Integer(Limit) - Integer(I) then
674 {$ENDIF}
675 {$ENDIF}
676 begin
677 Top^ := Base;
678 Inc(Top);
679 Top^ := J;
680 Base := I;
681 end
682 else
683 begin
684 Top^ := I;
685 Inc(Top);
686 Top^ := Limit;
687 Limit := J;
688 end;
689 Inc(Top);
690 end
691 else
692 begin
693 // the sub-array is small, perform insertion sort
694 J := Base;
695 I := J;
696 Inc(I);
697
698 {$IFDEF FPC}
699 while PtrInt(I) < PtrInt(Limit) do
700 {$ELSE}
701 {$IFDEF HAS_NATIVEINT}
702 while NativeInt(I) < NativeInt(Limit) do
703 {$ELSE}
704 while Integer(I) < Integer(Limit) do
705 {$ENDIF}
706 {$ENDIF}
707 begin
708 {$IFDEF FPC}
709 while LessThan(PPCell(PtrInt(J) + SizeOf(PCell)), J) do
710 begin
711 SwapCells(PPCell(PtrInt(J) + SizeOf(PCell)), J);
712 {$ELSE}
713 {$IFDEF HAS_NATIVEINT}
714 while LessThan(PPCell(NativeUInt(J) + SizeOf(PCell)), J) do
715 begin
716 SwapCells(PPCell(NativeUInt(J) + SizeOf(PCell)), J);
717 {$ELSE}
718 while LessThan(PPCell(Cardinal(J) + SizeOf(PCell)), J) do
719 begin
720 SwapCells(PPCell(Cardinal(J) + SizeOf(PCell)), J);
721 {$ENDIF}
722 {$ENDIF}
723 if J = Base then
724 Break;
725 Dec(J);
726 end;
727 J := I;
728 Inc(I);
729 end;
730
731 {$IFDEF FPC}
732 if PtrInt(Top) > PtrInt(@Stack[0]) then
733 {$ELSE}
734 {$IFDEF HAS_NATIVEINT}
735 if NativeInt(Top) > NativeInt(@Stack[0]) then
736 {$ELSE}
737 if Integer(Top) > Integer(@Stack[0]) then
738 {$ENDIF}
739 {$ENDIF}
740 begin
741 Dec(Top, 2);
742 Base := Top^;
743 Limit := PPCell(Pointer(NativeInt(Top) + SizeOf(PPCell))^);
744 end
745 else
746 Break;
747 end;
748 end;
749end;
750
751var
752 FillSpan: procedure (Ptr: PColor32Array; Covers: PColor32; Count: Cardinal;
753 const C: TColor32);
754
755procedure FillSpan_Pas(Ptr: PColor32Array; Covers: PColor32; Count: Cardinal;
756 const C: TColor32);
757begin
758 repeat
759 BlendMemEx(C, PColor32(Ptr)^, Covers^);
760 Inc(Covers);
761 Inc(Ptr);
762 Dec(Count);
763 until Count = 0;
764end;
765
766procedure FillSpan_ASM(Ptr: PColor32Array; Covers: PColor32; Count: Cardinal;
767 const C: TColor32);
768asm
769{$IFDEF CPUX86}
770 PUSH EBX
771 PUSH ESI
772 PUSH EDI
773
774 LEA ESI, EDX + 4 * ECX // ESI = Covers
775 LEA EDI, EAX + 4 * ECX // EDI = P
776 NEG ECX
777
778@LoopStart:
779 MOVZX EBX, [ESI + 4 * ECX]
780 MOVZX EAX, [EBP + $0B] // EAX = C.A
781 IMUL EBX, EAX // EBX = Alpha
782
783 MOVZX EAX, [EDI + 4 * ECX]
784 MOVZX EDX, [EBP + $08] // EDX = C.R
785 SUB EDX, EAX
786 IMUL EDX, EBX
787 SHL EAX, $10
788 ADD EDX, EAX
789 SHR EDX, $10
790 MOV [EDI + 4 * ECX], DL // store to pointer
791
792 MOVZX EAX, [EDI + 4 * ECX + 1]
793 MOVZX EDX, [EBP + $09] // EDX = C.G
794 SUB EDX, EAX
795 IMUL EDX, EBX
796 SHL EAX, $10
797 ADD EDX, EAX
798 SHR EDX, $10
799 MOV [EDI + 4 * ECX + 1], DL // store to pointer
800
801 MOVZX EAX, [EDI + 4 * ECX + 2]
802 MOVZX EDX, [EBP + $0A] // EDX = C.B
803 SUB EDX, EAX
804 IMUL EDX, EBX
805 SHL EAX, $10
806 ADD EDX, EAX
807 SHR EDX, $10
808 MOV [EDI + 4 * ECX + 2], DL // store to pointer
809
810 MOVZX EAX, [EDI + 4 * ECX + 3]
811 MOVZX EDX, [EBP + $0B] // EDX = C.A
812 SUB EDX, EAX
813 IMUL EDX, EBX
814 SHL EAX, $10
815 ADD EDX, EAX
816 SHR EDX, $10
817 MOV [EDI + 4 * ECX + 3], DL // store to pointer
818
819 ADD ECX, 1
820 JS @LoopStart
821
822 POP EDI
823 POP ESI
824 POP EBX
825{$ENDIF}
826{$IFDEF CPUX64}
827 LEA R10, RDX + 4 * R8 // R10 = Covers
828 LEA R11, RCX + 4 * R8 // R11 = P
829 NEG R8D
830
831@LoopStart:
832 MOVZX R9D, [R10 + 4 * R8]
833 MOVZX ECX, [EBP + $0B] // ECX = C.A
834 IMUL R9D, ECX // R9D = Alpha
835
836 MOVZX ECX, [R11 + 4 * R8]
837 MOVZX EDX, [EBP + $08] // EDX = C.R
838 SUB EDX, ECX
839 IMUL EDX, R9D
840 SHL ECX, $10
841 ADD EDX, ECX
842 SHR EDX, $10
843 MOV [R11 + 4 * R8], DL // store to pointer
844
845 MOVZX ECX, [R11 + 4 * R8 + 1]
846 MOVZX EDX, [EBP + $09] // EDX = C.G
847 SUB EDX, ECX
848 IMUL EDX, R9D
849 SHL ECX, $10
850 ADD EDX, ECX
851 SHR EDX, $10
852 MOV [R11 + 4 * R8 + 1], DL // store to pointer
853
854 MOVZX ECX, [R11 + 4 * R8 + 2]
855 MOVZX EDX, [EBP + $0A] // EDX = C.B
856 SUB EDX, ECX
857 IMUL EDX, R9D
858 SHL ECX, $10
859 ADD EDX, ECX
860 SHR EDX, $10
861 MOV [R11 + 4 * R8 + 2], DL // store to pointer
862
863 MOVZX ECX, [R11 + 4 * R8 + 3]
864 MOVZX EDX, [EBP + $0B] // EDX = C.A
865 SUB EDX, ECX
866 IMUL EDX, R9D
867 SHL ECX, $10
868 ADD EDX, ECX
869 SHR EDX, $10
870 MOV [R11 + 4 * R8 + 3], DL // store to pointer
871
872 ADD R8D, 1
873 JS @LoopStart
874{$ENDIF}
875end;
876
877{$IFNDEF OMIT_MMX}
878{$IFDEF TARGET_X86}
879procedure FillSpan_MMX(Ptr: PColor32Array; Covers: PColor32; Count: Cardinal;
880 const C: TColor32);
881asm
882 JCXZ @3
883
884 PUSH EBX
885 PUSH ESI
886 MOV ESI,EAX
887 MOV EBX,C
888
889 PXOR MM3,MM3 // MM3 = 0
890
891 MOVD MM1,EBX // MM1 = C (Foreground)
892 PUNPCKLBW MM1,MM3
893
894 SHR EBX,24
895 JZ @2
896 INC EBX // 255:256 range bias
897
898@1:
899 MOVD MM2,[ESI] // MM2 = Dest (Background)
900 PUNPCKLBW MM2,MM3
901 MOV EAX,[EDX] // EAX = Alpha
902 IMUL EAX,EBX
903 SHR EAX,8
904 SHL EAX,4
905 ADD EAX,alpha_ptr
906 MOVQ MM0,MM1
907 PSUBW MM0,MM2
908 PMULLW MM0,[EAX]
909 PSLLW MM2,8
910 MOV EAX,bias_ptr
911 PADDW MM2,[EAX]
912 PADDW MM0,MM2
913 PSRLW MM0,8
914 PACKUSWB MM0,MM3
915 MOVD [ESI],MM0
916
917 ADD ESI,4
918 ADD EDX,4
919
920 DEC ECX
921 JNZ @1
922
923@2: POP ESI
924 POP EBX
925
926@3:
927end;
928{$ENDIF}
929{$ENDIF}
930
931{$IFNDEF OMIT_SSE2}
932procedure FillSpan_SSE2(Ptr: PColor32Array; Covers: PColor32; Count: Cardinal;
933 const C: TColor32);
934asm
935{$IFDEF TARGET_X86}
936 JCXZ @5
937
938 PUSH EBX
939 MOV EBX,C
940
941 PXOR XMM7,XMM7 // XMM7 = 0
942
943 MOVD XMM1,EBX // XMM1 = C (Foreground)
944 PUNPCKLBW XMM1,XMM7
945
946 SHR EBX,24
947 JZ @4
948 INC EBX // 255:256 range bias
949
950 PUSH ESI
951 MOV ESI,EAX
952
953@1: MOVQ XMM0,XMM1
954 MOVD XMM2,[ESI] // XMM2 = Dest (Background)
955 PUNPCKLBW XMM2,XMM7
956 MOV EAX,[EDX] // EAX = Alpha
957 IMUL EAX,EBX
958 SHR EAX,8
959 JZ @3
960 CMP EAX,$FF
961 JZ @2
962 SHL EAX,4
963 ADD EAX,alpha_ptr
964 PSUBW XMM0,XMM2
965 PMULLW XMM0,[EAX]
966 PSLLW XMM2,8
967 MOV EAX,bias_ptr
968 PADDW XMM2,[EAX]
969 PADDW XMM0,XMM2
970 PSRLW XMM0,8
971
972@2: PACKUSWB XMM0,XMM7
973 MOVD [ESI],XMM0
974
975@3: ADD ESI,4
976 ADD EDX,4
977
978 DEC ECX
979 JNZ @1
980
981 POP ESI
982@4: POP EBX
983
984@5:
985{$ENDIF}
986
987{$IFDEF TARGET_X64}
988 TEST R8D,R8D
989 JZ @4
990
991 PXOR XMM7,XMM7 // XMM7 = 0
992
993 MOVD XMM1,R9D // XMM1 = C (Foreground)
994 PUNPCKLBW XMM1,XMM7
995
996 SHR R9D,24
997 JZ @2
998 INC R9D // 255:256 range bias
999
1000@1: MOVQ XMM0,XMM1
1001 MOVD XMM2,[RCX] // XMM2 = Dest (Background)
1002 PUNPCKLBW XMM2,XMM7
1003 MOV EAX,[RDX] // EAX = Alpha
1004 IMUL EAX,R9D
1005 SHR EAX,8
1006 JZ @3
1007 CMP EAX,$FF
1008 JZ @2
1009 SHL EAX,4
1010 ADD RAX,alpha_ptr
1011 PSUBW XMM0,XMM2
1012 PMULLW XMM0,[RAX]
1013 PSLLW XMM2,8
1014 MOV RAX,bias_ptr
1015 PADDW XMM2,[RAX]
1016 PADDW XMM0,XMM2
1017 PSRLW XMM0,8
1018
1019@2: PACKUSWB XMM0,XMM7
1020 MOVD [RCX],XMM0
1021
1022@3: ADD ECX,4
1023 ADD EDX,4
1024
1025 DEC R8D
1026 JNZ @1
1027
1028@4:
1029{$ENDIF}
1030end;
1031{$ENDIF}
1032
1033function CalculateAlpha(FillMode: TPolyFillMode; Area: Integer): Cardinal;
1034var
1035 Cover: Integer;
1036const
1037 CAAShift = 8;
1038 CAANum = 1 shl CAAShift;
1039 CAAMask = CAANum - 1;
1040 CAA2Num = CAANum shl 1;
1041 CAA2Mask = CAA2Num - 1;
1042begin
1043 Cover := SAR_9(Area);
1044 if Cover < 0 then
1045 Cover := -Cover;
1046 if FillMode = pfEvenOdd then
1047 begin
1048 Cover := Cover and CAA2Mask;
1049 if Cover > CAANum then
1050 Cover := CAA2Num - Cover;
1051 end;
1052 if Cover > CAAMask then
1053 Cover := CAAMask;
1054 Result := Cover;
1055end;
1056
1057
1058{ TScanLine }
1059
1060constructor TScanLine.Create(MinX, MaxX: Integer);
1061begin
1062 inherited Create;
1063
1064 FMaxLen := MaxX - MinX + 2;
1065 GetMem(FCovers, FMaxLen * SizeOf(TColor32));
1066 GetMem(FStartPtrs, FMaxLen * SizeOf(PColor32));
1067 GetMem(FCounts, FMaxLen * SizeOf(Word));
1068 FLastX := $7FFF;
1069 FLastY := $7FFF;
1070 FMinX := MinX;
1071 FCurCount := FCounts;
1072 FCurStartPtr := FStartPtrs;
1073 FNumSpans := 0;
1074end;
1075
1076destructor TScanLine.Destroy;
1077begin
1078 FreeMem(FCounts);
1079 FreeMem(FStartPtrs);
1080 FreeMem(FCovers);
1081
1082 inherited Destroy;
1083end;
1084
1085procedure TScanLine.AddCell(X, Y: Integer; Cover: Cardinal);
1086begin
1087 Dec(X, FMinX);
1088 FCovers[X] := TColor32(Cover);
1089 if X = FLastX + 1 then
1090 Inc(FCurCount^)
1091 else
1092 begin
1093 Inc(FCurCount);
1094 FCurCount^ := 1;
1095 Inc(FCurStartPtr);
1096 FCurStartPtr^ := PColor32(@FCovers[X]);
1097 Inc(FNumSpans);
1098 end;
1099 FLastX := X;
1100 FLastY := Y;
1101end;
1102
1103procedure TScanLine.AddSpan(X, Y: Integer; Len, Cover: Cardinal);
1104begin
1105 Dec(X, FMinX);
1106 FillLongWord(FCovers[X], Len, Cover);
1107
1108 if X = FLastX + 1 then
1109 Inc(FCurCount^, Word(Len))
1110 else
1111 begin
1112 Inc(FCurCount);
1113 FCurCount^ := Word(Len);
1114 Inc(FCurStartPtr);
1115 FCurStartPtr^ := PColor32(@FCovers[X]);
1116 Inc(FNumSpans);
1117 end;
1118 FLastX := X + Integer(Len) - 1;
1119 FLastY := Y;
1120end;
1121
1122function TScanLine.IsReady(Y: Integer): Integer;
1123begin
1124 Result := Ord((FNumSpans <> 0) and ((Y xor FLastY) <> 0));
1125end;
1126
1127procedure TScanLine.ResetSpans;
1128begin
1129 FLastX := $7FFF;
1130 FLastY := $7FFF;
1131 FCurCount := FCounts;
1132 FCurStartPtr := FStartPtrs;
1133 FNumSpans := 0;
1134end;
1135
1136
1137{ TOutline }
1138
1139constructor TOutline.Create;
1140begin
1141 inherited Create;
1142
1143 FCurCellPtr := nil;
1144
1145 FMin.X := $7FFFFFFF;
1146 FMin.Y := $7FFFFFFF;
1147 FMax.X := -$7FFFFFFF;
1148 FMax.Y := -$7FFFFFFF;
1149 FFlags := [ofSortRequired];
1150 SetCell(FCurCell, $7FFF, $7FFF);
1151end;
1152
1153destructor TOutline.Destroy;
1154var
1155 Ptr: PPCell;
1156begin
1157 FreeMem(FSortedCells);
1158 if FNumBlocks <> 0 then
1159 begin
1160 Ptr := PPCell(Cardinal(FCells) + (FNumBlocks - 1) * SizeOf(PCell));
1161 while FNumBlocks <> 0 do
1162 begin
1163 FreeMem(Ptr^);
1164 Dec(Ptr);
1165
1166 Dec(FNumBlocks);
1167 end;
1168 FreeMem(FCells);
1169 end;
1170
1171 inherited Destroy;
1172end;
1173
1174procedure TOutline.Reset;
1175begin
1176 FNumCells := 0;
1177 FCurBlock := 0;
1178 InternalReset;
1179end;
1180
1181procedure TOutline.InternalReset;
1182begin
1183 FMin.X := $7FFFFFFF;
1184 FMin.Y := $7FFFFFFF;
1185 FMax.X := -$7FFFFFFF;
1186 FMax.Y := -$7FFFFFFF;
1187 FFlags := [ofSortRequired];
1188 SetCell(FCurCell, $7FFF, $7FFF);
1189end;
1190
1191procedure TOutline.AddCurCell;
1192begin
1193 if FCurCell.Area or FCurCell.Cover <> 0 then
1194 begin
1195 if FNumCells and CCellBlockMask = 0 then
1196 begin
1197 if FNumBlocks >= CCellBlockLimit then
1198 Exit;
1199 AllocateBlock;
1200 end;
1201 FCurCellPtr^ := FCurCell;
1202 Inc(FCurCellPtr);
1203 Inc(FNumCells);
1204 end;
1205end;
1206
1207procedure TOutline.AllocateBlock;
1208var
1209 NewCells: PPCell;
1210begin
1211 if FCurBlock >= FNumBlocks then
1212 begin
1213 if FNumBlocks >= FMaxBlocks then
1214 begin
1215 GetMem(NewCells, (FMaxBlocks + CCellBlockPool) * SizeOf(PCell));
1216 if Assigned(FCells) then
1217 begin
1218 Move(FCells^, NewCells^, FMaxBlocks * SizeOf(PCell));
1219 FreeMem(FCells);
1220 end;
1221 FCells := NewCells;
1222 Inc(FMaxBlocks, CCellBlockPool);
1223 end;
1224 GetMem(PPCell(Cardinal(FCells) + FNumBlocks * SizeOf(PCell))^,
1225 Cardinal(CCellBlockSize) * SizeOf(TCell));
1226 Inc(FNumBlocks);
1227 end;
1228 FCurCellPtr := PPCell(Cardinal(FCells) + FCurBlock * SizeOf(PCell))^;
1229 Inc(FCurBlock);
1230end;
1231
1232function TOutline.GetCells: PPCell;
1233begin
1234 if ofNotClosed in FFlags then
1235 begin
1236 LineTo(FClose.X, FClose.Y);
1237 FFlags := FFlags - [ofNotClosed];
1238 end;
1239
1240 // Perform sort only the first time.
1241 if ofSortRequired in FFlags then
1242 begin
1243 AddCurCell;
1244 if FNumCells = 0 then
1245 begin
1246 Result := nil;
1247 Exit;
1248 end;
1249 SortCells;
1250 FFlags := FFlags - [ofSortRequired];
1251 end;
1252 Result := FSortedCells;
1253end;
1254
1255procedure TOutline.LineTo(X, Y: Integer);
1256var
1257 C: Integer;
1258begin
1259 if (ofSortRequired in FFlags) and (((FCur.X xor X) or (FCur.Y xor Y)) <> 0) then
1260 begin
1261 C := SAR_8(FCur.X);
1262 if C < FMin.X then FMin.X := C;
1263 Inc(C);
1264 if C > FMax.X then FMax.X := C;
1265
1266 C := SAR_8(X);
1267 if C < FMin.X then FMin.X := C;
1268 Inc(C);
1269 if C > FMax.X then FMax.X := C;
1270
1271 RenderLine(FCur.X, FCur.Y, X, Y);
1272 FCur.X := X;
1273 FCur.Y := Y;
1274 FFlags := FFlags + [ofNotClosed];
1275 end;
1276end;
1277
1278procedure TOutline.MoveTo(X, Y: Integer);
1279begin
1280 if not (ofSortRequired in FFlags) then //-7468, -6124, -6124, -4836
1281 Reset;
1282 if ofNotClosed in FFlags then
1283 LineTo(FClose.X, FClose.Y);
1284
1285 SetCurCell(SAR_8(X), SAR_8(Y));
1286
1287 FCur.X := X;
1288 FClose.X := X;
1289 FCur.Y := Y;
1290 FClose.Y := Y;
1291end;
1292
1293procedure TOutline.RenderLine(X1, Y1, X2, Y2: Integer);
1294var
1295 EY1, EY2, FY1, FY2, Dx, Dy, XFrom, XTo, P, Rem, AMod, Lift: Integer;
1296 Delta, First, Incr, EX, TwoFx, Area: Integer;
1297begin
1298 EY1 := SAR_8(Y1);
1299 EY2 := SAR_8(Y2);
1300 FY1 := Y1 and CPolyBaseMask;
1301 FY2 := Y2 and CPolyBaseMask;
1302
1303 if EY1 < FMin.Y then FMin.Y := EY1;
1304 if EY1 >= FMax.Y then FMax.Y := EY1 + 1;
1305 if EY2 < FMin.Y then FMin.Y := EY2;
1306 if EY2 >= FMax.Y then FMax.Y := EY2 + 1;
1307
1308 Dx := X2 - X1;
1309 Dy := Y2 - Y1;
1310
1311 // everything is on a single scanline
1312 if EY1 = EY2 then
1313 begin
1314 RenderScanLine(EY1, X1, FY1, X2, FY2);
1315 Exit;
1316 end;
1317
1318 // Vertical line - we have to calculate start and end cells, and then -
1319 // the common values of the area and coverage for all cells of the line.
1320 // We know exactly there's only one cell, so, we don't have to call
1321 // RenderScanline().
1322 Incr := 1;
1323 if Dx = 0 then
1324 begin
1325 EX := SAR_8(X1);
1326 TwoFx := (X1 - (EX shl CPolyBaseShift)) shl 1;
1327
1328 First := CPolyBaseSize;
1329 if Dy < 0 then
1330 begin
1331 First := 0;
1332 Incr := -1;
1333 end;
1334
1335 Delta := First - FY1;
1336 Inc(FCurCell.Cover, Delta);
1337 Inc(FCurCell.Area, TwoFx * Delta);
1338
1339 Inc(EY1, Incr);
1340 SetCurCell(EX, EY1);
1341
1342 Delta := First + First - CPolyBaseSize;
1343 Area := TwoFx * Delta;
1344 while EY1 <> EY2 do
1345 begin
1346 FCurCell.Cover := Delta;
1347 FCurCell.Area := Area;
1348 Inc(EY1, Incr);
1349 SetCurCell(EX, EY1);
1350 end;
1351 Delta := FY2 - CPolyBaseSize + First;
1352 Inc(FCurCell.Cover, Delta);
1353 Inc(FCurCell.Area, TwoFx * Delta);
1354 Exit;
1355 end;
1356
1357 // ok, we have to render several scanlines
1358 P := (CPolyBaseSize - FY1) * Dx;
1359 First := CPolyBaseSize;
1360
1361 if Dy < 0 then
1362 begin
1363 P := FY1 * Dx;
1364 First := 0;
1365 Incr := -1;
1366 Dy := -Dy;
1367 end;
1368
1369 Delta := P div Dy;
1370 AMod := P mod Dy;
1371
1372 if AMod < 0 then
1373 begin
1374 Dec(Delta);
1375 Inc(AMod, Dy);
1376 end;
1377
1378 XFrom := X1 + Delta;
1379 RenderScanLine(EY1, X1, FY1, XFrom, First);
1380
1381 Inc(EY1, Incr);
1382 SetCurCell(SAR_8(XFrom), EY1);
1383
1384 if EY1 <> EY2 then
1385 begin
1386 P := CPolyBaseSize * Dx;
1387 Lift := P div Dy;
1388 Rem := P mod Dy;
1389
1390 if Rem < 0 then
1391 begin
1392 Dec(Lift);
1393 Inc(Rem, Dy);
1394 end;
1395 Dec(AMod, Dy);
1396
1397 while EY1 <> EY2 do
1398 begin
1399 Delta := Lift;
1400 Inc(AMod, Rem);
1401 if AMod >= 0 then
1402 begin
1403 Dec(AMod, Dy);
1404 Inc(Delta);
1405 end;
1406
1407 XTo := XFrom + Delta;
1408 RenderScanLine(EY1, XFrom, CPolyBaseSize - First, XTo, First);
1409 XFrom := XTo;
1410
1411 Inc(EY1, Incr);
1412 SetCurCell(SAR_8(XFrom), EY1);
1413 end;
1414 end;
1415
1416 RenderScanLine(EY1, XFrom, CPolyBaseSize - First, X2, FY2);
1417end;
1418
1419procedure TOutline.RenderScanLine(EY, X1, Y1, X2, Y2: Integer);
1420var
1421 EX1, EX2, FX1, FX2, Delta, P, First, Dx, Incr, Lift, AMod, Rem: Integer;
1422begin
1423 EX1 := SAR_8(X1);
1424 EX2 := SAR_8(X2);
1425 FX1 := X1 and CPolyBaseMask;
1426 FX2 := X2 and CPolyBaseMask;
1427
1428 // trivial case. Happens often
1429 if Y1 = Y2 then
1430 begin
1431 SetCurCell(EX2, EY);
1432 Exit;
1433 end;
1434
1435 // everything is located in a single cell. That is easy!
1436 if EX1 = EX2 then
1437 begin
1438 Delta := Y2 - Y1;
1439 Inc(FCurCell.Cover, Delta);
1440 Inc(FCurCell.Area, (FX1 + FX2) * Delta);
1441 Exit;
1442 end;
1443
1444 // ok, we'll have to render a run of adjacent cells on the same scanline...
1445 P := (CPolyBaseSize - FX1) * (Y2 - Y1);
1446 First := CPolyBaseSize;
1447 Incr := 1;
1448
1449 Dx := X2 - X1;
1450
1451 if Dx < 0 then
1452 begin
1453 P := FX1 * (Y2 - Y1);
1454 First := 0;
1455 Incr := -1;
1456 Dx := -Dx;
1457 end;
1458
1459 Delta := P div Dx;
1460 AMod := P mod Dx;
1461
1462 if AMod < 0 then
1463 begin
1464 Dec(Delta);
1465 Inc(AMod, Dx);
1466 end;
1467
1468 Inc(FCurCell.Cover, Delta);
1469 Inc(FCurCell.Area, (FX1 + First) * Delta);
1470 Inc(EX1, Incr);
1471 SetCurCell(EX1, EY);
1472 Inc(Y1, Delta);
1473
1474 if EX1 <> EX2 then
1475 begin
1476 P := CPolyBaseSize * (Y2 - Y1 + Delta);
1477 Lift := P div Dx;
1478 Rem := P mod Dx;
1479
1480 if Rem < 0 then
1481 begin
1482 Dec(Lift);
1483 Inc(Rem, Dx);
1484 end;
1485
1486 Dec(AMod, Dx);
1487
1488 while EX1 <> EX2 do
1489 begin
1490 Delta := Lift;
1491 Inc(AMod, Rem);
1492 if AMod >= 0 then
1493 begin
1494 Dec(AMod, Dx);
1495 Inc(Delta);
1496 end;
1497
1498 Inc(FCurCell.Cover, Delta);
1499 Inc(FCurCell.Area, CPolyBaseSize * Delta);
1500 Inc(Y1, Delta);
1501 Inc(EX1, Incr);
1502 SetCurCell(EX1, EY);
1503 end;
1504 end;
1505
1506 Delta := Y2 - Y1;
1507 Inc(FCurCell.Cover, Delta);
1508 Inc(FCurCell.Area, (FX2 + CPolyBaseSize - First) * Delta);
1509end;
1510
1511procedure TOutline.SetCurCell(X, Y: Integer);
1512begin
1513 if FCurCell.PackedCoord <> (Y shl 16) + X then
1514 begin
1515 AddCurCell;
1516 SetCell(FCurCell, X, Y);
1517 end;
1518end;
1519
1520procedure TOutline.SortCells;
1521var
1522 SortedPtr, BlockPtr: PPCell;
1523 CellPtr: PCell;
1524 NB, I: Cardinal;
1525begin
1526 if FNumCells = 0 then
1527 Exit;
1528
1529 if FNumCells > FSortedSize then
1530 begin
1531 FreeMem(FSortedCells);
1532 FSortedSize := FNumCells;
1533 GetMem(FSortedCells, (FNumCells + 1) * SizeOf(PCell));
1534 end;
1535
1536 SortedPtr := FSortedCells;
1537 BlockPtr := FCells;
1538
1539 NB := FNumCells shr CCellBlockShift;
1540
1541 while NB <> 0 do
1542 begin
1543 Dec(NB);
1544
1545 CellPtr := BlockPtr^;
1546 Inc(BlockPtr);
1547 I := CCellBlockSize;
1548 while I <> 0 do
1549 begin
1550 Dec(I);
1551
1552 SortedPtr^ := CellPtr;
1553 Inc(SortedPtr);
1554 Inc(CellPtr);
1555 end;
1556 end;
1557
1558 CellPtr := BlockPtr^;
1559 I := FNumCells and CCellBlockMask;
1560 while I <> 0 do
1561 begin
1562 Dec(I);
1563
1564 SortedPtr^ := CellPtr;
1565 Inc(SortedPtr);
1566 Inc(CellPtr);
1567 end;
1568 PPCell(Cardinal(FSortedCells) + FNumCells * SizeOf(PCell))^ := nil;
1569
1570 QSortCells(FSortedCells, FNumCells);
1571end;
1572
1573
1574{ TPolygonRenderer32AggLite }
1575
1576procedure TPolygonRenderer32AggLite.Render(CellsPtr: Pointer; MinX, MaxX: Integer);
1577var
1578 X, Y, Cover, Alpha, Area, Coord: Integer;
1579 Cells: PPCell absolute CellsPtr;
1580 CurCell, StartCell: PCell;
1581 ScanLine: TScanLine;
1582
1583 procedure RenderSpan;
1584 var
1585 NumSpans: Cardinal;
1586 BaseX: Integer;
1587 Row: PColor32Array;
1588 CurX: Integer;
1589 Covers: PColor32;
1590 NumPix: Integer;
1591 BaseCovers: Pointer;
1592 CurCount: PWord;
1593 CurStartPtr: PPColor32;
1594
1595 begin
1596 NumSpans := ScanLine.NumSpans;
1597 BaseX := ScanLine.BaseX;
1598 Row := Bitmap.ScanLine[ScanLine.Y];
1599
1600 BaseCovers := ScanLine.CoversPtr;
1601 CurCount := ScanLine.CountsPtr;
1602 CurStartPtr := ScanLine.StartPtrs;
1603
1604 if Assigned(Filler) then
1605 repeat
1606 Dec(NumSpans);
1607 Inc(CurCount);
1608 Inc(CurStartPtr);
1609 {$IFDEF FPC}
1610 CurX := (PtrInt(CurStartPtr^) - PtrInt(BaseCovers)) div SizeOf(TColor32) + BaseX;
1611 {$ELSE}
1612 {$IFDEF HAS_NATIVEINT}
1613 CurX := (NativeInt(CurStartPtr^) - NativeInt(BaseCovers)) div SizeOf(TColor32) + BaseX;
1614 {$ELSE}
1615 CurX := (Integer(CurStartPtr^) - Integer(BaseCovers)) div SizeOf(TColor32) + BaseX;
1616 {$ENDIF}
1617 {$ENDIF}
1618 Covers := CurStartPtr^;
1619 NumPix := CurCount^;
1620
1621 if CurX < 0 then
1622 begin
1623 Inc(NumPix, CurX);
1624 if NumPix <= 0 then
1625 Continue;
1626 Dec(Covers, CurX);
1627 CurX := 0;
1628 end;
1629 if CurX + NumPix >= Bitmap.Width then
1630 begin
1631 NumPix := Bitmap.Width - CurX;
1632 if NumPix <= 0 then
1633 Continue;
1634 end;
1635
1636 Filler.FillLine(@Row^[CurX], CurX, ScanLine.Y, NumPix, Covers, Bitmap.CombineMode);
1637 until NumSpans = 0
1638 else
1639 repeat
1640 Dec(NumSpans);
1641 Inc(CurCount);
1642 Inc(CurStartPtr);
1643 {$IFDEF FPC}
1644 CurX := (PtrInt(CurStartPtr^) - PtrInt(BaseCovers)) div SizeOf(TColor32) + BaseX;
1645 {$ELSE}
1646 {$IFDEF HAS_NATIVEINT}
1647 CurX := (NativeInt(CurStartPtr^) - NativeInt(BaseCovers)) div SizeOf(TColor32) + BaseX;
1648 {$ELSE}
1649 CurX := (Integer(CurStartPtr^) - Integer(BaseCovers)) div SizeOf(TColor32) + BaseX;
1650 {$ENDIF}
1651 {$ENDIF}
1652
1653 Covers := CurStartPtr^;
1654 NumPix := CurCount^;
1655
1656 if CurX < 0 then
1657 begin
1658 Inc(NumPix, CurX);
1659 if NumPix <= 0 then
1660 Continue;
1661 Dec(Covers, CurX);
1662 CurX := 0;
1663 end;
1664 if CurX + NumPix >= Bitmap.Width then
1665 begin
1666 NumPix := Bitmap.Width - CurX;
1667 if NumPix <= 0 then
1668 Continue;
1669 end;
1670
1671 FillSpan(@Row^[CurX], PColor32(Covers), NumPix, Color);
1672 until NumSpans = 0;
1673 EMMS;
1674 end;
1675
1676begin
1677 ScanLine := TScanLine.Create(MinX, MaxX); // -32, 64
1678 try
1679 Cover := 0;
1680 CurCell := Cells^;
1681 Inc(Cells);
1682 while True do
1683 begin
1684 StartCell := CurCell;
1685
1686 Coord := CurCell^.Pnt.PackedCoord;
1687 X := CurCell^.Pnt.X;
1688 Y := CurCell^.Pnt.Y;
1689
1690 Area := StartCell^.Area;
1691 Inc(Cover, StartCell^.Cover);
1692
1693 CurCell := Cells^;
1694 Inc(Cells);
1695 while Assigned(CurCell) do
1696 begin
1697 if CurCell^.Pnt.PackedCoord <> Coord then
1698 Break;
1699 Inc(Area, CurCell^.Area);
1700 Inc(Cover, CurCell^.Cover);
1701
1702 CurCell := Cells^;
1703 Inc(Cells);
1704 end;
1705
1706 if Area <> 0 then
1707 begin
1708 Alpha := CalculateAlpha(Fillmode, (Cover shl (CPolyBaseShift + 1)) - Area);
1709 if Alpha <> 0 then
1710 begin
1711 if ScanLine.IsReady(Y) <> 0 then
1712 begin
1713 if (ScanLine.Y >= 0) and (ScanLine.Y < Bitmap.Height) then
1714 RenderSpan;
1715 ScanLine.ResetSpans;
1716 end;
1717 ScanLine.AddCell(X, Y, GAMMA_ENCODING_TABLE[Alpha]);
1718 end;
1719 Inc(X);
1720 end;
1721
1722 if not Assigned(CurCell) then
1723 Break;
1724
1725 if CurCell^.Pnt.X > X then
1726 begin
1727 Alpha := CalculateAlpha(Fillmode, Cover shl (CPolyBaseShift + 1));
1728 if Alpha <> 0 then
1729 begin
1730 if ScanLine.IsReady(Y) <> 0 then
1731 begin
1732 if (ScanLine.Y >= 0) and (ScanLine.Y < Bitmap.Height) then
1733 RenderSpan;
1734 ScanLine.ResetSpans;
1735 end;
1736 ScanLine.AddSpan(X, Y, CurCell^.Pnt.X - X, GAMMA_ENCODING_TABLE[Alpha]);
1737 end;
1738 end;
1739 end;
1740
1741 with ScanLine do
1742 if (NumSpans <> 0) and (Y >= 0) and (Y < Bitmap.Height) then
1743 RenderSpan;
1744 finally
1745 ScanLine.Free;
1746 end;
1747end;
1748
1749type
1750 TBitmap32Access = class(TBitmap32);
1751
1752procedure TPolygonRenderer32AggLite.PolygonFS(
1753 const Points: TArrayOfFloatPoint; const ClipRect: TFloatRect);
1754var
1755 I: Integer;
1756 Cells: PPCell;
1757 OutLine: TOutline;
1758 APoints: TArrayOfFloatPoint;
1759 R: TFloatRect;
1760begin
1761 R := ClipRect;
1762 InflateRect(R, 0.05, 0.05);
1763 APoints := ClipPolygon (Points, R);
1764
1765 OutLine := TOutline.Create;
1766 try
1767 OutLine.Reset;
1768 OutLine.MoveTo(Fixed8(APoints[0].X), Fixed8(APoints[0].Y));
1769 for I := 1 to High(APoints) do
1770 OutLine.LineTo(Fixed8(APoints[I].X), Fixed8(APoints[I].Y));
1771
1772 // get cells and check count
1773 Cells := OutLine.Cells;
1774 if OutLine.NumCells = 0 then
1775 Exit;
1776
1777 if Assigned(Filler) then
1778 begin
1779 // call begin rendering of assigned filler
1780 Filler.BeginRendering;
1781
1782 Render(Cells, OutLine.MinX, OutLine.MaxX);
1783
1784 // rendering done, call end rendering of assigned filler
1785 Filler.EndRendering;
1786 end
1787 else
1788 Render(Cells, OutLine.MinX, OutLine.MaxX);
1789
1790 {$IFDEF CHANGENOTIFICATIONS}
1791 if TBitmap32Access(Bitmap).UpdateCount = 0 then
1792 if Length(APoints) > 0 then
1793 Bitmap.Changed(MakeRect(OutLine.MinX, OutLine.MinY, OutLine.MaxX,
1794 OutLine.MaxY));
1795 {$ENDIF}
1796 finally
1797 SetLength(APoints, 0);
1798 OutLine.Free;
1799 end;
1800end;
1801
1802procedure TPolygonRenderer32AggLite.PolyPolygonFS(
1803 const Points: TArrayOfArrayOfFloatPoint; const ClipRect: TFloatRect);
1804var
1805 I, J: Integer;
1806 Cells: PPCell;
1807 OutLine: TOutline;
1808 Bounds: TRect;
1809 APoints: TArrayOfArrayOfFloatPoint;
1810 R: TFloatRect;
1811 FirstValid: integer;
1812begin
1813 if Length(Points) = 0 then
1814 Exit;
1815
1816 APoints := Points;
1817 // temporary fix for floating point rounding errors - corr. - to + by pws
1818 R := ClipRect;
1819 InflateRect(R, 0.05, 0.05);
1820 FirstValid := -1;
1821 for i := 0 to High(APoints) do
1822 begin
1823 APoints[i] := ClipPolygon(Points[I], R);
1824 if (FirstValid = -1) and (Length(APoints[i]) > 0) then
1825 FirstValid := i;
1826 end;
1827
1828 if (FirstValid = -1) then
1829 exit; // All were clipped
1830
1831 OutLine := TOutline.Create;
1832 try
1833 OutLine.Reset;
1834 OutLine.MoveTo(Fixed8(APoints[FirstValid, 0].X), Fixed8(APoints[FirstValid, 0].Y));
1835 for I := 1 to High(APoints[FirstValid]) do
1836 OutLine.LineTo(Fixed8(APoints[FirstValid, I].X), Fixed8(APoints[FirstValid, I].Y));
1837
1838 Bounds := MakeRect(OutLine.MinX, OutLine.MinY, OutLine.MaxX, OutLine.MaxY);
1839
1840 for J := FirstValid+1 to High(APoints) do
1841 begin
1842 if (Length(APoints[J]) = 0) then
1843 continue;
1844 OutLine.MoveTo(Fixed8(APoints[J, 0].X), Fixed8(APoints[J, 0].Y));
1845 for I := 1 to High(APoints[J]) do
1846 OutLine.LineTo(Fixed8(APoints[J, I].X), Fixed8(APoints[J, I].Y));
1847
1848 Bounds.Left := Min(Bounds.Left, OutLine.MinX);
1849 Bounds.Right := Max(Bounds.Right, OutLine.MaxX);
1850 Bounds.Top := Min(Bounds.Top, OutLine.MinY);
1851 Bounds.Bottom := Max(Bounds.Bottom, OutLine.MaxY);
1852 end;
1853
1854 // get cells and check count
1855 Cells := OutLine.Cells;
1856 if OutLine.NumCells = 0 then
1857 Exit;
1858
1859 if Assigned(Filler) then
1860 begin
1861 // call begin rendering of assigned filler
1862 Filler.BeginRendering;
1863
1864 Render(Cells, Bounds.Left, Bounds.Right);
1865
1866 // rendering done, call end rendering of assigned filler
1867 Filler.EndRendering;
1868 end
1869 else
1870 Render(Cells, Bounds.Left, Bounds.Right);
1871
1872{$IFDEF CHANGENOTIFICATIONS}
1873 if TBitmap32Access(Bitmap).UpdateCount = 0 then
1874 for I := 0 to High(APoints) do
1875 if Length(APoints[I]) > 0 then
1876 Bitmap.Changed(Bounds);
1877{$ENDIF}
1878 finally
1879 OutLine.Free;
1880 SetLength(APoints, 0);
1881 end;
1882end;
1883
1884const
1885 FID_FILLSPAN = 0;
1886
1887procedure RegisterBindings;
1888begin
1889 BlendRegistry := NewRegistry('GR32_PolygonsAggLite bindings');
1890 BlendRegistry.RegisterBinding(FID_FILLSPAN, @@FILLSPAN);
1891
1892 // pure pascal
1893 BlendRegistry.Add(FID_FILLSPAN, @FILLSPAN_Pas);
1894
1895{$IFNDEF PUREPASCAL}
1896 BlendRegistry.Add(FID_FILLSPAN, @FILLSPAN_ASM, []);
1897{$IFNDEF OMIT_MMX}
1898 BlendRegistry.Add(FID_FILLSPAN, @FILLSPAN_MMX, [ciMMX]);
1899{$ENDIF}
1900
1901{$IFNDEF OMIT_SSE2}
1902 BlendRegistry.Add(FID_FILLSPAN, @FILLSPAN_SSE2, [ciSSE2]);
1903{$ENDIF}
1904{$ENDIF}
1905
1906 BlendRegistry.RebindAll;
1907end;
1908
1909initialization
1910 RegisterPolygonRenderer(TPolygonRenderer32AggLite);
1911 RegisterBindings;
1912
1913finalization
1914
1915end.
Note: See TracBrowser for help on using the repository browser.