srealio.mod 1.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475
  1. IMPLEMENTATION MODULE SRealIO;
  2. IMPORT IOConsts, SIOResult;
  3. FROM IOConsts IMPORT allRight;
  4. PROCEDURE m2realconv (x : REAL; mode : INTEGER; prec : INTEGER;
  5. VAR s : ARRAY OF CHAR) : INTEGER;
  6. EXTERNAL;
  7. PROCEDURE m2readreal () : REAL;
  8. EXTERNAL;
  9. PROCEDURE m2writechar (c : CHAR);
  10. EXTERNAL;
  11. PROCEDURE m2write (VAR s : ARRAY OF CHAR);
  12. EXTERNAL;
  13. PROCEDURE StrLen (VAR s : ARRAY OF CHAR) : CARDINAL;
  14. VAR i : CARDINAL;
  15. BEGIN
  16. i := 0;
  17. WHILE (i <= HIGH(s)) AND (s[i] # CHR(0)) DO INC(i) END;
  18. RETURN i
  19. END StrLen;
  20. PROCEDURE WritePadded (VAR s : ARRAY OF CHAR; width : CARDINAL);
  21. VAR n, i : CARDINAL;
  22. BEGIN
  23. n := StrLen(s);
  24. IF width > n THEN
  25. i := width - n;
  26. WHILE i > 0 DO m2writechar(" "); DEC(i) END
  27. END;
  28. m2write(s)
  29. END WritePadded;
  30. PROCEDURE WriteFloat (real : REAL; sigFigs : CARDINAL; width : CARDINAL);
  31. VAR s : ARRAY [0 .. 127] OF CHAR;
  32. n : INTEGER;
  33. BEGIN
  34. n := m2realconv(real, 1, VAL(INTEGER, sigFigs), s);
  35. WritePadded(s, width)
  36. END WriteFloat;
  37. PROCEDURE WriteEng (real : REAL; sigFigs : CARDINAL; width : CARDINAL);
  38. VAR s : ARRAY [0 .. 127] OF CHAR;
  39. n : INTEGER;
  40. BEGIN
  41. n := m2realconv(real, 2, VAL(INTEGER, sigFigs), s);
  42. WritePadded(s, width)
  43. END WriteEng;
  44. PROCEDURE WriteFixed (real : REAL; place : INTEGER; width : CARDINAL);
  45. VAR s : ARRAY [0 .. 127] OF CHAR;
  46. n : INTEGER;
  47. BEGIN
  48. n := m2realconv(real, 0, place, s);
  49. WritePadded(s, width)
  50. END WriteFixed;
  51. PROCEDURE WriteReal (real : REAL; width : CARDINAL);
  52. BEGIN
  53. (* ISO: fixed if it fits, otherwise floating; approximate by
  54. fixed with a width-derived number of places. *)
  55. IF width <= 16 THEN
  56. WriteFixed(real, 6, width)
  57. ELSE
  58. WriteFloat(real, 6, width)
  59. END
  60. END WriteReal;
  61. PROCEDURE ReadReal (VAR real : REAL);
  62. BEGIN
  63. real := m2readreal();
  64. SIOResult.SetReadResult(allRight)
  65. END ReadReal;
  66. END SRealIO.