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, x: INTEGER);
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 24 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])
 - 
 
Line 77... Line 24...
77 
  UNTIL i = 0
 24 
 
78 
END WriteInt;
 - 
 
79 
 
 25 
 
80 
PROCEDURE IsNan(AValue: REAL): BOOLEAN;
 - 
 
81 
VAR s: SET;
 26 
PROCEDURE String* (s: ARRAY OF CHAR);
82 
BEGIN
 - 
 
83 
  sys.GET(sys.ADR(AValue), s)
 - 
 
84 
  RETURN (s * {52..62} = {52..62}) & ((s * {32..51} # {}) OR (s * {0..31} # {}))
 - 
 
85 
END IsNan;
 - 
 
86 
 
 - 
 
87 
PROCEDURE IsInf(x: REAL): BOOLEAN;
 - 
 
88 
  RETURN ABS(x) = sys.INF()
 27 
BEGIN
Line 89... Line -...
89 
END IsInf;
 - 
 
90 
 
 - 
 
91 
PROCEDURE Int*(x, width: INTEGER);
 - 
 
92 
VAR i: INTEGER;
 - 
 
93 
BEGIN
 - 
 
94 
  IF x # 80000000H THEN
 - 
 
95 
    WriteInt(x, width)
 - 
 
96 
  ELSE
 - 
 
97 
    FOR i := 12 TO width DO
 - 
 
98 
      Char(20X)
 - 
 
99 
    END;
 - 
 
100 
    String("-2147483648")
 - 
 
101 
  END
 - 
 
102 
END Int;
 - 
 
103 
 
 - 
 
104 
PROCEDURE OutInf(x: REAL; width: INTEGER);
 - 
 
Line 105... Line 28...
105 
VAR s: ARRAY 5 OF CHAR; i: INTEGER;
 28 
    printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0]))
106 
BEGIN
 29 
END String;
107 
  IF IsNan(x) THEN
 30 
 
108 
    s := "Nan";
 - 
 
Line 109... Line -...
109 
    INC(width)
 - 
 
110 
  ELSIF IsInf(x) & (x > 0.0) THEN
 - 
 
111 
    s := "+Inf"
 31 
 
112 
  ELSIF IsInf(x) & (x < 0.0) THEN
 32 
PROCEDURE Ln*;
113 
    s := "-Inf"
 - 
 
114 
  END;
 - 
 
115 
  FOR i := 1 TO width - 4 DO
 - 
 
116 
    Char(" ")
 - 
 
117 
  END;
 - 
 
118 
  String(s)
 - 
 
119 
END OutInf;
 - 
 
120 
 
 - 
 
121 
PROCEDURE Ln*;
 - 
 
122 
BEGIN
 - 
 
123 
  Char(0AX)
 33 
BEGIN
124 
END Ln;
 34 
    printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(0AX))
125 
 
 - 
 
126 
PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
 - 
 
127 
VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
 - 
 
128 
BEGIN
 - 
 
129 
  IF IsNan(x) OR IsInf(x) THEN
 35 
END Ln;
130 
    OutInf(x, width)
 - 
 
131 
  ELSIF p < 0 THEN
 - 
 
132 
    Realp(x, width)
 - 
 
133 
  ELSE
 - 
 
134 
    len := 0;
 - 
 
135 
    minus := FALSE;
 - 
 
136 
    IF x < 0.0 THEN
 - 
 
137 
      minus := TRUE;
 - 
 
138 
      INC(len);
 - 
 
139 
      x := ABS(x)
 - 
 
140 
    END;
 - 
 
141 
    e := 0;
 - 
 
142 
    WHILE x >= 10.0 DO
 - 
 
143 
      x := x / 10.0;
 - 
 
144 
      INC(e)
 - 
 
145 
    END;
 - 
 
146 
 
 - 
 
147 
    IF e >= 0 THEN
 - 
 
148 
      len := len + e + p + 1;
 - 
 
149 
      IF x > 9.0 + d THEN
 - 
 
150 
        INC(len)
 - 
 
151 
      END;
 - 
 
152 
      IF p > 0 THEN
 - 
 
153 
        INC(len)
 - 
 
154 
      END;
 - 
 
155 
    ELSE
 - 
 
156 
      len := len + p + 2
 - 
 
157 
    END;
 - 
 
158 
    FOR i := 1 TO width - len DO
 - 
 
159 
      Char(" ")
 - 
 
160 
    END;
 - 
 
161 
    IF minus THEN
 - 
 
162 
      Char("-")
 - 
 
163 
    END;
 - 
 
164 
    y := x;
 - 
 
