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 [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 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 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] ~ {
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 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] ~ {
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:
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 => {
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: 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;
};
Old Stuff
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};
De-implemented.
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;
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
Keep the poor devil out of trouble if we can.
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.