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