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