DIRECTORY
Imager USING [Error],
ImagerColor,
ImagerColorPrivate,
ImagerPixelArray USING [GetPixels, MaxSampleValue, PixelArray],
ImagerSample,
Real USING [FixI, Round],
RealFns USING [Power],
RuntimeError USING [BoundsFault],
SF;

ImagerColorImpl: CEDAR PROGRAM
IMPORTS Imager, ImagerPixelArray, ImagerSample, Real, RealFns, RuntimeError
EXPORTS ImagerColor, ImagerColorPrivate
~ BEGIN OPEN ImagerColorPrivate, ImagerColor;
ColorOperatorClass: TYPE ~ ImagerColorPrivate.ColorOperatorClass;
ColorOperatorClassRep: PUBLIC TYPE ~ ImagerColorPrivate.ColorOperatorClassRep;

RGBCalibrationImpl: TYPE ~ ImagerColorPrivate.RGBCalibrationImpl;
RGBCalibrationImplRep: PUBLIC TYPE ~ ImagerColorPrivate.RGBCalibrationImplRep;

defaultCalibration: RGBCalibration _ NIL;

GetDefaultCalibration: PUBLIC PROC RETURNS [RGBCalibration] ~ {
RETURN[defaultCalibration];
};
CreateCalibration: PUBLIC PROC [type: ATOM, red, green, blue: Chromaticity, 
white: Chromaticity, YMax: REAL _ 100] RETURNS [RGBCalibration] ~ {
ERROR;
};

CIEFromRGB: PUBLIC PROC [rgb: RGB, calibration: RGBCalibration _ NIL] RETURNS [XYZ] ~ {
cal: RGBCalibration ~ IF calibration=NIL THEN defaultCalibration ELSE calibration;
impl: RGBCalibrationImpl ~ cal.impl;
RETURN[[
X: impl.cXR*rgb.R+impl.cXG*rgb.G+impl.cXB*rgb.B, 
Y: impl.cYR*rgb.R+impl.cYG*rgb.G+impl.cYB*rgb.B, 
Z: impl.cZR*rgb.R+impl.cZG*rgb.G+impl.cZB*rgb.B
]];
};
RGBFromCIE: PUBLIC PROC [cie: XYZ, calibration: RGBCalibration _ NIL] RETURNS [RGB] ~ {
cal: RGBCalibration ~ IF calibration=NIL THEN defaultCalibration ELSE calibration;
impl: RGBCalibrationImpl ~ cal.impl;
RETURN[[
R: impl.cRX*cie.X+impl.cRY*cie.Y+impl.cRZ*cie.Z, 
G: impl.cGX*cie.X+impl.cGY*cie.Y+impl.cGZ*cie.Z, 
B: impl.cBX*cie.X+impl.cBY*cie.Y+impl.cBZ*cie.Z
]];
};

RGBMaxY: PUBLIC PROC [c: Chromaticity, calibration: RGBCalibration _ NIL] 
RETURNS [Y: REAL] ~ {
cie: XYZ _ [X: c.x, Y: c.y, Z: 1-(c.x+c.y)];
rgb: RGB _ RGBFromCIE[cie, calibration];
max: REAL _ MAX[MAX[rgb.R, rgb.G],rgb.B];
Y _ c.y/max;	--it would be an unusual device that had max=0
};
ChromaticityFromCIE: PUBLIC PROC [c: XYZ] RETURNS [Chromaticity] ~ {
sum: REAL ~ c.X+c.Y+c.Z;
RETURN[[x: c.X/sum, y: c.Y/sum]];
};

CIEFromChromaticity: PUBLIC PROC [c: Chromaticity, Y: REAL] RETURNS [XYZ] ~ {
scale: REAL ~ Y/c.y;
RETURN[[X: c.x*scale, Y: Y, Z: (1-c.x-c.y)*scale]];
};

ToRange: PROC[v: REAL] RETURNS[REAL] = INLINE {
IF v IN[0..1] THEN RETURN[v] ELSE ERROR RuntimeError.BoundsFault;
}; 

HSLFromRGB: PUBLIC PROC [val: RGB] RETURNS [HSL] ~ {
max,min,rc,gc,bc,del, h, s, l: REAL;
red: REAL _ ToRange[val.R];
green: REAL _ ToRange[val.G];
blue: REAL _ ToRange[val.B];
max _ MAX[red,MAX[green,blue]];
min _ MIN[red,MIN[green,blue]];
l _ (max+min)/2;
IF max=min THEN RETURN[[0,0,l]];	--gray
del _ max-min;
s _ IF l <= 0.5 THEN del/(max+min) ELSE del/(2-max-min);
rc _ (max-red)/del;
gc _ (max-green)/del;
bc _ (max-blue)/del;
IF max = red THEN h _ bc-gc	--between yellow and magenta
ELSE IF max = green THEN h _ 2+rc-bc	--between cyan and yellow
ELSE IF max = blue THEN h _ 4+gc-rc	--between magenta and cyan
ELSE ERROR Imager.Error[[$invalidColor, "Invalid RGB color"]];
h _ h/6.0;
IF h < 0 THEN h _ h+1;
RETURN[[h, s, l]];
};

RGBFromHSL: PUBLIC PROC [val: HSL] RETURNS [RGB] ~ {
m1,m2,hue,saturation, lightness, r, g, b: REAL;
Value: PROC[n1,n2,h1: REAL] RETURNS[v: REAL] = {
IF h1 > 360 THEN h1 _ h1-360;
IF h1 < 0 THEN h1 _ h1+360;
v _ SELECT TRUE FROM
h1 IN [0..60) => n1+(n2-n1)*h1/60,
h1 IN [60..180) => n2,
h1 IN [180..240) => n1+(n2-n1)*(240-h1)/60,
ENDCASE => n1;
};
IF val.S=0 THEN RETURN[[val.L, val.L, val.L]];
saturation _ ToRange[val.S];
lightness _ ToRange[val.L];
hue _ 360*ToRange[val.H];
m2 _ IF lightness <= 0.5
THEN lightness*(1+saturation)
ELSE lightness+saturation-lightness*saturation;
m1 _ 2*lightness-m2;
r _ Value[m1,m2,hue+120];
g _ Value[m1,m2,hue];
b _ Value[m1,m2,hue-120];
RETURN[[r, g, b]];
};

