blackbox-linux-console/BlackBox/Dev/Mod/Commanders.txt

MODULE DevCommanders;

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

	IMPORT
		Kernel, Fonts, Ports, Stores, Models, Views, Controllers, Properties, Dialog, Controls,
		TextModels, TextSetters, TextMappers, Services, StdLog;

	CONST
		(* additional Scan types *)
		ident = 19; qualident = 20; execMark = 21;

		point = Ports.point;

		minVersion = 0; maxVersion = 0; maxStdVersion = 0;


	TYPE
		View* = POINTER TO ABSTRACT RECORD (Views.View)
		END;
		EndView* = POINTER TO ABSTRACT RECORD (Views.View)
		END;

		Par* = POINTER TO RECORD
			text*: TextModels.Model;
			beg*, end*: INTEGER
		END;

		Directory* = POINTER TO ABSTRACT RECORD END;


		StdView = POINTER TO RECORD (View) END;
		StdEndView = POINTER TO RECORD (EndView) END;

		StdDirectory = POINTER TO RECORD (Directory) END;

		Scanner = RECORD
			s: TextMappers.Scanner;
			ident: ARRAY LEN(Kernel.Name) OF CHAR;
			qualident: ARRAY LEN(Kernel.Name) * 2 - 1 OF CHAR
		END;
		
		TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;

	VAR
		par*: Par;
		dir-, stdDir-: Directory;
		
		cleaner: TrapCleaner;
		cleanerInstalled: BOOLEAN;


	(** Cleaner **)

	PROCEDURE (c: TrapCleaner) Cleanup;
	BEGIN
		par := NIL;
		cleanerInstalled := FALSE;
	END Cleanup;
	
	(** View **)

	PROCEDURE (v: View) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
	BEGIN
		v.Externalize^(wr);
		wr.WriteVersion(maxVersion);
		wr.WriteXInt(execMark)
	END Externalize;

	PROCEDURE (v: View) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
		VAR thisVersion, type: INTEGER;
	BEGIN
		v.Internalize^(rd);
		IF rd.cancelled THEN RETURN END;
		rd.ReadVersion(minVersion, maxVersion, thisVersion);
		IF rd.cancelled THEN RETURN END;
		rd.ReadXInt(type)
	END Internalize;


	(** Directory **)

	PROCEDURE (d: Directory) New* (): View, NEW, ABSTRACT;
	PROCEDURE (d: Directory) NewEnd* (): EndView, NEW, ABSTRACT;


	(* auxilliary procedures *)

	PROCEDURE IsIdent (VAR s: ARRAY OF CHAR): BOOLEAN;
		VAR i: INTEGER; ch: CHAR;
	BEGIN
		ch := s[0]; i := 1;
		IF ("A" <= CAP(ch)) & (CAP(ch) <= "Z") OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_") THEN
			REPEAT
				ch := s[i]; INC(i)
			UNTIL ~( ("0" <= ch) & (ch <= "9") OR ("A" <= CAP(ch)) & (CAP(ch) <= "Z")
						OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_") );
			RETURN (ch = 0X) & (i <= LEN(Kernel.Name))
		ELSE
			RETURN FALSE
		END
	END IsIdent;

	PROCEDURE Scan (VAR s: Scanner);
		VAR done: BOOLEAN;
	BEGIN
		s.s.Scan;
		IF (s.s.type = TextMappers.view) THEN
			IF Properties.ThisType(s.s.view, "DevCommanders.View") # NIL THEN s.s.type := execMark END
		ELSIF (s.s.type = TextMappers.string) & TextMappers.IsQualIdent(s.s.string) THEN
			s.s.type := qualident; s.qualident := s.s.string$
		ELSIF (s.s.type = TextMappers.string) & IsIdent(s.s.string) THEN
			s.ident := s.s.string$;
			TextMappers.ScanQualIdent(s.s, s.qualident, done);
			IF done THEN s.s.type := qualident ELSE s.s.type := ident END
		END
	END Scan;

	PROCEDURE GetParExtend (r: TextModels.Reader; VAR end: INTEGER);
		VAR v, v1: Views.View;
	BEGIN
		REPEAT r.ReadView(v); 
			IF v # NIL THEN 
				v1 := v;
				v := Properties.ThisType(v1, "DevCommanders.View") ;
				IF v = NIL THEN v := Properties.ThisType(v1, "DevCommanders.EndView")  END
			END
		UNTIL r.eot OR (v # NIL);
		end := r.Pos(); IF ~r.eot THEN DEC(end) END
	END GetParExtend;

	PROCEDURE Unload (cmd: Dialog.String);
		VAR modname: Kernel.Name; str: Dialog.String; i: INTEGER; ch: CHAR; mod: Kernel.Module;
	BEGIN
		i := 0; ch := cmd[0];
		WHILE (ch # 0X) & (ch # ".") DO modname[i] := SHORT(ch); INC(i); ch := cmd[i] END;
		modname[i] := 0X;
		mod := Kernel.ThisLoadedMod(modname);
		IF mod # NIL THEN
			Kernel.UnloadMod(mod);
			IF mod.refcnt < 0 THEN
				str := modname$;
				Dialog.MapParamString("#Dev:Unloaded", str, "", "", str);
				StdLog.String(str); StdLog.Ln;
				Controls.Relink
			ELSE
				str := modname$;
				Dialog.ShowParamMsg("#Dev:UnloadingFailed", str, "", "")
			END
		END
	END Unload;

	PROCEDURE Execute (t: TextModels.Model; pos: INTEGER; VAR end: INTEGER; unload: BOOLEAN);
		VAR s: Scanner; beg, res: INTEGER; cmd: Dialog.String;
	BEGIN
		end := t.Length();
		s.s.ConnectTo(t); s.s.SetPos(pos); s.s.SetOpts({TextMappers.returnViews});
		Scan(s); ASSERT(s.s.type = execMark, 100);
		Scan(s);
		IF s.s.type IN {qualident, TextMappers.string} THEN
			beg := s.s.Pos() - 1; GetParExtend(s.s.rider, end);
			ASSERT(~cleanerInstalled, 101);
			Kernel.PushTrapCleaner(cleaner); cleanerInstalled := TRUE;
			NEW(par); par.text := t; par.beg := beg; par.end := end;
			IF s.s.type = qualident THEN cmd := s.qualident$ ELSE cmd := s.s.string$ END;
			IF unload (* & (s.s.type = qualident)*) THEN Unload(cmd) END;
			Dialog.Call(cmd, " ",  res);
			par := NIL;
			Kernel.PopTrapCleaner(cleaner); cleanerInstalled := FALSE;
		END
	END Execute;

	PROCEDURE Track (v: View; f: Views.Frame; x, y: INTEGER; buttons: SET);
		VAR c: Models.Context; w, h, end: INTEGER; isDown, in, in0: BOOLEAN; m: SET;
	BEGIN
		c := v.context; c.GetSize(w, h); in0 := FALSE; in := TRUE;
		REPEAT
			IF in # in0 THEN
				f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.show); in0 := in
			END;
			f.Input(x, y, m, isDown);
			in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
		UNTIL ~isDown;
		IF in0 THEN
			f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.hide);
			WITH c:TextModels.Context DO
				Execute(c.ThisModel(), c.Pos(), end,Controllers.modify IN buttons)
			ELSE Dialog.Beep
			END
		END
	END Track;

	(* StdView *)

	PROCEDURE (v: StdView) Externalize (VAR wr: Stores.Writer);
	BEGIN
		v.Externalize^(wr);
		wr.WriteVersion(maxStdVersion)
	END Externalize;

	PROCEDURE (v: StdView) Internalize (VAR rd: Stores.Reader);
		VAR thisVersion: INTEGER;
	BEGIN
		v.Internalize^(rd);
		IF rd.cancelled THEN RETURN END;
		rd.ReadVersion(minVersion, maxStdVersion, thisVersion)
	END Internalize;

	PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
		CONST u = point;
		VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
			size, d, w, asc, dsc, fw: INTEGER; s: ARRAY 2 OF CHAR;
	BEGIN
		ASSERT(v.context # NIL, 20);
		c := v.context;
		WITH c: TextModels.Context DO a := c.Attr(); font := a.font; color := a.color
		ELSE font := Fonts.dir.Default(); color := Ports.defaultColor
		END;
		font.GetBounds(asc, dsc, fw);
		size := asc + dsc; d := size DIV 2;
		f.DrawOval(u, 0, u + size, size, Ports.fill, color);
		s := "!";
		w := font.StringWidth(s);
		f.DrawString(u + d - w DIV 2, size - dsc, Ports.background, s, font)
	END Restore;

	PROCEDURE (v: StdView) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
																		VAR focus: Views.View);
	BEGIN
		WITH msg: Controllers.TrackMsg DO
			Track(v, f, msg.x, msg.y, msg.modifiers)
		| msg: Controllers.PollCursorMsg DO
			msg.cursor := Ports.refCursor
		ELSE
		END
	END HandleCtrlMsg;

	PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);
		VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, fw: INTEGER;
	BEGIN
		WITH msg: Properties.Preference DO
			WITH msg: Properties.SizePref DO
				c := v.context;
				IF (c # NIL) & (c IS TextModels.Context) THEN
					a := c(TextModels.Context).Attr(); font := a.font
				ELSE font := Fonts.dir.Default()
				END;
				font.GetBounds(asc, dsc, fw);
				msg.h := asc + dsc; msg.w := msg.h + 2 * point
			| msg: Properties.ResizePref DO
				msg.fixed := TRUE
			| msg: Properties.FocusPref DO
				msg.hotFocus := TRUE
			| msg: TextSetters.Pref DO
				c := v.context;
				IF (c # NIL) & (c IS TextModels.Context) THEN
					a := c(TextModels.Context).Attr(); font := a.font
				ELSE font := Fonts.dir.Default()
				END;
				font.GetBounds(asc, msg.dsc, fw)
			| msg: Properties.TypePref DO
				IF Services.Is(v, msg.type) THEN msg.view := v END
			ELSE
			END
		ELSE
		END
	END HandlePropMsg;
	
	
	(* StdEndView *)

	PROCEDURE (v: StdEndView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
		CONST u = point;
		VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
			size, w, asc, dsc, fw: INTEGER; s: ARRAY 2 OF CHAR;
			points: ARRAY 3 OF Ports.Point;
	BEGIN
		ASSERT(v.context # NIL, 20);
		c := v.context;
		WITH c: TextModels.Context DO a := c.Attr(); font := a.font; color := a.color
		ELSE font := Fonts.dir.Default(); color := Ports.defaultColor
		END;
		font.GetBounds(asc, dsc, fw);
		size := asc + dsc;
		points[0].x := 0; points[0].y := size;
		points[1].x := u + (size DIV 2); points[1].y := size DIV 2;
		points[2].x := u + (size DIV 2); points[2].y := size;     
		f.DrawPath(points, 3, Ports.fill, color, Ports.closedPoly)
	END Restore;
	
	PROCEDURE (v: StdEndView) HandlePropMsg (VAR msg: Properties.Message);
		VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, fw: INTEGER;
	BEGIN
		WITH msg: Properties.Preference DO
			WITH msg: Properties.SizePref DO
				c := v.context;
				IF (c # NIL) & (c IS TextModels.Context) THEN
					a := c(TextModels.Context).Attr(); font := a.font
				ELSE font := Fonts.dir.Default()
				END;
				font.GetBounds(asc, dsc, fw);
				msg.h := asc + dsc; msg.w := (msg.h + 2 * point) DIV 2
			| msg: Properties.ResizePref DO
				msg.fixed := TRUE
			| msg: Properties.FocusPref DO
				msg.hotFocus := TRUE
			| msg: TextSetters.Pref DO
				c := v.context;
				IF (c # NIL) & (c IS TextModels.Context) THEN
					a := c(TextModels.Context).Attr(); font := a.font
				ELSE font := Fonts.dir.Default()
				END;
				font.GetBounds(asc, msg.dsc, fw)
			| msg: Properties.TypePref DO
				IF Services.Is(v, msg.type) THEN msg.view := v END
			ELSE
			END
		ELSE
		END
	END HandlePropMsg;

	(* StdDirectory *)

	PROCEDURE (d: StdDirectory) New (): View;
		VAR v: StdView;
	BEGIN
		NEW(v); RETURN v
	END New;
	
	PROCEDURE (d: StdDirectory) NewEnd (): EndView;
		VAR v: StdEndView;
	BEGIN
		NEW(v); RETURN v
	END NewEnd;

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

	PROCEDURE DepositEnd*;
	BEGIN
		Views.Deposit(dir.NewEnd())
	END DepositEnd;

	PROCEDURE SetDir* (d: Directory);
	BEGIN
		dir := d
	END SetDir;

	PROCEDURE Init;
		VAR d: StdDirectory;
	BEGIN
		NEW(d); dir := d; stdDir := d;
		NEW(cleaner); cleanerInstalled := FALSE;
	END Init;

BEGIN
	Init
END DevCommanders.