<> <> <> <> <<>> 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] = { <> 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 a0 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]= { <> <> 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]; <> }; 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] = { <> 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 {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> 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> 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] = { <> 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 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]; }; }; }; <3 => {>> <<};>> ENDCASE => { cd.hasColors ¬ FALSE; Xl.PutScreenProp[screen, myKey, cd]; RETURN }; }; cd.hasColors ¬ TRUE; }; Xl.PutScreenProp[screen, myKey, cd]; }; END.