
    <<SimpleTerminalImpl.mesa>>
        <<Copyright © 1984, 1985 by Xerox Corporation.  All rights reserved.>>
        <<Derived from SimpleTTY.mesa last edited by Forrest January 6, 1981  7:28 PM >>
        <<Levin on January 17, 1984 11:13:07 am PST>>
        <<McGregor on April 22, 1982 4:23 pm>>
        <<Birrell, July 7, 1983 3:20 pm>>
        <<MBrown, September 17, 1983 8:18 pm>>
        <<Willie-Sue, June 11, 1985 1:17:50 pm PDT>>
    <<Russ Atkinson (RRA) February 20, 1985 3:38:56 pm PST>>
        <<Doug Wyatt, April 12, 1985 5:38:43 pm PST>>
        <<Hal Murray, January 21, 1986 9:01:44 pm PST>>

    DIRECTORY
        Ascii USING [BS, CR, DEL, ESC, FF, LF, SP, TAB],
        Basics USING [bitsPerWord],
        BasicTime USING [earliestGMT, TimeNotKnown, FromPupTime, GMT, Now, Period],
        Convert USING [RopeFromTime],
        File USING [GetVolumeName, SystemVolume, Volume],
        IO USING [card, CreateStream, CreateStreamProcs, PutFR, STREAM, StreamProcs, time],
        PrincOps USING [BBptr, BBTable, BBTableSpace, BitAddress],
        PrincOpsUtils USING [AlignedBBTable, BITBLT, Codebase, MyGlobalFrame],
        Process USING [Abort, DisableTimeout, Pause, priorityForeground, priorityRealTime, SecondsToTicks, SetPriority, SetTimeout, Ticks],
        Rope USING [Cat, Fetch, Length, ROPE],
        SimpleTerminal USING [],
        SystemVersion USING [bootFileDate, release],
        Terminal USING [Current, GetBWBitmapState, GetBWFrameBuffer, GetKeys, GetMousePosition, FrameBuffer, Position, RegisterNotifier, 
        Select, SetBWBackground, SetBWBitmapState, SetBWCursorPosition, SetMousePosition, SwapNotifier, Virtual, 
        WaitForBWVerticalRetrace],
        ThisMachine USING [Address, Name, ProcessorID],
        TerminalDefs USING [KeyName, KeyState];

    SimpleTerminalImpl: MONITOR LOCKS m USING m: POINTER TO MONITORLOCK
    IMPORTS BasicTime, Convert, File, IO, PrincOpsUtils, Process, Rope, SystemVersion, Terminal, ThisMachine
    EXPORTS SimpleTerminal
    = BEGIN

        ROPE: TYPE = Rope.ROPE;
        STREAM: TYPE = IO.STREAM;

    <<Constraints to satisfy externally:>>
        <<A statevector is needed at priority 6 for the keyboard watching process, at least until facilities exist to let it allocate one 
        itself.>>
        <<If keyboard watcher is to avoid faults, its code and global frame should be pinned.>>

    State: TYPE = {off, turningOn, on, turningOff, joining};

    <<Global variables protected by "terminalLock">>

    terminalLock: MONITORLOCK;

    state: State _ off;
    stateChange: CONDITION _ [timeout: 0];

    terminal: Terminal.Virtual _ NIL;
    turnOnCount: NAT _ 0;

    originalTerminal: Terminal.Virtual;

    inStream, outStream: STREAM _ NIL;

    keyboardWatcher, timePainter: PROCESS;

    <<>>
    <<Exported to SimpleTerminal>>

    TurnOn: PUBLIC SAFE PROC [nameStripe: ROPE _ NIL] RETURNS [in, out: STREAM] = TRUSTED {
        TurnOnEntryA: ENTRY PROC [m: POINTER TO MONITORLOCK]
            RETURNS [turnOnNeeded: BOOL] = -- INLINE -- {
            oldState: State = state;
            DO
                SELECT state FROM
                    off => {
                        IF turnOnCount ~= 0 THEN ERROR;
                        originalTerminal _ Terminal.Current[];
                        state _ turningOn;
                        EXIT
                        };
                    turningOff => {
                        <<Shutdown was deferred and is still pending.  We simply cancel it.>>
                        state _ on;
                        EXIT
                        };
                    on => EXIT;
                    ENDCASE;
                WAIT stateChange;
                ENDLOOP;
            [] _ terminal.Select[];
            turnOnCount _ turnOnCount.SUCC;
            IF oldState ~= state THEN BROADCAST stateChange;
            RETURN[state ~= on]
            };
        TurnOnEntryB: ENTRY PROC [m: POINTER TO MONITORLOCK] = -- INLINE -- {
            state _ on;
            BROADCAST stateChange;
            };
        IF TurnOnEntryA[@terminalLock] THEN {
            IF nameStripe = NIL THEN
                nameStripe _ IO.PutFR["Cedar %g.%g.%g of %t",
                    IO.card[SystemVersion.release.major],
                    IO.card[SystemVersion.release.minor],
                    IO.card[SystemVersion.release.patch],
                    IO.time[BasicTime.FromPupTime[SystemVersion.bootFileDate]]
                    ];
            InitScreen[nameStripe];
            keyboardWatcher _ FORK ProcessKeyboard[];
            inStream _ IO.CreateStream[inStreamProcs, NIL];
            outStream _ IO.CreateStream[outStreamProcs, NIL];
            TurnOnEntryB[@terminalLock];
            };
        RETURN [inStream, outStream]
        };

    TurnOff: PUBLIC SAFE PROC = TRUSTED {
        TurnOffEntry: ENTRY PROC [m: POINTER TO MONITORLOCK]
            RETURNS [shutdown: BOOL] = -- INLINE -- {
            DO
                SELECT state FROM
                    off => RETURN[FALSE];
                    on => EXIT;
                    ENDCASE => WAIT stateChange;
                ENDLOOP;
            IF (shutdown _ ((turnOnCount _ turnOnCount.PRED) = 0)) THEN {
                state _ turningOff;
                BROADCAST stateChange;
                };
            };
        selected: BOOL = Terminal.Current[] = terminal;
        <<The following is intended to be TRUE when the terminal that was current at the time TurnOn was called has a screen displayed.  It 
        is therefore more interesting than ours and we should shut our screen down now and make its visible again.  If there wasn't 
        a visible screen when TurnOn was called and we are still the current terminal, we leave our screen visible until someone 
        else invokes Terminal.Select.  >>
        wantPreviousTerminal: BOOL = 
            selected AND
            originalTerminal ~= terminal AND originalTerminal.GetBWBitmapState[] = displayed;
        IF TurnOffEntry[@terminalLock] AND (~selected OR wantPreviousTerminal) THEN {
            DoShutDown[terminal, going, NIL];
            IF wantPreviousTerminal THEN [] _ originalTerminal.Select[];
            };
        };

    DoShutDown: Terminal.SwapNotifier = TRUSTED {
        DoShutDownEntryA: ENTRY PROC [m: POINTER TO MONITORLOCK]
            RETURNS [needed: BOOL] = INLINE {
            IF (needed _ state = turningOff) THEN {
                state _ joining;
                BROADCAST stateChange;
                };
            };
        DoShutDownEntryB: ENTRY PROC [m: POINTER TO MONITORLOCK] = INLINE {
            state _ off;
            BROADCAST stateChange;
            };
        IF action = going AND DoShutDownEntryA[@terminalLock] THEN {
            Process.Abort[keyboardWatcher];
            JOIN keyboardWatcher;
            JOIN timePainter;
            inStream _ outStream _ NIL;
            [] _ terminal.SetBWBitmapState[none];
            frameBuffer _ NIL;
            DoShutDownEntryB[@terminalLock];
            };
        };


    InputTimeout: PUBLIC SAFE SIGNAL = CODE;

    SetInputTimeout: PUBLIC SAFE PROC [ticks: Process.Ticks] = TRUSTED {
        SetInputTimeoutEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = INLINE {
            IF ticks = 0 THEN Process.DisableTimeout[@charactersAvailable]
            ELSE Process.SetTimeout[@charactersAvailable, ticks];
            };
        SetInputTimeoutEntry[@keyboardLock];
        };


    EnableCursorTracking: PUBLIC SAFE PROC = TRUSTED {
        EnableEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = INLINE {
            IF (noTrack _ noTrack - 1) = 0 THEN doBlink _ TRUE;
            };
        EnableEntry[@screenLock];
        };

    DisableCursorTracking: PUBLIC SAFE PROC = TRUSTED {
        DisableEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = INLINE {
            IF (noTrack _ noTrack + 1) ~= 0 THEN doBlink _ FALSE;
            };
        DisableEntry[@screenLock];
        };


    <<>>
    <<Keyboard Definitions>>

    KeyState: TYPE = TerminalDefs.KeyState;
    KeyName: TYPE ~ TerminalDefs.KeyName;
    KeyItem: TYPE ~ RECORD[normal, shift: CHAR] _ [0C, 0C];

    KeyTable: ARRAY KeyName OF KeyItem ~ [

        ESC: [Ascii.ESC, Ascii.ESC], -- Alto ESC (upper left), DLion CENTER (top row, left end)
        One: ['1, '!], -- 1 and !
        Two: ['2, '@], -- 2 and @
        Three: ['3, '#], -- 3 and #
        Four: ['4, '$], -- 4 and $
        Five: ['5, '%], -- 5 and %
        Six: ['6, '~], -- 6 and ~
        Seven: ['7, '&], -- 7 and &
        Eight: ['8, '*], -- 8 and *
        Nine: ['9, '(], -- 9 and (
        Zero: ['0, ')], -- 0 and )
        Dash: ['-, '], -- Alto - and , DLion -
        Equal: ['=, '+], -- = and +
        BackSlash: ['\\, '|], -- Alto \ and |, DLion DEFAULTS (top row, right end)
        LF: [Ascii.LF, Ascii.LF], -- Alto LF (upper right), DLion COPY (left group)
        DEL: [Ascii.DEL, Ascii.DEL], -- Alto DEL, DLion DELETE (left group)

        TAB: [Ascii.TAB, Ascii.TAB], -- Alto TAB, DLion <paratab> (large key left of Q)
        Q: ['q, 'Q], 
        W: ['w, 'W], 
        E: ['e, 'E],
        R: ['r, 'R], 
        T: ['t, 'T], 
        Y: ['y, 'Y], 
        U: ['u, 'U], 
        I: ['i, 'I], 
        O: ['o, 'O], 
        P: ['p, 'P], 
        LeftBracket: ['[, '{], -- [ and {
        RightBracket: ['], '}], -- ] and }
        Arrow: ['_, '^], -- Alto _ and ^, DLion open quotes
        BS: [Ascii.BS, Ascii.BS], -- Alto BS (upper right), DLion _ (large key, upper right)

        A: ['a, 'A], 
        S: ['s, 'S], 
        D: ['d, 'D], 
        F: ['f, 'F], 
        G: ['g, 'G], 
        H: ['h, 'H], 
        J: ['j, 'J], 
        K: ['k, 'K], 
        L: ['l, 'L], 
        SemiColon: [';, ':], -- ; and :
        Quote: ['\', '\"], -- ' and " (close quotes on DLion)
        Return: [Ascii.CR, Ascii.CR], -- Alto RETURN, DLion <newpara> (double-height key, right side)

        Z: ['z, 'Z], 
        X: ['x, 'X], 
        C: ['c, 'C], 
        V: ['v, 'V], 
        B: ['b, 'B], 
        N: ['n, 'N], 
        M: ['m, 'M], 
        Comma: [',, '<], -- , and <
        Period: ['., '>], -- . and >
        Slash: ['/, '?], -- / and ?

        Space: [Ascii.SP, Ascii.SP] -- the space bar

        ];
    <<>>
    <<Keyboard Implementation>>

    <<>>
    <<Global variables protected by "keyboardLock">>

    keyboardLock: MONITORLOCK;

    charactersAvailable: CONDITION;

    in, out: NAT;
    buffer: PACKED ARRAY NAT[0..50) OF CHAR;

    ProcessKeyboard: PROC = {
        old, new: KeyState _ [bits[ALL[up]]];
        blinkCount: NAT _ 33;
        GoAway: ENTRY PROC[m: POINTER TO MONITORLOCK] RETURNS [BOOL] = INLINE {
            RETURN[state = joining];
            };
        TrackCursor:  ENTRY PROC[m: POINTER TO MONITORLOCK] = INLINE {
            mouse: Terminal.Position _ terminal.GetMousePosition[];
            IF noTrack > 0 THEN RETURN;
            mouse.x _ MIN[MAX[0, mouse.x], terminal.bwWidth];
            mouse.y _ MIN[MAX[0, mouse.y], terminal.bwHeight];
            terminal.SetBWCursorPosition[mouse];
            terminal.SetMousePosition[mouse]
            };
        AddToBuffer: ENTRY PROC[m: POINTER TO MONITORLOCK, c: CHAR] = INLINE {
            newin: NAT _ in + 1;
            IF newin = buffer.LENGTH THEN newin _ 0;
            IF newin ~= out THEN {buffer[in] _ c; in _ newin};
            };
        NotifyCharsAvailable: ENTRY PROC[m: POINTER TO MONITORLOCK] = INLINE {
            BROADCAST charactersAvailable;
            };
        in _ out _ 0;
        Process.SetPriority[Process.priorityRealTime];
        old.bits _ terminal.GetKeys[];
        UNTIL GoAway[@terminalLock] DO
            charsSeen: BOOL _ FALSE;
            terminal.WaitForBWVerticalRetrace[ ! ABORTED => CONTINUE];
            new.bits _ terminal.GetKeys[];
            TrackCursor[@screenLock];
            IF (blinkCount _ blinkCount - 1) = 0 THEN {BlinkCursor[]; blinkCount _ 34};
            FOR i: NAT IN[0..SIZE[KeyState]) DO
                IF old.words[i] ~= new.words[i] THEN
                    FOR b: NAT IN[i*Basics.bitsPerWord..(i+1)*Basics.bitsPerWord) DO
                        k: KeyName ~ VAL[b];
                        IF old.bits[k]=up AND new.bits[k]=down THEN {
                            entry: KeyItem ~ KeyTable[k];
                            char: CHAR _ entry.normal;
                            IF char#0C THEN {
                                SELECT TRUE FROM
                                    new.bits[Ctrl]=down => char _ VAL[ORD[char] MOD 40B];
                                    new.bits[LeftShift]=down, new.bits[RightShift]=down => char _ entry.shift;
                                    new.bits[Lock]=down AND char IN['a..'z] => char _ entry.shift;
                                    ENDCASE;
                                AddToBuffer[@keyboardLock, char];
                                charsSeen _ TRUE;
                                };
                            };
                        ENDLOOP;
                ENDLOOP;
            IF charsSeen THEN NotifyCharsAvailable[@keyboardLock];
            old _ new;
            ENDLOOP;
        };

    <<>>
    <<Font Definitions>>

    FontRecord: TYPE = MACHINE DEPENDENT RECORD [
        newStyle(0:0..0): BOOL,
        indexed(0:1..1): BOOL,
        fixed(0:2..2): BOOL,
        kerned(0:3..3): BOOL,
        pad(0:4..15): [0..7777B],
        min(1): CHAR,   -- limits of chars in font
        max(2): CHAR,   -- limits of chars in font
        maxwidth(3): NAT,
        length(4): NAT,
        ascent(5): NAT,
        descent(6): NAT,
        xoffset(7): NAT,
        raster(8): NAT,
        chars(9:0..63): SELECT OVERLAID * FROM
            hasBoundingBox => [
                boundingBox(9:0..63): RECORD [FontBBox, FontBBoy, FontBBdx, FontBBDy: INTEGER],
                BBBitmap(13): ARRAY [0..0) OF WORD],
            noBoundingBox => [bitmap(9): ARRAY [0..0) OF WORD],
            ENDCASE
        ];

    font: LONG POINTER TO FontRecord = GetFont[];

    bitmap: LONG POINTER = IF font.kerned THEN @font.BBBitmap ELSE @font.bitmap;
    height: NAT = font.ascent + font.descent;
    xInSegment: LONG POINTER TO ARRAY CHAR [0C..0C) OF NAT =
        bitmap + font.raster*height - (font.min-0C);

    GetFont: PROC RETURNS [LONG POINTER] = {
        <<Note:  Even though it doesn't say so in its strike header, this is a fixed-width>>
        <<font.  Bitter experience has shown that not all Gacha10.strike font files are, in>>
        <<fact, fixed width.  You need to painstakingly examine the xInSegment table for>>
        <<the truth.>>
        Gacha10Strike: ARRAY [0..1142B) OF WORD = [
        --   0--  100000B, 000040B, 000176B, 000007B, 001136B, 000010B, 000004B, 000000B,
        --  10--  000052B, 000000B, 000001B, 000000B, 000000B, 000000B, 000000B, 000000B,
        --  20--  000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
        --  30--  000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
        --  40--  000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
        --  50--  000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
        --  60--  000000B, 000000B, 017000B, 000040B, 120243B, 106204B, 004010B, 040100B,
        --  70--  000000B, 000002B, 034040B, 160701B, 107616B, 037070B, 070000B, 000200B,
        -- 100--  010034B, 034041B, 140707B, 107637B, 016104B, 070162B, 022010B, 110434B,
        -- 110--  074161B, 160707B, 144221B, 021104B, 104761B, 141007B, 000000B, 000200B,
        -- 120--  000040B, 001600B, 020010B, 010401B, 140000B, 000000B, 000000B, 000000B,
        -- 130--  000000B, 000000B, 000060B, 103000B, 017000B, 000040B, 120245B, 052412B,
        -- 140--  004020B, 020520B, 000000B, 000002B, 042141B, 011042B, 104021B, 001104B,
        -- 150--  104000B, 000400B, 004042B, 042121B, 021044B, 044020B, 021104B, 020022B,
        -- 160--  042015B, 114442B, 042211B, 011041B, 004221B, 021104B, 104021B, 001001B,
        -- 170--  000000B, 000200B, 000040B, 002000B, 020000B, 000400B, 040000B, 000000B,
        -- 200--  000000B, 000400B, 000000B, 000000B, 000100B, 100400B, 017000B, 000040B,
        -- 210--  121765B, 054412B, 004020B, 020340B, 100000B, 000004B, 046241B, 010042B,
        -- 220--  104020B, 002104B, 104100B, 101000B, 002042B, 056121B, 021044B, 044020B,
        -- 230--  021104B, 020022B, 102015B, 114442B, 042211B, 011041B, 004221B, 025050B,
        -- 240--  050041B, 000401B, 002010B, 034260B, 160643B, 107415B, 026070B, 070440B,
        -- 250--  043313B, 007054B, 032260B, 161704B, 044221B, 021104B, 174100B, 100400B,
        -- 260--  017000B, 000040B, 000503B, 001004B, 000040B, 010520B, 100000B, 000004B,
        -- 270--  052040B, 020704B, 107436B, 002070B, 104100B, 102017B, 101004B, 052121B,
        -- 300--  161004B, 047436B, 020174B, 020023B, 102012B, 112442B, 042211B, 160601B,
        -- 310--  004212B, 025020B, 050101B, 000401B, 007020B, 002311B, 011144B, 042023B,
        -- 320--  031010B, 010500B, 042514B, 110462B, 046311B, 010404B, 044221B, 012104B,
        -- 330--  010100B, 100406B, 057000B, 000040B, 000501B, 101012B, 100040B, 010103B,
        -- 340--  160017B, 100010B, 052040B, 040044B, 104221B, 004104B, 074000B, 002000B,
        -- 350--  001010B, 052211B, 011004B, 044020B, 027104B, 020022B, 042012B, 112442B,
        -- 360--  074211B, 040101B, 004212B, 025020B, 020101B, 000201B, 012476B, 036211B,
        -- 370--  001047B, 142021B, 021010B, 010600B, 042510B, 110442B, 042200B, 140404B,
        -- 400--  042425B, 004104B, 020100B, 100411B, 117000B, 000000B, 003745B, 042321B,
        -- 410--  000040B, 010000B, 100000B, 000010B, 062040B, 100047B, 140221B, 004104B,
        -- 420--  004000B, 001017B, 102000B, 056371B, 011044B, 044020B, 021104B, 020422B,
        -- 430--  042012B, 111442B, 040211B, 021041B, 004212B, 012050B, 020201B, 000201B,
        -- 440--  002020B, 042211B, 001044B, 002021B, 021010B, 010500B, 042510B, 110442B,
        -- 450--  042200B, 020404B, 042425B, 004050B, 020600B, 100300B, 017000B, 000040B,
        -- 460--  001205B, 042521B, 000040B, 010000B, 101400B, 002020B, 042041B, 001040B,
        -- 470--  104221B, 010104B, 104101B, 100400B, 004010B, 040211B, 011044B, 044020B,
        -- 500--  021104B, 020422B, 022012B, 111442B, 040211B, 011041B, 004204B, 012104B,
        -- 510--  020401B, 000101B, 002010B, 042311B, 011144B, 042023B, 021010B, 010440B,
        -- 520--  042510B, 110462B, 046201B, 010444B, 141012B, 012050B, 040100B, 100400B,
        -- 530--  017000B, 000040B, 001203B, 104616B, 100040B, 010000B, 000400B, 002020B,
        -- 540--  034371B, 170700B, 103416B, 010070B, 070100B, 100200B, 010010B, 036211B,
        -- 550--  160707B, 107620B, 016104B, 070342B, 023710B, 110434B, 040161B, 010701B,
        -- 560--  003404B, 012104B, 020761B, 000101B, 002000B, 036260B, 160643B, 102015B,
        -- 570--  021010B, 010420B, 042510B, 107054B, 032200B, 160303B, 041012B, 021020B,
        -- 600--  174100B, 100400B, 000000B, 000000B, 000001B, 000000B, 000020B, 020000B,
        -- 610--  000400B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 100000B,
        -- 620--  000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
        -- 630--  000040B, 000000B, 000000B, 000000B, 000001B, 000001B, 000000B, 000000B,
        -- 640--  000000B, 000001B, 000000B, 110000B, 000000B, 000040B, 002000B, 000000B,
        -- 650--  000000B, 000020B, 000100B, 100400B, 000000B, 000000B, 000000B, 000000B,
        -- 660--  000020B, 020000B, 001000B, 000000B, 000000B, 000000B, 000000B, 000000B,
        -- 670--  000001B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
        -- 700--  000000B, 000000B, 000030B, 000000B, 000000B, 000000B, 000001B, 000001B,
        -- 710--  000000B, 000000B, 000000B, 000016B, 000000B, 060000B, 000000B, 000040B,
        -- 720--  002000B, 000000B, 000000B, 000140B, 000100B, 100400B, 000000B, 000000B,
        -- 730--  000000B, 000000B, 000010B, 040000B, 000000B, 000000B, 000000B, 000000B,
        -- 740--  000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
        -- 750--  000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
        -- 760--  000001B, 140007B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
        -- 770--  000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000060B, 103000B,
        --1000--  012602B, 000000B, 000007B, 000016B, 000025B, 000034B, 000043B, 000052B,
        --1010--  000061B, 000070B, 000077B, 000106B, 000115B, 000124B, 000133B, 000142B,
        --1020--  000151B, 000160B, 000167B, 000176B, 000205B, 000214B, 000223B, 000232B,
        --1030--  000241B, 000250B, 000257B, 000266B, 000275B, 000304B, 000313B, 000322B,
        --1040--  000331B, 000340B, 000347B, 000356B, 000365B, 000374B, 000403B, 000412B,
        --1050--  000421B, 000430B, 000437B, 000446B, 000455B, 000464B, 000473B, 000502B,
        --1060--  000511B, 000520B, 000527B, 000536B, 000545B, 000554B, 000563B, 000572B,
        --1070--  000601B, 000610B, 000617B, 000626B, 000635B, 000644B, 000653B, 000662B,
        --1100--  000671B, 000700B, 000700B, 000707B, 000716B, 000725B, 000734B, 000743B,
        --1110--  000752B, 000761B, 000770B, 000777B, 001006B, 001015B, 001024B, 001033B,
        --1120--  001042B, 001051B, 001060B, 001067B, 001076B, 001105B, 001114B, 001123B,
        --1130--  001132B, 001141B, 001150B, 001157B, 001166B, 001175B, 001204B, 001213B,
        --1140--  001222B, 001230B];
        <<The following hack finds the address of constant array Gacha10Strike in the code segment and returns it.  This is slightly 
        unethical, but it saves duplicate allocation.>>
        p: LONG POINTER TO ARRAY [0..1142B) OF WORD _
            LOOPHOLE[PrincOpsUtils.Codebase[PrincOpsUtils.MyGlobalFrame[]]];
        DO
            IF p[0] = Gacha10Strike[0] AND p^ = Gacha10Strike THEN RETURN[p];
            p _ p+1;
            ENDLOOP;
        };

    <<>>
    <<Display Implementation>>


    <<Global variables protected by "screenLock">>

        screenLock: MONITORLOCK;

        noTrack: CARDINAL _ 0;
        doBlink: BOOL _ FALSE;

        frameBuffer: Terminal.FrameBuffer _ NIL;

        bbTable: PrincOps.BBTableSpace;
        bbPtr: PrincOps.BBptr = PrincOpsUtils.AlignedBBTable[@bbTable];

        charPos, line, nCharPos, nLines: NAT;
        usableHeight, usableWidth: NAT;
        firstLine, thisLine: PrincOps.BitAddress;
        bitsPerTextLine: NAT;  -- = screenWidth*font.height

        nameStripeOrg: PrincOps.BitAddress;
        nameStripeWidth: NAT;

    GetBitAddress: PROC [p: LONG POINTER, o: LONG CARDINAL] RETURNS [PrincOps.BitAddress] = {
        RETURN[[p+o/16, 0, o MOD 16]]
        };

    GetBitBltTable: PROC [frameBuffer: Terminal.FrameBuffer] RETURNS [bb: PrincOps.BBTable] = {
        bb _ [dst: [word: NIL, bit: 0], dstBpl: 0, 
        src: [word: NIL, bit: 0], srcDesc: [srcBpl[0]], 
        width: 0, height: 0, flags: []];
        IF frameBuffer.bitsPerPixel#1 THEN ERROR;
        bb.dst _ bb.src _ [word: frameBuffer.base, bit: 0];
        bb.dstBpl _ bb.srcDesc.srcBpl _ frameBuffer.wordsPerLine*Basics.bitsPerWord;
        bb.width _ frameBuffer.width;
        bb.height _ frameBuffer.height;
        };

    InitScreen: PROC [nameStripe: ROPE] = {
        borderWidth: NAT = 16;
        boxWidth: NAT = 1;
        marginWidth: NAT = 8;
        org: PrincOps.BitAddress;
        InitBitmap: PROC = {
            zero: CARDINAL _ 0;
            <<bbPtr.dst, bbPtr.height, and bbPtr.width are set up>>
            bbPtr.src _ [@zero, 0, 0];
            bbPtr.srcDesc _ [gray[[0, 0, 0, 0]]];
            bbPtr.flags _ [gray: TRUE];
            PrincOpsUtils.BITBLT[bbPtr];
            };
        MakeBorder: PROC [w: NAT] = {
            stipple: ARRAY [0..3] OF CARDINAL _ [104210B, 104210B, 021042B, 021042B];
            <<bbPtr.dstBpl never changes>>
            bbPtr.src _ [@stipple, 0, 0];
            bbPtr.srcDesc _ [gray[[yOffset: 0, widthMinusOne: 0, heightMinusOne: 3]]];
            bbPtr.flags _ [gray: TRUE];
            <<top stripe>>
            bbPtr.dst _ org;
            bbPtr.width _ usableWidth;
            bbPtr.height _ w;
            PrincOpsUtils.BITBLT[bbPtr];
            <<bottom stripe>>
            bbPtr.dst _ GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*(usableHeight-w)];
            PrincOpsUtils.BITBLT[bbPtr];
            <<left side>>
            bbPtr.dst _ GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*w];
            bbPtr.width _ w;
            bbPtr.height _ usableHeight - w - w;
            PrincOpsUtils.BITBLT[bbPtr];
            <<right side>>
            bbPtr.dst _ GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*w+usableWidth-w];
            PrincOpsUtils.BITBLT[bbPtr];
            org _ GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*w+w];
            usableHeight _ usableHeight - w - w;
            usableWidth _ usableWidth - w - w;
            };
        MakeBox: PROC [w: NAT] = {
            black: CARDINAL _ 177777B;
            bbPtr.src _ [@black, 0, 0];
            bbPtr.srcDesc _ [gray[[yOffset: 0, widthMinusOne: 0, heightMinusOne: w-1]]];
            bbPtr.flags _ [gray: TRUE];
            <<top stripe>>
            bbPtr.dst _ org;
            bbPtr.width _ usableWidth;
            bbPtr.height _ w;
            PrincOpsUtils.BITBLT[bbPtr];
            <<bottom stripe>>
            bbPtr.dst _ GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*(usableHeight-w)];
            PrincOpsUtils.BITBLT[bbPtr];
            <<left side>>
            bbPtr.dst _ GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*w];
            bbPtr.width _ w;
            bbPtr.height _ usableHeight-w-w;
            PrincOpsUtils.BITBLT[bbPtr];
            <<right side>>
            bbPtr.dst _ GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*w+usableWidth-w];
            PrincOpsUtils.BITBLT[bbPtr];
            org _ GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*w+w];
            usableHeight _ usableHeight - w - w;
            usableWidth _ usableWidth - w - w;
            };
        MakeNameStripe: PROC [nameStripe: ROPE] = {
            black: CARDINAL _ 177777B;
            systemVolume: File.Volume = File.SystemVolume[];
            numSign: ROPE = "#";
            volumeLabel: ROPE _ 
                IF systemVolume = NIL THEN "No System Volume"
                ELSE File.GetVolumeName[systemVolume];
            name: ROPE;
            name _ Rope.Cat[name, ThisMachine.Name[]];
            name _ Rope.Cat[name, " (", ThisMachine.Address[]];
            name _ Rope.Cat[name, ", ", ThisMachine.ProcessorID[$ProductSoftware], ")"];
            volumeLabel _ volumeLabel.Cat[" on ", name];
            nameStripeOrg _ org;
            nameStripeWidth _ usableWidth;
            <<paint version text>>
            bbPtr.dst _ GetBitAddress[org.word, org.bit+marginWidth];
            bbPtr.srcDesc _ [srcBpl[font.raster*16]];
            bbPtr.height _ height;
            bbPtr.width _ font.maxwidth;
            bbPtr.flags _ [];
            FOR i: CARDINAL IN CARDINAL[0..nameStripe.Length[]) DO
                bbPtr.src _ GetBitAddress[bitmap, xInSegment[nameStripe.Fetch[i]]];
                PrincOpsUtils.BITBLT[bbPtr];
                bbPtr.dst _ GetBitAddress[bbPtr.dst.word, bbPtr.dst.bit+font.maxwidth];
                ENDLOOP;
            <<paint volume name>>
            bbPtr.dst _ GetBitAddress[org.word,
                org.bit+usableWidth-marginWidth-volumeLabel.Length[]*font.maxwidth];
            FOR i: CARDINAL IN CARDINAL[0..volumeLabel.Length[]) DO
                bbPtr.src _ GetBitAddress[bitmap, xInSegment[volumeLabel.Fetch[i]]];
                PrincOpsUtils.BITBLT[bbPtr];
                bbPtr.dst _ GetBitAddress[bbPtr.dst.word, bbPtr.dst.bit+font.maxwidth];
                ENDLOOP;
            <<overlay with stripe>>
            bbPtr.src _ [@black, 0, 0];
            bbPtr.srcDesc _ [gray[[yOffset: 0, widthMinusOne: 0, heightMinusOne: 0]]];
            bbPtr.flags _ [gray: TRUE, dstFunc: xor];
            bbPtr.dst _ org;
            bbPtr.width _ usableWidth;
            bbPtr.height _ height;
            PrincOpsUtils.BITBLT[bbPtr];
            org _ GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*height];
            usableHeight _ usableHeight - height;
            timePainter _ FORK MaintainTime[];
            };
        [] _ terminal.SetBWBackground[white];
        [] _ terminal.SetBWBitmapState[allocated];
        frameBuffer _ terminal.GetBWFrameBuffer[];
        bbPtr^ _ GetBitBltTable[frameBuffer];
        org _ bbPtr.dst;
        usableHeight _ bbPtr.height;
        usableWidth _ bbPtr.width;
        InitBitmap[];
        MakeBorder[borderWidth];
        MakeBox[boxWidth];
        MakeNameStripe[nameStripe];
        <<now display the bitmap>>
        [] _ terminal.SetBWBitmapState[displayed];
        usableHeight _ usableHeight - 2*marginWidth;
        usableWidth _ usableWidth - 2*marginWidth;
        bitsPerTextLine _ bbPtr.dstBpl*height;
        firstLine _ 
            GetBitAddress[org.word, org.bit+LONG[marginWidth]*bbPtr.dstBpl+marginWidth];
        nCharPos _ usableWidth/font.maxwidth;
        nLines _ usableHeight/height;
        InitPainting[];
        };

    MaintainTime: PROC = {
        GoAway: ENTRY PROC [m: POINTER TO MONITORLOCK] RETURNS [BOOLEAN] = INLINE {
            RETURN[state = joining]};
        bbTable: PrincOps.BBTableSpace;
        bbPtr: PrincOps.BBptr = PrincOpsUtils.AlignedBBTable[@bbTable];
        black: CARDINAL _ 177777B;
        date: ROPE _ NIL;
        dateLength: NAT _ 0;
        secondsOrg: PrincOps.BitAddress;
        lastMinutes: INT _ 0;
        SetToBlacken: PROC = {
            bbPtr.src _ [@black, 0, 0];
            bbPtr.srcDesc _ [gray[[yOffset: 0, widthMinusOne: 0, heightMinusOne: 0]]];
            bbPtr.flags _ [gray: TRUE]};
        PaintTime: PROC = {
            current: BasicTime.GMT = BasicTime.Now[ ! BasicTime.TimeNotKnown => GOTO noTime];
            secondsSinceGenesis: INT = BasicTime.Period[from: BasicTime.earliestGMT, to: current];
            minutesSinceGenesis: INT = secondsSinceGenesis/60;
            IF lastMinutes = minutesSinceGenesis THEN {
                seconds: [0..59] _ secondsSinceGenesis MOD 60;
                SetToBlacken[];
                bbPtr.dst _ secondsOrg;
                bbPtr.width _ 2*font.maxwidth;
                bbPtr.height _ height;
                PrincOpsUtils.BITBLT[bbPtr];
                <<bbPtr.dst & bbPtr.height still OK>>
                bbPtr.srcDesc _ [srcBpl[font.raster*16]];
                bbPtr.width _ font.maxwidth;
                bbPtr.flags _ [srcFunc: complement];
                bbPtr.src _ GetBitAddress[bitmap, xInSegment['0+seconds/10]];
                PrincOpsUtils.BITBLT[bbPtr];
                bbPtr.dst _ GetBitAddress[bbPtr.dst.word, bbPtr.dst.bit+font.maxwidth];
                bbPtr.src _ GetBitAddress[bitmap, xInSegment['0+seconds MOD 10]];
                PrincOpsUtils.BITBLT[bbPtr]}
            ELSE {
                SetToBlacken[];
                bbPtr.dst _ GetBitAddress[nameStripeOrg.word,
                    nameStripeOrg.bit+(nameStripeWidth-dateLength*font.maxwidth)/2];
                bbPtr.width _ dateLength*font.maxwidth;
                bbPtr.height _ height;
                PrincOpsUtils.BITBLT[bbPtr];
                date _ Convert.RopeFromTime[from: current, start: years, end: seconds,
                    includeDayOfWeek: TRUE, useAMPM: FALSE, includeZone: FALSE];
                dateLength _ date.Length[];
                bbPtr.dst _ GetBitAddress[nameStripeOrg.word,
                    nameStripeOrg.bit+(nameStripeWidth-dateLength*font.maxwidth)/2];
                secondsOrg _ GetBitAddress[bbPtr.dst.word, bbPtr.dst.bit+(dateLength-2)*font.maxwidth];
                bbPtr.srcDesc _ [srcBpl[font.raster*16]];
                bbPtr.width _ font.maxwidth;
                bbPtr.flags _ [srcFunc: complement];
                FOR i: CARDINAL IN [0..dateLength) DO
                    bbPtr.src _ GetBitAddress[bitmap, xInSegment[date.Fetch[i]]];
                    PrincOpsUtils.BITBLT[bbPtr];
                    bbPtr.dst _ GetBitAddress[bbPtr.dst.word, bbPtr.dst.bit+font.maxwidth];
                    ENDLOOP;
                };
            lastMinutes _ minutesSinceGenesis;
            EXITS
                noTime => NULL;
            };
        Process.SetPriority[Process.priorityForeground];
        bbPtr^ _ GetBitBltTable[terminal.GetBWFrameBuffer[]];
        UNTIL GoAway[@terminalLock] DO
            PaintTime[];
            Process.Pause[Process.SecondsToTicks[1]];
            ENDLOOP;
        };

    InitPainting: PROC = {
        <<set up standard arguments for character painting>>
        charPos _ 0; line _ 1;
        <<bbPtr.dstBpl already set up>>
        <<bbPtr.src set when proc called>>
        bbPtr.dst _ thisLine _ firstLine;
        bbPtr.srcDesc _ [srcBpl[font.raster*16]];
        bbPtr.height _ height;
        bbPtr.width _ font.maxwidth;
        bbPtr.flags _ [];
        };

    ClearThisChar: INTERNAL PROC = {
        zero: CARDINAL _ 0;
        bbPtr.src _ [@zero, 0, 0];
        bbPtr.srcDesc _ [gray[[0, 0, 0, 0]]];
        bbPtr.flags _ [gray: TRUE];
        PrincOpsUtils.BITBLT[bbPtr];
        bbPtr.srcDesc _ [srcBpl[font.raster*16]];
        bbPtr.flags _ [];
        };

    DisplayChar: INTERNAL PROC [c: CHAR] = {
        Backup: INTERNAL PROC = {
            t: NAT = bbPtr.dst.bit+16-font.maxwidth;
            IF charPos=0 THEN RETURN;
            charPos _ charPos - 1;
            bbPtr.dst.word _ bbPtr.dst.word + t/16 - 1;
            bbPtr.dst.bit _ t MOD 16;
            };
        ClearScreen: PROC = {
            zero: CARDINAL _ 0;
            bbPtr.dst _ firstLine;
            bbPtr.src _ [@zero, 0, 0];
            bbPtr.srcDesc _ [gray[[0, 0, 0, 0]]];
            bbPtr.flags _ [gray: TRUE];
            bbPtr.height _ usableHeight;
            bbPtr.width _ usableWidth;
            PrincOpsUtils.BITBLT[bbPtr];
            InitPainting[];
            };
        Newline: INTERNAL PROC = {
            IF line < nLines THEN
                {thisLine _ GetBitAddress[thisLine.word, thisLine.bit+bitsPerTextLine]; line _ line+1}
            ELSE {
                zero: CARDINAL _ 0;
                sBBTable: PrincOps.BBTableSpace;
                sbbPtr: PrincOps.BBptr = PrincOpsUtils.AlignedBBTable[@sBBTable];
                sbbPtr^ _ [
                    dst: firstLine, dstBpl: bbPtr.dstBpl,
                    src: GetBitAddress[firstLine.word, firstLine.bit+bitsPerTextLine],
                    srcDesc: [srcBpl[bbPtr.dstBpl]], flags: [direction: forward],
                    width: nCharPos*font.maxwidth, height: height*(nLines-1)];
                PrincOpsUtils.BITBLT[sbbPtr];
                sbbPtr^ _ [
                    dst: thisLine, src: [@zero, 0, 0],
                    dstBpl: bbPtr.dstBpl, srcDesc: [gray[[0, 0, 0, 0]]],
                    width: nCharPos*font.maxwidth, height: height,
                    flags: [gray: TRUE]];
                PrincOpsUtils.BITBLT[sbbPtr];
                };
            bbPtr.dst _ thisLine;
            charPos _ 0;
            };
        SELECT c FROM
            IN (Ascii.SP..'~] => {
                IF ~(c IN [font.min..font.max]) THEN c _ font.max + 1;
                bbPtr.src _ GetBitAddress[bitmap, xInSegment[c]];
                PrincOpsUtils.BITBLT[bbPtr];
                };
            Ascii.SP => NULL;
            Ascii.CR => {Newline[]; RETURN};
            Ascii.BS => {Backup[]; ClearThisChar[]; RETURN};
            Ascii.TAB => {UNTIL charPos MOD 8 = 0 DO DisplayChar[Ascii.SP]; ENDLOOP; RETURN};
            Ascii.FF => {ClearScreen[]; RETURN};
            IN [0C..Ascii.SP) => {DisplayChar['^]; DisplayChar[c+('A-1C)]; RETURN};
            ENDCASE => RETURN;
        IF (charPos _ charPos + 1) >= nCharPos THEN Newline[]
        ELSE bbPtr.dst _ GetBitAddress[bbPtr.dst.word, bbPtr.dst.bit + font.maxwidth];
        };

    BlinkCursor: PROC = {
        BlinkCursorEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = {
            blinker: CARDINAL _ 60000B;
            IF doBlink THEN {
                bbPtr.src _ [@blinker, 0, 0];
                bbPtr.srcDesc _ [gray[[0, 0, 0, 0]]];
                bbPtr.flags _ [gray: TRUE, dstFunc: xor];
                PrincOpsUtils.BITBLT[bbPtr];
                bbPtr.srcDesc _ [srcBpl[font.raster*16]];
                bbPtr.flags _ [];
                };
            };
        IF doBlink THEN BlinkCursorEntry[@screenLock];
        };

    <<>>
    <<IO Streams implementation>>

    CreateStreams: PROC = {
        };

    CharsAvail: SAFE PROC [self: STREAM, wait: BOOL] RETURNS [INT] = TRUSTED {
        CharsAvailEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] RETURNS [BOOL] =
            INLINE {RETURN[in ~= out]};
        RETURN[IF CharsAvailEntry[@keyboardLock] THEN 1 ELSE 0]
        };

    EndOf: SAFE PROC [self: STREAM] RETURNS [BOOL] = CHECKED {RETURN[FALSE]};

    GetChar: SAFE PROC [self: STREAM] RETURNS [c: CHAR] = TRUSTED {
        GetEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] RETURNS [BOOL] = INLINE {
            ENABLE UNWIND => NULL;
            WHILE in = out DO
                WAIT charactersAvailable;
                IF in = out THEN RETURN[FALSE];
                ENDLOOP;
            c _ buffer[out];
            IF (out _ out + 1) = buffer.LENGTH THEN out _ 0;
            RETURN[TRUE]
            };
        UNTIL GetEntry[@keyboardLock] DO SIGNAL InputTimeout; ENDLOOP;
        };

    PutChar: SAFE PROC [self: STREAM, char: CHAR] = TRUSTED {
        PutCharEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = INLINE {
            doBlink _ FALSE;
            ClearThisChar[];  -- to get rid of possible blinker
            DisplayChar[char];
            doBlink _ TRUE;
            };
        PutCharEntry[@screenLock];
        };

    EraseChar: SAFE PROC [self: STREAM, char: CHAR] = TRUSTED {
        EraseCharEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = INLINE {
            doBlink _ FALSE;
            ClearThisChar[];  -- to get rid of possible blinker
            DisplayChar[Ascii.BS];
            doBlink _ TRUE;
            };
        EraseCharEntry[@screenLock];
        };


    <<Initialization>>
        <<>>
        inStreamProcs: REF IO.StreamProcs;
        outStreamProcs: REF IO.StreamProcs;

        Initialize: ENTRY PROC [m: POINTER TO MONITORLOCK] = {
            IF ~font.newStyle OR font.indexed OR ~(font.min IN [0C..177C])
                OR ~(font.max+1 IN [0C..177C]) THEN ERROR;
            inStreamProcs _ IO.CreateStreamProcs[
                variety: $input, class: $SimpleTerminal,
                getChar: GetChar,
                endOf: EndOf,
                charsAvail: CharsAvail
                ];
            outStreamProcs _ IO.CreateStreamProcs[
                variety: $output, class: $SimpleTerminal,
                putChar: PutChar,
                eraseChar: EraseChar
                ];
            terminal _ Terminal.Current[];
            terminal.RegisterNotifier[DoShutDown];
            };

        Initialize[@terminalLock];
        <<>>
    END.

    ChangeLog

    WSO, July 30, 1984:  catch BasicTime.TimeNotKnown in call to BasicTime.Now.