MessageWindowImpl.mesa
Copyright Ó 1985, 1986, 1987, 1991, 1992 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, February 2, 1987 5:34:30 pm PST
Michael Plass, March 17, 1992 9:44 am PST
Bier, December 8, 1988 12:16:00 pm PST
Willie-s, May 24, 1991 1:47 pm PDT
Christian Jacobi, February 14, 1992 1:49 pm PST
DIRECTORY
BasicTime USING [GetClockPulses, Pulses, PulsesToMicroseconds],
Feedback,
FeedbackClasses,
Imager USING [black, MaskRectangle, MaskRectangleI, SetColor, SetFont, SetGray, SetXY, SetXYI, ShowRope, ShowText, white],
ImagerBackdoor USING [invert],
ImagerFont USING [RopeEscapement],
IO,
MessageWindow USING [],
MessageWindowBackdoor USING [],
Process,
Real USING [Round],
Rope USING [Equal, Fetch, FromRefText, ROPE, Size],
RuntimeError,
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, MoveViewer, PaintViewer, RegisterViewerClass],
ViewerPrivate USING [], -- exports messageWindow
ViewerSpecs USING [bwScreenHeight, messageWindowHeight];
MessageWindowImpl: CEDAR MONITOR
IMPORTS BasicTime, Feedback, FeedbackClasses, Imager, ImagerBackdoor, ImagerFont, IO, Process, Real, Rope, RuntimeError, TIPUser, VFonts, ViewerForkers, ViewerLocks, ViewerOps, ViewerSpecs
EXPORTS MessageWindow, MessageWindowBackdoor, ViewerPrivate
=
BEGIN
ROPE: TYPE ~ Rope.ROPE;
messageWindow: PUBLIC ViewerClasses.Viewer ¬ NIL;
Message Replay
replayPause: Process.Milliseconds ¬ 750;
Replay: PROC [messages: LIST OF ROPE] ~ {
prev: ROPE ¬ NIL;
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 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";
dally:
CONDITION;
-- times out after 1 second. See initialization at the bottom
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;
};
ReadQueue:
ENTRY
PROC
RETURNS [rope:
ROPE ¬
NIL] ~ {
Try:
INTERNAL
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 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: CARD ~ 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 ¬ FALSE; -- initial value to keep compiler happy
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:
PUBLIC
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.RopeEscapement[VFonts.defaultFont, "No"].x;
a[5] ¬ x ¬ x-hOffset;
a[4] ¬ x ¬ x-1;
a[3] ¬ x ¬ x-hOffset-ImagerFont.RopeEscapement[VFonts.defaultFont, "Yes"].x;
a[2] ¬ x ¬ x-hOffset;
a[1] ¬ x ¬ x-1;
a[0] ¬ x ¬ x-hOffset-ImagerFont.RopeEscapement[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[];
$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["MessageWindow.tip" !
RuntimeError.UNCAUGHT => CONTINUE];
};
staticArea: INT ¬ 1024; -- monitored. This value does not need to be the actual size, since it us just used for startup.
AllocateStaticArea:
PUBLIC
PROC [width:
INTEGER]
RETURNS [wx, wy, ww, wh:
INTEGER] ~ {
m: ViewerClasses.Viewer ~ messageWindow;
width ¬ MAX[width, 0];
IF m =
NIL
THEN {
Locked:
ENTRY
PROC ~ {
staticArea ¬ staticArea - width;
wx ¬ MAX[staticArea, 0];
wy ¬ ViewerSpecs.bwScreenHeight-ViewerSpecs.messageWindowHeight;
ww ¬ width;
wh ¬ ViewerSpecs.messageWindowHeight;
};
Locked[];
}
ELSE {
ViewerOps.MoveViewer[m, m.wx, m.wy, m.ww-width, m.wh, FALSE];
wx ¬ m.wx + m.ww;
wy ¬ m.wy;
ww ¬ width;
wh ¬ m.wh;
};
};
CreateMessageWindowViewer:
PROC ~ {
wx, wy, ww, wh: INTEGER;
[wx, wy, ww, wh] ¬ AllocateStaticArea[staticArea];
IF wx # 0 THEN ERROR;
messageWindow ¬ ViewerOps.CreateViewer[$MessageWindow, [name: "MW",
wx: wx, wy: wy,
ww: ww, wh: wh,
column: static
]];
};
CreateMessageWindow:
PUBLIC PROC ~ {
IF messageWindow = NIL THEN CreateMessageWindowViewer[];
StartFeedback[];
};
Feedback
MWPutFL:
PROC [mh: Feedback.MsgHandler, msgType: Feedback.MsgType, msgClass: Feedback.MsgClass, format: Rope.
ROPE, list:
LIST
OF
IO.Value ¬
NIL ] ~ {
Append[IO.PutFLR[format, list], msgType=begin OR msgType=oneLiner];
};
MWClearHerald:
PROC [mh: Feedback.MsgHandler, msgClass: Feedback.MsgClass ] ~ {
Append[NIL, TRUE];
};
MWBlink:
PROC [mh: Feedback.MsgHandler, msgClass: Feedback.MsgClass ] ~ {
Blink[];
};
StartFeedback:
PROC = {
h1: Feedback.MsgHandler ~ FeedbackClasses.CreateHandler[MWPutFL, MWClearHerald, MWBlink, NIL];
h2: Feedback.MsgHandler ~ FeedbackClasses.CreateStoringHandler[2000];
h12: Feedback.MsgHandler ~ FeedbackClasses.CreateSplittingHandler[h1, h2];
[] ¬ Feedback.SetGlobalDefaultHandlersBehavior[h12];
};
Initialization
messageWindowClass: ViewerClasses.ViewerClass ¬
NEW[ViewerClasses.ViewerClassRec ¬ [
paint: MessageWindowPaint,
notify: MessageWindowNotify,
tipTable: FindTIPTable[]
]];
ViewerOps.RegisterViewerClass[$MessageWindow, messageWindowClass];
TRUSTED{
Process.InitializeCondition[@dally, Process.SecondsToTicks[1]];
};
CreateMessageWindowViewer[];
END.