home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / ELIPMBR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-20  |  4.7 KB  |  165 lines
  1. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  2.  
  3. procedure StrokeEllipse ( xc, yc : integer ; { center }
  4.                             a, b : word ; { radii }
  5.                               ta : single ) ; { rotation angle (rad) }
  6.  
  7.      { ElipMBR - Modified Bresenham ellipse algorithm with }
  8.      {           rotation and aspect correction            }
  9.  
  10. var
  11.    Color            : word ;    { default color }
  12.    a2,b2            : single ;  { starting point parameters }
  13.    costa,sinta      : single ;  { rotation angle functions }
  14.    costa2,sinta2    : single ;  {            "             }
  15.    px,py            : single ;  { aspect variables }
  16.    pxx,pxy,pyy      : single ;  {        "         }
  17.    x0,y0            : single ;  { starting point, float }
  18.    ix0,iy0          : integer ; {        "      , fixed }
  19.    ix,iy            : integer ; { coordinates variables }
  20.    ie,iex,iey       : longint ; { error variables }
  21.    idex,idey        : longint ; { error offsets }
  22.    idex0,idey0      : longint ; {       "      , initial }
  23.    idexx,idexy      : longint ; { error increments }
  24.    ideyx,ideyy      : longint ; {        "         }
  25.  
  26. begin
  27.  
  28.    if (a > 0) and (b > 0) then begin
  29.  
  30.       Color := GetColor ;
  31.  
  32.       a2 := sqr(a) ;
  33.       b2 := sqr(b) ;
  34.                                 { rotation angle functions }
  35.       costa := cos(ta) ;
  36.       costa2 := sqr(costa) ;
  37.       sinta := sin(ta) ;
  38.       sinta2 := sqr(sinta) ;
  39.                                 { initialize assuming 3/2 aspect }
  40.       px := 3 * GetMaxY ;
  41.       py := 2 * GetMaxX ;
  42.                                { scaling parameters }
  43.       if px > py then begin
  44.          py := py / px ;
  45.          px := 1.0
  46.       end
  47.       else begin
  48.          px := px / py ;
  49.          py := 1.0
  50.       end ;
  51.                                 { find negative y extremum point }
  52.       pxx := sqr(px) * (b2 * costa2 + a2 * sinta2) ;
  53.       pxy := px * py * (b2 - a2) * sinta * costa ;
  54.       pyy := sqr(py) * (b2 * sinta2 + a2 * costa2) ;
  55.  
  56.       idexx := Round(2.0*pxx) ;
  57.       idexy := Round(2.0*pxy) ;
  58.       ideyx := idexy ;
  59.       ideyy := Round(2.0*pyy) ;
  60.                                 { initial coordinates }
  61.       y0 := sqrt(pxx)/py ;
  62.       iy0 := Round(y0) ;
  63.       x0 := -y0 * pxy / pxx ;
  64.       ix0 := Round(x0) ;
  65.  
  66.       idex0 := Round((2.0*x0+1.0) * pxx + 2.0*y0 * pxy) ;
  67.       idey0 := Round(2.0*x0 * pxy + (2.0*y0+1.0) * pyy) ;
  68.                                 { starting point }
  69.       ix := ix0 ;
  70.       iy := iy0 ;
  71.       ie := 0 ;
  72.                                 { extremum diagonal points }
  73.       PutPixel(xc+ix,yc-iy,Color) ;
  74.       PutPixel(xc-ix,yc+iy,Color) ;
  75.                                { clockwise }
  76.       idex := idex0 ;
  77.       idey := -idey0 + ideyy ;
  78.  
  79.       while idex < -idey do begin
  80.  
  81.          Inc(ie,idex) ;
  82.          Inc(idex,idexx) ;
  83.          Inc(ix) ;
  84.          Dec(idey,ideyx) ;
  85.          iey := ie + idey ;
  86.          if abs(ie) >= abs(iey) then begin
  87.             ie := iey ;
  88.             Dec(idex,idexy) ;
  89.             Dec(iy) ;
  90.             Inc(idey,ideyy) ;
  91.          end ;
  92.  
  93.          PutPixel(xc+ix,yc-iy,Color) ;
  94.          PutPixel(xc-ix,yc+iy,Color)
  95.  
  96.       end ;
  97.  
  98.       while -idey > 0 do begin
  99.  
  100.          Inc(ie,idey) ;
  101.          Inc(idey,ideyy) ;
  102.          Dec(iy) ;
  103.          Dec(idex,idexy) ;
  104.          iex := ie + idex ;
  105.          if abs(ie) >= abs(iex) then begin
  106.             ie := iex ;
  107.             Dec(idey,ideyx) ;
  108.             Inc(ix) ;
  109.             Inc(idex,idexx)
  110.          end ;
  111.  
  112.          PutPixel(xc+ix,yc-iy,Color) ;
  113.          PutPixel(xc-ix,yc+iy,Color)
  114.  
  115.       end ;
  116.                                { counter clockwise }
  117.       ix := ix0 ;
  118.       iy := iy0 ;
  119.       ie := 0 ;
  120.  
  121.       idex := -idex0 + idexx ;
  122.       idey := -idey0 + ideyy ;
  123.  
  124.       while idex < -idey do begin
  125.  
  126.          Inc(ie,idex) ;
  127.          Inc(idex,idexx) ;
  128.          Dec(ix) ;
  129.          Inc(idey,ideyx) ;
  130.          iey := ie + idey ;
  131.          if abs(ie) >= abs(iey) then begin
  132.             ie := iey ;
  133.             Inc(idey,ideyy) ;
  134.             Dec(iy) ;
  135.             Inc(idex,idexy)
  136.          end ;
  137.  
  138.          PutPixel(xc+ix,yc-iy,Color) ;
  139.          PutPixel(xc-ix,yc+iy,Color)
  140.  
  141.       end ;
  142.  
  143.       while -idey > 0 do begin
  144.  
  145.          Inc(ie,idey) ;
  146.          Inc(idey,ideyy) ;
  147.          Dec(iy) ;
  148.          Inc(idex,idexy) ;
  149.          iex := ie + idex ;
  150.          if abs(ie) >= abs(iex) then begin
  151.             ie := iex ;
  152.             Inc(idex,idexx) ;
  153.             Dec(ix) ;
  154.             Inc(idey,ideyx)
  155.          end ;
  156.  
  157.          PutPixel(xc+ix,yc-iy,Color) ;
  158.          PutPixel(xc-ix,yc+iy,Color)
  159.  
  160.       end
  161.    end
  162. end ;
  163.  
  164. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  165.