Read and write Unicode in Windows Console

src/In.Mod

@@ -7,13 +7,13 @@ MODULE In;
 IMPORT Platform, SYSTEM, Reals, Out, Utf8;
 
 CONST
-  pending = 0; (* readstate when at start of input or end of line. Implies nextch undefined. *)
-  ready   = 1; (* readstate when nextch is defined and contains next character on current line. *)
-  eof     = 2; (* readstate when at end of file. *)
+  pending = 0; (* readState when at start of input or end of line. Implies nextch undefined. *)
+  ready   = 1; (* readState when nextch is defined and contains next character on current line. *)
+  eof     = 2; (* readState when at end of file. *)
 
-  (* Codepages, see cp below *)
+  (* Codepages, values of cp *)
   singleByte = 1;
-  utf8       = 2; (*!TODO also add UTF16 = 2 *)
+  utf8       = 2; (*!TODO also add UTF16 *)
 
 TYPE
   SBYTE = BYTE;
@@ -22,16 +22,17 @@ TYPE
 VAR
   Done-: BOOLEAN;
   nextch: CHAR; (* Maintains 1 character read ahaead except at end of line. *)
-  readstate: INTEGER;
+  readState: INTEGER;
   cp: INTEGER; (* Input Code Page *)
 
 PROCEDURE Open*;
 VAR error: Platform.ErrorCode;
 BEGIN
-  error := Platform.Seek(Platform.StdIn, 0, Platform.SeekSet); (* Rewind STDIN to beginning of file. *)
+  (* Rewind STDIN to beginning of file. *)
+  error := Platform.Seek(Platform.StdIn, 0, Platform.SeekSet);
   cp := utf8;
   nextch := 0X;
-  readstate := pending;
+  readState := pending;
   Done := error = 0
 END Open;
 
@@ -40,49 +41,63 @@ VAR error: Platform.ErrorCode; x, n: INTEGER;
   m: ARRAY 1 OF SBYTE;
 BEGIN
   error := Platform.ReadBuf(Platform.StdIn, m, n); x := m[0] MOD 256;
-  IF (error = 0) & (n = 1) THEN readstate := ready
-  ELSE readstate := eof; x := 0
+  IF (error = 0) & (n = 1) THEN readState := ready
+  ELSE readState := eof; x := 0
   END;
   RETURN x
 END GetByte;
 
+PROCEDURE GetChar(VAR x: CHAR): BOOLEAN;
+VAR error: Platform.ErrorCode; n: INTEGER; ok: BOOLEAN;
+  m: ARRAY 1 OF CHAR;
+BEGIN
+  error := Platform.ReadBufW(Platform.StdIn, m, n); x := m[0];
+  IF (error = 0) & (n = 1) THEN readState := ready; ok := TRUE
+  ELSE readState := eof; x := 0X; ok := FALSE
+  END ;
+RETURN ok END GetChar;
+
 PROCEDURE Byte*(VAR x: BYTE);
 BEGIN x := SYSTEM.VAL(BYTE, SHORT(SHORT(GetByte())))
 END Byte;
 
 PROCEDURE ReadChar;
 VAR x, y: INTEGER;
-BEGIN x := GetByte();
-  IF readstate = ready THEN
-    IF cp = utf8 THEN
-      IF x > 80H THEN y := GetByte() MOD 64; (* Not 1 byte *)
-        IF x DIV 32 = 6 THEN (* 2 bytes *)
-          x := x MOD 32 * 64 + y
-        ELSIF y DIV 16 = 14 THEN (* 3 bytes *)
-          x := (x MOD 16 * 64 + y) * 64 + GetByte() MOD 64
-        ELSIF y DIV 8 = 30 THEN (* 4 bytes *)
-          x := ((x MOD 8 * 64 + y) * 64 + GetByte() MOD 64) * 64 + GetByte() MOD 64
-        ELSE x := 0
+  c: CHAR;
+BEGIN
+  IF GetChar(c) THEN nextch := c
+  ELSE x := GetByte();
+    IF readState = ready THEN
+      IF cp = utf8 THEN
+        IF x >= 80H THEN y := GetByte() MOD 64; (* Not 1 byte *)
+          IF x DIV 32 = 6 THEN (* 2 bytes *)
+            x := x MOD 32 * 64 + y
+          ELSIF y DIV 16 = 14 THEN (* 3 bytes *)
+            x := (x MOD 16 * 64 + y) * 64 + GetByte() MOD 64
+          ELSIF y DIV 8 = 30 THEN (* 4 bytes *)
+            x := ((x MOD 8 * 64 + y) * 64 + GetByte() MOD 64) * 64 + GetByte() MOD 64
+          ELSE x := 0
+          END
         END
