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

MODULE StdLog;

	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Log.odc *)
	(* DO NOT EDIT *)

	IMPORT
		Log, Fonts, Ports, Stores, Models, Views, Dialog, HostDialog, StdDialog,
		TextModels, TextMappers, TextRulers, TextViews, TextControllers;

	CONST
		(** IntForm base **)
		charCode* = TextMappers.charCode; decimal* = TextMappers.decimal; hexadecimal* = TextMappers.hexadecimal;

		(** IntForm showBase **)
		hideBase* = TextMappers.hideBase; showBase* = TextMappers.showBase;

		mm = Ports.mm;

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

	VAR
		logAlerts: BOOLEAN;

		text-, buf-: TextModels.Model;
		defruler-: TextRulers.Ruler;
		dir-: TextViews.Directory;

		out, subOut: TextMappers.Formatter;
		
		showHook: ShowHook;


	PROCEDURE Flush;
	BEGIN
		text.Append(buf); Views.RestoreDomain(text.Domain())
	END Flush;

	PROCEDURE Char* (ch: CHAR);
	BEGIN
		out.WriteChar(ch); Flush
	END Char;

	PROCEDURE Int* (i: LONGINT);
	BEGIN
		out.WriteChar(" "); out.WriteInt(i); Flush
	END Int;

	PROCEDURE Real* (x: REAL);
	BEGIN
		out.WriteChar(" "); out.WriteReal(x); Flush
	END Real;

	PROCEDURE String* (IN str: ARRAY OF CHAR);
	BEGIN
		out.WriteString(str); Flush
	END String;

	PROCEDURE Bool* (x: BOOLEAN);
	BEGIN
		out.WriteChar(" "); out.WriteBool(x); Flush
	END Bool;

	PROCEDURE Set* (x: SET);
	BEGIN
		out.WriteChar(" "); out.WriteSet(x); Flush
	END Set;

	PROCEDURE IntForm* (x: LONGINT; base, minWidth: INTEGER; fillCh: CHAR; showBase: BOOLEAN);
	BEGIN
		out.WriteIntForm(x, base, minWidth, fillCh, showBase); Flush
	END IntForm;

	PROCEDURE RealForm* (x: REAL; precision, minW, expW: INTEGER; fillCh: CHAR);
	BEGIN
		out.WriteRealForm(x, precision, minW, expW, fillCh); Flush
	END RealForm;

	PROCEDURE Tab*;
	BEGIN
		out.WriteTab; Flush
	END Tab;

	PROCEDURE Ln*;
	BEGIN
		out.WriteLn; Flush;
		TextViews.ShowRange(text, text.Length(), text.Length(), TextViews.any)
	END Ln;

	PROCEDURE Para*;
	BEGIN
		out.WritePara; Flush;
		TextViews.ShowRange(text, text.Length(), text.Length(), TextViews.any)
	END Para;

	PROCEDURE View* (v: Views.View);
	BEGIN
		out.WriteView(v); Flush
	END View;

	PROCEDURE ViewForm* (v: Views.View; w, h: INTEGER);
	BEGIN
		out.WriteViewForm(v, w, h); Flush
	END ViewForm;

	PROCEDURE ParamMsg* (IN msg, p0, p1, p2: ARRAY OF CHAR);
	BEGIN
		out.WriteParamMsg(msg, p0, p1, p2); Flush
	END ParamMsg;

	PROCEDURE Msg* (IN msg: ARRAY OF CHAR);
	BEGIN
		out.WriteMsg(msg); Flush
	END Msg;
	

	PROCEDURE^ Open*;

	PROCEDURE (hook: ShowHook) ShowParamMsg (IN s, p0, p1, p2: ARRAY OF CHAR);
	BEGIN
		IF Dialog.showsStatus THEN
			Dialog.ShowParamStatus(s, p0, p1, p2);
			IF logAlerts THEN
				ParamMsg(s, p0, p1, p2); Ln
			END
		ELSE
			IF logAlerts THEN
				Open;
				ParamMsg(s, p0, p1, p2); Ln
			ELSE
				HostDialog.ShowParamMsg(s, p0, p1, p2)
			END
		END
	END ShowParamMsg;
	
	PROCEDURE (hook: ShowHook) ShowParamStatus (IN s, p0, p1, p2: ARRAY OF CHAR);
	BEGIN
		HostDialog.ShowParamStatus(s, p0, p1, p2)
	END ShowParamStatus;


	PROCEDURE NewView* (): TextViews.View;
		VAR v: TextViews.View;
	BEGIN
		Flush;
		Dialog.SetShowHook(showHook); 	(* attach alert dialogs *)
		v := dir.New(text);
		v.SetDefaults(TextRulers.CopyOf(defruler, Views.deep), dir.defAttr);
		RETURN v
	END NewView;

	PROCEDURE New*;
	BEGIN
		Views.Deposit(NewView())
	END New;


	PROCEDURE SetDefaultRuler* (ruler: TextRulers.Ruler);
	BEGIN
		defruler := ruler
	END SetDefaultRuler;

	PROCEDURE SetDir* (d: TextViews.Directory);
	BEGIN
		ASSERT(d # NIL, 20); dir := d
	END SetDir;


	PROCEDURE Open*;
		VAR v: Views.View; pos: INTEGER;
	BEGIN
		v := NewView();
		StdDialog.Open(v, "#Dev:Log", NIL, "", NIL, FALSE, TRUE, FALSE, FALSE, TRUE);
		Views.RestoreDomain(text.Domain());
		pos := text.Length();
		TextViews.ShowRange(text, pos, pos, TextViews.any);
		TextControllers.SetCaret(text, pos)
	END Open;

	PROCEDURE Clear*;
	BEGIN
		Models.BeginModification(Models.notUndoable, text);
		text.Delete(0, text.Length());
		buf.Delete(0, buf.Length());
		Models.EndModification(Models.notUndoable, text)
	END Clear;
	

	(* Sub support *)

	PROCEDURE* Guard (o: ANYPTR): BOOLEAN;
	BEGIN
		RETURN
			(o # NIL) &
			~(		(o IS TextModels.Model) & (o = text)
				OR   (o IS Stores.Domain) & (o = text.Domain())
				OR   (o IS TextViews.View) & (o(TextViews.View).ThisModel() = text)
			)
	END Guard;

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

	PROCEDURE* FlushBuf;
		VAR buf: TextModels.Model;
	BEGIN
		buf := subOut.rider.Base();
		IF buf.Length() > 0 THEN
			IF ~Log.synch THEN Open() END;
			text.Append(buf)
		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());
		NEW(h);
		Log.SetHook(h);
	END AttachSubLog;

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


	PROCEDURE Init;
		VAR font: Fonts.Font; p: TextRulers.Prop; x: INTEGER; i: INTEGER;
	BEGIN
		logAlerts := TRUE; (* logReports := FALSE; *)

		text := TextModels.dir.New();
		buf := TextModels.CloneOf(text);
		out.ConnectTo(buf);

		font := TextModels.dir.attr.font;
		defruler := TextRulers.dir.New(NIL);
		TextRulers.SetRight(defruler, 80*mm);
		dir := TextViews.dir;
		NEW(showHook)
	END Init;

BEGIN
	Init; AttachSubLog
CLOSE
	DetachSubLog; 
END StdLog.