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 [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;


avail: LIST OF ROPE _ NIL;
queue: LIST OF ROPE _ NIL;
last: LIST OF ROPE _ NIL;
postmasterActive: BOOL _ FALSE;
queueSize: CARDINAL _ 0;
pendingClears: CARDINAL _ 0;
clearToken: ROPE ~ "clear";
blinkToken: ROPE ~ "blink";

KosherRope: PROC [ref: REF] RETURNS [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 ROPE _ NIL;
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: ROPE _ NIL] ~ {
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] ~ {
RETURN [queue # NIL AND (SELECT queue.first FROM clearToken, blinkToken => FALSE ENDCASE => TRUE)]
};

Clear: PUBLIC PROC = { AddToQueue[clearToken] };

Append: PUBLIC PROC [message: ROPE, clearFirst: BOOL _ FALSE] = {
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 => {
pulsesWaited: LONG CARDINAL _ BasicTime.GetClockPulses[]-lastAppend;
msWaited: CARDINAL _ MIN[BasicTime.PulsesToMicroseconds[pulsesWaited]/1000, 10000];
msToWait: CARDINAL _ IF 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;
};
mode: {none, confirm} _ none;
ready: BOOL _ FALSE;
confirm: BOOL;
inputReady: CONDITION;

empty: BOOL _ TRUE;

maxLength: INTEGER = 120;
static: REF TEXT _ NEW[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 ROPE _ NIL] ~ {
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: ROPE _ NIL] = {ERROR};

confirmPrompt: ROPE _ NIL;
nextInLine: CONDITION;

Confirm: PUBLIC ENTRY PROC [prompt: ROPE _ NIL] 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 REAL _ ALL[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[];
ENDCASE => NULL;
ENDCASE => NULL;
ENDLOOP;
};

FindTIPTable: PROC RETURNS [tipTable: TIPUser.TIPTable _ NIL] ~ {
tipTable _ TIPUser.InstantiateNewTIPTable["[]<>NewMessageWindow.tip" ! RuntimeError.UNCAUGHT => CONTINUE];
IF tipTable = NIL
THEN tipTable _TIPUser.InstantiateNewTIPTable ["[Cedar]<Cedar6.0>Viewers>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.
nMessageWindowImpl.mesa 
Copyright c 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
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
In case somebody was trusting a REF TEXT to look like a ROPE.
Returns true if there is a pending action to append more text to the window; good for punting provably redundant repaints.
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.
Old Stuff
De-implemented.
Keep the poor devil out of trouble if we can.
Κ
τ˜
codeš
œ™Kšœ
Οm
œ7™BKš
œ'™'Kš
œ#™#Kš
œ"™"K™(K™'K™*—K˜š
Οk	˜	Jšœ
žœ0˜?Jšœžœn˜zJšœžœ
˜Jšœžœ
˜Jšœžœ˜Jšœžœ,˜9Jšœžœ	˜Jšœžœžœ˜,Jšœ
žœžœ˜JšœžœI˜VJšœžœ˜JšœžœJ˜]Jšœžœ
˜ Jšœžœ˜/Jšœ
žœ2˜AJšœžœΟc˜0Jšœžœ6˜G—K˜KšΠblœžœ
ž˜ Kšžœ–
˜
Kšžœ˜$Kšœž˜K˜Kšžœžœžœ
˜K˜Kšœžœžœ
˜1K˜
head™™ŠK˜—Kš	œžœ
žœ
žœžœ
˜Kš	œžœ
žœ
žœžœ
˜Kš	œžœ
žœ
žœžœ
˜Kšœžœžœ
˜Kšœžœ˜Kšœžœ˜Kšœžœ˜šœžœ˜K˜—š
Οn
œžœžœžœžœ˜.Kšœ žœ
žœžœ
™=šžœžœ
ž˜Kšœžœžœ˜Kšœžœ
žœžœ˜2Kšžœžœžœ˜—Kš
œ˜K˜—š‘
œžœ
žœžœ˜'Kš	œžœ
žœ
žœžœ
˜Kšžœžœžœ
žœžœ
žœ
˜Jšžœ	ž˜Kšžœžœ˜Kšžœ,žœ˜G—šžœ	ž˜Kšžœ˜Kšžœ!˜%—Kš
œ˜Kšžœžœ#˜<šžœ
žœ˜Kšžœ
žœžœ#žœ˜L—Kšžœ˜
Kš
œ˜K˜—šœž	œ(˜8K˜—š‘	œžœ
žœ
žœžœžœ˜4š‘œžœ˜
šžœ	žœ
žœ˜Kšœžœ
žœ
žœ	˜Kš
œ˜Kš
œ˜Kšžœ
žœ
žœžœ
˜ Kšœžœ
˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—Kš
œ˜—Kš
œ˜Kšžœžœ
žœžœ˜'Kšžœžœ
žœžœžœ	žœ
žœ
žœ˜IKšžœžœ#˜<Kš
œ˜K˜—š
‘œžœ
žœ
žœžœ˜'K™zKšžœ
žœ
žœžœ
žœžœ
žœžœ˜bKš
œ˜K˜—š‘œžœ
žœ˜0K˜—š‘œžœ
žœžœžœžœ˜AKšžœžœ˜*Jšžœžœ
žœ!˜6K˜K˜—š‘œžœ
žœ˜0K˜—KšœžœŸ=˜WKšœžœŸ:˜TKš
œ'˜'šœ)Ÿ+˜TK˜—š‘
œžœ˜Kš
œB˜Bš
ž˜Kšœžœ˜šžœž˜KšžœžœŸ.˜;š
œ˜KšœŠ
žœw™„Kšœžœ
žœ)˜DKšœ
žœžœ;˜SKš	œ
žœžœžœžœ
˜Pšžœžœ˜0Kšžœ7˜;—Kš
œ˜Kš
œ˜—Kš
œH˜HKšžœC˜J—Kšžœ
˜—Kš
œ˜——™	K˜Kšœžœžœ
˜Kšœ	žœ
˜Kšœž	œ
˜K˜Kšœžœžœ
˜K˜Kšœžœ˜Kš	œžœ
žœžœ
žœ
˜(K˜Kšœ
žœ˜Kšœžœ˜ Kšœžœžœžœ
žœ
žœ
˜.Kš
œ˜šœžœ˜(K˜—š‘œžœ
žœžœ˜7Kšœžœ
žœ
žœ˜!Kšžœžœžœžœ
žœ
žœ
˜HK˜K˜—š‘
œžœ
žœžœ
žœ
žœžœ˜7šžœžœž˜ Kšœ&žœ
˜3Kšœžœ
žœ˜Kšœžœ˜*Kšžœ
˜—K˜K˜—š‘œžœ˜Kšžœžœ
žœ
˜Kšœžœ
˜'Kš
œ˜K˜K˜K˜—š‘
œžœ˜Kš
œ˜Kšœžœ
˜
Kš
œP˜PK˜K˜—š‘œžœ˜Kš
žœžœžœ
žœ
žœ
˜*š
œ=˜=Kšœžœ˜ —š
œ˜K˜——š‘
œžœžœ˜'š‘œžœ˜šžœžœ
žœž˜(Kšžœžœ
žœ
˜(K˜/K˜"Kšžœ
˜—Kšžœ
žœžœ.žœ˜SKšœžœ
˜Kš
œ˜—Kšžœžœ
žœ
žœ
˜!š
œ:˜:Kšœžœ˜"—Kš
œ˜K˜—š‘œžœ˜š‘œžœ˜šžœž˜Kšœ-žœ˜=K˜(Kšžœ
˜—Kš
œ˜—Kšžœžœ
žœMžœ˜pKš
œ˜K˜—š‘œžœ
žœ
žœžœžœžœ˜>K™—K˜Kšœžœžœ
˜Kšœž	œ
˜K˜š‘œžœ
žœ
žœ
žœžœžœžœ˜BKš	žœžœ
žœ
žœŸ˜<Kš
œ˜Kš
œ˜Kšœžœ
˜Kš
œ/˜/Kš
žœžœ
žœ
žœ
žœ
˜-Kšœžœ
˜K˜Kšœžœ
˜Kšžœ˜Kš
œ/˜/Kšžœ
˜Kš
œ˜K˜—š‘œ˜/šžœžœ˜Kš
œ0˜0K˜IKš
œ
˜
—šžœ˜Kšœžœ˜Kšœ	žœ˜šžœ
žœžœ˜K˜'K˜IKš
œ˜—K˜'K˜.K˜,K˜!šžœžœ˜Kšœžœ˜Kš	œžœžœ
žœžœ˜#Kš
œ˜Kš
œ˜Kš
œF˜FKš
œ˜Kš
œ˜Kš
œG˜GKš
œ˜Kš
œ˜Kš
œO˜OKš
œU˜UKš
œ˜Kš
œF˜FKš
œ,˜,Kš
œ(˜(Kš
œ˜Kš
œ,˜,Kš
œ ˜ Kš
œ,˜,Kš
œ˜Kš
œ>˜>Kš
œ>˜>Kš
œ0˜0K˜(Kš
œM˜MK˜(Kš
œM˜MKš
œ˜—Kš
œ˜—Kš
œ˜K˜—Kšœžœ˜Kšœžœ˜Kšœžœ˜šœžœ˜K˜—š‘œžœ
žœžœ˜<Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—š‘œžœ
žœžœžœžœ˜;Kšžœžœ
žœžœ˜&Kšœžœ
˜
šžœž˜
Kšžœ žœ˜(Kšžœžœ˜'Kšžœ
žœ˜—šžœžœ˜Kš
œ$˜$Kšžœ˜Kš
œ˜—Kšžœžœ˜Kš
œ˜K˜—š‘œ˜1KšœBžœ˜Išžœžœ
žœ
žœ
žœžœžœ
ž˜5šžœ	žœ
ž˜K˜)šœžœžœž˜Kš	œžœžœ
žœ
žœ	˜FKšžœžœ
˜—Kšžœžœ
˜—Kšžœ
˜—Kš
œ˜K˜—š‘œžœ
žœžœ˜AKšœTžœžœ˜jšžœž˜K™-Kšžœjžœžœ˜„
—Kš
œ˜—šœ0žœ!˜TK˜K˜Kš
œ˜K˜K˜—K˜BK˜˜CKš
œF˜FKš
œC˜CK˜K˜—K˜—Kšžœ
˜—…—'ς:T