
DIRECTORY
PreDebug, Process, RuntimeError, ViewersWorld, ViewersWorldClasses, X11Viewers, Xl, XlBitmap, XlColorAccess, XTk, XTkNotification;

X11ViewersColorImpl: CEDAR MONITOR
IMPORTS PreDebug, Process, RuntimeError, X11Viewers, Xl, XlBitmap, XlColorAccess, XTk, XTkNotification, ViewersWorld
SHARES X11Viewers = 
BEGIN OPEN X11Viewers;

detailsForSynchronous: Xl.Details ~ NEW[Xl.DetailsRec ¬ [synchronous: TRUE]];

MapEntryRec: TYPE = PACKED RECORD [
isAnimationIndex: BOOL ¬ FALSE, --the real truth whether we own an index; client callbacks are delayed so we can't trust clients.
r, g, b: BYTE ¬ 0, --so we can report the color back
revokeClosure: REF RevokeColorMapClosure ¬ NIL  
];

RevokeColorMapClosure: TYPE = RECORD [proc: ViewersWorld.RevokeColorMapIndexProc, data: REF, index: CARDINAL];

ColorMapData: TYPE = RECORD [
map: ARRAY [0..256) OF MapEntryRec
];

CheckBitsPerPixel: XTk.WidgetNotifyProc = {
data: ScreenServerData ~ NARROW[callData];
cd: XlColorAccess.ColorData ~ XlColorAccess.Access[data.top.screenDepth.screen, data.possibleBitsPerPixel, Xl.VisualClass.pseudoColor];
IF cd#NIL AND cd.hasColors THEN {
TRUSTED {XTk.PutWidgetProp[data.top, $ColorData, LOOPHOLE[cd --because readonly--]]};
X11Viewers.bitsPerPixelOk;
};
};

ColorMapCreate: XTk.WidgetNotifyProc = {
data: ScreenServerData ~ NARROW[callData];
WITH XTk.GetWidgetProp[data.top, $ColorData] SELECT FROM
cd: XlColorAccess.ColorData => IF cd.hasColors AND data.useBitmap THEN {
bitmap: XTk.Widget ~ data.bitmap;
bitmap.attributes.colorMap ¬ cd.colormap;
data.top.attributes.colorMap ¬ cd.colormap;
};
ENDCASE => {};
};

RegisterRevokeColorMapEntries: XTk.WidgetNotifyProc = {
data: ScreenServerData ~ NARROW[callData];
XTk.RegisterNotifier[data.top, XTk.preStopFastAccessKey, RevokeColorMapEntries, data];
};

ColorMapInstall: XTk.WidgetNotifyProc = {
data: ScreenServerData ~ NARROW[callData];
bm: XlBitmap.Bitmap ¬ data.bm;
WITH XTk.GetWidgetProp[data.top, $ColorData] SELECT FROM
cd: XlColorAccess.ColorData => IF cd.hasColors AND data.useBitmap AND bm#NIL THEN {
XlBitmap.SetColormap[data.bm, cd.entries];
};
ENDCASE => {};
};

RevokeColorMapEntries: XTk.WidgetNotifyProc = {
WITH registerData SELECT FROM
data: ScreenServerData => {
XTk.PutWidgetProp[data.top, $ColorData, NIL];
WITH data.reservedForColorIndices SELECT FROM
cm: REF ColorMapData => {
closures: LIST OF RevokeColorMapClosure ¬ ClearAllAnimationIndices[cm];
TRUSTED {Process.Detach[FORK CallClientColorMapRevoke[data, closures] ]}
};
ENDCASE => {};
};
ENDCASE => {};
};
CallClientColorMapRevoke: PROC [data: ScreenServerData, closures: LIST OF RevokeColorMapClosure] = {
FOR l: LIST OF RevokeColorMapClosure ¬ closures, l.rest WHILE l#NIL DO
l.first.proc[data.viewersWorld, l.first.index, l.first.data];
ENDLOOP
};

