

DIRECTORY 
Imager,
ImagerSample,
IO,
SF,
Xl,
XlColorMapAccess,
XlBitmap,
XlBitmapWindow,
XTk,
XTkFriends,
XTkBitmapWidgets,
XTkShellWidgets;

XTkBitmapWidgetsImpl: CEDAR MONITOR 
LOCKS bmRef USING bmRef: REF BMRec
IMPORTS ImagerSample, SF, XlBitmapWindow, XlColorMapAccess, Xl, XlBitmap, XTk, XTkFriends, XTkShellWidgets
EXPORTS XTkBitmapWidgets =
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 [
handle: XlBitmapWindow.Handle ¬ NIL,
bm: XlBitmap.Bitmap ¬ NIL,
origin: Xl.Point ¬ [0, 0],
restrict: SF.Box ¬ SF.maxBox,
notify: BitmapEventProc, 
data: REF ¬ NIL,
ownedBitmap: XlBitmap.Bitmap ¬ NIL
];

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

mapEvents: Xl.EventFilter = Xl.CreateEventFilter[unmapNotify, mapNotify];
NotifyMapChange: Xl.EventProcType = {
widget: Widget = NARROW[clientData];
bmRef: REF BMRec ~ GetInstData[widget];
IF bmRef.notify#NIL THEN {
SELECT event.type FROM
mapNotify => bmRef.notify[widget, map, bmRef.data];
unmapNotify => bmRef.notify[widget, unmap, bmRef.data];
ENDCASE => {};
};
};

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

dummyBitmap: XlBitmap.Bitmap ¬ XlBitmap.Create[[s: 1, f: 32], 1, FALSE];  -- Used to uinstall other bitmaps

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, [NotifyMapChange, mapEvents, widget.rootTQ, widget], [exposure: TRUE]];
};
XTkFriends.SimpleConfigureOneLevelLR[widget, geometry, mapping];
IF existW OR createW THEN {
IF createW AND bmRef.ownedBitmap#NIL THEN InitColormap[widget, bmRef.ownedBitmap];
SetBM[bmRef, widget, FALSE, TRUE];
IF createW THEN {
XlBitmapWindow.SetWindow[handle: bmRef.handle, c: widget.connection, w: widget.window, immediateRefresh: FALSE];
reason ¬ createWindow;
};
IF bmRef.notify#NIL THEN bmRef.notify[widget, reason, bmRef.data];
};
};

BMPreStopFastAccess: TerminateProc = {
bmRef: REF BMRec ~ GetInstData[widget];
XlBitmapWindow.SetNoWindow[bmRef.handle];
};

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

BMDestroyWidget: WidgetProc = {
bmRef: REF BMRec ~ GetInstData[widget];
XlBitmapWindow.DestroyHandle[handle: bmRef.handle];
};

NullNotify: BitmapEventProc = {};

InitInstPart: InitInstancePartProc = {
XTkFriends.AssignInstPart[widget, bmClass, NEW[BMRec ¬ [notify: NullNotify, handle: XlBitmapWindow.CreateHandle[]]]];
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;
};

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] ] ]
};
bm: XlBitmap.Bitmap ¬ bmRef.bm;
IF bm#NIL THEN { 
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]];
IF bpp>1 THEN {
IF widget.screenDepth=NIL OR XlColorMapAccess.Find8BitPseudoColorVisualType[widget.screenDepth.screen]=NIL THEN {
XlBitmapWindow.SetBitmap[handle: bmRef.handle, bitmap: dummyBitmap, immediateRefresh: FALSE];
RETURN;	
};
};
XlBitmapWindow.SetBitmap[handle: bmRef.handle, bitmap: bmRef.bm, restrict: restrict, origin: origin, immediateRefresh: immediateRefresh, retainRefreshs: retainRefreshs];
};
};

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

Wait: PUBLIC PROC [widget: BitmapWidget, server: BOOL ¬ FALSE] = {
bmRef: REF BMRec ~ GetInstData[widget];
XlBitmapWindow.Wait[bmRef.handle, server];
};

CreateContext: PUBLIC PROC [widget: BitmapWidget, surfaceUnitsPerPixel: NAT ¬ 1] RETURNS [context: Imager.Context] = {
bmRef: REF BMRec ~ GetInstData[widget];
context ¬ XlBitmap.CreateContext[bmRef.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 THEN {
IF widget.screenDepth#NIL AND XlColorMapAccess.Find8BitPseudoColorVisualType[widget.screenDepth.screen]#NIL 
THEN bpp ¬ 8 
ELSE bpp ¬ 1;
};
bm ¬ XlBitmap.Create[size, bpp];
SetBitmap[widget: widget, bitmap: bm, origin: origin];
IF widget.screenDepth#NIL 
THEN InitColormap[widget, bm] 
ELSE bmRef.ownedBitmap ¬ bm
};

InitColormap: PROC [widget: XTk.Widget, bitmap: XlBitmap.Bitmap] = {
IF bitmap#NIL THEN {
cd: XlColorMapAccess.ColorData ¬ XlColorMapAccess.Access[widget.screenDepth.screen];
IF cd#NIL AND cd.hasColors THEN {
XlBitmap.SetColormap[bitmap, cd.entries];
IF cd.hasPrivateColormap AND widget.attributes.colorMap#cd.colormap 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];
};
};
};
};