165 
    WHILE (y < 1.0) & (y # 0.0) DO
 - 
 
166 
      y := y * 10.0;
 - 
 
167 
      DEC(e)
 - 
 
168 
    END;
 - 
 
169 
    IF e < 0 THEN
 - 
 
170 
      IF x - FLT(FLOOR(x)) > d THEN
 - 
 
171 
        Char("1");
 - 
 
172 
        x := 0.0
 - 
 
173 
      ELSE
 - 
 
174 
        Char("0");
 - 
 
175 
        x := x * 10.0
 - 
 
176 
      END
 - 
 
177 
    ELSE
 - 
 
178 
      WHILE e >= 0 DO
 - 
 
179 
        IF x - FLT(FLOOR(x)) > d THEN
 - 
 
180 
          IF x > 9.0 THEN
 - 
 
181 
            String("10")
 - 
 
182 
          ELSE
 - 
 
183 
            Char(CHR(FLOOR(x) + ORD("0") + 1))
 - 
 
184 
          END;
 - 
 
185 
          x := 0.0
 - 
 
186 
        ELSE
 - 
 
187 
          Char(CHR(FLOOR(x) + ORD("0")));
 - 
 
188 
          x := (x - FLT(FLOOR(x))) * 10.0
 - 
 
189 
        END;
 - 
 
190 
        DEC(e)
 - 
 
Line 191... Line 36...
191 
      END
 36 
 
192 
    END;
 - 
 
193 
    IF p > 0 THEN
 37 
 
194 
      Char(".")
 - 
 
195 
    END;
 - 
 
196 
    WHILE p > 0 DO
 - 
 
197 
      IF x - FLT(FLOOR(x)) > d THEN
 - 
 
198 
        Char(CHR(FLOOR(x) + ORD("0") + 1));
 - 
 
199 
        x := 0.0
 - 
 
200 
      ELSE
 - 
 
201 
        Char(CHR(FLOOR(x) + ORD("0")));
 - 
 
202 
        x := (x - FLT(FLOOR(x))) * 10.0
 - 
 
203 
      END;
 - 
 
204 
      DEC(p)
 - 
 
205 
    END
 - 
 
206 
  END
 - 
 
207 
END _FixReal;
 - 
 
208 
 
 - 
 
209 
PROCEDURE Real*(x: REAL; width: INTEGER);
 - 
 
210 
VAR e, n, i: INTEGER; minus: BOOLEAN;
 - 
 
211 
BEGIN
 - 
 
212 
  Realp := Real;
 - 
 
213 
  IF IsNan(x) OR IsInf(x) THEN
 - 
 
214 
    OutInf(x, width)
 - 
 
215 
  ELSE
 - 
 
216 
    e := 0;
 - 
 
217 
    n := 0;
 - 
 
218 
    IF width > 23 THEN
 - 
 
219 
      n := width - 23;
 - 
 
220 
      width := 23
 - 
 
221 
    ELSIF width < 9 THEN
 - 
 
222 
      width := 9
 - 
 
223 
    END;
 - 
 
224 
    width := width - 5;
 - 
 
225 
    IF x < 0.0 THEN
 - 
 
226 
      x := -x;
 - 
 
227 
      minus := TRUE
 - 
 
228 
    ELSE
 - 
 
229 
      minus := FALSE
 - 
 
230 
    END;
 - 
 
231 
    WHILE x >= 10.0 DO
 38 
PROCEDURE Int* (x, width: INTEGER);
232 
      x := x / 10.0;
 - 
 
233 
      INC(e)
 - 
 
234 
    END;
 - 
 
235 
    WHILE (x < 1.0) & (x # 0.0) DO
 - 
 
236 
      x := x * 10.0;
 - 
 
237 
      DEC(e)
 - 
 
238 
    END;
 - 
 
239 
    IF x > 9.0 + d THEN
 - 
 
240 
      x := 1.0;
 - 
 
241 
      INC(e)
 - 
 
242 
    END;
 - 
 
243 
    FOR i := 1 TO n DO
 - 
 
244 
      Char(" ")
 - 
 
245 
    END;
 - 
 
246 
    IF minus THEN
 - 
 
247 
      x := -x
 39 
BEGIN
Line -... Line 40...
- 
 
 40 
    printf2(SYSTEM.SADR("%*lld"), width, x)
248 
    END;
 41 
END Int;
249 
    _FixReal(x, width, width - 3);
 42 
 
250 
    Char("E");
 - 
 
251 
    IF e >= 0 THEN
 43 
 
252 
      Char("+")
 44 
PROCEDURE intval (x: REAL): INTEGER;
Line -... Line 45...
- 
 
 45 
VAR
253 
    ELSE
 46 
    i: INTEGER;
254 
      Char("-");
 47 
 
Line -... Line 48...
- 
 
 48 
BEGIN
- 
 
 49 
    SYSTEM.GET(SYSTEM.ADR(x), i)
- 
 
 50 
    RETURN i
- 
 
 51 
END intval;
- 
 
 52 
 
- 
 
 53 
 
- 
 
 54 
PROCEDURE Real* (x: REAL; width: INTEGER);
- 
 
 55 
BEGIN
- 
 
 56 
    printf3(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), intval(x))
- 
 
 57 
END Real;
- 
 
 58 
 
- 
 
 59 
 
- 
 
 60 
PROCEDURE FixReal* (x: REAL; width, precision: INTEGER);
- 
 
 61 
BEGIN
- 
 
 62 
    printf3(SYSTEM.SADR("%*.*f"), width, precision, intval(x))
- 
 
 63 
END FixReal;
- 
 
 64 
 
- 
 
 65 
 
255 
      e := ABS(e)
 66 
PROCEDURE Open*;
256 
    END;
 67 
END Open;