{*********************************************************}
{*                                                       *}
{*  UNIT:     T E l l i _ A A        24.07.95,  20.11.97 *}
{*                                                       *}
{*  Sprache:        T u r b o - P a s c a l     V 7.0    *}
{*                                                       *}
{*  (c)copyright:   1997 Ing. Gerd Platl                 *}
{*                                                       *}
{*  Zeichnet Ellipsen und Ellipsenscheiben mittels       *}
{*  DDA-Algorithmus (digital differential analyzer)      *}
{*  der nur Integer-Arithmetik ben”tigt                  *}
{*  unter Verwendung einer Farbpalette mit 256 Farben.   *}
{* ----------------------------------------------------- *}
{*  DrawEllipse      Zeichnet Ellipse mit Anti-Alaising  *}
{*  DiskEllipse      Ellipsenscheibe mit Anti-Alaising   *}
{*                                                       *}
{*********************************************************}
{$I tpc_opt.inc}

{ define ellitest}

UNIT TElli_AA;

INTERFACE

procedure DrawEllipse (mx,my, a,b: integer; color: byte);
procedure DiskEllipse (mx,my, a,b: integer; color: byte);

const ciRange: integer = 15;  {color index range}

IMPLEMENTATION

uses {$ifdef ellitest} TpError, {$endif}
     Gr320;

