home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / source / Library / Out2.mod < prev    next >
Encoding:
Text File  |  1995-06-29  |  4.1 KB  |  189 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: Out2.mod $
  4.   Description: Extensions to module Out.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.4 $
  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.   Log entries are at the end of the file.
  16.  
  17. *************************************************************************)
  18.  
  19. <* STANDARD- *>
  20.  
  21. MODULE Out2;
  22.  
  23. IMPORT Kernel, d := Dos, conv := Conversions, str := Strings, Reals, Out;
  24.  
  25.  
  26. PROCEDURE Bin * ( x : LONGINT; n : INTEGER );
  27.  
  28.   VAR s : ARRAY 33 OF CHAR; len : INTEGER;
  29.  
  30. BEGIN (* Bin *)
  31.   IF conv.IntToStr (x, 2, 0, " ", s) THEN
  32.     len := str.Length (s);
  33.     WHILE n > len DO Out.Char (" "); DEC (n) END;
  34.     Out.String (s);
  35.   END
  36. END Bin;
  37.  
  38.  
  39. PROCEDURE Oct * ( x : LONGINT; n : INTEGER );
  40.  
  41.   VAR s : ARRAY 13 OF CHAR; len : INTEGER;
  42.  
  43. BEGIN (* Oct *)
  44.   IF conv.IntToStr (x, 8, 0, " ", s) THEN
  45.     len := str.Length (s);
  46.     WHILE n > len DO Out.Char (" "); DEC (n) END;
  47.     Out.String (s);
  48.   END
  49. END Oct;
  50.  
  51.  
  52. PROCEDURE Hex * ( x : LONGINT; n : INTEGER );
  53.  
  54.   VAR s : ARRAY 10 OF CHAR; len : INTEGER;
  55.  
  56. BEGIN (* Hex *)
  57.   IF conv.IntToStr (x, 16, 0, " ", s) THEN
  58.     len := str.Length (s);
  59.     WHILE n > len DO Out.Char (" "); DEC (n) END;
  60.     Out.String (s);
  61.   END
  62. END Hex;
  63.  
  64.  
  65. PROCEDURE RealFix * ( x : REAL; n, k : INTEGER );
  66.  
  67.   CONST maxD = 9;
  68.  
  69.   VAR e, i : INTEGER; sign : CHAR; x0 : REAL; d : ARRAY maxD OF CHAR;
  70.  
  71.   (*------------------------------------*)
  72.   PROCEDURE seq ( ch : CHAR; n : LONGINT );
  73.  
  74.   BEGIN (* seq *)
  75.     WHILE n > 0 DO Out.Char (ch); DEC (n) END
  76.   END seq;
  77.  
  78.   (*------------------------------------*)
  79.   PROCEDURE dig (n : INTEGER);
  80.  
  81.   BEGIN (* dig *)
  82.     WHILE n > 0 DO
  83.       DEC (i); Out.Char (d [i]); DEC (n)
  84.     END;
  85.   END dig;
  86.  
  87. BEGIN (* RealFix *)
  88.   e := Reals.Expo (x);
  89.   IF k < 0 THEN k := 0 END;
  90.   IF e = 0 THEN
  91.     seq (" ", n - k - 2); Out.Char ("0"); seq (" ", k + 1)
  92.   ELSIF e = 255 THEN
  93.     Out.String ("NaN"); seq (" ", n - 4)
  94.   ELSE
  95.     e := (e - 127) * 77 DIV 256;
  96.     IF x < 0.0 THEN sign := "-"; x := -x ELSE sign := " " END;
  97.     IF e >= 0 THEN (* x >= 1.0, 77/256 = log 2 *) x := x / Reals.Ten (e)
  98.     ELSE (* x < 1.0 *) x := Reals.Ten (-e) * x
  99.     END;
  100.     IF x >= 10.0 THEN x := 0.1 * x; INC (e) END;
  101.     (* 1 <= x < 10 *)
  102.     IF k + e >= maxD - 1 THEN k := maxD - 1 - e
  103.     ELSIF k + e < 0 THEN k := -e; x := 0.0
  104.     END;
  105.     x0 := Reals.Ten (k + e); x := x0 * x + 0.5;
  106.     IF x >= 10.0 * x0 THEN INC (e) END;
  107.     (* e = no. of digits before decimal point *)
  108.     INC (e); i := k + e; Reals.Convert (x, i, d);
  109.     IF e > 0 THEN
  110.       seq (" ", n - e - k - 2); Out.Char (sign); dig (e); Out.Char (".");
  111.       dig (k)
  112.     ELSE
  113.       seq (" ", n - k - 3); Out.Char (sign); Out.Char ("0"); Out.Char (".");
  114.       seq ("0", -e); dig (k + e)
  115.     END
  116.   END
  117. END RealFix;
  118.  
  119.  
  120. PROCEDURE RealHex * ( x : REAL );
  121.  
  122.   VAR d : ARRAY 9 OF CHAR;
  123.  
  124. BEGIN (* RealHex *)
  125.   Reals.ConvertH (x, d); d [8] := 0X; Out.String (d)
  126. END RealHex;
  127.  
  128.  
  129. PROCEDURE LongRealFix * ( x : LONGREAL; n, k : INTEGER );
  130. BEGIN (* LongRealFix *)
  131.   RealFix (SHORT (x), n, k)
  132. END LongRealFix;
  133.  
  134.  
  135. PROCEDURE LongRealHex * ( x : LONGREAL );
  136. BEGIN (* LongRealHex *)
  137.   RealHex (SHORT (x))
  138. END LongRealHex;
  139.  
  140.  
  141. PROCEDURE Set * ( x : SET );
  142.  
  143.   VAR i : INTEGER; first : BOOLEAN;
  144.  
  145. BEGIN (* Set *)
  146.   Out.Char ("{");
  147.   i := 0; first := TRUE;
  148.   FOR i := 0 TO 31 DO
  149.     IF i IN x THEN
  150.       IF ~first THEN Out.Char (",") ELSE first := FALSE END;
  151.       Out.Int (i, 0)
  152.     END
  153.   END;
  154.   Out.Char ("}");
  155. END Set;
  156.  
  157.  
  158. PROCEDURE Bool * ( x : BOOLEAN );
  159. BEGIN (* Bool *)
  160.   IF x THEN Out.String ("TRUE") ELSE Out.String ("FALSE") END
  161. END Bool;
  162.  
  163.  
  164. PROCEDURE Pair ( ch : CHAR; x : LONGINT );
  165. BEGIN (* Pair *)
  166.   Out.Char (ch);
  167.   Out.Char (CHR (x DIV 10 + 30H));
  168.   Out.Char (CHR (x MOD 10 + 30H))
  169. END Pair;
  170.  
  171.  
  172. PROCEDURE Time * ( t : LONGINT );
  173. BEGIN (* Time *)
  174.   Pair (" ", t DIV 4096 MOD 32);
  175.   Pair (":", t DIV 64 MOD 64);
  176.   Pair (":", t MOD 64);
  177. END Time;
  178.  
  179.  
  180. PROCEDURE Date * ( t, d : LONGINT );
  181. BEGIN (* Date *)
  182.   Pair (" ", d MOD 32);
  183.   Pair (".", d DIV 32 MOD 16);
  184.   Pair (".", d DIV 512 MOD 128);
  185.   Time (t)
  186. END Date;
  187.  
  188. END Out2.
  189.