* made floodfill a *LOT* faster (better DrawnPoints management)

This commit is contained in:
Jonas Maebe 2000-01-02 19:01:32 +00:00
parent 96b6cdedae
commit 0e4fe19488

View File

@ -95,7 +95,7 @@ type
If (frac(x)<0) then dec(t); If (frac(x)<0) then dec(t);
floor := t; floor := t;
end; end;
(*
{ simple descriptive name } { simple descriptive name }
function max(a, b : graph_int) : graph_int; function max(a, b : graph_int) : graph_int;
begin begin
@ -109,7 +109,7 @@ type
if (a <= b) then min := a if (a <= b) then min := a
else min := b; else min := b;
end; end;
*)
{ needed for the compare functions; should NOT be used for anything else } { needed for the compare functions; should NOT be used for anything else }
var var
ptable : ppointarray; { pointer to points list } ptable : ppointarray; { pointer to points list }
@ -273,19 +273,24 @@ begin
DrawPoly(NumPoints, PolyPoints); DrawPoly(NumPoints, PolyPoints);
end; end;
{ maximum supported Y resultion }
const
MaxYRes = 2048;
{ changing this to 1 or 2 doesn't improve performance noticably }
YResDiv = 4;
type type
PFloodLine = ^TFloodLine;
TFloodLine = record TFloodLine = record
next: PFloodLine;
x1 : smallint; x1 : smallint;
x2 : smallint; x2 : smallint;
y : smallint; y : smallint;
end; end;
TDrawnList = Array[0..StdBuffersize] of TFloodLine; TDrawnList = Array[0..(MaxYRes - 1) div 4] of PFloodLine;
var var
DrawnIndex : Word;
DrawnList : TDrawnList; DrawnList : TDrawnList;
Buffer : Record { Union for byte and word addressing of buffer } Buffer : Record { Union for byte and word addressing of buffer }
ByteIndex : Word; ByteIndex : Word;
@ -346,11 +351,14 @@ var
{ Y axis, from the x1 to x2 coordinates. } { Y axis, from the x1 to x2 coordinates. }
{********************************************************} {********************************************************}
Procedure AddLinePoints(x1,x2,y: smallint); Procedure AddLinePoints(x1,x2,y: smallint);
var temp: PFloodLine;
begin begin
DrawnList[DrawnIndex].x1 := x1; new(temp);
DrawnList[DrawnIndex].x2 := x2; temp^.x1 := x1;
DrawnList[DrawnIndex].y := y; temp^.x2 := x2;
Inc(DrawnIndex); temp^.y := y;
temp^.next := DrawnList[y div YResDiv];
DrawnList[y div YResDiv] := temp;
end; end;
{********************************************************} {********************************************************}
@ -367,27 +375,45 @@ var
{********************************************************} {********************************************************}
Function AlreadyDrawn(x, y: smallint): boolean; Function AlreadyDrawn(x, y: smallint): boolean;
var var
LocalIndex : smallint; temp : PFloodLine;
begin begin
AlreadyDrawn := FALSE; AlreadyDrawn := false;
LocalIndex := 0; temp := DrawnList[y div YResDiv];
while LocalIndex < DrawnIndex do while assigned(temp) do
Begin begin
{ if vertical val is equal to our y point ... } if (temp^.y = y) and
if DrawnList[LocalIndex].y = y then (temp^.x1 <= x) and
Begin (temp^.x2 >= x) then
{ then check if x >< ... } begin
if (x >= DrawnList[LocalIndex].x1) and AlreadyDrawn := true;
(x <= DrawnList[LocalIndex].x2) then
Begin
AlreadyDrawn := TRUE;
exit; exit;
end; end;
end; temp := temp^.next;
Inc(LocalIndex);
end; end;
end; end;
{********************************************************}
{ Procedure CleanUpDrawnList }
{--------------------------------------------------------}
{ removes all elements from the DrawnList. Doesn't init }
{ elements of it with NILL }
{********************************************************}
Procedure CleanUpDrawnList;
var
l: longint;
temp1, temp2: PFloodLine;
begin
for l := 0 to high(DrawnList) do
begin
temp1 := DrawnList[l];
while assigned(temp1) do
begin
temp2 := temp1;
temp1 := temp1^.next;
dispose(temp2);
end;
end;
end;
Procedure FloodFill (x, y : smallint; Border: word); Procedure FloodFill (x, y : smallint; Border: word);
{********************************************************} {********************************************************}
@ -407,6 +433,7 @@ var
x1, x2, prevy: smallint; x1, x2, prevy: smallint;
Index : smallint; Index : smallint;
Begin Begin
FillChar(DrawnList,sizeof(DrawnList),0);
{ init prevy } { init prevy }
prevy := 32767; prevy := 32767;
{ Save current drawing color } { Save current drawing color }
@ -425,8 +452,6 @@ var
(x>ViewWidth) Or (y>ViewHeight) then Exit; (x>ViewWidth) Or (y>ViewHeight) then Exit;
{ Some internal variables } { Some internal variables }
Index := 0; Index := 0;
{ Index of segments to draw }
DrawnIndex := 0;
{ Index of points to check } { Index of points to check }
Buffer.WordIndex:=0; Buffer.WordIndex:=0;
PushPoint (x,y); PushPoint (x,y);
@ -434,25 +459,35 @@ var
Begin Begin
PopPoint (x,y); PopPoint (x,y);
{ Get the complete lines for the following } { Get the complete lines for the following }
If y <> prevy then
begin
If (prevy - y = 1) then If (prevy - y = 1) then
{ previous line was one below the new one, so the previous s2 } { previous line was one below the new one, so the previous s2 }
{ = new s1 } { = new s1 }
Begin Begin
stemp := s1; stemp := s3;
s3 := s1;
s1 := s2; s1 := s2;
s2 := stemp; s2 := stemp;
GetScanline(0,ViewWidth,y-1,s2^);
End End
Else If (y - prevy = 1) then Else If (y - prevy = 1) then
{ previous line was one above the new one, so the previous s3 } { previous line was one above the new one, so the previous s3 }
{ = new s1 } { = new s1 }
Begin Begin
stemp := s1; stemp := s2;
s2 := s1;
s1 := s3; s1 := s3;
s3 := stemp; s3 := stemp;
End
Else GetScanline(0,ViewWidth,y,s1^);
GetScanline(0,ViewWidth,y-1,s2^);
GetScanline(0,ViewWidth,y+1,s3^); GetScanline(0,ViewWidth,y+1,s3^);
End
Else
begin
GetScanline(0,ViewWidth,y-1,s2^);
GetScanline(0,ViewWidth,y,s1^);
GetScanline(0,ViewWidth,y+1,s3^);
end;
end;
prevy := y; prevy := y;
{ check the current scan line } { check the current scan line }
While (s1^[x]<>Border) And (x<=ViewWidth) Do Inc (x); While (s1^[x]<>Border) And (x<=ViewWidth) Do Inc (x);
@ -504,12 +539,16 @@ var
FreeMem (s1,(ViewWidth+1)*2); FreeMem (s1,(ViewWidth+1)*2);
FreeMem (s2,(ViewWidth+1)*2); FreeMem (s2,(ViewWidth+1)*2);
FreeMem (s3,(ViewWidth+1)*2); FreeMem (s3,(ViewWidth+1)*2);
CleanUpDrawnList;
CurrentColor := BackUpColor; CurrentColor := BackUpColor;
End; End;
{ {
$Log$ $Log$
Revision 1.13 1999-12-20 11:22:36 peter Revision 1.14 2000-01-02 19:01:32 jonas
* made floodfill a *LOT* faster (better DrawnPoints management)
Revision 1.13 1999/12/20 11:22:36 peter
* integer -> smallint to overcome -S2 switch needed for ggi version * integer -> smallint to overcome -S2 switch needed for ggi version
Revision 1.12 1999/12/11 23:41:38 jonas Revision 1.12 1999/12/11 23:41:38 jonas