home *** CD-ROM | disk | FTP | other *** search
- { Copyright (C) 1988 Adam Fritz, 133 Main St., Afton, NY 13730 }
-
- program MinimumCircularAngle (output) ;
-
- { MinCAng - Compute cosine scaled Bxx for sine scaled }
- { Bxx and list distinct set bit counts. }
-
- type
- hexstr = string[9] ;
-
- {~~~~~~~~~~~~~~~~~~~~ count set bits ~~~~~~~~~~~~~~~~~~~~~~}
-
- function nBits ( n : longint ) : integer ;
- var
- iBits : integer ;
- begin
- iBits := 0 ;
- while n <> 0 do begin
- if Odd(n) then
- Inc(iBits) ;
- n := n shr 1
- end ;
- nBits := iBits
- end ;
-
- {~~~~~~~~~~~ convert integer to hex string ~~~~~~~~~~~~~~~~}
-
- procedure itoh ( var sn : hexstr ; n : longint ) ;
- const
- hexchr : array[0..15] of char = ('0','1','2','3','4','5','6','7',
- '8','9','A','B','C','D','E','F') ;
- var
- lsn : hexstr ;
- ih,nh : integer ;
- begin
- lsn := '' ;
- if abs(n) < 65536 then
- nh := 4
- else
- nh := 8 ;
- for ih := 1 to nh do begin
- lsn := hexchr[n and $000F] + lsn ;
- n := n shr 4
- end ;
- sn := '$' + lsn
- end ;
-
- {~~~~~~~~~~~~~~~~~~~~~ main program ~~~~~~~~~~~~~~~~~~~~~~~}
-
- var
- ib : integer ;
- is : longint ;
- i : integer ;
- da,dad,sinda,cosda : single ;
- r : longint ;
- isinda,icosda : longint ;
- nisinda,nicosda,nida : integer ;
- sisinda,sicosda : hexstr ;
-
- begin
- { get scale }
- repeat
- write ('Scale: ') ;
- readln (ib)
- until (ib > 0) and (ib < 31) ;
- is := longint(1) shl ib ;
-
- isinda := is ;
- r := 0 ;
- repeat
- { sine and cosine }
- Dec(isinda) ;
- sinda := isinda / is ;
- cosda := sqrt(1.0 - sqr(sinda)) ;
- { cosine scaled Bxx }
- icosda := Round(cosda * is) ;
- { count distinct set bits }
- nisinda := nBits(isinda) ;
- if nisinda > ib div 2 then
- nisinda := nisinda - ib ;
- nicosda := nBits(icosda) ;
- if nicosda > ib div 2 then
- nicosda := nicosda - ib ;
- nida := abs(nisinda) + abs(nicosda) ;
- { hex strings }
- if nida < 4 then begin
- itoh(sisinda,isinda) ;
- itoh(sicosda,icosda) ;
- if cosda <> 0.0 then
- da := arctan(sinda/cosda)
- else
- da := Pi / 2.0 ;
- r := Round(4.0/sqr(da)) ;
- dad := da / Pi * 180.0 ;
- writeln (output,dad:10:5,' ',r:5,
- ' ',sisinda,' ',sicosda,
- ' ',nisinda:4,' ',nicosda:4,' ',nida:4)
- end
- until (isinda = 512) or (r > 2000)
- end.
-
- { Copyright (C) 1988 Adam Fritz, 133 Main St., Afton, NY 13730 }
-