
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;
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 {
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] = {
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] = {
KillCaret[carets[id]];
};

StopCaretsInViewer: PUBLIC ENTRY PROC [viewer: Viewer] ~ {
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] = {
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] = {
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 = {
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 ~ {
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.
   N  
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
KAP for PCedar November 18, 1988
KAP for PCedar November 18, 1988
<<ENABLE UNWIND => NULL; ChJ: protected InvertCaret>>
<<ENABLE UNWIND => NULL; ChJ: protected InvertCaret>>
<<ENABLE UNWIND => NULL; ChJ: protected InvertCaret>>
<<ENABLE UNWIND => NULL; ChJ: protected InvertCaret>>
<<ENABLE UNWIND => NULL; ChJ: protected InvertCaret>>
<<ENABLE UNWIND => NULL; ChJ: protected InvertCaret>>
Puts the caret in the proper phase, unless suspended.
 Э╩	  ХNewlineDelimiter
Ц(cedarcode) styleЩ codeЪЬЩKЪЬ
╧eЬ=ЩHKЩ0KЩ0KЩ,KЩ&KЩ$KЩ.KЩ&ЧKШ Ъ╧k	Ш	KЪЬШKЪЬЮЬШ!KЪЬЮЬ(Ш4KЪЬЮЬ
ШKЪЬЮЬ!Ш3KЪЬЮЬ#Ш0KЪЬЮЬ
ШKЪЬ
ЮЬШ%KЪЬЮЬ%Ш8ЧKШ Ъ╨bl
ЬЮЬЮШKЪЮЬVШ]KЪЮЬШKЪЮЬ
ШKЪЬЮЬЮЬШЧKШ KЪЬ	ЮЬШKЪЬЮЬШ$KЪЬЮЬШ$KШ KЪЬ	Ю	ЬШKШ KЪЬЮЬШKЪЬЮЬШKЪЬЮЬШKШ KЪЬЮЬШKЪЬЮЬШKЪЬЮЬШЪЬЮЬШKШ ЧKЪЬЮЬЮЬШ#KЪЬ Щ KЪЬЮЬЮЬЮЬЮЬЮЬШ8KШ ЪЬЮЬ	ЮЬШ)ЪЬ	ЮЬШKЪЬ	╧c"Ш+KЪЬ	а"Ш+KЪЬ	а"Ш+KЪЬ	а"Ш+KЪЬ	а"Ш+KЪЬ	а"Ш+KШЧЪЬЮЬШKЪЬ	а"Ш+KЪЬ	а"Ш+KЪЬ	а"Ш+KЪЬ	а"Ш+KЪЬ	а"Ш+KЪЬ	а"Ш+KШЧШKШ ЧЧЪ╧nЬЮЬЮЬЮЬШ[KЪЬ Щ ЪЮЬ"Ш(KЪЬ7Ш7KЪЬЮЬЮЬЮЬШSKЪЬЮЬШ%KЪЬШЧKШKШ ЧKЪЬЮЬЮЬ
ШЪЬ
ЮЬЮЬШKЪЬ!ЮЬШ%KЪЬЮЬаШ4KЪЬЮЬа#Ш6KЪЬЮЬа>ШSKЪЬ	ЮЬЮШKЪЬШKШ ЧKЪ	ЬЮЬ	ЮЬ	ЮЬЮЬШ*KШ Ъб
ЬЮЬЮЬШЪЮЬЮЬ	ЮШKЪЬЮЬШ"KЪЬ5Ш5KШKЪЮЬШЧKШKШ ЧЪ
б
ЬЮЬЮЬЮЬЮЬШNKЪЬ5Щ5KШKЪЮЬ
ЮЬЮЬЮЬШKЪЬаШ/KЪЬЮЬШKШKЪЬШKЪЬШKЪЬШKШ ЧЪб	ЬЮЬЮЬЮЬШ.KЪЬ5Щ5KЪЬШKЪЬШKШ ЧЪбЬЮЬЮЬЮЬШ:KЪЬ5Щ5ЪЮЬЮЬ	ЮШKШKЪЮЬЮЬШ-KЪЮЬШЧKЪЬШKШ ЧKЪЬЮЬа.ШKKШ Ъ
бЬЮЬЮЬЮЬЮЬШVKЪЬЮЬ0Ш?ЪЮЬЮЬШKЪЬ
ЮЬШ$KЪЬШKЪЬШЧKЪЮЬ
ШKЪЬШKШ ЧЪбЬЮЬЮЬЮЬЮЬЮЬЮЬШnKЪЬ5Щ5ЪЮЬЮЬ	ЮШKЪЬШЪ
ЮЬЮЬЮЬЮЬ3ЮЬШbKЪ
ЮЬ
ЮЬЮЬ
ЮЬЮЬШqKЪЬШЧKЪЬЮЬШKЪЮЬШЧKЪЮЬЮЬ#Ш4KЪЬШKШ ЧЪбЬЮЬЮЬЮЬ
ЮЬЮЬШ;KЪЬ5Щ5ЪЮЬЮЬ	ЮШKШKЪЮЬЮЬЮЬЮЬШFKЪЮЬШЧKШ"KЪЬШKШ ЧKЪЬЮЬЮЬШЪбЬЮЬЮЬЮЬШ#KЪЬ5Щ5ЪЮЬЮЬШKЪЬ"Ш"KЪЮЬЮЬЮЬЮЬШ6KЪЬШЧKЪЬШKШ ЧЪ
бЬЮЬЮЬЮЬЮЬШ@Ъ
ЮЬЮЬЮЬЮЬЮЬШ3KЪЬШЪЮЬЮЬЮЬШKЪЬЮЬШKЪЬЮЬШKЪЬЮЬЮЬЮЬШ:KЪЬШKЪЮЬЮЬ)ЮЬШKKЪЮЬШ KЪЬШЧKЪЮЬЮЬЮЬШKЪЬШЧKЪЮЬЮЬЮЬШKШKШ ЧЪбЬЮЬЮЬШ-KЪЮЬЮЬЮЬаШ1KШЪ
ЮЬЮЬЮЬЮЬ$ЮЬШMKЪЬBШBЪЬЮЬШ5KЪЬ0Ш0KЪЬГШГKЪЬЮЬШ"KШЧKЪЮЬЮЬЮЬOШhKЪЬTЮЬШ[KШЧ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ЪЮЬШЧ ЕЧ      $v  