home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / LEAKCRAF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-20  |  3.4 KB  |  106 lines
  1. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  2.  
  3. program StrokeCircleClosureDemo (output) ;
  4.  
  5.      {    LeakCRAF - determine whether stroke circle       }
  6.      {               routine using rotation angle method   }
  7.      {               and fixed point arithmetic closes     }
  8.  
  9. uses GRAPH ;
  10.  
  11. {$I conic.pas }
  12.  
  13. var
  14.      nLeak          : integer ; { number of leaks }
  15.      nOverflow      : integer ; { number of overflows }
  16.  
  17. {**********************************************************}
  18.  
  19. procedure StrokeCircle ( xc, yc : integer ; r : word ) ;
  20.  
  21.      { CircRAF - draw circle using rotation angle method   }
  22.      {           and floating point arithmetic             }
  23.  
  24. var
  25.    ixar,iyar        : word ;    { aspect ratio parameters }
  26.    iar              : longint ; { aspect ratio B16 }
  27.    da               : single ;  { step angle }
  28.    icosda,isinda    : longint ; { step angle functions B16 }
  29.    ida,nda,ndad4    : integer ; { loop control }
  30.    it,ix,iy         : longint ; { coordinate variables B6 }
  31.    ix0,iy0,ix1,iy1 : integer ; { display variables }
  32.  
  33. begin
  34.                                 { constraint test }
  35.    if r < 512 then begin
  36.                                 { aspect ratio }
  37.       GetAspectRatio(ixar,iyar) ;
  38.       iar := SwapLong(longint(ixar)) div longint(iyar) ;
  39.                                 { step angle and functions }
  40.       da := 2.0 * sqrt(1.0/r) ;
  41.       nda := Round(2.0 * Pi / da) ;
  42.       if Odd(nda) then Inc(nda) ;
  43.       da := 2.0 * Pi / nda ;
  44.       icosda := Round(cos(da) * 65536) ;
  45.       isinda := Round(sin(da) * 65536) ;
  46.                                 { starting point with offset }
  47.       ix := r shl 6 + idr ;
  48.       iy := 0 ;
  49.       ix0 := RoundScaleB6(ix) ;
  50.       iy0 := 0 ;
  51.                                 { circle }
  52.       for ida := 1 to nda do begin
  53.                                 { rotate coordinates }
  54.          it := RoundScaleB16(ix * icosda - iy * isinda) ;
  55.          iy := RoundScaleB16(ix * isinda + iy * icosda) ;
  56.          ix := it ;
  57.                                 { aspect ratio }
  58.          ix1 := RoundScaleB6(ix) ;
  59.          iy1 := RoundScaleB6(LongHi(iy * iar)) ;
  60.  
  61.       end
  62.    end ;
  63.                                 { report closure }
  64.    if (abs(ix0-ix1) > 1) or (abs(iy0-iy1) > 1) then begin
  65.       if (ix1 < 0) or (iy1 < 0) then
  66.          Inc(nOverflow)
  67.       else
  68.          Inc(nLeak) ;
  69.       writeln (output,r:5,' ',nda:5,' ',ix1:5,' ',iy1:5) ;
  70.    end
  71.  
  72. end ;
  73.  
  74. {********************* main program ***********************}
  75.  
  76. var
  77.    grDriver,grMode  : integer ;  { graphics mode control }
  78.    r                : integer ;  { circle radius }
  79.    xc, yc           : integer ;  { circle center }
  80.    i                : integer ;  { loop control }
  81.  
  82. begin
  83.  
  84.    grDriver := Detect ;
  85.    InitGraph(grDriver,grMode,'') ;
  86.    CloseGraph ;
  87.                                 { center of display }
  88.    xc := (GetMaxX + 1) div 2 ;
  89.    yc := (GetMaxY + 1) div 2 ;
  90.                                 { offset survey }
  91.    for i := 8 to 24 do begin
  92.       idr := 2*i ;
  93.       dr := idr/64 ;
  94.       nLeak := 0 ;
  95.       nOverflow := 0 ;
  96.                                 { radius survey }
  97.       for r := 500 to 511 do
  98.          StrokeCircle(xc,yc,r) ;
  99.                                 { report closure and overflow problems }
  100.       writeln (output,idr:5,'   ',dr:5:2,' ',nLeak:5,' ',nOverflow:5)
  101.    end
  102.  
  103. end.
  104.  
  105. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  106.