<<>>
    <<CaretsImpl.mesa>>
        <<Copyright Ó 1985, 1986, 1991 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson (RRA) June 10, 1985 7:57:21 pm PDT>>
        <<Michael Plass, November 21, 1985 12:29:28 pm PST>>
        <<Doug Wyatt, December 16, 1986 3:45:54 pm PST>>
        <<Pier, November 18, 1988 5:07:29 pm PST>>
        <<Bier, January 9, 1989 1:53:50 pm PST>>
        <<Christian Jacobi, October 24, 1991 5:46 pm PDT>>
        <<Willie-s, October 29, 1991 6:16 pm PST>>

    DIRECTORY
        Carets,
        CedarProcess USING [SetPriority],
        Imager USING [Color, Context, MaskBitmap, SetColor],
        ImagerBackdoor USING [invert],
        ImagerSample USING [SampleMap, UnsafeNewSampleMap],
        Process USING [Detach, MsecToTicks, SetTimeout],
        ViewerClasses USING [Viewer],
        ViewerOps USING [UserToScreenCoords],
        ViewerPrivate USING [PaintScreen, Screen, ViewerScreen];

    CaretsImpl: CEDAR MONITOR
        IMPORTS CedarProcess, Imager, ImagerBackdoor, ImagerSample, Process, ViewerOps, ViewerPrivate
        EXPORTS Carets, ViewerPrivate
        SHARES ViewerOps
        ~ BEGIN OPEN Carets;

    CaretId: TYPE ~ Carets.CaretId;
    Viewer: TYPE ~ ViewerClasses.Viewer;
    Screen: TYPE ~ ViewerPrivate.Screen;

    timeOut: CONDITION;

    caretH: INTEGER = 6;
    caretW: INTEGER = 16;
    caretXOffset: CARDINAL = 8;

    xminCaret: INTEGER ~ -4;
    xmaxCaret: INTEGER ~ 3;
    yminCaret: INTEGER ~ -caretH;
    ymaxCaret: INTEGER ~ 0;

    CaretBits: TYPE ~ REF CaretBitsRep;
    <<KAP for PCedar November 18, 1988>>
    CaretBitsRep: TYPE = PACKED ARRAY [0..caretH) OF CARD16;

    caretBits: ARRAY CaretId OF CaretBits Ź [
        primary: NEW[CaretBitsRep Ź [
            000400B, -- 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0
            001600B, -- 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0
            003700B, -- 0 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0
            003300B, -- 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0
            006140B, -- 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0
            004040B  -- 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0
            ]],
        secondary: NEW[CaretBitsRep Ź [
            000400B, -- 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0
            001200B, -- 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0
            002100B, -- 0 0 0 0 0 1 0 0 0 1 0 0 0 0 0 0
            002100B, -- 0 0 0 0 0 1 0 0 0 1 0 0 0 0 0 0
            004040B, -- 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0
            004040B  -- 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0
            ]]
        ];

    SampleMapFromCaretBits: PROC [bits: CaretBits] RETURNS [ImagerSample.SampleMap] ~ TRUSTED {
        <<KAP for PCedar November 18, 1988>>
        RETURN [ImagerSample.UnsafeNewSampleMap[
            box: [min: [s: 0, f: 0], max: [s: caretH, f: caretW]], 
            bitsPerSample: 1, bitsPerLine: BITS[CARD16], base: [word: LOOPHOLE[bits], bit: 0], 
            ref: bits, words: WORDS[CaretBitsRep]
            ]];
        };

    Caret: TYPE ~ REF CaretRep;
    CaretRep: TYPE ~ RECORD[
        bitmap: ImagerSample.SampleMap Ź NIL,
        viewer: Viewer Ź NIL, -- viewer containing the caret
        x, y: INTEGER Ź 0, -- position in viewer's client area
        sx, sy: INTEGER Ź 0, -- position on screen (recomputed when caret becomes visible).
        visible: BOOL Ź FALSE
        ];

    carets: ARRAY CaretId OF Caret Ź ALL[NIL];

    InitCarets: ENTRY PROC ~ {
        FOR id: CaretId IN CaretId DO
            caret: Caret ~ NEW[CaretRep Ź []];
            caret.bitmap Ź SampleMapFromCaretBits[caretBits[id]];
            carets[id] Ź caret;
            ENDLOOP;
        };

    StartCaret: PUBLIC ENTRY PROC [viewer: Viewer, x, y: INTEGER, id: CaretId] = {
        <<<<ENABLE UNWIND => NULL; ChJ: protected InvertCaret>>>>
        caret: Caret ~ carets[id];
        IF viewer = NIL THEN RETURN;
        KillCaret[caret]; -- kill off old visible caret
        x Ź MIN[x, viewer.cw];
        caret.viewer Ź viewer;
        caret.x Ź x; caret.y Ź y;
        PhaseCarets[];
        };

    StopCaret: PUBLIC ENTRY PROC [id: CaretId] = {
        <<<<ENABLE UNWIND => NULL; ChJ: protected InvertCaret>>>>
        KillCaret[carets[id]];
        };

    StopCaretsInViewer: PUBLIC ENTRY PROC [viewer: Viewer] ~ {
        <<<<ENABLE UNWIND => NULL; ChJ: protected InvertCaret>>>>
        FOR id: CaretId IN CaretId DO
            caret: Caret ~ carets[id];
            IF caret.viewer=viewer THEN KillCaret[caret];
            ENDLOOP;
        };

    caretHoldCount: INTEGER Ź 0; -- number of requests pending to suspend caret

    DoWithoutCarets: PUBLIC PROC [sx, sy, w, h: INTEGER, screen: Screen, action: PROC] = {
        suspended: BOOL Ź SuspendCaretsInsideBox[sx, sy, w, h, screen];
        IF suspended THEN {
            action[ ! UNWIND => ResumeCarets[]];
            ResumeCarets[];
            }
        ELSE action[];
        };

    SuspendCaretsInsideBox: ENTRY PROC [x, y, w, h: INTEGER, screen: Screen] RETURNS [suspended: BOOL Ź FALSE] = {
        <<<<ENABLE UNWIND => NULL; ChJ: protected InvertCaret>>>>
        FOR id: CaretId IN CaretId DO
            caret: Caret ~ carets[id];
            IF caret.viewer#NIL AND caret.visible AND ViewerPrivate.ViewerScreen[caret.viewer] = screen THEN {
                IF caret.sx IN [x-xmaxCaret..x+w-xminCaret) AND caret.sy IN [y-ymaxCaret..y+h-yminCaret) THEN InvertCaret[caret];
                };
            suspended Ź TRUE;
            ENDLOOP;
        IF suspended THEN caretHoldCount Ź caretHoldCount+1;
        };

    SuspendCarets: PUBLIC ENTRY PROC[visible: BOOL Ź FALSE] = {
        <<<<ENABLE UNWIND => NULL; ChJ: protected InvertCaret>>>>
        FOR id: CaretId IN CaretId DO
            caret: Caret ~ carets[id];
            IF caret.viewer#NIL AND caret.visible#visible THEN InvertCaret[caret];
            ENDLOOP;
        caretHoldCount Ź caretHoldCount+1;
        };

    lazy: BOOL Ź TRUE;
    ResumeCarets: PUBLIC ENTRY PROC = {
        <<<<ENABLE UNWIND => NULL; ChJ: protected InvertCaret>>>>
        IF caretHoldCount>0 THEN {
            caretHoldCount Ź caretHoldCount-1;
            IF NOT lazy AND caretHoldCount = 0 THEN PhaseCarets[];
            };
        };

    Visible: PROC [viewer: Viewer, x, y: INTEGER] RETURNS [BOOL] ~ {
        IF x IN[0..viewer.cw) AND y IN[0..viewer.ch) THEN {
            parent: Viewer ~ viewer.parent;
            IF parent#NIL THEN {
                px: INTEGER Ź x+viewer.cx;
                py: INTEGER Ź y+viewer.cy;
                top: BOOL ~ (parent#NIL AND parent.class.topDownCoordSys);
                px Ź px+viewer.wx;
                IF top THEN py Ź py+(parent.ch-viewer.wy-viewer.wh) ELSE py Ź py+viewer.wy;
                RETURN[Visible[parent, px, py]];
                }
            ELSE RETURN[TRUE];
            }
        ELSE RETURN[FALSE];
        };

    InvertCaret: INTERNAL PROC [caret: Caret] ~ {
        ENABLE ANY => GOTO Oops; --ChJ, October 24, 1991 
        viewer: Viewer ~ caret.viewer;
        IF viewer#NIL AND (caret.visible OR Visible[viewer, caret.x, caret.y]) THEN {
            screen: ViewerPrivate.Screen ~ ViewerPrivate.ViewerScreen[viewer];
            invertCaretAction: PROC [context: Imager.Context] ~ {
                Imager.SetColor[context, ImagerBackdoor.invert];
                Imager.MaskBitmap[context: context, bitmap: caret.bitmap, referencePoint: [f: caretXOffset, s: 0], position: [caret.sx, caret.sy]];
                caret.visible Ź NOT caret.visible;
                };
            IF NOT caret.visible THEN [caret.sx, caret.sy] Ź ViewerOps.UserToScreenCoords[viewer, caret.x, caret.y];
            ViewerPrivate.PaintScreen[screen: screen, action: invertCaretAction, suspendCarets: FALSE];
            };
        EXITS Oops => {}
        };

    KillCaret: INTERNAL PROC [caret: Caret] ~ {
        IF caret.viewer=NIL THEN RETURN;
        IF caret.visible THEN InvertCaret[caret];
        caret.viewer Ź NIL;
        };

    caretPhase: BOOL Ź FALSE;  -- Master ticker for carets; inverts twice a second.
    PhaseCarets: INTERNAL PROC ~ {
        <<Puts the caret in the proper phase, unless suspended.>>
        FOR id: CaretId IN CaretId DO
            caret: Caret ~ carets[id];
            IF caret.viewer#NIL AND caret.visible # caretPhase AND caretHoldCount=0 THEN InvertCaret[caret];
            ENDLOOP;
        };

    CaretProcess: ENTRY PROC = {
        ENABLE UNWIND => NULL;
        suspended: BOOL Ź FALSE;
        TRUSTED {Process.SetTimeout[@timeOut, Process.MsecToTicks[500]]};
        CedarProcess.SetPriority[foreground];
        DO
            WAIT timeOut;
            caretPhase Ź NOT caretPhase;
            PhaseCarets[];
            ENDLOOP;
        };

    InitCarets[];
    TRUSTED {Process.Detach[FORK CaretProcess]}; -- start the blinker

    END.