home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / numana01.zip / SRC / CONVERSI.MOD next >
Text File  |  1996-07-31  |  31KB  |  828 lines

  1. IMPLEMENTATION MODULE Conversions;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*              Miscellaneous type conversions          *)
  6.         (*                                                      *)
  7.         (*  Programmer:         P. Moylan                       *)
  8.         (*  Last edited:        30 July 1996                    *)
  9.         (*  Status:             Working                         *)
  10.         (*                                                      *)
  11.         (*      Have not fully tested the cases where the field *)
  12.         (*       size is too small.                             *)
  13.         (*      Seems to be a loss of accuracy when converting  *)
  14.         (*       E-format numbers; for example 123.456E7 is     *)
  15.         (*       converted to 1234559999 when passed through    *)
  16.         (*       StringToReal and then RealToString.  I'm not   *)
  17.         (*       yet sure where this is happening, but suspect  *)
  18.         (*       that it requires some deep error analysis.     *)
  19.         (*                                                      *)
  20.         (********************************************************)
  21.  
  22. FROM SYSTEM IMPORT
  23.     (* type *)  CARD8;
  24.  
  25. FROM LowLevel IMPORT
  26.     (* proc *)  IAND, RS;
  27.  
  28. CONST tab = CHR(9);
  29.  
  30. TYPE CharSet = SET OF CHAR;
  31.  
  32. (************************************************************************)
  33. (*                         BUFFER MANIPULATION                          *)
  34. (************************************************************************)
  35.  
  36. PROCEDURE ShiftRight (VAR (*INOUT*) buffer: ARRAY OF CHAR;
  37.                                 first, last, amount: CARDINAL);
  38.  
  39.     (* Moves the contents of buffer[first..last] right by the specified *)
  40.     (* number of characters, space filling at the left and discarding   *)
  41.     (* characters shifted out at the right.                             *)
  42.  
  43.     VAR j: CARDINAL;
  44.  
  45.     BEGIN
  46.         IF amount > 0 THEN
  47.             FOR j := last TO first+amount BY -1 DO
  48.                 buffer[j] := buffer[j-amount];
  49.             END (*FOR*);
  50.             FOR j := first TO first+amount-1 DO
  51.                 buffer[j] := " ";
  52.             END (*FOR*);
  53.         END (*IF*);
  54.     END ShiftRight;
  55.  
  56. (************************************************************************)
  57. (*                      REAL NUMBER TO CARDINAL POWER                   *)
  58. (************************************************************************)
  59.  
  60. PROCEDURE atoi (a: LONGREAL;  i: CARDINAL): LONGREAL;
  61.  
  62.     (* Calculates a**i.  This procedure does not really belong in this  *)
  63.     (* module, but for now it doesn't seem to have any other suitable   *)
  64.     (* home.                                                            *)
  65.  
  66.     VAR result: LONGREAL;
  67.  
  68.     BEGIN
  69.         result := 1.0;
  70.  
  71.         (* Desired answer is result*(a)**i.  The loop below keeps this  *)
  72.         (* quantity invariant while reducing i down to zero.            *)
  73.  
  74.         LOOP
  75.             IF ODD(i) THEN
  76.                 DEC(i);  result := a*result;
  77.             END (*IF*);
  78.             IF i=0 THEN EXIT(*LOOP*) END(*IF*);
  79.             i := i DIV 2;  a := a*a;
  80.         END (*LOOP*);
  81.         RETURN result;
  82.     END atoi;
  83.  
  84. (************************************************************************)
  85.  
  86. PROCEDURE TenToPower (N: CARDINAL): LONGREAL;
  87.  
  88.     (* Calculates 10**N.        *)
  89.  
  90.     BEGIN
  91.         RETURN atoi (10.0, N);
  92.     END TenToPower;
  93.  
  94. (************************************************************************)
  95. (*                      CARDINAL-TO-STRING CONVERSIONS                  *)
  96. (************************************************************************)
  97.  
  98. PROCEDURE HexToChar (number: HexDigit): CHAR;
  99.  
  100.     (* Converts a one-digit hexadecimal number to its readable form.    *)
  101.  
  102.     BEGIN
  103.         IF number < 10 THEN
  104.             RETURN CHR(ORD("0")+number)
  105.         ELSE
  106.             RETURN CHR(ORD("A")+number-10)
  107.         END (*IF*);
  108.     END HexToChar;
  109.  
  110. (************************************************************************)
  111.  
  112. PROCEDURE HexByteToString (value: CARD8;
  113.                         VAR (*OUT*) buffer: ARRAY OF CHAR;  pos: CARDINAL);
  114.  
  115.     (* Converts a byte value to 2-character hexadecimal, with the       *)
  116.     (* result stored at buffer[pos] and buffer[pos+1].                  *)
  117.  
  118.     BEGIN
  119.         buffer[pos] := HexToChar (VAL(HexDigit, value DIV 16));
  120.         buffer[pos+1] := HexToChar (VAL(HexDigit, value MOD 16));
  121.     END HexByteToString;
  122.  
  123. (************************************************************************)
  124.  
  125. PROCEDURE HexToString (value: CARDINAL;  VAR (*OUT*) buffer: ARRAY OF CHAR);
  126.  
  127.     VAR j: CARDINAL;
  128.  
  129.     BEGIN
  130.         FOR j := HIGH(buffer) TO 0 BY -1 DO
  131.             buffer[j] := HexToChar (IAND(value,0FH));
  132.             value := RS (value, 4);
  133.         END (*FOR*);
  134.     END HexToString;
  135.  
  136. (************************************************************************)
  137.  
  138. (*
  139. PROCEDURE LongHexToString (value: LONGCARD;  VAR (*OUT*) buffer: EightChar);
  140.  
  141.     VAR j: [0..3];  highpart: ARRAY [0..3] OF CHAR;
  142.  
  143.     BEGIN
  144.         HexToString (LowWord(value), buffer);
  145.         HexToString (HighWord(value), highpart);
  146.         FOR j := 0 TO 3 DO
  147.             buffer[j] := highpart[j];
  148.         END (*FOR*);
  149.     END LongHexToString;
  150. *)
  151.  
  152. (************************************************************************)
  153.  
  154. (*
  155. PROCEDURE LongCardToString (number: LONGCARD;
  156.                                         VAR (*OUT*) buffer: ARRAY OF CHAR;
  157.                                         fieldsize: CARDINAL);
  158.  
  159.     (* Converts the number to a decimal character string in array       *)
  160.     (* "buffer", right-justified in a field of fieldsize characters.    *)
  161.  
  162.     VAR j, remainder: CARDINAL;
  163.  
  164.     BEGIN
  165.         IF number < 10 THEN
  166.             IF fieldsize > 1 THEN
  167.                 FOR j := 0 TO fieldsize-2 DO
  168.                     buffer[j] := " ";
  169.                 END (*FOR*);
  170.             END (*IF*);
  171.             buffer[fieldsize-1] := CHR(ORD(number) + ORD("0"));
  172.         ELSIF fieldsize = 1 THEN
  173.             buffer[0] := "*";
  174.         ELSE
  175.             LongCardToString (number DIV 10, buffer, fieldsize-1);
  176.             remainder := CARDINAL (number MOD 10);
  177.             buffer[fieldsize-1] := CHR(remainder + ORD("0"));
  178.         END (*IF*);
  179.     END LongCardToString;
  180. *)
  181.  
  182. (*********************************************************************)
  183.  
  184. PROCEDURE CardinalToString (number: CARDINAL;
  185.                                         VAR (*OUT*) buffer: ARRAY OF CHAR;
  186.                                         fieldsize: CARDINAL);
  187.  
  188.     (* Converts the number to a decimal character string in array       *)
  189.     (* "buffer", right-justified in a field of fieldsize characters.    *)
  190.  
  191.     VAR j, remainder: CARDINAL;
  192.  
  193.     BEGIN
  194.         IF number < 10 THEN
  195.             IF fieldsize > 1 THEN
  196.                 FOR j := 0 TO fieldsize-2 DO
  197.                     buffer[j] := " ";
  198.                 END (*FOR*);
  199.             END (*IF*);
  200.             buffer[fieldsize-1] := CHR(ORD(number) + ORD("0"));
  201.         ELSIF fieldsize = 1 THEN
  202.             buffer[0] := "*";
  203.         ELSE
  204.             CardinalToString (number DIV 10, buffer, fieldsize-1);
  205.             remainder := number MOD 10;
  206.             buffer[fieldsize-1] := CHR(remainder + ORD("0"));
  207.         END (*IF*);
  208.     END CardinalToString;
  209.  
  210. (*********************************************************************)
  211.  
  212. PROCEDURE ShortCardToString (number: CARD8;
  213.                                         VAR (*OUT*) buffer: ARRAY OF CHAR;
  214.                                         fieldsize: CARDINAL);
  215.  
  216.     (* Converts the number to a decimal character string in array       *)
  217.     (* "buffer", right-justified in a field of fieldsize characters.    *)
  218.  
  219.     BEGIN
  220.         CardinalToString (VAL(CARDINAL,number), buffer, fieldsize);
  221.     END ShortCardToString;
  222.  
  223. (*********************************************************************)
  224.  
  225. PROCEDURE AssembleCardinal (number: CARDINAL;
  226.                                 VAR (*OUT*) buffer: ARRAY OF CHAR;
  227.                                 VAR (*INOUT*) place: CARDINAL;
  228.                                 VAR (*OUT*) error: BOOLEAN);
  229.  
  230.     (* Converts number to decimal, putting it in buffer starting at     *)
  231.     (* buffer[place].  On return, place has been updated to be just     *)
  232.     (* beyond the last digit put in the buffer.                         *)
  233.  
  234.     BEGIN
  235.         IF number > 9 THEN
  236.             AssembleCardinal (number DIV 10, buffer, place, error);
  237.             IF error THEN RETURN END(*IF*);
  238.         END (*IF*);
  239.         error := place > HIGH(buffer);
  240.         IF NOT error THEN
  241.             buffer[place] := CHR (number MOD 10 + ORD("0"));
  242.             INC (place);
  243.         END (*IF*);
  244.     END AssembleCardinal;
  245.  
  246. (************************************************************************)
  247. (*                      REAL-TO-STRING CONVERSIONS                      *)
  248. (************************************************************************)
  249.  
  250. PROCEDURE AssembleExponent (number: INTEGER;
  251.                         VAR (*OUT*) buffer: ARRAY OF CHAR;
  252.                         VAR (*INOUT*) position: CARDINAL;
  253.                         VAR (*OUT*) error: BOOLEAN);
  254.  
  255.     (* Puts a field of the format Ennn or E-nnn into the buffer,        *)
  256.     (* starting at buffer[position].  On return, position has been      *)
  257.     (* updated so that buffer[position] is the first character not      *)
  258.     (* altered by this procedure.                                       *)
  259.  
  260.     BEGIN
  261.         error := FALSE;
  262.         IF number <> 0 THEN
  263.             error := position > HIGH(buffer);
  264.             IF NOT error THEN
  265.                 buffer[position] := "E";  INC(position);
  266.                 IF number < 0 THEN
  267.                     error := position > HIGH(buffer);
  268.                     IF NOT error THEN
  269.                         buffer[position] := "-";  INC(position);
  270.                         number := -number;
  271.                     END (*IF*);
  272.                 END (*IF*);
  273.             END (*IF*);
  274.             IF NOT error THEN
  275.                 AssembleCardinal (number, buffer, position, error);
  276.             END (*IF*);
  277.         END (*IF*);
  278.     END AssembleExponent;
  279.  
  280. (************************************************************************)
  281.  
  282. PROCEDURE Roundup (VAR (*INOUT*) buffer: ARRAY OF CHAR;
  283.                                         first, last: CARDINAL);
  284.  
  285.     (* Takes the decimal number in buffer[first..last] and increments   *)
  286.     (* its least significant digit, propagating the carry upwards as    *)
  287.     (* far as necessary.                                                *)
  288.  
  289.     VAR position, pointposition: CARDINAL;
  290.         code: CHAR;
  291.  
  292.     BEGIN
  293.         position := last+1;  pointposition := position;
  294.         REPEAT
  295.             DEC (position);
  296.             code := buffer[position];
  297.             IF code = "9" THEN buffer[position] := "0"
  298.             ELSIF code = "." THEN
  299.                 pointposition := position;  code := "9";
  300.             ELSE
  301.                 INC (buffer[position]);
  302.             END (*IF*);
  303.         UNTIL (code <> "9") OR (position = first);
  304.  
  305.         (* The job is now done, except for one special case.  If we     *)
  306.         (* have left the above loop after incrementing a "9", the carry *)
  307.         (* has propagated off the left end of the number.  In that case *)
  308.         (* every digit must have been a "9", so the result is 10000...  *)
  309.         (* with a decimal point inserted at the appropriate place.      *)
  310.  
  311.         IF code = "9" THEN
  312.             IF pointposition <= last THEN
  313.                 buffer[pointposition] := "0";
  314.                 IF pointposition < last THEN
  315.                     INC (pointposition);  buffer[pointposition] := ".";
  316.                 END (*IF*);
  317.             END (*IF*);
  318.             buffer[first] := "1";
  319.         END (*IF*);
  320.  
  321.     END Roundup;
  322.  
  323. (************************************************************************)
  324.  
  325. PROCEDURE Fformat (number: LONGREAL;  VAR (*OUT*) buffer: ARRAY OF CHAR;
  326.                         start: CARDINAL;  VAR (*INOUT*) finish: CARDINAL;
  327.                         LeftJustified: BOOLEAN;  VAR (*OUT*) error: BOOLEAN);
  328.  
  329.     (* Formats the second argument as a decimal number, left or right   *)
  330.     (* justified depending on the value of LeftJustified, in            *)
  331.     (* buffer[start..finish].  This procedure is known to be called     *)
  332.     (* only with start=0 or start=1 with a sign in buffer[0]; so we     *)
  333.     (* perform the justification on all of buffer[0..finish] if right   *)
  334.     (* justification is specified.  In the case of left justification,  *)
  335.     (* finish is updated to show the last buffer position actually      *)
  336.     (* used; and this character position is followed by one or more NUL *)
  337.     (* characters, except in the case where we have used the entire     *)
  338.     (* field to hold the result.                                        *)
  339.  
  340.     VAR position: CARDINAL;
  341.         integerpart: CARDINAL;  nextdigit: [0..9];
  342.  
  343.     BEGIN
  344.         position := start;
  345.         integerpart := VAL (CARDINAL, number);
  346.         AssembleCardinal (integerpart, buffer, position, error);
  347.         IF error THEN RETURN END(*IF*);
  348.  
  349.         IF position <= finish THEN
  350.             buffer[position] := ".";
  351.             INC (position);
  352.             number := number - VAL (LONGREAL, integerpart);
  353.  
  354.             WHILE (position <= finish) DO
  355.                 number := 10.0*number;
  356.                 nextdigit := VAL (CARDINAL, number);
  357.                 buffer[position] := CHR(ORD("0") + nextdigit);
  358.                 INC (position);
  359.                 number := number - VAL (LONGREAL, nextdigit);
  360.             END (*WHILE*);
  361.  
  362.             (* If the remainder is 0.5 or more, adjust the result by    *)
  363.             (* rounding up.                                             *)
  364.  
  365.             IF number >= 0.5 THEN
  366.                 Roundup (buffer, start, finish);
  367.             END (*IF*);
  368.  
  369.             (* Strip off the trailing zeros.    *)
  370.  
  371.             DEC (position);
  372.             WHILE buffer[position] = '0' DO
  373.                 buffer[position] := CHR(0);
  374.                 DEC (position);
  375.             END (*WHILE*);
  376.  
  377.             (* If we are left with a whole number, strip off the        *)
  378.             (* decimal point.                                           *)
  379.  
  380.             IF buffer[position] = '.' THEN
  381.                 buffer[position] := CHR(0);
  382.                 DEC (position);
  383.             END (*IF*);
  384.  
  385.             (* Right justify the result or modify finish, as specified. *)
  386.  
  387.             IF LeftJustified THEN
  388.                 finish := position;
  389.             ELSE
  390.                 ShiftRight (buffer, 0, finish, finish-position);
  391.             END (*IF*);
  392.  
  393.         END (*IF*);
  394.  
  395.     END Fformat;
  396.  
  397. (************************************************************************)
  398.  
  399. PROCEDURE Scale (VAR (*INOUT*) mantissa: LONGREAL;
  400.                         VAR (*INOUT*) exponent: INTEGER;
  401.                         power: CARDINAL;  lower, upper: LONGREAL);
  402.  
  403.     (* Adjusts mantissa so that lower <= mantissa < upper, while        *)
  404.     (* keeping the quantity  (mantissa * 10^exponent) invariant.  To    *)
  405.     (* save us some calculation, the caller must ensure that            *)
  406.     (* upper = 10^power and lower = 10^(-power).                        *)
  407.  
  408.     BEGIN
  409.         WHILE mantissa >= upper DO
  410.             INC (exponent, power);  mantissa := lower*mantissa;
  411.         END (*WHILE*);
  412.  
  413.         WHILE mantissa < lower DO
  414.             DEC (exponent, power);  mantissa := upper*mantissa;
  415.         END (*WHILE*);
  416.     END Scale;
  417.  
  418. (************************************************************************)
  419.  
  420. PROCEDURE Separate (number: LONGREAL;  VAR (*OUT*) mantissa: LONGREAL;
  421.                                         VAR (*OUT*) exponent: INTEGER);
  422.  
  423.     (* Separates the first argument into a mantissa and exponent part,  *)
  424.     (* so that  number = mantissa * 10^exponent.                        *)
  425.  
  426.     BEGIN
  427.         mantissa := number;  exponent := 0;
  428.         Scale (mantissa, exponent, 256, 1.0E-256, 1.0E256);
  429.         Scale (mantissa, exponent, 64, 1.0E-64, 1.0E64);
  430.         Scale (mantissa, exponent, 16, 1.0E-16, 1.0E16);
  431.         Scale (mantissa, exponent, 4, 1.0E-4, 1.0E4);
  432.         Scale (mantissa, exponent, 1, 1.0E-1, 1.0E1);
  433.     END Separate;
  434.  
  435. (************************************************************************)
  436.  
  437. PROCEDURE Eformat (number: LONGREAL;  VAR (*OUT*) buffer: ARRAY OF CHAR;
  438.                                         start, finish: CARDINAL;
  439.                                         VAR (*OUT*) error: BOOLEAN);
  440.  
  441.     (* Puts number into buffer[start..finish] in E format, with the     *)
  442.     (* whole of buffer[0..finish] right justified.                      *)
  443.  
  444.     VAR mantissa: LONGREAL;  exponent: INTEGER;
  445.         position: CARDINAL;
  446.  
  447.     BEGIN
  448.         Separate (number, mantissa, exponent);
  449.  
  450.         (* Put the exponent into the buffer first, in order to find out *)
  451.         (* how much space will be left for the mantissa.                *)
  452.  
  453.         position := start;
  454.         AssembleExponent (exponent, buffer, position, error);
  455.         error := error OR (position > finish);
  456.  
  457.         IF error THEN
  458.             IF finish < HIGH(buffer) THEN
  459.                 buffer[finish+1] := CHR(0);
  460.             END (*IF*);
  461.         ELSE
  462.             ShiftRight (buffer, start, finish, finish-position+1);
  463.  
  464.             (* Now assemble the mantissa into the buffer.       *)
  465.  
  466.             DEC (finish, position-start);
  467.             Fformat (mantissa, buffer, start, finish, FALSE, error);
  468.         END (*IF*);
  469.  
  470.     END Eformat;
  471.  
  472. (************************************************************************)
  473. (*              CONVERSION OF REAL NUMBER TO CHARACTER STRING           *)
  474. (************************************************************************)
  475.  
  476. PROCEDURE LongRealToString (number: LONGREAL;
  477.                                         VAR (*OUT*) buffer: ARRAY OF CHAR;
  478.                                         fieldsize: CARDINAL);
  479.  
  480.     (* Converts the number to a decimal character string in array       *)
  481.     (* "buffer", right-justified in a field of "places" characters.     *)
  482.  
  483.     VAR start, finish, j: CARDINAL;  small: LONGREAL;  error: BOOLEAN;
  484.  
  485.     BEGIN
  486.         IF fieldsize = 0 THEN RETURN END(*IF*);
  487.  
  488.         start := 0;  finish := fieldsize-1;  error := FALSE;
  489.  
  490.         (* Make sure that the string will fit into the buffer, and that *)
  491.         (* it will be properly terminated.                              *)
  492.  
  493.         IF finish > HIGH(buffer) THEN
  494.             DEC (fieldsize, finish-HIGH(buffer));
  495.             finish := HIGH(buffer);
  496.         ELSIF finish < HIGH(buffer) THEN
  497.             buffer[finish+1] := CHR(0);
  498.         END (*IF*);
  499.  
  500.         (* For a negative number, insert a minus sign.  *)
  501.  
  502.         IF number < 0.0 THEN
  503.             IF fieldsize <= 1 THEN
  504.                 error := TRUE;
  505.             ELSE
  506.                 buffer[0] := "-";  start := 1;  DEC(fieldsize);
  507.                 number := -number;
  508.             END (*IF*);
  509.         END (*IF*);
  510.  
  511.         IF NOT error THEN
  512.  
  513.             (* Now decide on whether to use E format, based on the      *)
  514.             (* value to be converted.                                   *)
  515.  
  516.             small := 100.0 / TenToPower(fieldsize);
  517.             IF number = 0.0 THEN
  518.                 Fformat (number, buffer, start, finish, FALSE, error);
  519.             ELSIF (number >= TenToPower(fieldsize))
  520.                     OR (number > VAL(LONGREAL, MAX(CARDINAL)))
  521.                         OR (number < small) THEN
  522.                 Eformat (number, buffer, start, finish, error);
  523.             ELSE
  524.                 Fformat (number, buffer, start, finish, FALSE, error);
  525.             END (*IF*);
  526.  
  527.         END (*IF*);
  528.  
  529.         IF error THEN
  530.             FOR j := 0 TO finish DO
  531.                 buffer[j] := '*';
  532.             END (*FOR*);
  533.         END (*IF*);
  534.  
  535.     END LongRealToString;
  536.  
  537. (************************************************************************)
  538.  
  539. PROCEDURE RealToString (number: REAL;  VAR (*OUT*) buffer: ARRAY OF CHAR;
  540.                                         fieldsize: CARDINAL);
  541.  
  542.     (* Like LongRealToString, except for argument type. *)
  543.  
  544.     BEGIN
  545.         LongRealToString (VAL(LONGREAL,number), buffer, fieldsize);
  546.     END RealToString;
  547.  
  548. (************************************************************************)
  549.  
  550. PROCEDURE LongRealToF (number: LONGREAL;  VAR (*INOUT*) fieldsize: CARDINAL;
  551.                         decimalplaces: CARDINAL;  LeftJustified: BOOLEAN;
  552.                         VAR (*OUT*) buffer: ARRAY OF CHAR);
  553.  
  554.     (* Converts the number to an F-format string, of up to fieldsize    *)
  555.     (* characters with decimalplaces digits after the decimal point.    *)
  556.     (* The result is left justified if LeftJustified = TRUE is          *)
  557.     (* specified by the caller, and right justified with space fill     *)
  558.     (* otherwise.  On return fieldsize gives the number of character    *)
  559.     (* positions actually used.  The result string is terminated with   *)
  560.     (* at least one CHR(0) (which is not counted in fieldsize), except  *)
  561.     (* where the result fills the entire buffer.                        *)
  562.  
  563.     VAR start, finish, j: CARDINAL;  scalefactor: LONGREAL;  error: BOOLEAN;
  564.  
  565.     BEGIN
  566.         IF fieldsize = 0 THEN RETURN END(*IF*);
  567.  
  568.         start := 0;  finish := fieldsize-1;  error := FALSE;
  569.  
  570.         (* Make sure that the string will fit into the buffer, and that *)
  571.         (* it will be properly terminated.                              *)
  572.  
  573.         IF finish > HIGH(buffer) THEN
  574.             DEC (fieldsize, finish-HIGH(buffer));
  575.             finish := HIGH(buffer);
  576.         ELSIF finish < HIGH(buffer) THEN
  577.             buffer[finish+1] := CHR(0);
  578.         END (*IF*);
  579.  
  580.         (* For a negative number, insert a minus sign.  *)
  581.  
  582.         IF number < 0.0 THEN
  583.             IF fieldsize <= 1 THEN
  584.                 error := TRUE;
  585.             ELSE
  586.                 buffer[0] := "-";  start := 1;  DEC(fieldsize);
  587.                 number := -number;
  588.             END (*IF*);
  589.         END (*IF*);
  590.  
  591.         IF NOT error THEN
  592.  
  593.             (* Round the number to the desired number of decimal places. *)
  594.  
  595.             scalefactor := TenToPower (decimalplaces);
  596.             number := scalefactor*number + 0.5;
  597.             number := VAL(LONGREAL, VAL(CARDINAL, number)) / scalefactor;
  598.  
  599.             (* Perform the conversion.  *)
  600.  
  601.             Fformat (number, buffer, start, finish, LeftJustified, error);
  602.  
  603.         END (*IF*);
  604.  
  605.         IF error THEN
  606.             FOR j := 0 TO finish DO
  607.                 buffer[j] := '*';
  608.             END (*FOR*);
  609.         END (*IF*);
  610.  
  611.         fieldsize := finish + 1;
  612.  
  613.     END LongRealToF;
  614.  
  615. (************************************************************************)
  616.  
  617. PROCEDURE RealToF (number: REAL;  VAR (*INOUT*) fieldsize: CARDINAL;
  618.                         decimalplaces: CARDINAL;  LeftJustified: BOOLEAN;
  619.                         VAR (*OUT*) buffer: ARRAY OF CHAR);
  620.  
  621.     (* Like LongRealToF, except for argument type.      *)
  622.  
  623.     BEGIN
  624.         LongRealToF (VAL(LONGREAL,number), fieldsize, decimalplaces,
  625.                                         LeftJustified, buffer);
  626.     END RealToF;
  627.  
  628. (************************************************************************)
  629. (*                  CONVERSION OF STRING TO CARDINAL                    *)
  630. (************************************************************************)
  631.  
  632. PROCEDURE StringToHex (string: ARRAY OF CHAR): CARDINAL;
  633.  
  634.     (* Converts a hexadecimal character string to numeric, stopping at  *)
  635.     (* the first non-digit character.  Leading spaces are permitted.    *)
  636.  
  637.     CONST HexChars = CharSet {"0".."9", "a".."f", "A".."F"};
  638.  
  639.     VAR position, value: CARDINAL;
  640.  
  641.     BEGIN
  642.         position := 0;
  643.         WHILE (position <= HIGH(string)) AND (string[position] = ' ') DO
  644.             INC (position);
  645.         END (*WHILE*);
  646.         value := 0;
  647.         WHILE (position <= HIGH(string)) AND (string[position] IN HexChars) DO
  648.             value := 16*value;
  649.             IF string[position] IN CharSet{"a".."f"} THEN
  650.                 value := value + 10 + ORD(string[position]) - ORD('a');
  651.             ELSIF string[position] IN CharSet{"A".."F"} THEN
  652.                 value := value + 10 + ORD(string[position]) - ORD('A');
  653.             ELSE
  654.                 value := value + ORD(string[position]) - ORD('0');
  655.             END (*IF*);
  656.             INC (position);
  657.         END (*WHILE*);
  658.         RETURN value;
  659.     END StringToHex;
  660.  
  661. (************************************************************************)
  662.  
  663. (*
  664. PROCEDURE StringToLongCard (string: ARRAY OF CHAR): LONGCARD;
  665.  
  666.     (* Converts a character string to decimal, stopping at the first    *)
  667.     (* non-digit character.  Leading spaces are permitted.              *)
  668.  
  669.     VAR position: CARDINAL;  value: LONGCARD;
  670.  
  671.     BEGIN
  672.         position := 0;
  673.         WHILE (position <= HIGH(string)) AND (string[position] = ' ') DO
  674.             INC (position);
  675.         END (*WHILE*);
  676.         value := 0;
  677.         WHILE (position <= HIGH(string)) AND (string[position] >= '0')
  678.                 AND (string[position] <= '9') DO
  679.             value := 10*value + VAL(LONGCARD, ORD(string[position]) - ORD('0'));
  680.             INC (position);
  681.         END (*WHILE*);
  682.         RETURN value;
  683.     END StringToLongCard;
  684. *)
  685.  
  686. (************************************************************************)
  687.  
  688. PROCEDURE StringToCardinal (string: ARRAY OF CHAR): CARDINAL;
  689.  
  690.     (* Converts a character string to decimal, stopping at the first    *)
  691.     (* non-digit character.  Leading spaces are permitted.              *)
  692.  
  693.     VAR position, value: CARDINAL;
  694.  
  695.     BEGIN
  696.         position := 0;
  697.         WHILE (position <= HIGH(string)) AND (string[position] = ' ') DO
  698.             INC (position);
  699.         END (*WHILE*);
  700.         value := 0;
  701.         WHILE (position <= HIGH(string)) AND (string[position] >= '0')
  702.                 AND (string[position] <= '9') DO
  703.             value := 10*value + ORD(string[position]) - ORD('0');
  704.             INC (position);
  705.         END (*WHILE*);
  706.         RETURN value;
  707.     END StringToCardinal;
  708.  
  709. (************************************************************************)
  710. (*                      CONVERSION OF STRING TO REAL                    *)
  711. (************************************************************************)
  712.  
  713. PROCEDURE StringToLongReal (string: ARRAY OF CHAR): LONGREAL;
  714.  
  715.     (* Converts a decimal text string (with optional leading minus      *)
  716.     (* sign) to real.  Leading blanks are ignored.  The conversion      *)
  717.     (* stops at the end of the array or at the first character which    *)
  718.     (* cannot be part of the number, and in the latter case all         *)
  719.     (* subsequent characters are ignored.                               *)
  720.  
  721.     VAR result, placevalue: LONGREAL;
  722.         position: CARDINAL;
  723.         nextchar: CHAR;
  724.         exponent: CARDINAL;  negative, negativeexp: BOOLEAN;
  725.  
  726.     (********************************************************************)
  727.  
  728.     PROCEDURE GetNextChar;
  729.  
  730.         (* Puts the next character in the input into variable nextchar, *)
  731.         (* or sets nextchar := CHR(0) if there is no next character.    *)
  732.         (* The position in the array is updated.                        *)
  733.  
  734.         CONST EndMarker = CHR(0);
  735.  
  736.         BEGIN
  737.             IF position > HIGH(string) THEN
  738.                 nextchar := EndMarker;
  739.             ELSE
  740.                 nextchar := string[position];  INC (position);
  741.             END (*IF*);
  742.         END GetNextChar;
  743.  
  744.     (********************************************************************)
  745.  
  746.     BEGIN
  747.         result := 0.0;  position := 0;  negative := FALSE;
  748.  
  749.         (* Skip leading spaces and tabs.        *)
  750.  
  751.         REPEAT
  752.             GetNextChar;
  753.         UNTIL (nextchar <> " ") AND (nextchar <> tab);
  754.  
  755.         (* Check for a sign.    *)
  756.  
  757.         IF (nextchar = "-") OR (nextchar = "+") THEN
  758.             negative := (nextchar = "-");
  759.  
  760.             (* There might be some more spaces to skip. *)
  761.  
  762.             REPEAT
  763.                 GetNextChar;
  764.             UNTIL (nextchar <> " ") AND (nextchar <> tab);
  765.         END (*IF*);
  766.  
  767.         (* Read the part before the decimal point.      *)
  768.  
  769.         WHILE nextchar IN CharSet {"0".."9"} DO
  770.             result := 10.0*result + VAL(LONGREAL, ORD(nextchar)-ORD("0") );
  771.             GetNextChar;
  772.         END (*WHILE*);
  773.  
  774.         (* Now the part after the decimal point, if any.        *)
  775.  
  776.         IF nextchar = "." THEN
  777.             GetNextChar;  placevalue := 0.1;
  778.             WHILE nextchar IN CharSet {"0".."9"} DO
  779.                 result := result +
  780.                         placevalue * VAL(LONGREAL, ORD(nextchar)-ORD("0") );
  781.                 placevalue := 0.1*placevalue;
  782.                 GetNextChar;
  783.             END (*WHILE*);
  784.         END (*IF*);
  785.  
  786.         (* Check for Ennn part. *)
  787.  
  788.         IF (nextchar = "E") OR (nextchar = "e") THEN
  789.             GetNextChar;
  790.             exponent := 0;  negativeexp := FALSE;
  791.             IF nextchar = "+" THEN
  792.                 GetNextChar;
  793.             ELSIF nextchar = "-" THEN
  794.                 negativeexp := TRUE;  GetNextChar;
  795.             END (*IF*);
  796.             WHILE nextchar IN CharSet {"0".."9"} DO
  797.                 exponent := 10*exponent + ORD(nextchar) - ORD("0");
  798.                 GetNextChar;
  799.             END (*WHILE*);
  800.             IF negativeexp THEN
  801.                 result := result / TenToPower(exponent);
  802.             ELSE
  803.                 result := result * TenToPower(exponent);
  804.             END (*IF*);
  805.         END (*IF*);
  806.  
  807.         IF negative THEN
  808.             result := -result;
  809.         END (*IF*);
  810.         RETURN result;
  811.  
  812.     END StringToLongReal;
  813.  
  814. (************************************************************************)
  815.  
  816. PROCEDURE StringToReal (string: ARRAY OF CHAR): REAL;
  817.  
  818.     (* Like StringToLongReal except for the result type.        *)
  819.  
  820.     BEGIN
  821.         RETURN VAL(REAL,StringToLongReal(string));
  822.     END StringToReal;
  823.  
  824. (************************************************************************)
  825.  
  826. END Conversions.
  827.  
  828.