SPACE 2/SPACE - Library 2 - Volume 1.iso/magazi~1/305/stlog.23/nc.pas

Pascal/Delphi Source File | 1988-05-12 | 13.4 KB | 403 lines

{$P-}
{$M+}
{$E+}
PROGRAM Mock;

{$I i:\opus.i}
{$I i:\GCTV.inc}

FUNCTION Do_Alert( alert : Str255 ; def_btn : integer ) : integer ;
  EXTERNAL ;
PROCEDURE Hide_Mouse ;
  EXTERNAL ;
PROCEDURE Show_Mouse ;
  EXTERNAL ;

PROCEDURE REAL_TO_STRING (     real_num    : REAL;
                           VAR string_real : STRING;
                               digits      : INTEGER;
                               sci_not     : BOOLEAN );

(*
   real_num    : real number to be converted into a string
   string_real : working variable that also passes string result to caller
   digits      : specifies # of digits to be displayed right of decimal,
                 valid values are 0-11
   sci_not     : flag which determines whether to express in sci. not. or not
*)

(*
   FORMAT of string returned is:
   sci. not.:
              sign ( - or SPACE ), #.#####... , E, sign ( - or nothing ), ##.
   non-sci. not. :
                  sign ( - or SPACE ), ####.####.
*)

(*
   Round-off errors of the nature x.xxxx9999 are corrected; consequently,
   any number with a sequence of 1 or more terminal 9's
   is affected, even if this is NOT an artifact. This should rarely be a
   problem. Also, if a number is to be expressed in expanded form, the
   magnitude of the exponent plus the # of digits to be displayed can not
   exceed 8, since LONG_ROUND generates long_ints- size < 2e9. This is not
   too severe a problem since only 11 digits of precision are supported
   anyway. That is, specifying 4 digits for the # 100,000,000.9012 is
   meaningless since the number is rounded to 100,000,000.9 as it becomes
   a REAL. The last digits are unavailable to real_to_string. In such
   cases, no action is performed on the number- it emerges untouched by
   the rounding function. Also, note that the detection of 999 occurs after
   conversion to 1 <= mag_num < 10. Thus, 99,999,999,999 becomes 9.9999999999
   which indicates a rounding error.
*)

  LABEL 1;
  VAR   c,i,j    : INTEGER;
        sign_exp : STRING[1];
        loc_char : CHAR;

  PROCEDURE INSERT_COMMAS;
     BEGIN
         dec_pos := POS('.',string_real);
         IF (dec_pos > 5) OR (dec_pos = 0) THEN BEGIN
            IF dec_pos = 0 THEN
               comma_pos := LENGTH(string_real) -2
            ELSE
               comma_pos := dec_pos-3;
            WHILE comma_pos > 2 DO BEGIN
               INSERT(',',string_real,comma_pos);
               comma_pos := comma_pos-3
            END
         END
     END; { INSERT_COMMAS }

  PROCEDURE ADJUST_TO_SPECIFIED_LENGTH;
     (* adjusts appearance following rounding *)
     BEGIN
        dec_pos := POS ( '.',string_real );
        n_digits := dec_pos+digits;
        WHILE LENGTH(string_real) < n_digits DO
                  string_real := CONCAT(string_real,'0');
        WHILE LENGTH(string_real) > n_digits DO
                  DELETE(string_real,LENGTH(string_real),1);
        IF POS('.' , string_real ) = LENGTH(string_real) THEN
           DELETE(string_real,LENGTH(string_real),1)
     END; (* adjust_to_specified_length *)

  PROCEDURE DO_EXPONENT;
     BEGIN
         temp_1 := '';
         IF c >= 30 THEN BEGIN
            temp_1 := '3';
            c := c-30
         END;
         IF c >= 20 THEN BEGIN
            temp_1 := '2';
            c := c-20
         END;
         IF c >= 10 THEN BEGIN
            temp_1 := '1';
            c := c-10
         END;
         temp_1 := CONCAT(temp_1,CHR(c+48));
         adjust_to_specified_length;
         string_real := CONCAT(string_real,'E',sign_exp,temp_1)
     END;

  PROCEDURE REMOVE_9s;
     VAR i , j : INTEGER;
     BEGIN
         (* Get rid of artifactual "999999" generated, if any *)
         temp_1 := COPY(string_real,4,10);
         i := 10;
         found := FALSE;
         WHILE (NOT found) AND (i >= 1) DO
             IF temp_1[i] <> '9' THEN
                found := TRUE
             ELSE
                i := i-1;
         i := i+1;
         IF i <= 10 THEN BEGIN
            FOR j := 1 TO 15 DO
                last[j] := 'f';
            str_len := i+2;
            FOR i := 1 TO str_len DO
                last[i] := string_real[i];
            IF str_len = 3 THEN BEGIN (* x.9999999999 *)
               IF last[2] = '9' THEN BEGIN
                  last[2] := '1';
                  last[4] := '0';
                  IF sign_exp = '' THEN
                     c := c+1
                  ELSE
                     c := c-1
               END
               ELSE BEGIN
                  last[2] := CHR(ORD(last[2])+1);
                  last[4] := '0'
               END
            END
            ELSE (* x.xxxx999999 *)
               (* needn't check here if last[str_len]=9; it CAN'T be,
                  as it would have been a part of the string of 9's *)
               last[str_len] := CHR(ORD(last[str_len])+1);
            string_real := '';
            i := 1;
            WHILE last[i] <> 'f' DO BEGIN (* recreate string_real *)
                string_real := CONCAT(string_real,last[i]);
                i := i+1
            END
         END
     END; (* REMOVE_9s *)

  BEGIN (* REAL_TO_STRING *)
     IF real_num <> 0.0 THEN BEGIN
        (* sign of number *)
        IF real_num < 0.0 THEN
           string_real := '-'
        ELSE
           string_real := ' ';
        IF ((real_num < 1.0) AND (real_num > 0.0))  OR
           ((real_num < 0.0) AND (real_num > -1.0)) THEN
           sign_exp := '-'
        ELSE
           sign_exp := '';
        (* got sign, so work with number magnitude *)
        mag_num := ABS (real_num);
        (* c counts the number of times the number can be multiplied or div-
           ided by 10 so that finally 1 <= number < 10 *)
        c := 0;
        (* make 1 <= number < 10 *)
        IF mag_num >= 10.0 THEN
           REPEAT
               mag_num := mag_num/10.0;
               c := c+1
           UNTIL mag_num < 10.0
        ELSE IF mag_num < 1.0 THEN
           REPEAT
               mag_num := mag_num*10.0;
               c := c+1
           UNTIL mag_num >= 1.0;

        (* Round mag_num to specified # of digits *)

        IF (sci_not) AND (digits <= 8) THEN
            mag_num := LONG_ROUND(mag_num*PwrOfTen(digits))/PwrOfTen(digits);
        IF NOT sci_not THEN BEGIN (* Round to spec # digit if possible *)
           IF (c+digits <= 8) AND ((real_num > 1) OR (real_num < -1)) THEN
              mag_num := LONG_ROUND(mag_num*PwrOfTen(c+digits)) /
                                       PwrOfTen(c+digits);
           (* bug fix- account for numbers between -1.0 and 1.0 *)
           i := digits-c;
           IF (real_num < 1) AND (real_num > -1) THEN BEGIN
              IF ABS(i) <= 8 THEN BEGIN
                 IF i >= 0 THEN
                    mag_num := LONG_ROUND(mag_num*PwrOfTen(i))/PwrOfTen(i)
                 ELSE
                    mag_num := LONG_ROUND(mag_num/PwrOfTen(ABS(i)))*
                                             PwrOfTen(ABS(i))
              END
           END
        END;
        IF mag_num = 0 THEN BEGIN
           string_real := ' 0';
           GOTO 1
        END;
        IF mag_num >= 10 THEN BEGIN (* rounded up to 10 *)
           IF sign_exp = '-' THEN BEGIN
              c := c-1;
              IF c = 0 THEN
                 sign_exp := '';
           END
           ELSE
              c := c+1;
           mag_num := 1
        END;

        (* reals have 11 digits of precision   *)
        (* convert REAL to a string equivalent *)

        FOR i := 1 TO 11 DO BEGIN
            j := TRUNC (mag_num);
            string_real := CONCAT(string_real,CHR (j+48));
            mag_num := (mag_num-j)*10
        END; (* FOR i  *)
        INSERT('.',string_real,3);

        remove_9s;

        { now have the mantissa converted in string_real, so... }

        IF NOT sci_not THEN BEGIN
           (* express in expanded form *)
           IF sign_exp = '-' THEN BEGIN   (* mag_num < 1, mag_num <> 0 *)
              loc_char := string_real[2];
              DELETE(string_real,2,1);
              INSERT('0',string_real,2);
              INSERT(loc_char,string_real,4);
              FOR i := 1 TO c-1 DO
                  INSERT('0',string_real,4);
              adjust_to_specified_length
           END
           ELSE BEGIN
              DELETE(string_real,3,1);
              IF 3+c > LENGTH(string_real) THEN
                 FOR i := LENGTH(string_real) TO 2+c DO
                     string_real := CONCAT(string_real,'0');
              INSERT('.',string_real,3+c);
              adjust_to_specified_length;
              insert_commas
           END
        END
        ELSE
           do_exponent;
     END (* begin of first then clause *)
     ELSE (* real_num = 0 *)
        string_real := ' 0';
1:  END; (* REAL_TO_STRING *)



FUNCTION STRING_TO_REAL ( VAR str : STR30 ) : REAL;

(*
   Strings passed must follow the following rules:
        1. may have been created by REAL_TO_STRING,
        2. may have been entered via READ or WINDOW_INPUT
           a. Strings entered via WINDOW_INPUT may contain NO imbedded spaces,
              and if given in sci. not. must use either 'e' or 'E' .
        3. overflows are trapped, STRING_TO_REAL returns 0 and string_real
           returns 'OVERFLOW'; otherwise string_real is preserved intact
        4. must be an exact image of a valid real! VALID_NUMBER screens out
           all miswritten numbers, i.e 1.22.4-e0-4
        5. must have at least one digit preceding a decimal
        6. doesn't check for spaces because the routines that call it either
           eat up the spaces or don't allow them
        7. doesn't check for a null string since one is never passed
*)

  LABEL 1;

  BEGIN
     loverflow := FALSE;
     sign_num := 1;
     sign_exp := 1;
     lpower := 1;
     real_num := 0;
     exp_val := 0;
     lfactor := 0;
     str_pos := 1;
     str_len := LENGTH(str);
     IF (str[1] = '+') OR (str[1] = '-') OR (str[1] = ' ') THEN BEGIN
        IF str[1] = '-' THEN
           sign_num := -1;
        str_pos := 2
     END;
     lquit := FALSE;
     WHILE (str_pos <= str_len) AND (NOT lquit) DO
        IF str[str_pos] IN digits THEN BEGIN
           real_num := real_num*10+ORD(str[str_pos])-ORD('0');
           str_pos := str_pos+1
        END
        ELSE
           lquit := TRUE;
     IF str_pos <= str_len THEN
        IF str[str_pos] = '.' THEN BEGIN
           places := 0;
           str_pos := str_pos+1;
           lquit := FALSE;
           WHILE (str_pos <= str_len) AND (NOT lquit) DO
              IF str[str_pos] IN digits THEN BEGIN
                 places := places+1;
                 real_num := real_num*10+ORD(str[str_pos])-ORD('0');
                 str_pos := str_pos+1
              END
              ELSE
                 lquit := TRUE;
           real_num := real_num/PwrOfTen(places)
        END;
     IF str_pos <= str_len THEN
        IF (str[str_pos] = 'E') OR (str[str_pos] = 'e') THEN BEGIN
           str_pos := str_pos+1;
           IF str_pos <= str_len THEN BEGIN
              IF (str[str_pos] = '+') OR (str[str_pos] = '-') THEN BEGIN
                 IF str[str_pos] = '-' THEN
                    sign_exp := -1;
                 str_pos := str_pos+1
              END;
              lquit := FALSE;
              WHILE (str_pos <= str_len) AND (NOT lquit) DO
                 IF str[str_pos] IN digits THEN BEGIN
                    exp_val := exp_val*10+ORD(str[str_pos])-ORD('0');
                    str_pos := str_pos+1
                 END
                 ELSE
                    lquit := TRUE;
              IF exp_val > 38 THEN BEGIN
                 loverflow := TRUE;
                 GOTO 1
              END;
              lpower := PwrOfTen(exp_val);
              IF sign_exp < 0 THEN
                 lpower := 1/lpower
           END
        END;

     (* Check for potential overflow *)

     mag_num := real_num;

     IF mag_num <> 0 THEN
        IF mag_num >= 10 THEN
           REPEAT
               mag_num := mag_num/10.0;
               lfactor := lfactor+1
           UNTIL mag_num < 10.0
        ELSE IF mag_num < 1.0 THEN
           REPEAT
               mag_num := mag_num*10.0;
               lfactor := lfactor-1
           UNTIL mag_num >= 1.0;

1:   IF (ABS(exp_val*sign_exp+lfactor) >= 37) OR (loverflow) THEN BEGIN
        alert := Do_Alert(float_over,1);
        str := 'OVERFLOW';
        string_to_real := 0
     END
     ELSE
        string_to_real := real_num*sign_num*lpower

  END; (* STRING_TO_REAL *)


PROCEDURE INT_TO_STRING ( n : INTEGER; VAR s : STR10 );
   { for non_negative integers }
   VAR
      digit,divisor   : INTEGER;
      leading         : BOOLEAN;
   BEGIN { INT_TO_STRING }
       IF n <= 0 THEN
          s := '0'
       ELSE BEGIN
          s := '';
          divisor := 10000;
          leading := TRUE;
          WHILE divisor > 0 DO BEGIN
             digit := n DIV divisor;
             IF (digit <> 0) OR (NOT leading) THEN BEGIN
                s := CONCAT(s,CHR(digit+48));
                leading := FALSE
             END;
             n := n MOD divisor;
             divisor := divisor DIV 10
          END
       END
   END; { INT_TO_STRING }

BEGIN  (* dummy program for modular compilation *)
END.