END.

  2  XTkBitmapWidgetsImpl.mesa
Copyright س 1988, 1989, 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.
Christian Jacobi, October 21, 1988 1:13:59 pm PDT
Christian Jacobi, April 28, 1992 5:02 pm PDT
--make sure we never use an old bitmap with incopatible bits per pixel producing match errors
‌تہ  –(cedarcode) style•NewlineDelimiter
ک code™Kڑœ
دeœI™TK™1K™,—Kک ڑدk	œک
KکKڑœ‍کKڑ‍œکKڑ‍œکKکKکKک	KکKکKکKکKڑœکKک —ڑدnœ‍œ‍œک$Kڑ‍œ‍œ‍œک"Kڑ‍œ‍œRکjKڑ‍œک—Kڑ‍œ‍œک%Kک ڑœ4ک4Kڑœ!ک!KڑœکKڑœ$ک$Kڑœ(ک(Kڑœ.ک.Kڑœ ک KڑœکKڑœ‍œ‍œک4KڑœکKڑœک—Kک ڑœ‍œ‍	œ‍œک Kڑœ ‍œک$Kڑœ‍œکKڑœکKڑœ
‍œ‍œکKکKڑœ‍œ‍œکKڑœ‍ک"Kک—Kک ڑ
ںœ‍œ‍œ‍œ
‍œک<Kڑ‍œ‍œ#ک1Kڑœک—Kک KڑœIکIڑںœک%Kڑœ‍œک$Kڑœ‍œک'ڑ‍œ‍œ‍œکڑ‍œ‍کKڑœ3ک3Kڑœ7ک7Kڑ‍œک—Kک—KکKک —ڑںœک$Kڑœ‍œک'Kڑ‍œ‍œ‍œ1کIKڑœ1ک1Kڑœک—Kک KڑœA‍œدc!کkKک ڑںœک Kڑœ‍œک'Kڑœ‍œکKڑœ#ک#Kڑœ+ک+Kڑœ‍œ	ک+ڑ‍œ	‍œکKڑœ^‍œکeKک—Kک@ڑ‍œ‍œ	‍œکKڑ‍œ	‍œ‍œ‍œ)کRKڑœ‍œ‍œک"ڑ‍œ	‍œکKڑœi‍œکpKڑœکKڑœک—Kڑ‍œ‍œ‍œ*کBKک—KکKک —ڑںœک&Kڑœ‍œک'Kک)KکKک —ڑںœک2Kڑœ‍œک'Kک)Kڑœ"‍œک(Kڑ‍œ‍œ‍œ1کIKکKک —ڑںœکKڑœ‍œک'Kک3KکKک —Kڑں
œک!Kک ڑںœک&Kڑœ+‍œGکuKڑœ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ک ڑ
ںœ‍œ	‍œ0‍œ‍œکfڑ
ںœ‍œ‍œ‍œ‍œک*Kڑ‍œ‍œ‍œ‍œ‍œ‍œ‍œک6Kک—Kکڑ‍œ‍œ‍œکKڑœ ک ڑœ‍œکKک1Kک`Kک—Kڑœ
‍œ‍œ!ک6Kڑœ‍œ5ک=ڑ‍œ‍œکڑ
‍œ‍œ‍œK‍œ‍œکqKڑœ]™]KڑœV‍œک]Kڑ‍œکKک—Kک—Kک©Kک—KکKک —ڑ
ںœ‍œ‍œ‍œ‍œکAKڑœ‍œک'Kڑ‍œکKک—Kک ڑ
ںœ‍œ‍œ ‍œ‍œکBKڑœ‍œک'Kک*KکKک —ڑ
ںœ‍œ‍œ.‍œ‍œکvKڑœ‍œک'KکAKکKک —ڑ
ںœ‍œ‍œ‍œ‍œ$کqKڑœ‍œک'Kکڑ‍œ‍œکڑ‍œ‍œ‍œK‍œکlKڑ‍œ	کKڑ‍œ	ک—Kک—Kک Kک6ڑ‍œ‍œکKڑ‍œکKڑ‍œک—KکKک —ڑںœ‍œ2کDڑ‍œ‍œ‍œکKکTڑ‍œ‍œ‍œ‍œک!Kک)ڑ‍œ‍œ(‍œکJKڑœکKک?Kک)Kڑœ%‍œک5KڑœHکHKک—Kک—Kک—Kک—Kک Kڑ‍œکKک — …—      %   