home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / INCCOS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-04  |  3.0 KB  |  116 lines
  1. { Copyright (C) 1988 Adam Fritz, 133 Main St., Afton, NY 13730 }
  2.  
  3. program IncrementalCosine (output) ;
  4.  
  5.      { IncCos - computes 2 * cos for angles 360/n scaled   }
  6.      {          Bxx and lists those for which number of    }
  7.      {          distinct bits are two or fewer.            }
  8.  
  9. type
  10.    hexstr = string[9] ;
  11.  
  12. {~~~~~~~~~~~~~~~~~~~~ count set bits ~~~~~~~~~~~~~~~~~~~~~~}
  13.  
  14. function nBits ( n : longint ) : integer ;
  15. var
  16.    iBits : integer ;
  17. begin
  18.    iBits := 0 ;
  19.    while n <> 0 do begin
  20.       if Odd(n) then
  21.          Inc(iBits) ;
  22.       n := n shr 1
  23.    end ;
  24.    nBits := iBits
  25. end ;
  26.  
  27. {~~~~~~~~~~~~~ convert integer to hex string ~~~~~~~~~~~~~~}
  28.  
  29. procedure itoh ( var sn : hexstr ; n : longint ) ;
  30. const
  31.    hexchr : array[0..15] of char = ('0','1','2','3','4','5','6','7',
  32.                                     '8','9','A','B','C','D','E','F') ;
  33. var
  34.    lsn : hexstr ;
  35.    ih,nh : integer ;
  36. begin
  37.    lsn := '' ;
  38.    if abs(n) < 65536 then
  39.       nh := 4
  40.    else
  41.       nh := 8 ;
  42.    for ih := 1 to nh do begin
  43.       lsn := hexchr[n and $000F] + lsn ;
  44.       n := n shr 4
  45.    end ;
  46.    sn := '$' + lsn
  47. end ;
  48.  
  49. {~~~~~~~~~~~~~~~~~~~~~ main program ~~~~~~~~~~~~~~~~~~~~~~~}
  50.  
  51. var
  52.    ib : integer ;
  53.    is : longint ;
  54.    n : integer ;
  55.    pit2 : single ;
  56.  
  57.    da,dad,cosda,sinda : single ;
  58.    icosda,i2cosda : longint ;
  59.    ni2cosda,nida : integer ;
  60.    sicosda,si2cosda : hexstr ;
  61.  
  62.    ada,adad,cosada,sinada : single ;
  63.    isinada : longint ;
  64.    sisinada : hexstr ;
  65.  
  66.    r : longint ;
  67.  
  68. begin
  69.    pit2 := 2.0 * Pi ;
  70.                                 { get scale }
  71.    repeat
  72.       write ('Scale: ') ;
  73.       readln (ib)
  74.    until (ib >= 0) and (ib < 31) ;
  75.    is := longint(1) shl ib ;
  76.  
  77.    n := 4 ;
  78.    r := 0 ;
  79.    repeat
  80.                                 { incremental angle }
  81.       Inc(n) ;
  82.       da := pit2 / n ;
  83.       cosda := cos(da) ;
  84.                                 { scale Bxx }
  85.       icosda := Round(cosda * is) ;
  86.       i2cosda := Round(2.0 * cosda * is) ;
  87.                                 { count distinct bits }
  88.       ni2cosda := nBits(i2cosda) ;
  89.       if ni2cosda > ib div 2 then
  90.          ni2cosda := ni2cosda - ib - 1 ;
  91.       nida := abs(ni2cosda) ;
  92.                                 { hex strings }
  93.       if nida < 2 then begin
  94.          itoh(sicosda,icosda) ;
  95.          itoh(si2cosda,i2cosda) ;
  96.          dad := da * 180.0 / Pi ;
  97.          cosada := icosda / is ;
  98.          sinada := sqrt(1.0-sqr(cosada)) ;
  99.          if cosada > 0.0 then
  100.             ada := arctan(sinada/cosada)
  101.          else
  102.             ada := Pi / 2 ;
  103.          adad := ada * 180.0 / Pi ;
  104.          r := Round(4.0/sqr(ada)) ;
  105.          isinada := Round(sinada * is) ;
  106.          itoh(sisinada,isinada) ;
  107.          writeln (output,n:4,' ',dad:10:5,
  108.                   '   ',sisinada,'   ',sicosda,'   ',si2cosda,
  109.                   ' ',adad:10:5,' ',r:5,
  110.                   ' ',ni2cosda:4,' ',nida:4)
  111.       end
  112.    until (n = 512) or (r > 2000)
  113. end.
  114.  
  115. { Copyright (C) 1988 Adam Fritz, 133 Main St., Afton, NY 13730 }
  116.