X11ViewersProcsImpl.mesa
Copyright Ó 1988, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, November 28, 1988 5:15:06 pm PST
Christian Jacobi, August 16, 1993 12:19 pm PDT
Willie-s, October 30, 1991 11:58 am PST
Michael Plass, February 25, 1992 4:05 pm PST
Initialization order matters: must be started after X11ViewersImpl
X11ViewersProcsImpl:
CEDAR
MONITOR
IMPORTS ImagerColor, LRUCache, X11Viewers, Xl, XlColorAccess, XlCutBuffers, XlCursor, XTk, XTkNotification, ViewersWorld
EXPORTS X11Viewers ~
Cursors
CursorInfo: TYPE = REF CursorInfoRec;
CursorInfoRec:
PUBLIC
TYPE =
RECORD [
connection: Xl.Connection ¬ NIL,
garbageCollectCursor: Xl.Cursor ¬ Xl.nullCursor,
gc: Xl.GContext,
pixmap, bigPixmap: Xl.Pixmap, --contains cursor picture
cache: LRUCache.Handle,
last: CRef ¬ NIL,
gcCursorUsedRecently: BOOL ¬ FALSE,
hasBigCursor: BOOL ¬ FALSE,
didQueryBigCursur: BOOL ¬ FALSE
];
CRef: TYPE = REF CData;
CData:
TYPE =
RECORD [
hotx, hoty: INTEGER ¬ 0,
isBig: BOOL ¬ FALSE,
cursor: Xl.Cursor ¬ Xl.nullCursor,
actualXCursorColor: REF Xl.RGBRec ¬ NIL,
w: XTk.Widget ¬ NIL, --a copy, so operations on "last" have correct connection
patternName: ATOM ¬ NIL,
--Used to be a overlayd record, but since for Cedar1.0 one element was changed to a ref this is safer.
small: ViewersWorldClasses.CursorArray ¬ ALL[0],
big: ViewersWorldClasses.Cursor32ArrayRef ¬ NIL
];
cfree: CRef ¬ NIL;
NewCursorRec:
ENTRY
PROC [w: XTk.Widget]
RETURNS [cref: CRef] = {
cref ¬ cfree; cfree ¬ NIL;
IF cref=NIL THEN cref ¬ NEW[CData];
cref.w ¬ w;
cref.small ¬ ALL[0]; cref.big ¬ NIL;
};
CursorRecHash:
PROC [x:
REF]
RETURNS [
CARDINAL] = {
--used for lru-cache
--color is NOT part of hash
c: CRef ~ NARROW[x];
cnt: INT ¬ c.hotx*31+c.hoty;
IF c.isBig
AND c.big#
NIL
THEN
FOR i:
INT
IN [0..15]
DO
cnt ¬ (cnt MOD 10000000H)*31 + LOOPHOLE[c.big[2*i]]
ENDLOOP
ELSE
FOR i:
INT
IN [0..7]
DO
add: INT16 ¬ LOOPHOLE[c.small[2*i]];
cnt ¬ (cnt MOD 10000000H)*31 + add
ENDLOOP;
RETURN [LOOPHOLE[cnt]]
};
CursorRecEqual:
PROC [x:
REF, y:
REF]
RETURNS [
BOOL] = {
--used for lru-cache
--color is NOT considered
c1: CRef ~ NARROW[x];
c2: CRef ~ NARROW[y];
IF c1.patternName#c2.patternName THEN RETURN [FALSE];
IF c1.hotx#c2.hotx OR c1.hoty#c2.hoty THEN RETURN [FALSE];
IF c1.isBig#c2.isBig THEN RETURN [FALSE];
IF c1.isBig
AND c1.big#
NIL AND c2.big#
NIL
THEN {IF c1.big#c2.big THEN RETURN [FALSE]}
ELSE {IF c1.small#c2.small THEN RETURN [FALSE]};
RETURN [TRUE];
};
GetCursorPattern:
PROC [screenServerData:
REF, cursor:
REF ¬
NIL]
RETURNS [deltaX, deltaY:
INTEGER ¬ 0, cursorPattern: Cursors.CursorArray, patternName:
ATOM ¬
NIL] = {
Returns last value set with SetCursorPattern procedure
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {
ci: REF CursorInfoRec ~ data.cursorInfo;
IF ci#
NIL
AND ~data.instable
THEN {
cref: CRef ~ ci.last;
IF cref#
NIL
AND ~cref.isBig
THEN {
deltaX ¬ cref.hotx;
deltaY ¬ cref.hoty;
patternName ¬ cref.patternName;
cursorPattern ¬ cref.small;
};
};
};
ENDCASE => {};
};
GetBigCursorPattern: ViewersWorldClasses.GetBigCursorPatternProc = {
Returns last value set with SetCursorPattern procedure
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {
ci: REF CursorInfoRec ~ data.cursorInfo;
IF ci#
NIL
AND ~data.instable
THEN {
cref: CRef ~ ci.last;
IF cref#
NIL
AND cref.isBig
THEN {
deltaX ¬ cref.hotx;
deltaY ¬ cref.hoty;
cursorPattern ¬ cref.big;
patternName ¬ cref.patternName;
};
};
};
ENDCASE => {};
};
Cleanup:
PROC [screenServerData:
REF
ANY] = {
Call this after an error occured to free the cursor cache
ResetCursorCache:
PROC [ci: CursorInfo] = {
IF ci#
NIL
THEN {
h: LRUCache.Handle ~ ci.cache;
IF h#NIL THEN LRUCache.Reset[h]
};
};
WITH screenServerData
SELECT
FROM
data: ScreenServerData => ResetCursorCache[data.cursorInfo];
ENDCASE => {};
};
FixCursor:
PROC [cref: CRef, data: ScreenServerData] = {
w: XTk.Widget ~ cref.w;
axc: REF Xl.RGBRec ¬ cref.actualXCursorColor;
xc: REF Xl.RGBRec ~ EnsureCursorColor[data];
IF axc#xc
THEN {
IF axc=
NIL
OR axc#xc
THEN {
cref.actualXCursorColor ¬ axc ¬ xc;
Xl.ReColorCursor[c: w.connection, cursor: cref.cursor, foreground: axc]
};
};
Xl.ChangeWindowAttributes[w.connection, w.window, [cursor: cref.cursor]];
Xl.Flush[w.connection];
};
SetCursorPattern:
PROC [screenServerData:
REF
ANY, deltaX, deltaY:
INTEGER, cursorPattern: Cursors.CursorArray, patternName:
ATOM, cursor:
REF] = {
Associates this cursorPattern to window on screenServer
delta: hot spot
ENABLE UNCAUGHT => IF ~X11Viewers.debugging THEN {Cleanup[screenServerData]; GOTO oops};
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {
ci: CursorInfo ~ data.cursorInfo;
IF ci#
NIL
AND ~data.instable
THEN {
w: XTk.Widget ~ data.bitmap;
IF w#
NIL
AND w.state=realized
AND w.fastAccessAllowed=ok
THEN {
used: REF; insert: BOOL;
cref: CRef ¬ NewCursorRec[w];
cref.isBig ¬ FALSE;
cref.hotx ¬ deltaX; cref.hoty ¬ deltaY;
cref.small ¬ cursorPattern; cref.patternName ¬ patternName;
[insert: insert, used: used] ¬ LRUCache.Include[ci.cache, cref];
IF ~insert THEN {cfree ¬ cref; cref ¬ NARROW[used]};
IF cref.cursor=Xl.nullCursor
THEN
TRUSTED {
--Data structure established, but cursor needs initialization
--Copy pattern to make sure scan lines length is known independent whether type is packed or NOT
space: PACKED ARRAY [0..16) OF CARD16;
FOR i: INTEGER IN [0..16) DO space[i] ¬ cref.small[i] ENDLOOP;
Xl.PutImage[c: cref.w.connection, drawable: ci.pixmap.drawable, gc: ci.gc, size: [16, 16], dest: [0, 0], base: @space, offx: 0, offy: 0, scanLineBytes: 2];
BEGIN
xc: REF Xl.RGBRec ~ EnsureCursorColor[data];
--Coordinate transform from Cedar Viewers's hotspot to X Cursors hotspot very experimental due to not really understanding the Cedar side.
--I assume Viewers takes the left upper point of the cursor pattern to be the origin and defines the hotspot from there using a coordinate system pointing upward and to the right. (Explained by textcursor having hotspot 0, 0 and bullseye having negative offsets).
--X (consistent, as always) takes the left upper point of the cursor pattern to be the origin and defines the hotspot from there using a coordinate system pointing to the right and down.
hot: Xl.Point ¬ [-cref.hotx, -cref.hoty];
--X restricts the hotspot to be inside.
hot.x ¬ MAX[MIN[hot.x, 16], 0]; hot.y ¬ MAX[MIN[hot.y, 16], 0];
cref.cursor ¬ Xl.CreateCursor[c: cref.w.connection, source: ci.pixmap, mask: ci.pixmap, hotP: hot, foreground: xc];
cref.actualXCursorColor ¬ xc;
END;
};
IF ci.last=cref
THEN {
--already established; maybe we can skip the work
IF ci.gcCursorUsedRecently
THEN ci.gcCursorUsedRecently ¬ FALSE
ELSE RETURN;
};
ci.last ¬ cref;
FixCursor[cref, data];
};
};
};
ENDCASE => {};
EXITS oops => {};
};
SetBigCursorPattern: ViewersWorldClasses.SetBigCursorPatternProc = {
Associates this cursorPattern to window on screenServer
delta: hot spot
ENABLE
UNCAUGHT =>
IF ~X11Viewers.debugging THEN {Cleanup[screenServerData]; GOTO oops};
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {
ci: CursorInfo ~ data.cursorInfo;
IF ci#
NIL
AND ~data.instable
AND cursorPattern#
NIL
THEN {
w: XTk.Widget ~ data.bitmap;
IF w#
NIL
AND w.state=realized
AND w.fastAccessAllowed=ok
THEN {
used: REF; insert: BOOL;
cref: CRef ¬ NewCursorRec[w];
cref.hotx ¬ deltaX; cref.hoty ¬ deltaY;
cref.big ¬ cursorPattern; cref.patternName ¬ patternName;
cref.isBig ¬ TRUE;
[insert: insert, used: used] ¬ LRUCache.Include[ci.cache, cref];
IF ~insert THEN {cfree ¬ cref; cref ¬ NARROW[used]};
IF cref.cursor=Xl.nullCursor
THEN
TRUSTED {
--Data structure established, but cursor needs initialization
Xl.PutImage[c: w.connection, drawable: ci.bigPixmap.drawable, gc: ci.gc, size: [32, 32], dest: [0, 0], base: LOOPHOLE[cref.big], offx: 0, offy: 0, scanLineBytes: 4];
BEGIN
xc: REF Xl.RGBRec ~ EnsureCursorColor[data];
--Coordinate transform from Cedar Viewers's hotspot to X Cursors hotspot very experimental due to not really understanding the Cedar side.
--I assume Viewers takes the left upper point of the cursor pattern to be the origin and defines the hotspot from there using a coordinate system pointing upward and to the right. (Explained by textcursor having hotspot 0, 0 and bullseye having negative offsets).
--X (consistent, as always) takes the left upper point of the cursor pattern to be the origin and defines the hotspot from there using a coordinate system pointing to the right and down.
hot: Xl.Point ¬ [-cref.hotx, -cref.hoty];
--X restricts the hotspot to be inside.
hot.x ¬ MAX[MIN[hot.x, 32], 0]; hot.y ¬ MAX[MIN[hot.y, 32], 0];
cref.cursor ¬ Xl.CreateCursor[c: w.connection, source: ci.bigPixmap, mask: ci.bigPixmap, hotP: hot, foreground: xc];
cref.actualXCursorColor ¬ xc;
END;
};
IF ci.last=cref
THEN {
--already established; maybe we can skip the work
IF ci.gcCursorUsedRecently
THEN ci.gcCursorUsedRecently ¬ FALSE
ELSE RETURN;
};
ci.last ¬ cref;
FixCursor[cref, data];
};
};
};
ENDCASE => {};
EXITS oops => {};
};
BigCursorsSupported: ViewersWorldClasses.BigCursorsSupportedProc = {
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {
ci: REF CursorInfoRec ~ data.cursorInfo;
IF ci#
NIL
AND ~data.instable
THEN {
sd: Xl.ScreenDepth ~ data.top.screenDepth;
IF sd#
NIL
AND ~ci.didQueryBigCursur
THEN {
screen: Xl.Screen ~ sd.screen;
s: Xl.Size;
s ¬ Xl.QueryBestSize[screen.connection, cursor, screen.root.drawable, [32, 32] !
UNCAUGHT => {s ¬ [0, 0]; CONTINUE}
];
ci.didQueryBigCursur ¬ TRUE;
ci.hasBigCursor ¬ s.width>=32 AND s.height>=32;
};
RETURN [ci.hasBigCursor];
};
};
ENDCASE => {};
RETURN [FALSE]
};
IsBigCursorPattern: ViewersWorldClasses.IsBigCursorPatternProc = {
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {
ci: REF CursorInfoRec ~ data.cursorInfo;
IF ci#
NIL
AND ~data.instable
THEN {
cref: CRef ~ ci.last;
IF cref#NIL THEN RETURN [cref.isBig]
};
};
ENDCASE => {};
RETURN [FALSE]
};
ToX11ViewersColor:
PROC [color: Imager.Color, invGamma:
REAL ¬ 0.4545454]
RETURNS [rgbRef:
REF Xl.RGBRec] = {
rgb: ImagerColor.RGB ~ ImagerColor.RGBFromColor[NARROW[color]];
rgbRef ¬
NEW[Xl.RGBRec ¬ [
red: XlColorAccess.RealColorValToXColorVal[rgb.R, invGamma],
green: XlColorAccess.RealColorValToXColorVal[rgb.G, invGamma],
blue: XlColorAccess.RealColorValToXColorVal[rgb.B, invGamma]
]];
};
SetCursorColor: ViewersWorldClasses.SetCursorColorProc = {
ENABLE UNCAUGHT => {IF ~X11Viewers.debugging THEN {Cleanup[screenServerData]; GOTO oops}};
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {
ci: CursorInfo ~ data.cursorInfo;
data.xCursorColor ¬ ToX11ViewersColor[color, data.invGamma];
data.imagerCursorColor ¬ color;
IF ci#
NIL
AND ~data.instable
THEN {
cref: CRef ¬ ci.last;
IF cref#NIL THEN FixCursor[cref, data]; --does too much, but it really doesn't matter
};
}
ENDCASE => {};
EXITS oops => {};
};
InitData: XTk.WidgetNotifyProc = {
WITH callData
SELECT
FROM
data: ScreenServerData => {
Cleanup[data];
[] ¬ EnsureCursorColor[data];
lastData ¬ data;
};
ENDCASE => {};
};
defaultCursorColor: Imager.Color ~ ImagerColor.ColorFromRGB[[1, 0, 0]];
EnsureCursorColor:
PROC [data: ScreenServerData]
RETURNS [xc:
REF Xl.RGBRec] =
INLINE {
Allways returns a non-NIL REF Xl.RGBRec
xc ¬ data.xCursorColor;
IF xc=
NIL
THEN {
data.xCursorColor ¬ xc ¬ ToX11ViewersColor[defaultCursorColor];
data.imagerCursorColor ¬ defaultCursorColor;
};
};
GetCursorColor: ViewersWorldClasses.GetCursorColorProc = {
WITH screenServerData
SELECT
FROM
data: ScreenServerData => color ¬ data.imagerCursorColor;
ENDCASE => {};
IF color=NIL THEN color ¬ defaultCursorColor;
};
SetGCMode:
PUBLIC
PROC [doingGC:
BOOL] = {
Use a funny cursor to denote gc...
No error catching because done by caller
WITH lastData
SELECT
FROM
data: ScreenServerData => {
ci: CursorInfo ~ data.cursorInfo;
IF ci#
NIL
AND ~data.instable
THEN {
cref: CRef ~ ci.last;
IF cref#
NIL
THEN {
w: XTk.Widget ~ cref.w;
IF w#
NIL
AND w.state=realized
AND w.fastAccessAllowed=ok
THEN {
c: Xl.Connection ~ w.connection;
cursor: Xl.Cursor ~ IF doingGC THEN ci.garbageCollectCursor ELSE cref.cursor;
Xl.ChangeWindowAttributes[c, w.window, [cursor: cursor]];
Xl.Flush[c];
IF doingGC THEN ci.gcCursorUsedRecently ¬ TRUE;
};
};
};
};
ENDCASE => {};
};
Device, Mouse, Blink
SetMousePosition:
PROC [screenServerData:
REF
ANY, x, y:
INTEGER, display:
REF ¬
NIL, device:
REF ¬
NIL] = {
This procedure might or might not noop if called while cursor is grabbed by other application.
Result undefined if x, y outside window.
All the way to the X server; eventually this position will be reported to the input mechanisms.
Use for forced cursor movements, not for general cursor tracking.
ENABLE UNCAUGHT => IF ~X11Viewers.debugging THEN {Cleanup[screenServerData]; GOTO oops};
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {
w: XTk.Widget ~ data.bitmap;
IF w#
NIL
AND ~data.instable
THEN {
IF x<0 OR y<0 OR x>w.actual.size.width OR y>w.actual.size.height THEN RETURN;
IF data.actualSurfaceUnitsPerPixel=2 THEN {x ¬ x*2; y ¬ x*2};
Xl.WarpPointer[c: w.connection, dstWindow: w.window, dstPos: [x: x, y: w.actual.size.height-y], srcWindow: w.window];
Xl.Flush[w.connection];
};
};
ENDCASE => {};
EXITS oops => {}
};
GetMousePosition:
PROC [screenServerData:
REF
ANY, device:
REF ¬
NIL]
RETURNS [x, y:
INTEGER ¬ 0, display:
REF ¬
NIL] = {
Returns position as thought by X11Viewer; this might be ahead of other input mechanisms
Use for forced cursor movements, not for general cursor tracking.
ENABLE UNCAUGHT => IF ~X11Viewers.debugging THEN {Cleanup[screenServerData]; GOTO oops};
valid: BOOL ¬ FALSE; --its computed, but I don't know what to do with it...
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {
w: XTk.Widget ~ data.bitmap;
IF w#
NIL
AND ~data.instable
THEN {
reply: Xl.PointerReply = Xl.QueryPointer[w.connection, w.window];
IF reply.sameScreen
THEN {
valid ¬ TRUE;
IF reply.pos.x<0
OR reply.pos.x>w.actual.size.width
THEN valid ¬ FALSE
ELSE x ¬ reply.pos.x;
IF reply.pos.y<0
OR reply.pos.y>w.actual.size.height
THEN valid ¬ FALSE
ELSE y ¬ w.actual.size.height-reply.pos.y;
IF data.actualSurfaceUnitsPerPixel=2 THEN {x ¬ x/2; y ¬ y/2};
};
};
};
ENDCASE => {};
EXITS oops => {RETURN[]}
};
GetDeviceSize:
PROC [screenServerData:
REF, display:
REF ¬
NIL]
RETURNS [w, h:
NAT ¬ 0] = {
Returns size of screen containing screenServerData
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {w ¬ data.width; h ¬ data.height};
ENDCASE => {};
};
Sound:
PROC [screenServerData:
REF
ANY, display:
REF, frequency:
CARDINAL, duration:
CARDINAL] = {
Rings the bell; Ignores display, frequency and duration...
ENABLE UNCAUGHT => IF ~X11Viewers.debugging THEN {Cleanup[screenServerData]; GOTO oops};
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {
top: XTk.Widget ~ data.top;
c: Xl.Connection ~ IF top#NIL THEN top.connection ELSE NIL;
IF Xl.Alive[c] AND ~data.instable THEN Xl.Bell[c]
};
ENDCASE => {};
EXITS oops => {};
Cut buffers
CutBufferPushTioga:
PROC [c: Xl.Connection, data: Rope.
ROPE] = {
tioga: Xl.XAtom ~ Xl.InternAtom[c, "Tioga", TRUE].atom;
Xl.ChangeProperty[c: c, w: Xl.FirstRoot[c], property: tioga, type: tioga, mode: replace, data: data];
Xl.Flush[c];
};
SetCutBuffer:
PROC [screenServerData:
REF
ANY, buffer:
ATOM, data: Rope.
ROPE] = {
Pushes data into a cut buffer
for buffer = $Ascii data is Ascii string
for buffer = $Tioga data is encoded Tioga node
for unknown buffer noop
ENABLE UNCAUGHT => {IF ~X11Viewers.debugging THEN GOTO oops};
WITH screenServerData
SELECT
FROM
d: ScreenServerData => {
top: XTk.Widget ~ d.top;
c: Xl.Connection ~ IF top#NIL THEN top.connection ELSE NIL;
IF Xl.Alive[c]
AND ~d.instable
THEN {
SELECT buffer
FROM
$Ascii, $xterm, NIL => XlCutBuffers.Put[c, data];
$Tioga => CutBufferPushTioga[c, data];
ENDCASE => {};
};
};
ENDCASE => {};
EXITS oops => {};
};
CutBufferGetTioga:
PROC [c: Xl.Connection]
RETURNS [data: Rope.
ROPE] = {
tioga: Xl.XAtom ~ Xl.InternAtom[c, "Tioga", TRUE].atom;
pr: Xl.PropertyReturnRec ¬ Xl.GetProperty[c: c, w: Xl.FirstRoot[c], property: tioga, supposedFormat: 8];
WITH pr.value
SELECT
FROM
r: Rope.ROPE => data ¬ r;
ENDCASE => {};
};
GetCutBuffer:
PROC [screenServerData:
REF
ANY, buffer:
ATOM]
RETURNS [Rope.
ROPE ¬
NIL] = {
Gets data from cut buffer
might or might not flush the contents of the cut buffer
for buffer = $Ascii returned data is Ascii string
for buffer = $Tioga returned data is encoded Tioga node
for unknown buffer NIL
ENABLE UNCAUGHT => {IF ~X11Viewers.debugging THEN GOTO oops};
WITH screenServerData
SELECT
FROM
d: ScreenServerData => {
top: XTk.Widget ~ d.top;
c: Xl.Connection ~ IF top#NIL THEN top.connection ELSE NIL;
IF Xl.Alive[c]
AND ~d.instable
THEN {
SELECT buffer
FROM
$Tioga => RETURN [ CutBufferGetTioga[c] ];
$Ascii, $xterm, NIL => RETURN [ XlCutBuffers.Get[c] ];
ENDCASE => RETURN [NIL];
};
};
ENDCASE => {};
EXITS oops => {RETURN [NIL]};
};
Others
NewCursorInfo:
PROC [bitmap: XTk.Widget]
RETURNS [ci:
REF CursorInfoRec ¬
NIL] = {
c: Xl.Connection ~ bitmap.connection;
sd: Xl.ScreenDepth ~ bitmap.screenDepth;
IF Xl.Alive[c]
AND sd#
NIL
THEN {
drawable: Xl.Drawable ~ sd.screen.root.drawable;
ci ¬ NEW[CursorInfoRec];
ci.connection ¬ c;
ci.cache ¬ LRUCache.Create[cacheSize, CursorRecHash, CursorRecEqual];
ci.pixmap ¬ Xl.CreatePixmap[c: c, drawable: drawable, size: [16, 16], depth: 1];
ci.bigPixmap ¬ Xl.CreatePixmap[c: c, drawable: drawable, size: [32, 32], depth: 1];
ci.gc ¬ Xl.MakeGContext[c, drawable];
Xl.SetGCGraphicsExposures[ci.gc, FALSE];
Xl.SetGCGrounds[gc: ci.gc, foreground: 1, background: 0];
ci.garbageCollectCursor ¬ XlCursor.SharedStandardCursor[c, boxSpiral];
};
};
NewOrCachedCursorInfo:
PROC [bitmap: XTk.Widget]
RETURNS [
REF CursorInfoRec ¬
NIL] = {
c: Xl.Connection ~ bitmap.connection;
IF ~Xl.Alive[c] THEN RETURN [NIL];
WITH XTk.GetWidgetProp[bitmap, $CursorInfoRec]
SELECT
FROM
ci: REF CursorInfoRec => IF ci.connection=c THEN RETURN [ci];
ENDCASE => {};
BEGIN
ci: REF CursorInfoRec ~ NewCursorInfo[bitmap];
IF ci#NIL THEN XTk.PutWidgetProp[bitmap, $CursorInfoRec, ci];
RETURN [ci];
END;
};
Reset:
PUBLIC
PROC [screenServerData:
REF
ANY] = {
ENABLE UNCAUGHT => {IF ~X11Viewers.debugging THEN GOTO oops};
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {
bitmap: XTk.Widget ~ data.bitmap;
IF bitmap=
NIL
OR bitmap.fastAccessAllowed#ok
OR ~Xl.Alive[bitmap.connection]
THEN {
data.instable ¬ TRUE; data.cursorInfo ¬ NIL;
}
ELSE {
ci: REF CursorInfoRec ~ NewOrCachedCursorInfo[bitmap];
data.cursorInfo ¬ ci;
IF ci=
NIL
OR ~Xl.Alive[ci.connection]
THEN --breakpoint here-- data.instable ¬ TRUE
ELSE --breakpoint here-- data.instable ¬ FALSE
};
}
ENDCASE => {};
EXITS oops => {};
};
Warning:
PUBLIC
PROC [screenServerData:
REF
ANY, screen:
INT ¬ -1] = {
WITH screenServerData
SELECT
FROM
data: ScreenServerData => {
WITH data.cursorInfo
SELECT
FROM
ci:
REF CursorInfoRec => {
bitmap: XTk.Widget ~ data.bitmap;
IF bitmap#
NIL
AND bitmap.fastAccessAllowed=ok
THEN {
c: Xl.Connection ¬ bitmap.connection;
IF Xl.Alive[c] THEN RETURN; --warning arrives after problem has been fixed
};
};
ENDCASE => {};
data.instable ¬ TRUE; data.cursorInfo ¬ NIL;
};
ENDCASE => {};
};
AllocateColorMapIndex: ViewersWorldClasses.AllocateColorMapIndexProc = {
ERROR ViewersWorld.outOfColormapEntries
};
FreeColorMapIndex: ViewersWorldClasses.FreeColorMapIndexProc = {
};
SetColorMapEntry: ViewersWorldClasses.SetColorMapEntryProc = {
};
GetColorMapEntry: ViewersWorldClasses.GetColorMapEntryProc = {
red ¬ green ¬ blue ¬ 0;
};
FastAccessStopped: XTk.WidgetNotifyProc = {
Warning[registerData];
};
RegisterFastAccessStopped: XTk.WidgetNotifyProc = {
data: ScreenServerData ~ NARROW[callData];
w: XTk.Widget ~ data.top;
XTk.RegisterNotifier[w, XTk.preStopFastAccessKey, FastAccessStopped, data];
};
Initializations
X11Viewers.baseClass.bigCursorsSupported ¬ BigCursorsSupported;
X11Viewers.baseClass.isBigCursorPattern ¬ IsBigCursorPattern;
X11Viewers.baseClass.setBigCursorPattern ¬ SetBigCursorPattern;
X11Viewers.baseClass.getBigCursorPattern ¬ GetBigCursorPattern;
X11Viewers.baseClass.setCursorColor ¬ SetCursorColor;
X11Viewers.baseClass.getCursorColor ¬ GetCursorColor;
X11Viewers.baseClass.getCursorPattern ¬ GetCursorPattern;
X11Viewers.baseClass.setCursorPattern ¬ SetCursorPattern;
X11Viewers.baseClass.setMousePosition ¬ SetMousePosition;
X11Viewers.baseClass.getMousePosition ¬ GetMousePosition;
X11Viewers.baseClass.getDeviceSize ¬ GetDeviceSize;
X11Viewers.baseClass.blink ¬ Sound;
X11Viewers.baseClass.getCutBuffer ¬ GetCutBuffer;
X11Viewers.baseClass.setCutBuffer ¬ SetCutBuffer;
X11Viewers.baseClass.allocateColorMapIndex ¬ AllocateColorMapIndex;
X11Viewers.baseClass.freeColorMapIndex ¬ FreeColorMapIndex;
X11Viewers.baseClass.setColorMapEntry ¬ SetColorMapEntry;
X11Viewers.baseClass.getColorMapEntry ¬ GetColorMapEntry;
XTkNotification.RegisterGlobal[X11Viewers.beforeWindowCreation, InitData];
XTkNotification.RegisterGlobal[X11Viewers.afterWidgetCreation, RegisterFastAccessStopped];