XTkBlinkerImpl.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, April 25, 1992 11:19 am PDT
Christian Jacobi, April 27, 1992 10:53 am PDT
DIRECTORY Process, Xl, XTk, XTkBlinker;
XTkBlinkerImpl: CEDAR MONITOR
IMPORTS Process, Xl, XTk
EXPORTS XTkBlinker ~
BEGIN OPEN XTkBlinker;
Time is a problem: If times were are all the same we could share a single process; this way it is somewhat harder. We use a simple implementation for now and might fix this if blinkers would be used more heavily.
BlinkerData: TYPE = REF BlinkerDataRep;
BlinkerDataRep: PRIVATE TYPE = RECORD [
class: BlinkerClass,
life: REF LifeData,
pos: Xl.Point,
supposedOn: BOOL ¬ FALSE,
count: CARD ¬ LAST[CARD],
runKey: REF ¬ NIL,
onTicks: Process.Ticks ¬ 0,
offTicks: Process.Ticks ¬ 0
];
LifeData: TYPE = RECORD [
--immutable
connection: Xl.Connection ¬ NIL,
parentW: Xl.Window,
blinkW: Xl.Window,
geometry: Xl.Geometry,
ref: REF READONLY ANY ¬ NIL,
--mutable
visible: BOOL ¬ FALSE
];
flush: Xl.Details ¬ NEW[Xl.DetailsRec ¬ [
errorMatch: NEW[Xl.MatchRep ¬ [proc: IgnoreErrors]],
flush: now
]];
IgnoreErrors: Xl.EventProcType = {};
NewBlinkerClass: PUBLIC PROC [createProc: CreateOverlayProc, installProc: InstallProc ¬ NIL, classData: REF ¬ NIL, onMsec: NAT ¬ 400, offMsec: NAT ¬ 400] RETURNS [BlinkerClass] = {
Represents application supporting a blinking overlay on widgets
A widget may have multiple blinkers.
c: BlinkerClass ~ NEW[BlinkerClassRep ¬ [createProc, installProc, classData, Process.MsecToTicks[onMsec], Process.MsecToTicks[offMsec]]];
RETURN [c];
};
InstallBlinker: PUBLIC PROC [w: XTk.Widget, key: REF, blinkerClass: BlinkerClass, persistent: BOOL ¬ FALSE] = {
Enables blinker behaviour on widget
"key" is used as property key on w to denote this blinker
Position is [0, 0] and state is "Off"
Persistent means that the widgets remembers when blinking was turned on after widget migration
bd: BlinkerData ~ NEW[BlinkerDataRep];
bd.class ¬ blinkerClass;
bd.onTicks ¬ blinkerClass.onTime;
bd.offTicks ¬ blinkerClass.offTime;
XTk.PutWidgetProp[w, key, bd];
IF blinkerClass.installProc#NIL THEN blinkerClass.installProc[w, key, blinkerClass];
IF persistent THEN XTk.RegisterNotifier[w, XTk.postWindowCreationKey, WindowCreated, key];
};
WindowCreated: XTk.WidgetNotifyProc = {
b: BlinkerData ~ GetBlinker[widget, registerData];
IF b.supposedOn THEN BlinkerOn[widget, registerData, b.count];
};
BlinkerSetPos: PUBLIC PROC [w: XTk.Widget, key: REF, pos: Xl.Point] = {
Sets position for blinker. Noop if no blinker installed.
b: BlinkerData ~ GetBlinker[w, key];
IF b#NIL THEN {
life: REF LifeData ¬ b.life;
b.pos ← pos;
IF life#NIL THEN {
IF w.fastAccessAllowed=ok AND w.connection=life.connection AND w.window=life.parentW THEN {
geometry: Xl.Geometry ¬ life.geometry;
geometry.pos.x ¬ geometry.pos.x+pos.x;
geometry.pos.y ¬ geometry.pos.y+pos.y;
Xl.ConfigureWindow[c: life.connection, window: life.blinkW, geometry: geometry, stackMode: topIf, details: flush]; --It is not guaranteed that window exists, but it is guaranteed that we are not fooling around with somebody elses window
};
};
};
};
BlinkerOn: PUBLIC PROC [w: XTk.Widget, key: REF, count: CARD ¬ LAST[CARD]] = {
Turns blinker on (makes it blinking). Noop if no blinker installed.
b: BlinkerData ~ GetBlinker[w, key];
IF b#NIL THEN {
b.count ¬ count;
b.supposedOn ¬ TRUE;
IF b.life=NIL THEN CreateWindow[w, b];
IF b.life#NIL THEN {
runKey: REF INT ~ NEW[INT];
b.runKey ¬ runKey;
TRUSTED {Process.Detach[FORK DoBlinking[b, w, runKey]]};
};
};
};
ChangeBlinkerSpeed: PUBLIC PROC [w: XTk.Widget, key: REF, onMsec: NAT ¬ 400, offMsec: NAT ¬ 400] = {
b: BlinkerData ~ GetBlinker[w, key];
IF b#NIL THEN {
b.onTicks ¬ Process.MsecToTicks[onMsec];
b.offTicks ¬ Process.MsecToTicks[offMsec];
};
};
DoBlinking: PROC [b: BlinkerData, parent: XTk.Widget, runKey: REF] = {
MakeVisible: PROC [l: REF LifeData] = {
IF l#NIL THEN Xl.MapWindow[l.connection, l.blinkW, flush];
};
MakeInvisible: PROC [l: REF LifeData] = {
IF l#NIL THEN Xl.UnmapWindow[l.connection, l.blinkW, flush];
};
life: REF LifeData ~ b.life;
IF life=NIL THEN RETURN;
WHILE b.runKey=runKey AND b.life=life AND b.count>0 DO
IF parent.fastAccessAllowed#ok OR parent.window#life.parentW THEN RETURN;
MakeVisible[life];
Process.Pause[b.onTicks];
IF parent.fastAccessAllowed#ok OR parent.window#life.parentW THEN {
--safety catch...
RETURN;
};
MakeInvisible[life];
Process.Pause[b.offTicks];
b.count ¬ b.count - 1;
ENDLOOP
};
CreateWindow: PROC [parent: XTk.Widget, b: BlinkerData] = {
Assign: ENTRY PROC[b: BlinkerData, parent: XTk.Widget, life: REF LifeData] = {
IF life.parentW=parent.window AND life.connection=parent.connection THEN {
b.life ¬ life
};
};
life: REF LifeData ¬ NEW[LifeData];
life.parentW ¬ parent.window;
life.connection ¬ parent.connection;
[life.blinkW, life.geometry, life.ref] ¬ b.class.createProc[
blinkerClass: b.class, parent: parent,
attributes: [saveUnder: true, overrideRedirect: true],
pos: b.pos
];
Assign[b, parent, life];
};
BlinkerOff: PUBLIC PROC [w: XTk.Widget, key: REF] = {
Turns blinker off (makes it invisible). Noop if no blinker installed.
b: BlinkerData ~ GetBlinker[w, key];
IF b#NIL THEN {
b.supposedOn ¬ FALSE;
b.runKey ¬ NIL;
};
};
GetBlinker: PROC [w: XTk.Widget, key: REF] RETURNS [BlinkerData¬NIL] = {
WITH XTk.GetWidgetProp[w, key] SELECT FROM
b: BlinkerData => {Check[w, b]; RETURN [b]};
ENDCASE => {};
};
Check: PROC [w: XTk.Widget, b: BlinkerData] = {
life: REF LifeData ¬ b.life;
IF life#NIL THEN {
IF w.fastAccessAllowed#ok OR w.connection#life.connection OR w.window#life.parentW THEN b.life ¬ NIL
};
};
END.