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™˜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šžœ˜—…—ώ ΅