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

* ClearViewPort was wrong ,and is now 75% faster

Browse Source 
* Some clipping added by replacing DirectPutPixel -> PutPixel
This commit is contained in:
carl 1999-04-25 00:31:37 +00:00
parent 28f657b4db
commit a6a9da360d
1 changed files with 71 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -619,7 +619,6 @@ const
($80,$40,$20,$10,$08,$04,$02,$01); ($80,$40,$20,$10,$08,$04,$02,$01);
MaxModes = 13;
{ pre expanded line patterns } { pre expanded line patterns }
@ -942,7 +941,7 @@ var
{ 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;
@ -976,7 +975,7 @@ var
{ with predefined line patterns... } { with predefined line patterns... }
if LinePatterns[PixelCount and 15] = TRUE then if LinePatterns[PixelCount and 15] = TRUE then
begin begin
DirectPutPixel(x1+i,PixelCount); DirectPutPixel(x1+i,PixelCount);
end; end;
end; end;
end; end;
@ -1294,7 +1293,7 @@ var
Begin 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 }
@ -1371,11 +1370,11 @@ var
LineInfo.Thickness := Thickness; LineInfo.Thickness := Thickness;
LineInfo.LineStyle := LineStyle; LineInfo.LineStyle := LineStyle;
case LineStyle of case LineStyle of
UserBitLn: Lineinfo.Pattern := pattern; UserBitLn: Lineinfo.Pattern := pattern;
SolidLn: Lineinfo.Pattern := $ffff; { ------- } SolidLn: Lineinfo.Pattern := $ffff; { ------- }
DashedLn : Lineinfo.Pattern := $F8F8; { -- -- --} DashedLn : Lineinfo.Pattern := $F8F8; { -- -- --}
DottedLn: LineInfo.Pattern := $CCCC; { - - - - } DottedLn: LineInfo.Pattern := $CCCC; { - - - - }
CenterLn: LineInfo.Pattern := $FC78; { -- - -- } CenterLn: LineInfo.Pattern := $FC78; { -- - -- }
end; { end case } end; { end case }
{ setup pattern styles } { setup pattern styles }
j:=15; j:=15;
@ -1403,19 +1402,30 @@ var
Procedure ClearViewPortDefault; Procedure ClearViewPortDefault;
var var
i,j: integer; j: integer;
MaxWidth, MaxHeight: Integer; OldWriteMode, OldCurColor: word;
LineSets : LineSettingsType;
Begin Begin
{ CP is always RELATIVE coordinates } { CP is always RELATIVE coordinates }
CurrentX := 0; CurrentX := 0;
CurrentY := 0; CurrentY := 0;
MaxWidth := StartXViewPort + ViewWidth;
MaxHeight := StartYViewPort + ViewHeight; { Save all old settings }
for J:=StartYViewPort to MaxHeight do OldCurColor := CurrentColor;
Begin CurrentColor:=CurrentBkColor;
for i:=StartXViewPort to MaxWidth do OldWriteMode:=CurrentWriteMode;
PutPixel(I,J,CurrentBkColor); GetLineSettings(LineSets);
end; { reset to normal line style...}
SetLineStyle(SolidLn, 0, NormWidth);
{ routines are relative here...}
for J:=0 to ViewHeight do
HLine(0, ViewWidth, J);
{ restore old settings...}
SetLineStyle(LineSets.LineStyle, LineSets.Pattern, LineSets.Thickness);
CurrentColor := OldCurColor;
CurrentWriteMode := OldWriteMode;
end; end;
@ -1531,18 +1541,18 @@ Begin
Begin Begin
for i:=X to X1 do for i:=X to X1 do
begin begin
case BitBlt of case BitBlt of
{$R-} {$R-}
CopyPut: color:= pt(Bitmap)[k]; { also = normalput } CopyPut: color:= pt(Bitmap)[k]; { also = normalput }
XORPut: color:= pt(Bitmap)[k] XOR GetPixel(i,j); XORPut: color:= pt(Bitmap)[k] XOR GetPixel(i,j);
OrPut: color:= pt(Bitmap)[k] OR GetPixel(i,j); OrPut: color:= pt(Bitmap)[k] OR GetPixel(i,j);
AndPut: color:= pt(Bitmap)[k] AND GetPixel(i,j); AndPut: color:= pt(Bitmap)[k] AND GetPixel(i,j);
NotPut: color:= not pt(Bitmap)[k]; NotPut: color:= not pt(Bitmap)[k];
{$R+} {$R+}
end; end;
putpixel(i,j,color); putpixel(i,j,color);
Inc(k); Inc(k);
end; end;
end; end;
end; end;
@ -1561,9 +1571,9 @@ Begin
for i:=X1 to X2 do for i:=X1 to X2 do
begin begin
{$R-} {$R-}
pt(Bitmap)[k] :=getpixel(i,j); pt(Bitmap)[k] :=getpixel(i,j);
{$R+} {$R+}
Inc(k); Inc(k);
end; end;
end; end;
ptw(Bitmap)[0] := X2-X1; { First longint is width } ptw(Bitmap)[0] := X2-X1; { First longint is width }
@ -1696,11 +1706,11 @@ end;
if (Radius = 1) then if (Radius = 1) then
begin begin
OldWriteMode:=CurrentWriteMode; { must use clipping ... }
CurrentWriteMode := NormalPut; { don't need to explicitly set NormalPut mode }
DirectPutPixel(X, Y); { because PutPixel only supports normal put }
CurrentWriteMode := OldWriteMode; PutPixel(X, Y,CurrentColor);
Exit; Exit;
end; end;
{ Only if we are using thickwidths lines do we accept } { Only if we are using thickwidths lines do we accept }
@ -1708,7 +1718,7 @@ end;
OldWriteMode := CurrentWriteMode; OldWriteMode := CurrentWriteMode;
if (LineInfo.Thickness = NormWidth) then if (LineInfo.Thickness = NormWidth) then
CurrentWriteMode := NormalPut; CurrentWriteMode := NormalPut;
InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle); InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle);
CurrentWriteMode := OldWriteMode; CurrentWriteMode := OldWriteMode;
end; end;
@ -1767,10 +1777,8 @@ end;
if (Radius = 1) then if (Radius = 1) then
begin begin
OldWriteMode := CurrentWriteMode; { only normal put mode is supported by a call to PutPixel }
CurrentWriteMode := NormalPut; PutPixel(X, Y, CurrentColor);
DirectPutPixel(X, Y);
CurrentWriteMode := OldWriteMode;
Exit; Exit;
end; end;
@ -1780,8 +1788,8 @@ end;
move(ArcCall,OriginalArcInfo, sizeof(ArcCall)); move(ArcCall,OriginalArcInfo, sizeof(ArcCall));
if LineInfo.Thickness = Normwidth then if LineInfo.Thickness = Normwidth then
begin begin
OldWriteMode := CurrentWriteMode; OldWriteMode := CurrentWriteMode;
CurrentWriteMode := CopyPut; CurrentWriteMode := CopyPut;
end; end;
InternalEllipse(X,Y,Radius,Radius,0,360); InternalEllipse(X,Y,Radius,Radius,0,360);
if LineInfo.Thickness = Normwidth then if LineInfo.Thickness = Normwidth then
@ -1803,9 +1811,11 @@ end;
Currentwritemode:=normalput; Currentwritemode:=normalput;
Line(ArcCall.XStart, ArcCall.YStart, x,y); Line(ArcCall.XStart, ArcCall.YStart, x,y);
Line(x,y,ArcCall.Xend,ArcCall.YEnd); Line(x,y,ArcCall.Xend,ArcCall.YEnd);
DirectPutPixel(ArcCall.xstart,ArcCall.ystart); { we must take care of clipping so we call PutPixel instead }
DirectPutPixel(x,y); { of DirectPutPixel... }
DirectPutPixel(ArcCall.xend,ArcCall.yend); PutPixel(ArcCall.xstart,ArcCall.ystart,CurrentColor);
PutPixel(x,y,CurrentColor);
PutPixel(ArcCall.xend,ArcCall.yend,CurrentColor);
stangle:=Stangle mod 360; EndAngle:=Endangle mod 360; stangle:=Stangle mod 360; EndAngle:=Endangle mod 360;
if stAngle<=Endangle then if stAngle<=Endangle then
Angle:=(stAngle+EndAngle)/2 Angle:=(stAngle+EndAngle)/2
@ -1831,8 +1841,8 @@ end;
{ unchanged. } { unchanged. }
if (Pattern > UserFill) or (Color > GetMaxColor) then if (Pattern > UserFill) or (Color > GetMaxColor) then
begin begin
_GraphResult := grError; _GraphResult := grError;
exit; exit;
end; end;
FillSettings.Color := Color; FillSettings.Color := Color;
FillSettings.Pattern := Pattern; FillSettings.Pattern := Pattern;
@ -1852,8 +1862,8 @@ end;
begin begin
if Color > GetMaxColor then if Color > GetMaxColor then
begin begin
_GraphResult := grError; _GraphResult := grError;
exit; exit;
end; end;
FillSettings.Color := Color; FillSettings.Color := Color;
@ -1888,21 +1898,23 @@ end;
Lineinfo.thickness:=normwidth; Lineinfo.thickness:=normwidth;
case Fillsettings.pattern of case Fillsettings.pattern of
EmptyFill : begin EmptyFill :
begin
Currentcolor:=CurrentBkColor; Currentcolor:=CurrentBkColor;
for y:=y1 to y2 do for y:=y1 to y2 do
Hline(x1,x2,y); Hline(x1,x2,y);
end; end;
SolidFill : begin SolidFill :
begin
CurrentColor:=FillSettings.color; CurrentColor:=FillSettings.color;
for y:=y1 to y2 do for y:=y1 to y2 do
Hline(x1,x2,y); Hline(x1,x2,y);
end; end;
else else
Begin Begin
CurrentColor:=FillSettings.color; CurrentColor:=FillSettings.color;
for y:=y1 to y2 do for y:=y1 to y2 do
patternline(x1,x2,y); patternline(x1,x2,y);
end; end;
end; end;
CurrentColor:= Origcolor; CurrentColor:= Origcolor;
@ -2203,9 +2215,11 @@ end;
Arc(x,y,StAngle,EndAngle,Radius); Arc(x,y,StAngle,EndAngle,Radius);
Line(ArcCall.XStart, ArcCall.YStart, x,y); Line(ArcCall.XStart, ArcCall.YStart, x,y);
Line(x,y, ArcCall.XEnd, ArcCall.YEnd); Line(x,y, ArcCall.XEnd, ArcCall.YEnd);
DirectPutPixel(ArcCall.xstart,ArcCall.ystart); { must use PutPixel() instead of DirectPutPixel because we need }
DirectPutPixel(x,y); { clipping... }
DirectPutPixel(ArcCall.xend,ArcCall.yend); PutPixel(ArcCall.xstart,ArcCall.ystart,CurrentColor);
PutPixel(x,y,CurrentColor);
PutPixel(ArcCall.xend,ArcCall.yend,CurrentColor);
Stangle:=stAngle mod 360; EndAngle:=Endangle mod 360; Stangle:=stAngle mod 360; EndAngle:=Endangle mod 360;
if Stangle<=Endangle then if Stangle<=Endangle then
angle:=(StAngle+EndAngle)/2 angle:=(StAngle+EndAngle)/2
@ -2322,14 +2336,6 @@ SetRGBPalette
SetVisualPage SetVisualPage
DetectGraph DetectGraph
{ These routine must be hooked for every new platform: }
{ }
{ InitGraph() }
{ PutPixel() }
{ DirectPutPixel() }
{ GetPixel() }
{ CloseGraph() }
{ DetectGraph() } { DetectGraph() }
{ GetPalette() } { GetPalette() }
{ SetAllPalette() } { SetAllPalette() }