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