MODULE Controllers;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
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.