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 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, WINAPI;
 - 
 
Line 21... Line 8...
21 
 
 8 
MODULE Out;
Line 22... Line 9...
22 
CONST
 9 
 
23 
 
 - 
 
Line 24... Line 10...
24 
  d = 1.0 - 5.0E-12;
 10 
IMPORT SYSTEM;
25 
 
 11 
 
- 
 
 12 
 
26 
VAR
 13 
VAR
- 
 
 14 
 
27 
 
 15 
    hConsoleOutput: INTEGER;
- 
 
 16 
 
28 
  hConsoleOutput: INTEGER;
 17 
 
- 
 
 18 
PROCEDURE [ccall, "msvcrt.dll", "printf"] printf1 (fmt: INTEGER; x: INTEGER);
Line 29... Line -...
29 
  Realp: PROCEDURE (x: REAL; width: INTEGER);
 - 
 
30 
 
 - 
 
31 
 
 - 
 
32 
PROCEDURE String*(s: ARRAY OF CHAR);
 - 
 
33 
VAR count: INTEGER;
 - 
 
Line 34... Line 19...
34 
BEGIN
 19 
PROCEDURE [ccall, "msvcrt.dll", "printf"] printf2 (fmt: INTEGER; width, x: INTEGER);
35 
  WINAPI.WriteFile(hConsoleOutput, sys.ADR(s[0]), LENGTH(s), sys.ADR(count), NIL)
 - 
 
36 
END String;
 20 
PROCEDURE [ccall, "msvcrt.dll", "printf"] printf3 (fmt: INTEGER; width, precision: INTEGER; x: REAL);
37 
 
 21 
 
38 
PROCEDURE StringW*(s: ARRAY OF WCHAR);
 22 
PROCEDURE [windows, "kernel32.dll", ""]
Line 39... Line -...
39 
VAR count: INTEGER;
 - 
 
40 
BEGIN
 - 
 
41 
  WINAPI.WriteConsoleW(hConsoleOutput, sys.ADR(s[0]), LENGTH(s), sys.ADR(count), 0)
 - 
 
42 
END StringW;
 - 
 
43 
 
 - 
 
44 
PROCEDURE Char*(x: CHAR);
 - 
 
45 
VAR count: INTEGER;
 - 
 
46 
BEGIN
 - 
 
47 
  WINAPI.WriteFile(hConsoleOutput, sys.ADR(x), 1, sys.ADR(count), NIL)
 - 
 
48 
END Char;
 - 
 
49 
 
 - 
 
50 
PROCEDURE WriteInt(x, n: INTEGER);
 - 
 
51 
VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN;
 - 
 
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;
 - 
 
67 
  WHILE n > i DO
 - 
 
Line 68... Line 23...
68 
    Char(" ");
 23 
    WriteConsoleW (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER);
69 
    DEC(n)
 - 
 
70 
  END;
 24 
 
71 
  IF neg THEN
 - 
 
72 
    Char("-")
 - 
 
73 
  END;
 25 
PROCEDURE [windows, "kernel32.dll", ""]
74 
  REPEAT
 26 
    GetStdHandle (nStdHandle: INTEGER): INTEGER;
75 
    DEC(i);
 - 
 
76 
    Char(a[i])
 - 
 
77 
  UNTIL i = 0
 - 
 
78 
END WriteInt;
 - 
 
Line 79... Line -...
79 
 
 - 
 
80 
PROCEDURE IsNan(AValue: REAL): BOOLEAN;
 - 
 
81 
VAR h, l: SET;
 - 
 
82 
BEGIN
 - 
 
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()
 - 
 
90 
END IsInf;
 - 
 
Line 91... Line 27...
91 
 
 27 
 
92 
PROCEDURE Int*(x, width: INTEGER);
 - 
 
93 
VAR i: INTEGER;
 28 
 
94 
BEGIN
 - 
 
95 
  IF x # 80000000H THEN
 - 
 
96 
    WriteInt(x, width)
 - 
 
97 
  ELSE
 - 
 
98 
    FOR i := 12 TO width DO
 - 
 
99 
      Char(20X)
 29 
PROCEDURE Char* (x: CHAR);
100 
    END;
 - 
 
101 
    String("-2147483648")
 - 
 
