<> <> <> <> DIRECTORY Process, Xl, XTk, XTkBlinker; XTkBlinkerImpl: CEDAR MONITOR IMPORTS Process, Xl, XTk EXPORTS XTkBlinker ~ BEGIN OPEN XTkBlinker; <> 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] = { <> <> 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] = { <> <<"key" is used as property key on w to denote this blinker>> <> <> 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] = { <> 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]] = { <> 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] = { <> 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.