DIRECTORY 
ForkOps,
Imager,
ImagerSample,
Process,
Rope,
SF,
Xl,
XlBitmap,
XlBWFriends,
XlColorAccess,
XlDetails,
XlShmPixmaps,
XTk,
XTkFriends,
XTkBitmapWidgets,
XTkBitmapWidgetsExtras,
XTkShellWidgets;

XTkBitmapWidgetsImpl: CEDAR MONITOR 
LOCKS bmRef USING bmRef: REF BMRec
IMPORTS ForkOps, ImagerSample, Process, Rope, SF, Xl, XlBitmap, XlBWFriends, XlColorAccess, XlDetails, XlShmPixmaps, XTk, XTkFriends, XTkShellWidgets
EXPORTS XTkBitmapWidgets, XTkBitmapWidgetsExtras
SHARES XlBWFriends =
BEGIN OPEN Xl, XTk, XTkBitmapWidgets;

bmClass: ImplementorClass ¬ XTkFriends.CreateClass[[
key: $bitmapWidget, wDataNum: 1, 
configureLR: BMConfigureLR, 
destroyWindowLR: BMDestroyWindowLR, 
preStopFastAccess: BMPreStopFastAccess, 
fullStopFastAccessLR: BMFullStopFastAccessLR, 
destroyWidget: BMDestroyWidget, 
initInstPart: InitInstPart, 
eventMask: [exposure: TRUE, structureNotify: TRUE], 
backgroundKey: $white
]];

BMRec: TYPE = MONITORED RECORD [
wAsUsed: XlBWFriends.WRef ¬ NIL,
wInternal: XlBWFriends.WRef ¬ NIL,
bm: XlBitmap.Bitmap ¬ NIL,
origin: Xl.Point ¬ [0, 0],
restrict: SF.Box ¬ SF.maxBox,
notify: BitmapEventProc, 
mapped: BOOL ¬ FALSE,
data: REF ¬ NIL,
ownedBitmap: XlBitmap.Bitmap ¬ NIL,
support8: BOOL ¬ FALSE,
support4: BOOL ¬ FALSE,
support2: BOOL ¬ FALSE,
shmData: REF ShmData ¬ NIL,
gc: Xl.GContext
];

ShmData: TYPE = RECORD [
shmPixmap: Xl.Pixmap ¬ Xl.nullPixmap,
c: Xl.Connection ¬ NIL,
bm: XlBitmap.Bitmap ¬ NIL
];

noErrors: Xl.Details ~ XlDetails.ignoreErrors;
NoOp: Xl.EventProcType ~ {};
mPadNoErrors: Xl.Details ~ NEW[Xl.DetailsRec ¬ [
errorMatch: NEW[Xl.MatchRep ¬ [proc: NoOp]],
specific: $ZPixmap
]];

MPadBugActualPaint1: PROC[b: SF.Box, ref: REF] = {
w: XlBWFriends.WRef ~ NARROW[ref];
bpp: INT ~ 1;
dirtyFix: INT ¬ b.min.f MOD 32;
IF w.offset.x+b.min.f<dirtyFix THEN {
dirtyFix ¬ dirtyFix - 32; 
};
Xl.PutImage[c: w.c, drawable: w.d, gc: w.gc, 
base: w.base, 
dest: [w.offset.x+b.min.f-dirtyFix, w.offset.y+b.min.s], 
size: [b.max.f-b.min.f+dirtyFix, b.max.s-b.min.s], 
offx: b.min.f-dirtyFix, offy: b.min.s, 
scanLineBytes: w.scanLineBytes, bitsPerPixel: bpp, details: mPadNoErrors];
};

IBMBugActualPaint1: PROC[b: SF.Box, ref: REF] = {
w: XlBWFriends.WRef ~ NARROW[ref];
bpp: INT ~ 1;
dirtyFix: INT ¬ b.min.f MOD 32;
IF w.offset.x+b.min.f<dirtyFix THEN {
dirtyFix ¬ dirtyFix - 32; 
};
Xl.PutImage[c: w.c, drawable: w.d, gc: w.gc, 
base: w.base, 
dest: [w.offset.x+b.min.f-dirtyFix, w.offset.y+b.min.s], 
size: [b.max.f-b.min.f+dirtyFix, b.max.s-b.min.s], 
offx: b.min.f-dirtyFix, offy: b.min.s, 
scanLineBytes: w.scanLineBytes, bitsPerPixel: bpp, details: noErrors];
};

ActualPaint1: PROC[b: SF.Box, ref: REF] = {
w: XlBWFriends.WRef ~ NARROW[ref];
bpp: INT ~ 1;
dirtyFix: INT ~ 0;
Xl.PutImage[c: w.c, drawable: w.d, gc: w.gc, 
base: w.base, 
dest: [w.offset.x+b.min.f-dirtyFix, w.offset.y+b.min.s], 
size: [b.max.f-b.min.f+dirtyFix, b.max.s-b.min.s], 
offx: b.min.f-dirtyFix, offy: b.min.s, 
scanLineBytes: w.scanLineBytes, bitsPerPixel: bpp, details: noErrors];
};

