Subversion Repositories Kolibri OS

Rev

Rev 7983 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 7983 Rev 8097
Line 1... Line 1...
1 
(*
 1 
(*
2 
    Copyright 2013, 2014, 2017, 2018, 2019 Anton Krotov
 2 
    BSD 2-Clause License
Line 3... Line -...
3 
 
 - 
 
4 
    This program is free software: you can redistribute it and/or modify
 - 
 
5 
    it under the terms of the GNU Lesser General Public License as published by
 - 
 
6 
    the Free Software Foundation, either version 3 of the License, or
 3 
 
7 
    (at your option) any later version.
 - 
 
8 
 
 - 
 
9 
    This program is distributed in the hope that it will be useful,
 - 
 
10 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 - 
 
11 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 4 
    Copyright (c) 2020, Anton Krotov
12 
    GNU Lesser General Public License for more details.
 - 
 
13 
 
 - 
 
14 
    You should have received a copy of the GNU Lesser General Public License
 - 
 
15 
    along with this program.  If not, see .
 5 
    All rights reserved.
Line 16... Line 6...
16 
*)
 6 
*)
Line 17... Line 7...
17 
 
 7 
 
18 
MODULE Out;
 - 
 
19 
 
 - 
 
Line 20... Line -...
20 
IMPORT sys := SYSTEM, API;
 - 
 
Line 21... Line 8...
21 
 
 8 
MODULE Out;
Line -... Line 9...
- 
 
 9 
 
22 
CONST
 10 
IMPORT SYSTEM, Libdl;
- 
 
 11 
 
Line 23... Line 12...
23 
 
 12 
 
24 
  d = 1.0 - 5.0E-12;
 13 
VAR
25 
 
 14 
 
26 
VAR
 15 
    printf1: PROCEDURE [linux] (fmt: INTEGER; x: INTEGER);
Line 27... Line 16...
27 
 
 16 
    printf2: PROCEDURE [linux] (fmt: INTEGER; width, x: INTEGER);
28 
  Realp: PROCEDURE (x: REAL; width: INTEGER);
 - 
 
29 
 
 - 
 
30 
 
 - 
 
31 
PROCEDURE Char*(x: CHAR);
 17 
    printf3: PROCEDURE [linux] (fmt: INTEGER; width, precision: INTEGER; x: REAL);
32 
BEGIN
 - 
 
33 
    API.putc(x)
 18 
 
34 
END Char;
 - 
 
35 
 
 - 
 
36 
 
 - 
 
37 
PROCEDURE String*(s: ARRAY OF CHAR);
 19 
 
Line 38... Line 20...
38 
VAR
 20 
PROCEDURE Char* (x: CHAR);
39 
    i: INTEGER;
 - 
 
40 
 
 21 
BEGIN
41 
BEGIN
 - 
 
42 
    i := 0;
 - 
 