HSVFromRGB: PUBLIC PROC [val: RGB] RETURNS [HSV] ~ {
r, g, b, h, s, v: REAL _ 0;
max,min,rc,gc,bc: REAL;
r _ ToRange[val.R]; g _ ToRange[val.G]; b _ ToRange[val.B];
min _ MIN[MIN[r,g],b];  --amount of white
v _ max _ MAX[MAX[r,g],b];--maximum "brightness"
IF max#0 THEN s _ (max-min)/max
ELSE s _ 0;
IF s=0 THEN RETURN[[0,0,v]];  --gray
rc _ (max - r)/(max - min);
gc _ (max - g)/(max - min);
bc _ (max - b)/(max - min);
IF r=max THEN h_bc-gc
ELSE IF g=max THEN h_2+rc-bc
ELSE IF b=max THEN h_4+gc-rc;
h _ h / 6.0;
IF h<0 THEN h_h+1;
RETURN[[h, s, v]];
};

RGBFromHSV: PUBLIC PROC [val: HSV] RETURNS [RGB] ~ {
hue, saturation, value: REAL;
ihue: INTEGER;
fhue,m,n,k: REAL;
IF val.V=0 OR val.S=0 THEN RETURN[[val.V, val.V, val.V]];
hue _ ToRange[val.H];
saturation _ ToRange[val.S];
value _ ToRange[val.V];
hue _ hue*6;
ihue _ Real.FixI[hue];	--integer hue
fhue _ hue-ihue;	--fractional hue
IF ihue=6 THEN ihue _ 0;
m _ value*(1-saturation);
n _ value*(1-(saturation*fhue));
k _ value*(1-(saturation*(1-fhue)));
SELECT ihue FROM
0 => RETURN[[value,k,m]];
1 => RETURN[[n,value,m]];
2 => RETURN[[m,value,k]];
3 => RETURN[[m,n,value]];
4 => RETURN[[k,m,value]];
5 => RETURN[[value,m,n]];
ENDCASE => RETURN[[0,0,0]];
};

YIQFromRGB: PUBLIC PROC [val: RGB] RETURNS [YIQ] ~ {
RETURN[[
Y: 0.30*val.R+0.59*val.G+0.11*val.B,
I: 0.60*val.R-0.28*val.G-0.32*val.B,
Q: 0.21*val.R-0.52*val.G+0.31*val.B
]];
};

RGBFromYIQ: PUBLIC PROC [val: YIQ] RETURNS [RGB] ~ {
RETURN[[
R: 1.0*val.Y+0.9482623*val.I+0.6240127*val.Q,
G: 1.0*val.Y-0.2760664*val.I-0.6398104*val.Q,
B: 1.0*val.Y-1.10545*val.I+1.729858*val.Q
]];
};

IntensityFromGray: PROC [f: REAL] RETURNS [REAL] ~ {
IF f>=1 THEN RETURN[0];
IF f<=0 THEN RETURN[1];
RETURN[1-f];
};

IntensityFromRGB: PROC [val: RGB] RETURNS [REAL] ~ {
Y: REAL ~ 0.30*val.R+0.59*val.G+0.11*val.B;
IF Y<=0 THEN RETURN[0];
IF Y>=1 THEN RETURN[1];
RETURN[Y];
};



Apply: PUBLIC PROC [self: ColorOperator, pixel: PixelProc] RETURNS [ConstantColor] ~ {
size: NAT ~ self.samplesPerPixelIn;
color: ConstantColor ~ NEW[ColorRep.constant[size] _ [constant[colorOperator: self, pixel: ]]];
FOR i: NAT IN[0..size) DO color.pixel[i] _ pixel[i] ENDLOOP;
RETURN[color];
};
TupleFromPixel: PUBLIC PROC [self: ColorOperator, output: ColorOutput, 
pixelIn: PixelProc, tupleAction: PROC [tupleOut: TupleProc]] ~ {
class: ColorOperatorClass ~ self.class;
class.TupleFromPixel[self, output, pixelIn, tupleAction];
};

PixelFromPixel: PUBLIC PROC [self: ColorOperator, output: ColorOutput, 
pixelIn: PixelProc, maxOut: PixelProc, pixelAction: PROC [pixelOut: PixelProc]] ~ {
class: ColorOperatorClass ~ self.class;
tupleAction: PROC [tupleOut: TupleProc] ~ {
pixelOut: PixelProc ~ { RETURN[Real.Round[maxOut[i]*tupleOut[i]]] };
pixelAction[pixelOut];
};
class.TupleFromPixel[self, output, pixelIn, tupleAction];
};

TranslatePixels: PUBLIC PROC [self: ColorOperator, output: ColorOutput, 
maxIn: PixelProc, maxOut: PixelProc, translateAction: PROC [translate: TranslateProc]] ~ {
class: ColorOperatorClass ~ self.class;
IF class.TranslatePixels=NIL THEN {
slowTranslate: TranslateProc ~ {
samplesPerPixelOut: NAT ~ output.samplesPerPixelOut;
FOR j: NAT IN[0..pixelsIn.length) DO
pixelIn: PixelProc ~ { RETURN[pixelsIn[i][j]] };
pixelOutAction: PROC [pixelOut: PixelProc] ~ {
FOR i: NAT IN[0..samplesPerPixelOut) DO
pixelsOut[i][j] _ pixelOut[i];
ENDLOOP;
};
PixelFromPixel[self, output, pixelIn, maxOut, pixelOutAction];
ENDLOOP;
};
translateAction[slowTranslate];
}
ELSE class.TranslatePixels[self, output, maxIn, maxOut, translateAction];
};

