home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / apps / spread / opusprg / opussrc / nc.pas < prev    next >
Pascal/Delphi Source File  |  1988-05-12  |  14KB  |  403 lines
  1.  
  2.  
  3. {$P-}
  4. {$M+}
  5. {$E+}
  6. PROGRAM Mock;
  7.  
  8. {$I i:\opus.i}
  9. {$I i:\GCTV.inc}
  10.  
  11. FUNCTION Do_Alert( alert : Str255 ; def_btn : integer ) : integer ;
  12.   EXTERNAL ;
  13. PROCEDURE Hide_Mouse ;
  14.   EXTERNAL ;
  15. PROCEDURE Show_Mouse ;
  16.   EXTERNAL ;
  17.  
  18. PROCEDURE REAL_TO_STRING (     real_num    : REAL;
  19.                            VAR string_real : STRING;
  20.                                digits      : INTEGER;
  21.                                sci_not     : BOOLEAN );
  22.  
  23. (*
  24.    real_num    : real number to be converted into a string
  25.    string_real : working variable that also passes string result to caller
  26.    digits      : specifies # of digits to be displayed right of decimal,
  27.                  valid values are 0-11
  28.    sci_not     : flag which determines whether to express in sci. not. or not
  29. *)
  30.  
  31. (*
  32.    FORMAT of string returned is:
  33.    sci. not.:
  34.               sign ( - or SPACE ), #.#####... , E, sign ( - or nothing ), ##.
  35.    non-sci. not. :
  36.                   sign ( - or SPACE ), ####.####.
  37. *)
  38.  
  39. (*
  40.    Round-off errors of the nature x.xxxx9999 are corrected; consequently,
  41.    any number with a sequence of 1 or more terminal 9's
  42.    is affected, even if this is NOT an artifact. This should rarely be a
  43.    problem. Also, if a number is to be expressed in expanded form, the
  44.    magnitude of the exponent plus the # of digits to be displayed can not
  45.    exceed 8, since LONG_ROUND generates long_ints- size < 2e9. This is not
  46.    too severe a problem since only 11 digits of precision are supported
  47.    anyway. That is, specifying 4 digits for the # 100,000,000.9012 is
  48.    meaningless since the number is rounded to 100,000,000.9 as it becomes
  49.    a REAL. The last digits are unavailable to real_to_string. In such
  50.    cases, no action is performed on the number- it emerges untouched by
  51.    the rounding function. Also, note that the detection of 999 occurs after
  52.    conversion to 1 <= mag_num < 10. Thus, 99,999,999,999 becomes 9.9999999999
  53.    which indicates a rounding error.
  54. *)
  55.  
  56.   LABEL 1;
  57.   VAR   c,i,j    : INTEGER;
  58.         sign_exp : STRING[1];
  59.         loc_char : CHAR;
  60.  
  61.   PROCEDURE INSERT_COMMAS;
  62.      BEGIN
  63.          dec_pos := POS('.',string_real);
  64.          IF (dec_pos > 5) OR (dec_pos = 0) THEN BEGIN
  65.             IF dec_pos = 0 THEN
  66.                comma_pos := LENGTH(string_real) -2
  67.             ELSE
  68.                comma_pos := dec_pos-3;
  69.             WHILE comma_pos > 2 DO BEGIN
  70.                INSERT(',',string_real,comma_pos);
  71.                comma_pos := comma_pos-3
  72.             END
  73.          END
  74.      END; { INSERT_COMMAS }
  75.  
  76.   PROCEDURE ADJUST_TO_SPECIFIED_LENGTH;
  77.      (* adjusts appearance following rounding *)
  78.      BEGIN
  79.         dec_pos := POS ( '.',string_real );
  80.         n_digits := dec_pos+digits;
  81.         WHILE LENGTH(string_real) < n_digits DO
  82.                   string_real := CONCAT(string_real,'0');
  83.         WHILE LENGTH(string_real) > n_digits DO
  84.                   DELETE(string_real,LENGTH(string_real),1);
  85.         IF POS('.' , string_real ) = LENGTH(string_real) THEN
  86.            DELETE(string_real,LENGTH(string_real),1)
  87.      END; (* adjust_to_specified_length *)
  88.  
  89.   PROCEDURE DO_EXPONENT;
  90.      BEGIN
  91.          temp_1 := '';
  92.          IF c >= 30 THEN BEGIN
  93.             temp_1 := '3';
  94.             c := c-30
  95.          END;
  96.          IF c >= 20 THEN BEGIN
  97.             temp_1 := '2';
  98.             c := c-20
  99.          END;
  100.          IF c >= 10 THEN BEGIN
  101.             temp_1 := '1';
  102.             c := c-10
  103.          END;
  104.          temp_1 := CONCAT(temp_1,CHR(c+48));
  105.          adjust_to_specified_length;
  106.          string_real := CONCAT(string_real,'E',sign_exp,temp_1)
  107.      END;
  108.  
  109.   PROCEDURE REMOVE_9s;
  110.      VAR i , j : INTEGER;
  111.      BEGIN
  112.          (* Get rid of artifactual "999999" generated, if any *)
  113.          temp_1 := COPY(string_real,4,10);
  114.          i := 10;
  115.          found := FALSE;
  116.          WHILE (NOT found) AND (i >= 1) DO
  117.              IF temp_1[i] <> '9' THEN
  118.                 found := TRUE
  119.              ELSE
  120.                 i := i-1;
  121.          i := i+1;
  122.          IF i <= 10 THEN BEGIN
  123.             FOR j := 1 TO 15 DO
  124.                 last[j] := 'f';
  125.             str_len := i+2;
  126.             FOR i := 1 TO str_len DO
  127.                 last[i] := string_real[i];
  128.             IF str_len = 3 THEN BEGIN (* x.9999999999 *)
  129.                IF last[2] = '9' THEN BEGIN
  130.                   last[2] := '1';
  131.                   last[4] := '0';
  132.                   IF sign_exp = '' THEN
  133.                      c := c+1
  134.                   ELSE
  135.                      c := c-1
  136.                END
  137.                ELSE BEGIN
  138.                   last[2] := CHR(ORD(last[2])+1);
  139.                   last[4] := '0'
  140.                END
  141.             END
  142.             ELSE (* x.xxxx999999 *)
  143.                (* needn't check here if last[str_len]=9; it CAN'T be,
  144.                   as it would have been a part of the string of 9's *)
  145.                last[str_len] := CHR(ORD(last[str_len])+1);
  146.             string_real := '';
  147.             i := 1;
  148.             WHILE last[i] <> 'f' DO BEGIN (* recreate string_real *)
  149.                 string_real := CONCAT(string_real,last[i]);
  150.                 i := i+1
  151.             END
  152.          END
  153.      END; (* REMOVE_9s *)
  154.  
  155.   BEGIN (* REAL_TO_STRING *)
  156.      IF real_num <> 0.0 THEN BEGIN
  157.         (* sign of number *)
  158.         IF real_num < 0.0 THEN
  159.            string_real := '-'
  160.         ELSE
  161.            string_real := ' ';
  162.         IF ((real_num < 1.0) AND (real_num > 0.0))  OR
  163.            ((real_num < 0.0) AND (real_num > -1.0)) THEN
  164.            sign_exp := '-'
  165.         ELSE
  166.            sign_exp := '';
  167.         (* got sign, so work with number magnitude *)
  168.         mag_num := ABS (real_num);
  169.         (* c counts the number of times the number can be multiplied or div-
  170.            ided by 10 so that finally 1 <= number < 10 *)
  171.         c := 0;
  172.         (* make 1 <= number < 10 *)
  173.         IF mag_num >= 10.0 THEN
  174.            REPEAT
  175.                mag_num := mag_num/10.0;
  176.                c := c+1
  177.            UNTIL mag_num < 10.0
  178.         ELSE IF mag_num < 1.0 THEN
  179.            REPEAT
  180.                mag_num := mag_num*10.0;
  181.                c := c+1
  182.            UNTIL mag_num >= 1.0;
  183.  
  184.         (* Round mag_num to specified # of digits *)
  185.  
  186.         IF (sci_not) AND (digits <= 8) THEN
  187.             mag_num := LONG_ROUND(mag_num*PwrOfTen(digits))/PwrOfTen(digits);
  188.         IF NOT sci_not THEN BEGIN (* Round to spec # digit if possible *)
  189.            IF (c+digits <= 8) AND ((real_num > 1) OR (real_num < -1)) THEN
  190.               mag_num := LONG_ROUND(mag_num*PwrOfTen(c+digits)) / 
  191.                                        PwrOfTen(c+digits);
  192.            (* bug fix- account for numbers between -1.0 and 1.0 *)
  193.            i := digits-c;
  194.            IF (real_num < 1) AND (real_num > -1) THEN BEGIN
  195.               IF ABS(i) <= 8 THEN BEGIN
  196.                  IF i >= 0 THEN
  197.                     mag_num := LONG_ROUND(mag_num*PwrOfTen(i))/PwrOfTen(i)
  198.                  ELSE
  199.                     mag_num := LONG_ROUND(mag_num/PwrOfTen(ABS(i)))*
  200.                                              PwrOfTen(ABS(i))
  201.               END
  202.            END
  203.         END;
  204.         IF mag_num = 0 THEN BEGIN
  205.            string_real := ' 0';
  206.            GOTO 1
  207.         END;   
  208.         IF mag_num >= 10 THEN BEGIN (* rounded up to 10 *)
  209.            IF sign_exp = '-' THEN BEGIN
  210.               c := c-1;
  211.               IF c = 0 THEN
  212.                  sign_exp := '';
  213.            END
  214.            ELSE
  215.               c := c+1;
  216.            mag_num := 1
  217.         END;
  218.  
  219.         (* reals have 11 digits of precision   *)
  220.         (* convert REAL to a string equivalent *)
  221.  
  222.         FOR i := 1 TO 11 DO BEGIN
  223.             j := TRUNC (mag_num);
  224.             string_real := CONCAT(string_real,CHR (j+48));
  225.             mag_num := (mag_num-j)*10
  226.         END; (* FOR i  *)
  227.         INSERT('.',string_real,3);
  228.  
  229.         remove_9s;
  230.  
  231.         { now have the mantissa converted in string_real, so... }
  232.  
  233.         IF NOT sci_not THEN BEGIN
  234.            (* express in expanded form *)
  235.            IF sign_exp = '-' THEN BEGIN   (* mag_num < 1, mag_num <> 0 *)
  236.               loc_char := string_real[2];
  237.               DELETE(string_real,2,1);
  238.               INSERT('0',string_real,2);
  239.               INSERT(loc_char,string_real,4);
  240.               FOR i := 1 TO c-1 DO
  241.                   INSERT('0',string_real,4);
  242.               adjust_to_specified_length
  243.            END
  244.            ELSE BEGIN
  245.               DELETE(string_real,3,1);
  246.               IF 3+c > LENGTH(string_real) THEN
  247.                  FOR i := LENGTH(string_real) TO 2+c DO
  248.                      string_real := CONCAT(string_real,'0');
  249.               INSERT('.',string_real,3+c);
  250.               adjust_to_specified_length;
  251.               insert_commas
  252.            END
  253.         END
  254.         ELSE
  255.            do_exponent;
  256.      END (* begin of first then clause *)
  257.      ELSE (* real_num = 0 *)
  258.         string_real := ' 0';
  259. 1:  END; (* REAL_TO_STRING *)
  260.  
  261.  
  262.  
  263. FUNCTION STRING_TO_REAL ( VAR str : STR30 ) : REAL;
  264.  
  265. (*
  266.    Strings passed must follow the following rules:
  267.         1. may have been created by REAL_TO_STRING,
  268.         2. may have been entered via READ or WINDOW_INPUT
  269.            a. Strings entered via WINDOW_INPUT may contain NO imbedded spaces,
  270.               and if given in sci. not. must use either 'e' or 'E' .
  271.         3. overflows are trapped, STRING_TO_REAL returns 0 and string_real
  272.            returns 'OVERFLOW'; otherwise string_real is preserved intact
  273.         4. must be an exact image of a valid real! VALID_NUMBER screens out
  274.            all miswritten numbers, i.e 1.22.4-e0-4
  275.         5. must have at least one digit preceding a decimal
  276.         6. doesn't check for spaces because the routines that call it either
  277.            eat up the spaces or don't allow them
  278.         7. doesn't check for a null string since one is never passed
  279. *)
  280.  
  281.   LABEL 1;
  282.  
  283.   BEGIN
  284.      loverflow := FALSE;
  285.      sign_num := 1;
  286.      sign_exp := 1;
  287.      lpower := 1;
  288.      real_num := 0;
  289.      exp_val := 0;
  290.      lfactor := 0;
  291.      str_pos := 1;
  292.      str_len := LENGTH(str);
  293.      IF (str[1] = '+') OR (str[1] = '-') OR (str[1] = ' ') THEN BEGIN
  294.         IF str[1] = '-' THEN
  295.            sign_num := -1;
  296.         str_pos := 2
  297.      END;
  298.      lquit := FALSE;
  299.      WHILE (str_pos <= str_len) AND (NOT lquit) DO
  300.         IF str[str_pos] IN digits THEN BEGIN
  301.            real_num := real_num*10+ORD(str[str_pos])-ORD('0');
  302.            str_pos := str_pos+1
  303.         END   
  304.         ELSE
  305.            lquit := TRUE;
  306.      IF str_pos <= str_len THEN
  307.         IF str[str_pos] = '.' THEN BEGIN
  308.            places := 0;
  309.            str_pos := str_pos+1;
  310.            lquit := FALSE;
  311.            WHILE (str_pos <= str_len) AND (NOT lquit) DO
  312.               IF str[str_pos] IN digits THEN BEGIN
  313.                  places := places+1;
  314.                  real_num := real_num*10+ORD(str[str_pos])-ORD('0');
  315.                  str_pos := str_pos+1
  316.               END   
  317.               ELSE
  318.                  lquit := TRUE;
  319.            real_num := real_num/PwrOfTen(places)
  320.         END;
  321.      IF str_pos <= str_len THEN
  322.         IF (str[str_pos] = 'E') OR (str[str_pos] = 'e') THEN BEGIN
  323.            str_pos := str_pos+1;
  324.            IF str_pos <= str_len THEN BEGIN
  325.               IF (str[str_pos] = '+') OR (str[str_pos] = '-') THEN BEGIN
  326.                  IF str[str_pos] = '-' THEN
  327.                     sign_exp := -1;
  328.                  str_pos := str_pos+1
  329.               END;
  330.               lquit := FALSE;
  331.               WHILE (str_pos <= str_len) AND (NOT lquit) DO
  332.                  IF str[str_pos] IN digits THEN BEGIN
  333.                     exp_val := exp_val*10+ORD(str[str_pos])-ORD('0');
  334.                     str_pos := str_pos+1
  335.                  END
  336.                  ELSE
  337.                     lquit := TRUE;
  338.               IF exp_val > 38 THEN BEGIN
  339.                  loverflow := TRUE;
  340.                  GOTO 1
  341.               END;
  342.               lpower := PwrOfTen(exp_val);
  343.               IF sign_exp < 0 THEN
  344.                  lpower := 1/lpower
  345.            END      
  346.         END;
  347.                  
  348.      (* Check for potential overflow *)
  349.      
  350.      mag_num := real_num;
  351.      
  352.      IF mag_num <> 0 THEN
  353.         IF mag_num >= 10 THEN
  354.            REPEAT
  355.                mag_num := mag_num/10.0;
  356.                lfactor := lfactor+1
  357.            UNTIL mag_num < 10.0
  358.         ELSE IF mag_num < 1.0 THEN
  359.            REPEAT
  360.                mag_num := mag_num*10.0;
  361.                lfactor := lfactor-1
  362.            UNTIL mag_num >= 1.0;
  363.            
  364. 1:   IF (ABS(exp_val*sign_exp+lfactor) >= 37) OR (loverflow) THEN BEGIN
  365.         alert := Do_Alert(float_over,1);
  366.         str := 'OVERFLOW';
  367.         string_to_real := 0
  368.      END
  369.      ELSE
  370.         string_to_real := real_num*sign_num*lpower
  371.      
  372.   END; (* STRING_TO_REAL *)
  373.  
  374.  
  375. PROCEDURE INT_TO_STRING ( n : INTEGER; VAR s : STR10 );
  376.    { for non_negative integers }
  377.    VAR
  378.       digit,divisor   : INTEGER;
  379.       leading         : BOOLEAN;
  380.    BEGIN { INT_TO_STRING }
  381.        IF n <= 0 THEN
  382.           s := '0'
  383.        ELSE BEGIN
  384.           s := '';
  385.           divisor := 10000;
  386.           leading := TRUE;
  387.           WHILE divisor > 0 DO BEGIN
  388.              digit := n DIV divisor;
  389.              IF (digit <> 0) OR (NOT leading) THEN BEGIN
  390.                 s := CONCAT(s,CHR(digit+48));
  391.                 leading := FALSE
  392.              END;
  393.              n := n MOD divisor;
  394.              divisor := divisor DIV 10
  395.           END
  396.        END
  397.    END; { INT_TO_STRING }
  398.  
  399. BEGIN  (* dummy program for modular compilation *)
  400. END.
  401.  
  402.  
  403.