ActualPaint2: PROC[b: SF.Box, ref: REF] = {
w: XlBWFriends.WRef ~ NARROW[ref];
bpp: INT ~ 2;
modulus: INT ~ 32 / bpp; --Oops, this line knows unit size is 32...
dirtyFix: INT ¬ b.min.f MOD modulus; 
IF w.offset.x+b.min.f<dirtyFix THEN {
dirtyFix ¬ dirtyFix - modulus; 
};
Xl.PutImage[c: w.c, drawable: w.d, gc: w.gc, 
base: w.base, 
dest: [w.offset.x+b.min.f-dirtyFix, w.offset.y+b.min.s], 
size: [b.max.f-b.min.f+dirtyFix, b.max.s-b.min.s], 
offx: b.min.f-dirtyFix, offy: b.min.s, 
scanLineBytes: w.scanLineBytes, bitsPerPixel: bpp, details: noErrors];
};

ActualPaint4: PROC[b: SF.Box, ref: REF] = {
w: XlBWFriends.WRef ~ NARROW[ref];
bpp: INT ~ 4;
modulus: INT ~ 32 / bpp; --Oops, this line knows unit size is 32...
dirtyFix: INT ¬ b.min.f MOD modulus; 
IF w.offset.x+b.min.f<dirtyFix THEN {
dirtyFix ¬ dirtyFix - modulus; 
};
Xl.PutImage[c: w.c, drawable: w.d, gc: w.gc, 
base: w.base, 
dest: [w.offset.x+b.min.f-dirtyFix, w.offset.y+b.min.s], 
size: [b.max.f-b.min.f+dirtyFix, b.max.s-b.min.s], 
offx: b.min.f-dirtyFix, offy: b.min.s, 
scanLineBytes: w.scanLineBytes, bitsPerPixel: bpp, details: noErrors];
};

ActualPaint8: PROC[b: SF.Box, ref: REF] = {
w: XlBWFriends.WRef ~ NARROW[ref];
bpp: INT ~ 8;
modulus: INT ~ 32 / bpp; --Oops, this line knows unit size is 32...
dirtyFix: INT ¬ b.min.f MOD modulus; 
IF w.offset.x+b.min.f<dirtyFix THEN {
dirtyFix ¬ dirtyFix - modulus; 
};
Xl.PutImage[c: w.c, drawable: w.d, gc: w.gc, 
base: w.base, 
dest: [w.offset.x+b.min.f-dirtyFix, w.offset.y+b.min.s], 
size: [b.max.f-b.min.f+dirtyFix, b.max.s-b.min.s], 
offx: b.min.f-dirtyFix, offy: b.min.s, 
scanLineBytes: w.scanLineBytes, bitsPerPixel: bpp, details: noErrors];
};

ActualPaint24: PROC[b: SF.Box, ref: REF] = {
w: XlBWFriends.WRef ~ NARROW[ref];
bpp: INT ~ 24;
dirtyFix: INT ¬ b.min.f MOD 3; 
--Oops, this line knows unit size is 32...
IF w.offset.x+b.min.f<dirtyFix THEN {
dirtyFix ¬ dirtyFix - 3; 
};
Xl.PutImage[c: w.c, drawable: w.d, gc: w.gc, 
base: w.base, 
dest: [w.offset.x+b.min.f-dirtyFix, w.offset.y+b.min.s], 
size: [b.max.f-b.min.f+dirtyFix, b.max.s-b.min.s], 
offx: b.min.f-dirtyFix, offy: b.min.s, 
scanLineBytes: w.scanLineBytes, bitsPerPixel: bpp, details: noErrors];
};

ShmPaintCopyPlane: PROC[b: SF.Box, ref: REF] = {
w: XlBWFriends.WRef ~ NARROW[ref];
Xl.CopyPlane[c: w.c, src: w.sharedD, dst: w.d, 
srcP: [b.min.f, b.min.s], 
dstP: [w.offset.x+b.min.f, w.offset.y+b.min.s], 
size: [b.max.f-b.min.f, b.max.s-b.min.s], 
gc: w.gc, bitPlane: 1, details: noErrors]
};

ShmPaintCopyArea: PROC[b: SF.Box, ref: REF] = {
w: XlBWFriends.WRef ~ NARROW[ref];
Xl.CopyArea[c: w.c, src: w.sharedD, dst: w.d, 
srcP: [b.min.f, b.min.s], 
dstP: [w.offset.x+b.min.f, w.offset.y+b.min.s], 
size: [b.max.f-b.min.f, b.max.s-b.min.s], 
gc: w.gc, details: noErrors]
};

GetInstData: PROC [w: Widget] RETURNS [REF BMRec] = INLINE {
RETURN [NARROW[XTkFriends.InstPart[w, bmClass]]];
};

eventFilter: Xl.EventFilter = Xl.CreateEventFilter[unmapNotify, mapNotify, expose];

EventHandler: Xl.EventProcType = {
widget: Widget ~ NARROW[clientData];
bmRef: REF BMRec ~ GetInstData[widget];
IF bmRef.notify#NIL THEN {
SELECT event.type FROM
mapNotify => {
bmRef.mapped ¬ TRUE;
SetBM[bmRef, widget, FALSE, FALSE];
bmRef.notify[widget, map, bmRef.data];
};
unmapNotify => {
bmRef.mapped ¬ FALSE;
Stop[bmRef];
bmRef.notify[widget, unmap, bmRef.data];
};
expose => {
e: Xl.ExposeEvent ~ NARROW[event];
s: XlBWFriends.SRef;
w: XlBWFriends.WRef ~ bmRef.wAsUsed;
IF w=NIL OR (s ¬ w.s)=NIL THEN RETURN;
XlBWFriends.IncludeRect[s, w, [
min: [s: e.pos.y-w.offset.y, f: e.pos.x-w.offset.x], 
max: [s: e.pos.y+e.size.height-w.offset.y, f: e.pos.x+e.size.width-w.offset.x]
], e.count#0];
};
ENDCASE => {};
};
};