Translate: PUBLIC PROC [self: ColorOperator, output: ColorOutput,
pa: PixelArray, maxOut: PixelProc] RETURNS [PixelMap] ~ {
size: SF.Vec ~ [s: NAT[pa.sSize], f: NAT[pa.fSize]];
samplesPerPixelIn: NAT ~ pa.samplesPerPixel;
samplesPerPixelOut: NAT ~ output.samplesPerPixelOut;
maxIn: PixelProc ~ { RETURN[pa.MaxSampleValue[i]] };
pm: PixelMap ~ ImagerSample.NewPixelMap[samplesPerPixelOut, size, maxOut];
translateAction: PROC [translate: TranslateProc] ~ {
pixelsIn: PixelBuffer ~ ImagerSample.ObtainScratchPixels[samplesPerPixelIn, size.f];
pixelsOut: PixelBuffer ~ ImagerSample.ObtainScratchPixels[samplesPerPixelOut, size.f];
FOR s: NAT IN[0..size.s) DO
pa.GetPixels[s: s, f: 0, pixels: pixelsIn];
translate[pixelsIn: pixelsIn, pixelsOut: pixelsOut];
pm.PutPixels[min: [s: s, f: 0], pixels: pixelsOut];
ENDLOOP;
ImagerSample.ReleaseScratchPixels[pixelsOut];
ImagerSample.ReleaseScratchPixels[pixelsIn];
};
TranslatePixels[self, output, maxIn, maxOut, translateAction];
RETURN[pm];
};


NewColorOperatorClass: PUBLIC PROC [
name: ROPE, 
TupleFromPixel: TupleFromPixelProc, 
TranslatePixels: TranslatePixelsProc
] RETURNS [ColorOperatorClass] ~ {
class: ColorOperatorClass ~ NEW[ColorOperatorClassRep _ [name: name,
TupleFromPixel: TupleFromPixel, TranslatePixels: TranslatePixels]];
RETURN[class];
};


TranslatePixelsTable: PROC [self: ColorOperator, output: ColorOutput, 
maxIn: PixelProc, maxOut: PixelProc, translateAction: PROC [translate: TranslateProc]] ~ {
maxIn0: Sample ~ maxIn[0];
samplesPerPixelOut: NAT ~ output.samplesPerPixelOut;
table: PixelBuffer ~ ImagerSample.ObtainScratchPixels[samplesPerPixelOut, maxIn0+1];
tableTranslate: TranslateProc ~ TRUSTED {
count: NAT ~ pixelsIn.length;
FOR i: NAT IN[0..samplesPerPixelOut) DO
samplesIn: SampleBuffer ~ pixelsIn[0];
samplesOut: SampleBuffer ~ pixelsOut[i];
samplesTable: SampleBuffer ~ table[i];
pointerIn: LONG POINTER TO ImagerSample.RawSamples _ 
samplesIn.PointerToSamples[start: 0, count: count];
pointerOut: LONG POINTER TO ImagerSample.RawSamples _ 
samplesOut.PointerToSamples[start: 0, count: count];
THROUGH [0..count/8) DO
pointerOut[0] _ samplesTable[pointerIn[0]];
pointerOut[1] _ samplesTable[pointerIn[1]];
pointerOut[2] _ samplesTable[pointerIn[2]];
pointerOut[3] _ samplesTable[pointerIn[3]];
pointerOut[4] _ samplesTable[pointerIn[4]];
pointerOut[5] _ samplesTable[pointerIn[5]];
pointerOut[6] _ samplesTable[pointerIn[6]];
pointerOut[7] _ samplesTable[pointerIn[7]];
pointerIn _ pointerIn+8; pointerOut _ pointerOut+8;
ENDLOOP;
THROUGH [0..count MOD 8) DO
pointerOut[0] _ samplesTable[pointerIn[0]];
pointerIn _ pointerIn+1; pointerOut _ pointerOut+1;
ENDLOOP;
ENDLOOP;
};
FOR s0: Sample IN[0..maxIn0] DO
pixelIn: PixelProc ~ { check: [0..1) ~ i; RETURN[s0] };
pixelOutAction: PROC [pixelOut: PixelProc] ~ {
FOR i: NAT IN[0..samplesPerPixelOut) DO table[i][s0] _ pixelOut[i] ENDLOOP;
};
PixelFromPixel[self, output, pixelIn, maxOut, pixelOutAction];
ENDLOOP;
translateAction[tableTranslate];
ImagerSample.ReleaseScratchPixels[table];
};


SampleTableProc: TYPE ~ PROC [Sample] RETURNS [REAL];

NewSampleTable: PROC [size: NAT, proc: SampleTableProc] RETURNS [SampleTable] ~ {
IF size=0 THEN RETURN[NIL]
ELSE {
map: SampleTable ~ NEW[SampleTableRep[size]];
FOR i: Sample IN[0..size) DO map[i] _ proc[i] ENDLOOP;
RETURN[map];
};
};


classGrayLinear: ColorOperatorClass ~ NewColorOperatorClass[
name: "Xerox/GrayLinear",
TupleFromPixel: TupleFromPixelGrayLinear,
TranslatePixels: TranslatePixelsTable
];

TupleFromPixelGrayLinear: TupleFromPixelProc ~ {
data: DataGrayLinear ~ NARROW[self.data];
s0: Sample ~ pixelIn[0];
s: REAL ~ IF data.map=NIL THEN REAL[s0] ELSE data.map[s0];
f: REAL ~ (s-data.sWhite)/(data.sBlack-data.sWhite);
x: REAL ~ IF f<=0 THEN 1 ELSE IF f>=1 THEN 0 ELSE 1-f;
tupleOut: TupleProc ~ { RETURN[x] };
tupleAction[tupleOut];
};

NewColorOperatorGrayLinear: PUBLIC PROC [sWhite, sBlack: REAL, 
sampleTableSize: Sample _ 0, sampleTableProc: SampleTableProc _ NIL
] RETURNS [ColorOperator] ~ {
data: DataGrayLinear ~ NEW[DataGrayLinearRep _ [
sWhite: sWhite, sBlack: sBlack, 
map: NewSampleTable[sampleTableSize, sampleTableProc]
]];
RETURN[NEW[ColorOperatorRep _ [
chromatic: FALSE, samplesPerPixelIn: 1,
class: classGrayLinear, data: data
]]];
};


classGrayDensity: ColorOperatorClass ~ NewColorOperatorClass[
name: "Xerox/GrayDensity",
TupleFromPixel: TupleFromPixelGrayDensity,
TranslatePixels: TranslatePixelsTable
];

