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