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;
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.