FreeShmData: PROC [x: REF] = {
WITH x SELECT FROM
sd: REF ShmData => {
pm: Xl.Pixmap ¬ sd.shmPixmap;
sd.shmPixmap ¬ Xl.nullPixmap;
IF Xl.Alive[sd.c] AND pm#Xl.nullPixmap THEN Xl.FreePixmap[sd.c, pm, noErrors];
};
ENDCASE => {}
};

DelayedDestroyShmData: PROC [sd: REF ShmData] = {
IF sd#NIL THEN ForkOps.ForkDelayed[100, FreeShmData, sd]
};

BMDestroyWindowLR: TerminateProc = {
bmRef: REF BMRec ~ GetInstData[widget];
sd: REF ShmData ~ bmRef.shmData;
bmRef.shmData ¬ NIL;
IF bmRef.notify#NIL THEN bmRef.notify[widget, destroyWindow, bmRef.data];
XTkFriends.SimpleDestroyWindowLR[widget, reason];
Stop[bmRef];
IF sd#NIL THEN DelayedDestroyShmData[sd];
};

BMConfigureLR: ConfigureProc = {
bmRef: REF BMRec ~ GetInstData[widget];
existW, createW: BOOL;
reason: BitmapEventReason ¬ resize;
existW ¬ widget.actualMapping<unconfigured;
createW ¬ mapping<unconfigured AND ~existW;
IF createW THEN {
XTk.AddTemporaryMatch[widget, [EventHandler, eventFilter, widget.rootTQ, widget], [exposure: TRUE]];
};
XTkFriends.SimpleConfigureOneLevelLR[widget, geometry, mapping];
IF existW OR createW THEN {
IF createW THEN {
sd: Xl.ScreenDepth ¬ widget.screenDepth;
ownBM: XlBitmap.Bitmap ¬ bmRef.ownedBitmap;
bmRef.gc ¬ MakeGC[widget];
bmRef.mapped ¬ FALSE;
reason ¬ createWindow;
IF sd#NIL 
THEN {
bmRef.support8 ¬ XlColorAccess.FindVisualType[sd.screen, 8, Xl.VisualClass.pseudoColor]#NIL; 
bmRef.support4 ¬ XlColorAccess.FindVisualType[sd.screen, 4, Xl.VisualClass.pseudoColor]#NIL; 
bmRef.support2 ¬ XlColorAccess.FindVisualType[sd.screen, 2, Xl.VisualClass.pseudoColor]#NIL; 
IF ownBM#NIL AND (bmRef.support8 OR bmRef.support4  OR bmRef.support2) THEN FollowColorsOnce[widget, ownBM];
}
ELSE {
bmRef.support8 ¬ bmRef.support4 ¬ bmRef.support2 ¬ FALSE;
};
};
SetBM[bmRef, widget, FALSE, TRUE];
IF bmRef.notify#NIL THEN bmRef.notify[widget, reason, bmRef.data];
};
};

Set: PROC [bmRef: REF BMRec, h: XlBWFriends.WRef] = {
Swap: ENTRY PROC [bmRef: REF BMRec, new: XlBWFriends.WRef] RETURNS [old: XlBWFriends.WRef] = {
old ¬ bmRef.wAsUsed;
IF old=new THEN old ¬ NIL;
bmRef.wAsUsed ¬ new;
};
old: XlBWFriends.WRef ¬ Swap[bmRef, h];
IF old#NIL THEN XlBWFriends.StopWRef[old];
};

Stop: PROC [bmRef: REF BMRec] = {
Nillout: ENTRY PROC [bmRef: REF BMRec] RETURNS [old: XlBWFriends.WRef] = {
old ¬ bmRef.wAsUsed;
bmRef.wAsUsed ¬ NIL;
};
old: XlBWFriends.WRef ¬ Nillout[bmRef];
IF old#NIL THEN XlBWFriends.StopWRef[old];
};

BMPreStopFastAccess: TerminateProc = {
bmRef: REF BMRec ~ GetInstData[widget];
Stop[bmRef];
};

BMFullStopFastAccessLR: FullStopFastAccessProc = {
bmRef: REF BMRec ~ GetInstData[widget];
Stop[bmRef];
IF bmRef.notify#NIL THEN bmRef.notify[widget, destroyWindow, bmRef.data];
};

BMDestroyWidget: WidgetProc = {
bmRef: REF BMRec ~ GetInstData[widget];
Stop[bmRef];
};

NullNotify: BitmapEventProc = {};

InitInstPart: InitInstancePartProc = {
XTkFriends.AssignInstPart[widget, bmClass, NEW[BMRec ¬ [notify: NullNotify, wAsUsed: NIL]]];
XTk.SetWidgetFlag[widget, XTk.preferredSizeCurrent, TRUE];
};

DontNotify: BitmapEventProc = {};
SetCallbacks: PUBLIC PROC [bmw: BitmapWidget, notify: BitmapEventProc ¬ NIL, data: REF ¬ NIL] = {
bmRef: REF BMRec ~ GetInstData[bmw];
IF notify=NIL THEN notify ¬ DontNotify;
bmRef.notify ¬ notify;
bmRef.data ¬ data;
};

varyingFlag: XTk.WidgetFlagKey ~ wf6;

