paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-19 12:09:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Fully implemented clipping

Browse Source 
* PatternnLine now calls HLine if the lines to draw are
      non-patterned (10-15% speedv improvement)
This commit is contained in:
carl 1999-04-25 02:28:54 +00:00
parent a6a9da360d
commit 23c364f842
1 changed files with 265 additions and 195 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

460
rtl/inc/graph/graph.pp
View File

@ -706,6 +706,7 @@ var
Col: word; Col: word;
xtmp: integer; xtmp: integer;
Begin Begin
{ must we swap the values? } { must we swap the values? }
if x >= x2 then if x >= x2 then
Begin Begin
@ -713,6 +714,16 @@ var
x2 := x; x2 := x;
x:= xtmp; x:= xtmp;
end; end;
{ First convert to global coordinates }
X := X + StartXViewPort;
X2 := X2 + StartXViewPort;
Y := Y + StartYViewPort;
if ClipPixels then
Begin
if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
exit;
end;
for x:= x to x2 do for x:= x to x2 do
DirectPutPixel(X,Y); DirectPutPixel(X,Y);
end; end;
@ -731,6 +742,16 @@ var
y2 := y; y2 := y;
y:= ytmp; y:= ytmp;
end; end;
{ First convert to global coordinates }
X := X + StartXViewPort;
Y2 := Y2 + StartYViewPort;
Y := Y + StartYViewPort;
if ClipPixels then
Begin
if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
exit;
end;
for y := y to y2 do Directputpixel(x,y) for y := y to y2 do Directputpixel(x,y)
End; End;
@ -773,10 +794,10 @@ var
hline(x1,x2,y2-1); hline(x1,x2,y2-1);
hline(x1,x2,y2); hline(x1,x2,y2);
hline(x2,x2,y2+1); hline(x2,x2,y2+1);
end; end;
end end
else else
if x1 = x2 then if x1 = x2 then
Begin Begin
{******************************************} {******************************************}
{ SOLID LINES VERTICAL } { SOLID LINES VERTICAL }
@ -791,8 +812,20 @@ var
vline(x1+1,y1,y2); vline(x1+1,y1,y2);
end; end;
end end
else else
begin
{ Convert to global coordinates. }
x1 := x1 + StartXViewPort;
x2 := x2 + StartXViewPort;
y1 := y1 + StartYViewPort;
y2 := y2 + StartYViewPort;
{ if fully clipped then exit... }
if ClipPixels then
begin begin
if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
exit;
end;
{******************************************} {******************************************}
{ SLOPED SOLID LINES } { SLOPED SOLID LINES }
{******************************************} {******************************************}
@ -883,7 +916,7 @@ var
Begin Begin
DirectPutPixel(x-1,y); DirectPutPixel(x-1,y);
DirectPutPixel(x,y); DirectPutPixel(x,y);
DirectPutPixel(x+1,y); DirectPutPixel(x+1,y);
end end
else else
Begin Begin
@ -907,176 +940,189 @@ var
end; end;
end; end;
end; end;
end end
else else
{******************************************} {******************************************}
{ begin patterned lines } { begin patterned lines }
{******************************************} {******************************************}
Begin Begin
OldCurrentColor := CurrentColor; { Convert to global coordinates. }
PixelCount:=0; x1 := x1 + StartXViewPort;
if y1 = y2 then x2 := x2 + StartXViewPort;
Begin y1 := y1 + StartYViewPort;
{ Check if we must swap } y2 := y2 + StartYViewPort;
if x1 >= x2 then { if fully clipped then exit... }
if ClipPixels then
begin
if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
exit;
end;
OldCurrentColor := CurrentColor;
PixelCount:=0;
if y1 = y2 then
Begin Begin
swtmp := x1; { Check if we must swap }
x1 := x2; if x1 >= x2 then
x2 := swtmp; Begin
end; swtmp := x1;
if LineInfo.Thickness = NormWidth then x1 := x2;
Begin x2 := swtmp;
end;
if LineInfo.Thickness = NormWidth then
Begin
for PixelCount:=x1 to x2 do for PixelCount:=x1 to x2 do
{ optimization: PixelCount mod 16 } { optimization: PixelCount mod 16 }
if LinePatterns[PixelCount and 15] = TRUE then if LinePatterns[PixelCount and 15] = TRUE then
begin begin
DirectPutPixel(PixelCount,y2); DirectPutPixel(PixelCount,y2);
end; end;
end end
else else
Begin Begin
for i:=-1 to 1 do for i:=-1 to 1 do
Begin Begin
for PixelCount:=x1 to x2 do for PixelCount:=x1 to x2 do
{ Optimization from Thomas - mod 16 = and 15 } { Optimization from Thomas - mod 16 = and 15 }
if LinePatterns[PixelCount and 15] = TRUE then if LinePatterns[PixelCount and 15] = TRUE then
begin begin
DirectPutPixel(PixelCount,y2+i); DirectPutPixel(PixelCount,y2+i);
end;
end; end;
end;
end;
end
else
if x1 = x2 then
Begin
{ Check if we must swap }
if y1 >= y2 then
Begin
swtmp := y1;
y1 := y2;
y2 := swtmp;
end;
if LineInfo.Thickness = NormWidth then
Begin
for PixelCount:=y1 to y2 do
{ compare if we should plot a pixel here , compare }
{ with predefined line patterns... }
if LinePatterns[PixelCount and 15] = TRUE then
begin
DirectPutPixel(x1,PixelCount);
end;
end
else
Begin
for i:=-1 to 1 do
Begin
for PixelCount:=y1 to y2 do
{ compare if we should plot a pixel here , compare }
{ with predefined line patterns... }
if LinePatterns[PixelCount and 15] = TRUE then
begin
DirectPutPixel(x1+i,PixelCount);
end;
end;
end;
end
else
Begin
oldCurrentColor := CurrentColor;
{ Calculate deltax and deltay for initialisation }
deltax := abs(x2 - x1);
deltay := abs(y2 - y1);
{ Initialize all vars based on which is the independent variable }
if deltax >= deltay then
begin
Flag := FALSE;
{ x is independent variable }
numpixels := deltax + 1;
d := (2 * deltay) - deltax;
dinc1 := deltay Shl 1;
dinc2 := (deltay - deltax) shl 1;
xinc1 := 1;
xinc2 := 1;
yinc1 := 0;
yinc2 := 1;
end
else
begin
Flag := TRUE;
{ y is independent variable }
numpixels := deltay + 1;
d := (2 * deltax) - deltay;
dinc1 := deltax Shl 1;
dinc2 := (deltax - deltay) shl 1;
xinc1 := 0;
xinc2 := 1;
yinc1 := 1;
yinc2 := 1;
end;
{ Make sure x and y move in the right directions }
if x1 > x2 then
begin
xinc1 := - xinc1;
xinc2 := - xinc2;
end;
if y1 > y2 then
begin
yinc1 := - yinc1;
yinc2 := - yinc2;
end;
{ Start drawing at <x1, y1> }
x := x1;
y := y1;
If LineInfo.Thickness=ThickWidth then
Begin
TmpNumPixels := NumPixels-1;
{ Draw the pixels }
for i := 0 to TmpNumPixels do
begin
{ all depending on the slope, we can determine }
{ in what direction the extra width pixels will be put }
If Flag then
Begin
{ compare if we should plot a pixel here , compare }
{ with predefined line patterns... }
if LinePatterns[i and 15] = TRUE then
begin
DirectPutPixel(x-1,y);
DirectPutPixel(x,y);
DirectPutPixel(x+1,y);
end;
end
else
Begin
{ compare if we should plot a pixel here , compare }
{ with predefined line patterns... }
if LinePatterns[i and 15] = TRUE then
begin
DirectPutPixel(x,y-1);
DirectPutPixel(x,y);
DirectPutPixel(x,y+1);
end;
end;
if d < 0 then
begin
d := d + dinc1;
x := x + xinc1;
y := y + yinc1;
end
else
begin
d := d + dinc2;
x := x + xinc2;
y := y + yinc2;
end;
end; end;
end
else
if x1 = x2 then
Begin
{ Check if we must swap }
if y1 >= y2 then
Begin
swtmp := y1;
y1 := y2;
y2 := swtmp;
end;
if LineInfo.Thickness = NormWidth then
Begin
for PixelCount:=y1 to y2 do
{ compare if we should plot a pixel here , compare }
{ with predefined line patterns... }
if LinePatterns[PixelCount and 15] = TRUE then
begin
DirectPutPixel(x1,PixelCount);
end;
end
else
Begin
for i:=-1 to 1 do
Begin
for PixelCount:=y1 to y2 do
{ compare if we should plot a pixel here , compare }
{ with predefined line patterns... }
if LinePatterns[PixelCount and 15] = TRUE then
begin
DirectPutPixel(x1+i,PixelCount);
end;
end;
end;
end
else
Begin
oldCurrentColor := CurrentColor;
{ Calculate deltax and deltay for initialisation }
deltax := abs(x2 - x1);
deltay := abs(y2 - y1);
{ Initialize all vars based on which is the independent variable }
if deltax >= deltay then
begin
Flag := FALSE;
{ x is independent variable }
numpixels := deltax + 1;
d := (2 * deltay) - deltax;
dinc1 := deltay Shl 1;
dinc2 := (deltay - deltax) shl 1;
xinc1 := 1;
xinc2 := 1;
yinc1 := 0;
yinc2 := 1;
end
else
begin
Flag := TRUE;
{ y is independent variable }
numpixels := deltay + 1;
d := (2 * deltax) - deltay;
dinc1 := deltax Shl 1;
dinc2 := (deltax - deltay) shl 1;
xinc1 := 0;
xinc2 := 1;
yinc1 := 1;
yinc2 := 1;
end;
{ Make sure x and y move in the right directions }
if x1 > x2 then
begin
xinc1 := - xinc1;
xinc2 := - xinc2;
end;
if y1 > y2 then
begin
yinc1 := - yinc1;
yinc2 := - yinc2;
end;
{ Start drawing at <x1, y1> }
x := x1;
y := y1;
If LineInfo.Thickness=ThickWidth then
Begin
TmpNumPixels := NumPixels-1;
{ Draw the pixels }
for i := 0 to TmpNumPixels do
begin
{ all depending on the slope, we can determine }
{ in what direction the extra width pixels will be put }
If Flag then
Begin
{ compare if we should plot a pixel here , compare }
{ with predefined line patterns... }
if LinePatterns[i and 15] = TRUE then
begin
DirectPutPixel(x-1,y);
DirectPutPixel(x,y);
DirectPutPixel(x+1,y);
end;
end
else
Begin
{ compare if we should plot a pixel here , compare }
{ with predefined line patterns... }
if LinePatterns[i and 15] = TRUE then
begin
DirectPutPixel(x,y-1);
DirectPutPixel(x,y);
DirectPutPixel(x,y+1);
end;
end;
if d < 0 then
begin
d := d + dinc1;
x := x + xinc1;
y := y + yinc1;
end
else
begin
d := d + dinc2;
x := x + xinc2;
y := y + yinc2;
end;
end;
end end
else else
Begin Begin
@ -1084,24 +1130,24 @@ var
TmpNumPixels := NumPixels-1; TmpNumPixels := NumPixels-1;
{ NormWidth } { NormWidth }
for i := 0 to TmpNumPixels do for i := 0 to TmpNumPixels do
begin begin
if LinePatterns[i and 15] = TRUE then if LinePatterns[i and 15] = TRUE then
begin begin
DirectPutPixel(x,y); DirectPutPixel(x,y);
end; end;
if d < 0 then if d < 0 then
begin begin
d := d + dinc1; d := d + dinc1;
x := x + xinc1; x := x + xinc1;
y := y + yinc1; y := y + yinc1;
end end
else else
begin begin
d := d + dinc2; d := d + dinc2;
x := x + xinc2; x := x + xinc2;
y := y + yinc2; y := y + yinc2;
end; end;
end; end;
end end
end; end;
{******************************************} {******************************************}
@ -1274,6 +1320,15 @@ var
OldWriteMode : word; OldWriteMode : word;
OldCurrentColor : word; OldCurrentColor : word;
begin begin
{ convert to global coordinates ... }
x1 := x1 + StartXViewPort;
x2 := x2 + StartXViewPort;
y := y + StartYViewPort;
{ if line was fully clipped then exit...}
if LineClipped(x1,y,x2,y,StartXViewPort,StartYViewPort,
StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
exit;
OldWriteMode := CurrentWriteMode; OldWriteMode := CurrentWriteMode;
CurrentWriteMode := NormalPut; CurrentWriteMode := NormalPut;
@ -1287,31 +1342,46 @@ var
{ [FillSettings.Pattern][(((y+viewport.x1) and $7)+1];} { [FillSettings.Pattern][(((y+viewport.x1) and $7)+1];}
[FillSettings.Pattern][(y and $7)+1]; [FillSettings.Pattern][(y and $7)+1];
For i:= 0 to NrIterations do if FillSettings.Pattern = EmptyFill then
Begin begin
for j:=0 to 7 do OldCurrentColor := CurrentColor;
Begin CurrentColor := CurrentBkColor;
HLine(x1,x2,y);
CurrentColor := OldCurrentColor;
end
else
if FillSettings.Pattern = SolidFill then
begin
HLine(x1,x2,y);
end
else
begin
For i:= 0 to NrIterations do
Begin
for j:=0 to 7 do
Begin
{ x1 mod 8 } { x1 mod 8 }
if RevBitArray[x1 and 7] and TmpFillPattern <> 0 then if RevBitArray[x1 and 7] and TmpFillPattern <> 0 then
DirectPutpixel(x1,y) DirectPutpixel(x1,y)
else else
begin begin
{ According to the TP graph manual, we overwrite everything } { According to the TP graph manual, we overwrite everything }
{ which is filled up - checked against VGA and CGA drivers } { which is filled up - checked against VGA and CGA drivers }
{ of TP. } { of TP. }
OldCurrentColor := CurrentColor; OldCurrentColor := CurrentColor;
CurrentColor := CurrentBkColor; CurrentColor := CurrentBkColor;
DirectPutPixel(x1,y); DirectPutPixel(x1,y);
CurrentColor := OldCurrentColor; CurrentColor := OldCurrentColor;
end; end;
Inc(x1); Inc(x1);
if x1 > x2 then if x1 > x2 then
begin begin
CurrentWriteMode := OldWriteMode; CurrentWriteMode := OldWriteMode;
exit; exit;
end; end;
end; end;
end; end;
end;
CurrentWriteMode := OldWriteMode; CurrentWriteMode := OldWriteMode;
end; end;