MODULE WMMessages;
IMPORT
Strings, KernelLog, Objects, Kernel, Locks;
CONST
MsgQSize = 128;
MsgPointer* = 0; MsgKey* = 2; MsgClose* = 3; MsgStyleChanged* = 4;
MsgFocus* = 5; MsgExt* = 6; MsgDrag* = 7;
MsgInvokeEvent* = 8;
MsgResized* = 9;
MsgSetLanguage* = 10;
MsgSubPointerMove* = 0; MsgSubPointerDown* = 1; MsgSubPointerUp* = 2; MsgSubPointerLeave* = 3;
MsgSubFocusGot* = 0; MsgSubFocusLost* = 1; MsgSubMasterFocusGot* = 2; MsgSubMasterFocusLost* = 3;
MsgDragOver* = 0; MsgDragDropped* = 1;
Statistics* = TRUE;
MsgTypeMax* = 10;
TYPE
CompCommand* = PROCEDURE { DELEGATE } (sender, par : ANY);
String* = Strings.String;
Message* = RECORD
originator*,
sender* : ANY;
token* : AsyncToken;
event* : CompCommand;
msgType*, msgSubType* : LONGINT;
x*, y*, z*, dx*, dy*, dz* : LONGINT;
flags* : SET;
ext* : ANY;
END;
MessageExtension* = POINTER TO RECORD END;
AsyncToken* = OBJECT
VAR
ready : BOOLEAN;
result* : ANY;
PROCEDURE Reset*;
BEGIN {EXCLUSIVE}
ready := FALSE;
END Reset;
PROCEDURE AwaitCompletion*;
BEGIN {EXCLUSIVE}
AWAIT(ready)
END AwaitCompletion;
PROCEDURE IsCompleted*():BOOLEAN;
BEGIN {EXCLUSIVE}
RETURN ready
END IsCompleted;
PROCEDURE Completed*;
BEGIN {EXCLUSIVE}
ready := TRUE
END Completed;
END AsyncToken;
MessageHandler* = PROCEDURE {DELEGATE} (VAR msg : Message);
TrapHandler* = PROCEDURE {DELEGATE} () : BOOLEAN;
MsgSequencer* = OBJECT
VAR
head, num : LONGINT;
msgQ : ARRAY MsgQSize OF Message;
alive, continue, hadOverflow : BOOLEAN;
msg : Message;
handler : MessageHandler;
originator : ANY;
me : ANY;
lock- : Locks.RWLock;
th, traphandler : TrapHandler;
name* : String;
trapOnOverflow* : BOOLEAN;
PROCEDURE &New*(handler : MessageHandler);
BEGIN
SELF.handler := handler;
NEW(lock);
head := 0; num := 0;
originator := NIL; me := NIL; th := NIL; traphandler := NIL;
name := NIL;
alive := FALSE; continue := TRUE; hadOverflow := FALSE; trapOnOverflow := FALSE;
END New;
PROCEDURE SetTrapHandler*(th : TrapHandler);
BEGIN {EXCLUSIVE}
traphandler := th
END SetTrapHandler;
PROCEDURE IsCallFromSequencer*() : BOOLEAN;
BEGIN
RETURN Objects.ActiveObject() = me
END IsCallFromSequencer;
PROCEDURE GetOriginator*() : ANY;
BEGIN
IF Objects.ActiveObject() = me THEN RETURN originator
ELSE RETURN NIL
END
END GetOriginator;
PROCEDURE Add*(VAR msg : Message) : BOOLEAN;
VAR i : LONGINT;
BEGIN {EXCLUSIVE}
IF (msg.msgType = MsgPointer) & (num > 0) THEN
i := num - 1;
WHILE i >= 0 DO
IF (msgQ[(head + i) MOD MsgQSize].msgType = MsgPointer) & (msg.msgSubType = MsgSubPointerMove) & (msgQ[(head + i) MOD MsgQSize].flags = msg.flags) THEN
msgQ[(head + i) MOD MsgQSize].x := msg.x;
msgQ[(head + i) MOD MsgQSize].y := msg.y;
msgQ[(head + i) MOD MsgQSize].z := msg.z;
RETURN TRUE
END;
DEC(i)
END
END;
IF num < MsgQSize THEN
IF Statistics THEN
INC(messagesAdded);
IF (msg.msgType >= 0) & (msg.msgType < MsgTypeMax) THEN
INC(messagesAddedByType[msg.msgType]);
END;
END;
msgQ[(head + num) MOD MsgQSize] := msg; INC(num);
RETURN TRUE
ELSE
IF Statistics THEN INC(messagesDiscarded); END;
IF ~hadOverflow THEN
IF name # NIL THEN KernelLog.String(name^); KernelLog.String(" : ") END;
IF trapOnOverflow THEN HALT(123456) END;
hadOverflow := TRUE;
END;
RETURN FALSE
END
END Add;
PROCEDURE Handle(VAR msg : Message) : BOOLEAN;
BEGIN
IF ~IsCallFromSequencer() THEN RETURN Add(msg)
ELSE
IF msg.msgType = MsgInvokeEvent THEN
IF msg.event # NIL THEN
msg.event(msg.sender, msg.ext);
IF msg.token # NIL THEN msg.token.Completed END
END
ELSE handler(msg)
END;
msg.originator := NIL;
msg.sender := NIL;
msg.ext := NIL;
originator := NIL;
RETURN TRUE
END
END Handle;
PROCEDURE ScheduleEvent*(event : CompCommand; sender, par : ANY);
VAR invokeMsg : Message;
BEGIN
invokeMsg.msgType := MsgInvokeEvent;
invokeMsg.sender := sender; invokeMsg.ext := par;
invokeMsg.event := event;
IF ~Handle(invokeMsg) THEN END
END ScheduleEvent;
PROCEDURE Stop*;
BEGIN {EXCLUSIVE}
alive := FALSE
END Stop;
PROCEDURE Get(VAR msg : Message) : BOOLEAN;
BEGIN {EXCLUSIVE}
IF hadOverflow THEN KernelLog.String(" - Recovered"); hadOverflow := FALSE END;
AWAIT((num # 0) OR ~alive);
IF ~alive THEN RETURN FALSE END;
msg := msgQ[head];
msgQ[head].originator := NIL;
msgQ[head].sender := NIL;
msgQ[head].ext := NIL;
head := (head + 1) MOD MsgQSize;
DEC(num);
originator := msg.originator;
RETURN TRUE
END Get;
BEGIN {ACTIVE, SAFE}
(* trap occured *)
IF alive THEN
th := traphandler; KernelLog.String("WMMessages: [TRAP]"); KernelLog.Ln;
IF th # NIL THEN continue := th() ELSE continue := FALSE END;
IF continue THEN lock.Reset ELSE RETURN END;
END;
alive := TRUE; me := Objects.ActiveObject();
(* Message processing loop *)
WHILE Get(msg) DO
lock.AcquireWrite;
(* Check alive again for the case that the sequencer has been stopped just after Get(msg) returned
but before the lock could be acquired (WMComponents.FormWindow holds that lock when calling Sequencer.Stop) *)
IF alive THEN
IF ~Handle(msg) THEN KernelLog.String("WMMessages: A msg was not handled... "); KernelLog.Ln; END;
END;
lock.ReleaseWrite
END
END MsgSequencer;
VAR
tokenCache : Kernel.FinalizedCollection;
ttoken : AsyncToken;
messagesAddedByType- : ARRAY MsgTypeMax OF LONGINT;
messagesAdded- : LONGINT;
messagesDiscarded- : LONGINT;
PROCEDURE TokenEnumerator(obj: ANY; VAR cont: BOOLEAN);
BEGIN
cont := FALSE; ttoken := obj(AsyncToken)
END TokenEnumerator;
PROCEDURE GetAsyncToken*() : AsyncToken;
BEGIN {EXCLUSIVE}
ttoken := NIL;
tokenCache.Enumerate(TokenEnumerator);
IF ttoken = NIL THEN NEW(ttoken)
ELSE tokenCache.Remove(ttoken)
END;
ttoken.Reset;
RETURN ttoken
END GetAsyncToken;
PROCEDURE RecycleAsyncToken*(t : AsyncToken);
BEGIN
IF t.IsCompleted() THEN tokenCache.Add(t, NIL) END;
END RecycleAsyncToken;
BEGIN
NEW(tokenCache)
END WMMessages.