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, 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 
 
- 
 
 8 
MODULE In;
- 
 
 9 
 
- 
 
 10 
IMPORT SYSTEM;
Line 18... Line 11...
18 
MODULE In;
 11 
 
Line 19... Line -...
19 
 
 - 
 
Line 20... Line 12...
20 
IMPORT sys := SYSTEM;
 12 
 
Line 21... Line 13...
21 
 
 13 
CONST
22 
TYPE
 14 
 
- 
 
 15 
    MAX_LEN = 1024;
Line 23... Line -...
23 
 
 - 
 
24 
  STRING = ARRAY 260 OF CHAR;
 - 
 
Line -... Line 16...
- 
 
 16 
 
25 
 
 17 
 
26 
VAR
 18 
VAR
Line 27... Line -...
27 
 
 - 
 
28 
  Done*: BOOLEAN;
 - 
 
29 
  hConsoleInput: INTEGER;
 - 
 
30 
 
 - 
 
31 
PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"]
 - 
 
32 
    GetStdHandle (nStdHandle: INTEGER): INTEGER;
 - 
 
33 
 
 - 
 
34 
PROCEDURE [windows-, "kernel32.dll", "ReadConsoleA"]
 - 
 
35 
    ReadConsole (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER): INTEGER;
 - 
 
36 
 
 - 
 
37 
PROCEDURE digit(ch: CHAR): BOOLEAN;
 - 
 
38 
  RETURN (ch >= "0") & (ch <= "9")
 - 
 
39 
END digit;
 - 
 
40 
 
 - 
 
41 
PROCEDURE CheckInt(s: STRING; VAR first, last: INTEGER; VAR neg: BOOLEAN; Point: BOOLEAN): BOOLEAN;
 - 
 
42 
VAR i: INTEGER;
 - 
 
43 
BEGIN
 - 
 
44 
  i := 0;
 - 
 
45 
  neg := FALSE;
 - 
 
