home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / CIRCRAIR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-19  |  1.9 KB  |  53 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.      { CircRAIR - draw circle using rotation angle method, }
  6.      {            `increment' angle step, fraction machine }
  7.      {            scaling, and semi-circular symmetry      }
  8.  
  9. var
  10.    ixar,iyar        : word ;    { aspect ratio parameters }
  11.    iar              : longint ; { aspect ratio B16 }
  12.    ida              : integer ; { loop control }
  13.    it,ix,iy         : longint ; { coordinate variables B22 }
  14.    ix0,iy0,ix1,iy1,ix2,iy2 : integer ; { display coordinates B0 }
  15.  
  16. begin
  17.                                 { constraint test }
  18.    if r < 512 then begin
  19.                                 { aspect ratio }
  20.       GetAspectRatio(ixar,iyar) ;
  21.       iar := SwapLong(longint(ixar)) div longint(iyar) ;
  22.                                 { prescale }
  23.       ix := SwapLong(r shl 6 + idr) ;
  24.       iy := 0 ;
  25.                                 { starting point }
  26.       ix0 := RoundScaleB6(LongHi(ix)) ;
  27.       iy0 := 0 ;
  28.       ix1 := ix0 ;
  29.       iy1 := iy0 ;
  30.                                 { circle }
  31.       for ida := 1 to 24 do begin
  32.                                 { rotate coordinates }
  33.          it := (((-iy div 4 - iy) div 32 - ix) div 16 - iy) div 8 + ix ;
  34.          iy := ((( ix div 4 + ix) div 32 - iy) div 16 + ix) div 8 + iy ;
  35.          ix := it ;
  36.                                 { semi-circular symmetry }
  37.          ix2 := RoundScaleB6(LongHi(ix)) ;
  38.          iy2 := RoundScaleB6(LongHi(LongHi(iy) * iar)) ;
  39.          Line(xc+ix1,yc+iy1,xc+ix2,yc+iy2) ;
  40.          Line(xc-ix1,yc-iy1,xc-ix2,yc-iy2) ;
  41.                                 { ladder down }
  42.          ix1 := ix2 ;  iy1 := iy2
  43.  
  44.       end ;
  45.                                 { closure }
  46.       Line(xc+ix2,yc+iy2,xc-ix0,yc-iy0) ;
  47.       Line(xc-ix2,yc-iy2,xc+ix0,yc+iy0)
  48.  
  49.    end
  50. end ;
  51.  
  52. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  53.