{*********************************************************}
{ draw 4 mirror points of ellipse with given color index
{---------------------------------------------------------}
procedure QuadroPixel (x1,y1,x2,y2: integer; color: byte);

begin
  PutPixel (x1,y1, color);
  PutPixel (x1,y2, color);
  PutPixel (x2,y2, color);
  PutPixel (x2,y1, color);
end;

{*********************************************************}
{ call:      DrawEllipse (mx,my, a,b, color);
{ function:  draw ellipse with 3 points thickness using
{            DDA-Algorithm and Anti-Aliasing.
{            (Intensity looks like 2 pixels)
{            The palette between color & c2 must be linear!
{ input:     mx,my: integer;  middle point
{            a,b: integer;    axis length >= 0
{            color: byte;     drawing color [1..15]
{    global: ciRange: integer;  color index range
{---------------------------------------------------------}
procedure DrawEllipse (mx,my, a,b: integer; color: byte);

var   x,   mx1,mx2,  my1,my2: integer;
      aq,bq, dx,dy, r, rx,ry: longint;
      c1,c2, c3,c4,c5, inColor, outColor: byte;
      aay: boolean;

{$ifdef ellitest}
  const ni: integer = 1;
{$endif}

begin
  if color = 0 then begin c1 := 0; c2 := 0; end
  else begin
    c1 := 1 + color * 16;         {darkest color}
    c2 := c1 + ciRange - 1;       {brightest color}
  end;
  SetColor (c2);
  c3 := (c1 + c2) div 2;          {50 % intensity}
  c4 := c2 - c1;                  {index range}

  if a = 0
  then if b = 0
  then PutPixel (mx, my, c2)      {draw just a point}
  else begin
    DrawVLine (mx, my-b, my+b);    {draw vertical line}
    SetColor (c3);
    DrawVLine (mx+1, my-b, my+b);
    DrawVLine (mx-1, my-b, my+b);
    inc (b);
    PutPixel (mx,my+b, c3);
    PutPixel (mx,my-b, c3);
    QuadroPixel (mx+1,my+b,mx-1,my-b, (c1+c3)shr 1);
    exit;
  end;
  if b = 0
  then begin
    DrawHLine (mx-a, mx+a, my);   {draw horizontal line}
    SetColor (c3);
    DrawHLine (mx-a, mx+a, my+1);
    DrawHLine (mx-a, mx+a, my-1);
    inc (a);
    PutPixel (mx-a,my, c3);
    PutPixel (mx+a,my, c3);
    QuadroPixel (mx+a,my+1,mx-a,my-1, (c1+c3)shr 1);
    exit;
  end
  else begin
    PutPixel (mx + a, my, c2);    {draw highest point}
    PutPixel (mx - a, my, c2);    {draw lowest point}

    mx1 := mx - a;   my1 := my;   {init pixel positions}
    mx2 := mx + a;   my2 := my;   { for QuadroPixel}

    aq := longint (a) * a;        {calc sqr}
    bq := longint (b) * b;
    dx := aq shl 1;               {dx := 2 * a * a}
    dy := bq shl 1;               {dy := 2 * b * b}
    r  := a * bq;                 {r  := a * b * b}
    rx := r shl 1;                {rx := 2 * a * b * b}
    ry := 0;                      {because y = 0}
    x := a;
    aay := false;                 {set aa-points left&right}

{$ifdef ellitest}
    writeln (tst, '  dx=  ',dx:3,'  dy=  ',dy:3);
    writeln (tst, ni:3,': x=',x:3
                , '  r=',r:6, '  rx=',rx:6,'  ry=',ry:6
                , '  c=',(rx-r)*15 div (rx+ry));
{$endif}
    QuadroPixel (mx1-1,my1,mx2+1,my2, c3);  {draw point outside}
    QuadroPixel (mx1+1,my1,mx2-1,my2, c3);  {draw point inside}

    while x > 0
    do begin
      if r > 0
      then begin                  { y + 1 }
        inc (my1);   dec (my2);
        inc (ry, dx);             {ry = dx * y}
        dec (r, ry);              {r = r - dx * y}
      end;
      if r <= 0
      then begin                  { x - 1 }
        dec (x);
        inc (mx1);   dec (mx2);
        dec (rx, dy);             {rx = dy * x}
        inc (r, rx);              {r = r + dy * x}
      end;
      QuadroPixel (mx1,my1,mx2,my2, c2);  {draw mirror points}

      {-- anti-aliasing pixel drawing --}
      c5 := c4 * (rx-r) div (rx+ry);   {!!! very tricky !!!}
      inColor  := c1 + c5;        {inside color index}
      outColor := c2 - c5;        {outside color index}
      if aay
      then begin                  {draw above, below}
        QuadroPixel (mx1, my1-1, mx2, my2+1, inColor);
        QuadroPixel (mx1, my1+1, mx2, my2-1, outColor);
      end
      else begin                  {draw left,right}
        QuadroPixel (mx1+1, my1, mx2-1, my2, inColor);
        QuadroPixel (mx1-1, my1, mx2+1, my2, outColor);
        if rx < ry                {tangent -45ø erreicht ?}
        then begin
          aay := true;            {draw diagonal}
          QuadroPixel (mx1, my1+1, mx2, my2-1, outColor);
        end;
      end;
{$ifdef ellitest}
      inc (ni);
      writeln (tst, ni:3,': x=',x:3
                  , '  r=',r:6, '  rx=',rx:6,'  ry=',ry:6
                  , '  c=',incolor);
      PutPixel (mx2, (my1+my2)div 2,1);   {Nulllinie}
      PutPixel (mx2, (my1+my2)div 2 + r div 10000, 11);
      PutPixel (mx2, (my1+my2)div 2 - rx div 10000, 9);
      PutPixel (mx2, (my1+my2)div 2 - ry div 10000, 7);
{$endif}

    end;
  end;
end;

{*********************************************************}
{ Aufruf:      DiskEllipse (mx,my, a,b, color);
{ Funktion:    Zeichnen einer Ellipsenscheibe
{              mittels DDA-Algorithmus
{              und Anti-Aliasing-Technik
{ Versorgung:  mx,my: integer;  Mittelpunktkoordinaten
{              a,b: integer;    Halbachsenl„ngen >= 0
{              color: byte;     Hintergrundfarbe
{      global: ciRange: integer;  Farbbereich
{---------------------------------------------------------}
procedure DiskEllipse (mx,my, a,b: integer; color: byte);

var   x,   mx1,mx2,  my1,my2: integer;
      aq,bq, dx,dy, r, rx,ry: longint;
      c1,c2, c3,c4,c5, outColor: byte;
      aay: boolean;

begin
  if color = 0 then begin c1 := 0; c2 := 0; end
  else begin
    c1 := 1 + color * 16;
    c2 := c1 + ciRange - 1;       {Ellipsenfarbe}
  end;
  SetColor (c2);
  c3 := (integer(c1) + c2) div 2;
  c4 := c2 - c1;

  if a = 0
  then if b = 0
  then PutPixel (mx, my, c2)      {draw just a point}
  else begin
    DrawVLine (mx, my-b, my+b);    {draw vertical line}
    SetColor (c3);
    DrawVLine (mx+1, my-b, my+b);
    DrawVLine (mx-1, my-b, my+b);
    inc (b);
    PutPixel (mx,my+b, c3);
    PutPixel (mx,my-b, c3);
    QuadroPixel (mx+1,my+b,mx-1,my-b, (c1+c3)shr 1);
    exit;
  end;
  if b = 0
  then begin
    DrawHLine (mx-a, mx+a, my);   {draw horizontal line}
    SetColor (c3);
    DrawHLine (mx-a, mx+a, my+1);
    DrawHLine (mx-a, mx+a, my-1);
    inc (a);
    PutPixel (mx-a,my, c3);
    PutPixel (mx+a,my, c3);
    QuadroPixel (mx+a,my+1,mx-a,my-1, (c1+c3)shr 1);
    exit;
  end
  else begin
    mx1 := mx - a;   my1 := my;   {init pixel positions}
    mx2 := mx + a;   my2 := my;

    DrawHLine (mx-a, mx+a, my);
    QuadroPixel (mx1-1,my1,mx2+1,my2, c3);  {Aussenpunkte setzen}

    aq := longint (a) * a;        {calc sqr}
    bq := longint (b) * b;
    dx := aq shl 1;               {dx := 2 * a * a}
    dy := bq shl 1;               {dy := 2 * b * b}
    r  := a * bq;                 {r  := a * b * b}
    rx := r shl 1;                {rx := 2 * a * b * b}
    ry := 0;                      {because y = 0}
    x := a;
    aay := false;

    while x > 0
    do begin
      if r > 0
      then begin                  { y + 1 }
        inc (my1);   dec(my2);
        inc (ry, dx);
        dec (r, ry);         {draw 2 horizontal lines}
        DrawHLine (mx1, mx2, my1);
        DrawHLine (mx1, mx2, my2);
      end;
      if r <= 0
      then begin                  { x - 1 }
        dec (x);
        inc (mx1); dec (mx2);
        dec (rx, dy);
        inc (r, rx);
      end;

      {-- Anti-Alaising-Pixel drawing --}
      outColor := c2 - c4 * (rx-r) div (rx+ry);
      if aay
      then begin                       {oben, unten}
{        QuadroPixel (mx1, my1-1, mx2, my2+1, inColor);}
        QuadroPixel (mx1, my1+1, mx2, my2-1, outColor);
      end
      else begin                       {links,rechts}
{        QuadroPixel (mx1+1, my1, mx2-1, my2, inColor);}
        QuadroPixel (mx1-1, my1, mx2+1, my2, outColor);
        if rx < ry      {Tangente -45ø erreicht ?}
        then begin
          aay := true;                 {diagonal}
          QuadroPixel (mx1, my1+1, mx2, my2-1, outColor);
        end;
      end;
    end;
  end;
end;

end.