46 
  WHILE (s[i] <= 20X) & (s[i] # 0X) DO
 - 
 
47 
    INC(i)
 - 
 
48 
  END;
 - 
 
49 
  IF s[i] = "-" THEN
 - 
 
50 
    neg := TRUE;
 - 
 
51 
    INC(i)
 - 
 
Line 52... Line -...
52 
  ELSIF s[i] = "+" THEN
 - 
 
53 
    INC(i)
 - 
 
54 
  END;
 - 
 
55 
  first := i;
 - 
 
56 
  WHILE digit(s[i]) DO
 - 
 
57 
    INC(i)
 - 
 
58 
  END;
 - 
 
59 
  last := i
 - 
 
60 
  RETURN ((s[i] <= 20X) OR (Point & (s[i] = "."))) & digit(s[first])
 - 
 
61 
END CheckInt;
 - 
 
62 
 
 - 
 
63 
PROCEDURE IsMinInt(str: STRING; pos: INTEGER): BOOLEAN;
 19 
 
64 
VAR i: INTEGER; min: STRING;
 - 
 
65 
BEGIN
 - 
 
66 
  i := 0;
 - 
 
67 
  min := "2147483648";
 - 
 
68 
  WHILE (min[i] # 0X) & (str[i] # 0X) & (min[i] = str[i + pos]) DO
 - 
 
69 
    INC(i)
 - 
 
70 
  END
 - 
 
71 
  RETURN i = 10
 - 
 
72 
END IsMinInt;
 - 
 
73 
 
 - 
 
74 
PROCEDURE StrToInt(str: STRING; VAR err: BOOLEAN): INTEGER;
 - 
 
75 
CONST maxINT = 7FFFFFFFH;
 - 
 
76 
VAR i, n, res: INTEGER; flag, neg: BOOLEAN;
 - 
 
77 
BEGIN
 - 
 
78 
  res := 0;
 - 
 
79 
  flag := CheckInt(str, i, n, neg, FALSE);
 - 
 
80 
  err := ~flag;
 - 
 
81 
  IF flag & neg & IsMinInt(str, i) THEN
 - 
 
82 
    flag := FALSE;
 - 
 
83 
    neg := FALSE;
 - 
 
84 
    res := 80000000H
 - 
 
85 
  END;
 - 
 
86 
  WHILE flag & digit(str[i]) DO
 - 
 
87 
    IF res > maxINT DIV 10 THEN
 - 
 
88 
      err := TRUE;
 - 
 
89 
      flag := FALSE;
 - 
 
90 
      res := 0
 - 
 
91 
    ELSE
 - 
 
92 
      res := res * 10;
 - 
 
93 
      IF res > maxINT - (ORD(str[i]) - ORD("0")) THEN
 - 
 
94 
        err := TRUE;
 20 
    Done*: BOOLEAN;
95 
        flag := FALSE;
 - 
 
96 
        res := 0
 - 
 
97 
      ELSE
 - 
 
98 
        res := res + (ORD(str[i]) - ORD("0"));
 - 
 
99 
        INC(i)
 21 
    hConsoleInput: INTEGER;
100 
      END
 - 
 
101 
    END
 - 
 
102 
  END;
 - 
 
103 
  IF neg THEN
 - 
 
104 
    res := -res
 - 
 
105 
  END
 - 
 
106 
  RETURN res
 - 
 
Line 107... Line -...
107 
END StrToInt;
 - 
 
108 
 
 - 
 
109 
PROCEDURE Space(s: STRING): BOOLEAN;
 22 
    s: ARRAY MAX_LEN + 4 OF CHAR;
110 
VAR i: INTEGER;
 - 
 
111 
BEGIN
 - 
 
112 
  i := 0;
 - 
 
113 
  WHILE (s[i] # 0X) & (s[i] <= 20X) DO
 - 
 
114 
    INC(i)
 - 
 
115 
  END
 - 
 
116 
  RETURN s[i] = 0X
 - 
 
117 
END Space;
 23 
 
118 
 
 - 
 
119 
PROCEDURE CheckReal(s: STRING; VAR n: INTEGER; VAR neg: BOOLEAN): BOOLEAN;
 24 
 
120 
VAR i: INTEGER; Res: BOOLEAN;
 25 
PROCEDURE [windows, "msvcrt.dll",   ""] sscanf (buf: INTEGER; fmt: INTEGER; adr: INTEGER): INTEGER;
121 
BEGIN
 26 
PROCEDURE [windows, "kernel32.dll", ""] GetStdHandle (nStdHandle: INTEGER): INTEGER;
122 
  Res := CheckInt(s, n, i, neg, TRUE);
 27 
PROCEDURE [windows, "kernel32.dll", ""] ReadConsoleA (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER);
123 
  IF Res THEN
 - 
 
124 
    IF s[i] = "." THEN
 28 
 
125 
      INC(i);
 29 
 
126 
      WHILE digit(s[i]) DO
 30 
PROCEDURE String* (VAR str: ARRAY OF CHAR);
127 
        INC(i)
 - 
 
128 
      END;
 - 
 
129 
      IF (s[i] = "D") OR (s[i] = "E") OR (s[i] = "d") OR (s[i] = "e") THEN
 - 
 
130 
        INC(i);
 31 
VAR
131 
        IF (s[i] = "+") OR (s[i] = "-") THEN
 - 
 
132 
          INC(i)
 - 
 
133 
        END;
 - 
 
134 
        Res := digit(s[i]);
 - 
 
Line 135... Line -...
135 
        WHILE digit(s[i]) DO
 - 
 
136 
          INC(i)
 - 
 
137 
        END
 - 
 
138 
      END
 - 
 
139 
    END
 - 
 
140 
  END
 - 
 
141 
  RETURN Res & (s[i] <= 20X)
 - 
 
142 
END CheckReal;
 - 
 
143 
 
 - 
 
144 
PROCEDURE StrToFloat(str: STRING; VAR err: BOOLEAN): REAL;
 - 
 
145 
CONST maxDBL = 1.69E308; maxINT = 7FFFFFFFH;
 - 
 
146 
VAR i, scale: INTEGER; res, m, d: REAL; minus, neg: BOOLEAN;
 - 
 
147 
 
 - 
 
148 
  PROCEDURE part1(VAR res, d: REAL; VAR i: INTEGER; str: STRING): BOOLEAN;
 - 
 
149 
  BEGIN
 - 
 
150 
    res := 0.0;
 - 
 
151 
    d := 1.0;
 - 
 
152 
    WHILE digit(str[i]) DO
 - 
 
Line 153... Line 32...
153 
      res := res * 10.0 + FLT(ORD(str[i]) - ORD("0"));
 32 
    count: INTEGER;
154 
      INC(i)
 33 
 
155 
    END;
 - 
 
156 
    IF str[i] = "." THEN
 - 
 
157 
      INC(i);
 - 
 
158 
      WHILE digit(str[i]) DO
 - 
 
159 
        d := d / 10.0;
 - 
 
160 
        res := res + FLT(ORD(str[i]) - ORD("0")) * d;
 - 
 
161 
        INC(i)
 - 
 
162 
      END
 34 
BEGIN
163 
    END
 - 
 
164 
    RETURN str[i] # 0X
 - 
 
165 
  END part1;
 - 
 
166 
 
 - 
 
167 
  PROCEDURE part2(VAR i, scale: INTEGER; VAR m, res: REAL; VAR minus, err: BOOLEAN; str: STRING): BOOLEAN;
 - 
 
168 
  BEGIN
 - 
 
169 
    INC(i);
 - 
 
170 
    m := 10.0;
 - 
 
171 
    minus := FALSE;
 - 
 
172 
    IF str[i] = "+" THEN
 - 
 
173 
      INC(i)
 35 
    ReadConsoleA(hConsoleInput, SYSTEM.ADR(s[0]), MAX_LEN, SYSTEM.ADR(count), 0);
174 
    ELSIF str[i] = "-" THEN
 - 
 
175 
      minus := TRUE;
 - 
 
176 
      INC(i);
 - 
 
177 
      m := 0.1
 - 
 
178 
    END;
 - 
 
179 
    scale := 0;
 - 
 
180 
    err := FALSE;
 - 
 
181 
    WHILE ~err & digit(str[i]) DO
 - 
 
182 
      IF scale > maxINT DIV 10 THEN
 - 
 
183 
        err := TRUE;
 36 
    IF (s[count - 1] = 0AX) & (s[count - 2] = 0DX) THEN
Line 184... Line -...
184 
        res := 0.0
 - 
 
185 
      ELSE
 - 
 
186 
        scale := scale * 10;
 - 
 
187 
        IF scale > maxINT - (ORD(str[i]) - ORD("0")) THEN
 - 
 
188 
          err := TRUE;
 - 
 
189 
          res := 0.0
 - 
 
190 
        ELSE
 - 
 
191 
          scale := scale + (ORD(str[i]) - ORD("0"));
 - 
 
192 
          INC(i)
 - 
 
193 
        END
 - 
 
194 
      END
 - 
 
195 
    END
 - 
 
196 
    RETURN ~err
 - 
 
197 
  END part2;
 - 
 
198 
 
 - 
 
199 
  PROCEDURE part3 (VAR err, minus: BOOLEAN; VAR scale: INTEGER; VAR res, m: REAL);
 - 
 
200 
  VAR i: INTEGER;
 - 
 
201 
  BEGIN
 - 
 
202 
    err := FALSE;
 - 
 
Line -... Line 37...
- 
 
 37 
        DEC(count, 2)
203 
    IF scale = maxINT THEN
 38 
    END;
204 
      err := TRUE;
 39 
    s[count] := 0X;
205 
      res := 0.0
 40 
    COPY(s, str);
206 
    END;
 - 
 
207 
    i := 1;
 - 
 
208 
    WHILE ~err & (i <= scale) DO
 - 
 
209 
      IF ~minus & (res > maxDBL / m) THEN
 - 
 
210 
        err := TRUE;
 - 
 
211 
        res := 0.0
 - 
 
212 
      ELSE
 - 
 
213 
        res := res * m;
 - 
 
214 
        INC(i)
 - 
 
215 
      END
 - 
 
216 
    END
 41 
    str[LEN(str) - 1] := 0X;
Line 217... Line -...
217 
  END part3;
 - 
 
218 
 
 - 
 
219 
BEGIN
 - 
 
220 
  IF CheckReal(str, i, neg) THEN
 - 
 
221 
    IF part1(res, d, i, str) & part2(i, scale, m, res, minus, err, str) THEN
 - 
 
222 
      part3(err, minus, scale, res, m)
 - 
 
223 
    END;
 - 
 
224 
    IF neg THEN
 - 
 
225 
      res := -res
 - 
 
226 
    END
 - 
 
227 
  ELSE
 - 
 
228 
    res := 0.0;
 - 
 
229 
    err := TRUE
 - 
 
230 
  END
 - 
 
231 
  RETURN res
 - 
 
232 
END StrToFloat;
 - 
 
233 
 
 - 
 
Line 234... Line 42...
234 
PROCEDURE String*(VAR s: ARRAY OF CHAR);
 42 
    Done := TRUE
235 
VAR count, i: INTEGER; str: STRING;
 - 
 
236 
BEGIN
 43 
END String;
237 
  ReadConsole(hConsoleInput, sys.ADR(str[0]), 256, sys.ADR(count), 0);
 44 
 
238 
  IF (str[count - 1] = 0AX) & (str[count - 2] = 0DX) THEN
 45 
 
239 
    DEC(count, 2)
 - 
 
240 
  END;
 46 
PROCEDURE Int* (VAR x: INTEGER);
Line -... Line 47...
- 
 
 47 
BEGIN
241 
  str[256] := 0X;
 48 
    String(s);
242 
  str[count] := 0X;
 - 
 
243 
  i := 0;
 49 
    Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lld"), SYSTEM.ADR(x)) = 1
244 
  WHILE (i < LEN(s) - 1) & (i < LEN(str)) & (str[i] # 0X) DO
 50 
END Int;
245 
      s[i] := str[i];
 - 
 
246 
      INC(i)
 51 
 
Line 247... Line -...
247 
  END;
 - 
 
248 
  s[i] := 0X;
 - 
 
249 
  Done := TRUE
 - 
 
250 
END String;
 - 
 
251 
 
 - 
 
252 
PROCEDURE Char*(VAR x: CHAR);
 - 
 
253 
VAR str: STRING;
 - 
 
254 
BEGIN
 - 
 
255 
  String(str);
 - 
 
256 
  x := str[0];
 - 
 
257 
  Done := TRUE
 - 
 
258 
END Char;
 - 
 
259 
 
 - 
 
260 
PROCEDURE Ln*;
 - 
 
261 
VAR str: STRING;
 - 
 
262 
BEGIN
 - 
 
263 
  String(str);
 - 
 
264 
  Done := TRUE
 - 
 
265 
END Ln;
 - 
 
266 
 
 - 
 
267 
PROCEDURE Real*(VAR x: REAL);
 - 
 
Line 268... Line 52...
268 
VAR str: STRING; err: BOOLEAN;
 52 
 
269 
BEGIN
 53 
PROCEDURE Real* (VAR x: REAL);
270 
  err := FALSE;
 54 
BEGIN
271 
  REPEAT
 55 
    String(s);
272 
    String(str)
 56 
    Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lf"), SYSTEM.ADR(x)) = 1
Line -... Line 57...
- 
 
 57 
END Real;
273 
  UNTIL ~Space(str);
 58 
 
274 
  x := StrToFloat(str, err);
 59