home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / MINCANG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-04  |  2.7 KB  |  104 lines

  1. { Copyright (C) 1988 Adam Fritz, 133 Main St., Afton, NY 13730 }
  2.  
  3. program MinimumCircularAngle (output) ;
  4.  
  5.      { MinCAng - Compute cosine scaled Bxx for sine scaled }
  6.      {           Bxx and list 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.    i : integer ;
  54.    da,dad,sinda,cosda : single ;
  55.    r : longint ;
  56.    isinda,icosda : longint ;
  57.    nisinda,nicosda,nida : integer ;
  58.    sisinda,sicosda : hexstr ;
  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.    isinda := is ;
  69.    r := 0 ;
  70.    repeat
  71.                                 { sine and cosine }
  72.       Dec(isinda) ;
  73.       sinda := isinda / is ;
  74.       cosda := sqrt(1.0 - sqr(sinda)) ;
  75.                                 { cosine scaled Bxx }
  76.       icosda := Round(cosda * is) ;
  77.                                 { count distinct set bits }
  78.       nisinda := nBits(isinda) ;
  79.       if nisinda > ib div 2 then
  80.          nisinda := nisinda - ib ;
  81.       nicosda := nBits(icosda) ;
  82.       if nicosda > ib div 2 then
  83.          nicosda := nicosda - ib ;
  84.       nida := abs(nisinda) + abs(nicosda) ;
  85.                                 { hex strings }
  86.       if nida < 4 then begin
  87.          itoh(sisinda,isinda) ;
  88.          itoh(sicosda,icosda) ;
  89.          if cosda <> 0.0 then
  90.             da := arctan(sinda/cosda)
  91.          else
  92.             da := Pi / 2.0 ;
  93.          r := Round(4.0/sqr(da)) ;
  94.          dad := da / Pi * 180.0 ;
  95.          writeln (output,dad:10:5,' ',r:5,
  96.                   '   ',sisinda,'   ',sicosda,
  97.                   ' ',nisinda:4,' ',nicosda:4,' ',nida:4)
  98.       end
  99.    until (isinda = 512) or (r > 2000)
  100. end.
  101.  
  102. { Copyright (C) 1988 Adam Fritz, 133 Main St., Afton, NY 13730 }
  103.  
  104.