source: trunk/Packages/Graphics32/GR32_Rasterizers.pas

Last change on this file was 2, checked in by chronos, 6 years ago
File size: 23.7 KB
Line 
1unit GR32_Rasterizers;
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 Graphics32
24 *
25 * The Initial Developer of the Original Code is
26 * Mattias Andersson
27 *
28 * Portions created by the Initial Developer are Copyright (C) 2004-2009
29 * the Initial Developer. All Rights Reserved.
30 *
31 * Contributor(s):
32 * Steffen Binas <steffen.binas@aquasoft.de>
33 *
34 * ***** END LICENSE BLOCK ***** *)
35
36interface
37
38{$I GR32.inc}
39
40uses
41{$IFDEF FPC}
42 LCLIntf,
43 {$IFDEF Windows}
44 Windows,
45 {$ENDIF}
46{$ELSE}
47 Windows,
48{$ENDIF}
49 Classes, GR32, GR32_Blend;
50
51type
52 TAssignColor = procedure(var Dst: TColor32; Src: TColor32) of object;
53
54 PCombineInfo = ^TCombineInfo;
55 TCombineInfo = record
56 SrcAlpha: Integer;
57 DrawMode: TDrawMode;
58 CombineMode: TCombineMode;
59 CombineCallBack: TPixelCombineEvent;
60 TransparentColor: TColor32;
61 end;
62
63type
64 { TRasterizer }
65 { A base class for TCustomBitmap32-specific rasterizers. }
66 TRasterizer = class(TThreadPersistent)
67 private
68 FSampler: TCustomSampler;
69 FSrcAlpha: Integer;
70 FBlendMemEx: TBlendMemEx;
71 FCombineCallBack: TPixelCombineEvent;
72 FAssignColor: TAssignColor;
73 FTransparentColor: TColor32;
74 procedure SetSampler(const Value: TCustomSampler);
75 procedure SetCombineInfo(const CombineInfo: TCombineInfo);
76 procedure AssignColorOpaque(var Dst: TColor32; Src: TColor32);
77 procedure AssignColorBlend(var Dst: TColor32; Src: TColor32);
78 procedure AssignColorCustom(var Dst: TColor32; Src: TColor32);
79 procedure AssignColorTransparent(var Dst: TColor32; Src: TColor32);
80 protected
81 procedure AssignTo(Dst: TPersistent); override;
82 procedure DoRasterize(Dst: TCustomBitmap32; DstRect: TRect); virtual; abstract;
83 property AssignColor: TAssignColor read FAssignColor write FAssignColor;
84 public
85 constructor Create; override;
86 procedure Assign(Source: TPersistent); override;
87 procedure Rasterize(Dst: TCustomBitmap32); overload;
88 procedure Rasterize(Dst: TCustomBitmap32; const DstRect: TRect); overload;
89 procedure Rasterize(Dst: TCustomBitmap32; const DstRect: TRect; const CombineInfo: TCombineInfo); overload;
90 procedure Rasterize(Dst: TCustomBitmap32; const DstRect: TRect; Src: TCustomBitmap32); overload;
91 published
92 property Sampler: TCustomSampler read FSampler write SetSampler;
93 end;
94
95 TRasterizerClass = class of TRasterizer;
96
97 { TRegularSamplingRasterizer }
98 { This rasterizer simply picks one sample for each pixel in the output bitmap. }
99 TRegularRasterizer = class(TRasterizer)
100 private
101 FUpdateRowCount: Integer;
102 protected
103 procedure DoRasterize(Dst: TCustomBitmap32; DstRect: TRect); override;
104 public
105 constructor Create; override;
106 published
107 property UpdateRowCount: Integer read FUpdateRowCount write FUpdateRowCount;
108 end;
109
110 { TSwizzlingRasterizer }
111 { An interesting rasterization method where sample locations are choosen
112 according to a fractal pattern called 'swizzling'. With a slight
113 modification to the algorithm this routine will actually yield the
114 well-known sierpinski triangle fractal. An advantage with this pattern
115 is that it may benefit from local coherency in the sampling method used. }
116 TSwizzlingRasterizer = class(TRasterizer)
117 private
118 FBlockSize: Integer;
119 procedure SetBlockSize(const Value: Integer);
120 protected
121 procedure DoRasterize(Dst: TCustomBitmap32; DstRect: TRect); override;
122 public
123 constructor Create; override;
124 published
125 property BlockSize: Integer read FBlockSize write SetBlockSize default 3;
126 end;
127
128 { TProgressiveRasterizer }
129 { This class will perform rasterization in a progressive manner. It performs
130 subsampling with a block size of 2^n and will successively decrease n in
131 each iteration until n equals zero. }
132 TProgressiveRasterizer = class(TRasterizer)
133 private
134 FSteps: Integer;
135 FUpdateRows: Boolean;
136 procedure SetSteps(const Value: Integer);
137 procedure SetUpdateRows(const Value: Boolean);
138 protected
139 procedure DoRasterize(Dst: TCustomBitmap32; DstRect: TRect); override;
140 public
141 constructor Create; override;
142 published
143 property Steps: Integer read FSteps write SetSteps default 4;
144 property UpdateRows: Boolean read FUpdateRows write SetUpdateRows default True;
145 end;
146
147 { TTesseralRasterizer }
148 { This is a recursive rasterization method. It uses a divide-and-conquer
149 scheme to subdivide blocks vertically and horizontally into smaller blocks. }
150 TTesseralRasterizer = class(TRasterizer)
151 protected
152 procedure DoRasterize(Dst: TCustomBitmap32; DstRect: TRect); override;
153 end;
154
155 { TContourRasterizer }
156 TContourRasterizer = class(TRasterizer)
157 protected
158 procedure DoRasterize(Dst: TCustomBitmap32; DstRect: TRect); override;
159 end;
160
161 { TMultithreadedRegularRasterizer }
162 TMultithreadedRegularRasterizer = class(TRasterizer)
163 protected
164 procedure DoRasterize(Dst: TCustomBitmap32; DstRect: TRect); override;
165 end;
166
167{ Auxiliary routines }
168function CombineInfo(Bitmap: TCustomBitmap32): TCombineInfo;
169
170const
171 DEFAULT_COMBINE_INFO: TCombineInfo = (
172 SrcAlpha: $FF;
173 DrawMode: dmOpaque;
174 CombineMode: cmBlend;
175 CombineCallBack: nil;
176 TransparentColor: clBlack32;
177 );
178
179var
180 DefaultRasterizerClass: TRasterizerClass = TRegularRasterizer;
181 NumberOfProcessors: Integer = 1;
182
183implementation
184
185uses
186 Math, SysUtils, GR32_Math, GR32_System, GR32_LowLevel, GR32_Resamplers,
187 GR32_Containers, GR32_OrdinalMaps;
188
189type
190 TCustomBitmap32Access = class(TCustomBitmap32);
191
192 TLineRasterizerData = record
193 ScanLine: Integer;
194 end;
195 PLineRasterizerData = ^TLineRasterizerData;
196
197 TScanLineRasterizerThread = class(TThread)
198 protected
199 Data: PLineRasterizerData;
200 DstRect: TRect;
201 Dst: TCustomBitmap32;
202 GetSample: TGetSampleInt;
203 AssignColor: TAssignColor;
204 procedure Execute; override;
205 end;
206
207function CombineInfo(Bitmap: TCustomBitmap32): TCombineInfo;
208begin
209 with Result do
210 begin
211 SrcAlpha := Bitmap.MasterAlpha;
212 DrawMode := Bitmap.DrawMode;
213 CombineMode := Bitmap.CombineMode;
214 CombineCallBack := Bitmap.OnPixelCombine;
215 if (DrawMode = dmCustom) and not Assigned(CombineCallBack) then
216 DrawMode := dmOpaque;
217 TransparentColor := Bitmap.OuterColor;
218 end;
219end;
220
221
222{ TRasterizer }
223
224procedure TRasterizer.AssignColorBlend(var Dst: TColor32; Src: TColor32);
225begin
226 FBlendMemEx(Src, Dst, FSrcAlpha);
227 EMMS;
228end;
229
230procedure TRasterizer.AssignColorOpaque(var Dst: TColor32; Src: TColor32);
231begin
232 Dst := Src;
233end;
234
235procedure TRasterizer.AssignColorCustom(var Dst: TColor32; Src: TColor32);
236begin
237 FCombineCallBack(Src, Dst, FSrcAlpha);
238end;
239
240procedure TRasterizer.AssignColorTransparent(var Dst: TColor32;
241 Src: TColor32);
242begin
243 if Src <> FTransparentColor then Dst := Src;
244end;
245
246procedure TRasterizer.AssignTo(Dst: TPersistent);
247begin
248 if Dst is TRasterizer then
249 SmartAssign(Self, Dst)
250 else
251 inherited;
252end;
253
254procedure TRasterizer.Rasterize(Dst: TCustomBitmap32; const DstRect: TRect;
255 Src: TCustomBitmap32);
256begin
257 Rasterize(Dst, DstRect, CombineInfo(Src));
258end;
259
260procedure TRasterizer.Rasterize(Dst: TCustomBitmap32; const DstRect: TRect;
261 const CombineInfo: TCombineInfo);
262begin
263 SetCombineInfo(CombineInfo);
264 Rasterize(Dst, DstRect);
265end;
266
267procedure TRasterizer.SetCombineInfo(const CombineInfo: TCombineInfo);
268begin
269 with CombineInfo do
270 begin
271 FTransparentColor := TransparentColor;
272
273 FSrcAlpha := SrcAlpha;
274 FBlendMemEx := BLEND_MEM_EX[CombineMode]^;
275 FCombineCallBack := CombineCallBack;
276
277 case DrawMode of
278 dmOpaque: FAssignColor := AssignColorOpaque;
279 dmBlend: FAssignColor := AssignColorBlend;
280 dmTransparent: FAssignColor := AssignColorTransparent;
281 else
282 if Assigned(FCombineCallback) then
283 FAssignColor := AssignColorCustom
284 else
285 FAssignColor := AssignColorBlend;
286 end;
287 end;
288end;
289
290procedure TRasterizer.Rasterize(Dst: TCustomBitmap32; const DstRect: TRect);
291var
292 UpdateCount: Integer;
293 R: TRect;
294begin
295 UpdateCount := TCustomBitmap32Access(Dst).UpdateCount;
296 if Assigned(FSampler) then
297 begin
298 FSampler.PrepareSampling;
299 IntersectRect(R, DstRect, Dst.BoundsRect);
300 if FSampler.HasBounds then
301 IntersectRect(R, DstRect, MakeRect(FSampler.GetSampleBounds, rrOutside));
302 try
303 DoRasterize(Dst, R);
304 finally
305 while TCustomBitmap32Access(Dst).UpdateCount > UpdateCount do
306 TCustomBitmap32Access(Dst).EndUpdate;
307 FSampler.FinalizeSampling;
308 end;
309 end;
310end;
311
312procedure TRasterizer.SetSampler(const Value: TCustomSampler);
313begin
314 if FSampler <> Value then
315 begin
316 FSampler := Value;
317 Changed;
318 end;
319end;
320
321procedure TRasterizer.Rasterize(Dst: TCustomBitmap32);
322begin
323 Rasterize(Dst, Dst.BoundsRect);
324end;
325
326constructor TRasterizer.Create;
327begin
328 inherited;
329 SetCombineInfo(DEFAULT_COMBINE_INFO);
330end;
331
332procedure TRasterizer.Assign(Source: TPersistent);
333begin
334 BeginUpdate;
335 try
336 if Source is TCustomBitmap32 then
337 SetCombineInfo(CombineInfo(TCustomBitmap32(Source)))
338 else
339 inherited;
340 finally
341 EndUpdate;
342 Changed;
343 end;
344end;
345
346{ TRegularRasterizer }
347
348constructor TRegularRasterizer.Create;
349begin
350 inherited;
351 FUpdateRowCount := 0;
352end;
353
354procedure TRegularRasterizer.DoRasterize(Dst: TCustomBitmap32; DstRect: TRect);
355var
356 I, J, UpdateCount: Integer;
357 P: PColor32;
358 GetSample: TGetSampleInt;
359begin
360 GetSample := FSampler.GetSampleInt;
361 UpdateCount := 0;
362 for J := DstRect.Top to DstRect.Bottom - 1 do
363 begin
364 P := @Dst.Bits[DstRect.Left + J * Dst.Width];
365 for I := DstRect.Left to DstRect.Right - 1 do
366 begin
367 AssignColor(P^, GetSample(I, J));
368 Inc(P);
369 end;
370 Inc(UpdateCount);
371 if UpdateCount = FUpdateRowCount then
372 begin
373 Dst.Changed(Rect(DstRect.Left, J - UpdateCount, DstRect.Right, J));
374 UpdateCount := 0;
375 end;
376 end;
377 with DstRect do
378 Dst.Changed(Rect(Left, Bottom - UpdateCount - 1, Right, Bottom));
379end;
380
381{ TSwizzlingRasterizer }
382
383constructor TSwizzlingRasterizer.Create;
384begin
385 inherited;
386 FBlockSize := 3;
387end;
388
389procedure TSwizzlingRasterizer.DoRasterize(Dst: TCustomBitmap32; DstRect: TRect);
390var
391 I, L, T, W, H, Size, RowSize, D: Integer;
392 P1, P2, PBlock: TPoint;
393 GetSample: TGetSampleInt;
394 ForwardBuffer: array of Integer;
395
396 function GetDstCoord(P: TPoint): TPoint;
397 var
398 XI, YI: Integer;
399 begin
400 Result := P;
401 Inc(Result.X);
402 Inc(Result.Y);
403
404 XI := ForwardBuffer[Result.X];
405 YI := ForwardBuffer[Result.Y];
406
407 if XI <= YI then
408 Dec(Result.Y, 1 shl XI)
409 else
410 Dec(Result.X, 1 shl (YI + 1));
411
412 if Result.Y >= H then
413 begin
414 Result.Y := P.Y + 1 shl YI;
415 Result.X := P.X;
416 Result := GetDstCoord(Result);
417 end;
418
419 if Result.X >= W then
420 begin
421 Result.X := P.X + 1 shl XI;
422 Result.Y := P.Y;
423 Result := GetDstCoord(Result);
424 end;
425 end;
426
427begin
428 W := DstRect.Right - DstRect.Left;
429 H := DstRect.Bottom - DstRect.Top;
430 L := DstRect.Left; T := DstRect.Top;
431 Size := NextPowerOf2(Max(W, H));
432
433 SetLength(ForwardBuffer, Size + 1);
434
435 I := 2;
436 while I <= Size do
437 begin
438 ForwardBuffer[I] := ForwardBuffer[I shr 1] + 1;
439 Inc(I, 2);
440 end;
441
442 Size := W * H - 1;
443 GetSample := FSampler.GetSampleInt;
444
445 D := 1 shl FBlockSize;
446 PBlock := Point(L + D, T + D);
447 P1 := Point(-1, 0);
448
449 RowSize := Dst.Width;
450 for I := 0 to Size do
451 begin
452 P1 := GetDstCoord(P1);
453 P2.X := L + P1.X;
454 P2.Y := T + P1.Y;
455
456 AssignColor(Dst.Bits[P2.X + P2.Y * RowSize], GetSample(P2.X, P2.Y));
457
458 // Invalidate the current block
459 if (P2.X >= PBlock.X) or (P2.Y >= PBlock.Y) then
460 begin
461 Dst.Changed(Rect(PBlock.X - D, PBlock.Y - D, PBlock.X, PBlock.Y));
462 PBlock.X := P2.X + D;
463 PBlock.Y := P2.Y + D;
464 end;
465 end;
466 Dst.Changed(Rect(PBlock.X - D, PBlock.Y - D, PBlock.X, PBlock.Y));
467end;
468
469procedure TSwizzlingRasterizer.SetBlockSize(const Value: Integer);
470begin
471 if FBlockSize <> Value then
472 begin
473 FBlockSize := Value;
474 Changed;
475 end;
476end;
477
478{ TProgressiveRasterizer }
479
480constructor TProgressiveRasterizer.Create;
481begin
482 inherited;
483 FSteps := 4;
484 FUpdateRows := True;
485end;
486
487{$DEFINE UseInternalFill}
488
489procedure TProgressiveRasterizer.DoRasterize(Dst: TCustomBitmap32;
490 DstRect: TRect);
491var
492 I, J, Shift, W, H, B, Wk, Hk, X, Y: Integer;
493 DoUpdate: Boolean;
494 OnChanged: TAreaChangedEvent;
495 Step: Integer;
496 GetSample: TGetSampleInt;
497
498{$IFDEF UseInternalFill}
499 Bits: PColor32Array;
500
501procedure IntFillRect(X1, Y1, X2, Y2: Integer; C: TColor32);
502var
503 Y: Integer;
504 P: PColor32Array;
505begin
506 for Y := Y1 to Y2 - 1 do
507 begin
508 P := Pointer(@Bits[Y * W]);
509 FillLongword(P[X1], X2 - X1, C);
510 end;
511end;
512{$ENDIF}
513
514begin
515 GetSample := FSampler.GetSampleInt;
516 OnChanged := Dst.OnAreaChanged;
517{$IFDEF UseInternalFill}
518 Bits := Dst.Bits;
519{$ENDIF}
520 DoUpdate := (TCustomBitmap32Access(Dst).UpdateCount = 0) and Assigned(OnChanged);
521 W := DstRect.Right - DstRect.Left;
522 H := DstRect.Bottom - DstRect.Top;
523 J := DstRect.Top;
524 Step := 1 shl FSteps;
525 while J < DstRect.Bottom do
526 begin
527 I := DstRect.Left;
528 B := Min(J + Step, DstRect.Bottom);
529 while I < DstRect.Right - Step do
530 begin
531 {$IFDEF UseInternalFill}
532 IntFillRect(I, J, I + Step, B, GetSample(I, J));
533 {$ELSE}
534 Dst.FillRect(I, J, I + Step, B, GetSample(I, J));
535 {$ENDIF}
536 Inc(I, Step);
537 end;
538 {$IFDEF UseInternalFill}
539 IntFillRect(I, J, DstRect.Right, B, GetSample(I, J));
540 if DoUpdate and FUpdateRows then
541 OnChanged(Dst, Rect(DstRect.Left, J, DstRect.Right, B), AREAINFO_RECT);
542 {$ELSE}
543 Dst.FillRect(I, J, DstRect.Right, B, GetSample(I, J));
544 {$ENDIF}
545 Inc(J, Step);
546 end;
547 if DoUpdate and (not FUpdateRows) then OnChanged(Dst, DstRect, AREAINFO_RECT);
548
549 Shift := FSteps;
550 while Step > 1 do
551 begin
552 Dec(Shift);
553 Step := Step div 2;
554 Wk := W div Step - 1;
555 Hk := H div Step;
556 for J := 0 to Hk do
557 begin
558 Y := DstRect.Top + J shl Shift;
559 B := Min(Y + Step, DstRect.Bottom);
560 if Odd(J) then
561 for I := 0 to Wk do
562 begin
563 X := DstRect.Left + I shl Shift;
564 {$IFDEF UseInternalFill}
565 IntFillRect(X, Y, X + Step, B, GetSample(X, Y));
566 {$ELSE}
567 Dst.FillRect(X, Y, X + Step, B, GetSample(X, Y));
568 {$ENDIF}
569 end
570 else
571 for I := 0 to Wk do
572 if Odd(I) then
573 begin
574 X := DstRect.Left + I shl Shift;
575 {$IFDEF UseInternalFill}
576 IntFillRect(X, Y, X + Step, B, GetSample(X, Y));
577 {$ELSE}
578 Dst.FillRect(X, Y, X + Step, B, GetSample(X, Y));
579 {$ENDIF}
580 end;
581 X := DstRect.Left + Wk shl Shift;
582 {$IFDEF UseInternalFill}
583 IntFillRect(X, Y, DstRect.Right, B, GetSample(X, Y));
584 if FUpdateRows and DoUpdate then
585 OnChanged(Dst, Rect(DstRect.Left, Y, DstRect.Right, B), AREAINFO_RECT);
586 {$ELSE}
587 Dst.FillRect(X, Y, DstRect.Right, B, GetSample(X, Y));
588 {$ENDIF}
589 end;
590 if DoUpdate and (not FUpdateRows) then OnChanged(Dst, DstRect, AREAINFO_RECT);
591 end;
592end;
593
594procedure TProgressiveRasterizer.SetSteps(const Value: Integer);
595begin
596 if FSteps <> Value then
597 begin
598 FSteps := Value;
599 Changed;
600 end;
601end;
602
603procedure TProgressiveRasterizer.SetUpdateRows(const Value: Boolean);
604begin
605 if FUpdateRows <> Value then
606 begin
607 FUpdateRows := Value;
608 Changed;
609 end;
610end;
611
612{ TTesseralRasterizer }
613
614procedure TTesseralRasterizer.DoRasterize(Dst: TCustomBitmap32; DstRect: TRect);
615var
616 W, H, I: Integer;
617 GetSample: TGetSampleInt;
618
619 procedure SplitHorizontal(X, Y, Width, Height: Integer); forward;
620
621 procedure SplitVertical(X, Y, Width, Height: Integer);
622 var
623 HalfWidth, X2, I: Integer;
624 begin
625 HalfWidth := Width div 2;
626 if HalfWidth > 0 then
627 begin
628 X2 := X + HalfWidth;
629 for I := Y + 1 to Y + Height - 1 do
630 AssignColor(Dst.PixelPtr[X2, I]^, GetSample(X2, I));
631 Dst.Changed(Rect(X2, Y, X2 + 1, Y + Height));
632 SplitHorizontal(X, Y, HalfWidth, Height);
633 SplitHorizontal(X2, Y, Width - HalfWidth, Height);
634 end;
635 end;
636
637 procedure SplitHorizontal(X, Y, Width, Height: Integer);
638 var
639 HalfHeight, Y2, I: Integer;
640 begin
641 HalfHeight := Height div 2;
642 if HalfHeight > 0 then
643 begin
644 Y2 := Y + HalfHeight;
645 for I := X + 1 to X + Width - 1 do
646 AssignColor(Dst.PixelPtr[I, Y2]^, GetSample(I, Y2));
647 Dst.Changed(Rect(X, Y2, X + Width, Y2 + 1));
648 SplitVertical(X, Y, Width, HalfHeight);
649 SplitVertical(X, Y2, Width, Height - HalfHeight);
650 end;
651 end;
652
653begin
654 GetSample := FSampler.GetSampleInt;
655 with DstRect do
656 begin
657 W := Right - Left;
658 H := Bottom - Top;
659 for I := Left to Right - 1 do
660 AssignColor(Dst.PixelPtr[I, Top]^, GetSample(I, Top));
661 Dst.Changed(Rect(Left, Top, Right, Top + 1));
662 for I := Top to Bottom - 1 do
663 AssignColor(Dst.PixelPtr[Left, I]^, GetSample(Left, I));
664 Dst.Changed(Rect(Left, Top, Left + 1, Bottom));
665 if W > H then
666 SplitVertical(Left, Top, W, H)
667 else
668 SplitHorizontal(Left, Top, W, H);
669 end;
670end;
671
672
673{ TContourRasterizer }
674
675procedure InflateRect(const P: TPoint; var R: TRect);
676begin
677 if P.X < R.Left then R.Left := P.X;
678 if P.Y < R.Top then R.Top := P.Y;
679 if P.X >= R.Right then R.Right := P.X + 1;
680 if P.Y >= R.Bottom then R.Bottom := P.Y + 1;
681end;
682
683procedure TContourRasterizer.DoRasterize(Dst: TCustomBitmap32; DstRect: TRect);
684type
685 TDirection = (North, East, South, West);
686var
687 I, J, D, Diff: Integer;
688 C, CLast: TColor32;
689 P, PLast: TPoint;
690 GetSample: TGetSampleInt;
691 NewDir, Dir: TDirection;
692 Visited: TBooleanMap;
693 UpdateRect: TRect;
694const
695 LEFT: array[TDirection] of TDirection = (West, North, East, South);
696 RIGHT: array[TDirection] of TDirection = (East, South, West, North);
697 COORDS: array[TDirection] of TPoint = ((X: 0; Y: -1), (X: 1; Y: 0), (X: 0; Y: 1), (X: -1; Y: 0));
698label
699 MainLoop;
700begin
701 GetSample := FSampler.GetSampleInt;
702 Visited := TBooleanMap.Create;
703 try
704 with DstRect do
705 Visited.SetSize(Right - Left, Bottom - Top);
706
707 I := 0; J := 0;
708 Dir := East;
709 NewDir := East;
710
711 PLast := Point(DstRect.Left, DstRect.Top);
712 CLast := GetSample(PLast.X, PLast.Y);
713 AssignColor(Dst.PixelPtr[PLast.X, PLast.Y]^, CLast);
714
715 UpdateRect := Rect(PLast.X, PLast.Y, PLast.X + 1, PLast.Y + 1);
716 while True do
717 begin
718 MainLoop:
719
720 Diff := MaxInt;
721
722 // forward
723 with COORDS[Dir] do P := Point(PLast.X + X, PLast.Y + Y);
724 if PtInRect(DstRect, P) and (not Visited[P.X, P.Y]) then
725 begin
726 C := GetSample(P.X, P.Y);
727 Diff := Intensity(ColorSub(C, CLast));
728 EMMS;
729 NewDir := Dir;
730 AssignColor(Dst.PixelPtr[P.X, P.Y]^, C);
731 Visited[P.X - DstRect.Left, P.Y - DstRect.Top] := True;
732 InflateRect(P, UpdateRect);
733 end;
734
735 // left
736 with COORDS[LEFT[Dir]] do P := Point(PLast.X + X, PLast.Y + Y);
737 if PtInRect(DstRect, P) and (not Visited[P.X, P.Y]) then
738 begin
739 C := GetSample(P.X, P.Y);
740 D := Intensity(ColorSub(C, CLast));
741 EMMS;
742 if D < Diff then
743 begin
744 NewDir := LEFT[Dir];
745 Diff := D;
746 end;
747 AssignColor(Dst.PixelPtr[P.X, P.Y]^, C);
748 Visited[P.X - DstRect.Left, P.Y - DstRect.Top] := True;
749 InflateRect(P, UpdateRect);
750 end;
751
752 // right
753 with COORDS[RIGHT[Dir]] do P := Point(PLast.X + X, PLast.Y + Y);
754 if PtInRect(DstRect, P) and (not Visited[P.X, P.Y]) then
755 begin
756 C := GetSample(P.X, P.Y);
757 D := Intensity(ColorSub(C, CLast));
758 EMMS;
759 if D < Diff then
760 begin
761 NewDir := RIGHT[Dir];
762 Diff := D;
763 end;
764 AssignColor(Dst.PixelPtr[P.X, P.Y]^, C);
765 Visited[P.X - DstRect.Left, P.Y - DstRect.Top] := True;
766 InflateRect(P, UpdateRect);
767 end;
768
769 if Diff = MaxInt then
770 begin
771 Dst.Changed(UpdateRect);
772 while J < Visited.Height do
773 begin
774 while I < Visited.Width do
775 begin
776 if not Visited[I, J] then
777 begin
778 Visited[I, J] := True;
779 PLast := Point(DstRect.Left + I, DstRect.Top + J);
780 CLast := GetSample(PLast.X, PLast.Y);
781 AssignColor(Dst.PixelPtr[PLast.X, PLast.Y]^, CLast);
782 UpdateRect := Rect(PLast.X, PLast.Y, PLast.X + 1, PLast.Y + 1);
783 goto MainLoop;
784 end;
785 Inc(I);
786 end;
787 I := 0;
788 Inc(J);
789 end;
790 Break;
791 end;
792
793 Dir := NewDir;
794 with COORDS[Dir] do PLast := Point(PLast.X + X, PLast.Y + Y);
795 CLast := Dst[PLast.X, PLast.Y];
796 end;
797
798 finally
799 Visited.Free;
800 end;
801end;
802
803{ TMultithreadedRegularRasterizer }
804
805procedure TMultithreadedRegularRasterizer.DoRasterize(Dst: TCustomBitmap32; DstRect: TRect);
806var
807 I: Integer;
808 Threads: array of TScanLineRasterizerThread;
809 Data: TLineRasterizerData;
810
811 function CreateThread: TScanLineRasterizerThread;
812 begin
813 Result := TScanLineRasterizerThread.Create(True);
814 Result.Data := @Data;
815 Result.DstRect := DstRect;
816 Result.GetSample := Sampler.GetSampleInt;
817 Result.AssignColor := AssignColor;
818 Result.Dst := Dst;
819 {$IFDEF USETHREADRESUME}
820 Result.Resume;
821 {$ELSE}
822 Result.Start;
823 {$ENDIF}
824 end;
825
826begin
827 Data.ScanLine := DstRect.Top - 1;
828
829 { Start Threads }
830 SetLength(Threads, NumberOfProcessors);
831 try
832 for I := 0 to NumberOfProcessors - 1 do
833 Threads[I] := CreateThread;
834
835 { Wait for Threads to be ready }
836 for I := 0 to High(Threads) do
837 begin
838 Threads[I].WaitFor;
839 Threads[I].Free;
840 end;
841
842 finally
843 Dst.Changed(DstRect);
844 end;
845end;
846
847{ TLineRasterizerThread }
848
849procedure TScanLineRasterizerThread.Execute;
850var
851 ScanLine: Integer;
852 I: Integer;
853 P: PColor32;
854begin
855 ScanLine := InterlockedIncrement(Data^.ScanLine);
856 while ScanLine < DstRect.Bottom do
857 begin
858 P := @Dst.Bits[DstRect.Left + ScanLine * Dst.Width];
859
860 for I := DstRect.Left to DstRect.Right - 1 do
861 begin
862 AssignColor(P^, GetSample(I, ScanLine));
863 Inc(P);
864 end;
865
866 ScanLine := InterlockedIncrement(Data^.ScanLine);
867 end;
868end;
869
870initialization
871 NumberOfProcessors := GetProcessorCount;
872{$IFDEF USEMULTITHREADING}
873 if NumberOfProcessors > 1 then
874 DefaultRasterizerClass := TMultithreadedRegularRasterizer;
875{$ENDIF}
876
877
878end.
Note: See TracBrowser for help on using the repository browser.