SetAnimationIndex: ENTRY PROC [cm: REF ColorMapData, idx: [0..256), revokeClosure: REF RevokeColorMapClosure] RETURNS [fail: BOOL¬FALSE] = {
IF cm=NIL OR cm.map[idx].isAnimationIndex THEN RETURN [fail¬TRUE];
cm.map[idx].isAnimationIndex ¬ TRUE;
cm.map[idx].revokeClosure ¬ revokeClosure;
};

ClearAnimationIndex: ENTRY PROC [cm: REF ColorMapData, idx: [0..256)] RETURNS [was: BOOL ¬ FALSE, revoke: REF RevokeColorMapClosure ¬ NIL] = {
IF cm#NIL THEN {
was ¬ cm.map[idx].isAnimationIndex;
revoke ¬ cm.map[idx].revokeClosure;
cm.map[idx].revokeClosure ¬ NIL;
cm.map[idx].isAnimationIndex ¬ FALSE;
};
};

ClearAllAnimationIndices: ENTRY PROC [cm: REF ColorMapData] RETURNS [closures: LIST OF RevokeColorMapClosure ¬ NIL] = {
IF cm#NIL THEN {
FOR i: [0..256) IN [0..256) DO
closure: REF RevokeColorMapClosure ~ cm.map[i].revokeClosure;
cm.map[i].revokeClosure ¬ NIL;
cm.map[i].isAnimationIndex ¬ FALSE;
IF closure#NIL THEN closures ¬ CONS[closure­, closures];
ENDLOOP;
};
};

GetColorMapData: ENTRY PROC [data: ScreenServerData] RETURNS [REF ColorMapData] = {
IF data=NIL THEN RETURN [NEW[ColorMapData]]; --never occurs, but never wedge monitor
WITH data.reservedForColorIndices SELECT FROM
cm: REF ColorMapData => RETURN [cm];
ENDCASE => {
cm: REF ColorMapData ~ NEW[ColorMapData];
data.reservedForColorIndices ¬ cm;
RETURN [cm];
};
};

AllocateColorMapIndex: PROC [screenServerData: REF, display: REF, revokeIndex: ViewersWorld.RevokeColorMapIndexProc, clientData: REF ¬ NIL] RETURNS [index: CARDINAL] = {
data: ScreenServerData ~ NARROW[screenServerData]; 
cm: REF ColorMapData ~ GetColorMapData[data];
bitmap: XTk.Widget ~ data.bitmap;
pixels: REF Xl.Card32Sequence;
revokeClosure: REF RevokeColorMapClosure ¬ NIL;
IF bitmap=NIL THEN 
ERROR ViewersWorld.outOfColormapEntries; 
IF data.actualBitsPerPixel#8 AND data.actualBitsPerPixel#4 THEN 
ERROR ViewersWorld.outOfColormapEntries; 
pixels ¬ Xl.AllocColorCells[c: bitmap.connection, colorMap: bitmap.attributes.colorMap, colors: 1, planes: 0, contiguos: FALSE ! Xl.XError => GOTO Oops].pixels;   
IF pixels=NIL OR pixels.leng#1 OR pixels[0]>256 THEN ERROR ViewersWorld.outOfColormapEntries;
index ¬ pixels[0];
IF revokeIndex#NIL THEN 
revokeClosure ¬ NEW[RevokeColorMapClosure ¬ [revokeIndex, clientData, index]];
IF SetAnimationIndex[cm, index, revokeClosure].fail THEN ERROR ViewersWorld.outOfColormapEntries;
EXITS Oops => ERROR ViewersWorld.outOfColormapEntries;
};

FreeColorMapIndex: ViewersWorldClasses.FreeColorMapIndexProc = {
ENABLE RuntimeError.UNCAUGHT, Xl.XError => {IF ~X11Viewers.debugging THEN GOTO oops};
IF index>255 THEN RETURN;
WITH screenServerData SELECT FROM
data: ScreenServerData => {
bitmap: XTk.Widget ~ data.bitmap;
cm: REF ColorMapData ~ GetColorMapData[data];
IF bitmap#NIL THEN {
was: BOOL; revoke: REF RevokeColorMapClosure;
[was, revoke] ¬ ClearAnimationIndex[cm, index];
IF was THEN { 
Xl.FreeColors[c: bitmap.connection, colorMap: bitmap.attributes.colorMap, pixels: LIST[index], planeMask: 0, details: detailsForSynchronous];
};
};
};
ENDCASE => {};
EXITS oops => {}
};