43 
    WHILE (i < LEN(s)) & (s[i] # 0X) DO
 - 
 
44 
        Char(s[i]);
 - 
 
45 
        INC(i)
 - 
 
46 
    END
 - 
 
47 
END String;
 - 
 
48 
 
 - 
 
49 
 
 - 
 
50 
PROCEDURE WriteInt(x, n: INTEGER);
 - 
 
51 
VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN;
 22 
    printf1(SYSTEM.SADR("%c"), ORD(x))
52 
BEGIN
 - 
 
53 
  i := 0;
 - 
 
54 
  IF n < 1 THEN
 - 
 
55 
    n := 1
 - 
 
56 
  END;
 - 
 
57 
  IF x < 0 THEN
 - 
 
58 
    x := -x;
 - 
 
59 
    DEC(n);
 - 
 
60 
    neg := TRUE
 - 
 
61 
  END;
 - 
 
62 
  REPEAT
 - 
 
63 
    a[i] := CHR(x MOD 10 + ORD("0"));
 - 
 
64 
    x := x DIV 10;
 - 
 
65 
    INC(i)
 - 
 
66 
  UNTIL x = 0;
 23 
END Char;
Line 67... Line -...
67 
  WHILE n > i DO
 - 
 
68 
    Char(" ");
 - 
 
69 
    DEC(n)
 - 
 
70 
  END;
 - 
 
71 
  IF neg THEN
 - 
 
72 
    Char("-")
 - 
 
73 
  END;
 - 
 
74 
  REPEAT
 - 
 
75 
    DEC(i);
 - 
 
76 
    Char(a[i])
 - 
 
77 
  UNTIL i = 0
 - 
 
Line 78... Line 24...
78 
END WriteInt;
 24 
 
79 
 
 - 
 
80 
PROCEDURE IsNan(AValue: REAL): BOOLEAN;
 25 
 
81 
VAR h, l: SET;
 - 
 
82 
BEGIN
 26 
PROCEDURE String* (s: ARRAY OF CHAR);
83 
  sys.GET(sys.ADR(AValue), l);
 - 
 
84 
  sys.GET(sys.ADR(AValue) + 4, h)
 - 
 
85 
  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
 - 
 
86 
END IsNan;
 - 
 
87 
 
 - 
 
88 
PROCEDURE IsInf(x: REAL): BOOLEAN;
 - 
 
89 
  RETURN ABS(x) = sys.INF()
 27 
BEGIN
Line 90... Line -...
90 
END IsInf;
 - 
 
91 
 
 - 
 
92 
PROCEDURE Int*(x, width: INTEGER);
 - 
 
93 
VAR i: INTEGER;
 - 
 
94 
BEGIN
 - 
 
95 
  IF x # 80000000H THEN
 - 
 
96 
    WriteInt(x, width)
 - 
 
97 
  ELSE
 - 
 
98 
    FOR i := 12 TO width DO
 - 
 
99 
      Char(20X)
 - 
 
100 
    END;
 - 
 
101 
    String("-2147483648")
 - 
 
102 
  END
 - 
 
103 
END Int;
 - 
 
104 
 
 - 
 
105 
PROCEDURE OutInf(x: REAL; width: INTEGER);
 - 
 
106 
VAR s: ARRAY 5 OF CHAR; i: INTEGER;
 - 
 
107 
BEGIN
 - 
 
108 
  IF IsNan(x) THEN
 - 
 
109 
    s := "Nan";
 - 
 
110 
    INC(width)
 - 
 
111 
  ELSIF IsInf(x) & (x > 0.0) THEN
 - 
 
112 
    s := "+Inf"
 - 
 
113 
  ELSIF IsInf(x) & (x < 0.0) THEN
 - 
 
114 
    s := "-Inf"
 - 
 
115 
  END;
 - 
 
116 
  FOR i := 1 TO width - 4 DO
 - 
 
117 
    Char(" ")
 - 
 
118 
  END;
 - 
 
119 
  String(s)
 - 
 
120 
END OutInf;
 - 
 
121 
 
 - 
 
122 
PROCEDURE Ln*;
 - 
 
123 
BEGIN
 - 
 
124 
  Char(0AX)
 - 
 
125 
END Ln;
 - 
 
126 
 
 - 
 
127 
PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
 - 
 
128 
VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
 - 
 
129 
BEGIN
 - 
 
130 
  IF IsNan(x) OR IsInf(x) THEN
 - 
 
131 
    OutInf(x, width)
 - 
 
132 
  ELSIF p < 0 THEN
 - 
 
133 
    Realp(x, width)
 - 
 
134 
  ELSE
 - 
 
135 
    len := 0;
 - 
 
136 
    minus := FALSE;
 - 
 
137 
    IF x < 0.0 THEN
 - 
 
138 
      minus := TRUE;
 - 
 
139 
      INC(len);
 - 
 
140 
      x := ABS(x)
 - 
 
141 
    END;
 - 
 
142 
    e := 0;
 - 
 
143 
    WHILE x >= 10.0 DO
 - 
 
144 
      x := x / 10.0;
 - 
 
145 
      INC(e)
 - 
 
146 
    END;
 - 
 
147 
 
 - 
 
148 
    IF e >= 0 THEN
 - 
 
149 
      len := len + e + p + 1;
 - 
 
150 
      IF x > 9.0 + d THEN
 - 
 
151 
        INC(len)
 - 
 
152 
      END;
 - 
 
153 
      IF p > 0 THEN
 - 
 
154 
        INC(len)
 - 
 
155 
      END;
 - 
 
156 
    ELSE
 - 
 
157 
      len := len + p + 2
 - 
 
158 
    END;
 - 
 
159 
    FOR i := 1 TO width - len DO
 - 
 
160 
      Char(" ")
 - 
 
161 
    END;
 - 
 
162 
    IF minus THEN
 - 
 
163 
      Char("-")
 - 
 
164 
    END;
 - 
 
165 
    y := x;
 - 
 
166 
    WHILE (y < 1.0) & (y # 0.0) DO
 - 
 
167 
      y := y * 10.0;
 - 
 
168 
      DEC(e)
 - 
 
169 
    END;
 - 
 
170 
    IF e < 0 THEN
 - 
 
171 
      IF x - FLT(FLOOR(x)) > d THEN
 - 
 
172 
        Char("1");
 - 
 
173 
        x := 0.0
 - 
 
174 
      ELSE
 - 
 
175 
        Char("0");
 - 
 
176 
        x := x * 10.0
 - 
 
177 
      END
 - 
 
178 
    ELSE
 - 
 
179 
      WHILE e >= 0 DO
 - 
 
180 
        IF x - FLT(FLOOR(x)) > d THEN
 - 
 
181 
          IF x > 9.0 THEN
 - 
 
182 
            String("10")
 - 
 
183 
          ELSE
 - 
 
184 
            Char(CHR(FLOOR(x) + ORD("0") + 1))
 - 
 
185 
          END;
 - 
 
186 
          x := 0.0
 - 
 
187 
        ELSE
 - 
 
188 
          Char(CHR(FLOOR(x) + ORD("0")));
 - 
 
189 
          x := (x - FLT(FLOOR(x))) * 10.0
 - 
 
190 
        END;
 - 
 
191 
        DEC(e)
 - 
 
192 
      END
 - 
 
193 
    END;
 - 
 
Line 194... Line 28...
194 
    IF p > 0 THEN
 28 
    printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0]))
