home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / pascal / passrc / int.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  2.4 KB  |  96 lines
  1. { -----------------------------------------------------------------------------
  2.  
  3.                                  NOTICE:
  4.  
  5.       THESE MATERIALS are UNSUPPORTED by OSS!  If you do not understand how to
  6.       use them do not contact OSS for help!  We will not teach you how to 
  7.       program in Pascal.  If you find an error in these materials, feel free
  8.       to SEND US A LETTER explaining the error, and how to fix it.
  9.  
  10.       THE BOTTOM LINE:
  11.  
  12.          Use it, enjoy it, but you are on your own when using these materials!
  13.  
  14.  
  15.                                DISCLAIMER:
  16.  
  17.       OSS makes no representations or warranties with respect to the contents
  18.       hereof and specifically disclaim all warranties of merchantability or
  19.       fitness for any particular purpose.   This document is subject to change
  20.       without notice.
  21.       
  22.       OSS provides these materials for use with Personal Pascal.  Use them in
  23.       any way you wish.
  24.  
  25.    -------------------------------------------------------------------------- }
  26.  
  27.  
  28. PROGRAM int;
  29.  
  30.   VAR
  31.     r: real;
  32.  
  33.   FUNCTION rtrunc( n: real ): real;
  34.  
  35.     TYPE
  36.       funny = RECORD
  37.                 CASE boolean OF
  38.                   true: ( r: real );
  39.                   false: ( b: PACKED ARRAY[ 0..5 ] OF byte );
  40.               END;
  41.  
  42.     VAR
  43.       temp: funny;
  44.       exp: integer;     { Exponent byte }
  45.       last: 0..4;
  46.  
  47.     BEGIN
  48.       temp.r := n;
  49.       exp := temp.b[5] - $80;
  50.       IF exp <= 0 THEN
  51.         rtrunc := 0
  52.       ELSE IF exp >= 40 THEN
  53.         rtrunc := temp.r
  54.       ELSE
  55.         BEGIN
  56.           last := exp DIV 8;
  57.           temp.b[last] := temp.b[last] & shl( $FF, 8-(exp MOD 8));
  58.           WHILE last < 4 DO
  59.             BEGIN
  60.               last := last + 1;
  61.               temp.b[last] := 0;
  62.             END;
  63.           rtrunc := temp.r;
  64.         END;
  65.     END;
  66.  
  67.   FUNCTION rint( n: real ): real;
  68.  
  69.     VAR
  70.       temp: real;
  71.  
  72.     BEGIN
  73.       temp := rtrunc( n );
  74.       IF (temp <> n) AND (n < 0) THEN
  75.         temp := temp-1;
  76.       rint := temp;
  77.     END;
  78.  
  79.   FUNCTION rround( n: real ): real;
  80.  
  81.     BEGIN
  82.       IF n >= 0 THEN
  83.         rround := rtrunc( n+0.5 )
  84.       ELSE
  85.         rround := rtrunc( n-0.5 )
  86.     END;
  87.  
  88.   BEGIN
  89.     WHILE true DO
  90.       BEGIN
  91.         write( '>>' );
  92.         readln( r );
  93.         writeln( 'int(', r, ') = ', rint(r), rtrunc(r), rround(r) );
  94.       END;
  95.   END.
  96.