SetColorMapEntry: ViewersWorldClasses.SetColorMapEntryProc = {
ENABLE RuntimeError.UNCAUGHT, Xl.XError => {IF ~X11Viewers.debugging THEN GOTO oops};
IF index>255 THEN RETURN;
WITH screenServerData SELECT FROM
data: ScreenServerData => {
cm: REF ColorMapData ~ GetColorMapData[data];
bitmap: XTk.Widget ~ data.bitmap;
IF ~cm.map[index].isAnimationIndex THEN RETURN;
cm.map[index].r ¬ red ¬ MIN[red, 255];
cm.map[index].g ¬ green ¬ MIN[green, 255];
cm.map[index].b ¬ blue ¬ MIN[blue, 255];
IF bitmap=NIL OR bitmap.fastAccessAllowed#ok THEN RETURN;
Xl.StoreColors[c: bitmap.connection, colorMap: bitmap.attributes.colorMap, 
items: LIST[[pixel: index, 
rgb: [red: red*257, green: green*257, blue: blue*257]
]],
details: detailsForSynchronous
];
};
ENDCASE => {};
EXITS oops => {}
};

GetColorMapEntry: ViewersWorldClasses.GetColorMapEntryProc = {
red ¬ green ¬ blue ¬ 0;
IF index>255 THEN RETURN;
WITH screenServerData SELECT FROM
data: ScreenServerData => {
WITH data.reservedForColorIndices SELECT FROM
cm: REF ColorMapData => {
red ¬ cm.map[index].r;
green ¬ cm.map[index].g;
blue ¬ cm.map[index].b;
};
ENDCASE => {};
};
ENDCASE => {};
};
X11Viewers.baseClass.allocateColorMapIndex ¬ AllocateColorMapIndex;
X11Viewers.baseClass.freeColorMapIndex ¬ FreeColorMapIndex;
X11Viewers.baseClass.setColorMapEntry ¬ SetColorMapEntry;
X11Viewers.baseClass.getColorMapEntry ¬ GetColorMapEntry;
XTkNotification.RegisterGlobal[X11Viewers.beforeWindowCreation, ColorMapCreate];
XTkNotification.RegisterGlobal[X11Viewers.afterWidgetCreation, RegisterRevokeColorMapEntries];
XTkNotification.RegisterGlobal[X11Viewers.bitmapReplaced, ColorMapInstall];
XTkNotification.RegisterGlobal[X11Viewers.checkBitsPerPixel, CheckBitsPerPixel];
PreDebug.RegisterErrorExplainer[ViewersWorld.outOfColormapEntries, NIL, "Can't allocate a color map index"];
END.

  ‍  X11ViewersColorImpl.mesa
Copyright س 1988, 1989, 1991, 1992, 1993 by Xerox Corporation.  All rights reserved.
Created by Christian Jacobi, August 9, 1990 4:18 pm PDT
Christian Jacobi, August 20, 1993 1:40 pm PDT
Willie-s, November 14, 1991 12:32 pm PST
Michael Plass, February 25, 1992 4:09 pm PST

Implements color displays for X11Viewers

Initialization order matters: 
must be started after X11ViewersImpl
must be started after X11ViewerProcsImpl

Revoke color map indices, so client won't use them any more.
Don't free color map indices because connection will/has crash anyway.
--fork: we don't want to crash or hang with a silly client
--no with select or luxury: never return a bad index
<<don't crash if bad index is used; It might just have been invalidated but the invalidation has not yet come through all the way...>>
--Returns correct color if it was defined using SetColorMapEntry; bogus color otherwise.