TupleFromPixelGrayDensity: TupleFromPixelProc ~ {
data: DataGrayDensity ~ NARROW[self.data];
s0: Sample ~ pixelIn[0];
s: REAL ~ IF data.map=NIL THEN REAL[s0] ELSE data.map[s0];
d: REAL ~ ((s-data.sWhite)/(data.sBlack-data.sWhite))*data.dBlack;
f: REAL ~ RealFns.Power[base: 10, exponent: -d];
x: REAL ~ IF f<=0 THEN 1 ELSE IF f>=1 THEN 0 ELSE 1-f;
tupleOut: TupleProc ~ { RETURN[x] };
tupleAction[tupleOut];
};

NewColorOperatorGrayDensity: PUBLIC PROC [sWhite, sBlack, dBlack: REAL, 
sampleTableSize: Sample _ 0, sampleTableProc: SampleTableProc _ NIL
] RETURNS [ColorOperator] ~ {
data: DataGrayDensity ~ NEW[DataGrayDensityRep _ [
sWhite: sWhite, sBlack: sBlack, dBlack: dBlack,
map: NewSampleTable[sampleTableSize, sampleTableProc]
]];
RETURN[NEW[ColorOperatorRep _ [
chromatic: FALSE, samplesPerPixelIn: 1,
class: classGrayDensity, data: data
]]];
};

classGrayVisual: ColorOperatorClass ~ NewColorOperatorClass[
name: "Xerox/GrayVisual",
TupleFromPixel: TupleFromPixelGrayVisual,
TranslatePixels: TranslatePixelsTable
];

TupleFromPixelGrayVisual: TupleFromPixelProc ~ {
data: DataGrayVisual ~ NARROW[self.data];
s0: Sample ~ pixelIn[0];
s: REAL ~ IF data.map=NIL THEN REAL[s0] ELSE data.map[s0];
L: REAL ~ (s-data.sBlack)/(data.sWhite-data.sBlack);
Y: REAL ~ IF L<=0.09 THEN L/0.09 ELSE RealFns.Power[base: (L+0.16)/0.25, exponent: 3];
f: REAL ~ 1-0.01*Y;
x: REAL ~ IF f<=0 THEN 1 ELSE IF f>=1 THEN 0 ELSE 1-f;
tupleOut: TupleProc ~ { RETURN[x] };
tupleAction[tupleOut];
};

NewColorOperatorGrayVisual: PUBLIC PROC [sWhite, sBlack: REAL, 
sampleTableSize: Sample _ 0, sampleTableProc: SampleTableProc _ NIL
] RETURNS [ColorOperator] ~ {
data: DataGrayVisual ~ NEW[DataGrayVisualRep _ [
sWhite: sWhite, sBlack: sBlack, 
map: NewSampleTable[sampleTableSize, sampleTableProc]
]];
RETURN[NEW[ColorOperatorRep _ [
chromatic: FALSE, samplesPerPixelIn: 1,
class: classGrayVisual, data: data
]]];
};


classMap: ColorOperatorClass ~ NewColorOperatorClass[
name: "Xerox/Map",
TupleFromPixel: TupleFromPixelMap,
TranslatePixels: TranslatePixelsTable
];

TupleFromPixelMap: TupleFromPixelProc ~ {
data: DataMap ~ NARROW[self.data];
color: ConstantColor ~ data[pixelIn[0]];
TupleFromColor[color, output, tupleAction];
};

NewColorOperatorMap: PUBLIC PROC [
maxSampleValue: Sample, map: PROC [Sample] RETURNS [ConstantColor]
] RETURNS [ColorOperator] ~ {
data: DataMap ~ NEW[DataMapRep[maxSampleValue+1] _ [v: ]];
chromatic: BOOL _ FALSE;
FOR s0: Sample IN[0..maxSampleValue] DO
color: ConstantColor ~ map[s0];
data.v[s0] _ color;
chromatic _ chromatic OR color.colorOperator.chromatic;
ENDLOOP;
RETURN[NEW[ColorOperatorRep _ [
chromatic: chromatic, samplesPerPixelIn: 1,
class: classMap, data: data
]]];
};


TupleFromPixelBuildMap: TupleFromPixelProc ~ {
data: DataBuildMap ~ NARROW[self.data];
pixelMapped: PixelProc ~ { check: [0..1) ~ i; s0: Sample ~ pixelIn[0]; RETURN[data[s0]] };
TupleFromPixel[data.colorOperator, output, pixelMapped, tupleAction];
};

classBuildMap: ColorOperatorClass ~ NEW[ColorOperatorClassRep _ [
name: "Xerox/BuildMap",
TupleFromPixel: TupleFromPixelBuildMap
]];

NewColorOperatorBuildMap: PUBLIC PROC [colorOperator: ColorOperator,
maxSampleValue: Sample, map: PROC [Sample] RETURNS [Sample]
] RETURNS [ColorOperator] ~ {
data: DataBuildMap ~ NEW[DataBuildMapRep[maxSampleValue+1] _ [
colorOperator: colorOperator, v: 
]];
FOR s0: Sample IN[0..maxSampleValue] DO data.v[s0] _ map[s0] ENDLOOP;
RETURN[NEW[ColorOperatorRep _ [
chromatic: colorOperator.chromatic, samplesPerPixelIn: 1,
class: classBuildMap, data: data
]]];
};


TupleFromPixelRGB: TupleFromPixelProc ~ {
data: DataRGB ~ NARROW[self.data];
tupleRGB: TupleProc ~ {
check: [0..3) ~ i;
value: Sample ~ pixelIn[i];
max: Sample ~ data.maxIn;
RETURN[MIN[value, max]/REAL[max]];
};
tupleY: TupleProc ~ {
check: [0..1) ~ i;
val: RGB ~ [R: tupleRGB[0], G: tupleRGB[1], B: tupleRGB[2]];
RETURN[IntensityFromRGB[val]];
};
SELECT output.type FROM
$RGB => tupleAction[tupleRGB];
$Y => tupleAction[tupleY];
ENDCASE => ERROR;
};

