mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-03 16:43:41 +02:00
d045295cd4
* added first FPC support, only VGA works to some extend for now
* use -dasmgraph to use assembler routines, otherwise Pascal
equivalents are used
* use -dsupportVESA to support VESA (crashes under FPC for now)
* only dispose vesainfo at closegrph if a vesa card was detected
* changed int32 to longint (int32 is not declared under FPC)
* changed the declaration of almost every procedure in graph.inc to
"far;" becquse otherwise you can't assign them to procvars under TP
real mode (but unexplainable "data segnment too large" errors prevent
it from working under real mode anyway)
511 lines
17 KiB
PHP
511 lines
17 KiB
PHP
{
|
|
$Id$
|
|
|
|
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 = longint; { 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;
|
|
{$ifdef debug}
|
|
{$R+}
|
|
{$endif debug}
|
|
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. Clipping is supported, and }
|
|
{ coordinates are local/viewport relative. }
|
|
{********************************************************}
|
|
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;
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.3 1999-07-12 13:27:11 jonas
|
|
+ added Log and Id tags
|
|
* added first FPC support, only VGA works to some extend for now
|
|
* use -dasmgraph to use assembler routines, otherwise Pascal
|
|
equivalents are used
|
|
* use -dsupportVESA to support VESA (crashes under FPC for now)
|
|
* only dispose vesainfo at closegrph if a vesa card was detected
|
|
* changed int32 to longint (int32 is not declared under FPC)
|
|
* changed the declaration of almost every procedure in graph.inc to
|
|
"far;" becquse otherwise you can't assign them to procvars under TP
|
|
real mode (but unexplainable "data segnment too large" errors prevent
|
|
it from working under real mode anyway)
|
|
|
|
}
|