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;
ymaxCaret: INTEGER ~ 0;
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 ~ {
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.
����CaretsImpl.mesa
Copyright c 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
Puts the caret in the proper phase, unless suspended.
�Ê£��˜�codešœ™Kšœ
Ïmœ1™<K™'K™0K™0—K˜�šÏk ˜ Kšœžœ ˜Kšœ
žœ˜Kšœ
žœ˜!Kšœžœ&˜2Kšœžœ
˜ Kšœžœ#˜0Kšœžœ
˜ Kšœ
žœ˜%Kšœžœ%˜8—K˜�šÐbl
œžœž˜KšžœH˜OKšžœ˜ Kšžœ
˜Kšœžœžœ˜—K˜�Kšœžœ˜$Kšœžœ˜$K˜�Kšœ ž œ˜K˜�Kšœžœ˜Kšœžœ˜Kšœžœ˜K˜�Kšœ žœžœ˜#Kš œžœžœ
žœžœ˜/K˜�Kšœ žœ˜Kšœ žœ˜Kšœ žœ ˜ šœ žœ˜K˜�—šœžœ˜(Kšœ Ïc"˜+Kšœ "˜+Kšœ "˜+Kšœ "˜+Kšœ "˜+Kšœ "˜+K˜—K˜�šœžœ˜(Kšœ "˜+Kšœ "˜+Kšœ "˜+Kšœ "˜+Kšœ "˜+Kšœ "˜+K˜K˜�—Kšœžœžœ
˜šœ
žœžœ˜Kšœžœ˜Kšœžœ ˜4Kšœžœ #˜6Kšœžœ >˜SKšœ žœž˜Kšœ˜K˜�—Kš œžœ žœ žœžœ˜*K˜�šÏn
œžœžœ˜šžœ
žœ ž˜ Kšœžœ˜"šžœž˜K˜ K˜!Kšžœžœ˜—K˜Kšžœ˜—K˜K˜�—š
¡
œžœžœžœžœ˜NKšžœžœžœ˜K˜Kšžœ
žœžœžœ˜ Kšœ ˜/Kšœžœ˜K˜Kšœ˜Kšœ˜Kšœ˜K˜�—š¡ œžœžœžœ˜.Kšžœžœžœ˜Kšœ˜Kšœ˜K˜�—š¡œžœžœžœ˜:Kšžœžœžœ˜šžœ
žœ ž˜ J˜Jšžœžœ˜-Kšžœ˜—Kšœ˜K˜�—Kšœžœ .˜KK˜�š
¡œžœžœžœžœ˜VKšœ žœ0˜?šžœ žœ˜Kšœ
žœ˜$Kšœ˜Kšœ˜—Kšžœ
˜Kšœ˜K˜�—š¡œžœžœžœžœ
žœžœ˜nKšžœžœžœ˜šžœ
žœ ž˜ Jšœ˜š
žœžœžœžœ3žœ˜bKš
žœ
žœ žœ
žœ žœ˜qKšœ˜—Kšœ žœ˜Kšžœ˜—Kšžœ žœ#˜4Kšœ˜K˜�—š ¡
œžœžœžœ
žœžœ˜;Kšžœžœžœ˜šžœ
žœ ž˜ J˜Jšžœžœžœžœ˜FKšžœ˜—K˜"Kšœ˜K˜�—Kšœžœžœ˜š¡ œžœžœžœ˜#Kšžœžœžœ˜šžœžœ˜Kšœ"˜"Kšžœžœžœžœ˜6Kšœ˜—Kšœ˜K˜�—š
¡œžœžœžœžœ˜@š
žœžœžœžœžœ˜3Kšœ ˜ šžœžœžœ˜Kšœžœ˜Kšœžœ˜Kšœžœ žœžœ ˜:Kšœ˜Kšžœžœ)žœ˜KKšžœ˜ Kšœ˜—Kšžœžœžœ˜Kšœ˜—Kšžœžœžœ˜K˜K˜�—š¡ œžœžœ˜-K˜ š
žœžœžœžœ$žœ˜MKšœB˜Bšœžœ ˜5Kšœ0˜0Kšœ(žœy˜©Kšœžœ˜"K˜—KšžœžœžœO˜hKšœTžœ˜[K˜—Kšœ˜K˜�—š¡ œžœžœ˜+Kšžœžœžœžœ˜ Kšžœžœ˜)Kšœžœ˜Kšœ˜K˜�—Kšœ žœžœ 4˜Oš¡ œžœžœ˜ Kšœ5™5šžœ
žœ ž˜ Kšœ˜Kš
žœžœžœ žœžœ˜`Kšžœ˜—Kšœ˜K˜�—š¡ œžœžœ˜ Kšžœžœžœ˜Kšœ žœžœ˜Kšžœ:˜AK˜%šž˜Kšžœ ˜
Kšœ
žœ ˜ Kšœ˜Kšžœ˜—Kšœ˜K˜�—K˜
Kšžœžœ ˜AK˜�Kšžœ˜—�…—����þ�� µ��