mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-26 06:02:33 +02:00
114 lines
3.3 KiB
Plaintext
114 lines
3.3 KiB
Plaintext
{
|
|
$Id$
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 1993,97 by the Free Pascal development team
|
|
|
|
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.
|
|
|
|
**********************************************************************}
|
|
|
|
procedure Arc(x,y,alpha,beta:Integer;Radius:word);
|
|
|
|
const i:Array[0..20]of Byte=
|
|
(0,3,0, 2,3,1, 2,1,0, 0,1,1, 0,3,0, 2,3,1, 2,1,0);
|
|
|
|
var counter,index,ofs : integer;
|
|
xa,ya,xe,ye : Array[0..2]of Integer;
|
|
xp,yp : integer;
|
|
xradius,yradius : word;
|
|
first,ready : Boolean;
|
|
|
|
procedure DrawArc(index1,index2,index3:byte);
|
|
var ende,incr:integer;
|
|
begin
|
|
if index3=0 then begin
|
|
counter:=index;
|
|
ende:=0;
|
|
incr:=-4;
|
|
end else begin
|
|
counter:=-4;
|
|
ende:=index-4;
|
|
incr:=4;
|
|
end;
|
|
if first then begin
|
|
repeat
|
|
first:=false;
|
|
counter:=counter+incr;
|
|
xp:=PInteger(BufferMem)[counter+index1];
|
|
yp:=PInteger(BufferMem)[counter+index2];
|
|
until (counter=ende) or
|
|
(((xp=xa[0]) or (xp=xa[1]) or (xp=xa[2])) and
|
|
((yp=ya[0]) or (yp=ya[1]) or (yp=ya[2])));
|
|
if Counter=Ende then exit else putpixel(xp,yp,aktcolor);
|
|
end;
|
|
repeat
|
|
if (((xp=xe[0]) or (xp=xe[1]) or (xp=xe[2])) and
|
|
((yp=ye[0]) or (yp=ye[1]) or (yp=ye[2]))) then
|
|
begin
|
|
ready:=true;
|
|
exit;
|
|
end;
|
|
counter:=counter+incr;
|
|
xp:=PInteger(BufferMem)[counter+index1];
|
|
yp:=PInteger(BufferMem)[counter+index2];
|
|
putpixel(xp,yp,aktcolor);
|
|
until counter=Ende;
|
|
end;
|
|
|
|
begin
|
|
first:=true; ready:=false;
|
|
XRadius:=Radius; YRadius:=Radius;
|
|
|
|
alpha:=alpha mod 360; beta:=beta mod 360;
|
|
case alpha of
|
|
0.. 89 : ofs:=0;
|
|
90..179 : ofs:=1;
|
|
180..269 : ofs:=2;
|
|
270..359 : ofs:=3;
|
|
end;
|
|
x:=x+aktviewport.x1; y:=y+aktviewport.y1;
|
|
xa[1]:=x+round(sin((alpha+90)*Pi/180) * XRadius);
|
|
ya[1]:=y+round(cos((alpha+90)*Pi/180) * YRadius);
|
|
xe[1]:=x+round(sin((beta+90)*Pi/180) * XRadius);
|
|
ye[1]:=y+round(cos((beta+90)*Pi/180) * YRadius);
|
|
xa[0]:=xa[1]-1; xa[2]:=xa[1]+1; ya[0]:=ya[1]-1; ya[2]:=ya[1]+1;
|
|
xe[0]:=xe[1]-1; xe[2]:=xe[1]+1; ye[0]:=ye[1]-1; ye[2]:=ye[1]+1;
|
|
index:=Calcellipse(x,y,Radius,Radius);
|
|
repeat
|
|
DrawArc(i[ofs*3],i[ofs*3+1],i[ofs*3+2]);
|
|
ofs:=(ofs+1) mod 7;
|
|
until ready;
|
|
end;
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.1 1998-03-25 11:18:42 root
|
|
Initial revision
|
|
|
|
Revision 1.3 1998/01/26 11:58:53 michael
|
|
+ Added log at the end
|
|
|
|
|
|
|
|
Working file: rtl/dos/ppi/arc.ppi
|
|
description:
|
|
----------------------------
|
|
revision 1.2
|
|
date: 1997/12/01 12:21:27; author: michael; state: Exp; lines: +13 -0
|
|
+ added copyright reference in header.
|
|
----------------------------
|
|
revision 1.1
|
|
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
|
Initial revision
|
|
----------------------------
|
|
revision 1.1.1.1
|
|
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
|
FPC RTL CVS start
|
|
=============================================================================
|
|
}
|