CreateBitmapWidget: PUBLIC PROC [widgetSpec: WidgetSpec, notify: BitmapEventProc, data: REF] RETURNS [widget: Widget] = {
widget ¬ XTk.CreateWidget[widgetSpec, bmClass];
XTk.SetWidgetFlag[widget, varyingFlag];
SetCallbacks[widget, notify, data];
};

SetBitmap: PUBLIC PROC [widget: BitmapWidget, bitmap: XlBitmap.Bitmap, restrict: SF.Box ¬ SF.maxBox, origin: Xl.Point ¬ [0, 0], immediateRefresh: BOOL ¬ TRUE, retainRefreshs: BOOL ¬ FALSE] = {
bmRef: REF BMRec ~ GetInstData[widget];
bmRef.bm ¬ bitmap;
bmRef.restrict ¬ SF.Intersect[restrict, XlBitmap.GetBox[bitmap]];
bmRef.origin ¬ origin;
IF widget.state=realized THEN
SetBM[bmRef, widget, immediateRefresh, retainRefreshs];
};

GetBitmap: PUBLIC PROC [widget: BitmapWidget] RETURNS [bitmap: XlBitmap.Bitmap, restrict: SF.Box, origin: Xl.Point] = {
bmRef: REF BMRec ~ GetInstData[widget];
bitmap ¬ bmRef.bm;
restrict ¬ bmRef.restrict;
origin ¬ bmRef.origin;
};

MakeGC: PROC [widget: XTk.Widget] RETURNS [Xl.GContext] = {
vendor: Rope.ROPE ¬ Xl.Info[widget.connection].vendor;
screen: Xl.Screen ~ widget.screenDepth.screen;
gc: Xl.GContext ~ Xl.MakeGContext[widget.connection, widget.window.drawable];
Xl.SetGCGraphicsExposures[gc, FALSE];
IF Rope.Equal[vendor, "Xerox Split MPAD"] THEN {
IF screen.blackPixel=0 THEN {
Xl.SetGCFunction[gc, copyInverted];
RETURN [gc]
};
};
Xl.SetGCFunction[gc, copy];
Xl.SetGCGrounds[gc: gc, foreground: screen.blackPixel, background: screen.whitePixel];
RETURN [gc]
};

SetBM: PROC [bmRef: REF BMRec, widget: BitmapWidget, immediateRefresh: BOOL, retainRefreshs: BOOL] = {
Range: PROC [x: INT] RETURNS [INTEGER] = {
RETURN[ MIN[ MAX[x, FIRST[INTEGER]], LAST[INTEGER] ] ]
};
vendor: Rope.ROPE;
bm: XlBitmap.Bitmap ¬ bmRef.bm;
IF bm=NIL OR widget.state#realized THEN Stop[bmRef] 
ELSE { 
sd: REF ShmData;
shmP: Xl.Pixmap ¬ Xl.nullPixmap;
rsm: ImagerSample.RasterSampleMap ¬ NARROW[XlBitmap.GetSM[bm]];
paintProc: PROC[b: SF.Box, ref: REF];
currentCase: Rope.ROPE ¬ NIL;
w: XlBWFriends.WRef;
origin: Xl.Point ¬ bmRef.origin;
clip: SF.Box ¬ [
min: [s: Range[-origin.y], f: Range[-origin.x]], 
max: [s: Range[widget.actual.size.height-origin.y], f: Range[widget.actual.size.width-origin.x]]
];
restrict: SF.Box ¬ SF.Intersect[bmRef.restrict, clip];
bpp: NAT ¬ ImagerSample.GetBitsPerSample[XlBitmap.GetSM[bm]];
SELECT bpp FROM
1 => NULL; --always works
8 => IF ~bmRef.support8 THEN RETURN; --it wouldn't work
4 => IF ~bmRef.support4 THEN RETURN; --it wouldn't work
2 => IF ~bmRef.support2 THEN RETURN; --it wouldn't work
ENDCASE => {
};
Stop[bmRef];
w ¬ NEW[XlBWFriends.WRec];
w.c ¬ widget.connection;
w.d ¬ widget.window;
w.bm ¬ bm;
w.base ¬ LOOPHOLE[ImagerSample.GetBase[rsm].word];
w.offset ¬ origin;
sd ¬ bmRef.shmData;
IF sd#NIL AND sd.c=w.c AND sd.bm=bm AND sd.shmPixmap#Xl.nullPixmap 
THEN shmP ¬ sd.shmPixmap --reuse it
ELSE {
IF XlShmPixmaps.ConnectionSupportsPixmaps[w.c] AND XlShmPixmaps.SampleMapSupportsThis[rsm] THEN {
shmP ¬ XlShmPixmaps.UnsafeCreatePixmap[c: w.c, drawable: w.d, sm: rsm ! 
Xl.XError => {
shmP ¬ Xl.nullPixmap;
CONTINUE
}
];
IF shmP=Xl.nullPixmap
THEN bmRef.shmData ¬ NIL
ELSE bmRef.shmData ¬ NEW[ShmData ¬ [shmPixmap: shmP, c: w.c, bm: bm]];
IF sd#NIL THEN DelayedDestroyShmData[sd];
};
};
w.clip ¬ SF.Intersect[clip, SF.Intersect[pseudoInfinitBox, XlBitmap.GetBox[bm]]];
w.scanLineBytes ¬ ImagerSample.GetBitsPerLine[rsm]/8;
w.gc ¬ bmRef.gc;
IF shmP=Xl.nullPixmap
THEN {
SELECT ImagerSample.GetBitsPerSample[rsm] FROM
 1 => {
IF widget.screenDepth.depth=4 
THEN {paintProc ¬ IBMBugActualPaint1; currentCase ¬ "ibm 6000 bug fix"} 
ELSE {paintProc ¬ ActualPaint1; currentCase ¬ "1 bpp, remote"};
w.overheadCost ¬ 48+40
};
 8 => {
paintProc ¬ ActualPaint8; w.overheadCost ¬ 6+10;
currentCase ¬ "8 bpp, remote";
};
 2 => {
paintProc ¬ ActualPaint2; w.overheadCost ¬ 24+20; 
currentCase ¬ "2 bpp, remote";
};
 4 => {
paintProc ¬ ActualPaint4; w.overheadCost ¬ 12+20; 
currentCase ¬ "4 bpp, remote";
};
24 => {
paintProc ¬ ActualPaint24; w.overheadCost ¬ 0+4;
currentCase ¬ "24 bpp, remote";
};
ENDCASE => {RETURN};
}
ELSE {
w.sharedD ¬ shmP;
IF ImagerSample.GetBitsPerSample[rsm]=1 
THEN {
paintProc ¬ ShmPaintCopyPlane; w.overheadCost ¬ 40000; 
currentCase ¬ "1 bpp, shm";
}
ELSE {
paintProc ¬ ShmPaintCopyArea; w.overheadCost ¬ 20000;
currentCase ¬ "multi bpp, shm";
}
};
vendor ¬ Xl.Info[w.c].vendor;
IF Rope.Equal[vendor, "Xerox Split MPAD"] THEN {
w.overheadCost ¬ 2;
w.serverQueueLimit ¬ 10;
paintProc ¬ MPadBugActualPaint1;
currentCase ¬ Rope.Concat[currentCase, " MPAD"];
};
WITH XTk.GetWidgetProp[widget, $OverheadCost] SELECT FROM
ri: REF INT => {
w.overheadCost ¬ ri­;
WITH XTk.GetWidgetProp[widget, $ServerQueueLimit] SELECT FROM
ri: REF INT => w.serverQueueLimit ¬ ri­;
ENDCASE => {};
};
ENDCASE => {};
w.report ¬ LIST[[paintProc, w]];
XTk.PutWidgetProp[widget, $XTkBitmapWidgetsImpl, currentCase];
bmRef.wInternal ¬ w;
IF bmRef.mapped THEN {
XlBWFriends.StartWRef[w];
Set[bmRef, w];
ClearOutsideAreas[widget];
IF immediateRefresh OR retainRefreshs THEN 
XlBWFriends.IncludeRect[w.s, w, clip, FALSE];
};
}
};