TranslatePixelsRGB: PROC [self: ColorOperator, output: ColorOutput, 
maxIn: PixelProc, maxOut: PixelProc, translateAction: PROC [translate: TranslateProc]] ~ {
data: DataRGB ~ NARROW[self.data];
};

classRGB: ColorOperatorClass ~ NEW[ColorOperatorClassRep _ [
name: "Xerox/Research/RGB",
TupleFromPixel: TupleFromPixelRGB,
TranslatePixels: TranslatePixelsRGB
]];

NewColorOperatorRGB: PUBLIC PROC [maxIn: Sample] RETURNS [ColorOperator] ~ {
data: DataRGB ~ NEW[DataRGBRep _ [maxIn: maxIn]];
RETURN[NEW[ColorOperatorRep _ [
chromatic: TRUE, samplesPerPixelIn: 3,
class: classRGB, data: data
]]];
};


TupleFromPixelColorMap8: TupleFromPixelProc ~ {
data: DataColorMap8 ~ NARROW[self.data];
s0: Sample ~ pixelIn[0];
triple: ColorValueTriple ~ data[s0];
max: ColorValue ~ ColorValue.LAST;
tupleRGB: TupleProc ~ {
value: ColorValue ~ triple[i];
RETURN[REAL[value]/REAL[max]];
};
tupleY: TupleProc ~ {
check: [0..1) ~ i;
val: RGB ~ [R: tupleRGB[0], G: tupleRGB[1], B: tupleRGB[2]];
RETURN[IntensityFromRGB[val]];
};
SELECT output.type FROM
$RGB => tupleAction[tupleRGB];
$Y => tupleAction[tupleY];
ENDCASE => ERROR;
};

classColorMap8: ColorOperatorClass ~ NewColorOperatorClass[
name: "Xerox/Research/ColorMap8",
TupleFromPixel: TupleFromPixelColorMap8,
TranslatePixels: TranslatePixelsTable
];

NewColorOperatorColorMap8: PUBLIC PROC [
map: PROC [ChannelValue] RETURNS [ColorValueTriple]
] RETURNS [ColorOperator] ~ {
data: DataColorMap8 ~ NEW[DataColorMap8Rep];
FOR i: ChannelValue IN ChannelValue DO data[i] _ map[i] ENDLOOP;
RETURN[NEW[ColorOperatorRep _ [
chromatic: TRUE, samplesPerPixelIn: 1,
class: classColorMap8, data: data
]]];
};


TupleFromColor: PUBLIC PROC [self: ConstantColor, output: ColorOutput, 
tupleAction: PROC [tupleOut: TupleProc]] ~ {
pixelIn: PixelProc ~ { RETURN[self.pixel[i]] };
TupleFromPixel[self.colorOperator, output, pixelIn, tupleAction];
};

PixelFromColor: PUBLIC PROC [self: ConstantColor, output: ColorOutput, 
maxOut: PixelProc, pixelAction: PROC [pixelOut: PixelProc]] ~ {
pixelIn: PixelProc ~ { RETURN[self.pixel[i]] };
PixelFromPixel[self.colorOperator, output, pixelIn, maxOut, pixelAction];
};

outputIntensity: ColorOutput _ NIL;
outputRGB: ColorOutput _ NIL;

IntensityFromColor: PUBLIC PROC [self: ConstantColor] RETURNS [Y: REAL _ 0] ~ {
pixelIn: PixelProc ~ { RETURN[self.pixel[i]] };
tupleAction: PROC [tupleOut: TupleProc] ~ { Y _ tupleOut[0] };
TupleFromPixel[self.colorOperator, outputIntensity, pixelIn, tupleAction];
};

RGBFromColor: PUBLIC PROC [self: ConstantColor] RETURNS [rgb: RGB _ [0, 0, 0]] ~ {
pixelIn: PixelProc ~ { RETURN[self.pixel[i]] };
tupleAction: PROC [tupleOut: TupleProc] ~ {
rgb _ [R: tupleOut[0], G: tupleOut[1], B: tupleOut[2]];
};
TupleFromPixel[self.colorOperator, outputRGB, pixelIn, tupleAction];
};


IntensityFromStipple: PROC [word: WORD] RETURNS [REAL] ~ {
nBits: NAT ~ 16;
bits: PACKED ARRAY [0..nBits) OF [0..1] ~ LOOPHOLE[word];
count: NAT _ 0; -- count the number of 1 bits
FOR i: NAT IN[0..nBits) DO count _ count+bits[i] ENDLOOP;
RETURN[REAL[nBits-count]/nBits];
};

ColorFromStipple: PUBLIC PROC [word: WORD, function: Function] RETURNS [SpecialColor] ~ {
data: StippleData ~ NEW[StippleDataRep _ [word: word, function: function]];
RETURN[NEW[ColorRep.special _ [special[type: $Stipple, data: data, substitute: NIL]]]];
};


MakeSampledBlack: PUBLIC PROC [pa: PixelArray, um: Transformation, clear: BOOL _ FALSE] RETURNS [SampledBlack] ~ {
IF pa.samplesPerPixel#1 THEN ERROR;
IF ImagerPixelArray.MaxSampleValue[pa, 0]#1 THEN ERROR;
RETURN[NEW[ColorRep.sampledBlack _ [sampledBlack[pa: pa, um: um, clear: clear]]]];
};

MakeSampledColor: PUBLIC PROC [pa: PixelArray, um: Transformation, colorOperator: ColorOperator] RETURNS [SampledColor] ~ {
RETURN[NEW[ColorRep.sampled _ [sampled[pa: pa, um: um, colorOperator: colorOperator]]]];
};


END.



$ImagerColorImpl.mesa
Copyright c 1984, 1985, 1986 by Xerox Corporation.  All rights reserved.
Stone, June 25, 1985 5:15:17 pm PDT
Michael Plass, August 1, 1985 5:13:38 pm PDT
Doug Wyatt, March 6, 1986 10:18:48 pm PST




We want to find the maximum value of Y such that c.x, c.y, Y is inside of the current RGB gamut.  (x,y,z)*S=(X,Y,Z).  (x,y,z)*S*CIEToRGB=(r,g,b)*S.  We want to find the maximum value for S such that R, G and B <=1.  Find the MAX[r,g,b].  S=1/max.  Y=y*S. 
NOTE: there is no chromaticity value for black (r=g=b=0).  Black is Y=0. 


