oberon-07-compiler/lib/Windows/In.ob07

(*
    BSD 2-Clause License

    Copyright (c) 2020-2021, Anton Krotov
    All rights reserved.
*)

MODULE In;

IMPORT SYSTEM, API;


CONST

    MAX_LEN = 1024;
    bit_depth = API.BIT_DEPTH;


VAR

    Done*: BOOLEAN;
    hConsoleInput: INTEGER;
    s: ARRAY MAX_LEN + 4 OF CHAR;
    fmt: ARRAY 8 OF CHAR;


PROCEDURE [ccall,   "msvcrt.dll",   ""] sscanf (buf: INTEGER; fmt: INTEGER; adr: INTEGER): INTEGER;
PROCEDURE [windows, "kernel32.dll", ""] GetStdHandle (nStdHandle: INTEGER): INTEGER;
PROCEDURE [windows, "kernel32.dll", ""] ReadConsoleA (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER);


PROCEDURE String* (VAR str: ARRAY OF CHAR);
VAR
    count: INTEGER;

BEGIN
    ReadConsoleA(hConsoleInput, SYSTEM.ADR(s[0]), MAX_LEN, SYSTEM.ADR(count), 0);
    IF (s[count - 1] = 0AX) & (s[count - 2] = 0DX) THEN
        DEC(count, 2)
    END;
    s[count] := 0X;
    COPY(s, str);
    str[LEN(str) - 1] := 0X;
    Done := TRUE
END String;


PROCEDURE Int* (VAR x: INTEGER);
BEGIN
    String(s);
    Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.ADR(fmt[0]), SYSTEM.ADR(x)) = 1
END Int;


PROCEDURE Real* (VAR x: REAL);
BEGIN
    String(s);
    Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lf"), SYSTEM.ADR(x)) = 1
END Real;


PROCEDURE Char* (VAR x: CHAR);
BEGIN
    String(s);
    x := s[0]
END Char;


PROCEDURE Ln*;
BEGIN
    String(s)
END Ln;


PROCEDURE Open*;
BEGIN
    hConsoleInput := GetStdHandle(-10);
    Done := TRUE
END Open;


BEGIN
    IF bit_depth = 32 THEN
        fmt := "%d"
    ELSE
        fmt := "%lld"
    END
END In.