home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / CIRCDAS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-20  |  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.      { CircDAS - draw circular point constellation using   }
  6.      {           difference angle method and `strange'     }
  7.      {           angle step                                }
  8.  
  9. const
  10.    icosda : longint = $2000 ;
  11.    isinda : longint = $7BEF ;
  12.  
  13. var
  14.    Color            : word ;    { default color }
  15.    ir               : longint ; { offset radius B6 }
  16.    ixar,iyar        : word ;    { aspect ratio parameters }
  17.    iar              : longint ; { aspect ratio B16 }
  18.    ida              : integer ; { loop control }
  19.    ixa0,ixa1,ixa2   : longint ; { coordinate variables B22 }
  20.    iya0,iya1,iya2   : longint ; { coordinate variables B22 }
  21.  
  22. begin
  23.                                 { constraint test }
  24.    if r < 512 then begin
  25.                                 { aspect ratio }
  26.       Color := GetColor ;
  27.       GetAspectRatio(ixar,iyar) ;
  28.       iar := SwapLong(longint(ixar)) div longint(iyar) ;
  29.                                 { offset, prescale, aspect, }
  30.                                 { and reflect               }
  31.       ir := r shl 6 + idr ;
  32.       ixa2 := ir * icosda shl 1 ;
  33.       ixa1 := SwapLong(ir) ;
  34.       iya2 := -LongHi(ir * isinda shl 1) * iar ;
  35.       iya1 := 0 ;
  36.                                 { circle }
  37.       for ida := 1 to r do begin
  38.                                 { step coordinates }
  39.          ixa0 := ixa1 div 2 - ixa2 ;
  40.          iya0 := iya1 div 2 - iya2 ;
  41.                                 { show pixel }
  42.          PutPixel(xc+RoundScaleB6(LongHi(ixa0)),
  43.                   yc+RoundScaleB6(LongHi(iya0)),Color) ;
  44.                                 { ladder down }
  45.          ixa2 := ixa1 ;  iya2 := iya1 ;
  46.          ixa1 := ixa0 ;  iya1 := iya0
  47.  
  48.       end
  49.    end
  50. end ;
  51.  
  52. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  53.