blackbox-linux-console/BlackBox/System/Mod/Controllers.txt

MODULE Controllers;

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

	IMPORT Kernel, Services, Ports, Stores, Models, Views;

	CONST
		(** Forward target **)
		targetPath* = TRUE; frontPath* = FALSE;

		(** ScrollMsg.op **)
		decLine* = 0; incLine* = 1; decPage* = 2; incPage* = 3; gotoPos* = 4;

		(** PageMsg.op **)
		nextPageX* = 0; nextPageY* = 1; gotoPageX* = 2; gotoPageY* = 3;

		(** PollOpsMsg.valid, EditMsg.op **)
		cut* = 0; copy* = 1;
		pasteChar* = 2; (* pasteLChar* = 3; *) paste* = 4; (* pasteView* = 5; *)

		(** TrackMsg.modifiers, EditMsg.modifiers **)
		doubleClick* = 0;	(** clicking history **)
		extend* = 1; modify* = 2;	(** modifier keys **)
		(* extend = Sub.extend; modify = Sub.modify *)

		(** PollDropMsg.mark, PollDrop mark **)
		noMark* = FALSE; mark* = TRUE;
		(** PollDropMsg.show, PollDrop show **)
		hide* = FALSE; show* = TRUE;

		minVersion = 0; maxVersion = 0;


	TYPE

		(** messages **)

		Message* = Views.CtrlMessage;

		PollFocusMsg* = EXTENSIBLE RECORD (Message)
			focus*: Views.Frame	(** OUT, preset to NIL **)
		END;

		PollSectionMsg* = RECORD (Message)
			focus*, vertical*: BOOLEAN;	(** IN **)
			wholeSize*: INTEGER;	(** OUT, preset to 1 **)
			partSize*: INTEGER;	(** OUT, preset to 1 **)
			partPos*: INTEGER;	(** OUT, preset to 0 **)
			valid*, done*: BOOLEAN	(** OUT, preset to (FALSE, FALSE) **)
		END;

		PollOpsMsg* = RECORD (Message)
			type*: Stores.TypeName;	(** OUT, preset to "" **)
			pasteType*: Stores.TypeName;	(** OUT, preset to "" **)
			singleton*: Views.View;	(** OUT, preset to NIL **)
			selectable*: BOOLEAN;	(** OUT, preset to FALSE **)
			valid*: SET	(** OUT, preset to {} **)
		END;

		ScrollMsg* = RECORD (Message)
			focus*, vertical*: BOOLEAN;	(** IN **)
			op*: INTEGER;	(** IN **)
			pos*: INTEGER;	(** IN **)
			done*: BOOLEAN	(** OUT, preset to FALSE **)
		END;

		PageMsg* = RECORD (Message)
			op*: INTEGER;	(** IN **)
			pageX*, pageY*: INTEGER;	(** IN **)
			done*, eox*, eoy*: BOOLEAN	(** OUT, preset to (FALSE, FALSE, FALSE) **)
		END;

		TickMsg* = RECORD (Message)
			tick*: INTEGER	(** IN **)
		END;

		MarkMsg* = RECORD (Message)
			show*: BOOLEAN;	(** IN **)
			focus*: BOOLEAN	(** IN **)
		END;

		SelectMsg* = RECORD (Message)
			set*: BOOLEAN	(** IN **)
		END;


		RequestMessage* = ABSTRACT RECORD (Message)
			requestFocus*: BOOLEAN	(** OUT, preset (by framework) to FALSE **)
		END;

		EditMsg* = RECORD (RequestMessage)
			op*: INTEGER;	(** IN **)
			modifiers*: SET;	(** IN, valid if op IN {pasteChar, pasteLchar} **)
			char*: CHAR;	(** IN, valid if op = pasteChar **)
			view*: Views.View; w*, h*: INTEGER;	(** IN, valid if op  = paste **)
														(** OUT, valid if op IN {cut, copy} **)
			isSingle*: BOOLEAN;	(** dito **)
			clipboard*: BOOLEAN	(** IN, valid if op IN {cut, copy, paste} **)
		END;

		ReplaceViewMsg* = RECORD (RequestMessage)
			old*, new*: Views.View	(** IN **)
		END;


		CursorMessage* = ABSTRACT RECORD (RequestMessage)
			x*, y*: INTEGER	(** IN, needs translation when passed on **)
		END;

		PollCursorMsg* = RECORD (CursorMessage)
			cursor*: INTEGER;	(** OUT, preset to Ports.arrowCursor **)
			modifiers*: SET	(** IN **)
		END;

		TrackMsg* = RECORD (CursorMessage)
			modifiers*: SET	(** IN **)
		END;

		WheelMsg* = RECORD (CursorMessage)
			done*: BOOLEAN; 		(** must be set if the message is handled **)
			op*, nofLines*: INTEGER;
		END;


		TransferMessage* = ABSTRACT RECORD (CursorMessage)
			source*: Views.Frame;	(** IN, home frame of transfer originator, may be NIL if unknown **)
			sourceX*, sourceY*: INTEGER	(** IN, reference point in source frame, defined if source # NIL **)
		END;

		PollDropMsg* = RECORD (TransferMessage)
			mark*: BOOLEAN;	(** IN, request to mark drop target **)
			show*: BOOLEAN;	(** IN, if mark then show/hide target mark **)
			type*: Stores.TypeName;	(** IN, type of view to drop **)
			isSingle*: BOOLEAN;	(** IN, view to drop is singleton **)
			w*, h*: INTEGER;	(** IN, size of view to drop, may be 0, 0 **)
			rx*, ry*: INTEGER;	(** IN, reference point in view **)
			dest*: Views.Frame	(** OUT, preset to NIL, set if DropMsg is acceptable **)
		END;

		DropMsg* = RECORD (TransferMessage)
			view*: Views.View;	(** IN, drop this *)
			isSingle*: BOOLEAN;	(** IN, view to drop is singleton **)
			w*, h*: INTEGER;	(** IN, proposed size *)
			rx*, ry*: INTEGER	(** IN, reference point in view **)
		END;


		(** controllers **)

		Controller* = POINTER TO ABSTRACT RECORD (Stores.Store) END;


		(** forwarders **)

		Forwarder* = POINTER TO ABSTRACT RECORD
			next: Forwarder
		END;

		TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
		PathInfo = POINTER TO RECORD
			path: BOOLEAN; prev: PathInfo
		END;
		
		BalanceCheckAction = POINTER TO RECORD (Services.Action) 
			wait: WaitAction
		END;
		WaitAction = POINTER TO RECORD (Services.Action) 
			check: BalanceCheckAction
		END;

	VAR
		path-: BOOLEAN;

		list: Forwarder;
		
		cleaner: TrapCleaner;
		prevPath, cache: PathInfo;
		


	(** BalanceCheckAction **)
	
	PROCEDURE (a: BalanceCheckAction) Do;
	BEGIN
		Services.DoLater(a.wait, Services.resolution);
		ASSERT(prevPath = NIL, 100);
	END Do;
	
	PROCEDURE (a: WaitAction) Do;
	BEGIN
		Services.DoLater(a.check, Services.immediately)
	END Do;

	(** Cleaner **)

	PROCEDURE (c: TrapCleaner) Cleanup;
	BEGIN
		path := frontPath;
		prevPath := NIL
	END Cleanup;

	PROCEDURE NewPathInfo(): PathInfo;
		VAR c: PathInfo;
	BEGIN
		IF cache = NIL THEN NEW(c)
		ELSE c := cache; cache := cache.prev
		END;
		RETURN c
	END NewPathInfo;
	
	PROCEDURE DisposePathInfo(c: PathInfo);
	BEGIN
		c.prev := cache; cache := c
	END DisposePathInfo;


	(** Controller **)

	PROCEDURE (c: Controller) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
	(** pre: ~c.init **)
	(** post: c.init **)
		VAR thisVersion: INTEGER;
	BEGIN
		c.Internalize^(rd);
		rd.ReadVersion(minVersion, maxVersion, thisVersion)
	END Internalize;

	PROCEDURE (c: Controller) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
	(** pre: c.init **)
	BEGIN
		c.Externalize^(wr);
		wr.WriteVersion(maxVersion)
	END Externalize;


	(** Forwarder **)

	PROCEDURE (f: Forwarder) Forward* (target: BOOLEAN; VAR msg: Message), NEW, ABSTRACT;
	PROCEDURE (f: Forwarder) Transfer* (VAR msg: TransferMessage), NEW, ABSTRACT;

	PROCEDURE Register* (f: Forwarder);
		VAR t: Forwarder;
	BEGIN
		ASSERT(f # NIL, 20);
		t := list; WHILE (t # NIL) & (t # f) DO t := t.next END;
		IF t = NIL THEN f.next := list; list := f END
	END Register;

	PROCEDURE Delete* (f: Forwarder);
		VAR t: Forwarder;
	BEGIN
		ASSERT(f # NIL, 20);
		IF f = list THEN
			list := list.next
		ELSE
			t := list; WHILE (t # NIL) & (t.next # f) DO t := t.next END;
			IF t # NIL THEN t.next := f.next END
		END;
		f.next := NIL
	END Delete;


	PROCEDURE ForwardVia* (target: BOOLEAN; VAR msg: Message);
		VAR t: Forwarder;
	BEGIN
		t := list; WHILE t # NIL DO t.Forward(target, msg); t := t.next END
	END ForwardVia;

	PROCEDURE SetCurrentPath* (target: BOOLEAN);
		VAR p: PathInfo;
	BEGIN
		IF prevPath = NIL THEN Kernel.PushTrapCleaner(cleaner) END;
		p := NewPathInfo(); p.prev := prevPath; prevPath := p; p.path := path;
		path := target
	END SetCurrentPath;
	
	PROCEDURE ResetCurrentPath*;
		VAR p: PathInfo;
	BEGIN
		IF prevPath # NIL THEN (* otherwise trap cleaner may have already removed prefPath objects *)
			p := prevPath; prevPath := p.prev; path := p.path;
			IF prevPath = NIL THEN Kernel.PopTrapCleaner(cleaner) END;
			DisposePathInfo(p)
		END
	END ResetCurrentPath;

	PROCEDURE Forward* (VAR msg: Message);
	BEGIN
		ForwardVia(path, msg)
	END Forward;

	PROCEDURE PollOps* (VAR msg: PollOpsMsg);
	BEGIN
		msg.type := "";
		msg.pasteType := "";
		msg.singleton := NIL;
		msg.selectable := FALSE;
		msg.valid := {};
		Forward(msg)
	END PollOps;

	PROCEDURE PollCursor* (x, y: INTEGER; modifiers: SET; OUT cursor: INTEGER);
		VAR msg: PollCursorMsg;
	BEGIN
		msg.x := x; msg.y := y; msg.cursor := Ports.arrowCursor; msg.modifiers := modifiers;
		Forward(msg);
		cursor := msg.cursor
	END PollCursor;

	PROCEDURE Transfer* (x, y: INTEGER; source: Views.Frame; sourceX, sourceY: INTEGER; VAR msg: TransferMessage);
		VAR t: Forwarder;
	BEGIN
		ASSERT(source # NIL, 20);
		msg.x := x; msg.y := y;
		msg.source := source; msg.sourceX := sourceX; msg.sourceY := sourceY;
		t := list; WHILE t # NIL DO t.Transfer(msg); t := t.next END
	END Transfer;

	PROCEDURE PollDrop* (x, y: INTEGER;
							source: Views.Frame; sourceX, sourceY: INTEGER;
							mark, show: BOOLEAN;
							type: Stores.TypeName;
							isSingle: BOOLEAN;
							w, h, rx, ry: INTEGER;
							OUT dest: Views.Frame; OUT destX, destY: INTEGER);
		VAR msg: PollDropMsg;
	BEGIN
		ASSERT(source # NIL, 20);
		msg.mark := mark; msg.show := show; msg.type := type; msg.isSingle := isSingle;
		msg.w := w; msg.h := h; msg.rx := rx; msg.ry := ry; msg.dest := NIL;
		Transfer(x, y, source, sourceX, sourceY, msg);
		dest := msg.dest; destX := msg.x; destY := msg.y
	END PollDrop;

	PROCEDURE Drop* (x, y: INTEGER; source: Views.Frame; sourceX, sourceY: INTEGER;
									view: Views.View; isSingle: BOOLEAN; w, h, rx, ry: INTEGER);
		VAR msg: DropMsg;
	BEGIN
		ASSERT(source # NIL, 20); ASSERT(view # NIL, 21);
		msg.view := view; msg.isSingle := isSingle;
		msg.w := w; msg.h := h; msg.rx := rx; msg.ry := ry;
		Transfer(x, y, source, sourceX, sourceY, msg)
	END Drop;

	PROCEDURE PasteView* (view: Views.View; w, h: INTEGER; clipboard: BOOLEAN);
		VAR msg: EditMsg;
	BEGIN
		ASSERT(view # NIL, 20);
		msg.op := paste; msg.isSingle := TRUE;
		msg.clipboard := clipboard;
		msg.view := view; msg.w := w; msg.h := h;
		Forward(msg)
	END PasteView;


	PROCEDURE FocusFrame* (): Views.Frame;
		VAR msg: PollFocusMsg;
	BEGIN
		msg.focus := NIL; Forward(msg); RETURN msg.focus
	END FocusFrame;

	PROCEDURE FocusView* (): Views.View;
		VAR focus: Views.Frame;
	BEGIN
		focus := FocusFrame();
		IF focus # NIL THEN RETURN focus.view ELSE RETURN NIL END
	END FocusView;

	PROCEDURE FocusModel* (): Models.Model;
		VAR focus: Views.Frame;
	BEGIN
		focus := FocusFrame();
		IF focus # NIL THEN RETURN focus.view.ThisModel() ELSE RETURN NIL END
	END FocusModel;


	PROCEDURE HandleCtrlMsgs (op: INTEGER; f, g: Views.Frame; VAR msg: Message; VAR mark, front, req: BOOLEAN);
	(* g = f.up OR g = NIL *)
		CONST pre = 0; translate = 1; backoff = 2; final = 3;
	BEGIN
		CASE op OF
		  pre:
			WITH msg: MarkMsg DO
				IF msg.show & (g # NIL) THEN mark := TRUE; front := g.front END
			| msg: RequestMessage DO
				msg.requestFocus := FALSE
			ELSE
			END
		| translate:
			WITH msg: CursorMessage DO
				msg.x := msg.x + f.gx - g.gx;
				msg.y := msg.y + f.gy - g.gy
			ELSE
			END
		| backoff:
			WITH msg: MarkMsg DO
				IF ~msg.show THEN mark := FALSE; front := FALSE END
			| msg: RequestMessage DO
				req := msg.requestFocus
			ELSE
			END
		| final:
			WITH msg: PollFocusMsg DO
				IF msg.focus = NIL THEN msg.focus := f END
			| msg: MarkMsg DO
				IF ~msg.show THEN mark := FALSE; front := FALSE END
			| msg: RequestMessage DO
				req := msg.requestFocus
			ELSE
			END
		END
	END HandleCtrlMsgs;


	PROCEDURE Init;
		VAR action: BalanceCheckAction; w: WaitAction;
	BEGIN
		Views.InitCtrl(HandleCtrlMsgs);
		NEW(cleaner);
		NEW(action); NEW(w); action.wait := w; w.check := action; Services.DoLater(action, Services.immediately);
	END Init;

BEGIN
	Init
END Controllers.