CaretsImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Doug Wyatt, May 8, 1985 10:19:01 am PDT
Russ Atkinson (RRA) June 10, 1985 7:57:21 pm PDT
Michael Plass, November 21, 1985 12:29:28 pm PST
DIRECTORY
Carets USING [CaretId],
CaretsExtras USING [],
CedarProcess USING [SetPriority],
Imager USING [Color, Context, MaskBits, SetColor],
ImagerBackdoor USING [invert],
Process USING [Detach, MsecToTicks, SetTimeout],
ViewerClasses USING [Viewer],
ViewerOps USING [UserToScreenCoords],
ViewerPrivate USING [PaintScreen, Screen, ViewerScreen];
CaretsImpl:
CEDAR
MONITOR
IMPORTS CedarProcess, Imager, ImagerBackdoor, Process, ViewerOps, ViewerPrivate
EXPORTS Carets, CaretsExtras
SHARES ViewerOps
~ BEGIN OPEN Carets;
Viewer: TYPE ~ ViewerClasses.Viewer;
Screen: TYPE ~ ViewerPrivate.Screen;
timeOut: CONDITION;
caretH: INTEGER = 6;
caretW: INTEGER = 16;
caretXOffset: CARDINAL = 8;
CaretBits: TYPE ~ REF CaretBitsRep;
CaretBitsRep: TYPE = ARRAY [0..caretH) OF WORD;
xminCaret: INTEGER ~ -4;
xmaxCaret: INTEGER ~ 3;
yminCaret: INTEGER ~ -caretH;
pCaret: CaretBits ~
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
]];
sCaret: CaretBits ~
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
]];
Caret: TYPE ~ REF CaretRep;
CaretRep:
TYPE ~
RECORD[
bits: CaretBits ← 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 ← []];
SELECT id
FROM
primary => caret.bits ← pCaret;
secondary => caret.bits ← sCaret;
ENDCASE => ERROR;
carets[id] ← caret;
ENDLOOP;
};
StartCaret:
PUBLIC
ENTRY
PROC [viewer: Viewer, x, y:
INTEGER, id: CaretId] = {
ENABLE UNWIND => NULL;
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;
KillCaret[carets[id]];
};
StopCaretsInViewer:
PUBLIC
ENTRY
PROC [viewer: Viewer] ~ {
ENABLE UNWIND => NULL;
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;
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;
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;
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] ~ {
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.MaskBits[context: context, base: LOOPHOLE[caret.bits], wordsPerLine: 1,
sMin: 0, fMin: 0, sSize: caretH, fSize: caretW, tx: caret.sx-caretXOffset, ty: 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];
};
};
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.