102 
  END
 - 
 
103 
END Int;
 - 
 
104 
 
 - 
 
105 
PROCEDURE OutInf(x: REAL; width: INTEGER);
 30 
BEGIN
106 
VAR s: ARRAY 5 OF CHAR; i: INTEGER;
 31 
    printf1(SYSTEM.SADR("%c"), ORD(x))
Line 107... Line 32...
107 
BEGIN
 32 
END Char;
108 
  IF IsNan(x) THEN
 33 
 
109 
    s := "Nan";
 34 
 
110 
    INC(width)
 - 
 
111 
  ELSIF IsInf(x) & (x > 0.0) THEN
 35 
PROCEDURE StringW* (s: ARRAY OF WCHAR);
Line -... Line 36...
- 
 
 36 
BEGIN
112 
    s := "+Inf"
 37 
    WriteConsoleW(hConsoleOutput, SYSTEM.ADR(s[0]), LENGTH(s), 0, 0)
113 
  ELSIF IsInf(x) & (x < 0.0) THEN
 - 
 
114 
    s := "-Inf"
 38 
END StringW;
115 
  END;
 - 
 
116 
  FOR i := 1 TO width - 4 DO
 39 
 
117 
    Char(" ")
 - 
 
118 
  END;
 - 
 
119 
  String(s)
 - 
 
120 
END OutInf;
 - 
 
121 
 
 - 
 
122 
PROCEDURE Ln*;
 - 
 
123 
BEGIN
 - 
 
124 
  Char(0DX);
 - 
 
125 
  Char(0AX)
 - 
 
126 
END Ln;
 - 
 
127 
 
 - 
 
128 
PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
 - 
 
129 
VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
 - 
 
130 
BEGIN
 - 
 
131 
  IF IsNan(x) OR IsInf(x) THEN
 40 
 
132 
    OutInf(x, width)
 41 
PROCEDURE String* (s: ARRAY OF CHAR);
133 
  ELSIF p < 0 THEN
 - 
 
134 
    Realp(x, width)
 - 
 
135 
  ELSE
 - 
 
136 
    len := 0;
 - 
 
137 
    minus := FALSE;
 - 
 
138 
    IF x < 0.0 THEN
 - 
 
139 
      minus := TRUE;
 - 
 
140 
      INC(len);
 - 
 
141 
      x := ABS(x)
 - 
 
142 
    END;
 - 
 
143 
    e := 0;
 - 
 
144 
    WHILE x >= 10.0 DO
 - 
 
145 
      x := x / 10.0;
 - 
 
146 
      INC(e)
 - 
 
147 
    END;
 - 
 
148 
 
 - 
 
149 
    IF e >= 0 THEN
 - 
 
150 
      len := len + e + p + 1;
 - 
 
151 
      IF x > 9.0 + d THEN
 - 
 
152 
        INC(len)
 - 
 
153 
      END;
 - 
 
154 
      IF p > 0 THEN
 - 
 
155 
        INC(len)
 - 
 
156 
      END;
 - 
 
157 
    ELSE
 - 
 
158 
      len := len + p + 2
 - 
 
159 
    END;
 - 
 
160 
    FOR i := 1 TO width - len DO
 - 
 
161 
      Char(" ")
 - 
 
162 
    END;
 - 
 
163 
    IF minus THEN
 - 
 
164 
      Char("-")
 - 
 
165 
    END;
 - 
 
166 
    y := x;
 - 
 
167 
    WHILE (y < 1.0) & (y # 0.0) DO
 - 
 
168 
      y := y * 10.0;
 - 
 
169 
      DEC(e)
 - 
 
170 
    END;
 - 
 
171 
    IF e < 0 THEN
 - 
 
172 
      IF x - FLT(FLOOR(x)) > d THEN
 - 
 
173 
        Char("1");
 - 
 
174 
        x := 0.0
 - 
 
175 
      ELSE
 - 
 
176 
        Char("0");
 - 
 
177 
        x := x * 10.0
 - 
 
178 
      END
 - 
 
179 
    ELSE
 - 
 
180 
      WHILE e >= 0 DO
 - 
 
181 
        IF x - FLT(FLOOR(x)) > d THEN
 - 
 
182 
          IF x > 9.0 THEN
 - 
 
183 
            String("10")
 - 
 
184 
          ELSE
 - 
 
185 
            Char(CHR(FLOOR(x) + ORD("0") + 1))
 - 
 
186 
          END;
 - 
 
187 
          x := 0.0
 - 
 
188 
        ELSE
 - 
 
189 
          Char(CHR(FLOOR(x) + ORD("0")));
 - 
 
190 
          x := (x - FLT(FLOOR(x))) * 10.0
 - 
 
191 
        END;
 - 
 
192 
        DEC(e)
 - 
 
193 
      END
 - 
 
Line 194... Line 42...
194 
    END;
 42 
BEGIN
195 
    IF p > 0 THEN
 - 
 
196 
      Char(".")
 43 
    printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0]))