‌ت{  –(cedarcode) style•NewlineDelimiter
ک ™Icodeڑœ	دeœH™TK™7K™-K™(K™,K™ K™(K™ ڑدb™Kڑ‍$™$Kڑ‍(™(—K™ —ڑدk	ک	Kک‚—Kک ڑدnœںœںک"KڑںœmکtKڑںœک—KڑںœںœکKک Kڑœ$ںœںœکMKک ڑœںœںœںœک#KڑœںœںœدcaکپKڑœ	ںœ،!ک4Kڑœںœںœ،ک0KکKک —Kڑ	œںœںœ4ںœ	ںœکnKک ڑœںœںœکKڑœںœ
ںœک"Kک—Kک ڑ œک+Kڑœںœک*Kک‡ڑںœںœںœںœک!Kڑںœ*ںœ،œکUKکKک—Kک—Kک ڑ œک(Kڑœںœک*ڑںœ)ںœںک8ڑœںœںœںœکHKک!Kڑœ)ک)Kڑœ+ک+Kک—Kڑںœک—KکKک —ڑ œک7Kڑœںœک*KڑœVکVKکKک —ڑ œک)Kڑœںœک*Kکڑںœ)ںœںک8ڑœںœںœںœںœںœکSKک*Kک—Kڑںœک—Kک—Kک ڑ œک/K™<K™FڑںœںœںککKڑœ(ںœک-ڑںœںœںک-ڑœںœکKڑœ
ںœںœ6کGJ™:Kڑںœںœ,کHKک—Kڑںœک—Kک—Kڑںœک—Kکڑ œںœ$ںœںœکdڑںœںœںœ*ںœںœںکFKک=Kڑںک—Kک—Kک —ڑ œںœںœںœ-ںœںœںœںœکŒKڑںœںœںœںœںœںœکBKڑœںœک$Kک*Kک—ڑ œںœںœںœںœںœںœ
ںœںœکژڑںœںœںœکKک#Kک#Kڑœںœک Kڑœںœک%Kک—KکKک —ڑ œںœںœںœںœںœںœںœکwڑںœںœںœکڑںœںœ
ںکKڑœ	ںœ1ک=KڑœںœکKڑœںœک#Kڑںœ	ںœںœںœک8Kڑںœک—Kک—Kک—Kک ڑ
 œںœںœںœںœکSKڑںœںœںœںœںœ،'کTڑںœںœںک-Kڑœںœںœک$ڑںœکKڑœںœںœک)Kڑœ"ک"KڑںœکKڑœک——Kک—Kک ڑ œںœںœںœAںœںœںœ	ںœک©K™4Kڑœںœک3Kڑœںœ&ک-Kڑœ!ک!KڑœںœکKڑœںœںœک/ڑںœںœںœکKڑںœ$ک)—ڑںœںœںœک@Kڑںœ$ک)—Kڑœyںœںœک£Kڑںœںœںœںœںœںœ#ک]KکڑںœںœںœکKڑœںœ;کN—Kڑںœ2ںœںœ#کaKڑںœ	ںœ#ک6KکKک —ڑ œ/ک@Kڑ
ںœںœںœںœںœکUKڑںœںœںœکڑںœںœںک!کKک!Kڑœںœ&ک-ڑںœںœںœکKڑœںœ
ںœک-Kک/ڑںœںœکKڑœRںœ7کچKک—Kک—Kک—Kڑںœک—KڑںœکKکKک —ڑ œ.ک>Kڑ
ںœںœںœںœںœکUKڑںœںœںœکڑںœںœںک!K™†کKڑœںœ&ک-Kڑœ!ک!Kڑںœ!ںœںœک/Kڑœںœک&Kڑœںœک*Kڑœںœک(Kڑ
ںœںœںœںœںœک9ڑœKکKڑœںœکKڑœ5ک5Kک—KکKک—Kک—Kڑںœک—KڑںœکKکKک —ڑ œ.ک>K™XKکKڑںœںœںœکڑںœںœںک!کڑںœںœںک-ڑœںœکKکKکKکKک—Kڑںœک—Kک—Kڑںœک—Kک—K™ KکCKک;Kک9Kک9KڑœPکPKڑœ^ک^KڑœKکKKڑœPکPKڑœCںœ&کlKڑںœکKک — …—    ى  *  