<> <> <> <> DIRECTORY CGColor USING [HSVToRGB], ColorMap USING [GrayTable, GrayRec], ColorPackagePrivate USING [ColorMapProc, terminal], Real USING [RoundI], RealFns USING [Power], Terminal USING [Color, GetColorBitmapState, GetColorMode, SetBlueMap, SetColor, SetGreenMap, SetRedMap]; ColorMapImpl: CEDAR PROGRAM IMPORTS CGColor, ColorPackagePrivate, Real, RealFns, Terminal EXPORTS ColorMap, ColorPackagePrivate = { OPEN ColorPackagePrivate; Color: TYPE = Terminal.Color; Triple: TYPE = RECORD[r,g,b: Color]; ColorTable: ARRAY [0..255] OF Triple _ ALL[[0,0,0]]; blue: Color=2; red: Color=4; magenta: Color=6; green: Color=8; cyan: Color=10; yellow: Color=12; NoMap: PROC RETURNS[BOOLEAN] = { RETURN[terminal.GetColorBitmapState=none OR terminal.GetColorMode.full]; }; StandardMap: PUBLIC PROC = { IF NoMap[] THEN RETURN; GrayWedge[]; -- start with a gray wedge. IF terminal.GetColorMode.bitsPerPixelChannelA < 4 THEN RETURN; <> FOR i: Color IN [2..256) DO IF i MOD 2 = 0 THEN SetColor[i,0,0,0]; ENDLOOP; <> SetRGBColor[blue,0,0,1]; --blue SetRGBColor[red,1,0,0]; --red SetRGBColor[magenta,1,0,1]; --magenta SetRGBColor[green,0,1,0]; --green SetRGBColor[cyan,0,1,1]; --cyan SetRGBColor[yellow,1,1,0]; --yellow SetUpGrayTable[]; }; <> <> <> <> foreground: Color _ 255; background: Color _ 0; standardGrayTable: ColorMap.GrayTable _ NEW[ColorMap.GrayRec[256]]; grayTable: ColorMap.GrayTable _ standardGrayTable; <> <> GrayMap: PUBLIC PROC = { GrayWedge[]; SetUpGrayTable[]; }; GrayWedge: PROC = { color: REAL _ 0; step: REAL _ 0; nentries: CARDINAL _ 0; bitsPerPixel: CARDINAL _ terminal.GetColorMode.bitsPerPixelChannelA; IF NoMap[] THEN RETURN; SELECT bitsPerPixel FROM 1 => {step _ 1.0; nentries _ 2}; 2 => {step _ 1.0/7; nentries _ 4}; 4 => {step _ 1.0/15; nentries _ 16}; 8 => {step _ 1.0/255; nentries _ 256}; ENDCASE => ERROR; FOR i: CARDINAL IN [0..nentries) DO SetRGBColor[i,color,color,color]; color _ color+step; ENDLOOP; }; <> <> <> SetUpGrayTable: PUBLIC PROC = { lastValid: INTEGER _ -1; firstValid: INTEGER _ 1000; nextValid,prevValid: INTEGER _ 0; maxCIndex: INTEGER _ MaxIndex[]; <> table: ARRAY[0..255] OF INTEGER _ ALL[-1]; IF NoMap[] THEN RETURN; <> FOR i: INTEGER IN [0..maxCIndex] DO IF ColorTable[i].r=ColorTable[i].g AND ColorTable[i].g=ColorTable[i].b THEN { intensity: INTEGER _ ColorTable[i].r; <> IF table[intensity]=-1 THEN table[intensity] _ i; IF intensity>lastValid THEN lastValid _ intensity; IF intensitymaxCIndex THEN RETURN; --no Grays FOR i: INTEGER IN [0..firstValid] DO grayTable[i] _ table[firstValid] ENDLOOP; nextValid _ prevValid _ firstValid; UNTIL nextValid>=lastValid DO mid: REAL; k: INTEGER; nextValid _ nextValid+1; UNTIL table[nextValid] > -1 DO nextValid _ nextValid+1 ENDLOOP; <> mid _ (nextValid+prevValid)/2.0; k _ prevValid; UNTIL k>mid DO grayTable[k]_ table[prevValid]; k _ k+1; ENDLOOP; UNTIL k>nextValid DO grayTable[k]_ table[nextValid]; k _ k+1; ENDLOOP; prevValid _ nextValid; ENDLOOP; FOR i: INTEGER IN [lastValid..255] DO grayTable[i] _ table[lastValid] ENDLOOP; }; gamma: REAL _ 1.0/2.2; SetGamma: PUBLIC PROC[g: REAL] = { gamma _ 1.0/g; IF terminal.GetColorMode.full THEN FullComp[]}; GetGamma: PUBLIC PROC RETURNS[REAL] = {RETURN[gamma]}; <> Comp: PROCEDURE [intensity: REAL] RETURNS [REAL] = { IF intensity=0 THEN RETURN[0]; IF intensity=1 THEN RETURN[1]; intensity _ RealFns.Power[intensity, gamma]; RETURN[MAX[MIN[1,intensity],0]]; }; FullComp: PROC = { step: REAL _ 1.0/255.0; v: REAL _ 0; FOR i: CARDINAL IN [0..256) DO terminal.SetRedMap[in: i, out: ToByte[Comp[v]]]; terminal.SetGreenMap[in: i, out: ToByte[Comp[v]]]; terminal.SetBlueMap[in: i, out: ToByte[Comp[v]]]; v _ v+step; ENDLOOP; }; ColorError: PUBLIC SIGNAL[why: LONG STRING] = CODE; SetRGBColor: PUBLIC PROCEDURE[index: CARDINAL _ 0, r,g,b: REAL] = { IF NoMap[] THEN RETURN; IF index>MaxIndex[] THEN SIGNAL ColorError["index out of range"]; SetColor[index,r,g,b]; }; MaxIndex: PROC RETURNS[max: CARDINAL] = { max _ (SELECT terminal.GetColorMode.bitsPerPixelChannelA FROM 1 => 1, 2 => 3, 4 => 15, 8 => 255, ENDCASE => 0); }; SetHSVColor: PUBLIC PROCEDURE[index: CARDINAL _ 0, h,s,v: REAL] = { r,g,b: REAL; IF NoMap[] THEN RETURN; IF index>MaxIndex[] THEN SIGNAL ColorError["index out of range"]; [r,g,b] _ CGColor.HSVToRGB[h,s,v]; SetColor[index,r,g,b]; }; ToByte: PROC [v: REAL] RETURNS[Color] = { IF v NOT IN [0..1] THEN SIGNAL ColorError["value out of range"]; RETURN[MAX[0,MIN[255,Real.RoundI[v*255]]]]; }; FromByte: PROC [b: Color] RETURNS[REAL] = { RETURN[MAX[0,MIN[1,b/255.0]]]; }; SetColor: PROC[index: Color, r,g,b: REAL] = { ir,ig,ib: Color; ir _ ToByte[Comp[r]]; ig _ ToByte[Comp[g]]; ib _ ToByte[Comp[b]]; terminal.SetColor[aChannelValue: index, red: ir, green: ig, blue: ib]; ColorTable[index] _ [r: ToByte[r],g: ToByte[g],b: ToByte[b]]; }; <> GetGrayTable: PUBLIC PROC RETURNS[ColorMap.GrayTable] = {RETURN[grayTable]}; SetGrayTable: PUBLIC PROC[table: ColorMap.GrayTable] = { IF table=NIL THEN grayTable _ standardGrayTable ELSE { IF table.length#256 THEN ERROR; --hey, this is a hack feature anyway grayTable _ table; }; }; <> <> MyGetIndex: PROC[r,g,b: Color] RETURNS[Color] = { maxIndex: Color _ MaxIndex[]; --gets the maximum index for the current mod intensity: REAL; gray: Color; IF NoMap[] THEN RETURN[0]; FOR i: Color IN [0..maxIndex] DO IF r=ColorTable[i].r AND g=ColorTable[i].g AND b=ColorTable[i].b THEN RETURN[i]; ENDLOOP; <> intensity _ .11*b+.30*r+.59*g; --NTSC luminance gray _ Real.RoundI[intensity]; RETURN[grayTable[gray]]; }; GetIndexProc: ColorPackagePrivate.ColorMapProc _ MyGetIndex; SetNewColorMapProc: PUBLIC PROC[new: ColorPackagePrivate.ColorMapProc] = { GetIndexProc _ IF new=NIL THEN MyGetIndex ELSE new}; GetIndex: PUBLIC PROC [r,g,b: Color] RETURNS[Color] = { RETURN[GetIndexProc[r,g,b]]; }; GetColor: PUBLIC PROC[index: Color] RETURNS[r,g,b: Color] = { IF index>MaxIndex[] THEN ColorError["index out of range"]; [r,g,b] _ ColorTable[index]; RETURN[r,g,b]; }; }.