ClearOutsideAreas: PROC [w: XTk.Widget] = {
ENABLE ANY => GOTO Oops;
Clear: PROC [pos: Point, size: Size] = {
Xl.ClearArea[c, win, pos, size, FALSE, noErrors];
};
Fill: PROC [pos: Point, size: Size] = {
Xl.FillRectangle[c, win, bmRef.gc, pos, size, noErrors];
};
infinite: INT = 9999;
bmRef: REF BMRec ~ GetInstData[w];
c: Xl.Connection ¬ w.connection;
win: Xl.Window ¬ w.window;
r: SF.Box ¬ SF.Displace[bmRef.restrict, [bmRef.origin.y, bmRef.origin.x]];
IF win=Xl.nullWindow OR w.fastAccessAllowed#ok THEN RETURN;
IF r.min.f>0 THEN Clear[[0, 0], [r.min.f, infinite]];
IF r.min.s>0 THEN Clear[[r.min.f, 0], [infinite, r.min.s]];
Clear[[r.max.f, 0], [infinite, infinite]];
Clear[[0, r.max.s], [infinite, infinite]];
IF XTk.GetWidgetProp[w, $BitmapBorder]#NIL THEN {
<<left>>	Fill[[r.min.f-1, r.min.s-1], [1, r.max.s-r.min.s+2]];
<<right>>	Fill[[r.max.f, r.min.s-1], [1, r.max.s-r.min.s+2]];
<<top>>	Fill[[r.min.f-1, r.min.s-1], [r.max.f-r.min.f+2, 1]];
<<bottom>>	Fill[[r.min.f-1, r.max.s], [r.max.f-r.min.f+2, 1]];
};
EXITS Oops => {};
};

pseudoInfinitBox: SF.Box ~ [min: [-8000, -8000], max: [8000, 8000]]; --artificial clip region used to prevent arithmetic overflow

GetImplData: PUBLIC PROC [widget: BitmapWidget] RETURNS [REF] = {
bmRef: REF BMRec ~ GetInstData[widget];
RETURN [bmRef.wAsUsed];
}; 

Wait: PUBLIC PROC [widget: BitmapWidget, server: BOOL ¬ FALSE] = {
bmRef: REF BMRec ~ GetInstData[widget];
w: XlBWFriends.WRef ¬ bmRef.wAsUsed;
IF w#NIL 
THEN {
timedOut: BOOL ¬ XlBWFriends.WaitLocal[w.s, w].timedOut;
IF timedOut AND server THEN {
WHILE XlBWFriends.WaitLocal[w.s, w].timedOut DO ENDLOOP;
};
IF server AND Xl.Alive[w.c] THEN Xl.RoundTrip[w.c];
}
ELSE Process.Yield[];
};

