ImagerColorImpl.mesa
Copyright © 1984 Xerox Corporation. All rights reserved.
Doug Wyatt, November 3, 1984 3:58:27 pm PST
DIRECTORY
ImagerColor USING [Calibration, CalibrationRep, CIE, ColorOperator, ColorOperatorRep, ColorRep, ConstantColor, HSL, HSV, RGB, SampledColor, SampleMap, SeparationRep, SpecialColor],
ImagerPixelArray USING [PixelArray],
ImagerTransformation USING [Transformation],
Real USING [FixC];
ImagerColorImpl: CEDAR PROGRAM
IMPORTS Real
EXPORTS ImagerColor
~ BEGIN OPEN ImagerColor;
Transformation: TYPE ~ ImagerTransformation.Transformation;
PixelArray: TYPE ~ ImagerPixelArray.PixelArray;
Clip: PROC[r: REAL] RETURNS[REAL] ~ INLINE {
RETURN[IF r<0 THEN 0 ELSE IF r>1 THEN 1 ELSE r]
};
Check: PROC[r: REAL] RETURNS[REAL] ~ INLINE {
RETURN[IF r IN[0..1] THEN r ELSE ERROR]
};
CIEFromIntensity: PUBLIC PROC[intensity: REAL] RETURNS[CIE] ~ {
x: REAL ~ 0.3101; y: REAL ~ 0.3163; -- chromaticity of "standard" white
Y: REAL ~ Check[intensity];
XYZ: REAL ~ Y/y;
RETURN[[XYZ*x, Y, XYZ*(1-x-y)]];
};
IntensityFromCIE: PUBLIC PROC[cie: CIE] RETURNS[REAL] ~ {
RETURN[cie.Y];
};
CIEFromRGB: PUBLIC PROC[rgb: RGB, cal: Calibration ← NIL] RETURNS[CIE] ~ {
c: Calibration ~ IF cal=NIL THEN defaultCal ELSE cal;
r, g, b: REAL; [r, g, b] ← rgb;
RETURN[[
X: c.Xr*r + c.Xg*g + c.Xb*b,
Y: c.Yr*r + c.Yg*g + c.Yb*b,
Z: c.Zr*r + c.Zg*g + c.Zb*b
]];
};
RGBFromCIE: PUBLIC PROC[cie: CIE, cal: Calibration ← NIL] RETURNS[RGB] ~ {
c: Calibration ~ IF cal=NIL THEN defaultCal ELSE cal;
X, Y, Z: REAL; [X, Y, Z] ← cie;
RETURN[[
r: c.rX*X + c.rY*Y + c.rZ*Z,
g: c.gX*X + c.gY*Y + c.gZ*Z,
b: c.bX*X + c.bY*Y + c.bZ*Z
]];
};
These algorithms for HSV and HSL use the hexacone model described in "Color Gamut Transform Pairs" by Alvy Ray Smith, Siggraph 1978, p. 12. Algorithms from Foley and van Dam.
Hue: PROC[rc, gc, bc: REAL] RETURNS[REAL] ~ {
max: REAL ~ MAX[rc, gc, bc];
h: REAL ~ SELECT TRUE FROM
rc=0 => 0+(bc-gc)/max, -- between yellow and magenta
gc=0 => 2+(rc-bc)/max, -- between cyan and yellow
bc=0 => 4+(gc-rc)/max, -- between magenta and cyan
ENDCASE => ERROR;
RETURN[(IF h<0 THEN h+6 ELSE h)/6];
};
HSVFromRGB: PUBLIC PROC[rgb: RGB] RETURNS[HSV] ~ {
r: REAL ~ Check[rgb.r];
g: REAL ~ Check[rgb.g];
b: REAL ~ Check[rgb.b];
min: REAL ~ MIN[r, g, b]; -- amount of white
max: REAL ~ MAX[r, g, b]; -- maximum "brightness"
value: REAL ~ max;
IF max=min THEN RETURN[[h: 0, s: 0, v: value]] -- gray
ELSE {
del: REAL ~ max-min;
hue: REAL ~ Hue[max-r, max-g, max-b];
saturation: REAL ~ del/max;
RETURN[[h: hue, s: saturation, v: value]];
};
};
RGBFromHSV: PUBLIC PROC[hsv: HSV] RETURNS[RGB] ~ {
h: REAL ~ Check[hsv.h];
s: REAL ~ Check[hsv.s];
v: REAL ~ Check[hsv.v];
IF s=0 THEN RETURN[[v, v, v]]
ELSE {
hue: REAL ~ h*6;
ihue: [0..6] ~ Real.FixC[hue]; -- integer hue
fhue: REAL ~ hue-ihue; -- fractional hue
m: REAL ~ v*(1-s);
n: REAL ~ v*(1-(s*fhue));
k: REAL ~ v*(1-(s*(1-fhue)));
SELECT ihue FROM
0, 6 => RETURN[[v,k,m]];
1 => RETURN[[n,v,m]];
2 => RETURN[[m,v,k]];
3 => RETURN[[m,n,v]];
4 => RETURN[[k,m,v]];
5 => RETURN[[v,m,n]];
ENDCASE => ERROR;
};
};
HSLFromRGB: PUBLIC PROC[rgb: RGB] RETURNS[HSL] ~ {
r: REAL ~ Check[rgb.r];
g: REAL ~ Check[rgb.g];
b: REAL ~ Check[rgb.b];
min: REAL ~ MIN[r, g, b];
max: REAL ~ MAX[r, g, b];
lightness: REAL ~ (max+min)/2;
IF max=min THEN RETURN[[h: 0, s: 0, l: lightness]] -- gray
ELSE {
del: REAL ~ max-min;
hue: REAL ~ Hue[max-r, max-g, max-b];
saturation: REAL ~ IF lightness<=0.5 THEN del/(max+min) ELSE del/(2-max-min);
RETURN[[h: hue, s: saturation, l: lightness]];
};
};
RGBFromHSL: PUBLIC PROC[hsl: HSL] RETURNS[RGB] ~ {
h: REAL ~ Check[hsl.h];
s: REAL ~ Check[hsl.s];
lightness: REAL ~ Check[hsl.l];
IF s=0 THEN RETURN[[lightness, lightness, lightness]]
ELSE {
Value: PROC[n1, n2, h: REAL] RETURNS[REAL] = {
h1: REAL ~ IF h<0 THEN h+360 ELSE IF h<360 THEN h ELSE h-360;
SELECT h1 FROM
<60 => RETURN[n1+(n2-n1)*h1/60]; -- IN[0..60)
<180 => RETURN[n2]; -- IN[60..180)
<240 => RETURN[n1+(n2-n1)*(240-h1)/60]; -- IN[180..240)
ENDCASE => RETURN[n1]; -- IN[240..360)
};
hue: REAL ~ 360*h; -- degrees, IN[0..360]
m2: REAL ~ IF lightness<=0.5 THEN lightness*(1+s) ELSE lightness+s-lightness*s;
m1: REAL ~ 2*lightness-m2;
RETURN[[r: Value[m1, m2, hue+120], g: Value[m1, m2, hue], b: Value[m1, m2, hue-120]]];
};
};
Chromaticity: PROC[cie: CIE] RETURNS[x, y: REAL] ~ {
s: REAL ~ cie.X+cie.Y+cie.Z;
RETURN[cie.X/s, cie.Y/s];
};
CreateCalibration: PROC[xr, yr, xg, yg, xb, yb: REAL] RETURNS[Calibration] ~ {
c: Calibration ~ NEW[CalibrationRep];
zr, zg, zb, s, d: REAL;
zr ← 1-(xr+yr); zg ← 1-(xg+yg); zb ← 1-(xb+yb);
s ← yr+yg+yb;
c.Xr ← xr/s; c.Xg ← xg/s; c.Xb ← xb/s;
c.Yr ← yr/s; c.Yg ← yg/s; c.Yb ← yb/s;
c.Zr ← zr/s; c.Zg ← zg/s; c.Zb ← zb/s;
d ←
c.Zr*(c.Xg*c.Yb - c.Xb*c.Yg) +
c.Zg*(c.Xb*c.Yr - c.Xr*c.Yb) +
c.Zb*(c.Xr*c.Yg - c.Xg*c.Yr);
c.rX ← (c.Yg*c.Zb - c.Yb*c.Zg)/d;
c.rY ← (c.Zg*c.Xb - c.Zb*c.Xg)/d;
c.rZ ← (c.Xg*c.Yb - c.Xb*c.Yg)/d;
c.gX ← (c.Yb*c.Zr - c.Yr*c.Zb)/d;
c.gY ← (c.Zb*c.Xr - c.Zr*c.Xb)/d;
c.gZ ← (c.Xb*c.Yr - c.Xr*c.Yb)/d;
c.bX ← (c.Yr*c.Zg - c.Yg*c.Zr)/d;
c.bY ← (c.Zr*c.Xg - c.Zg*c.Xr)/d;
c.bZ ← (c.Xr*c.Yg - c.Xg*c.Yr)/d;
RETURN[c];
};
default CIE coordinates for calibration
longXR: REAL ← 0.6;  longXG: REAL ← 0.22;  longXB: REAL ← 0.23;
longYR: REAL ← 0.325;  longYG: REAL ← 0.62;  longYB: REAL ← 0.2;
normalXR: REAL ← 0.615; normalXG: REAL ← 0.3;  normalXB: REAL ← 0.15; 
normalYR: REAL ← 0.34; normalYG: REAL ← 0.59; normalYB: REAL ← 0.065;
Hitachi's CIE coordinates (from catalog # CE-E500R, Jan. 1982)
HitachiLPxR: REAL ← 0.603; HitachiLPxG: REAL ← 0.220; HitachiLPxB: REAL ← 0.151;
HitachiLPyR: REAL ← 0.327; HitachiLPyG: REAL ← 0.619; HitachiLPyB: REAL ← 0.064;
HitachiNPxR: REAL ← 0.610; HitachiNPxG: REAL ← 0.298; HitachiNPxB: REAL ← 0.151; 
HitachiNPyR: REAL ← 0.342; HitachiNPyG: REAL ← 0.588; HitachiNPyB: REAL ← 0.064;
defaultCal: Calibration ← CreateCalibration[
xr: normalXR, yr: normalYR, xg: normalXG, yg: normalYG, xb: normalXB, yb: normalYB];
Test: PROC[c: Calibration] RETURNS[m11, m12, m13, m21, m22, m23, m31, m32, m33: REAL] ~ {
m11 ← c.rX*c.Xr + c.rY*c.Yr + c.rZ*c.Zr;
m12 ← c.rX*c.Xg + c.rY*c.Yg + c.rZ*c.Zg;
m13 ← c.rX*c.Xb + c.rY*c.Yb + c.rZ*c.Zb;
m21 ← c.gX*c.Xr + c.gY*c.Yr + c.gZ*c.Zr;
m22 ← c.gX*c.Xg + c.gY*c.Yg + c.gZ*c.Zg;
m23 ← c.gX*c.Xb + c.gY*c.Yb + c.gZ*c.Zb;
m31 ← c.bX*c.Xr + c.bY*c.Yr + c.bZ*c.Zr;
m32 ← c.bX*c.Xg + c.bY*c.Yg + c.bZ*c.Zg;
m33 ← c.bX*c.Xb + c.bY*c.Yb + c.bZ*c.Zb;
};
black: PUBLIC ConstantColor ← MakeCIE[CIEFromIntensity[0]];
white: PUBLIC ConstantColor ← MakeCIE[CIEFromIntensity[1]];
XOR: PUBLIC SpecialColor ← NEW[ColorRep[special] ← [special[$XOR]]];
MakeGray: PUBLIC PROC[f: REAL] RETURNS[ConstantColor] ~ {
IF f=1.0 THEN RETURN[black];
IF f=0.0 THEN RETURN[white];
IF f IN[0.0..1.0] THEN RETURN[MakeCIE[CIEFromIntensity[1-f]]];
ERROR;
};
MakeCIE: PUBLIC PROC[cie: CIE] RETURNS[ConstantColor] ~ {
RETURN[NEW[ColorRep.constant ← [constant[cie]]]];
};
MakeSampledBlack: PUBLIC PROC[pa: PixelArray, um: Transformation, clear: BOOL]
RETURNS[SampledColor] ~ {
op: ColorOperator ~ NEW[ColorOperatorRep.black ← [black[clear: clear]]];
RETURN[NEW[ColorRep[sampled] ← [sampled[pa: pa, um: um, colorOperator: op]]]];
};
MakeSampledColor: PUBLIC PROC[pa: PixelArray, um: Transformation, colorOperator: ColorOperator]
RETURNS[SampledColor] ~ {
RETURN[NEW[ColorRep[sampled] ← [sampled[pa: pa, um: um, colorOperator: colorOperator]]]];
};
SampleMap: TYPE ~ ImagerColor.SampleMap;
RGBColorOperator: PROC[sMax: REAL ← 255, sMin: REAL ← 0, map: SampleMap ← NIL,
cal: Calibration ← NIL] RETURNS[ColorOperator] ~ {
c: Calibration ~ IF cal=NIL THEN defaultCal ELSE cal;
op: REF ColorOperatorRep.separations ~ NEW[ColorOperatorRep.separations[3]];
op[0] ← NEW[SeparationRep ← [cie: [c.Xr, c.Yr, c.Zr], sMax: sMax, sMin: sMin, map: map]];
op[1] ← NEW[SeparationRep ← [cie: [c.Xg, c.Yg, c.Zg], sMax: sMax, sMin: sMin, map: map]];
op[2] ← NEW[SeparationRep ← [cie: [c.Xb, c.Yb, c.Zb], sMax: sMax, sMin: sMin, map: map]];
RETURN[op];
};
GrayLinearColorOperator: PROC[sWhite: REAL ← 255, sBlack: REAL ← 0, map: SampleMap ← NIL]
RETURNS[ColorOperator] ~ {
op: REF ColorOperatorRep.grayLinear ~ NEW[ColorOperatorRep.grayLinear ← [
grayLinear[sWhite: sWhite, sBlack: sBlack, map: map]]];
RETURN[op];
};
END.