MessageWindowImpl.mesa
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
McGregor on September 10, 1982 10:41 am
Maxwell, February 14, 1983 10:22 am
Paul Rovner, June 16, 1983 8:53 am
Russ Atkinson, November 18, 1983 1:30 pm
Doug Wyatt, May 6, 1985 10:28:27 am PDT
Michael Plass, May 8, 1986 10:07:26 am PDT
DIRECTORY
BasicTime USING [GetClockPulses, Pulses, PulsesToMicroseconds],
Imager USING [black, MaskRectangle, MaskRectangleI, SetColor, SetFont, SetGray, SetXY, SetXYI, ShowRope, ShowText, white],
ImagerBackdoor USING [invert],
ImagerFont USING [RopeWidth],
MessageWindow USING [],
Process USING [Detach, Milliseconds, MsecToTicks, Pause],
Real USING [Round],
Rope USING [Equal, Fetch, FromRefText, ROPE, Size],
RuntimeError USING [UNCAUGHT],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPScreenCoordsRec, TIPTable],
VFonts USING [defaultFont],
ViewerClasses USING [ModifyProc, NotifyProc, PaintProc, Viewer, ViewerClass, ViewerClassRec],
ViewerForkers USING [ForkPaint],
ViewerLocks USING [CallUnderWriteLock, Wedged],
ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass],
ViewerPrivate USING [], -- exports messageWindow
ViewerSpecs USING [bwScreenHeight, bwScreenWidth, messageWindowHeight];
MessageWindowImpl: CEDAR MONITOR
IMPORTS BasicTime, Imager, ImagerBackdoor, ImagerFont, Process, Real, Rope, RuntimeError, TIPUser, VFonts, ViewerForkers, ViewerLocks, ViewerOps, ViewerSpecs
EXPORTS MessageWindow, ViewerPrivate
= BEGIN
ROPE: TYPE ~ Rope.ROPE;
messageWindow: PUBLIC ViewerClasses.Viewer ← NIL;
Message Replay
replayPause: Process.Milliseconds ← 750;
Replay: PROC [messages: LIST OF ROPE] ~ {
prev: ROPENIL;
WHILE messages # NIL DO
IF Rope.Size[messages.first] = 0 OR Rope.Equal[messages.first, prev]
THEN NULL
ELSE {
IF prev # NIL THEN Process.Pause[Process.MsecToTicks[replayPause]];
Append[messages.first, TRUE];
prev ← messages.first;
};
messages ← messages.rest;
ENDLOOP;
};
Message Queueing
This section maintains a queue of unposted messages, and has a consumer process to post them. It is layered on the older mechanism; in the best of worlds it would all be better integrated, but it was done this way to avoid the risk of breaking what was there. — mfp
avail: LIST OF ROPENIL;
queue: LIST OF ROPENIL;
last: LIST OF ROPENIL;
postmasterActive: BOOLFALSE;
queueSize: CARDINAL ← 0;
pendingClears: CARDINAL ← 0;
clearToken: ROPE ~ "clear";
blinkToken: ROPE ~ "blink";
KosherRope: PROC [ref: REF] RETURNS [ROPE] ~ {
In case somebody was trusting a REF TEXT to look like a ROPE.
WITH ref SELECT FROM
rope: ROPE => RETURN [rope];
text: REF TEXT => RETURN [Rope.FromRefText[text]];
ENDCASE => RETURN [NIL];
};
AddToQueue: ENTRY PROC [rope: ROPE] ~ {
new: LIST OF ROPENIL;
IF rope = clearToken AND last#NIL AND last.first = clearToken THEN RETURN;
IF avail = NIL
THEN new ← LIST[rope]
ELSE {new ← avail; avail ← new.rest; new.rest ← NIL; new.first ← rope};
IF queue = NIL
THEN { queue ← last ← new }
ELSE { last.rest ← new; last ← new };
queueSize ← queueSize + 1;
IF rope = clearToken THEN pendingClears ← pendingClears + 1;
IF NOT postmasterActive
THEN TRUSTED { Process.Detach[FORK PostMaster[]]; postmasterActive ← TRUE };
NOTIFY dally;
};
dally: CONDITION ← [timeout: Process.MsecToTicks[1000]];
ReadQueue: ENTRY PROC RETURNS [rope: ROPENIL] ~ {
Try: PROC ~ {
IF queue # NIL THEN {
old: LIST OF ROPE ~ queue;
rope ← old.first;
queue ← old.rest;
IF old.rest=NIL THEN last ← NIL;
old.first ← NIL;
old.rest ← avail;
avail ← old;
queueSize ← queueSize - 1;
};
};
Try[];
IF rope = NIL THEN {WAIT dally; Try[]};
IF rope = NIL THEN {postmasterActive ← FALSE; IF queue # NIL THEN ERROR};
IF rope = clearToken THEN pendingClears ← pendingClears - 1;
};
MoreText: ENTRY PROC RETURNS [BOOL] ~ {
Returns true if there is a pending action to append more text to the window; good for punting provably redundant repaints.
RETURN [queue # NIL AND (SELECT queue.first FROM clearToken, blinkToken => FALSE ENDCASE => TRUE)]
};
Clear: PUBLIC PROC = { AddToQueue[clearToken] };
Append: PUBLIC PROC [message: ROPE, clearFirst: BOOLFALSE] = {
IF clearFirst THEN AddToQueue[clearToken];
IF message # NIL THEN AddToQueue[KosherRope[message]];
};
Blink: PUBLIC PROC = { AddToQueue[blinkToken] };
shortQueue: CARDINAL ← 5; -- If there are more pending clears than this, use shortPause
longQueue: CARDINAL ← 30; -- If there are more pending clears than this, don't pause
shortPause: Process.Milliseconds ← 200;
longerPause: Process.Milliseconds ← 500; -- normal persistence before a message dies
PostMaster: PROC ~ {
lastAppend: BasicTime.Pulses ← BasicTime.GetClockPulses[]-1000000;
DO
rope: ROPE ~ ReadQueue[];
SELECT rope FROM
NIL => EXIT; -- No action for awhile, so kill this process.
clearToken => {
The idea here is to not clear the previous message until it has been around for a certain amount of time. Since ReadQueue times out with NIL if nothing happens for awhile, we know that pulsesWaited should not get too big, but we guard against overflow anyway.
pulsesWaited: LONG CARDINAL ← BasicTime.GetClockPulses[]-lastAppend;
msWaited: CARDINALMIN[BasicTime.PulsesToMicroseconds[pulsesWaited]/1000, 10000];
msToWait: CARDINALIF queueSize > shortQueue THEN shortPause ELSE longerPause;
IF queueSize < longQueue AND msToWait > msWaited
THEN Process.Pause[Process.MsecToTicks[msToWait-msWaited]];
ClearPrivate[];
};
blinkToken => {BlinkPrivate[]; lastAppend ← BasicTime.GetClockPulses[]};
ENDCASE => {AppendPrivate[rope]; lastAppend ← BasicTime.GetClockPulses[]};
ENDLOOP;
};
Old Stuff
mode: {none, confirm} ← none;
ready: BOOLFALSE;
confirm: BOOL;
inputReady: CONDITION;
empty: BOOLTRUE;
maxLength: INTEGER = 120;
static: REF TEXTNEW[TEXT[maxLength]];
ringSize: NAT ~ 10;
RingIndex: TYPE ~ [0..ringSize);
RingArray: TYPE ~ ARRAY RingIndex OF REF TEXT;
ringIndex: RingIndex ← 0;
ring: REF RingArray ← CreateRingArray[];
CreateRingArray: PROC RETURNS [ring: REF RingArray] ~ {
ring ← NEW[RingArray ← ALL[NIL]];
FOR i: RingIndex IN RingIndex DO ring[i] ← NEW[TEXT[maxLength]] ENDLOOP;
};
GetHistory: PROC RETURNS [list: LIST OF ROPENIL] ~ {
FOR i: RingIndex IN RingIndex DO
r: RingIndex ~ (ringIndex+ringSize-i) MOD ringSize;
text: REF TEXT ~ ring[r];
list ← CONS[Rope.FromRefText[text], list];
ENDLOOP;
};
ClearStatic: PROC ~ {
IF static.length=0 THEN RETURN;
ringIndex ← (ringIndex+1) MOD ringSize;
static ← ring[ringIndex];
static.length ← 0;
};
ClearInternal: PROC = {
ClearStatic[];
empty ← TRUE;
ViewerOps.PaintViewer[viewer: messageWindow, hint: client, whatChanged: $Clear];
};
ClearPrivate: PROC = {
IF empty OR messageWindow=NIL THEN RETURN;
ViewerLocks.CallUnderWriteLock[ClearInternal, messageWindow !
ViewerLocks.Wedged => CONTINUE];
};
AppendPrivate: PROC [message: ROPE] = {
LockedAppend: PROC = {
FOR n: INT IN [0..Rope.Size[message]) DO
IF static.length >= maxLength THEN EXIT;
static[static.length] ← Rope.Fetch[message, n];
static.length ← static.length + 1;
ENDLOOP;
IF NOT MoreText[] THEN ViewerOps.PaintViewer[messageWindow, client, TRUE, $Append];
empty ← FALSE;
};
IF messageWindow=NIL THEN RETURN;
ViewerLocks.CallUnderWriteLock[LockedAppend, messageWindow
! ViewerLocks.Wedged => CONTINUE];
};
BlinkPrivate: PROC = {
Inner: PROC ~ {
THROUGH [0..6) DO
ViewerOps.PaintViewer[messageWindow, client, FALSE, $Invert];
Process.Pause[Process.MsecToTicks[120]];
ENDLOOP;
};
IF messageWindow#NIL THEN ViewerLocks.CallUnderWriteLock[Inner, messageWindow ! ViewerLocks.Wedged => CONTINUE];
};
ReadFrom: PUBLIC PROC RETURNS [message: ROPENIL] = {ERROR};
De-implemented.
confirmPrompt: ROPENIL;
nextInLine: CONDITION;
Confirm: PUBLIC ENTRY PROC [prompt: ROPENIL] RETURNS [BOOL] = {
WHILE mode#none DO WAIT nextInLine; ENDLOOP; -- wait in line
confirmPrompt ← prompt;
mode ← confirm;
ready ← FALSE;
ViewerForkers.ForkPaint[messageWindow, client];
UNTIL ready=TRUE DO WAIT inputReady; ENDLOOP;
ready ← FALSE;
mode ← none;
confirmPrompt ← NIL;
NOTIFY nextInLine;
ViewerForkers.ForkPaint[messageWindow, client];
RETURN[confirm];
};
MessageWindowPaint: ViewerClasses.PaintProc = {
IF whatChanged = $Invert THEN {
Imager.SetColor[context, ImagerBackdoor.invert];
Imager.MaskRectangleI[context, 0, 0, messageWindow.cw, messageWindow.ch];
}
ELSE {
bottomOffset: INTEGER = 3;
hOffset: INTEGER = 2;
IF NOT clear THEN {
Imager.SetColor[context, Imager.white];
Imager.MaskRectangleI[context, 0, 0, messageWindow.cw, messageWindow.ch];
};
Imager.SetColor[context, Imager.black];
Imager.SetXYI[context, hOffset, bottomOffset];
Imager.SetFont[context, VFonts.defaultFont];
Imager.ShowText[context, static];
IF mode = confirm THEN {
x: REAL ← self.cw;
a: ARRAY [0..8] OF REALALL[0.0];
a[8] ← x ← x-2*hOffset;
a[7] ← x ← x-1;
a[6] ← x ← x-hOffset-ImagerFont.RopeWidth[VFonts.defaultFont, "No"].x;
a[5] ← x ← x-hOffset;
a[4] ← x ← x-1;
a[3] ← x ← x-hOffset-ImagerFont.RopeWidth[VFonts.defaultFont, "Yes"].x;
a[2] ← x ← x-hOffset;
a[1] ← x ← x-1;
a[0] ← x ← x-hOffset-ImagerFont.RopeWidth[VFonts.defaultFont, confirmPrompt].x;
Imager.MaskRectangle[context, [a[0]-hOffset, 0, messageWindow.cw, messageWindow.ch]];
Imager.SetGray[context, 0];
Imager.MaskRectangle[context, [a[2], 0, a[7]-a[2], messageWindow.ch]];
Imager.SetXY[context, [a[0], bottomOffset]];
Imager.ShowRope[context, confirmPrompt];
Imager.SetGray[context, 1];
Imager.SetXY[context, [a[3], bottomOffset]];
Imager.ShowRope[context, "Yes"];
Imager.SetXY[context, [a[6], bottomOffset]];
Imager.ShowRope[context, "No"];
Imager.MaskRectangle[context, [a[4], 0, 1, messageWindow.ch]];
SetConfirmation[yes0: a[2], yes1: a[4], no0: a[5], no1: a[7]];
Imager.SetColor[context, ImagerBackdoor.invert];
Process.Pause[Process.MsecToTicks[100]];
Imager.MaskRectangle[context, [a[0], 0, messageWindow.cw, messageWindow.ch]];
Process.Pause[Process.MsecToTicks[100]];
Imager.MaskRectangle[context, [a[0], 0, messageWindow.cw, messageWindow.ch]];
};
};
};
yesMin: INTEGER ← 0;
yesMax: INTEGER ← 0;
noMin: INTEGER ← 0;
noMax: INTEGER ← 0;
SetConfirmation: ENTRY PROC [yes0, yes1, no0, no1: REAL] ~ {
yesMin ← Real.Round[yes0];
yesMax ← Real.Round[yes1];
noMin ← Real.Round[no0];
noMax ← Real.Round[no1];
};
TryConfirmation: ENTRY PROC [x: INTEGER] RETURNS [BOOL] ~ {
IF mode # confirm THEN RETURN [FALSE];
ready ← TRUE;
SELECT x FROM
IN [yesMin..yesMax) => {confirm ← TRUE};
IN [noMin..noMax) => {confirm ← FALSE};
ENDCASE => {ready ← FALSE};
IF ready THEN {
yesMin ← yesMax ← noMin ← noMax ← 0;
NOTIFY inputReady;
};
RETURN [TRUE];
};
MessageWindowNotify: ViewerClasses.NotifyProc = {
mouse: TIPUser.TIPScreenCoordsRec ← [mouseX: 0, mouseY: 0, color: FALSE];
FOR l: LIST OF REF ANY ← input, l.rest UNTIL l=NIL DO
WITH l.first SELECT FROM
z: TIPUser.TIPScreenCoords => mouse ← z^;
atom: ATOM => SELECT atom FROM
$ButtonHit => IF TryConfirmation[mouse.mouseX] THEN NULL ELSE Clear[];
$Replay => IF TryConfirmation[mouse.mouseX] THEN NULL ELSE TRUSTED {
messages: LIST OF ROPE ~ GetHistory[];
Process.Detach[FORK Replay[messages]];
};
ENDCASE => NULL;
ENDCASE => NULL;
ENDLOOP;
};
FindTIPTable: PROC RETURNS [tipTable: TIPUser.TIPTable ← NIL] ~ {
tipTable ← TIPUser.InstantiateNewTIPTable["[]<>NewMessageWindow.tip" ! RuntimeError.UNCAUGHT => CONTINUE];
};
messageWindowClass: ViewerClasses.ViewerClass ← NEW[ViewerClasses.ViewerClassRec ← [
paint: MessageWindowPaint,
notify: MessageWindowNotify,
tipTable: FindTIPTable[]
]];
ViewerOps.RegisterViewerClass[$MessageWindow, messageWindowClass];
messageWindow ← ViewerOps.CreateViewer[$MessageWindow, [name: "MW",
wx: 0, wy: ViewerSpecs.bwScreenHeight-ViewerSpecs.messageWindowHeight,
ww: ViewerSpecs.bwScreenWidth, wh: ViewerSpecs.messageWindowHeight,
column: static
]];
END.