home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / dev / obero / oberon-a / source / library / out.mod < prev    next >
Encoding:
Text File  |  1995-06-29  |  3.2 KB  |  140 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: Out.mod $
  4.   Description: Formatted output on the standard output stream.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.3 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 00:40:27 $
  10.  
  11.   Copyright © 1994-1995, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. <* STANDARD- *>
  18.  
  19. MODULE Out;
  20.  
  21. (**
  22. ** Extracts from the Oakwood Report are enclosed in quotes.
  23. **
  24. ** "Module Out provides a set of basic routines for formatted output of
  25. ** characters, numbers and strings. It assumes a standard output stream
  26. ** to which the symbols are written."
  27. *)
  28.  
  29. IMPORT Dos, DosUtil, WbConsole, Reals;
  30.  
  31.  
  32. PROCEDURE Open*;
  33.  
  34.   VAR ignore : LONGINT;
  35.  
  36. BEGIN (* Open *)
  37.   IF Dos.Flush (Dos.Output()) THEN
  38.     ignore := Dos.Seek (Dos.Output(), 0, Dos.beginning)
  39.   END;
  40. END Open;
  41.  
  42.  
  43. PROCEDURE Write ( ch : CHAR );
  44. BEGIN (* Write *)
  45.   Dos.PrintF ("%lc", ch)
  46. END Write;
  47.  
  48.  
  49. PROCEDURE Char* ( ch : CHAR );
  50.  
  51. BEGIN (* Char *)
  52.   DosUtil.HaltIfBreak ({Dos.ctrlC});
  53.   Write (ch); IF Dos.Flush (Dos.Output()) THEN END
  54. END Char;
  55.  
  56.  
  57. PROCEDURE String* ( str : ARRAY OF CHAR );
  58.  
  59.   VAR ignore : LONGINT;
  60.  
  61. <*$CopyArrays-*>
  62. BEGIN (* String *)
  63.   DosUtil.HaltIfBreak ({Dos.ctrlC});
  64.   ignore := Dos.PutStr (str); IF Dos.Flush (Dos.Output()) THEN END
  65. END String;
  66.  
  67.  
  68. PROCEDURE Int* ( x, n : LONGINT );
  69.  
  70.   VAR i : INTEGER; x0 : LONGINT; a : ARRAY 11 OF CHAR;
  71.  
  72. BEGIN (* Int *)
  73.   DosUtil.HaltIfBreak ({Dos.ctrlC});
  74.   i := 0;
  75.   IF x < 0 THEN
  76.     IF x = MIN (LONGINT) THEN String (" -2147483648"); RETURN
  77.     ELSE DEC (n); x0 := -x
  78.     END
  79.   ELSE x0 := x
  80.   END;
  81.   REPEAT a [i] := CHR (x0 MOD 10 + 30H); x0 := x0 DIV 10; INC (i)
  82.   UNTIL x0 = 0;
  83.   WHILE n > i DO Write (" "); DEC (n) END;
  84.   IF x < 0 THEN Write ("-") END;
  85.   REPEAT DEC (i); Write (a [i]) UNTIL i = 0;
  86.   IF Dos.Flush (Dos.Output()) THEN END
  87. END Int;
  88.  
  89.  
  90. PROCEDURE Real* ( x : REAL; n : INTEGER );
  91.  
  92.   CONST maxD = 32;
  93.  
  94.   VAR e : INTEGER; x0 : REAL; d : ARRAY maxD OF CHAR;
  95.  
  96. BEGIN (* Real *)
  97.   DosUtil.HaltIfBreak ({Dos.ctrlC});
  98.   e := Reals.Expo (x);
  99.   IF e = 0 THEN
  100.     Write ("0");
  101.     REPEAT Write (" "); DEC (n) UNTIL n <= 3
  102.   ELSIF e = 255 THEN
  103.     String ("NaN");
  104.     WHILE n > 4 DO Write (" "); DEC (n) END
  105.   ELSE
  106.     IF n <= 9 THEN n := 3 ELSE DEC (n, 6) END;
  107.     REPEAT Write (" "); DEC (n) UNTIL n <= 8;
  108.     (* there are 2 < n <= 8 digits to be written *)
  109.     IF x < 0.0 THEN Write ("-"); x := -x ELSE Write (" ") END;
  110.     e := (e - 127) * 77 DIV 256;
  111.     IF e >= 0 THEN x := x / Reals.Ten (e) ELSE x := Reals.Ten (-e) * x END;
  112.     IF x >= 10.0 THEN x := 0.1 * x; INC (e) END;
  113.     x0 := Reals.Ten (n - 1); x := x0 * x + 0.5;
  114.     IF x >= 10.0 * x0 THEN x := x * 0.1; INC (e) END;
  115.     Reals.Convert (x, n, d);
  116.     DEC (n); Write (d [n]); Write (".");
  117.     REPEAT DEC (n); Write (d [n]) UNTIL n = 0;
  118.     Write ("E");
  119.     IF e < 0 THEN Write ("-"); e := -e ELSE Write ("+") END;
  120.     Write (CHR (e DIV 10 + 30H)); Write (CHR (e MOD 10 + 30H))
  121.   END;
  122.   IF Dos.Flush (Dos.Output()) THEN END
  123. END Real;
  124.  
  125.  
  126. PROCEDURE LongReal* ( x : LONGREAL; n : INTEGER );
  127.  
  128. BEGIN (* LongReal *)
  129.   Real (SHORT(x), n)
  130. END LongReal;
  131.  
  132.  
  133. PROCEDURE Ln*;
  134.  
  135. BEGIN (* Ln *)
  136.   Char (0AX)
  137. END Ln;
  138.  
  139. END Out.
  140.