freepascal.compiler/rtl/dos/ppi/arc.ppi

{
    $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
  =============================================================================
}