mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 07:46:00 +02:00
* another fix for a case where internalellipsedefault went haywire
* sector() and pieslice() fully implemented! * small change to prevent buffer overflow with floodfill
This commit is contained in:
parent
f31460489f
commit
e188d82aec
@ -307,7 +307,7 @@ var
|
|||||||
var
|
var
|
||||||
i: integer;
|
i: integer;
|
||||||
Begin
|
Begin
|
||||||
If Buffer.WordIndex<(StdBufferSize DIV 2) then
|
If Buffer.WordIndex<(StdBufferSize DIV 2)-3 then
|
||||||
Begin
|
Begin
|
||||||
Buffer.Words[Buffer.WordIndex]:=x;
|
Buffer.Words[Buffer.WordIndex]:=x;
|
||||||
Buffer.Words[Buffer.WordIndex+1]:=y;
|
Buffer.Words[Buffer.WordIndex+1]:=y;
|
||||||
@ -492,7 +492,12 @@ var
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.6 1999-09-12 17:28:59 jonas
|
Revision 1.7 1999-09-17 13:58:31 jonas
|
||||||
|
* another fix for a case where internalellipsedefault went haywire
|
||||||
|
* sector() and pieslice() fully implemented!
|
||||||
|
* small change to prevent buffer overflow with floodfill
|
||||||
|
|
||||||
|
Revision 1.6 1999/09/12 17:28:59 jonas
|
||||||
* several changes to internalellipse to make it faster
|
* several changes to internalellipse to make it faster
|
||||||
and to make sure it updates the ArcCall correctly
|
and to make sure it updates the ArcCall correctly
|
||||||
(not yet done for width = 3)
|
(not yet done for width = 3)
|
||||||
|
@ -1307,55 +1307,50 @@ var
|
|||||||
Procedure InternalEllipseDefault(X,Y: Integer;XRadius: word;
|
Procedure InternalEllipseDefault(X,Y: Integer;XRadius: word;
|
||||||
YRadius:word; stAngle,EndAngle: word; pl: PatternLineProc); far;
|
YRadius:word; stAngle,EndAngle: word; pl: PatternLineProc); far;
|
||||||
var
|
var
|
||||||
j,Delta, DeltaEnd: graph_float;
|
j, Delta, DeltaEnd: graph_float;
|
||||||
NumOfPixels: longint;
|
NumOfPixels: longint;
|
||||||
NumOfPix: Array[0..2] of longint;
|
NumOfPix: Array[0..2] of longint;
|
||||||
count: longint;
|
count: longint;
|
||||||
ConvFac,TempTerm: graph_float;
|
ConvFac,TempTerm: graph_float;
|
||||||
aval,bval: integer;
|
aval,bval: integer;
|
||||||
TmpAngle: word;
|
xtemp, ytemp, xp, yp, xm, ym, xnext, ynext,
|
||||||
DeltaAngle: word;
|
plxpyp, plxmyp, plxpym, plxmym: integer;
|
||||||
xtemp, ytemp, xp, yp, xm, ym: integer;
|
BackupColor, DeltaAngle, TmpAngle, OldLineWidth: word;
|
||||||
q1p, q2p, q3p, q4p: PointType;
|
|
||||||
BackupColor, OldLineWidth: word;
|
|
||||||
Begin
|
Begin
|
||||||
If LineInfo.ThickNess = ThickWidth Then
|
If LineInfo.ThickNess = ThickWidth Then
|
||||||
{ first draw the two outer ellipses using normwidth and no filling (JM) }
|
{ first draw the two outer ellipses using normwidth and no filling (JM) }
|
||||||
Begin
|
Begin
|
||||||
OldLineWidth := LineInfo.Thickness;
|
OldLineWidth := LineInfo.Thickness;
|
||||||
LineInfo.Thickness := NormWidth;
|
LineInfo.Thickness := NormWidth;
|
||||||
InternalEllipseDefault(x,y,XRadius+2,YRadius+2,StAngle,EndAngle,
|
InternalEllipseDefault(x,y,XRadius,YRadius,StAngle,EndAngle,
|
||||||
{$ifdef fpc}@{$endif fpc}DummyPatternLine);
|
{$ifdef fpc}@{$endif fpc}DummyPatternLine);
|
||||||
InternalEllipseDefault(x,y,XRadius+1,YRadius+1,StAngle,EndAngle,
|
InternalEllipseDefault(x,y,XRadius+1,YRadius+1,StAngle,EndAngle,
|
||||||
{$ifdef fpc}@{$endif fpc}DummyPatternLine);
|
{$ifdef fpc}@{$endif fpc}DummyPatternLine);
|
||||||
|
If (XRadius <> 0) and (YRadius <> 0) Then
|
||||||
|
{ draw the smallest ellipse last, since that one will use the }
|
||||||
|
{ original pl, so it could possibly draw patternlines (JM) }
|
||||||
|
Begin
|
||||||
|
Dec(XRadius);
|
||||||
|
Dec(YRadius);
|
||||||
|
End
|
||||||
|
Else Exit;
|
||||||
{ restore line thickness }
|
{ restore line thickness }
|
||||||
LineInfo.Thickness := OldLineWidth;
|
LineInfo.Thickness := OldLineWidth;
|
||||||
End;
|
End;
|
||||||
{ Get End and Start points into the ArcCall information record }
|
{ check for an ellipse with negligable x and y radius }
|
||||||
ArcCall.X := X;
|
If (xradius <= 1) and (yradius <= 1) then
|
||||||
ArcCall.Y := Y;
|
begin
|
||||||
|
putpixel(x,y,CurrentColor);
|
||||||
|
ArcCall.X := X;
|
||||||
|
ArcCall.Y := Y;
|
||||||
|
ArcCall.XStart := X;
|
||||||
|
ArcCall.YStart := Y;
|
||||||
|
ArcCall.XEnd := X;
|
||||||
|
ArcCall.YEnd := Y;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
{ for restoring after PatternLine }
|
{ for restoring after PatternLine }
|
||||||
BackupColor := CurrentColor;
|
BackupColor := CurrentColor;
|
||||||
With q1p Do
|
|
||||||
Begin
|
|
||||||
x := $7fff;
|
|
||||||
y := $7fff;
|
|
||||||
End;
|
|
||||||
With q2p Do
|
|
||||||
Begin
|
|
||||||
x := $7fff;
|
|
||||||
y := $7fff;
|
|
||||||
End;
|
|
||||||
With q3p Do
|
|
||||||
Begin
|
|
||||||
x := $7fff;
|
|
||||||
y := $7fff;
|
|
||||||
End;
|
|
||||||
With q4p Do
|
|
||||||
Begin
|
|
||||||
x := $7fff;
|
|
||||||
y := $7fff;
|
|
||||||
End;
|
|
||||||
If xradius = 0 then inc(x);
|
If xradius = 0 then inc(x);
|
||||||
if yradius = 0 then inc(y);
|
if yradius = 0 then inc(y);
|
||||||
{ check if valid angles }
|
{ check if valid angles }
|
||||||
@ -1374,106 +1369,86 @@ var
|
|||||||
{ equation of an ellipse. }
|
{ equation of an ellipse. }
|
||||||
{ In the worst case, we have to calculate everything from the }
|
{ In the worst case, we have to calculate everything from the }
|
||||||
{ quadrant, so divide the circumference value by 4 (JM) }
|
{ quadrant, so divide the circumference value by 4 (JM) }
|
||||||
NumOfPixels:=(8 div 4)*Round(2.5*sqrt((sqr(XRadius)+sqr(YRadius)) div 2));
|
NumOfPixels:=(8 div 4)*Round(2*sqrt((sqr(XRadius)+sqr(YRadius)) div 2));
|
||||||
{ Calculate the angle precision required }
|
{ Calculate the angle precision required }
|
||||||
{ Note: to get the same precision as before, we have to divide by an }
|
Delta := 90 / (NumOfPixels);
|
||||||
{ extra 4 (JM) }
|
|
||||||
Delta := DeltaAngle / (NumOfPixels*4);
|
|
||||||
{ Adjust for screen aspect ratio }
|
{ Adjust for screen aspect ratio }
|
||||||
XRadius:=(longint(XRadius)*10000) div XAspect;
|
XRadius:=(longint(XRadius)*10000) div XAspect;
|
||||||
YRadius:=(longint(YRadius)*10000) div YAspect;
|
YRadius:=(longint(YRadius)*10000) div YAspect;
|
||||||
{ removed from inner loop to make faster }
|
{ removed from inner loop to make faster }
|
||||||
ConvFac:=Pi/180.0;
|
ConvFac:=Pi/180.0;
|
||||||
{ store some arccall info }
|
{ store some arccall info }
|
||||||
TempTerm := (Delta+StAngle)*ConvFac;
|
ArcCall.X := X;
|
||||||
|
ArcCall.Y := Y;
|
||||||
|
TempTerm := (StAngle)*ConvFac;
|
||||||
ArcCall.XStart := round(XRadius*Cos(TempTerm)) + X;
|
ArcCall.XStart := round(XRadius*Cos(TempTerm)) + X;
|
||||||
ArcCall.XEnd := ArcCall.XStart;
|
|
||||||
ArcCall.YStart := round(YRadius*Sin(TempTerm+Pi)) + Y;
|
ArcCall.YStart := round(YRadius*Sin(TempTerm+Pi)) + Y;
|
||||||
ArcCall.YEnd := ArcCall.YStart;
|
TempTerm := (EndAngle)*ConvFac;
|
||||||
|
ArcCall.XEnd := round(XRadius*Cos(TempTerm)) + X;
|
||||||
|
ArcCall.YEnd := round(YRadius*Sin(TempTerm+Pi)) + Y;
|
||||||
{ otherwise we get an endless loop }
|
{ otherwise we get an endless loop }
|
||||||
If DeltaAngle = 0 Then
|
{ If DeltaAngle = 0 Then
|
||||||
Begin
|
Begin
|
||||||
Line(x,y,ArcCall.XStart,ArcCall.YStart);
|
Line(X,Y,ArcCall.XStart,ArcCall.YStart);
|
||||||
exit
|
exit
|
||||||
End;
|
End;}
|
||||||
{ Always just go over the first 90 degrees. Could be optimized a }
|
{ Always just go over the first 90 degrees. Could be optimized a }
|
||||||
{ bit if StAngle and EndAngle lie in the same quadrant, left as an }
|
{ bit if StAngle and EndAngle lie in the same quadrant, left as an }
|
||||||
{ execrise for the reader :) (JM) }
|
{ exercise for the reader :) (JM) }
|
||||||
j := 0;
|
j := 0;
|
||||||
DeltaAngle := 90;
|
{ calculate stop position, go 1 further than 90 because otherwise }
|
||||||
{ calculate stop position (JM)}
|
{ 1 pixel is sometimes not drawn (JM) }
|
||||||
DeltaEnd := j + DeltaAngle;
|
DeltaEnd := 91;
|
||||||
|
{ Calculate points }
|
||||||
|
xnext := XRadius;
|
||||||
|
ynext := 0;
|
||||||
Repeat
|
Repeat
|
||||||
{ this is used by both sin and cos }
|
xtemp := xnext;
|
||||||
TempTerm := j*ConvFac;
|
ytemp := ynext;
|
||||||
{ Calculate points }
|
{ this is used by both sin and cos }
|
||||||
xtemp := round(XRadius*Cos(TempTerm));
|
TempTerm := (j+Delta)*ConvFac;
|
||||||
ytemp := round(YRadius*Sin(TempTerm+Pi));
|
{ Calculate points }
|
||||||
|
xnext := round(XRadius*Cos(TempTerm));
|
||||||
|
ynext := round(YRadius*Sin(TempTerm+Pi));
|
||||||
|
|
||||||
xp := x + xtemp;
|
xp := x + xtemp;
|
||||||
xm := x - xtemp;
|
xm := x - xtemp;
|
||||||
yp := y + ytemp;
|
yp := y + ytemp;
|
||||||
ym := y - ytemp;
|
ym := y - ytemp;
|
||||||
If (j >= StAngle) and (j <= EndAngle) then
|
plxpyp := maxint;
|
||||||
begin
|
plxmyp := -maxint-1;
|
||||||
q1p.x := xp;
|
plxpym := maxint;
|
||||||
q1p.y := yp;
|
plxmym := -maxint-1;
|
||||||
PutPixel(xp,yp,CurrentColor);
|
If (j >= StAngle) and (j <= EndAngle) then
|
||||||
end;
|
begin
|
||||||
If ((180-j) >= StAngle) and ((180-j) <= EndAngle) then
|
plxpyp := xp;
|
||||||
begin
|
PutPixel(xp,yp,CurrentColor);
|
||||||
If (q2p.x = $7fff) then
|
end;
|
||||||
Begin
|
If ((180-j) >= StAngle) and ((180-j) <= EndAngle) then
|
||||||
q2p.x := xm;
|
begin
|
||||||
q2p.y := yp;
|
plxmyp := xm;
|
||||||
End;
|
PutPixel(xm,yp,CurrentColor);
|
||||||
PutPixel(xm,yp,CurrentColor);
|
end;
|
||||||
end;
|
If ((j+180) >= StAngle) and ((j+180) <= EndAngle) then
|
||||||
If ((j+180) >= StAngle) and ((j+180) <= EndAngle) then
|
begin
|
||||||
begin
|
plxmym := xm;
|
||||||
q3p.x := xm;
|
PutPixel(xm,ym,CurrentColor);
|
||||||
q3p.y := ym;
|
end;
|
||||||
PutPixel(xm,ym,CurrentColor);
|
If ((360-j) >= StAngle) and ((360-j) <= EndAngle) then
|
||||||
end;
|
begin
|
||||||
If ((360-j) >= StAngle) and ((360-j) <= EndAngle) then
|
plxpym := xp;
|
||||||
begin
|
PutPixel(xp,ym,CurrentColor);
|
||||||
If (q4p.x = $7fff) then
|
end;
|
||||||
Begin
|
If (ynext <> ytemp) and
|
||||||
q4p.x := xp;
|
(xp-xm >2) then
|
||||||
q4p.y := ym;
|
begin
|
||||||
End;
|
CurrentColor := FillSettings.Color;
|
||||||
PutPixel(xp,ym,CurrentColor);
|
pl(plxmyp+1,plxpyp-1,yp);
|
||||||
end;
|
pl(plxmym+1,plxpym-1,ym);
|
||||||
If xp-xm >2 then
|
CurrentColor := BackupColor;
|
||||||
begin
|
end;
|
||||||
CurrentColor := FillSettings.Color;
|
j:=j+Delta;
|
||||||
pl(xm+1,xp-1,yp);
|
|
||||||
pl(xm+1,xp-1,ym);
|
|
||||||
CurrentColor := BackupColor;
|
|
||||||
end;
|
|
||||||
j:=j+Delta;
|
|
||||||
Until j > (DeltaEnd);
|
Until j > (DeltaEnd);
|
||||||
{ get the end of the arc (JM) }
|
|
||||||
If q4p.x <> $7fff Then
|
|
||||||
Begin
|
|
||||||
ArcCall.XEnd := q4p.x;
|
|
||||||
ArcCall.YEnd := q4p.y
|
|
||||||
End
|
|
||||||
Else If q3p.x <> $7fff Then
|
|
||||||
Begin
|
|
||||||
ArcCall.XEnd := q3p.x;
|
|
||||||
ArcCall.YEnd := q3p.y
|
|
||||||
End
|
|
||||||
Else If q2p.x <> $7fff Then
|
|
||||||
Begin
|
|
||||||
ArcCall.XEnd := q2p.x;
|
|
||||||
ArcCall.YEnd := q2p.y
|
|
||||||
End
|
|
||||||
Else If q1p.x <> $7fff Then
|
|
||||||
Begin
|
|
||||||
ArcCall.XEnd := q1p.x;
|
|
||||||
ArcCall.YEnd := q1p.y
|
|
||||||
End;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -1882,9 +1857,8 @@ end;
|
|||||||
Var
|
Var
|
||||||
x : Integer;
|
x : Integer;
|
||||||
Begin
|
Begin
|
||||||
For x:=0 to ViewWidth Do Begin
|
For x:=0 to ViewWidth Do
|
||||||
WordArray(Data)[x]:=GetPixel(x, y);
|
WordArray(Data)[x]:=GetPixel(x, y);
|
||||||
End;
|
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
|
||||||
@ -2090,37 +2064,21 @@ end;
|
|||||||
|
|
||||||
Procedure Arc(X,Y : Integer; StAngle,EndAngle,Radius: word);
|
Procedure Arc(X,Y : Integer; StAngle,EndAngle,Radius: word);
|
||||||
|
|
||||||
var
|
{ var
|
||||||
OldWriteMode: word;
|
OldWriteMode: word;}
|
||||||
|
|
||||||
Begin
|
Begin
|
||||||
if (Radius <= 1) then
|
|
||||||
Begin
|
|
||||||
With ArcCall Do
|
|
||||||
Begin
|
|
||||||
X := X;
|
|
||||||
Y := Y;
|
|
||||||
XStart := X;
|
|
||||||
YStart := Y;
|
|
||||||
XEnd := X;
|
|
||||||
YEnd := Y;
|
|
||||||
End;
|
|
||||||
If Radius = 1 then
|
|
||||||
PutPixel(X, Y,CurrentColor);
|
|
||||||
Exit;
|
|
||||||
End;
|
|
||||||
|
|
||||||
{ Only if we are using thickwidths lines do we accept }
|
{ Only if we are using thickwidths lines do we accept }
|
||||||
{ XORput write modes. }
|
{ XORput write modes. }
|
||||||
OldWriteMode := CurrentWriteMode;
|
{ OldWriteMode := CurrentWriteMode;
|
||||||
if (LineInfo.Thickness = NormWidth) then
|
if (LineInfo.Thickness = NormWidth) then
|
||||||
CurrentWriteMode := NormalPut;
|
CurrentWriteMode := NormalPut;}
|
||||||
{$ifdef fpc}
|
{$ifdef fpc}
|
||||||
InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,@DummyPatternLine);
|
InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,@DummyPatternLine);
|
||||||
{$else fpc}
|
{$else fpc}
|
||||||
InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,DummyPatternLine);
|
InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,DummyPatternLine);
|
||||||
{$endif fpc}
|
{$endif fpc}
|
||||||
CurrentWriteMode := OldWriteMode;
|
{ CurrentWriteMode := OldWriteMode;}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -2200,12 +2158,185 @@ end;
|
|||||||
move(OriginalArcInfo, ArcCall,sizeof(ArcCall));
|
move(OriginalArcInfo, ArcCall,sizeof(ArcCall));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure SectorPL(x1,x2,y: Integer); {$ifndef fpc}far;{$endif fpc}
|
||||||
|
var plx1, plx2: integer;
|
||||||
|
{!!!!!!!!!!!!!!!}
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
t : text;
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
begin
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
assign(t,'sector.log');
|
||||||
|
append(t);
|
||||||
|
writeln(t,'Got here for line ',y);
|
||||||
|
close(t);
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
If (x1 = -maxint) Then
|
||||||
|
If (x2 = maxint-1) Then
|
||||||
|
{ no ellipse points drawn on this line }
|
||||||
|
If (((Y < ArcCall.Y) and (Y > ArcCall.YStart)) or
|
||||||
|
((Y > ArcCall.Y) and (Y < ArcCall.YStart))) Then
|
||||||
|
{ there is a part of the sector at this y coordinate, but no }
|
||||||
|
{ ellips points are plotted on this line, so draw a patternline }
|
||||||
|
{ between the lines connecting (arccall.x,arccall.y) with }
|
||||||
|
{ the start and the end of the arc (JM) }
|
||||||
|
{ use: y-y1=(y2-y1)/(x2-x1)*(x-x1) => }
|
||||||
|
{ x = (y-y1)/(y2-y1)*(x2-x1)+x1 }
|
||||||
|
Begin
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
If (ArcCall.YStart-ArcCall.Y) = 0 then
|
||||||
|
begin
|
||||||
|
append(t);
|
||||||
|
writeln('bug1');
|
||||||
|
close(t);
|
||||||
|
runerror(202);
|
||||||
|
end;
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
plx1 := Round((y-ArcCall.Y)/(ArcCall.YStart-ArcCall.Y)*
|
||||||
|
(ArcCall.XStart-ArcCall.X))+ArcCall.X;
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
If (ArcCall.YEnd-ArcCall.Y) = 0 then
|
||||||
|
begin
|
||||||
|
append(t);
|
||||||
|
writeln('bug2');
|
||||||
|
close(t);
|
||||||
|
runerror(202);
|
||||||
|
end;
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
plx2 := Round((y-ArcCall.Y)/(ArcCall.YEnd-ArcCall.Y)*
|
||||||
|
(ArcCall.XEnd-ArcCall.X))+ArcCall.X;
|
||||||
|
If plx1 > plx2 then
|
||||||
|
begin
|
||||||
|
plx1 := plx1 xor plx2;
|
||||||
|
plx2 := plx1 xor plx2;
|
||||||
|
plx1 := plx1 xor plx2;
|
||||||
|
end;
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
append(t);
|
||||||
|
writeln(t,'lines: ',plx1,' - ',plx2);
|
||||||
|
close(t);
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
End
|
||||||
|
{ otherwise two points which have nothing to do with the sector }
|
||||||
|
Else exit
|
||||||
|
Else
|
||||||
|
{ the arc is plotted at the right side, but not at the left side, }
|
||||||
|
{ fill till the line between (ArcCall.X,ArcCall.Y) and }
|
||||||
|
{ (ArcCall.XStart,ArcCall.YStart) }
|
||||||
|
Begin
|
||||||
|
If (y < ArcCall.Y) then
|
||||||
|
begin
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
If (ArcCall.YEnd-ArcCall.Y) = 0 then
|
||||||
|
begin
|
||||||
|
append(t);
|
||||||
|
writeln('bug3');
|
||||||
|
close(t);
|
||||||
|
runerror(202);
|
||||||
|
end;
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
plx1 := Round((y-ArcCall.Y)/(ArcCall.YEnd-ArcCall.Y)*
|
||||||
|
(ArcCall.XEnd-ArcCall.X))+ArcCall.X
|
||||||
|
end
|
||||||
|
else if (y > ArcCall.Y) then
|
||||||
|
begin
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
If (ArcCall.YStart-ArcCall.Y) = 0 then
|
||||||
|
begin
|
||||||
|
append(t);
|
||||||
|
writeln('bug4');
|
||||||
|
close(t);
|
||||||
|
runerror(202);
|
||||||
|
end;
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
plx1 := Round((y-ArcCall.Y)/(ArcCall.YStart-ArcCall.Y)*
|
||||||
|
(ArcCall.XStart-ArcCall.X))+ArcCall.X
|
||||||
|
end
|
||||||
|
else plx1 := ArcCall.X;
|
||||||
|
plx2 := x2;
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
append(t);
|
||||||
|
writeln(t,'right: ',plx1,' - ',plx2);
|
||||||
|
close(t);
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
End
|
||||||
|
Else
|
||||||
|
If (x2 = maxint-1) Then
|
||||||
|
{ the arc is plotted at the left side, but not at the rigth side. }
|
||||||
|
{ the right limit can be either the first or second line. Just take }
|
||||||
|
{ the closest one, but watch out for division by zero! }
|
||||||
|
Begin
|
||||||
|
If (y < ArcCall.Y) then
|
||||||
|
begin
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
If (ArcCall.YStart-ArcCall.Y) = 0 then
|
||||||
|
begin
|
||||||
|
append(t);
|
||||||
|
writeln('bug5');
|
||||||
|
close(t);
|
||||||
|
runerror(202);
|
||||||
|
end;
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
plx2 := Round((y-ArcCall.Y)/(ArcCall.YStart-ArcCall.Y)*
|
||||||
|
(ArcCall.XStart-ArcCall.X))+ArcCall.X
|
||||||
|
end
|
||||||
|
else if (y > ArcCall.Y) then
|
||||||
|
begin
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
If (ArcCall.YEnd-ArcCall.Y) = 0 then
|
||||||
|
begin
|
||||||
|
append(t);
|
||||||
|
writeln('bug6');
|
||||||
|
close(t);
|
||||||
|
runerror(202);
|
||||||
|
end;
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
plx2 := Round((y-ArcCall.Y)/(ArcCall.YEnd-ArcCall.Y)*
|
||||||
|
(ArcCall.XEnd-ArcCall.X))+ArcCall.X
|
||||||
|
end
|
||||||
|
else plx2 := ArcCall.X;
|
||||||
|
plx1 := x1;
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
append(t);
|
||||||
|
writeln(t,'left: ',plx1,' - ',plx2);
|
||||||
|
close(t);
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
End
|
||||||
|
Else
|
||||||
|
{ the arc is plotted at both sides }
|
||||||
|
Begin
|
||||||
|
plx1 := x1;
|
||||||
|
plx2 := x2;
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
append(t);
|
||||||
|
writeln(t,'normal: ',plx1,' - ',plx2);
|
||||||
|
close(t);
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
End;
|
||||||
|
If plx2 - plx1 > 2 then
|
||||||
|
Begin
|
||||||
|
{$ifdef sectorpldebug}
|
||||||
|
append(t);
|
||||||
|
Writeln(t,'drawing...');
|
||||||
|
close(t);
|
||||||
|
{$endif sectorpldebug}
|
||||||
|
PatternLine(plx1,plx2,y);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure Sector(x, y: Integer; StAngle,EndAngle, XRadius, YRadius: Word);
|
procedure Sector(x, y: Integer; StAngle,EndAngle, XRadius, YRadius: Word);
|
||||||
var angle : graph_float;
|
(* var angle : graph_float;
|
||||||
writemode : word;
|
writemode : word; *)
|
||||||
begin
|
begin
|
||||||
|
{$ifdef fpc}
|
||||||
|
internalellipse(x,y,XRadius, YRadius, StAngle, EndAngle, @SectorPL);
|
||||||
|
{$else fpc}
|
||||||
|
internalellipse(x,y,XRadius, YRadius, StAngle, EndAngle, SectorPL);
|
||||||
|
{$endif fpc}
|
||||||
|
Line(ArcCall.XStart, ArcCall.YStart, x,y);
|
||||||
|
Line(x,y,ArcCall.Xend,ArcCall.YEnd);
|
||||||
|
|
||||||
|
(*
|
||||||
Ellipse(x,y,stAngle,endAngle,XRadius,YRadius);
|
Ellipse(x,y,stAngle,endAngle,XRadius,YRadius);
|
||||||
{ As in the TP graph unit - the line settings are used to }
|
{ As in the TP graph unit - the line settings are used to }
|
||||||
{ define the outline of the sector. }
|
{ define the outline of the sector. }
|
||||||
@ -2231,7 +2362,7 @@ end;
|
|||||||
+abs(ArcCall.ystart-ArcCall.yend)>2) then
|
+abs(ArcCall.ystart-ArcCall.yend)>2) then
|
||||||
FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
|
FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
|
||||||
y+round(cos((angle+90)*Pi/180)*YRadius/2),CurrentColor);
|
y+round(cos((angle+90)*Pi/180)*YRadius/2),CurrentColor);
|
||||||
CurrentWriteMode := writemode;
|
CurrentWriteMode := writemode;*)
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -2619,33 +2750,8 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
procedure PieSlice(X,Y,stangle,endAngle:integer;Radius: Word);
|
procedure PieSlice(X,Y,stangle,endAngle:integer;Radius: Word);
|
||||||
var angle : graph_float;
|
|
||||||
XRadius, YRadius : word;
|
|
||||||
writemode : word;
|
|
||||||
begin
|
begin
|
||||||
writemode := currentwritemode;
|
Sector(x,y,stangle,endangle,radius,radius);
|
||||||
Arc(x,y,StAngle,EndAngle,Radius);
|
|
||||||
Line(ArcCall.XStart, ArcCall.YStart, x,y);
|
|
||||||
Line(x,y, ArcCall.XEnd, ArcCall.YEnd);
|
|
||||||
{ must use PutPixel() instead of DirectPutPixel because we need }
|
|
||||||
{ clipping... }
|
|
||||||
PutPixel(ArcCall.xstart,ArcCall.ystart,CurrentColor);
|
|
||||||
PutPixel(x,y,CurrentColor);
|
|
||||||
PutPixel(ArcCall.xend,ArcCall.yend,CurrentColor);
|
|
||||||
Stangle:=stAngle mod 360; EndAngle:=Endangle mod 360;
|
|
||||||
if Stangle<=Endangle then
|
|
||||||
angle:=(StAngle+EndAngle) div 2
|
|
||||||
else
|
|
||||||
angle:=(StAngle-360+EndAngle) div 2;
|
|
||||||
{ fill from the point in the middle of the slice }
|
|
||||||
XRadius:=(longint(Radius)*10000) div XAspect;
|
|
||||||
YRadius:=(longint(Radius)*10000) div YAspect;
|
|
||||||
{ avoid rounding errors }
|
|
||||||
if abs(ArcCall.xstart-ArcCall.xend)
|
|
||||||
+abs(ArcCall.ystart-ArcCall.yend)>2 then
|
|
||||||
floodfill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
|
|
||||||
y+round(cos((angle)*Pi/180)*YRadius/2),FillSettings.Color);
|
|
||||||
CurrentWriteMode := writemode;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$i fills.inc}
|
{$i fills.inc}
|
||||||
@ -2773,7 +2879,12 @@ DetectGraph
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.22 1999-09-15 13:37:50 jonas
|
Revision 1.23 1999-09-17 13:58:31 jonas
|
||||||
|
* another fix for a case where internalellipsedefault went haywire
|
||||||
|
* sector() and pieslice() fully implemented!
|
||||||
|
* small change to prevent buffer overflow with floodfill
|
||||||
|
|
||||||
|
Revision 1.22 1999/09/15 13:37:50 jonas
|
||||||
* small change to internalellipsedef to be TP compatible
|
* small change to internalellipsedef to be TP compatible
|
||||||
* fixed directputpixel for vga 320*200*256
|
* fixed directputpixel for vga 320*200*256
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user