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