home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol131 / readreal.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  8.9 KB  |  239 lines
  1. FUNCTION char2real(inchar : CHAR;VAR out# :REAL):BOOLEAN;
  2. {
  3. Comment : converts a numeric character to its equivalent REAL value.
  4.           If successful returns TRUE , else FALSE.
  5. }
  6. VAR testchar : BOOLEAN;
  7. BEGIN
  8.  testchar  := inchar IN ['0'..'9'];
  9.  IF testchar THEN out# := ORD(inchar) - ORD('0');
  10.  char2real := testchar;
  11. END; { of : function char2real }
  12.  
  13. FUNCTION str2real(VAR inputstr  : str255;
  14.           VAR real#     : REAL) : BOOLEAN;
  15. {
  16. Comment : Parses a string that represents a real number and calculates
  17. the corresponding value.Unlike the Pascal/Z parser it is not upset if
  18. the string contains a period without a preceding zero. As of 9/15/82 I
  19. have not yet incorporated checks to prevent floating input underflow
  20. or overflow.These should be added in the future.
  21. Requires :       FUNCTION  length;
  22.                     "      index;
  23.                     "      char2real;
  24.                  PROCEDURE setlength;
  25. }
  26. VAR
  27.     temp#,mult    : REAL;
  28.     
  29.         p,               { location of decimal point }
  30.         e,               {   "      "  E [for exponential factor]}
  31.     intpart,         {   "      " last CHAR before decimal point }
  32.     dec1st,          {   "      "  1st    "  after decimal point }
  33.     declast,         {   "      "  last   "    "   point but before E }
  34.     explength,     { number of CHARs in exponent including +/- }
  35.     l,i,sig#s    : INTEGER;
  36.  
  37.     negative,good#    : BOOLEAN;
  38.  
  39.     newstr        : str255;
  40.  
  41.         digit        : CHAR;
  42.  
  43. PROCEDURE expone(n : INTEGER); { internal to str2real : used in factoring
  44.                                  in the exponent term.}
  45. VAR
  46.     temp1,
  47.     factor : REAL;
  48. BEGIN
  49.   factor := 1.0;
  50.   good# := good# AND char2real(inputstr[n],temp#);
  51.   IF (good# AND (temp# > 0.0))
  52.   THEN for i := 1 TO TRUNC(temp#) DO factor := factor * ABS(mult);
  53.   IF mult < 0 
  54.      THEN BEGIN
  55.            temp1 := real# / factor;
  56.            temp1 := real# -  (temp1 * factor);
  57.            real# := (real# + temp1)/factor;
  58.           END
  59.      ELSE real# := real# * factor;
  60. END; { of : procedure expone }
  61.  
  62. BEGIN { str2real }
  63.   real#    := 0.0;
  64.   negative := FALSE;
  65.   good#    := TRUE;
  66.   l        := length(inputstr);
  67.   IF inputstr[1] IN ['+','-']    { if a sign character used get the sign
  68.                                    and then snip off the sign character! }
  69.      THEN BEGIN
  70.            negative := (inputstr[1] = '-');
  71.            setlength(newstr,(l - 1));
  72.            FOR i := 1 TO (l - 1) DO newstr[i] := inputstr[i + 1];
  73.            inputstr := newstr;
  74.           END;                   { now there is no + or - }
  75.   l := length(inputstr);
  76.   p := index(inputstr,'.');      { where is the decimal point? }
  77.   e := index(inputstr,'E');
  78.   IF e = 0 THEN e := index(inputstr,'e'); { is there an exponent ? }
  79.   IF p > 0 THEN BEGIN
  80.                  intpart := p - 1;
  81.                  dec1st  := p + 1;
  82.                  IF e > 0 THEN declast := e - 1 ELSE declast := l;
  83.                 END
  84.            ELSE BEGIN
  85.                  IF e > 0 THEN intpart := e - 1 ELSE intpart := l;
  86.                  dec1st  := 0;
  87.                  declast := 0;
  88.                 END;
  89.   FOR i := 1 to l DO { look for any invalid characters in the string }
  90.     BEGIN
  91.      digit := inputstr[i];
  92.      good# := good# AND
  93.                ( (digit IN ['0'..'9']) OR
  94.                  ((digit = '.') AND (i = p)) OR
  95.                  ((digit IN ['E','e']) AND (e > 0) AND (i = e)) OR
  96.                  ((digit IN ['+','-']) AND (e > 0) AND (i = (e + 1)))
  97.                );
  98.     END;
  99.   IF good# THEN { start actual conversion here : IF string is ok! }
  100.    BEGIN
  101.     mult  := 1;
  102.     FOR i := intpart DOWNTO 1 DO
  103.              BEGIN   { calculate the value of the part to the left of period }
  104.               good# := good# AND char2real(inputstr[i],temp#);
  105.               IF good#
  106.                  THEN BEGIN
  107.                       real# := real# + (mult * temp#);
  108.                       mult  := mult * 10;
  109.                       END;
  110.              END;
  111.     mult := 1;
  112.     IF (dec1st + declast) > 0
  113.       THEN BEGIN { Calculate the value of the part to the right of period.
  114.                    Note the recursive call to str2real.}
  115.             setlength(newstr,(declast - dec1st + 5));
  116.             i     := dec1st - 1;
  117.             sig#s := 0;
  118.             REPEAT
  119.              i := i + 1;
  120.              IF (inputstr[i] > '0') or (sig#s > 0)
  121.                 THEN BEGIN
  122.                       sig#s         := sig#s + 1;
  123.                       newstr[sig#s] := inputstr[i];
  124.                      END;
  125.             UNTIL (sig#s > 6) or (i = declast);
  126.             newstr[sig#s + 1] := 'e';
  127.             newstr[sig#s + 2] := '-';
  128.             i := i - dec1st + 1;
  129.             IF i < 10
  130.                THEN BEGIN
  131.                      newstr[sig#s + 3] := CHR(i + ORD('0'));
  132.                      setlength(newstr,(sig#s + 3));
  133.                     END
  134.                ELSE BEGIN
  135.                      newstr[sig#s + 3] := CHR((i DIV 10) + ORD('0'));
  136.                      newstr[sig#s + 4] := CHR((i MOD 10) + ORD('0'));
  137.                      setlength(newstr,(sig#s + 4));
  138.                     END;
  139.             good# := good# AND str2real(newstr,temp#);
  140.             real# := real# + temp#;
  141.            END; { of : calculating in the fractional part }
  142.     IF e = 0 THEN explength := 0 ELSE explength := l - e;
  143.     CASE explength OF        { Last step : factor in the exponent if present }
  144.        0 : BEGIN
  145.            END;              { no exponent.}
  146.        1 : BEGIN             { only 1 char after the e : positive by default }
  147.             mult := 10.0;
  148.             expone(l);
  149.            END;
  150.        2 : BEGIN             { 2 char : signed or unsigned exponent ? }
  151.              IF (inputstr[l - 1] = '-')
  152.                 THEN BEGIN
  153.                       mult := -10.0;
  154.                       expone(l);
  155.                      END
  156.                 ELSE BEGIN
  157.                       mult := 10.0;
  158.                       expone(l);
  159.                       IF inputstr[l-1] <> '+'
  160.                          THEN BEGIN
  161.                                mult := 100;
  162.                                expone(l-1);
  163.                               END;
  164.                      END;
  165.            END; { case explength = 2 }
  166.        3 : BEGIN          { 3 char exponent : 1st MUST be the sign }
  167.              good# := good# AND (inputstr[l - 2] IN ['+','-']);
  168.              IF good#
  169.                 THEN BEGIN
  170.                       IF inputstr[l-2] = '+'
  171.                          THEN mult :=  10.0
  172.                          ELSE mult := -10.0;
  173.                       expone(l);
  174.                       mult := mult * 10.0;
  175.                       expone(l-1);
  176.                      END;
  177.            END; { case explength = 3 }
  178.        ELSE  : good# := FALSE
  179.      END; { of : case list for factoring in the exponent }
  180.     IF negative THEN real# := 0 - real#;
  181.   END; { of : conversion }
  182.   str2real := good#;        
  183. END; { of : function str2real }
  184.  
  185. FUNCTION readreal(VAR realvar : REAL) : BOOLEAN;
  186.  
  187. {
  188.  Comment : Readreal allows a REAL variable to be input from the console 
  189.  in a more forgiving and flexible manner than do  the Pascal/Z standard 
  190.  READ and READLN utilities.It should be noted that the basically lousy
  191.  error checking of Pascal is so because it was not originally conceived
  192.  of as an interactive language.That is it was designed for a batch
  193.  processing system that could not permit runtime correction of input
  194.  errors.That does not,however excuse Ithaca's highly inconsistent methods
  195.  of error trapping.
  196.           Using readreal , the input REAL may have a period as the first 
  197.  or second character,(e.g. .123 , or +.123 , or -.123) or be a null string
  198.  (i.e.'',produced by hitting RETURN).If null ,the variable is set to 0 &
  199.  the return value of the function readreal is FALSE.Otherwise the real is
  200.  set to the input string equivalent and readreal returns TRUE.This allows
  201.  you to set any other default value for a null by checking  ((readreal =
  202.  FALSE) AND (realvar = 0.0)).(Pascal/Z has the  annoying habit of crashing 
  203.  out of your program if you give such inputs to its READ or READLN utility).
  204.  The conversion from STRING input to REAL uses the procedures str2real and
  205.  char2real.
  206.           On detecting invalid characters readreal gives an error message
  207.  and loops,rather than crashing.
  208.          Note that it is readreal that accepts the null string and str2real
  209.  that accepts the period without a preceding zero.
  210.          Hopefully at some time soon ITHACA will polish up the input error
  211.  checking for REALS allowing this function to be eliminated or cut in size.
  212.  
  213.  Requires :                    FUNCTION  length;
  214.                                FUNCTION  index;
  215.                                PROCEDURE setlength;
  216.  
  217. }
  218. VAR
  219.     realstring    : str255;
  220.         done        : BOOLEAN;
  221.  
  222.  
  223. BEGIN { readreal }
  224.  REPEAT
  225.  READLN(realstring);
  226.  IF LENGTH(realstring) = 0
  227.   THEN BEGIN
  228.         realvar  := 0.0;
  229.         readreal := FALSE;
  230.         done     := TRUE;
  231.        END
  232.   ELSE BEGIN
  233.         readreal := TRUE;
  234.         done     := str2real(realstring,realvar);
  235.         IF NOT done THEN WRITELN('error in real input : try again.');
  236.        END; { of : if length = 0 then..else... }
  237.  UNTIL done;
  238. END;   { of : procedure readreal }
  239.