noWhereBM: XlBitmap.Bitmap ~ XlBitmap.Create[[1, 1], 1, FALSE];

CreateContext: PUBLIC PROC [widget: BitmapWidget, surfaceUnitsPerPixel: NAT ¬ 1] RETURNS [context: Imager.Context] = {
bmRef: REF BMRec ~ GetInstData[widget];
bm: XlBitmap.Bitmap ¬ bmRef.bm;
IF bm=NIL THEN bm ¬ noWhereBM;
context ¬ XlBitmap.CreateContext[bm, surfaceUnitsPerPixel];
};

CreateAndSetBitmap: PUBLIC PROC [widget: BitmapWidget, size: SF.Vec, bpp: NAT ¬ 1, origin: Xl.Point ¬ [0, 0]] = {
bmRef: REF BMRec ~ GetInstData[widget];
bm: XlBitmap.Bitmap;
IF bpp=0 AND widget.screenDepth#NIL THEN {
IF XlColorAccess.FindVisualType[widget.screenDepth.screen, 8, Xl.VisualClass.pseudoColor]#NIL THEN bpp ¬ 8 
ELSE IF XlColorAccess.FindVisualType[widget.screenDepth.screen, 4, Xl.VisualClass.pseudoColor]#NIL THEN bpp ¬ 4
ELSE bpp ¬ 1;
};
IF bpp=0 THEN bpp ¬ 1;
bm ¬ XlBitmap.Create[size, bpp];
SetBitmap[widget: widget, bitmap: bm, origin: origin];
FollowColors[widget, bm];
};

FollowColors: PUBLIC PROC [widget: XTk.Widget, bitmap: XlBitmap.Bitmap] = {
bmRef: REF BMRec ~ GetInstData[widget];
bmRef.ownedBitmap ¬ bitmap;
FollowColorsOnce[widget, bitmap];
};

FollowColorsOnce: PUBLIC PROC [widget: XTk.Widget, bitmap: XlBitmap.Bitmap] = {
screenDepth: Xl.ScreenDepth ¬ widget.screenDepth;
IF bitmap#NIL AND screenDepth#NIL THEN {
sm: ImagerSample.RasterSampleMap ~ XlBitmap.GetSM[bitmap];
bbp: NAT ¬ ImagerSample.GetBitsPerSample[sm];
IF bbp>1 THEN {
cd: XlColorAccess.ColorData ¬ XlColorAccess.Access[screenDepth.screen, bbp, Xl.VisualClass.pseudoColor];
IF cd#NIL AND cd.hasColors THEN {
XlBitmap.SetColormap[bitmap, cd.entries];
IF cd.hasPrivateColormap AND widget.attributes.colorMap#cd.colormap AND widget.fastAccessAllowed=ok THEN {
attributes: Xl.Attributes ¬ [];
widget.attributes.colorMap ¬ attributes.colorMap ¬ cd.colormap;
XlBitmap.SetColormap[bitmap, cd.entries];
XTkShellWidgets.TrackColorMap[shell: NIL, w: widget];
Xl.ChangeWindowAttributes[widget.connection, widget.window, attributes, noErrors];
};
};
};
};
};

END.

FXTkBitmapWidgetsImpl.mesa
Copyright Σ 1988, 1989, 1990, 1991, 1992, 1993 by Xerox Corporation.  All rights reserved.
Christian Jacobi, October 21, 1988 1:13:59 pm PDT
Christian Jacobi, August 16, 1993 2:11 pm PDT
--window relative
--Prevent raising an error on negative dest.x. 
--However, some pixels will be missing
--Prevent raising an error on negative dest.x. 
--However, some pixels will be missing
--X protocol says left-pad must be 0 for zPixmap format
--Horrible case of unfriendly alignments
--Prevent raising an error on negative dest.x. 
--However, some pixels will be missing
--X protocol says left-pad must be 0 for zPixmap format
--Horrible case of unfriendly alignments
--Prevent raising an error on negative dest.x. 
--However, some pixels will be missing
--X protocol says left-pad must be 0 for zPixmap format
--Horrible case of unfriendly alignments
--Prevent raising an error on negative dest.x. 
--However, some pixels will be missing
--X protocol says left-pad must be 0 for zPixmap format
--Horrible case of unfriendly alignments
--Prevent raising an error on negative dest.x. 
--However, some pixels will be missing
--Because we do not stop the painters immediately
--Very short delay so bitmap will be finalized soon 
In bitmap format 1 delivers foreGround; compensate for zPixmap format 
--No test yet developped; 
--Take your chance that it works or crashes
--we wrongly believed shared memory would work
--overhead cost compensates for transferring request overhead (PutImage=6 words)
--it is scaled to compensate for cost function strictly assuming 8 bits per pixel
--is sligtly increased for a wild guess of per request overhead 
--overhead is wild guess on how much unification is justified
--This server uses slow radio communication in spite of possible presence of shared memory
--for experimenting to find out reasonable overheadCost
--remember: paints [0, 0] of bitmap at point "origin" in window
--clear left half space
--clear direct upper and upper right quarter space
--clear direct right and right lower quarter space
--clear direct under and right lower quarter space
Κ'–
(cedarcode) style•NewlineDelimiter