-      END
-    END;
-    nextch := CHR(x)
+      END;
+      nextch := CHR(x)
+    END
   END
 END ReadChar;
 
-PROCEDURE StartRead; (* Ensure either nextch is valid or we're at EOF. *)
-BEGIN Out.Flush; IF readstate = pending THEN ReadChar END
+PROCEDURE StartRead; (* Ensure either nextch is valid or we are at EOF. *)
+BEGIN Out.Flush; IF readState = pending THEN ReadChar END
 END StartRead;
 
 PROCEDURE StartAndSkip; (* Like StartRead, but also skip over blanks, CR, LF, tab. *)
 BEGIN StartRead;
-  WHILE (readstate = ready) & (nextch <= ' ') DO ReadChar END
+  WHILE (readState = ready) & (nextch <= ' ') DO ReadChar END
 END StartAndSkip;
 
 PROCEDURE Char*(VAR ch: CHAR);
 BEGIN StartRead;
-  IF readstate = ready THEN ch := nextch;
-    IF ch = 0AX THEN readstate := pending ELSE ReadChar END
+  IF readState = ready THEN ch := nextch;
+    IF ch = 0AX THEN readState := pending ELSE ReadChar END
   ELSE Done := FALSE; ch := 0X
   END
 END Char;
@@ -92,13 +107,13 @@ VAR ok, neg, hex, endofnum: BOOLEAN;
   decacc, hexacc, digit: LONGINT;
 BEGIN StartAndSkip;
   ok := FALSE;
-  IF readstate = ready THEN
+  IF readState = ready THEN
     neg := nextch = '-'; IF neg THEN ReadChar END;
     hex := FALSE;
     endofnum := FALSE;
     decacc := 0;
     hexacc := 0;
-    WHILE (readstate = ready) & ~endofnum DO
+    WHILE (readState = ready) & ~endofnum DO
       digit := -1;
       IF (nextch >= '0') & (nextch <= '9') THEN
         digit := ORD(nextch) MOD 16
@@ -123,37 +138,36 @@ BEGIN StartAndSkip;
     ELSE h := 0
     END
   END;
-  WHILE (readstate = ready) & (nextch <= ' ') & (nextch # 0AX) DO ReadChar END;
-  IF (readstate = ready) & (nextch = 0AX) THEN readstate := pending END;
+  WHILE (readState = ready) & (nextch <= ' ') & (nextch # 0AX) DO ReadChar END;
+  IF (readState = ready) & (nextch = 0AX) THEN readState := pending END;
   IF ~ok THEN Done := FALSE END
 END HugeInt;
 
 PROCEDURE Int16*(VAR i: SHORTINT);
 VAR h: LONGINT;
-BEGIN HugeInt(h); i := SHORT(SHORT(h)) (*!FIXME check range?*)
+BEGIN HugeInt(h); i := SHORT(SHORT(h)) (*!FIXME check range, update Done*)
 END Int16;
 
-PROCEDURE LongInt*(VAR i: INTEGER);
-VAR h: LONGINT;
-BEGIN HugeInt(h); i := SHORT(h) (*!FIXME check range?*)
-END LongInt;
-
 PROCEDURE Int*(VAR i: INTEGER); (*32-bit INTEGER alias*)
 VAR h: LONGINT;
-BEGIN HugeInt(h); i := SHORT(h) (*!FIXME check range?*)
+BEGIN HugeInt(h); i := SHORT(h) (*!FIXME check range, update Done*)
 END Int;
 
+PROCEDURE LongInt*(VAR i: INTEGER);
+BEGIN Int(i)
+END LongInt;
+
 PROCEDURE Line*(VAR line: ARRAY OF CHAR);
 VAR i: INTEGER;
 BEGIN StartRead; i := 0;
-  IF readstate # ready THEN Done := FALSE END;
-  WHILE (readstate = ready) & (nextch # 0DX) & (nextch # 0AX) &
-        (i < LEN(line) - 1) DO
-    line[i] := nextch; INC(i); ReadChar
+  IF readState # ready THEN Done := FALSE END;
+  WHILE (readState = ready) & (nextch # 0DX) & (nextch # 0AX) DO
+    IF i < LEN(line) - 1 THEN line[i] := nextch; INC(i) ELSE Done := FALSE END;
+    ReadChar
   END;
   line[i] := 0X;
-  IF (readstate = ready) & (nextch = 0DX) THEN ReadChar END;
-  IF (readstate = ready) & (nextch = 0AX) THEN readstate := pending END
+  IF (readState = ready) & (nextch = 0DX) THEN ReadChar END;
+  IF (readState = ready) & (nextch = 0AX) THEN readState := pending END
 END Line;
 
 (** Skip whitespaces, read characters until a whitespace, skip whitespaces
@@ -161,26 +175,26 @@ END Line;
 PROCEDURE Word*(VAR s: ARRAY OF CHAR);
 VAR i: INTEGER;
 BEGIN StartRead; i := 0;
-  IF readstate # ready THEN Done := FALSE END;
-  WHILE (readstate = ready) & (nextch > ' ') & (i < LEN(s) - 1) DO
+  IF readState # ready THEN Done := FALSE END;
+  WHILE (readState = ready) & (nextch > ' ') & (i < LEN(s) - 1) DO
     s[i] := nextch; INC(i); ReadChar
   END;
   s[i] := 0X;
-  WHILE (readstate = ready) & (nextch <= ' ') & (nextch # 0AX) DO ReadChar END;
-  IF (readstate = ready) & (nextch = 0AX) THEN readstate := pending END
+  WHILE (readState = ready) & (nextch <= ' ') & (nextch # 0AX) DO ReadChar END;
+  IF (readState = ready) & (nextch = 0AX) THEN readState := pending END
 END Word;
 
 PROCEDURE String*(VAR s: ARRAY OF CHAR);
 VAR i: INTEGER;
 BEGIN StartAndSkip; i := 0;
-  IF (readstate = ready) & (nextch = '"') THEN
+  IF (readState = ready) & (nextch = '"') THEN
     ReadChar;
-    WHILE (readstate = ready) & (i < LEN(s) - 1) &
+    WHILE (readState = ready) & (i < LEN(s) - 1) &
         (nextch >= ' ') & (nextch # '"') DO
       s[i] := nextch; ReadChar; INC(i)
     END
   END;
-  IF (readstate = ready) & (i < LEN(s) - 1) & (nextch = '"') THEN
+  IF (readState = ready) & (i < LEN(s) - 1) & (nextch = '"') THEN
     ReadChar; s[i] := 0X
   ELSE s[0] := 0X; Done := FALSE
   END
@@ -216,6 +230,6 @@ END LongReal;
 BEGIN
   cp := utf8;
   nextch := 0X;
-  readstate := pending;
+  readState := pending;
   Done := TRUE
 END In.

src/Out.Mod

@@ -1,26 +1,19 @@
 MODULE Out;
 
-IMPORT SYSTEM, Platform, Heap, U := Utf8, Reals;
+IMPORT SYSTEM, Platform, U := Utf8, Reals;
 
 TYPE
   SHORTINT = SYSTEM.INT16; INTEGER = SYSTEM.INT32; HUGEINT = SYSTEM.INT64;
   REAL = SYSTEM.REAL32; LONGREAL = SYSTEM.REAL64; CHAR = SYSTEM.CHAR16;
 
 VAR
-  IsConsole-: BOOLEAN;
-
   buf: ARRAY 128 OF CHAR;
   in: INTEGER;
 
 PROCEDURE Flush*;
 VAR error: Platform.ErrorCode;
-  s: ARRAY 1024 OF SHORTCHAR;
-  len: INTEGER;
 BEGIN
-  IF in > 0 THEN
-    U.EncodeEx(buf, in, s, len);
-    error := Platform.Write(Platform.StdOut, SYSTEM.ADR(s), len)
-  END;
+  IF in > 0 THEN error := Platform.WriteW(buf, in) END;
   in := 0
 END Flush;
 
@@ -40,19 +33,16 @@ VAR n: INTEGER;
 BEGIN n := 0; WHILE (n < LEN(s)) & (s[n] # 0X) DO INC(n) END; RETURN n
 END Length;
 
-PROCEDURE String*(IN str: ARRAY OF CHAR);
+PROCEDURE String*(IN s: ARRAY OF CHAR);
 VAR l: INTEGER; error: Platform.ErrorCode;
-  s: ARRAY 1024 OF SHORTCHAR;
-  len: INTEGER;
 BEGIN
-  l := Length(str);
+  l := Length(s);
   IF in + l > LEN(buf) THEN Flush END;
   IF l >= LEN(buf) THEN
     (* Doesn't fit buf or no sence. Bypass buffering. *)
-    U.EncodeEx(str, l, s, len);
-    error := Platform.Write(Platform.StdOut, SYSTEM.ADR(s), len)
+    error := Platform.WriteW(s, l)
   ELSE
-    SYSTEM.MOVE(SYSTEM.ADR(str), SYSTEM.ADR(buf[in]), l * 2); INC(in, l)
+    SYSTEM.MOVE(SYSTEM.ADR(s), SYSTEM.ADR(buf[in]), l * 2); INC(in, l)
   END
 END String;
 
@@ -129,6 +119,5 @@ BEGIN Reals.LongStrFix(x, n, k, s); String(s)
 END LongRealFix;
 
 BEGIN
-  IsConsole := Platform.IsConsole(Platform.StdOut);
   in := 0
 END Out.