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