|
|
@@ -0,0 +1,493 @@
|
|
|
+{
|
|
|
+ This file is part of the Free Pascal run time library.
|
|
|
+ Copyright (c) 1993,99 by Thomas Schatzl and Carl Eric Codere
|
|
|
+
|
|
|
+ This include implements polygon filling and flood filling.
|
|
|
+
|
|
|
+ See the file COPYING.FPC, included in this distribution,
|
|
|
+ for details about the copyright.
|
|
|
+
|
|
|
+ This program is distributed in the hope that it will be useful,
|
|
|
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
+
|
|
|
+ **********************************************************************}
|
|
|
+{$R-} { No range checking here, because we do some special typecasts }
|
|
|
+
|
|
|
+type
|
|
|
+{$IFDEF FPC}
|
|
|
+ graph_int = int32; { platform specific integer used for indexes;
|
|
|
+ should be 16 bits on TP/BP and 32 bits on every-
|
|
|
+ thing else for speed reasons }
|
|
|
+ graph_float = double; { the platform's preferred floating point size }
|
|
|
+{$ELSE}
|
|
|
+ graph_int = integer; { platform specific integer used for indexes;
|
|
|
+ should be 16 bits on TP/BP and 32 bits on every-
|
|
|
+ thing else for speed reasons }
|
|
|
+ graph_float = real; { the platform's preferred floating point size }
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+ pedge = ^edge;
|
|
|
+ edge = packed record { an edge structure }
|
|
|
+ x, { current x-coordinate on the edge }
|
|
|
+ dx : graph_float; { deltax of the edge }
|
|
|
+ i : graph_int; { index to which points this edge belongs to
|
|
|
+ always [i] and [i+1] }
|
|
|
+ end;
|
|
|
+
|
|
|
+ { used for typecasting because TP/BP is more strict here than FPC }
|
|
|
+ pedgearray = ^edgearray;
|
|
|
+ { 0..0 }
|
|
|
+ edgearray = array[0..0] of edge;
|
|
|
+
|
|
|
+ pint = ^graph_int;
|
|
|
+
|
|
|
+ pintarray = ^intarray;
|
|
|
+ { 0..0 }
|
|
|
+ intarray = array[0..0] of graph_int;
|
|
|
+
|
|
|
+ ppointtype = ^pointtype;
|
|
|
+ ppointarray = ^pointarray;
|
|
|
+ pointarray = array[0..0] of pointtype;
|
|
|
+
|
|
|
+{ definition of the called compare routine for the sort process. Returns -1 if
|
|
|
+ the two parameters should be swapped }
|
|
|
+type
|
|
|
+ compareproc = function (a, b : pointer) : graph_int;
|
|
|
+
|
|
|
+{ simple bubblesort, since it is expected that the edges themselves are not
|
|
|
+ too mixed, it is fastest (?). Rather than sorting the active edge table
|
|
|
+ this way, it is recommened to implement this using a linked list (not
|
|
|
+ nearly as much memory is transfered then) }
|
|
|
+ procedure bsort(p : pointer; number : integer; sizeelem :
|
|
|
+ integer; c : compareproc);
|
|
|
+ var i : graph_int;
|
|
|
+ swap : boolean;
|
|
|
+ temp : pointer;
|
|
|
+
|
|
|
+ curp, nextp : pointer;
|
|
|
+ begin
|
|
|
+ getmem(temp, sizeelem);
|
|
|
+ repeat
|
|
|
+ curp := p;
|
|
|
+ nextp := pointer(longint(p) + sizeelem);
|
|
|
+ swap := false;
|
|
|
+ for i := 0 to (number-2) do begin
|
|
|
+ if (c(curp, nextp)=1) then begin
|
|
|
+ { swap elements, you can't do it slower ;( }
|
|
|
+ move(curp^, temp^, sizeelem);
|
|
|
+ move(nextp^, curp^, sizeelem);
|
|
|
+ move(temp^, nextp^, sizeelem);
|
|
|
+ swap := true;
|
|
|
+ end;
|
|
|
+ inc(longint(curp), sizeelem);
|
|
|
+ inc(longint(nextp), sizeelem);
|
|
|
+ end;
|
|
|
+ until swap = false;
|
|
|
+ freemem(temp, sizeelem);
|
|
|
+ end;
|
|
|
+
|
|
|
+ { guess what this does }
|
|
|
+ function ceil(x : graph_float) : graph_int;
|
|
|
+ var t : graph_int;
|
|
|
+ begin
|
|
|
+ t:=Trunc(x);
|
|
|
+ If frac(x)>0 then inc(t);
|
|
|
+ ceil := t;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { guess what this does too }
|
|
|
+ function floor(x : graph_float) : graph_int;
|
|
|
+ var t : graph_int;
|
|
|
+ begin
|
|
|
+ t:=Trunc(x);
|
|
|
+ If frac(x)<0 then dec(t);
|
|
|
+ floor := t;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { simple descriptive name }
|
|
|
+ function max(a, b : graph_int) : graph_int;
|
|
|
+ begin
|
|
|
+ if (a > b) then max := a
|
|
|
+ else max := b;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { here too }
|
|
|
+ function min(a, b : graph_int) : graph_int;
|
|
|
+ begin
|
|
|
+ if (a < b) then min := a
|
|
|
+ else min := b;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { needed for the compare functions; should NOT be used for anything else }
|
|
|
+var
|
|
|
+ ptable : ppointarray; { pointer to points list }
|
|
|
+
|
|
|
+function compare_ind(u, v : pointer) : graph_int; far;
|
|
|
+begin
|
|
|
+ if (ptable^[pint(u)^].y <= ptable^[pint(v)^].y) then compare_ind := -1
|
|
|
+ else compare_ind := 1;
|
|
|
+end;
|
|
|
+
|
|
|
+function compare_active(u, v : pointer) : graph_int; far;
|
|
|
+begin
|
|
|
+ if (pedge(u)^.x <= pedge(v)^.x) then compare_active := -1
|
|
|
+ else compare_active := 1;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure fillpoly(numpoints : word; var PolyPoints);
|
|
|
+{ variables needed within the helper procedures too }
|
|
|
+var
|
|
|
+ activetable : pedgearray; { active edge table, e.g. edges crossing current scanline }
|
|
|
+ activepoints : graph_int; { number of points in active edge table }
|
|
|
+
|
|
|
+{ remove edge i from active edge table }
|
|
|
+procedure cdelete(index : graph_int);
|
|
|
+var
|
|
|
+ j : graph_int;
|
|
|
+begin
|
|
|
+ j := 0;
|
|
|
+ while (j < activepoints) and (pedgearray(activetable)^[j].i <> index) do inc(j);
|
|
|
+ if (j >= activepoints) then exit;
|
|
|
+ dec(activepoints);
|
|
|
+ move(pedgearray(activetable)^[j+1], pedgearray(activetable)^[j],
|
|
|
+ (activepoints-j) * sizeof(edge));
|
|
|
+end;
|
|
|
+
|
|
|
+{ insert edge index into active edge table (at the last position) }
|
|
|
+procedure cinsert(index, y : graph_int);
|
|
|
+var
|
|
|
+ j : graph_int;
|
|
|
+ deltax : graph_float;
|
|
|
+ p, q : ppointtype;
|
|
|
+begin
|
|
|
+ if (index < (numpoints-1)) then j := index + 1 else j := 0;
|
|
|
+
|
|
|
+ if (ptable^[index].y < ptable^[j].y) then begin
|
|
|
+ p := @ptable^[index];
|
|
|
+ q := @ptable^[j];
|
|
|
+ end else begin
|
|
|
+ p := @ptable^[j];
|
|
|
+ q := @ptable^[index];
|
|
|
+ end;
|
|
|
+ deltax := (q^.x-p^.x)/(q^.y-p^.y);
|
|
|
+ with activetable^[activepoints] do begin
|
|
|
+ dx := deltax;
|
|
|
+ x := dx * (y { + 0.5} - p^.y) + p^.x;
|
|
|
+ i := index;
|
|
|
+ end;
|
|
|
+ inc(activepoints);
|
|
|
+end;
|
|
|
+
|
|
|
+{ variables for the main procedure }
|
|
|
+var
|
|
|
+ k, i, j : graph_int;
|
|
|
+ starty, endy, y, xl, xr : graph_int;
|
|
|
+ oldcolor : word;
|
|
|
+var
|
|
|
+ indextable : pintarray; { list of vertex indices, sorted by y }
|
|
|
+
|
|
|
+begin
|
|
|
+ oldcolor := CurrentColor;
|
|
|
+ CurrentColor := FillSettings.Color;
|
|
|
+ ptable := @PolyPoints;
|
|
|
+ if (numpoints<=0) then exit;
|
|
|
+
|
|
|
+ getmem(indextable, sizeof(graph_int) * numpoints);
|
|
|
+ getmem(activetable, sizeof(edge) * numpoints);
|
|
|
+ if (not assigned(activetable)) or (not assigned(indextable)) then
|
|
|
+ begin
|
|
|
+ _GraphResult := grNoScanMem;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+{$R-}
|
|
|
+ { create y-sorted array of indices indextable[k] into vertex list }
|
|
|
+ for k := 0 to (numpoints-1) do
|
|
|
+ indextable^[k] := k;
|
|
|
+ { sort the indextable by points[indextable[k]].y }
|
|
|
+ bsort(indextable, numpoints, sizeof(graph_int), compare_ind);
|
|
|
+ { start with empty active edge table }
|
|
|
+ activepoints := 0;
|
|
|
+ { indextable[k] is the next vertex to process }
|
|
|
+ k := 0;
|
|
|
+ { ymin of polygon }
|
|
|
+ starty := ceil(pointarray(polypoints)[indextable^[0]].y-0.5);
|
|
|
+ { ymax of polygon }
|
|
|
+ endy := floor(pointarray(polypoints)[indextable^[numpoints-1]].y-0.5);
|
|
|
+
|
|
|
+ { step through scanlines }
|
|
|
+ for y := starty to endy do begin
|
|
|
+ { check vertices between previous scanline and current one, if any }
|
|
|
+ while (k < numpoints) and
|
|
|
+ (pointarray(polypoints)[indextable^[k]].y<=(y+0.5)) do begin
|
|
|
+ i := indextable^[k];
|
|
|
+ { insert or delete edges before and after points[i] ((i-1) to i and
|
|
|
+ i to (i+1)) from active edge table if they cross scanline y }
|
|
|
+ { point previous to i }
|
|
|
+ if (i > 0) then j := i-1 else j := numpoints-1;
|
|
|
+ { old edge, remove from list }
|
|
|
+ if (pointarray(polypoints)[j].y <= (y-0.5)) then cdelete(j)
|
|
|
+ { new edge, add to active edges }
|
|
|
+ else if (pointarray(polypoints)[j].y > (y + 0.5)) then cinsert(j, y);
|
|
|
+
|
|
|
+ { point next after i }
|
|
|
+ if (i < (numpoints-1)) then j := i+1 else j := 0;
|
|
|
+ { old edge, remove from active edge table }
|
|
|
+ if (pointarray(polypoints)[j].y <= (y - 0.5)) then cdelete(i)
|
|
|
+ { new edge, add to active edges }
|
|
|
+ else if (pointarray(polypoints)[j].y > (y + 0.5)) then cinsert(i, y);
|
|
|
+ inc(k);
|
|
|
+ end;
|
|
|
+ { sort active edges list by active[j].x }
|
|
|
+ bsort(activetable, activepoints, sizeof(edge), compare_active);
|
|
|
+ j := 0;
|
|
|
+ { draw horizontal segments for scanline y }
|
|
|
+ while (j < activepoints) do begin
|
|
|
+ {xl := ceil(activetable^[j].x-0.5);}
|
|
|
+ xl := trunc(activetable^[j].x-0.5);
|
|
|
+ if frac(activetable^[j].x-0.5)>0 then inc(xl);
|
|
|
+
|
|
|
+ xr := trunc(activetable^[j+1].x-0.5);
|
|
|
+ if frac(activetable^[j+1].x-0.5)<0 then dec(xr);
|
|
|
+
|
|
|
+ if (xl <= xr) then
|
|
|
+ PatternLine(xl,xr,y);
|
|
|
+{ line(xl, y, xr+1, y);}
|
|
|
+ { increment both edges' coordinates }
|
|
|
+ with activetable^[j] do begin
|
|
|
+ x := x + dx;
|
|
|
+ end;
|
|
|
+ with activetable^[j+1] do begin
|
|
|
+ x := x + dx;
|
|
|
+ end;
|
|
|
+ inc(j, 2);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+{$R+}
|
|
|
+ freemem(activetable, sizeof(edge) * numpoints);
|
|
|
+ freemem(indextable, sizeof(graph_int) * numpoints);
|
|
|
+ { restore the old color }
|
|
|
+ CurrentColor := OldColor;
|
|
|
+ { now let's draw the outline of this polygon }
|
|
|
+ DrawPoly(NumPoints, PolyPoints);
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+type
|
|
|
+ TFloodLine = record
|
|
|
+ x1 : Integer;
|
|
|
+ x2 : Integer;
|
|
|
+ y : Integer;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TDrawnList = Array[0..StdBuffersize] of TFloodLine;
|
|
|
+
|
|
|
+var
|
|
|
+ DrawnIndex : Word;
|
|
|
+ DrawnList : TDrawnList;
|
|
|
+ Buffer : Record { Union for byte and word addressing of buffer }
|
|
|
+ ByteIndex : Word;
|
|
|
+ WordIndex : Word;
|
|
|
+ Case Boolean Of
|
|
|
+ False : (Bytes : Array [0..StdBufferSize-1] Of Byte);
|
|
|
+ True : (Words : Array [0..(StdBufferSize DIV 2)-1] Of Word);
|
|
|
+ End;
|
|
|
+
|
|
|
+ s1, s2, s3 : PWordArray; { Three buffers for scanlines }
|
|
|
+
|
|
|
+
|
|
|
+ Procedure PushPoint (x, y : Integer);
|
|
|
+ {********************************************************}
|
|
|
+ { Adds a point to the list of points to check if we }
|
|
|
+ { need to draw. Doesn't add the point if there is a }
|
|
|
+ { buffer overflow. }
|
|
|
+ {********************************************************}
|
|
|
+ var
|
|
|
+ i: integer;
|
|
|
+ Begin
|
|
|
+ If Buffer.WordIndex<(StdBufferSize DIV 2) then
|
|
|
+ Begin
|
|
|
+ Buffer.Words[Buffer.WordIndex]:=x;
|
|
|
+ Buffer.Words[Buffer.WordIndex+1]:=y;
|
|
|
+ Inc (Buffer.WordIndex,2);
|
|
|
+ End
|
|
|
+ End;
|
|
|
+
|
|
|
+ Procedure PopPoint (Var x, y : Integer);
|
|
|
+ {********************************************************}
|
|
|
+ { Removes a point from the list of points to check, if }
|
|
|
+ { we try to access an illegal point, then the routine }
|
|
|
+ { returns -1,-1 as a coordinate pair. }
|
|
|
+ {********************************************************}
|
|
|
+ Begin
|
|
|
+ If Buffer.WordIndex>1 then
|
|
|
+ Begin
|
|
|
+ x:=Buffer.Words[Buffer.WordIndex-2];
|
|
|
+ y:=Buffer.Words[Buffer.WordIndex-1];
|
|
|
+ Dec (Buffer.WordIndex,2);
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ x:=-1;
|
|
|
+ y:=-1;
|
|
|
+ End;
|
|
|
+ End;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+ {********************************************************}
|
|
|
+ { Procedure AddLinePoints() }
|
|
|
+ {--------------------------------------------------------}
|
|
|
+ { Adds a line segment to the list of lines which will be }
|
|
|
+ { drawn to the screen. The line added is on the specified}
|
|
|
+ { Y axis, from the x1 to x2 coordinates. }
|
|
|
+ {********************************************************}
|
|
|
+ Procedure AddLinePoints(x1,x2,y: integer);
|
|
|
+ begin
|
|
|
+ DrawnList[DrawnIndex].x1 := x1;
|
|
|
+ DrawnList[DrawnIndex].x2 := x2;
|
|
|
+ DrawnList[DrawnIndex].y := y;
|
|
|
+ Inc(DrawnIndex);
|
|
|
+ end;
|
|
|
+
|
|
|
+ {********************************************************}
|
|
|
+ { Procedure AlreadyDrawn() }
|
|
|
+ {--------------------------------------------------------}
|
|
|
+ { This routine searches through the list of segments }
|
|
|
+ { which will be drawn to the screen, and determines if }
|
|
|
+ { the specified point (x,y) will already be drawn. }
|
|
|
+ { i.e : Checks if the x,y point lies within a known }
|
|
|
+ { segment which will be drawn to the screen. This makes }
|
|
|
+ { sure that we don't draw some segments two times. }
|
|
|
+ { Return TRUE if the point is already in the segment list}
|
|
|
+ { to draw, otherwise returns FALSE. }
|
|
|
+ {********************************************************}
|
|
|
+ Function AlreadyDrawn(x, y: integer): boolean;
|
|
|
+ var
|
|
|
+ LocalIndex : integer;
|
|
|
+ begin
|
|
|
+ AlreadyDrawn := FALSE;
|
|
|
+ LocalIndex := 0;
|
|
|
+ while LocalIndex < DrawnIndex do
|
|
|
+ Begin
|
|
|
+ { if vertical val is equal to our y point ... }
|
|
|
+ if DrawnList[LocalIndex].y = y then
|
|
|
+ Begin
|
|
|
+ { then check if x >< ... }
|
|
|
+ if (x >= DrawnList[LocalIndex].x1) and
|
|
|
+ (x <= DrawnList[LocalIndex].x2) then
|
|
|
+ Begin
|
|
|
+ AlreadyDrawn := TRUE;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ Inc(LocalIndex);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ Procedure FloodFill (x, y : Integer; Border: word);
|
|
|
+ {********************************************************}
|
|
|
+ { Procedure FloodFill() }
|
|
|
+ {--------------------------------------------------------}
|
|
|
+ { This routine fills a region of the screen bounded by }
|
|
|
+ { the <Border> color. It uses the current fillsettings }
|
|
|
+ { for the flood filling. }
|
|
|
+ {********************************************************}
|
|
|
+ Var
|
|
|
+ Beginx : Integer;
|
|
|
+ d, e, a : Byte;
|
|
|
+ Cont : Boolean;
|
|
|
+ BackupColor : Word;
|
|
|
+ x1, x2: integer;
|
|
|
+ Index : Integer;
|
|
|
+ Begin
|
|
|
+ { Save current drawing color }
|
|
|
+ BackupColor := CurrentColor;
|
|
|
+ CurrentColor := FillSettings.Color;
|
|
|
+ { MaxX is based on zero index }
|
|
|
+ GetMem (s1,(MaxX+1)*2); { A pixel color represents a word }
|
|
|
+ GetMem (s2,(MaxX+1)*2); { A pixel color represents a word }
|
|
|
+ GetMem (s3,(MaxX+1)*2); { A pixel color represents a word }
|
|
|
+ if (not assigned(s1)) or (not assigned(s2)) or (not assigned(s3)) then
|
|
|
+ begin
|
|
|
+ _GraphResult := grNoFloodMem;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ If (x<0) Or (y<0) Or (x>MaxX) Or (y>MaxY) then Exit;
|
|
|
+ { Some internal variables }
|
|
|
+ Index := 0;
|
|
|
+ { Index of segments to draw }
|
|
|
+ DrawnIndex := 0;
|
|
|
+ { Index of points to check }
|
|
|
+ Buffer.WordIndex:=0;
|
|
|
+ PushPoint (x,y);
|
|
|
+ While Buffer.WordIndex>0 Do
|
|
|
+ Begin
|
|
|
+ PopPoint (x,y);
|
|
|
+ { Get the complete lines for the following }
|
|
|
+ GetScanline (y-1,s2^);
|
|
|
+ GetScanline (y,s1^);
|
|
|
+ GetScanline (y+1,s3^);
|
|
|
+
|
|
|
+ { check the current scan line }
|
|
|
+ While (s1^[x]<>Border) And (x<=MaxX) Do Inc (x);
|
|
|
+ d:=0;
|
|
|
+ e:=0;
|
|
|
+ Dec (x);
|
|
|
+ Beginx:=x;
|
|
|
+ REPEAT
|
|
|
+ { check the above line }
|
|
|
+ If y<MaxY then
|
|
|
+ Begin
|
|
|
+ Cont:=(s3^[x]<>Border) and (not AlreadyDrawn(x,y+1));
|
|
|
+ If (e=0) And Cont then
|
|
|
+ Begin
|
|
|
+ PushPoint (x,y+1);
|
|
|
+ e:=1;
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ If (e=1) And Not Cont then e:=0;
|
|
|
+ End;
|
|
|
+ { check the line below }
|
|
|
+ If (y>0) then
|
|
|
+ Begin
|
|
|
+ Cont:=(s2^[x]<>Border) and (not AlreadyDrawn(x,y-1));
|
|
|
+ If (d=0) And Cont then
|
|
|
+ Begin
|
|
|
+ PushPoint (x,y-1);
|
|
|
+ d:=1;
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ If (d=1) And Not Cont then d:=0;
|
|
|
+ End;
|
|
|
+ Dec (x);
|
|
|
+ Until (x<0) Or (s1^[x]=Border);
|
|
|
+ { swap the values }
|
|
|
+ x1:=x+1;
|
|
|
+ x2:=BeginX;
|
|
|
+ if x1 > x2 then
|
|
|
+ Begin
|
|
|
+ x:=x1;
|
|
|
+ x1:=x2;
|
|
|
+ x2:=x;
|
|
|
+ end;
|
|
|
+ { Add to the list of drawn lines }
|
|
|
+ AddLinePoints(x1,x2,y);
|
|
|
+ PatternLine (x1,x2,y);
|
|
|
+ End; { end while }
|
|
|
+
|
|
|
+ FreeMem (s1,(MaxX+1)*2);
|
|
|
+ FreeMem (s2,(MaxX+1)*2);
|
|
|
+ FreeMem (s3,(MaxX+1)*2);
|
|
|
+ CurrentColor := BackUpColor;
|
|
|
+ End;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+
|
carl