
    <<CursorsImpl.mesa >>
        <<Copyright © 1985, 1986 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson (RRA) May 6, 1986 10:51:40 pm PDT>>
        <<Doug Wyatt, March 30, 1985 3:48:41 pm PST>>

        DIRECTORY
            Basics USING [BITNOT, BITOR],
            Cursors USING [ClientCursor, CornerSide, CursorArray, CursorHandle, CursorInfo, CursorRec, CursorType, PredefinedCursor],
            ImagerBackdoor USING [DrawBits],
            Interminal USING [SetCursorOffset, SetCursorPattern],
            Process USING [Detach, InitializeCondition, MsecToTicks, Ticks],
            PseudoCursors USING [PseudoCursor],
            TerminalDefs USING [Cursor],
            ViewerClasses USING [PaintProc, Viewer, ViewerClass, ViewerClassRec],
            ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass],
            ViewerPrivate USING [];

    CursorsImpl: CEDAR MONITOR
        IMPORTS Basics, ImagerBackdoor, Interminal, Process, ViewerOps
        EXPORTS Cursors, PseudoCursors, ViewerPrivate
        = BEGIN OPEN Cursors; 

    <<global variables and types>>

        ClientCursorArray: TYPE = ARRAY ClientCursor OF CursorHandle;
        X: BOOL = TRUE;
        O: BOOL = FALSE;

        PackedCursor: TYPE = PACKED ARRAY [0..16*16) OF BOOL;

        global: Global = NEW[GlobalData _ []];
        Global: TYPE = REF GlobalData;
        GlobalData: TYPE = RECORD [
            info: CursorInfo _ [last, 0, 0, FALSE],
            bits: CursorArray _ ALL[WORD.LAST],
            clientCursors: REF ClientCursorArray _ NEW[ClientCursorArray _ ALL[NIL]],
            lastUsedCursor: CursorType _ LAST[PredefinedCursor],
            initialHourglass: PackedCursor _ [
                X, X, X, X, X, X, X, X, X, X, X, X, X, X, X, X,
                X, X, X, X, X, X, X, X, X, X, X, X, X, X, X, X,
                O, X, X, X, X, X, X, X, X, X, X, X, X, X, X, O,
                O, O, X, X, X, X, X, X, X, X, X, X, X, X, O, O,
                O, O, O, X, X, X, X, X, X, X, X, X, X, O, O, O,
                O, O, O, O, X, X, X, X, X, X, X, X, O, O, O, O,
                O, O, O, O, O, X, X, X, X, X, X, O, O, O, O, O,
                O, O, O, O, O, O, X, X, X, X, O, O, O, O, O, O,
                O, O, O, O, O, O, X, O, O, X, O, O, O, O, O, O,
                O, O, O, O, O, X, O, O, O, O, X, O, O, O, O, O,
                O, O, O, O, X, O, O, O, O, O, O, X, O, O, O, O,
                O, O, O, X, O, O, O, O, O, O, O, O, X, O, O, O,
                O, O, X, O, O, O, O, O, O, O, O, O, O, X, O, O,
                O, X, O, O, O, O, O, O, O, O, O, O, O, O, X, O,
                X, O, O, O, O, O, O, O, O, O, O, O, O, O, O, X,
                X, X, X, X, X, X, X, X, X, X, X, X, X, X, X, X
                ],
            invertSand: BOOL _ TRUE,
            sand: BOOL _ TRUE,
            sandArray: ARRAY [1..15) OF CARDINAL _ ALL[0],
            sandUsed, tick, totalTicks, savedTicks: CARDINAL _ 0,
            theHG: PackedCursor _ ALL[FALSE],
            waitTime: Process.Ticks _ Process.MsecToTicks[100]
            ];

    <<Cursors procedures>>

        GetCursor: PUBLIC ENTRY PROC RETURNS [CursorType] ~ {
            RETURN [global.info.type];
            };

        GetCursorInfo: PUBLIC ENTRY PROC RETURNS [CursorInfo] ~ {
            RETURN [global.info]
            };

        SetCursor: PUBLIC ENTRY PROC [type: CursorType] = TRUSTED {
            SELECT type FROM
                global.info.type => RETURN;
                bullseye => {
                    global.info _ [bullseye, -7,-7, FALSE];
                    global.bits _ [
                        003700B, 007740B, 014060B, 030030B,
                        060014B, 140006B, 141606B, 141606B,
                        141606B, 140006B, 060014B, 030030B,
                        014060B, 007740B, 003700B, 000000B]; 
                    };
                hourGlass => {
                    global.info _ [hourGlass, -7,-7, FALSE];
                    global.bits _ [
                        177777B, 100001B, 040002B, 034034B,
                        017170B, 007560B, 003740B, 001700B,
                        001100B, 002440B, 004220B, 010610B,
                        021704B, 047762B, 177777B, 177777B];
                    };
                menu => {
                    global.info _ [menu, 0,-7, FALSE];
                    global.bits _ [
                        000000B, 000000B, 000000B, 001000B,
                        003001B, 007003B, 036007B, 177776B,
                        177776B, 036007B, 007003B, 003001B,
                        001000B, 000000B, 000000B, 000000B];
                    };
                scrollUpDown => {
                    global.info _ [scrollUpDown, -7,-7, FALSE];
                    global.bits _ [
                        000400B, 001600B, 003700B, 007740B,
                        017760B, 001600B, 001600B, 001600B,
                        001600B, 001600B, 001600B, 017760B,
                        007740B, 003700B, 001600B, 000400B];
                    };
                textPointer => {
                    global.info _ [textPointer, 0,0, FALSE];
                    global.bits _ [
                        100000B, 140000B, 160000B, 170000B,
                        174000B, 176000B, 177000B, 170000B,
                        154000B, 114000B, 006000B, 006000B,
                        003000B, 003000B, 001400B, 001400B];
                    };
                activate => {
                    global.info _ [activate, -7,-7, FALSE];
                    global.bits _ [
                        177777B, 177777B, 140003B, 140003B,
                        140003B, 140003B, 140003B, 140003B,
                        140003B, 140003B, 140003B, 140003B,
                        140003B, 140003B, 177777B, 177777B];
                    };
                blank => {
                    global.info _ [blank, 0,0, FALSE];
                    global.bits _ [
                        000000B, 000000B, 000000B, 000000B,
                        000000B, 000000B, 000000B, 000000B,
                        000000B, 000000B, 000000B, 000000B,
                        000000B, 000000B, 000000B, 000000B];
                    };
                confirm => {
                    global.info _ [confirm, 0,0, FALSE];
                    global.bits _ [
                        000000B, 000000B, 167227B, 105324B,
                        105326B, 105264B, 167224B, 000000B,
                        000000B, 073642B, 022266B, 023652B,
                        022442B, 072242B, 000000B, 000000B];
                    };
                crossHairsCircle => {
                    global.info _ [crossHairsCircle, -7,-7, FALSE];
                    global.bits _ [
                        001700B, 007760B, 014630B, 030614B,
                        060606B, 040602B, 140603B, 177177B,
                        177177B, 140603B, 040602B, 060606B,
                        030614B, 014630B, 007760B, 001700B];
                    };
                ftp => {
                    global.info _ [ftp, -7,-7, FALSE];
                    global.bits _ [
                        000177B, 076077B, 040037B, 040017B,
                        070007B, 043703B, 040401B, 040400B,
                        000400B, 100436B, 140421B, 160421B,
                        170036B, 174020B, 176020B, 177020B];
                    };
                typeKey => {
                    global.info _ [typeKey, -7,-7, FALSE];
                    global.bits _ [
                        002000B, 074000B, 140000B, 012767B,
                        012525B, 053566B, 111113B, 163100B,
                        000000B, 000000B, 154000B, 053520B,
                        062520B, 053360B, 155440B, 000140B];
                    };
                move => {
                    global.info _ [move, -7,-7, FALSE];
                    global.bits _ [
                        000000B, 000000B, 000000B, 014030B,
                        016070B, 017170B, 017770B, 015730B,
                        014630B, 014030B, 014030B, 014030B,
                        014030B, 000000B, 000000B, 000000B];
                    };
                mouseBlue => {
                    global.info _ [mouseBlue, -2,0, FALSE];
                    global.bits _ [
                        037770B, 020010B, 025350B, 025350B,
                        025350B, 025350B, 025350B, 020010B,
                        020010B, 020010B, 020010B, 020010B,
                        020010B, 020010B, 020010B, 037770B];
                    };
                mouseRed => {
                    global.info _ [mouseRed, -2,0, FALSE];
                    global.bits _ [
                        037770B, 020010B, 027250B, 027250B,
                        027250B, 027250B, 027250B, 020010B,
                        020010B, 020010B, 020010B, 020010B,
                        020010B, 020010B, 020010B, 037770B];
                    };
                mouseYellow => {
                    global.info _ [mouseYellow, -2,0, FALSE];
                    global.bits _ [
                        037770B, 020010B, 025650B, 025650B,
                        025650B, 025650B, 025650B, 020010B,
                        020010B, 020010B, 020010B, 020010B,
                        020010B, 020010B, 020010B, 037770B];
                    };
                grow => {
                    global.info _ [grow, 0,0, FALSE];
                    global.bits _ [
                        000000B, 000000B, 000000B, 003740B,
                        007760B, 006060B, 014000B, 014370B,
                        014370B, 014030B, 006060B, 007760B,
                        003740B, 000000B, 000000B, 000000B];
                    };
                pointDown => {
                    global.info _ [pointDown, -7,-15, FALSE];
                    global.bits _ [
                        001700B, 001700B, 001700B, 001700B,
                        001700B, 001700B, 001700B, 001700B,
                        001700B, 001700B, 037774B, 017770B,
                        007760B, 003740B, 001700B, 000600B];
                    };
                pointLeft => {
                    global.info _ [pointLeft, 0,-7, FALSE];
                    global.bits _ [
                        000000B, 000000B, 020000B, 060000B,
                        016000B, 036000B, 077777B, 177777B,
                        177777B, 077777B, 036000B, 016000B,
                        060000B, 020000B, 000000B, 000000B];
                    };
                pointRight => {
                    global.info _ [pointRight, -15,-7, FALSE];
                    global.bits _ [
                        000000B, 000000B, 000040B, 000060B,
                        000070B, 000074B, 177776B, 177777B,
                        177777B, 177776B, 000074B, 000070B,
                        000060B, 000040B, 000000B, 000000B];
                    };
                pointUp => {
                    global.info _ [pointUp, -7,0, FALSE];
                    global.bits _ [
                        000600B, 001700B, 003740B, 007760B,
                        017770B, 037774B, 001700B, 001700B,
                        001700B, 001700B, 001700B, 001700B,
                        001700B, 001700B, 001700B, 001700B];
                    };
                questionMark => {
                    global.info _ [questionMark, -7,-7, FALSE];
                    global.bits _ [
                        017000B, 037600B, 060600B, 140300B,
                        140300B, 060300B, 000600B, 001400B,
                        003000B, 006000B, 006000B, 006000B,
                        000000B, 000000B, 006000B, 006000B];
                    };
                retry => {
                    global.info _ [retry, -7,-7, FALSE];
                    global.bits _ [
                        036370B, 021200B, 021200B, 036347B,
                        024200B, 022200B, 021370B, 000000B,
                        000000B, 175721B, 021052B, 021044B,
                        021704B, 021204B, 021104B, 021044B];
                    };
                scrollDown => {
                    global.info _ [scrollDown, -7,-7, FALSE];
                    global.bits _ [
                        007760B, 007760B, 007760B, 007760B,
                        007760B, 007760B, 007760B, 007760B,
                        007760B, 077776B, 037774B, 017770B,
                        007760B, 003740B, 001700B, 000600B];
                    };
                scrollLeft => {
                    global.info _ [scrollLeft, -7,-7, FALSE];
                    global.bits _ [
                        000000B, 001000B, 003000B, 007000B,
                        017777B, 037777B, 077777B, 177777B,
                        177777B, 077777B, 037777B, 017777B,
                        007000B, 003000B, 001000B, 000000B];
                    };
                scrollLeftRight => {
                    global.info _ [scrollLeftRight, -7,-7, FALSE];
                    global.bits _ [
                        000000B, 000000B, 000000B, 004020B,
                        014030B, 034034B, 077776B, 177777B,
                        177777B, 077776B, 034034B, 014030B,
                        004020B, 000000B, 000000B, 000000B];
                    };
                scrollUp => {
                    global.info _ [scrollUp, -7,-7, FALSE];
                    global.bits _ [
                        000600B, 001700B, 003740B, 007760B,
                        017770B, 037774B, 077776B, 007760B,
                        007760B, 007760B, 007760B, 007760B,
                        007760B, 007760B, 007760B, 007760B];
                    };
                scrollRight => {
                    global.info _ [scrollRight, -7,-7, FALSE];
                    global.bits _ [
                        000000B, 000100B, 000140B, 000160B,
                        177770B, 177774B, 177776B, 177777B,
                        177777B, 177776B, 177774B, 177770B,
                        000160B, 000140B, 000100B, 000000B];
                    };
                ENDCASE => {
                    global.info _ global.clientCursors[type].info;
                    global.bits _ global.clientCursors[type].bits;
                    };

            Interminal.SetCursorPattern[global.bits];
            Interminal.SetCursorOffset[global.info.hotX, global.info.hotY];
            };

        InvertCursor: PUBLIC ENTRY PROC = {
            FOR n: CARDINAL IN [0..SIZE[CursorArray]) DO
                global.bits[n] _ Basics.BITNOT[global.bits[n]];
                ENDLOOP;
            Interminal.SetCursorPattern[global.bits];
            global.info.inverted _ ~ global.info.inverted;
            };

        NewCursor: PUBLIC ENTRY PROC [bits: CursorArray, hotX, hotY: INTEGER _ 0]
        RETURNS [CursorType] = {
            global.lastUsedCursor _ SUCC[global.lastUsedCursor];
            global.clientCursors[global.lastUsedCursor] _ NEW[CursorRec _ [
                [global.lastUsedCursor, hotX, hotY, FALSE],
                bits
                ]];
            RETURN[global.lastUsedCursor];
            };

        AddCursorCorner: PUBLIC ENTRY PROC [cornerSide: CornerSide] = {
            i: CARDINAL[0..15];
            SELECT cornerSide FROM
                upperLeft => {
                    global.info.hotX _ global.info.hotY _ 0;
                    global.bits[0] _ 177777B;
                    global.bits[1] _ 177777B;
                    FOR i IN [2..16) DO
                        global.bits[i] _ Basics.BITOR[global.bits[i], 140000B];
                        ENDLOOP;
                    };
                upperRight => {
                    global.info.hotX _ -15;
                    global.info.hotY _ 0;
                    global.bits[0] _ 177777B;
                    global.bits[1] _ 177777B;
                    FOR i IN [2..16) DO
                        global.bits[i] _ Basics.BITOR[global.bits[i], 000003B];
                        ENDLOOP;
                    };
                lowerLeft => {
                    global.info.hotX _ 0;
                    global.info.hotY _ -15;
                    global.bits[14] _ 177777B;
                    global.bits[15] _ 177777B;
                    FOR i IN [0..14) DO
                        global.bits[i] _ Basics.BITOR[global.bits[i], 140000B];
                        ENDLOOP;
                    };
                lowerRight => {
                    global.info.hotX _ global.info.hotY _ -15;
                    global.bits[14] _ 177777B;
                    global.bits[15] _ 177777B;
                    FOR i IN [0..14) DO
                        global.bits[i] _ Basics.BITOR[global.bits[i], 000003B];
                        ENDLOOP;
                    };
                upperSide => {
                    global.bits[0] _ 177777B;
                    global.bits[1] _ 177777B;
                    };
                lowerSide => {
                    global.bits[14] _ 177777B;
                    global.bits[15] _ 177777B;
                    };
                leftSide => {
                    FOR i IN [0..16) DO
                        global.bits[i] _ Basics.BITOR[global.bits[i], 140000B];
                        ENDLOOP;
                    };
                rightSide => {
                    FOR i IN [0..16) DO
                        global.bits[i] _ Basics.BITOR[global.bits[i], 000003B];
                        ENDLOOP;
                    };
                ENDCASE;
            Interminal.SetCursorPattern[global.bits];
            Interminal.SetCursorOffset[global.info.hotX, global.info.hotY];
            };

    <<ViewerPrivate procedures>>

        <<See HourGlass.mesa for instructions on how to use these procedures.>>

        <<Here's how to modify the cursor:  change the global.initialHourglass array below to anything>>
        <<you like for an initial cursor.  Count the number of bits (of global.sand) contained in the top>>
        <<and change the constant grains to this number.  global.sandArray will also need to be changed>>
        <<in InitializeHourglass.  The first seven numbers tell how many grains there are to start in>>
        <<the top rows of the hourglass (not counting the sides).  The last seven numbers tell how>>
        <<many empty places (slots for global.sand grains) there are in the bottom rows of the hourglass. >>
        <<The algorithm that moves the grains will carefully skip over any grains you initially put>>
        <<in the bottom.  Other fun things to play with are the constants that control how steep>>
        <<(slope) the global.sand piles up in the bottom, or drains from the top.  Happy hacking,  /Scott.>>

        grains: CARDINAL = 56;
        initGrains: CARDINAL = 3;

        InitializeHourglass: PUBLIC PROC [ticks: CARDINAL] = TRUSTED {
            global.savedTicks _ ticks;
            global.sandUsed _ global.tick _ 0;
            global.totalTicks _ ticks;
            global.theHG _ global.initialHourglass;
            global.sandArray _ [14, 12, 10, 8, 6, 4, 2, 2, 3, 6, 7, 10, 11, 14];
            global.sand _ TRUE;
            };

        TickHourglass: PUBLIC PROC = TRUSTED {
            incr: INTEGER;
            n, m: CARDINAL;
            topSlope: CARDINAL = 3;
            bottomSlope: CARDINAL = 2;

            IF (global.tick_global.tick+1) > global.totalTicks
                THEN {
                    <<wrap around>>
                    IF global.invertSand
                    THEN global.sand _ ~global.sand
                    ELSE global.theHG _ global.initialHourglass;
                    global.sandUsed _ global.tick _ 0;
                    global.totalTicks _ global.savedTicks;
                    global.sandArray _ [14, 12, 10, 8, 6, 4, 2, 2, 3, 6, 7, 10, 11, 14];
                    RETURN;
                    }

                ELSE THROUGH [global.sandUsed..MIN[global.tick*grains/global.totalTicks, grains]) DO

                    <<take a grain out of the top non-empty row of global.sand, favoring the middle.>>
                    FOR n DECREASING IN [2..8) DO
                        IF global.sandArray[n] >= global.sandArray[n-1]+topSlope THEN EXIT;
                        REPEAT FINISHED => FOR n IN [1..8) DO
                            IF global.sandArray[n]#0 THEN EXIT;
                            ENDLOOP;
                        ENDLOOP;
                    global.sandArray[n] _ global.sandArray[n]-1;
                    m _ (n*16)+7;
                    incr _ 1;
                    UNTIL global.theHG[m]=global.sand DO
                        m _ m+incr;
                        incr _ -incr + (IF incr<0 THEN 1 ELSE -1);
                        ENDLOOP;
                    global.theHG[m] _ ~global.sand;

                    <<put a grain in one of the top non-empty rows of global.sand, favoring the middle,>>
                    <<and using the slope as a determinant of the global.sand stacking angle.>>
                    IF global.sandUsed < initGrains
                        THEN global.theHG[SELECT global.sandUsed FROM
                            0 => (9*16)+7,
                            1 => (11*16)+7,
                            ENDCASE => (13*16)+7] _ global.sand
                        ELSE {
                            FOR n IN [8..14) DO
                                IF global.sandArray[n] >= global.sandArray[n+1]+bottomSlope THEN EXIT;
                                REPEAT FINISHED => FOR n DECREASING IN [8..15) DO
                                    IF global.sandArray[n]#0 THEN EXIT;
                                    ENDLOOP;
                                ENDLOOP;
                            global.sandArray[n] _ global.sandArray[n]-1;
                            m _ (n*16)+7;
                            incr _ 1;
                            WHILE global.theHG[m]=global.sand DO
                                m _ m+incr;
                                incr _ -incr + (IF incr<0 THEN 1 ELSE -1);
                                ENDLOOP;
                            global.theHG[m] _ global.sand;
                            };

                    global.sandUsed _ global.sandUsed+1;

                    ENDLOOP;

        Interminal.SetCursorPattern[LOOPHOLE[global.theHG]]; -- update displayed cursor

        };

    <<Pseudo Cursors>>

        PseudoCursor: TYPE = PseudoCursors.PseudoCursor;

        DataRec: TYPE = RECORD [
            bits: REF TerminalDefs.Cursor,
            newData: BOOL _ FALSE,
            paint: PROCESS _ NIL,
            timeout: CONDITION
            ];

        Create: PUBLIC PROC [parent: ViewerClasses.Viewer, x, y: INTEGER _ 0] 
        RETURNS [PseudoCursor] = {
            data: REF DataRec _ NEW[DataRec];
            data.bits _ NEW[TerminalDefs.Cursor];
            TRUSTED { Process.InitializeCondition[@data.timeout, global.waitTime] };
            RETURN[ViewerOps.CreateViewer[flavor: $PsuedoCursor, info: [parent: parent, wx: x, wy: y, ww: 16, wh: 16, data: data, border: 
            FALSE], paint: FALSE]];
            };

        Set: PUBLIC ENTRY PROC [pseudoCursor: PseudoCursor, bits: REF TerminalDefs.Cursor] = {
            ENABLE UNWIND => {};
            IF pseudoCursor # NIL THEN WITH pseudoCursor.data SELECT FROM
                d: REF DataRec => {
                    IF bits=NIL THEN d.bits^ _ ALL[0] ELSE d.bits^ _ bits^;
                    d.newData  _ TRUE;
                    IF d.paint=NIL THEN TRUSTED {
                        Process.Detach[d.paint _ FORK PaintProcess[pseudoCursor]];
                        };
                    };
                ENDCASE;
            };

        PaintProcess: ENTRY PROC [pseudoCursor: PseudoCursor] = {
            ENABLE UNWIND => {};
            WITH pseudoCursor.data SELECT FROM
                d: REF DataRec => {
                    WHILE d.newData DO
                        d.newData _ FALSE;
                        ViewerOps.PaintViewer[pseudoCursor, client, FALSE, $Update];
                        WAIT d.timeout;
                        ENDLOOP;
                    d.paint _ NIL;
                    };
                ENDCASE;
            };

        PseudoCursorPaint: ViewerClasses.PaintProc = {
            IF self # NIL THEN WITH self.data SELECT FROM
                d: REF DataRec => {
                    ImagerBackdoor.DrawBits[context: context, base: LOOPHOLE[d.bits], wordsPerLine: 1, sMin: 0, fMin: 0, sSize: 16, fSize: 16, tx: 0, 
                    ty: 16];
                    };
                ENDCASE;
            };

        ViewerOps.RegisterViewerClass[
            $PsuedoCursor,
            NEW[ViewerClasses.ViewerClassRec _ [
                paint: PseudoCursorPaint,
                tipTable: NIL
                ]]
            ];


    END.