freepascal.compiler/rtl/dos/ppi/ellipse.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.

 **********************************************************************}

    function CalcEllipse(x,y:Integer;XRadius,YRadius:word):Integer;
     var aq,bq,xq,yq,abq : Longint;
         xp,yp,count     : integer;
     begin
     XRadius:=(XRadius*10000) div XAsp;
     YRadius:=(YRadius*10000) div YAsp;
     aq :=XRadius * XRadius;
     bq :=YRadius * YRadius;
     abq:=aq * bq;
     yp:=YRadius;
     xp:=0;
     count:=0; 
     
      { Berechnung nach : X^2 / A^2 + Y^2 / B^2 = 1               }
      {      umgestellt : X^2 * Y^2 * A^2 * B^2 = A^2*B^2         }
      {      dadurch werden evtuelle Divisionen durch 0 vermieden }
      {      und Integerarithmetik moeglich                       }

    repeat              
      PWord(buffermem)[count  ]:=x + xp;
      PWord(buffermem)[count+1]:=y + yp;
      PWord(buffermem)[count+2]:=x - xp;
      PWord(buffermem)[count+3]:=y - yp;
      xq:=xp * xp; yq:=yp * yp;
      if xq * bq + yq * aq >= abq then yp:=yp-1 else xp:=xp+1; 
      Count:=Count+4;
    until yp < 0;
    CalcEllipse:=Count;
  end;
    
  Procedure _Ellipse(Count:Integer);  
    const aq:Integer=0;
    begin
    
    { Das Zeichnen der Ellipse erfolgt in zwei Schleifen, um systematisch }
    { von oben nach unten zu zeichnen und somit ein staendiges Bank-      }
    { umschalten zu verhindern }
    
    while aq <> count do begin
      PutPixel( PWord(buffermem)[aq]  ,PWord(buffermem)[aq+3],aktcolor);
      PutPixel( PWord(buffermem)[aq+2],PWord(buffermem)[aq+3],aktcolor);
      aq:=aq+4;
    end;
    while aq <> 0 do begin
      aq:=aq-4;
      PutPixel( PWord(buffermem)[aq]  ,PWord(buffermem)[aq+1],aktcolor);
      PutPixel( PWord(buffermem)[aq+2],PWord(buffermem)[aq+1],aktcolor);
    end;
  end;

  Procedure Fillellipse(x,y:Integer;XRadius,YRadius:word);    
    var Count,index:Word;
        Count8:Word;
        begin
         _graphresult:=grOk;
         if not isgraphmode then
           begin
              _graphresult:=grnoinitgraph;
              exit;
           end;

    Count:=CalcEllipse(x,y,XRadius,YRadius);
    if Count=0 then exit;
    Count8:=Count-8;
    index:=0;
    
    while index < count do begin
      while (PWord(buffermem)[index+1]=PWord(buffermem)[index+5]) and
            (index < count8) do Index:=Index+4;
      PatternLine(PWord(buffermem)[index],PWord(buffermem)[index+2],
                  PWord(buffermem)[index+3]); 
      Index:=Index+4;
    end;
    
    while index > 0 do begin   
      index:=index-4;  
      PatternLine(PWord(buffermem)[index],PWord(buffermem)[index+2],
                  PWord(buffermem)[index+1]); 
      while (PWord(buffermem)[index+1]=PWord(buffermem)[index-3]) and
            (index > 4 ) do Index:=Index-4; 
    end;
    
    if (aktColor <> aktFillSettings.Color) or (aktFillSettings.Pattern<>1)
       then _Ellipse(Count);
  end;
    

  procedure Circle(x,y:integer;radius:word);
  begin
    _graphresult:=grOk;
    if not isgraphmode then
      begin
        _graphresult:=grnoinitgraph;
        exit;
      end;
    _Ellipse(CalcEllipse(x,y,radius,radius));
  end;  
 
{
  $Log$
  Revision 1.1  1998-03-25 11:18:42  root
  Initial revision

  Revision 1.3  1998/01/26 11:57:54  michael
  + Added log at the end


  
  Working file: rtl/dos/ppi/ellipse.ppi
  description:
  ----------------------------
  revision 1.2
  date: 1997/12/01 12:21:29;  author: michael;  state: Exp;  lines: +13 -1
  + 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
  =============================================================================
}