Rev 7209 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
7597 | akron1 | 1 | (* |
2 | BSD 2-Clause License |
||
6613 | leency | 3 | |
7597 | akron1 | 4 | Copyright (c) 2018, 2019, Anton Krotov |
5 | All rights reserved. |
||
6613 | leency | 6 | *) |
7 | |||
8 | MODULE HOST; |
||
9 | |||
7597 | akron1 | 10 | IMPORT SYSTEM, K := KOSAPI, API, RTL; |
6613 | leency | 11 | |
7597 | akron1 | 12 | |
6613 | leency | 13 | CONST |
14 | |||
7597 | akron1 | 15 | slash* = "/"; |
16 | OS* = "KOS"; |
||
6613 | leency | 17 | |
7597 | akron1 | 18 | bit_depth* = RTL.bit_depth; |
19 | maxint* = RTL.maxint; |
||
20 | minint* = RTL.minint; |
||
21 | |||
22 | MAX_PARAM = 1024; |
||
23 | |||
24 | |||
6613 | leency | 25 | TYPE |
26 | |||
7597 | akron1 | 27 | FNAME = ARRAY 520 OF CHAR; |
6613 | leency | 28 | |
7597 | akron1 | 29 | FS = POINTER TO rFS; |
6613 | leency | 30 | |
7597 | akron1 | 31 | rFS = RECORD |
32 | subfunc, pos, hpos, bytes, buffer: INTEGER; |
||
33 | name: FNAME |
||
34 | END; |
||
35 | |||
36 | FD = POINTER TO rFD; |
||
37 | |||
38 | rFD = RECORD |
||
39 | attr: INTEGER; |
||
40 | ntyp: CHAR; |
||
41 | reserved: ARRAY 3 OF CHAR; |
||
42 | time_create, date_create, |
||
43 | time_access, date_access, |
||
44 | time_modif, date_modif, |
||
45 | size, hsize: INTEGER; |
||
46 | name: FNAME |
||
47 | END; |
||
48 | |||
49 | |||
6613 | leency | 50 | VAR |
51 | |||
52 | |||
7597 | akron1 | 53 | Console: BOOLEAN; |
6613 | leency | 54 | |
7597 | akron1 | 55 | Params: ARRAY MAX_PARAM, 2 OF INTEGER; |
56 | argc*: INTEGER; |
||
57 | |||
58 | eol*: ARRAY 3 OF CHAR; |
||
59 | |||
60 | |||
61 | PROCEDURE [stdcall, "Console.obj", "con_init"] con_init (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER); |
||
62 | |||
63 | PROCEDURE [stdcall, "Console.obj", "con_exit"] con_exit (bCloseWindow: BOOLEAN); |
||
64 | |||
65 | PROCEDURE [stdcall, "Console.obj", "con_write_string"] con_write_string (string, length: INTEGER); |
||
66 | |||
67 | |||
68 | PROCEDURE ExitProcess* (p1: INTEGER); |
||
6613 | leency | 69 | BEGIN |
7597 | akron1 | 70 | IF Console THEN |
71 | con_exit(FALSE) |
||
72 | END; |
||
73 | K.sysfunc1(-1) |
||
74 | END ExitProcess; |
||
6613 | leency | 75 | |
76 | |||
7597 | akron1 | 77 | PROCEDURE OutChar* (c: CHAR); |
78 | BEGIN |
||
79 | IF Console THEN |
||
80 | con_write_string(SYSTEM.ADR(c), 1) |
||
81 | ELSE |
||
82 | K.sysfunc3(63, 1, ORD(c)) |
||
83 | END |
||
84 | END OutChar; |
||
6613 | leency | 85 | |
7597 | akron1 | 86 | |
87 | PROCEDURE GetFileInfo (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN; |
||
88 | VAR |
||
89 | res2: INTEGER; |
||
90 | fs: rFS; |
||
91 | |||
6613 | leency | 92 | BEGIN |
7597 | akron1 | 93 | fs.subfunc := 5; |
94 | fs.pos := 0; |
||
95 | fs.hpos := 0; |
||
96 | fs.bytes := 0; |
||
97 | fs.buffer := SYSTEM.ADR(Info); |
||
98 | COPY(FName, fs.name) |
||
99 | RETURN K.sysfunc22(70, SYSTEM.ADR(fs), res2) = 0 |
||
100 | END GetFileInfo; |
||
101 | |||
102 | |||
103 | PROCEDURE Exists (FName: ARRAY OF CHAR): BOOLEAN; |
||
104 | VAR |
||
105 | fd: rFD; |
||
106 | |||
107 | BEGIN |
||
108 | RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr)) |
||
109 | END Exists; |
||
110 | |||
111 | |||
112 | PROCEDURE Close (VAR F: FS); |
||
113 | BEGIN |
||
114 | IF F # NIL THEN |
||
115 | DISPOSE(F) |
||
6613 | leency | 116 | END |
7597 | akron1 | 117 | END Close; |
6613 | leency | 118 | |
7597 | akron1 | 119 | |
120 | PROCEDURE Open (FName: ARRAY OF CHAR): FS; |
||
121 | VAR |
||
122 | F: FS; |
||
123 | |||
6613 | leency | 124 | BEGIN |
7597 | akron1 | 125 | IF Exists(FName) THEN |
126 | NEW(F); |
||
127 | IF F # NIL THEN |
||
128 | F.subfunc := 0; |
||
129 | F.pos := 0; |
||
130 | F.hpos := 0; |
||
131 | F.bytes := 0; |
||
132 | F.buffer := 0; |
||
133 | COPY(FName, F.name) |
||
134 | END |
||
135 | ELSE |
||
136 | F := NIL |
||
137 | END |
||
6613 | leency | 138 | |
7597 | akron1 | 139 | RETURN F |
140 | END Open; |
||
6613 | leency | 141 | |
142 | |||
7597 | akron1 | 143 | PROCEDURE Read (F: FS; Buffer, Count: INTEGER): INTEGER; |
144 | VAR |
||
145 | res, res2: INTEGER; |
||
146 | |||
6613 | leency | 147 | BEGIN |
7597 | akron1 | 148 | IF F # NIL THEN |
149 | F.subfunc := 0; |
||
150 | F.bytes := Count; |
||
151 | F.buffer := Buffer; |
||
152 | res := K.sysfunc22(70, SYSTEM.ADR(F^), res2); |
||
153 | IF res2 > 0 THEN |
||
154 | F.pos := F.pos + res2 |
||
155 | END |
||
156 | ELSE |
||
157 | res2 := 0 |
||
6613 | leency | 158 | END |
159 | |||
7597 | akron1 | 160 | RETURN res2 |
161 | END Read; |
||
162 | |||
163 | |||
164 | PROCEDURE Write (F: FS; Buffer, Count: INTEGER): INTEGER; |
||
165 | VAR |
||
166 | res, res2: INTEGER; |
||
167 | |||
6613 | leency | 168 | BEGIN |
7597 | akron1 | 169 | IF F # NIL THEN |
170 | F.subfunc := 3; |
||
171 | F.bytes := Count; |
||
172 | F.buffer := Buffer; |
||
173 | res := K.sysfunc22(70, SYSTEM.ADR(F^), res2); |
||
174 | IF res2 > 0 THEN |
||
175 | F.pos := F.pos + res2 |
||
176 | END |
||
177 | ELSE |
||
178 | res2 := 0 |
||
179 | END |
||
6613 | leency | 180 | |
7597 | akron1 | 181 | RETURN res2 |
182 | END Write; |
||
183 | |||
184 | |||
185 | PROCEDURE Create (FName: ARRAY OF CHAR): FS; |
||
7209 | akron1 | 186 | VAR |
7597 | akron1 | 187 | F: FS; |
188 | res2: INTEGER; |
||
189 | |||
190 | BEGIN |
||
191 | NEW(F); |
||
192 | IF F # NIL THEN |
||
193 | F.subfunc := 2; |
||
194 | F.pos := 0; |
||
195 | F.hpos := 0; |
||
196 | F.bytes := 0; |
||
197 | F.buffer := 0; |
||
198 | COPY(FName, F.name); |
||
199 | IF K.sysfunc22(70, SYSTEM.ADR(F^), res2) # 0 THEN |
||
200 | DISPOSE(F) |
||
201 | END |
||
202 | END |
||
203 | |||
204 | RETURN F |
||
205 | END Create; |
||
206 | |||
207 | |||
208 | PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; |
||
209 | VAR |
||
210 | n: INTEGER; |
||
211 | fs: FS; |
||
212 | |||
213 | BEGIN |
||
214 | SYSTEM.GET(SYSTEM.ADR(F), fs); |
||
215 | n := Read(fs, SYSTEM.ADR(Buffer[0]), bytes); |
||
216 | IF n = 0 THEN |
||
217 | n := -1 |
||
218 | END |
||
219 | |||
220 | RETURN n |
||
221 | END FileRead; |
||
222 | |||
223 | |||
224 | PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; |
||
225 | VAR |
||
226 | n: INTEGER; |
||
227 | fs: FS; |
||
228 | |||
229 | BEGIN |
||
230 | SYSTEM.GET(SYSTEM.ADR(F), fs); |
||
231 | n := Write(fs, SYSTEM.ADR(Buffer[0]), bytes); |
||
232 | IF n = 0 THEN |
||
233 | n := -1 |
||
234 | END |
||
235 | |||
236 | RETURN n |
||
237 | END FileWrite; |
||
238 | |||
239 | |||
240 | PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; |
||
241 | VAR |
||
242 | fs: FS; |
||
243 | res: INTEGER; |
||
244 | |||
245 | BEGIN |
||
246 | fs := Create(FName); |
||
247 | SYSTEM.GET(SYSTEM.ADR(fs), res) |
||
248 | RETURN res |
||
249 | END FileCreate; |
||
250 | |||
251 | |||
252 | PROCEDURE FileClose* (F: INTEGER); |
||
253 | VAR |
||
254 | fs: FS; |
||
255 | |||
256 | BEGIN |
||
257 | SYSTEM.GET(SYSTEM.ADR(F), fs); |
||
258 | Close(fs) |
||
259 | END FileClose; |
||
260 | |||
261 | |||
262 | PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; |
||
263 | VAR |
||
264 | fs: FS; |
||
265 | res: INTEGER; |
||
266 | |||
267 | BEGIN |
||
268 | fs := Open(FName); |
||
269 | SYSTEM.GET(SYSTEM.ADR(fs), res) |
||
270 | RETURN res |
||
271 | END FileOpen; |
||
272 | |||
273 | |||
274 | PROCEDURE GetTickCount* (): INTEGER; |
||
275 | RETURN K.sysfunc2(26, 9) |
||
276 | END GetTickCount; |
||
277 | |||
278 | |||
279 | PROCEDURE AppAdr (): INTEGER; |
||
280 | VAR |
||
7209 | akron1 | 281 | buf: ARRAY 1024 OF CHAR; |
282 | a: INTEGER; |
||
7597 | akron1 | 283 | |
7209 | akron1 | 284 | BEGIN |
7597 | akron1 | 285 | a := K.sysfunc3(9, SYSTEM.ADR(buf), -1); |
286 | SYSTEM.GET(SYSTEM.ADR(buf) + 22, a) |
||
7209 | akron1 | 287 | RETURN a |
288 | END AppAdr; |
||
289 | |||
7597 | akron1 | 290 | |
291 | PROCEDURE GetCommandLine (): INTEGER; |
||
292 | VAR |
||
293 | param: INTEGER; |
||
294 | |||
6613 | leency | 295 | BEGIN |
7597 | akron1 | 296 | SYSTEM.GET(28 + AppAdr(), param) |
297 | RETURN param |
||
6613 | leency | 298 | END GetCommandLine; |
299 | |||
7597 | akron1 | 300 | |
301 | PROCEDURE GetName (): INTEGER; |
||
302 | VAR |
||
303 | name: INTEGER; |
||
304 | |||
6613 | leency | 305 | BEGIN |
7597 | akron1 | 306 | SYSTEM.GET(32 + AppAdr(), name) |
307 | RETURN name |
||
6613 | leency | 308 | END GetName; |
309 | |||
310 | |||
7597 | akron1 | 311 | PROCEDURE GetChar (adr: INTEGER): CHAR; |
312 | VAR |
||
313 | res: CHAR; |
||
314 | |||
6613 | leency | 315 | BEGIN |
7597 | akron1 | 316 | SYSTEM.GET(adr, res) |
317 | RETURN res |
||
318 | END GetChar; |
||
6613 | leency | 319 | |
7597 | akron1 | 320 | |
321 | PROCEDURE ParamParse; |
||
322 | VAR |
||
323 | p, count, name, cond: INTEGER; |
||
324 | c: CHAR; |
||
325 | |||
326 | |||
327 | PROCEDURE ChangeCond (A, B, C: INTEGER; c: CHAR; VAR cond: INTEGER); |
||
328 | BEGIN |
||
329 | IF (c <= 20X) & (c # 0X) THEN |
||
330 | cond := A |
||
331 | ELSIF c = 22X THEN |
||
332 | cond := B |
||
333 | ELSIF c = 0X THEN |
||
334 | cond := 6 |
||
335 | ELSE |
||
336 | cond := C |
||
337 | END |
||
338 | END ChangeCond; |
||
339 | |||
340 | |||
6613 | leency | 341 | BEGIN |
7597 | akron1 | 342 | p := GetCommandLine(); |
343 | name := GetName(); |
||
344 | Params[0, 0] := name; |
||
345 | WHILE GetChar(name) # 0X DO |
||
346 | INC(name) |
||
347 | END; |
||
348 | Params[0, 1] := name - 1; |
||
349 | cond := 0; |
||
350 | count := 1; |
||
351 | WHILE (argc < MAX_PARAM) & (cond # 6) DO |
||
352 | c := GetChar(p); |
||
353 | CASE cond OF |
||
354 | |0: ChangeCond(0, 4, 1, c, cond); IF cond = 1 THEN Params[count, 0] := p END |
||
355 | |1: ChangeCond(0, 3, 1, c, cond); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END |
||
356 | |3: ChangeCond(3, 1, 3, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END |
||
357 | |4: ChangeCond(5, 0, 5, c, cond); IF cond = 5 THEN Params[count, 0] := p END |
||
358 | |5: ChangeCond(5, 1, 5, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END |
||
359 | |6: |
||
360 | END; |
||
361 | INC(p) |
||
362 | END; |
||
363 | argc := count |
||
364 | END ParamParse; |
||
6613 | leency | 365 | |
7597 | akron1 | 366 | |
367 | PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); |
||
368 | VAR |
||
369 | i, j, len: INTEGER; |
||
370 | c: CHAR; |
||
371 | |||
6613 | leency | 372 | BEGIN |
7597 | akron1 | 373 | j := 0; |
374 | IF n < argc THEN |
||
375 | len := LEN(s) - 1; |
||
376 | i := Params[n, 0]; |
||
377 | WHILE (j < len) & (i <= Params[n, 1]) DO |
||
378 | c := GetChar(i); |
||
379 | IF c # 22X THEN |
||
380 | s[j] := c; |
||
381 | INC(j) |
||
382 | END; |
||
383 | INC(i); |
||
384 | END; |
||
385 | END; |
||
386 | s[j] := 0X |
||
387 | END GetArg; |
||
6613 | leency | 388 | |
7597 | akron1 | 389 | |
390 | PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); |
||
391 | VAR |
||
392 | n: INTEGER; |
||
393 | |||
6613 | leency | 394 | BEGIN |
7597 | akron1 | 395 | GetArg(0, path); |
396 | n := LENGTH(path) - 1; |
||
397 | WHILE path[n] # slash DO |
||
398 | DEC(n) |
||
399 | END; |
||
400 | path[n + 1] := 0X |
||
401 | END GetCurrentDirectory; |
||
6613 | leency | 402 | |
403 | |||
7597 | akron1 | 404 | PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; |
405 | RETURN path[0] # slash |
||
406 | END isRelative; |
||
6613 | leency | 407 | |
408 | |||
7597 | akron1 | 409 | PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); |
410 | VAR |
||
411 | date, time: INTEGER; |
||
412 | |||
6613 | leency | 413 | BEGIN |
7597 | akron1 | 414 | date := K.sysfunc1(29); |
415 | time := K.sysfunc1(3); |
||
6613 | leency | 416 | |
7597 | akron1 | 417 | year := date MOD 16; |
418 | date := date DIV 16; |
||
419 | year := (date MOD 16) * 10 + year; |
||
420 | date := date DIV 16; |
||
421 | |||
422 | month := date MOD 16; |
||
423 | date := date DIV 16; |
||
424 | month := (date MOD 16) * 10 + month; |
||
425 | date := date DIV 16; |
||
426 | |||
427 | day := date MOD 16; |
||
428 | date := date DIV 16; |
||
429 | day := (date MOD 16) * 10 + day; |
||
430 | date := date DIV 16; |
||
431 | |||
432 | hour := time MOD 16; |
||
433 | time := time DIV 16; |
||
434 | hour := (time MOD 16) * 10 + hour; |
||
435 | time := time DIV 16; |
||
436 | |||
437 | min := time MOD 16; |
||
438 | time := time DIV 16; |
||
439 | min := (time MOD 16) * 10 + min; |
||
440 | time := time DIV 16; |
||
441 | |||
442 | sec := time MOD 16; |
||
443 | time := time DIV 16; |
||
444 | sec := (time MOD 16) * 10 + sec; |
||
445 | time := time DIV 16; |
||
446 | |||
447 | year := year + 2000 |
||
448 | END now; |
||
449 | |||
450 | |||
451 | PROCEDURE UnixTime* (): INTEGER; |
||
452 | RETURN 0 |
||
453 | END UnixTime; |
||
454 | |||
455 | |||
456 | PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
||
6613 | leency | 457 | BEGIN |
7597 | akron1 | 458 | SYSTEM.GET(SYSTEM.ADR(x), a); |
459 | SYSTEM.GET(SYSTEM.ADR(x) + 4, b) |
||
460 | RETURN a |
||
461 | END splitf; |
||
6613 | leency | 462 | |
7597 | akron1 | 463 | |
464 | BEGIN |
||
465 | eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
||
466 | Console := API.import; |
||
467 | IF Console THEN |
||
468 | con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS")) |
||
469 | END; |
||
470 | ParamParse |
||
6613 | leency | 471 | END HOST.=>>>>=> |