OberonCore

(*
   И.Н.Горячев   20.06.2006
   
   Модуль для вывода сообщений на консоль/в файл
   
   замечания:
   На консоль выводит в юникоде, в файл - в кодировке oem
   Реализует Log.Hook и Dialog.ShowHook
*)
MODULE WinConsole;

IMPORT SYSTEM, WinApi, Log, Dialog, Strings;

CONST
   crlf = 0AX + 0X;

TYPE
   LogHook = POINTER TO RECORD (Log.Hook)
   END;
   
   ShowHook = POINTER TO RECORD (Dialog.ShowHook)
   END;

VAR
   log : LogHook;
   show : ShowHook;
   out : WinApi.HANDLE;
   write : PROCEDURE (IN s : ARRAY OF CHAR);

PROCEDURE WriteConsole (IN s : ARRAY OF CHAR);
VAR res, written : INTEGER;
BEGIN
   res := WinApi.WriteConsoleW (out, SYSTEM.ADR(s[0]), LEN(s$), written, 0)
END WriteConsole;

PROCEDURE WriteFile (IN s : ARRAY OF CHAR);
VAR
   ss : ARRAY [untagged] 256 OF SHORTCHAR;
   res, written : INTEGER;
BEGIN
   res := WinApi.WideCharToMultiByte(WinApi.CP_OEMCP, {}, s, -1, ss, 255, NIL, NIL);
   res := WinApi.WriteFile (out, SYSTEM.ADR(ss), LEN(ss$), written, NIL)   
END WriteFile;

PROCEDURE WriteNull (IN s : ARRAY OF CHAR);
BEGIN
END WriteNull;

PROCEDURE WriteParam (IN s, p0, p1, p2 : ARRAY OF CHAR);
VAR msg: ARRAY 256 OF CHAR; i: INTEGER; ch: CHAR;
BEGIN
   Dialog.MapParamString(s, p0, p1, p2, msg);
   i := 0; ch := msg[0];
   WHILE ch # 0X DO
      IF ch = 0DX THEN log.Ln   (* TextModels.line *)
      ELSIF ch = 0EX THEN log.Ln   (* TextModels.para *)
      ELSIF ch = 09X THEN log.Tab   (* TextModels.tab *)
      ELSIF ch >= " " THEN log.Char(ch)
      END;
      INC(i); ch := msg[i];
   END;
   log.Ln
END WriteParam;

(* Log.Hook *)

PROCEDURE (log: LogHook) Guard (o: ANYPTR): BOOLEAN;
BEGIN
   RETURN o # NIL
END Guard;

PROCEDURE (log: LogHook) ClearBuf;
BEGIN
   (* no buffer *)
END ClearBuf;

PROCEDURE (log: LogHook) FlushBuf;
BEGIN
   (* no buffer *)
END FlushBuf;

PROCEDURE (log: LogHook) Beep;
BEGIN
   Dialog.Beep
END Beep;

PROCEDURE (log: LogHook) Char (ch: CHAR);
VAR s : ARRAY 2 OF CHAR;
BEGIN
   s[0] := ch; s[1] := 0X;
   write(s)
END Char;

PROCEDURE (log: LogHook) Int (n: INTEGER);
VAR s : ARRAY 32 OF CHAR;
BEGIN
   Strings.IntToString(n, s); write(s)
END Int;

PROCEDURE (log: LogHook) Real (x: REAL);
VAR s : ARRAY 32 OF CHAR;
BEGIN
   Strings.RealToStringForm(x, 16, 0, 0, " ", s); write(s)
END Real;

PROCEDURE (log: LogHook) String (IN str: ARRAY OF CHAR);
BEGIN
   write(str)
END String;

PROCEDURE (log: LogHook) Bool (x: BOOLEAN);
BEGIN
   IF x THEN write("$TRUE") ELSE write("$FALSE") END
END Bool;

PROCEDURE (log: LogHook) Set (x: SET);
VAR
   i : INTEGER;
BEGIN
   write("{"); i := MIN(SET);
   WHILE x # {} DO
      IF i IN x THEN log.Int(i); EXCL(x, i);
         IF (i + 2 <= MAX(SET)) & (i+1 IN x) & (i+2 IN x) THEN write("..");
            x := x - {i+1, i+2}; INC(i, 3);
            WHILE (i <= MAX(SET)) & (i IN x) DO EXCL(x, i); INC(i) END;
            log.Int(i-1)
         END;
         IF x # {} THEN write(", ") END
      END;
      INC(i)
   END;
   write("}")
END Set;

PROCEDURE (log: LogHook) IntForm (x: INTEGER; base, minWidth: INTEGER; fillCh: CHAR; showBase: BOOLEAN);
VAR s : ARRAY 32 OF CHAR;
BEGIN
   Strings.IntToStringForm(x, base, minWidth, fillCh, showBase, s); write(s)
END IntForm;

PROCEDURE (log: LogHook) RealForm (x: REAL; precision, minW, expW: INTEGER; fillCh: CHAR);
VAR s : ARRAY 32 OF CHAR;
BEGIN
   Strings.RealToStringForm(x, precision, minW, expW, fillCh, s); write(s)
END RealForm;

PROCEDURE (log: LogHook) Tab;
BEGIN
   log.Char(09X)
END Tab;

PROCEDURE (log: LogHook) Ln;
BEGIN
   log.String(crlf)
END Ln;

PROCEDURE (log: LogHook) Para;
BEGIN
   log.String(crlf)
END Para;

PROCEDURE (log: LogHook) View (v: ANYPTR);
BEGIN
   (* not supported *)
END View;

PROCEDURE (log: LogHook) ViewForm (v: ANYPTR; w, h: INTEGER);
BEGIN
   (* not supported *)
END ViewForm;

PROCEDURE (log: LogHook) ParamMsg (IN s, p0, p1, p2: ARRAY OF CHAR);
BEGIN
   WriteParam (s, p0, p1, p2)
END ParamMsg;

(* Dialog.ShowHook *)
   
PROCEDURE (h: ShowHook) ShowParamMsg (IN str, p0, p1, p2: ARRAY OF CHAR);
BEGIN
   WriteParam (str, p0, p1, p2)
END ShowParamMsg;

PROCEDURE (h: ShowHook) ShowParamStatus (IN str, p0, p1, p2: ARRAY OF CHAR);
BEGIN
   write("Status: ");
   WriteParam (str, p0, p1, p2)
END ShowParamStatus;

PROCEDURE Install*;
BEGIN
   Log.SetHook(log);
   Dialog.SetShowHook(show);
END Install;

PROCEDURE Init;
VAR ft : INTEGER;
BEGIN
   NEW(log);
   NEW(show);
   out := WinApi.GetStdHandle(WinApi.STD_OUTPUT_HANDLE);
   ft := WinApi.GetFileType(out);
   CASE ft OF
       WinApi.FILE_TYPE_CHAR : write := WriteConsole
   |   WinApi.FILE_TYPE_DISK,
       WinApi.FILE_TYPE_PIPE : write := WriteFile
   ELSE
      write := WriteNull
   END
END Init;

PROCEDURE Done;
BEGIN
   Dialog.SetShowHook(NIL);
   Log.SetHook(NIL);   
END Done;

BEGIN
   Init;
   Install
CLOSE
   Done
END WinConsole.

MODULE PrivEmpty;
END PrivEmpty.
^Q DevLinker.LinkExe   Empty.exe := PrivEmpty ~