home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / ELIPMB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-20  |  2.6 KB  |  91 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.      { ElipMB - Modified Bresenham ellipse algorithm }
  8.  
  9. var
  10.    Color            : word ;    { default color }
  11.    px,py            : single ;  { coordinate aspect variables }
  12.    pxx,pyy          : single ;  { coordinate offset increments }
  13.    ix,iy            : integer ; { display coordinates }
  14.    idex,idey        : longint ; { error offset counters }
  15.    idexx,ideyy      : longint ; { error offset increments }
  16.    ie,iex,iey       : longint ; { error variables }
  17.  
  18. begin
  19.  
  20.    if (a > 0) and (b > 0) then begin
  21.  
  22.       Color := GetColor ;
  23.                                 { initialize assuming 3/2 aspect }
  24.       px := 3 * GetMaxY ;
  25.       py := 2 * GetMaxX ;
  26.                                 { scaling parameters }
  27.       if px > py then begin
  28.          py := py / px ;
  29.          px := 1.0
  30.       end
  31.       else begin
  32.          px := px / py ;
  33.          py := 1.0
  34.       end ;
  35.  
  36.       pxx := sqr(b*px) ;
  37.       pyy := sqr(a*py) ;
  38.                                 { starting point and error }
  39.       ix := 0 ;
  40.       idex := Round(pxx) ;
  41.       idexx := Round(2*pxx) ;
  42.       iy := Round(b * px / py) ;
  43.       idey := -Round((2*iy-1) * pyy) ;
  44.       ideyy := Round(2*pyy) ;
  45.       ie := 0 ;
  46.                                 { diameter points }
  47.       PutPixel(xc,yc+iy,Color) ;
  48.       PutPixel(xc,yc-iy,Color) ;
  49.                                { octant points - 2,3,6,7 }
  50.       while idex < -idey do begin
  51.  
  52.          Inc(ie,idex) ;
  53.          Inc(idex,idexx) ;
  54.          Inc(ix) ;
  55.          iey := ie + idey ;
  56.          if abs(ie) >= abs(iey) then begin
  57.             ie := iey ;
  58.             Inc(idey,ideyy) ;
  59.             Dec(iy)
  60.          end ;
  61.  
  62.          PutPixel(xc+ix,yc+iy,Color) ;
  63.          PutPixel(xc+ix,yc-iy,Color) ;
  64.          PutPixel(xc-ix,yc+iy,Color) ;
  65.          PutPixel(xc-ix,yc-iy,Color)
  66.  
  67.       end ;
  68.                                 { octant points - 1,4,5,8 }
  69.       while -idey > 0 do begin
  70.  
  71.          Inc(ie,idey) ;
  72.          Inc(idey,ideyy) ;
  73.          Dec(iy) ;
  74.          iex := ie + idex ;
  75.          if abs(ie) >= abs(iex) then begin
  76.             ie := iex ;
  77.             Inc(idex,idexx) ;
  78.             Inc(ix)
  79.          end ;
  80.  
  81.          PutPixel(xc+ix,yc+iy,Color) ;
  82.          PutPixel(xc+ix,yc-iy,Color) ;
  83.          PutPixel(xc-ix,yc+iy,Color) ;
  84.          PutPixel(xc-ix,yc-iy,Color)
  85.  
  86.       end
  87.    end
  88. end ;
  89.  
  90. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  91.