˜
code™Kšœ
Οe
œO™ZK™1K™-—K˜šΟk	œ
˜
K˜K˜Kšœž
˜
K˜Kšœž
˜Kšžœ
˜K˜K˜	K˜K˜K˜
K˜
K˜K˜K˜K˜Kš
œ˜K˜—šΟnœžœ
žœ
˜$Kšžœžœžœ˜"Kšžœžœžœžœe˜•
Kšžœ)˜0Kšžœ˜—Kšžœ
žœ˜%K˜š
œ4˜4Kš
œ!˜!Kš
œ˜Kš
œ$˜$Kš
œ(˜(Kš
œ.˜.Kš
œ ˜ Kš
œ˜Kšœžœžœ˜4Kš
œ˜Kš
œ˜—K˜šœžœž	œ
žœ˜ Kšœžœ
˜ Kšœžœ
˜"Kšœžœ
˜Kš
œ˜Kšœ
žœžœ˜K˜Kšœžœžœ
˜Kšœžœžœ
˜Kšœž˜#K™Kšœ
žœžœ
˜Kšœ
žœžœ
˜Kšœ
žœžœ
˜Kšœ	žœžœ
˜K˜K˜K˜—šœ	žœžœ˜K˜%Kšœžœ
˜Kšœž˜K˜—K˜K˜.KšŸœ˜šœžœ˜0Kšœžœ˜,K˜K˜—K˜šŸœžœžœžœ˜2Kšœžœ˜"Kšœžœ˜
Kšœ
žœžœ˜šžœžœ˜%Kš
œ/™/Kš
œ&™&K˜K˜—K˜K˜K˜—šŸœžœžœžœ˜1Kšœžœ˜"Kšœžœ˜
Kšœ
žœžœ˜šžœžœ˜%Kš
œ/™/Kš
œ&™&K˜K˜—K˜™K˜K˜—šŸœžœžœžœ˜+Kšœžœ˜"Kšœžœ˜
Kšœ
žœ˜K˜™K˜K˜—šŸœžœžœžœ˜+Kšœžœ˜"Kšœžœ˜
Kšœ	žœ
Οc*˜Cšœ
žœžœ
˜%K™7—šžœžœ˜%K™(Kš
œ/™/Kš
œ&™&K˜K˜—K˜™K˜K˜—šŸœžœžœžœ˜+Kšœžœ˜"Kšœžœ˜
Kšœ	žœ
 *˜Cšœ
žœžœ
˜%K™7—šžœžœ˜%K™(Kš
œ/™/Kš
œ&™&K˜K˜—K˜™K˜K˜—šŸœžœžœžœ˜+Kšœžœ˜"Kšœžœ˜
Kšœ	žœ
 *˜Cšœ
žœžœ
˜%K™7—šžœžœ˜%K™(Kš
œ/™/Kš
œ&™&K˜K˜—K˜™K˜K˜—šŸ
œžœžœžœ˜,Kšœžœ˜"Kšœžœ˜šœ
žœžœ˜K™7Kš
 *˜*—šžœžœ˜%K™(Kš
œ/™/Kš
œ&™&K˜K˜—K˜™K˜K˜—šŸœžœžœžœ˜0Kšœžœ˜"K˜Π
K˜K˜—šŸœžœžœžœ˜/Kšœžœ˜"K˜Β
K˜—K˜š
Ÿœžœ
žœžœ
žœ˜<Kšžœžœ#˜1Kš
œ˜—K˜K˜SK˜šŸœ˜"Kšœžœ
˜$Kšœžœ˜'šžœžœ
žœ˜šžœž˜˜Kšœžœ
˜Kšœžœžœ˜#K˜&K˜—˜Kšœžœ
˜K˜K˜(K˜—˜Kšœžœ˜"J˜J˜$Jšžœžœ
žœžœ
žœ
žœ
˜&˜K˜5K˜NK˜—K˜—Kšžœ˜—K˜—K˜K˜—šŸœžœžœ˜šžœžœ
ž˜šœžœ
˜K˜K˜Kšžœžœžœ#˜NK˜—Kšžœ˜
—K˜—K˜šŸœžœžœ
˜1K™1K™4Kšžœžœ
žœ*˜8K˜—K˜šŸœ˜$Kšœžœ˜'Kšœžœ˜ Kšœžœ
˜Kšžœžœ
žœ1˜IKš
œ1˜1K˜Kšžœžœ
žœ˜)K˜—K˜šŸ
œ˜ Kšœžœ˜'Kšœžœ
˜Kš
œ#˜#Kš
œ+˜+Kšœžœ	˜+šžœ	žœ˜Kšœ]žœ˜dK˜—K˜@šžœžœ	žœ˜šžœ	žœ˜K˜(K˜+K˜Kšœžœ
˜K˜šžœžœ
˜
šžœ˜KšœXžœ˜]KšœXžœ˜]KšœXžœ˜]Kšžœžœ
žœžœžœžœ!˜lK˜
—šžœ˜Kšœ3žœ
˜9K˜——K˜—Kšœžœžœ˜"Kšžœžœ
žœ*˜BK˜—K˜K˜—šŸœžœ	žœ ˜5š
Ÿœžœ
žœ	žœžœ˜^K˜Kšžœ	žœžœ
˜K˜K˜—K˜'Kšžœžœ
žœ˜*K˜K˜—šŸœžœ	žœ˜!š
Ÿœžœ
žœ	žœžœ˜JK˜Kšœžœ
˜K˜—K˜'Kšžœžœ
žœ˜*K˜K˜—šŸœ˜&Kšœžœ˜'K˜K˜K˜—šŸœ˜2Kšœžœ˜'K˜Kšžœžœ
žœ1˜IK˜K˜—šŸœ˜Kšœžœ˜'K˜K˜K˜—KšŸ
œ˜!K˜šŸœ˜&Kšœ+žœ.˜\Kšœ4žœ˜:K˜K˜—KšŸ
œ˜!šŸœžœ
žœ/žœžœžœ˜aKšœžœ˜$Kšžœžœ
žœ˜'Kš
œ˜Kš
œ˜Kš
œ˜K˜—K˜%K˜š
Ÿœžœ
žœ9žœžœ˜yKš
œ/˜/K˜'Kš
œ#˜#K˜K˜—šŸ	œžœ
žœ;žœžœ6žœžœžœžœ˜ΐ
Kšœžœ˜'K˜Kšœžœ.˜AK˜šžœž˜K˜7—K˜K˜—š
Ÿ	œžœ
žœžœ%žœ˜wKšœžœ˜'K˜K˜K˜K˜—K˜šŸœžœžœ˜;Kšœ
žœ%˜6K˜.K˜MKšœžœ˜%šžœ(žœ˜0šžœžœ˜K™FK˜#Kšžœ˜K˜—K˜—K˜K˜VKšžœ˜K˜—K˜š
Ÿœžœ	žœ0žœžœ˜fš
Ÿœžœžœžœžœ˜*Kšžœžœžœžœ
žœžœ
žœ˜6K˜—Kšœ
žœ
˜K˜Kšžœžœ
žœžœ
˜4šžœ˜Kšœžœ	˜K˜ Kšœ$žœ˜?Kšœžœžœžœ˜%Kšœžœžœ
˜K˜K˜ šœžœ˜K˜1K˜`K˜—Kšœ
žœžœ!˜6Kšœžœ5˜=šžœž˜Kšœžœ ˜Kšœžœžœ
žœ ˜7Kš	œ
œžœžœ
žœ ˜7Kš	œ
œžœžœ
žœ ˜7šžœ˜K™K™+K˜——K˜Kšœžœ˜K˜K˜K˜
Kšœ	žœ!˜2K˜K˜š
žœžœ
žœ
žœ
žœ˜CKšžœ 
˜#šžœ˜šžœ-žœ)žœ˜a˜H˜Kš
œ.™.J˜Kš
ž˜K˜
—K˜——šžœ˜Jšžœž˜Kšžœžœ.˜F—Jšžœžœ
žœ˜)K˜—K˜—Kšœ	žœžœ3˜QK˜5K˜šžœ˜šžœ˜K™PK™QK™@šžœ$ž˜.˜šžœ˜KšžœD˜HKšžœ;˜?—K˜K˜—˜K˜0K˜K˜—˜K˜2K˜K˜—˜K˜2K˜K˜—˜K˜0K˜K˜—Kšžœžœ˜—K˜
—šžœ˜K˜K™=šžœ&˜(šžœ˜K˜7K˜K˜
—šžœ˜K˜5K˜K˜
——K˜——J˜šžœ(žœ˜0K™ZK˜J˜J˜ J˜0J˜—K™7šžœ*žœ
ž˜9šœžœ
žœ˜K˜šžœ.žœ
ž˜=Kšœžœ
žœ˜(Kšžœ˜—K˜—Kšžœ˜—Kšœžœ˜ K˜>K˜šžœžœ˜K˜K˜K˜šžœžœžœ
˜+Kšœ&žœ˜-—K˜—K˜
—K˜K˜—šŸœžœ˜+Kšžœ
žœžœ˜šŸœžœ˜(Kšœ žœ˜1K˜—šŸœžœ˜'K˜8K˜—Kšœ
žœ˜Kšœžœ˜"K˜ K˜Kšœžœžœ<˜JKšžœžœžœ
žœ
˜;K™?K™Kšžœžœ$˜5K™2Kšžœžœ*˜;K™2K˜*K™2K˜*šžœ%žœ
žœ˜1K˜>K˜=K˜=K˜>K˜—Kšžœ˜K˜K˜—Kšœžœ1 <˜
K˜š
Ÿœžœ
žœžœžœ˜AKšœžœ˜'Kšžœ˜K˜—K˜š
Ÿœžœ
žœ žœžœ˜BKšœžœ˜'K˜$šžœžœ
˜	šžœ˜Kšœ
žœ*˜8šžœ
žœžœ˜Kšžœ(žœ
žœ
˜8K˜—Kšžœžœžœ˜3K˜
—Kšžœ˜—K˜K˜—Kšœ8žœ˜?K˜š
Ÿ
œžœ
žœ.žœžœ˜vKšœžœ˜'K˜Kšžœžœ
žœ˜K˜;K˜K˜—š
Ÿœžœ
žœžœžœ$˜qKšœžœ˜'K˜šžœžœžžœ˜*KšžœXžœ
žœ	˜kKšžœXžœ
žœœ
˜oKšžœ	˜
K˜—Kšžœžœ	˜K˜ K˜6K˜K˜K˜—šŸœžœ
žœ2˜KKšœžœ˜'K˜K˜!K˜K˜—šŸœžœ
žœ2˜OK˜1š
žœžœ
žœ
žœ
žœ˜(K˜:Kšœžœ%˜-šžœžœ˜K˜hšžœžœ
žœžœ˜!K˜)šžœžœ(žœžœ˜jKš
œ˜K˜?K˜)Kšœ%žœ
˜5K˜RK˜—K˜—K˜—K˜—K˜—K˜Kšžœ
˜K˜—…—I2dŸ