ensures that v is in [0..1]; raises BoundsFault if not

These algorithms use the hexacone model described in
"Color Gamut Transform Pairs" by Alvy Ray Smith
Siggraph 1978, p. 12.
Algorithms from Foley and van Dam
YIQfromRGB: 
[ 0.30,  0.59,  0.11],
[ 0.60, -0.28, -0.32],
[ 0.21, -0.52,  0.31]

0.3, 0.59, 0.11
0.6, -0.28, -0.32
0.21, -0.52, 0.31
1.0, 0.9482623, 0.6240127
1.0, -0.2760664, -0.6398104
1.0, -1.10545, 1.729858



InitColorTable: PROC ~ {
PutColor[$White, NewGray[0.0]];
PutColor[$RGBWhite, NewRGB[[R: 1, G: 1, B: 1]]];
PutColor[$Black, NewGray[1.0]];
PutColor[$RGBBlack, NewRGB[[R: 0, G: 0, B: 0]]];
PutColor[$Invert, ColorFromStipple[word: WORD.LAST, function: invert]];
PutColor[$Clear, ColorFromStipple[word: 0, function: paint]];
PutColor[$Gray, NewGray[0.5]];
PutColor[$Red, NewRGB[[R: 1, G: 0, B: 0]]];
PutColor[$Green, NewRGB[[R: 0, G: 1, B: 0]]];
PutColor[$Blue, NewRGB[[R: 0, G: 0, B: 1]]];
PutColor[$Cyan, NewRGB[[R: 0, G: 1, B: 1]]];
PutColor[$Magenta, NewRGB[[R: 1, G: 0, B: 1]]];
PutColor[$Yellow, NewRGB[[R: 1, G: 1, B: 0]]];
PutColor[$Pink, NewHSL[[H: 0.0, S: 0.5, L: 0.7]]]; -- ???
PutColor[$Orange, NewHSL[[H: 0.04, S: 0.6, L: 0.4]]];
PutColor[$Brown, NewHSL[[H: 0.08, S: 0.6, L: 0.2]]];
PutColor[$Olive, NewHSL[[H: 0.25, S: 0.6, L: 0.2]]]; -- ???
PutColor[$YellowGreen, NewHSL[[H: 0.25, S: 0.6, L: 0.5]]]; -- ???
PutColor[$Purple, NewHSL[[H: 0.73, S: 0.6, L: 0.4]]];
};

CubeRootFn: PROC [r: REAL] RETURNS [REAL] ~ {
IF r>0.008856 THEN RETURN[RealFns.Root[index: 3, arg: r]]
ELSE RETURN[(903.29*r+16.0)/116.0];
};

LStar: PUBLIC PROC [Y: REAL] RETURNS [REAL] ~ {
RETURN[116.0*CubeRootFn[Y/100]-16.0];
};

LABFromCIE: PUBLIC PROC [val, illum: XYZ] RETURNS [CIELAB] ~ {
fX: REAL ~ CubeRootFn[val.X/illum.X];
fY: REAL ~ CubeRootFn[val.Y/illum.Y];
fZ: REAL ~ CubeRootFn[val.Z/illum.Z];
RETURN[[L: 116*fY-16, a: 500*(fX-fY), b: 200*(fY-fZ)]];
};

CIEFromLAB: PUBLIC PROC [val: CIELAB, illum: XYZ] RETURNS [XYZ] ~ {
fY: REAL ~ (val.L+16)/116;
fX: REAL ~ fY+val.a/500;
fZ: REAL ~ fY-val.b/200;
RETURN[[X: illum.X*(fX*fX*fX), Y: illum.Y*(fY*fY*fY), Z: illum.Z*(fZ*fZ*fZ)]];
};

LUVFromCIE: PUBLIC PROC [val, illum: XYZ] RETURNS [CIELUV] ~ {
den: REAL ~ -2*val.x+12*val.y+3;
uPrime: REAL ~ 4*val.x/den;
vPrime: REAL ~ 9*val.y/den;
RETURN[[L: xxx, u: xxx, v: xxx]];
};

