home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / SRC / CONVERSI.MOD < prev    next >
Text File  |  1996-10-09  |  30KB  |  795 lines

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