XlColorAccessImpl.mesa
Copyright Ó 1990, 1991, 1993 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, December 5, 1990 11:38:48 am PST
Christian Jacobi, October 25, 1993 12:08 pm PDT
DIRECTORY
ImagerDither, Process, Real, RealFns, Xl, XlColorAccess, XlRGBColorMaps, XlPredefinedAtoms;
XlColorAccessImpl: CEDAR MONITOR
IMPORTS Process, Real, RealFns, Xl, XlRGBColorMaps
EXPORTS XlColorAccess =
BEGIN OPEN XlColorAccess;
myKey: REF = NEW[INT]; --property key used on screen
FindVisualType: PUBLIC PROC [screen: Xl.Screen, depth: BYTE, class: Xl.VisualClass] RETURNS [Xl.VisualType ¬ NIL] = {
FOR dl: Xl.ScreenDepthL ¬ screen.screenDepthL, dl.rest WHILE dl#NIL DO
IF dl.first.depth=depth THEN {
FOR vtl: LIST OF READONLY Xl.VisualType ¬ dl.first.visuals, vtl.rest WHILE vtl#NIL DO
IF vtl.first.class=class THEN RETURN [vtl.first];
ENDLOOP;
RETURN;
};
ENDLOOP;
};
RealColorValToXColorVal: PUBLIC PROC [r: REAL, invGamma: REAL ¬ 0.4545454] RETURNS [v: Xl.RGBVal] = {
GCorrect: PROC [r: REAL, invGamma: REAL] RETURNS [REAL] = INLINE {
RETURN [RealFns.Power[r, invGamma]];
};
s: INT ~ Real.Round[GCorrect[r, invGamma]*65535.0];
SELECT s FROM
<= 0 => v ¬ 0;
>= 65535 => v ¬ 65535;
ENDCASE => v ¬ s;
};
DeGCorrect: PROC [r: REAL, gamma: REAL ¬ 2.2] RETURNS [REAL] = INLINE {
RETURN [RealFns.Power[r, gamma]];
};
Idx2Byte: PUBLIC PROC [val, max: CARD, gamma: REAL ¬ 2.2] RETURNS [BYTE] = {
float: REAL ¬ val;
float ¬ float / max;
float ¬ DeGCorrect[float, gamma];
RETURN [ToByte[float]];
};
detailsForSynchronous: Xl.Details ¬ NEW[Xl.DetailsRec ¬ [synchronous: TRUE]];
ToByte: PROC [r: REAL] RETURNS [BYTE] = {
s: INT = Real.Round[r*255];
SELECT s FROM
<= 0 => RETURN [0];
>= 255 => RETURN [255];
ENDCASE;
RETURN [s];
};
RampColors: PROC [eachColor: PROC [r, g, b: REAL], reds: NAT ¬ 5, greens: NAT ¬ 6, blues: NAT ¬ 4] = {
has black and white excluded
limit: NAT ¬ reds*greens*blues-1;
ColorAndInverted: PROC [r, g, b: REAL] ~ INLINE {
eachColor[r, g, b];
eachColor[1.0-r, 1.0-g, 1.0-b];
};
--Regular colors
FOR b: NAT IN [0..blues) DO
FOR g: NAT IN [0..greens) DO
FOR r: NAT IN [0..reds) DO
a: NAT ~ (r*greens+g)*blues+b;
IF a<limit AND a>0 THEN --exclude black and white
eachColor[r/(reds-1.0), g/(greens-1.0), b/(blues-1.0)];
ENDLOOP;
ENDLOOP;
ENDLOOP;
--Special colors
ColorAndInverted[0.25, 0.25, 0.25]; -- quarter-grey
eachColor[0.5, 0.5, 0.5];  -- half-grey
ColorAndInverted[0.1, 0.3, 0.85];  -- Distinct/Blue
};
TryWithStandardColorMap: PROC [screen: Xl.Screen, vt: Xl.VisualType, blackPixel, whitePixel: Xl.Pixel, gamma: REAL ¬ 2.2, invGamma: REAL ¬ 0.4545454] RETURNS [entries: ImagerDither.MapEntries ¬ NIL]= {
Tries whether a "standard" color map is defined. If so uses it.
Might add a few entries to the color map
SearchMaps: PROC [maps: LIST OF XlRGBColorMaps.StandardColorMap, vt: Xl.VisualType, mustMatch: Xl.ColorMap ¬ Xl.nullColorMap] RETURNS [XlRGBColorMaps.StandardColorMap ¬ NIL] = {
FOR list: LIST OF XlRGBColorMaps.StandardColorMap ¬ maps, list.rest WHILE list#NIL DO
IF list.first.visualId=vt.visual THEN {
IF mustMatch=Xl.nullColorMap OR mustMatch=list.first.colormap THEN
RETURN [list.first]
};
ENDLOOP
};
TryMap: PROC [mapKey: Xl.XAtom] RETURNS [map: XlRGBColorMaps.StandardColorMap ¬ NIL] = {
maps: LIST OF XlRGBColorMaps.StandardColorMap ¬ XlRGBColorMaps.GetRGBColorMaps[c: screen.connection, w: screen.root, mapKey: mapKey];
map ¬ SearchMaps[maps, vt, screen.defaultColorMap]; <<might improve this by using other color maps. Currently this is too hard because of the black and white pixel problem>>
};
colorMapSize: CARD ¬ MIN[vt.colorMapEntries, 256];
map: XlRGBColorMaps.StandardColorMap ¬ NIL;
map ¬ TryMap[XlPredefinedAtoms.rgbDefaultMap];
IF map=NIL THEN map ¬ TryMap[XlPredefinedAtoms.rgbBestMap];
IF map#NIL THEN {
addingFailed: BOOL ¬ FALSE;
TryAdding: PROC [r, g, b: REAL] = {
Tries to add a particular color to the color map; noop if failes
IF ~addingFailed THEN {
rgb: Xl.RGBRec; pixel: CARD32;
rgb.red ¬ RealColorValToXColorVal[r, invGamma];
rgb.green ¬ RealColorValToXColorVal[g, invGamma];
rgb.blue ¬ RealColorValToXColorVal[b, invGamma];
pixel ¬ Xl.AllocColor[c: screen.connection, colorMap: map.colormap, color: rgb ! Xl.XError => GOTO Oops].pixel;
IF pixel<colorMapSize THEN {
FOR l: ImagerDither.MapEntries ¬ entries, l.rest WHILE l#NIL DO
IF l.first.mapIndex=pixel THEN RETURN; --Pixel was already in the map
ENDLOOP;
entries ¬ CONS[[pixel, ToByte[r], ToByte[g], ToByte[b]], entries];
};
};
EXITS Oops => {addingFailed ¬ TRUE}
};
FOR b: NAT IN [0..map.blueMax] DO
FOR g: NAT IN [0..map.greenMax] DO
FOR r: NAT IN [0..map.redMax] DO
pixel: CARD ¬ (r*map.redMult + g*map.greenMult + b*map.blueMult + map.basePixel) MOD 256;
IF pixel<colorMapSize THEN {
red: BYTE ¬ Idx2Byte[r, map.redMax, gamma];
green: BYTE ¬ Idx2Byte[g, map.greenMax, gamma];
blue: BYTE ¬ Idx2Byte[b, map.blueMax, gamma];
entries ¬ CONS[[pixel, red, green, blue], entries];
};
ENDLOOP;
ENDLOOP;
ENDLOOP;
entries ¬ CONS[[blackPixel, 0, 0, 0], entries];
entries ¬ CONS[[whitePixel, 255, 255, 255], entries];
TryAdding[0.7, 0.7, 1.0]; -- This light blue should be usefull for viewer captions...
TryAdding[0.1, 0.3, 0.85]; -- Distinct/Blue...
TryAdding[0.25, 0.25, 0.25]; --Gray
TryAdding[0.5, 0.5, 0.5]; --Gray
TryAdding[0.75, 0.75, 0.75]; --Gray
};
};
AllocateForDefaultColormap: PROC [c: Xl.Connection, colorMap: Xl.ColorMap, blackPixel, whitePixel: Xl.Pixel, invGamma: REAL, reds: NAT ¬ 5, greens: NAT ¬ 6, blues: NAT ¬ 4] RETURNS [ImagerDither.MapEntries] = {
Tries to allocate colors into default color map; retrurns entries, or NIL if failed
entries: ImagerDither.MapEntries ¬ NIL;
BEGIN
ENABLE Xl.XError => {
--Free the colors again; there was no space. Make sure no entries are returned
pixelsToFree: LIST OF CARD32 ¬ NIL;
WHILE entries#NIL DO
IF entries.first.mapIndex#blackPixel AND entries.first.mapIndex#whitePixel THEN
pixelsToFree ¬ CONS[entries.first.mapIndex, pixelsToFree];
entries ¬ entries.rest
ENDLOOP;
Xl.FreeColors[c, colorMap, pixelsToFree, 0, detailsForSynchronous ! Xl.XError => CONTINUE];
Xl.UngrabServer[c ! Xl.XError => CONTINUE];
GOTO oops;
};
EachColor: PROC [r, g, b: REAL] ~ {
rgb: Xl.RGBRec; pixel: CARD32;
rgb.red ¬ RealColorValToXColorVal[r, invGamma];
rgb.green ¬ RealColorValToXColorVal[g, invGamma];
rgb.blue ¬ RealColorValToXColorVal[b, invGamma];
pixel ¬ Xl.AllocColor[c: c, colorMap: colorMap, color: rgb].pixel; --may raise Xl.XError which is caught
IF pixel<=255 THEN entries ¬ CONS[[pixel, ToByte[r], ToByte[g], ToByte[b]], entries];
};
Xl.GrabServer[c];
RampColors[EachColor, reds, greens, blues];
Xl.UngrabServer[c];
entries ¬ CONS[[blackPixel, 0, 0, 0], entries];
entries ¬ CONS[[whitePixel, 255, 255, 255], entries];
END;
RETURN [entries];
EXITS oops => RETURN [NIL];
};
AllocateForNewColormap: PROC [c: Xl.Connection, colorMap: Xl.ColorMap, blackPixel, whitePixel: Xl.Pixel, invGamma: REAL, reds: NAT ¬ 5, greens: NAT ¬ 6, blues: NAT ¬ 4, pixelCount: CARD32 ¬ 256] RETURNS [ImagerDither.MapEntries] = {
entries: ImagerDither.MapEntries ¬ NIL;
storeColorItems: LIST OF Xl.ColorItem ¬ NIL;
nextFreePixel: NAT ¬ 0; --private to NextPixel
NextPixel: PROC [] RETURNS [this: NAT] = {
--returns next pixel, but leaves blackPixel and whitePixel alone
this ¬ nextFreePixel;
WHILE (this=blackPixel OR this=whitePixel) DO this ¬ this+1 ENDLOOP;
nextFreePixel ¬ this+1;
};
EachColor: PROC [r, g, b: REAL] ~ {
rgb: Xl.RGBRec;
pixel: CARD32 ¬ NextPixel[];
IF pixel<pixelCount THEN {
rgb.red ¬ RealColorValToXColorVal[r, invGamma];
rgb.green ¬ RealColorValToXColorVal[g, invGamma];
rgb.blue ¬ RealColorValToXColorVal[b, invGamma];
storeColorItems ¬ CONS[[pixel: pixel, doRed: TRUE, doGreen: TRUE, doBlue: TRUE, rgb: rgb], storeColorItems];
entries ¬ CONS[[pixel, ToByte[r], ToByte[g], ToByte[b]], entries];
};
};
RampColors[EachColor, reds, greens, blues];
BEGIN
--For black and white reuse same pixel values as in the default color map to hide fact of exchanging color maps
w: Xl.ColorItem ¬ [pixel: whitePixel, doRed: TRUE, doGreen: TRUE, doBlue: TRUE, rgb: [65535, 65535, 65535]];
b: Xl.ColorItem ¬ [pixel: blackPixel, doRed: TRUE, doGreen: TRUE, doBlue: TRUE, rgb: [0, 0, 0]];
storeColorItems ¬ CONS[w, storeColorItems];
storeColorItems ¬ CONS[b, storeColorItems];
END;
entries ¬ CONS[[blackPixel, 0, 0, 0], entries];
entries ¬ CONS[[whitePixel, 255, 255, 255], entries];
Xl.StoreColors[c: c, colorMap: colorMap, items: storeColorItems];
RETURN [entries]
};
FindBlackAndWhite: PROC [screen: Xl.Screen, vt: Xl.VisualType] RETURNS [blackPixel, whitePixel: Xl.Pixel] = {
Finds and allocates suitable pixel for blackPixel, whitePixel; suitable means ImagerBackdoor.invert is implemented correctly.
Opponent: PROC [p1: Xl.Pixel] RETURNS [BYTE] = INLINE {
RETURN [colorMapSize-p1-1];
};
HasOpponent: PROC [p1: Xl.Pixel] RETURNS [BOOL] = INLINE {
RETURN [used[Opponent[p1]]]
};
colorMapSize: CARD ¬ MIN[vt.colorMapEntries, 256];
colormap: Xl.ColorMap ¬ screen.defaultColorMap;
c: Xl.Connection ¬ screen.connection;
used: PACKED ARRAY [0..255] OF BOOL ¬ ALL[FALSE];
lastAlloc: CARD32 ¬ LAST[CARD32];
found: BOOL ¬ FALSE;
GrabEm: PROC [] = {
Xl.GrabServer[c];
FOR i: NAT IN [0..colorMapSize) DO
pixels: REF Xl.Card32Sequence;
pixels ¬ Xl.AllocColorCells[c, colormap, 1, 0, FALSE ! Xl.XError => GOTO finished].pixels;
IF pixels#NIL THEN {
FOR k: NAT IN [0..pixels.leng) DO
lastAlloc ¬ pixels[k];
used[lastAlloc] ¬ TRUE;
IF HasOpponent[lastAlloc] THEN found ¬ TRUE;
ENDLOOP;
};
IF found THEN EXIT;
ENDLOOP;
EXITS finished => {};
};
ReturnEm: PROC [] = {
pixelsToFree: LIST OF CARD32 ¬ NIL;
used[blackPixel] ¬ FALSE;
used[whitePixel] ¬ FALSE;
used[screen.blackPixel] ¬ FALSE;
used[screen.whitePixel] ¬ FALSE;
FOR i: NAT IN [0..255] DO
IF used[i] THEN pixelsToFree ¬ CONS[i, pixelsToFree];
ENDLOOP;
IF pixelsToFree#NIL THEN Xl.FreeColors[c, colormap, pixelsToFree, 0];
Xl.UngrabServer[c];
};
blackPixel ¬ screen.blackPixel; used[blackPixel] ¬ TRUE;
whitePixel ¬ screen.whitePixel; used[whitePixel] ¬ TRUE;
IF HasOpponent[blackPixel] THEN RETURN [blackPixel, whitePixel];
GrabEm[];
IF found AND lastAlloc<colorMapSize THEN {
IF HasOpponent[lastAlloc] THEN {--otherwise we failed; just use standard black and white
SELECT TRUE FROM
Opponent[lastAlloc]=screen.whitePixel => blackPixel ¬ lastAlloc;
Opponent[lastAlloc]=screen.blackPixel => whitePixel ¬ lastAlloc;
ENDCASE => {whitePixel ¬ lastAlloc; blackPixel ¬ Opponent[lastAlloc]};
};
};
ReturnEm[];
IF blackPixel#screen.blackPixel THEN
Xl.StoreColors[c, colormap, LIST[[blackPixel, TRUE, TRUE, TRUE, [0, 0, 0]]]];
IF whitePixel#screen.whitePixel THEN
Xl.StoreColors[c, colormap, LIST[[whitePixel, TRUE, TRUE, TRUE, [65535, 65535, 65535]]]];
};
Access: PUBLIC PROC [screen: Xl.Screen, depth: BYTE, class: Xl.VisualClass] RETURNS [cd: ColorData ← NIL] = {
--Accesses the data sort of atomically; calls creation if necessary.
Action: TYPE = {use, wait, define};
Protected: ENTRY PROC [vt: Xl.VisualType] RETURNS [Action] = {
WITH Xl.GetVisualTypeProp[vt, myKey] SELECT FROM
d: ColorData => {cd ← d; RETURN [use]};
a: ATOM => RETURN [wait];
ENDCASE => {
Xl.PutVisualTypeProp[vt, myKey, $makingProgress];
RETURN [define];
};
};
a: Action;
vt: Xl.VisualType ~ FindVisualType[screen, depth, class];
IF vt=NIL THEN RETURN [NIL];
a ¬ Protected[vt];
IF a=wait THEN {
FOR i: INT ¬ 0, i+1 WHILE i<50 AND a=wait DO
Process.PauseMsec[100];
a ¬ Protected[vt];
ENDLOOP;
};
SELECT a FROM
use => {
RETURN [cd];
};
define => {
cd ← ColorDataInit[screen, vt];
RETURN [cd];
};
wait => {
--timed out
cd ← ColorDataInit[screen, vt];
RETURN [cd];
};
ENDCASE => ERROR;
};
NewCD: PROC [screen: Xl.Screen] RETURNS [REF ColorDataRec] = {
cd: REF ColorDataRec ~ NEW[ColorDataRec];
cd.hasColors ¬ cd.hasPrivateColormap ¬ FALSE;
cd.colormap ¬ screen.defaultColorMap;
cd.pseudoBlackPixel ¬ screen.blackPixel;
cd.pseudoWhitePixel ¬ screen.whitePixel;
RETURN [cd];
};
ColorDataInit: PROC [screen: Xl.Screen, vt: Xl.VisualType] RETURNS [cd: REF ColorDataRec] = {
--Actually creates the data
cd ← NewCD[screen];
IF vt#NIL THEN {
invGamma: REAL ¬ 0.4545454;
gamma: REAL ¬ 2.2;
cd.hasPrivateColormap ¬ FALSE;
[cd.pseudoBlackPixel, cd.pseudoWhitePixel] ¬ FindBlackAndWhite[screen, vt];
cd.entries ¬ TryWithStandardColorMap[screen, vt, cd.pseudoBlackPixel, cd.pseudoWhitePixel, gamma, invGamma];
IF cd.entries=NIL THEN {
SELECT TRUE FROM
vt.colorMapEntries>255 => {
cd.entries ¬ AllocateForDefaultColormap[screen.connection, cd.colormap, cd.pseudoBlackPixel, cd.pseudoWhitePixel, invGamma, 5, 6, 4];
IF cd.entries=NIL THEN {
cd.entries ¬ AllocateForDefaultColormap[screen.connection, cd.colormap, cd.pseudoBlackPixel, cd.pseudoWhitePixel, invGamma, 4, 5, 4];
IF cd.entries=NIL THEN {
cd.entries ¬ AllocateForDefaultColormap[screen.connection, cd.colormap, cd.pseudoBlackPixel, cd.pseudoWhitePixel, invGamma, 4, 4, 4];
IF cd.entries=NIL THEN {
cd.entries ¬ AllocateForDefaultColormap[screen.connection, cd.colormap, cd.pseudoBlackPixel, cd.pseudoWhitePixel, invGamma, 4, 4, 3];
IF cd.entries=NIL THEN {
cd.hasPrivateColormap ¬ TRUE;
cd.colormap ¬ Xl.CreateColorMap[c: screen.connection, visual: vt.visual, window: screen.root, allocAll: TRUE];
cd.entries ¬ AllocateForNewColormap[screen.connection, cd.colormap, cd.pseudoBlackPixel, cd.pseudoWhitePixel, invGamma, 5, 6, 4, vt.colorMapEntries];
};
};
};
};
};
vt.colorMapEntries>15 => {
cd.entries ¬ AllocateForDefaultColormap[screen.connection, cd.colormap, cd.pseudoBlackPixel, cd.pseudoWhitePixel, invGamma, 2, 3, 2];
IF cd.entries=NIL THEN {
cd.entries ¬ AllocateForDefaultColormap[screen.connection, cd.colormap, cd.pseudoBlackPixel, cd.pseudoWhitePixel, invGamma, 2, 2, 2];
IF cd.entries=NIL THEN {
cd.hasPrivateColormap ¬ TRUE;
cd.colormap ¬ Xl.CreateColorMap[c: screen.connection, visual: vt.visual, window: screen.root, allocAll: TRUE];
cd.entries ¬ AllocateForNewColormap[screen.connection, cd.colormap, cd.pseudoBlackPixel, cd.pseudoWhitePixel, invGamma, 2, 3, 2, vt.colorMapEntries];
};
};
};
vt.colorMapEntries>3 => {
};
ENDCASE => {
cd.hasColors ¬ FALSE;
Xl.PutScreenProp[screen, myKey, cd];
RETURN
};
};
cd.hasColors ¬ TRUE;
};
Xl.PutScreenProp[screen, myKey, cd];
};
END.