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