XTkBitmapWidgetsImpl.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
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,
--window relative
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 {
--Prevent raising an error on negative dest.x.
--However, some pixels will be missing
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 {
--Prevent raising an error on negative dest.x.
--However, some pixels will be missing
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;
--X protocol says left-pad must be 0 for zPixmap format
IF w.offset.x+b.min.f<dirtyFix
THEN {
--Horrible case of unfriendly alignments
--Prevent raising an error on negative dest.x.
--However, some pixels will be missing
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;
--X protocol says left-pad must be 0 for zPixmap format
IF w.offset.x+b.min.f<dirtyFix
THEN {
--Horrible case of unfriendly alignments
--Prevent raising an error on negative dest.x.
--However, some pixels will be missing
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;
--X protocol says left-pad must be 0 for zPixmap format
IF w.offset.x+b.min.f<dirtyFix
THEN {
--Horrible case of unfriendly alignments
--Prevent raising an error on negative dest.x.
--However, some pixels will be missing
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;
--X protocol says left-pad must be 0 for zPixmap format
--Oops, this line knows unit size is 32...
IF w.offset.x+b.min.f<dirtyFix
THEN {
--Horrible case of unfriendly alignments
--Prevent raising an error on negative dest.x.
--However, some pixels will be missing
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] = {
--Because we do not stop the painters immediately
--Very short delay so bitmap will be finalized soon
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 {
In bitmap format 1 delivers foreGround; compensate for zPixmap format
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 => {
--No test yet developped;
--Take your chance that it works or crashes
};
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 => {
--we wrongly believed shared memory would work
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 {
--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
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;
--overhead is wild guess on how much unification is justified
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 {
--This server uses slow radio communication in spite of possible presence of shared memory
w.overheadCost ¬ 2;
w.serverQueueLimit ¬ 10;
paintProc ¬ MPadBugActualPaint1;
currentCase ¬ Rope.Concat[currentCase, " MPAD"];
};
--for experimenting to find out reasonable overheadCost
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;
--remember: paints [0, 0] of bitmap at point "origin" in window
--clear left half space
IF r.min.f>0 THEN Clear[[0, 0], [r.min.f, infinite]];
--clear direct upper and upper right quarter space
IF r.min.s>0 THEN Clear[[r.min.f, 0], [infinite, r.min.s]];
--clear direct right and right lower quarter space
Clear[[r.max.f, 0], [infinite, infinite]];
--clear direct under and right lower quarter space
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.