197 
    END;
 - 
 
198 
    WHILE p > 0 DO
 - 
 
199 
      IF x - FLT(FLOOR(x)) > d THEN
 - 
 
200 
        Char(CHR(FLOOR(x) + ORD("0") + 1));
 - 
 
201 
        x := 0.0
 - 
 
202 
      ELSE
 - 
 
203 
        Char(CHR(FLOOR(x) + ORD("0")));
 - 
 
204 
        x := (x - FLT(FLOOR(x))) * 10.0
 - 
 
205 
      END;
 - 
 
206 
      DEC(p)
 - 
 
207 
    END
 - 
 
208 
  END
 - 
 
209 
END _FixReal;
 - 
 
210 
 
 - 
 
211 
PROCEDURE Real*(x: REAL; width: INTEGER);
 - 
 
212 
VAR e, n, i: INTEGER; minus: BOOLEAN;
 - 
 
213 
BEGIN
 - 
 
214 
  Realp := Real;
 - 
 
215 
  IF IsNan(x) OR IsInf(x) THEN
 - 
 
216 
    OutInf(x, width)
 - 
 
217 
  ELSE
 - 
 
218 
    e := 0;
 - 
 
219 
    n := 0;
 - 
 
220 
    IF width > 23 THEN
 - 
 
221 
      n := width - 23;
 - 
 
222 
      width := 23
 - 
 
223 
    ELSIF width < 9 THEN
 - 
 
224 
      width := 9
 - 
 
225 
    END;
 - 
 
226 
    width := width - 5;
 - 
 
227 
    IF x < 0.0 THEN
 - 
 
228 
      x := -x;
 - 
 
229 
      minus := TRUE
 - 
 
230 
    ELSE
 - 
 
231 
      minus := FALSE
 - 
 
232 
    END;
 - 
 
233 
    WHILE x >= 10.0 DO
 - 
 
234 
      x := x / 10.0;
 44 
END String;
235 
      INC(e)
 - 
 
236 
    END;
 - 
 
237 
    WHILE (x < 1.0) & (x # 0.0) DO
 - 
 
238 
      x := x * 10.0;
 - 
 
239 
      DEC(e)
 - 
 
240 
    END;
 - 
 
241 
    IF x > 9.0 + d THEN
 - 
 
242 
      x := 1.0;
 - 
 
243 
      INC(e)
 - 
 
244 
    END;
 - 
 
245 
    FOR i := 1 TO n DO
 - 
 
246 
      Char(" ")
 - 
 
247 
    END;
 - 
 
248 
    IF minus THEN
 - 
 
249 
      x := -x
 - 
 
250 
    END;
 45 
 
Line -... Line 46...
- 
 
 46 
 
251 
    _FixReal(x, width, width - 3);
 47 
PROCEDURE Ln*;
252 
    Char("E");
 48 
BEGIN
253 
    IF e >= 0 THEN
 - 
 
254 
      Char("+")
 49 
    printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(CHR(13) + CHR(10)))
255 
    ELSE
 50 
END Ln;
Line -... Line 51...
- 
 
 51 
 
256 
      Char("-");
 52 
 
257 
      e := ABS(e)
 53 
PROCEDURE Int* (x, width: INTEGER);
258 
    END;
 54 
BEGIN
259 
    IF e < 100 THEN
 55 
    printf2(SYSTEM.SADR("%*d"), width, x)
Line -... Line 56...
- 
 
 56 
END Int;
260 
      Char("0")
 57 
 
261 
    END;
 58