``````{
This unit draws polygons fast. It draws only polygons which are monotone
vertical. That means only polygons which you can fill with continues horizontal
lines. Fortunately that are the polygons which are mostly used in 3d graphics.
}

{*****************************************************************}
{* UnitName    : FASTPOLY.PAS                                    *}
{* Purpose     : Draw monotone vertical polygons fast            *}
{* Version     : 1.5                                             *}
{* Author      : Daan de Haas                                    *}
{* Date        : 20/10/1993                                      *}
{* Last update :  9/06/1994                                      *}
{* Language    : Borland Turbo Pascal 7.0                        *}
{* Fidonet     : Daan de Haas (2:500/104.6141)                   *}
{* Internet    : Daan.de.Haas@p6141.f104.n500.z2.fidonet.org     *}
{*****************************************************************}

{* VGA mode \$13 and 386 processor *}
{* Literatur : Dr Dobb's XSharp   *}

{\$R-,S-,Q-,I-}

UNIT FastPoly;

{**************************} INTERFACE {**************************}

TYPE
PPoint = ^TPoint;
TPoint = RECORD
x,y:integer;
END;
PPolygon = ^TPolygon;
PPointsList = ^TPointsList;
TPointsList = ARRAY[0..9999] OF TPoint;
TPolygon = RECORD
length,color:word;
PointPtr:PPointsList;
END;
PHLine = ^THLine;
THLine = RECORD
XStart,XEnd:word;
END;
PHLineArray = ^THLineArray;
THLineArray = ARRAY[0..9999] OF THLine;
THLineList = RECORD
length,YStart:integer;
HLinePtr : PHLineArray;
END;

PROCEDURE HLine(x1,y1,x2:word; color:word);
PROCEDURE InitPoly(VAR p:TPolygon; len,col:word);
PROCEDURE DonePoly(VAR p:TPolygon);
PROCEDURE FillMonotoneVerticalPolygon(XOffset,YOffset:word;
VertexList:TPolygon);

CONST
MaxX=320;
MaxY=200;
VidSegment=\$A000;

{************************} IMPLEMENTATION {***********************}

PROCEDURE HLine; ASSEMBLER;
ASM
mov ax,x1             { x1 < x2 }
cmp ax,x2
jl  @@skip1
je  @@lijnexit
xchg ax,x2
mov  x1,ax
@@skip1:
mov ax,maxX           { calculate y1*maxX+x1 }
mul y1
@@1:
mov di,ax             { dx=segment, di=offset }
mov ax,VidSegment

@@skip2:
cld                   { forward direction }
mov cx,x2
sub cx,x1
inc cx                { cx = number of pixels in line }
mov dx,di
mov es,ax             { load segment register }
mov ax,color          { get color into 386 register eax }
mov ah,al
mov dx,ax
db  \$66,\$c1,\$e0,\$10   { shl eax,16 (386 code) }
mov ax,dx
test di,00000011b
jz @@skip             { test for doubleword border, if so jump }
@@waitdd:
mov  es:[di],al       { put one pixel }
inc  di               { di:=next pixel address }
test di,00000011b     { doubleword border  ? }
loopnz @@waitdd       { stop if cx=0 or zeroflag 1 }
or  cx,cx             { cx=0 ? }
jz  @@lijnexit        { if so, line is ready }
cmp cx,4              { is a stosd possible ? }
jl  @@waitdd          { no, then pixel after pixel }
@@skip:
mov  dx,cx
shr  cx,2
db   \$f3,\$66,\$AB      { rep stosd (386 code) }
mov  cx,dx
and cx,00000011b      { line finished ? }
jnz @@waitdd
@@lijnexit:
END;

PROCEDURE ScanEdge(x1,y1,x2,y2,SetXStart,SkipFirst:integer;
VAR EdgePointPtr:PHLineArray); ASSEMBLER;
{ Scan converts an edge from (X1,Y1) to (X2,Y2), not including the
point at (X2,Y2). If SkipFirst == 1, the point at (X1,Y1) isn't
drawn; if SkipFirst == 0, it is. For each scan line, the pixel
closest to the scanned edge without being to the left of the scanned
edge is chosen. Uses an all-integer approach for speed & precision.

Edges must not go bottom to top; that is, Y1 must be <= Y2.
Updates the pointer pointed to by EdgePointPtr to point to the next
free entry in the array of HLine structures. }

VAR

ASM
les di,EdgePointPtr
les di,es:[di]  { point to the HLine array }
cmp SetXStart,1      { set the XStart field of each HLine
{ struc? }
jz @@HLinePtrSet  { yes, DI points to the first XStart }
add di,2   { no, point to the XEnd field of the }
{  first HLine struc }
@@HLinePtrSet:
mov bx,Y2
sub bx,Y1         { edge height }
jle @@ToScanEdgeExit{ guard against 0-length & horz edges }
mov Height,bx { Height = Y2 - Y1 }
sub cx,cx  { assume ErrorTerm starts at 0 (true if }
{  we're moving right as we draw) }
mov dx,1  { assume AdvanceAmt = 1 (move right) }
mov ax,X2
sub ax,X1           { DeltaX = X2 - X1 }
jz      @@IsVertical   { it's a vertical edge--special case it }
jns @@SetAdvanceAmt { DeltaX >= 0 }
mov cx,1  { DeltaX < 0 (move left as we draw) }
sub cx,bx  { ErrorTerm = -Height + 1 }
neg dx  { AdvanceAmt = -1 (move left) }
neg     ax              { Width = abs(DeltaX) }
{ Figure out whether the edge is diagonal, X-major (more horizontal), }
{ or Y-major (more vertical) and handle appropriately. }
cmp ax,bx  { if Width==Height, it's a diagonal edge }
jz @@IsDiagonal { it's a diagonal edge--special case }
jb @@YMajor { it's a Y-major (more vertical) edge }
{ it's an X-major (more horz) edge }
sub     dx,dx           { prepare DX:AX (Width) for division }
div     bx  { Width/Height }
{ DX = error term advance per scan line }
mov si,ax  { SI = minimum # of pixels to advance X }
{ on each scan line }
test    AdvanceAmt,8000h { move left or right? }
neg     si              { left, negate the distance to advance }
{ on each scan line }
mov ax,X1  { starting X coordinate }
cmp     SkipFirst,1 { skip the first point? }
jz @@XMajorSkipEntry  { yes }
@@XMajorLoop:
mov es:[di],ax  { store the current X value }
add di,4     { point to the next HLine struc }
@@XMajorSkipEntry:
add ax,si  { set X for the next scan line }
jle @@XMajorNoAdvance { not time for X coord to advance one }
{ extra }
sub     cx,Height     { adjust error term back }
dec     bx  { count off this scan line }
jnz     @@XMajorLoop
jmp @@ScanEdgeDone
@@ToScanEdgeExit:
jmp @@ScanEdgeExit
@@IsVertical:
mov ax,X1 { starting (and only) X coordinate }
sub bx,SkipFirst { loop count = Height - SkipFirst }
jz      @@ScanEdgeExit  { no scan lines left after skipping 1st }
@@VerticalLoop:
mov es:[di],ax  { store the current X value }
add di,4 { point to the next HLine struc }
dec bx  { count off this scan line }
jnz @@VerticalLoop
jmp @@ScanEdgeDone
@@IsDiagonal:
mov ax,X1 { starting X coordinate }
cmp     SkipFirst,1 { skip the first point? }
jz @@DiagonalSkipEntry { yes }
@@DiagonalLoop:
mov es:[di],ax  { store the current X value }
add di,4 { point to the next HLine struc }
@@DiagonalSkipEntry:
dec bx  { count off this scan line }
jnz @@DiagonalLoop
jmp @@ScanEdgeDone

@@YMajor:
push bp { preserve stack frame pointer }
mov si,X1  { starting X coordinate }
cmp     SkipFirst,1 { skip the first point? }
mov bp,bx { put Height in BP for error term calcs }
jz @@YMajorSkipEntry { yes, skip the first point }
@@YMajorLoop:
mov es:[di],si { store the current X value }
add di,4 { point to the next HLine struc }
@@YMajorSkipEntry:
sub     cx,bp  { adjust error term back }
dec     bx  { count off this scan line }
jnz     @@YMajorLoop
pop bp  { restore stack frame pointer }
@@ScanEdgeDone:
cmp SetXStart,1 { were we working with XStart field? }
jz @@UpdateHLinePtr { yes, DI points to the next XStart  }
sub di,2  { no, point back to the XStart field }
@@UpdateHLinePtr:
mov     bx,word ptr EdgePointPtr { point to pointer to HLine array }
mov ss:[bx],di  { update caller's HLine array pointer }
@@ScanEdgeExit:
END;

PROCEDURE DrawHorizontalLineList(VAR list:THLineList; color:word); ASSEMBLER;
ASM
les si,list
mov cx,es:[si]                { cx = number of lines }
mov ax,es:[si+2]              { ax = startY }
les si,es:[si+4]              { es:si points to pointlist }
@@loop:
mov bx,es:[si]                { get startX }
mov dx,es:[si+2]              { get endX }
push cx                       { save registers }
push ax
push si
push es

push bx                       { draw horizontal line }
push ax
push dx
mov  dx,color                 { get color }
push dx
call HLine

pop es                        { restore registers }
pop si
pop ax
pop cx
inc ax                        { y:=y+1 }
add si,4                      { next points }
loop @@loop                   { if length=0 then stop }
END;

PROCEDURE FillMonotoneVerticalPolygon;
VAR
i,MinIndex,MaxIndex,MinPoint_y,MaxPoint_y,NextIndex,
CurrentIndex,PreviousIndex:integer;
WorkingHLineList:THLineList;
EdgePointPtr:PHLineArray;
VertexPtr:PPointsList;
BEGIN
IF VertexList.Length=0 THEN Exit;
VertexPtr:=VertexList.PointPtr;
MaxPoint_y:=VertexPtr^[0].y;
MinPoint_y:=MaxPoint_y;
MinIndex:=0;
MaxIndex:=0;
FOR i:=1 TO VertexList.Length-1 DO
WITH VerTexPtr^[i] DO
IF y<MinPoint_y THEN
BEGIN
MinPoint_y:=y;
MinIndex:=i;
END
ELSE
IF y>MaxPoint_y THEN
BEGIN
MaxPoint_y:=y;
MaxIndex:=i;
END;
WITH WorkingHLineList DO
BEGIN
length:=MaxPoint_y-MinPoint_y;
IF length<=0 THEN Exit;
YStart:=YOffset+MinPoint_y;
GetMem(HLinePtr,SizeOf(THLine)*length);
EdgePointPtr:=HLinePtr;
END;
CurrentIndex:=MinIndex;
PreviousIndex:=MinIndex;
REPEAT
CurrentIndex:=(CurrentIndex+VertexList.length-1) MOD VertexList.length;
ScanEdge(VertexPtr^[PreviousIndex].x+XOffset,
VertexPtr^[PreviousIndex].y,
VertexPtr^[CurrentIndex].x+XOffset,
VertexPtr^[CurrentIndex].y,
1,0,EdgePointPtr);
PreviousIndex:=CurrentIndex;
UNTIL CurrentIndex=MaxIndex;
EdgePointPtr:=WorkingHLineList.HLinePtr;
CurrentIndex:=MinIndex;
PreviousIndex:=MinIndex;
REPEAT
CurrentIndex:=(CurrentIndex+1) MOD VertexList.length;
ScanEdge(VertexPtr^[PreviousIndex].x+XOffset,
VertexPtr^[PreviousIndex].y,
VertexPtr^[CurrentIndex].x+XOffset,
VertexPtr^[CurrentIndex].y,
0,0,EdgePointPtr);
PreviousIndex:=CurrentIndex;
UNTIL CurrentIndex=MaxIndex;
DrawHorizontalLineList(WorkingHLineList,VertexList.color);
WITH WorkingHLineList DO FreeMem(HLinePtr,SizeOf(THLine)*length);
END;

PROCEDURE InitPoly;
BEGIN
WITH p DO
BEGIN
length:=len;
color:=col;
{ No Error checking !}
GetMem(PointPtr,len*SizeOf(TPoint));
END;
END;

PROCEDURE DonePoly;
BEGIN
WITH p DO
BEGIN
IF PointPtr<>NIL THEN FreeMem(PointPtr,length*SizeOf(TPoint));
PointPtr:=NIL;
END;
END;

END.

{*****************************************************************}
{* ProgramName : FASTPOL.PAS                                     *}
{* Purpose     : Demonstration of unit FastPoly                  *}
{* Version     : 1.0                                             *}
{* Author      : Daan de Haas                                    *}
{* Date        : 9 jun 1994                                      *}
{* Last update : 9 jun 1994                                      *}
{* Language    : Borland Pascal 7.0                              *}
{* Fidonet     : Daan de Haas (2:500/104.6141)                   *}
{* Internet    : Daan.de.Haas@p6141.f104.n500.z2.fidonet.org     *}
{*****************************************************************}

{\$R-,I-,Q-,S-}

USES
Crt, FastPoly;

PROCEDURE SetVideo(m:word); ASSEMBLER;
ASM
mov ax,m
int \$10
END;

PROCEDURE Polydemo;
VAR
p1,p2:TPolygon;
BEGIN
InitPoly(p1,6,YELLOW);
p1.PointPtr^[0].X:=10;
p1.PointPtr^[0].Y:=0;
p1.PointPtr^[1].X:=20;
p1.PointPtr^[1].Y:=0;
p1.PointPtr^[2].X:=30;
p1.PointPtr^[2].Y:=10;
p1.PointPtr^[3].X:=20;
p1.PointPtr^[3].Y:=20;
p1.PointPtr^[4].X:=10;
p1.PointPtr^[4].Y:=20;
p1.PointPtr^[5].X:=0;
p1.PointPtr^[5].Y:=10;
InitPoly(p2,6,BLUE);
p2.PointPtr^[0].X:=10;
p2.PointPtr^[0].Y:=0;
p2.PointPtr^[1].X:=20;
p2.PointPtr^[1].Y:=0;
p2.PointPtr^[2].X:=30;
p2.PointPtr^[2].Y:=10;
p2.PointPtr^[3].X:=20;
p2.PointPtr^[3].Y:=20;
p2.PointPtr^[4].X:=10;
p2.PointPtr^[4].Y:=20;
p2.PointPtr^[5].X:=0;
p2.PointPtr^[5].Y:=10;
REPEAT
FillMonotoneVerticalPolygon(Random(MaxX-35),Random(MaxY-25),p1);
FillMonotoneVerticalPolygon(Random(MaxX-35),Random(MaxY-25),p2);
UNTIL KeyPressed;