195 
      Char(".")
 - 
 
196 
    END;
 29 
END String;
197 
    WHILE p > 0 DO
 - 
 
198 
      IF x - FLT(FLOOR(x)) > d THEN
 - 
 
199 
        Char(CHR(FLOOR(x) + ORD("0") + 1));
 - 
 
200 
        x := 0.0
 - 
 
201 
      ELSE
 - 
 
202 
        Char(CHR(FLOOR(x) + ORD("0")));
 - 
 
203 
        x := (x - FLT(FLOOR(x))) * 10.0
 - 
 
204 
      END;
 - 
 
205 
      DEC(p)
 - 
 
206 
    END
 - 
 
207 
  END
 - 
 
208 
END _FixReal;
 - 
 
209 
 
 - 
 
210 
PROCEDURE Real*(x: REAL; width: INTEGER);
 - 
 
211 
VAR e, n, i: INTEGER; minus: BOOLEAN;
 - 
 
212 
BEGIN
 - 
 
213 
  Realp := Real;
 - 
 
214 
  IF IsNan(x) OR IsInf(x) THEN
 - 
 
215 
    OutInf(x, width)
 - 
 
216 
  ELSE
 - 
 
217 
    e := 0;
 - 
 
218 
    n := 0;
 - 
 
219 
    IF width > 23 THEN
 - 
 
220 
      n := width - 23;
 - 
 
221 
      width := 23
 - 
 
222 
    ELSIF width < 9 THEN
 - 
 
223 
      width := 9
 - 
 
224 
    END;
 - 
 
225 
    width := width - 5;
 - 
 
226 
    IF x < 0.0 THEN
 - 
 
227 
      x := -x;
 - 
 
228 
      minus := TRUE
 - 
 
229 
    ELSE
 - 
 
230 
      minus := FALSE
 - 
 
231 
    END;
 - 
 
232 
    WHILE x >= 10.0 DO
 - 
 
233 
      x := x / 10.0;
 - 
 
234 
      INC(e)
 30 
 
235 
    END;
 - 
 
236 
    WHILE (x < 1.0) & (x # 0.0) DO
 - 
 
237 
      x := x * 10.0;
 - 
 
238 
      DEC(e)
 - 
 
239 
    END;
 - 
 
240 
    IF x > 9.0 + d THEN
 - 
 
241 
      x := 1.0;
 - 
 
242 
      INC(e)
 - 
 
243 
    END;
 - 
 
244 
    FOR i := 1 TO n DO
 - 
 
245 
      Char(" ")
 - 
 
246 
    END;
 - 
 
247 
    IF minus THEN
 - 
 
248 
      x := -x
 - 
 
249 
    END;
 - 
 
250 
    _FixReal(x, width, width - 3);
 31 
 
Line -... Line 32...
- 
 
 32 
PROCEDURE Ln*;
251 
    Char("E");
 33 
BEGIN
252 
    IF e >= 0 THEN
 34 
    printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(0AX))
253 
      Char("+")
 - 
 
254 
    ELSE
 35 
END Ln;
255 
      Char("-");
 36 
 
Line -... Line 37...
- 
 
 37 
 
256 
      e := ABS(e)
 38 
PROCEDURE Int* (x, width: INTEGER);
257 
    END;
 39 
BEGIN
Line -... Line 40...
- 
 
 40 
    printf2(SYSTEM.SADR("%*d"), width, x)
- 
 
 41 
END Int;
- 
 
 42 
 
- 
 
 43 
 
- 
 
 44 
PROCEDURE Real* (x: REAL; width: INTEGER);
- 
 
 45 
BEGIN
- 
 
 46 
    printf3(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), x)
- 
 
 47 
END Real;
- 
 
 48 
 
- 
 
 49 
 
- 
 
 50 
PROCEDURE FixReal* (x: REAL; width, precision: INTEGER);
- 
 
 51 
BEGIN
- 
 
 52 
    printf3(SYSTEM.SADR("%*.*f"), width, precision, x)
- 
 
 53 
END FixReal;
- 
 
 54 
 
- 
 
 55 
 
- 
 
 56 
PROCEDURE Open*;
- 
 
 57 
END Open;
258 
    IF e < 100 THEN
 58 
 
259 
      Char("0")
 59