blackbox-linux-console/BlackBox/Cons/Mod/Log.txt

MODULE ConsLog;

	(*
		A. V. Shiryaev, 2012.10

		Log.Hook implementation
		based on StdLog
	*)

	IMPORT
		Log, Views, Dialog,
		TextModels, TextMappers,
		Console;

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

	VAR
		logAlerts: BOOLEAN;
		subOut: TextMappers.Formatter;

		buf: TextModels.Model;
		textR: TextModels.Reader;

	(* Sub support *)

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

	PROCEDURE* ClearBuf;
		VAR subBuf: TextModels.Model;
	BEGIN
		subBuf := subOut.rider.Base(); subBuf.Delete(0, subBuf.Length())
	END ClearBuf;

	PROCEDURE* FlushBuf;
		VAR c: CHAR;
	BEGIN
		IF buf.Length() > 0 THEN
			textR.SetPos(0);
			textR.ReadChar(c);
			WHILE ~textR.eot DO
				IF c = 0DX THEN
					Console.WriteLn
				ELSE
					Console.WriteChar(c)
				END;
				textR.ReadChar(c)
			END;
			buf.Delete(0, buf.Length())
		END
	END FlushBuf;

	PROCEDURE* SubFlush;
	BEGIN
		IF Log.synch THEN
			FlushBuf;
			(* IF Log.force THEN Views.RestoreDomain(text.Domain()) END *)
		END;
	END SubFlush;

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

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

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

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

	PROCEDURE (log: LogHook) Char* (ch: CHAR);
	BEGIN
		subOut.WriteChar(ch); SubFlush
	END Char;

	PROCEDURE (log: LogHook) Int* (n: INTEGER);
	BEGIN
		subOut.WriteChar(" "); subOut.WriteInt(n); SubFlush
	END Int;

	PROCEDURE (log: LogHook) Real* (x: REAL);
	BEGIN
		subOut.WriteChar(" "); subOut.WriteReal(x); SubFlush
	END Real;

	PROCEDURE (log: LogHook) String* (IN str: ARRAY OF CHAR);
	BEGIN
		subOut.WriteString(str); SubFlush
	END String;

	PROCEDURE (log: LogHook) Bool* (x: BOOLEAN);
	BEGIN
		subOut.WriteChar(" "); subOut.WriteBool(x); SubFlush
	END Bool;

	PROCEDURE (log: LogHook) Set* (x: SET);
	BEGIN
		subOut.WriteChar(" "); subOut.WriteSet(x); SubFlush
	END Set;

	PROCEDURE (log: LogHook) IntForm* (x: INTEGER; base, minWidth: INTEGER; fillCh: CHAR; showBase: BOOLEAN);
	BEGIN
		subOut.WriteIntForm(x, base, minWidth, fillCh, showBase); SubFlush
	END IntForm;

	PROCEDURE (log: LogHook) RealForm* (x: REAL; precision, minW, expW: INTEGER; fillCh: CHAR);
	BEGIN
		subOut.WriteRealForm(x, precision, minW, expW, fillCh); SubFlush
	END RealForm;

	PROCEDURE (log: LogHook) Tab*;
	BEGIN
		subOut.WriteTab; SubFlush
	END Tab;

	PROCEDURE (log: LogHook) Ln*;
	BEGIN
		subOut.WriteLn; SubFlush;
		(* IF Log.synch THEN Views.RestoreDomain(text.Domain()) END *)
	END Ln;

	PROCEDURE (log: LogHook) Para*;
	BEGIN
		subOut.WritePara; SubFlush;
		(* IF Log.synch THEN Views.RestoreDomain(text.Domain()) END *)
	END Para;

	PROCEDURE (log: LogHook) View* (v: ANYPTR);
	BEGIN
		IF (v # NIL) & (v IS Views.View) THEN
			subOut.WriteView(v(Views.View)); SubFlush
		END
	END View;

	PROCEDURE (log: LogHook) ViewForm* (v: ANYPTR; w, h: INTEGER);
	BEGIN
		ASSERT(v # NIL, 20);
		IF (v # NIL) & (v IS Views.View) THEN
			subOut.WriteViewForm(v(Views.View), w, h); SubFlush
		END
	END ViewForm;

	PROCEDURE (log: LogHook) ParamMsg* (IN s, p0, p1, p2: ARRAY OF CHAR);
		VAR msg: ARRAY 256 OF CHAR; i: INTEGER; ch: CHAR;
	BEGIN
		IF logAlerts THEN
			(* IF Log.synch THEN Open END; *)
			Dialog.MapParamString(s, p0, p1, p2, msg);
			i := 0; ch := msg[0];
			WHILE ch # 0X DO
				IF ch = TextModels.line THEN subOut.WriteLn
				ELSIF ch = TextModels.para THEN subOut.WritePara
				ELSIF ch = TextModels.tab THEN subOut.WriteTab
				ELSIF ch >= " " THEN subOut.WriteChar(ch)
				END;
				INC(i); ch := msg[i];
			END;
			subOut.WriteLn; SubFlush
		(* ELSE
			HostDialog.ShowParamMsg(s, p0, p1, p2) *)
		END
	END ParamMsg;


	PROCEDURE AttachSubLog;
		VAR h: LogHook;
	BEGIN
		subOut.ConnectTo(TextModels.dir.New());
		buf := subOut.rider.Base();
		textR := buf.NewReader(NIL);
		NEW(h);
		Log.SetHook(h);
	END AttachSubLog;

	PROCEDURE DetachSubLog;
	BEGIN
		Log.SetHook(NIL)
	END DetachSubLog;

BEGIN
	AttachSubLog
CLOSE
	DetachSubLog;
END ConsLog.