�ʦ˜
codeš
œ™Kšœ
Ïm
œ=™HK™#K™,Kš
œ)™)—K™š
Ïk	˜	Kšœžœ	˜Kš
œ˜Kš
œ˜Kšœžœ)˜?Kš
œ
˜
Kšœžœ˜Kšœžœ	˜Kšœ
žœ˜!Kšžœ
˜—K˜KšÐblœžœ
ž˜KšžœD˜KKšžœ ˜'Kšœžœ
žœ!˜-K™Kšœžœ)˜AKšœžœ
žœ,˜NK˜Kšœžœ)˜AKšœžœ
žœ,˜NK˜šœ%žœ
˜)K˜—šÏnœžœ
žœ
žœ˜?Kšžœ˜K˜K™—š œžœ
žœžœ>žœžœ˜�
Kšžœ
˜K˜K˜—š 
œžœ
žœžœ žœžœžœ˜WKš	œžœ
žœ
žœžœ
˜RKš
œ$˜$Kšžœš
˜ 
K˜K™—š 
œžœ
žœžœ žœžœžœ˜WKš	œžœ
žœ
žœžœ
˜RKš
œ$˜$Kšžœš
˜ 
K˜K˜—š œžœ
žœ1žœžœžœ˜`Jš
œÿ
™ÿ
Jš
œI™IJšœžœ$˜,Jšœžœ ˜(Jšœžœžœ
žœ˜)Jšœ
Ïc.˜;K˜K™—š
 œžœ
žœžœžœ˜DKšœžœ˜Kšžœ˜!K˜K˜—š œžœ
žœžœžœžœ˜MKšœžœ	˜Kšžœ-˜3K˜K˜—K™
procš œžœžœžœ
žœžœ˜/Lšžœžœžœ
žœžœ
žœ˜ALš
œ˜Lš¡$Ïi¡™6—L™Lš
œ4™4Lš
œ/™/Lš
œ™Lš
œ!™!K˜š 
œžœ
žœžœžœžœ˜4Lšœžœ
˜$Lšœžœ˜Lšœžœ˜Lšœžœ˜Lšœžœžœ˜Lšœžœžœ˜L˜Lšžœ	žœ
žœ¡˜'L˜Lšœžœ
žœžœ˜8L˜L˜L˜Lšžœžœ¡˜8Lšžœ
žœ
žœ
¡˜>Lšžœ
žœžœ
¡˜>Lšžœ
žœ4˜>L˜
Lšžœžœ	˜Lšžœ˜K˜K˜—š 
œžœ
žœžœžœžœ˜4Lšœ*žœ
˜/š
 œžœžœžœžœ˜0Lšžœ
žœ
˜Lšžœžœ
˜šœžœ
žœ
ž˜Lšœžœ˜"Lšœžœ˜Lšœžœ&˜+Lšžœ˜—L˜—Lšžœ	žœ
žœ˜.L˜L˜Lš
œ˜šœžœ˜Lšžœ˜Lšžœ+˜/—L˜L˜L˜L˜Kšžœ˜K˜—K˜š 
œžœ
žœžœžœžœ˜4Lšœžœ˜Lšœžœ
˜Lš
œ;˜;Lšœžœ
žœ¡˜)Lšœ
žœ
žœ	¡˜0Lšžœžœ˜Lšžœ˜Lšžœžœ
žœ¡˜$Lš
œ˜Lš
œ˜Lš
œ˜Lšžœžœ˜Lšžœ
žœžœ
˜Lšžœ
žœžœ˜Lš
œ˜Lšžœžœ˜Lšžœ˜K˜K˜—š 
œžœ
žœžœžœžœ˜4Lšœžœ
˜Lšœžœ
˜Lšœžœ
˜Lšžœ	žœ	žœ
žœ˜9Lš
œ˜Lš
œ˜Lš
œ˜Lš
œ˜Lšœ¡
˜$Lšœ¡˜!Lšžœžœ
˜Lš
œ˜Lš
œ ˜ Lš
œ$˜$šžœž˜Lšœžœ˜Lšœžœ˜Lšœžœ˜Lšœžœ˜Lšœžœ˜Lšœžœ˜Lšžœžœ
˜—K˜—K˜š
œ™Kš
Ïf™Kš
£™Kš
£™K™—š 
œžœ
žœžœžœžœ˜4K™K™K™šžœ˜Kš
œ$˜$Kš
œ$˜$Kš
œ#˜#Kš
œ˜—K˜K˜—š 
œžœ
žœžœžœžœ˜4K™K™K™šžœ˜K˜-K˜-K˜)Kš
œ˜—K˜—K˜š
 œžœžœžœžœ˜4Kšžœžœ
žœ˜Kšžœžœ
žœ˜Kšžœ˜K˜K˜—š
 œžœžœžœžœ˜4Kšœžœ$˜+Kšžœžœ
žœ˜Kšžœžœ
žœ˜Kšžœ˜
K˜K˜—K˜K˜š œžœ
žœ)žœ˜VKšœžœ˜#KšœžœE˜_Kš
žœžœ
žœ
žœžœ
˜<Kšžœ˜K˜K™—š œžœ
žœNžœ˜ˆ
K˜'Kš
œ9˜9K˜K˜—š œžœ
žœažœ˜›
K˜'šœ
žœ˜+Kšœžœ&˜DKš
œ˜K˜—Kš
œ9˜9K˜K˜—š œžœ
žœcžœ ˜£
K˜'šžœžœ
žœ˜#˜ Kšœžœ˜4šžœžœ
žœž˜$Kšœžœ˜0šœžœ˜.šžœžœ
žœž˜'Kš
œ˜Kšžœ
˜—K˜—Kš
œ>˜>Kšžœ
˜—K˜—Kš
œ˜K˜
—KšžœE˜IK˜K˜—š 	œžœ
žœOžœ˜{Kšœžœžœžœ˜4Kšœžœ˜,Kšœžœ˜4Kšœžœ˜4Kš
œJ˜Jšœžœ˜4Kš
œT˜TKš
œV˜Všžœžœ
žœž˜K˜+Kš
œ4˜4Kš
œ3˜3Kšžœ
˜—Kš
œ-˜-Kš
œ,˜,K˜—Kš
œ>˜>Kšžœ˜K˜K˜—K˜š
 œžœ
žœ	žœOžœ˜ž
šœžœ%˜DKš
œC˜C—Kšžœ˜K˜K˜—K˜š œžœcžœ ˜¡
K˜Kšœžœ˜4Kš
œT˜Tšœ žœ˜)Kšœžœ˜šžœžœ
žœž˜'Kš
œ&˜&K˜(K˜&Kšœžœ
žœ
žœO˜iKšœžœ
žœ
žœP˜kšžœž˜K˜+K˜+K˜+K˜+K˜+K˜+K˜+K˜+K˜3Kšžœ
˜—šžœžœž˜K˜+K˜3Kšžœ
˜—Kšžœ
˜—K˜—šžœžœž˜Kšœ*žœ˜7šœžœ˜.Kš
žœžœ
žœžœžœ
˜KK˜—K˜>Kšžœ
˜—K˜ Kš
œ)˜)K˜K˜—˜K™—š	œžœžœ
žœžœ˜5K˜—š œžœžœžœ˜QKšžœžœ
žœ
žœ
˜šžœ˜Kšœžœ˜-Kšžœžœ
žœžœ
˜6Kšžœ˜K˜—K˜K˜—K˜š
œ<˜<K˜Kš
œ)˜)K˜%Kš
œ˜K˜—š œ˜0Kšœžœ˜)Kš
œ˜Kš
œžœžœ
žœ
žœ
žœžœ˜:Kšœžœ-˜4Kšœžœžœžœžœ
žœžœžœ˜6Kšœžœ˜$K˜K˜K˜—š œžœ
žœžœCžœžœ˜¡
šœžœ˜0Kš
œ ˜ Kš
œ5˜5Kš
œ˜—šžœ
žœ˜Kšœžœ˜'Kš
œ"˜"Kš
œ˜—K˜K˜—K˜š
œ=˜=K˜Kš
œ*˜*K˜%Kš
œ˜K˜—š œ˜1Kšœžœ˜*Kš
œ˜Kš
œžœžœ
žœ
žœ
žœžœ˜:Kšœžœ;˜BKšœžœ)˜0Kšœžœžœžœžœ
žœžœžœ˜6Kšœžœ˜$K˜K˜K˜—š œžœ
žœžœCžœžœ˜ª
šœžœ˜2Kš
œ/˜/Kš
œ5˜5Kš
œ˜—šžœ
žœ˜Kšœžœ˜'Kš
œ#˜#Kš
œ˜—K˜K˜—K™š
œ<˜<K˜Kš
œ)˜)Kš
œ%˜%Kš
œ˜K˜—š œ˜0Kšœžœ˜)Kš
œ˜Kš
œžœžœ
žœ
žœ
žœžœ˜:Kšœžœ-˜4Kš	œžœžœ	žœžœ1˜VKšœžœ˜Kšœžœžœžœžœ
žœžœžœ˜6Kšœžœ˜$K˜K˜K˜—š œžœ
žœžœCžœžœ˜¡
šœžœ˜0Kš
œ ˜ Kš
œ5˜5Kš
œ˜—šžœ
žœ˜Kšœžœ˜'Kš
œ"˜"Kš
œ˜—K˜K˜—K˜š
œ5˜5K˜Kš
œ"˜"Kš
œ%˜%Kš
œ˜K˜—š œ˜)Kšœžœ˜"K˜(K˜+K˜K˜—š œžœ
žœ žœ
žœžœ˜ƒ
Kšœžœ'˜:Kšœžœžœ
˜šžœžœž˜'K˜Kš
œ˜Kšœžœ˜7Kšžœ
˜—šžœ
žœ˜Kš
œ+˜+Kš
œ˜Kš
œ˜—K˜K˜—K˜š œ˜.Kšœžœ˜'KšœGžœ
˜ZK˜EK˜K˜—šœ$žœ˜AK˜Kš
œ&˜&Kš
œ˜K˜—š œžœ
žœ=žœ
žœžœ˜ž
šœžœ&˜>Kš
œ!˜!Kš
œ˜—Kšžœžœžœžœ
˜Ešžœ
žœ˜Kš
œ9˜9Kš
œ ˜ Kš
œ˜—K˜K˜—K˜š œ˜)Kšœžœ˜"š
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšžœ
žœ
žœ˜"Kš
œ˜—š
œ˜Kš
œ˜Kšœžœ4˜<Kšžœ˜Kš
œ˜—šžœ
ž˜Kš
œ˜Kš
œ˜Kšžœžœ
˜—K˜K˜—š œžœcžœ ˜Ÿ
Kšœžœ˜"K˜K˜—šœžœ˜<Kš
œ˜Kš
œ"˜"Kš
œ#˜#Kš
œ˜K˜—š œžœ
žœžœ˜LKšœžœ˜1šžœ
žœ˜Kšœžœ˜&Kš
œ˜Kš
œ˜—K˜K˜—K˜š œ˜/Kšœžœ˜(Kš
œ˜Kš
œ$˜$Kšœžœ
˜"š
œ˜Kš
œ˜Kšžœ
žœžœ˜Kš
œ˜—š
œ˜Kš
œ˜Kšœžœ4˜<Kšžœ˜Kš
œ˜—šžœ
ž˜Kš
œ˜Kš
œ˜Kšžœžœ
˜—K˜K˜—š
œ;˜;Kš
œ!˜!Kš
œ(˜(Kš
œ%˜%Kš
œ˜K˜—š œžœ
žœžœžœžœ˜zKšœžœ˜,Kšžœžœžœžœ
˜@šžœ
žœ˜Kšœžœ˜&Kš
œ!˜!Kš
œ˜—K˜K˜—K˜š œžœ
žœ:žœ˜tKšœžœ˜/Kš
œA˜AK˜K˜—š œžœ
žœMžœ˜‡
Kšœžœ˜/Kš
œI˜IK˜K˜—Kšœžœ
˜#Kšœžœ
˜K˜š
 œžœ
žœžœžœ	˜OKšœžœ˜/Kšœ
žœ-˜>Kš
œJ˜JK˜K˜—š
 œžœ
žœžœžœ˜RKšœžœ˜/šœ
žœ˜+Kš
œ7˜7Kš
œ˜—Kš
œD˜DK˜K˜—K˜š
 œžœžœžœžœ˜:Kšœžœ˜Kš	œžœ
žœžœ
žœ˜9Kšœžœ¡˜-Kš
žœžœ
žœžœžœ
˜9Kšžœ
žœ˜ K˜K˜—š
 œžœ
žœžœžœ˜YKšœžœ4˜KKšžœ
žœEžœ˜WK˜K˜—K˜š œžœ
žœ-žœžœžœ˜rKšžœžœ
žœ
˜#Kšžœ*žœ
žœ
˜7Kšžœ
žœH˜RK˜K˜—š œžœ
žœDžœ˜{Kšžœ
žœN˜XK˜K˜—š œžœ™K™Kš
œ0™0Kš
œ™Kš
œ0™0Kšœ)žœ
žœ™GKš
œ=™=Kš
œ™Kš
œ+™+Kš
œ-™-Kš
œ,™,Kš
œ,™,Kš
œ/™/Kš
œ.™.Kšœ3¡™9Kš
œ5™5Kš
œ4™4Kšœ5¡™;Kšœ;¡™AKš
œ5™5K™K™—K˜Kšžœ
˜K˜š
 
œžœžœžœžœ™-Kšžœžœ
žœ ™9Kšžœ
žœ™#K™K™—š œžœ
žœžœžœžœ™/Kšžœ™%K™K™—š 
œžœ
žœžœžœžœ™>Kšœžœ™%Kšœžœ™%Kšœžœ™%Kšžœ1™7K™K™—š 
œžœ
žœžœ	žœžœžœ™CKšœžœ™Kšœžœ™Kšœžœ™KšžœH™NK™K™—š 
œžœ
žœžœžœžœ™>Kšœžœ™ Kšœžœ™Kšœžœ™Kšžœ™!K™K™—L˜K˜—…—Lòp¼