-- ColorMapImpl.mesa
-- last edited by Maureen Stone, October 5, 1982 2:23 pm
-- last edited by Doug Wyatt, September 1, 1982 3:53 pm
-- Color definitions and colormap routines

DIRECTORY
ColorDisplay USING [Byte, curmode, disconnected, SetBlueMap, SetColor,
SetGreenMap, SetRedMap],
CGColor USING [HSVToRGB],
ColorMap USING [GrayTable, GrayRec],
ColorPackagePrivate USING [ColorMapProc],
Real USING [RoundI],
RealFns USING [Power];

ColorMapImpl: CEDAR PROGRAM
IMPORTS ColorDisplay, Real, RealFns, CGColor
EXPORTS ColorMap, ColorPackagePrivate = {

Byte: TYPE = ColorDisplay.Byte;
Triple: TYPE = RECORD[r,g,b: Byte];
ColorTable: ARRAY [0..255] OF Triple ← ALL[[0,0,0]];

blue: Byte=2; red: Byte=4; magenta: Byte=6; green: Byte=8; cyan: Byte=10; yellow: Byte=12;
NoMap: PROC RETURNS[BOOLEAN] = {OPEN ColorDisplay;
IF curmode=disconnected OR curmode.full THEN RETURN[TRUE]
ELSE RETURN[FALSE]};

StandardMap: PUBLIC PROC = {
IF NoMap[] THEN RETURN;
GrayWedge[]; -- start with a gray wedge.
IF ColorDisplay.curmode.bitsPerPixelA < 4 THEN RETURN;
--throw out half the grays to make room for colors
FOR i: Byte IN [2..256) DO
IF i MOD 2 = 0 THEN SetColor[i,0,0,0];
ENDLOOP;
--put in the standard colors,
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[];
};
--sets up the standard color map (definition changing daily!)
--functional colors. These values change with each display mode
--changing the color map with SetRGBColor or SetHSVColor may invalidate these values
--StandardMap[] will fix them

foreground: Byte ← 255;
background: Byte ← 0;

grayTable: ColorMap.GrayTable ← NEW[ColorMap.GrayRec[256]];
--sets up a gamma corrected gray wedge as the color map. Good for
--showing AIS files
GrayMap: PUBLIC PROC = {
 GrayWedge[];
 SetUpGrayTable[];
 };

GrayWedge: PROC = {
color: REAL ← 0;
step: REAL ← 0;
nentries: CARDINAL ← 0;
bitsPerPixel: CARDINAL ← ColorDisplay.curmode.bitsPerPixelA;
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;
};


--Searches the colormap for all the gray values and sets up a GrayTable
--Do this after you are finished setting your colormap if you want the color device
--to do its best for gray images.

SetUpGrayTable
: PUBLIC PROC = {
 lastValid: INTEGER ← -1;
 firstValid: INTEGER ← 1000;
 nextValid,prevValid: INTEGER ← 0;
 maxCIndex: INTEGER ← MaxIndex[];
 --need a table that can have "unassigned" entries
 table: ARRAY[0..255] OF INTEGER ← ALL[-1];
 IF NoMap[] THEN RETURN;
 --search the colortable for grays
 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;
 --want to use the first occurance of a color as the correct one (matches GetIndex)
   IF table[intensity]=-1 THEN table[intensity] ← i;
   IF intensity>lastValid THEN lastValid ← intensity;
   IF intensity<firstValid THEN firstValid ← intensity;
   };
  grayTable[i] ← 0; --zero this out while we're looping
  ENDLOOP;
 IF firstValid>maxCIndex 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;
 --interpolate between prevValid and nextValid
  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 ColorDisplay.curmode.full THEN FullComp[]};

GetGamma: PUBLIC PROC RETURNS[gamma: REAL] = {RETURN[gamma]};
--gamma should be in the range [1..3]

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
  TRUSTED {
   ColorDisplay.SetRedMap[in: i, out: ToByte[Comp[v]]];
   ColorDisplay.SetGreenMap[in: i, out: ToByte[Comp[v]]];
   ColorDisplay.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 ColorDisplay.curmode.bitsPerPixelA 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[Byte] = {
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: Byte] RETURNS[REAL] = {
RETURN[MAX[0,MIN[1,b/255.0]]];
};

SetColor: PROC[index: Byte, r,g,b: REAL] = {
ir,ig,ib: Byte;
ir ← ToByte[Comp[r]];
ig ← ToByte[Comp[g]];
ib ← ToByte[Comp[b]];
TRUSTED {ColorDisplay.SetColor[pixelA: index, r: ir,g: ig,b: ib]};
ColorTable[index] ← [r: ToByte[r],g: ToByte[g],b: ToByte[b]];
};

--returns a table that maps intensities [0..255] into pixel values for the current mode
GetGrayTable: PUBLIC PROC RETURNS[ColorMap.GrayTable] = {RETURN[grayTable]};

--finds color in the colormap or returns a compromise (currently a gray value).
--This is expensive, so the device should keep a cache.
MyGetIndex: PROC[r,g,b: Byte] RETURNS[Byte] = {
maxIndex: Byte ← MaxIndex[]; --gets the maximum index for the current mod
intensity: REAL;
gray: Byte;
IF NoMap[] THEN RETURN[0];
FOR i: Byte IN [0..maxIndex] DO
IF r=ColorTable[i].r AND g=ColorTable[i].g AND b=ColorTable[i].b THEN RETURN[i];
ENDLOOP;
--not found, so return the corresponding gray value
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 ← new};

GetIndex: PUBLIC PROC [r,g,b: Byte] RETURNS[Byte] = {
 RETURN[GetIndexProc[r,g,b]];
};

GetColor: PUBLIC PROC[index: Byte] RETURNS[r,g,b: Byte] = {
IF index>MaxIndex[] THEN ColorError["index out of range"];
[r,g,b] ← ColorTable[index];
RETURN[r,g,b];
};

}.