ColorFnsImpl.mesa
Copyright Ó 1984, 1985, 1986, 1987, 1988, 1992 by Xerox Corporation. All rights reserved.
Stone, January 7, 1987 6:46:10 pm PST
Michael Plass, February 17, 1988 11:05:21 pm PST
Maureen Stone, April 28, 1987 2:23:13 pm PDT
Doug Wyatt, April 10, 1992 4:20 pm PDT
Ken Fishkin, September 14, 1992 12:19 pm PDT
DIRECTORY
ColorFns,
Imager,
ImagerColor,
ImagerColorPrivate,
ImagerError,
ImagerPixel,
Real USING [Fix],
RealFns;
ColorFnsImpl: CEDAR PROGRAM
IMPORTS
Real, RealFns
EXPORTS ColorFns
~ BEGIN OPEN ColorFns;
Representation conversions
ToRange: PROC [v: REAL] RETURNS [REAL] = INLINE {
RETURN[IF v<0 THEN 0 ELSE IF v>1 THEN 1 ELSE v];
};
ensures that v is in [0..1]
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
IntensityFromRGB: PROC [val: RGB] RETURNS [REAL] ~ {
Y: REAL ~ 0.30*val.R+0.59*val.G+0.11*val.B;
RETURN [ToRange[Y]];
};
Invalid: PUBLIC ERROR ~ CODE;
HSLFromRGB: PUBLIC PROC [val: RGB] RETURNS [HSL] ~ {
red: REAL ~ ToRange[val.R];
green: REAL ~ ToRange[val.G];
blue: REAL ~ ToRange[val.B];
max: REAL ~ MAX[red, green, blue];
min: REAL ~ MIN[red, green, blue];
lightness: REAL ~ (max+min)/2;
del: REAL ~ max-min;
IF del = 0
THEN RETURN[[0, 0, lightness]] --gray
ELSE {
saturation: REAL ~ IF lightness <= 0.5 THEN del/(max+min) ELSE del/(2-max-min);
rc: REAL ~ (max-red)/del;
gc: REAL ~ (max-green)/del;
bc: REAL ~ (max-blue)/del;
hue: REAL ¬ (
SELECT max FROM
red => bc-gc, --between yellow and magenta
green => 2+rc-bc, --between cyan and yellow
blue => 4+gc-rc, --between magenta and cyan
ENDCASE => ERROR Invalid
)/6.0;
IF hue < 0 THEN hue ¬ hue+1;
RETURN[[hue, saturation, lightness]];
};
};
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: REAL ~ ToRange[val.R];
g: REAL ~ ToRange[val.G];
b: REAL ~ ToRange[val.B];
min: REAL ~ MIN[r, g, b]; -- amount of white
max: REAL ~ MAX[r, g, b]; -- maximum "brightness"
value: REAL ~ max;
saturation: REAL ~ IF max#0 THEN (max-min)/max ELSE 0;
IF saturation = 0
THEN RETURN[[0, 0, value]] --gray
ELSE {
rc: REAL ~ (max - r)/(max - min);
gc: REAL ~ (max - g)/(max - min);
bc: REAL ~ (max - b)/(max - min);
hue: REAL ¬ (SELECT max FROM
r => bc-gc,
g => 2+rc-bc,
b => 4+gc-rc,
ENDCASE => ERROR)/6.0;
IF hue<0 THEN hue ¬ hue + 1;
RETURN[[hue, saturation, value]];
};
};
RGBFromHSV: PUBLIC PROC [val: HSV] RETURNS [RGB] ~ {
hue, saturation, value: REAL;
ihue: INT;
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.Fix[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] ~ {
0.3, 0.59, 0.11
0.6, -0.28, -0.32
0.21, -0.52, 0.31
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] ~ {
1.0, 0.9482623, 0.6240127
1.0, -0.2760664, -0.6398104
1.0, -1.10545, 1.729858
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
]];
};
RGBFromYES: PUBLIC PROC[val: YES] RETURNS[RGB] = {
Previous values were:
1.0, 1.422, 0.124
1.0, -0.578, 0.124
1.0, 0.422, -1.876
New values from Rob Buckley, December 6, 1988:
RETURN[[
R: 1.0*val.Y+1.432*val.E+0.125*val.S,
G: 1.0*val.Y-0.568*val.E+0.125*val.S,
B: 1.0*val.Y+0.432*val.E-1.875*val.S
]];
};
YESFromRGB: PUBLIC PROC[val: RGB] RETURNS[YES] = {
Previous values were:
0.258, 0.680, 0.062
0.5, -0.5, 0
0.25, 0.25, -0.5
New values from Rob Buckley, December 6, 1988:
RETURN[[
Y: 0.253*val.R+0.684*val.G+0.063*val.B,
E: 0.5*val.R-0.5*val.G,
S: 0.25*val.R+0.25*val.G-0.5*val.B
]];
};
Simplest implementation produces R=1-C, G=1-M, B=1-Y.
CMYFromRGB: PUBLIC PROC [val: RGB] RETURNS [CMY] = {
RETURN[[C: 1-val.R, M: 1-val.G, Y: 1-val.B]];
};
RGBFromCMY: PUBLIC PROC [val: CMY] RETURNS [RGB] = {
RETURN[[R: 1-val.C, G: 1-val.M, B: 1-val.Y]];
};
RGBFromCMYK: PROC [val: CMYK] RETURNS [RGB] = {
This uses a simple-minded algorithm for approximating the effect of the black printer
darken: REAL ~ 1-val.K;
R: REAL ~ (1-val.C)*darken;
G: REAL ~ (1-val.M)*darken;
B: REAL ~ (1-val.Y)*darken;
RETURN[[R, G, B]];
};
Printer-Oriented Functions, Density and Dot Area
For ideal Reflectance, or for Transmittance=1-R.
Used for computing density from ideal dot area on halftoned films.
DensityFromReflectance: PUBLIC PROC [r: REAL] RETURNS [REAL] = {
d ← Log[1/R]. Reflectance of 0 will return a density of 5.0 (R=0.001)
Reflectance is percentage [0+..100].
RETURN[IF r=0 THEN 5.0 ELSE RealFns.Log[base: 10, arg: (100.0/r)]];
};
ReflectanceFromDensity: PUBLIC PROC [d: REAL] RETURNS [REAL] = {
Density is positive. To be consistant with procedure above, Density in [0..3]
RETURN[100.0/RealFns.Power[base: 10, exponent: d]];
};
Density measured from halftoned patterns on prints does not follow the equations above.
Here are equations relating density and dot area for reflective prints.
DensityFromDotArea: PUBLIC PROC [area: REAL, solidD: REAL ¬ 1.5, n: REAL ¬ 1.4] RETURNS [density: REAL] = {
area is percentage in [0..100], Density is positive. D = -n*log[1-a(1-10-solidD/n)]
If n=1 then reduces to the Murray-Davis equations.
density ¬ -n*RealFns.Log[
base: 10,
arg: (1-area*(1-RealFns.Power[base: 10, exponent: -solidD/n])/100.0)];
RETURN[density];
};
area is percentage in [0..100], Density is positive. D = -n*log[1-a(1-10-solidD/n)]
If n=1 then reduces to the Murray-Davis equations.
DotAreaFromDensity: PUBLIC PROC [density: REAL, solidD: REAL ¬ 1.5, n: REAL ¬ 1.4] RETURNS [area: REAL] = {
area is percentage in [0..100], Density is positive. Inverse of above
area ¬ 100.0*(1-RealFns.Power[base: 10, exponent: -density/n])/
(1-RealFns.Power[base: 10, exponent: -solidD/n]);
RETURN[area];
};
area is percentage in [0..100], Density is positive. Inverse of above
Functions involving XYZ and its descendants
Transf: TYPE ~ ARRAY [0 .. 3) OF ARRAY [0 .. 3) OF REAL;
Triple: TYPE ~ RECORD [r, s, t: REAL];
xYZtoXeroxRGB: Transf ← [[2.944, -1.461, -0.457], [-1.095, 2.026, 0.036], [0.078, -0.272, 1.452]];
xYZtoYES: Transf ~ [[0.000, 1.000, 0.000], [2.019, -1.743, -0.246], [0.423, 0.277, -0.831]];
xeroxRGBtoXYZ: Transf ~ [[0.469, 0.357, 0.139], [0.253, 0.684, 0.063], [0.022, 0.109, 0.693]];
xeroxRGBtoYES: Transf ~ [[0.253, 0.684, 0.063], [0.500, -0.500, 0.000], [0.250, 0.250, -0.500]];
yEStoXYZ: Transf ~ [[0.964, 0.528, -0.157], [1.000, 0.000, 0.000], [0.825, 0.269, -1.283]];
yEStoXeroxRGB: Transf ~ [[1.000, 1.432, 0.125], [1.000, -0.568, 0.125], [1.000, 0.432, -1.875]];
The values above are those specified in the Standard. Those below are more precise values published later in document X9000020.
xYZtoXeroxRGB: Transf ←
[[2.943758, -1.460787,  -0.456810],
[-1.094978, 2.025751,  0.036025],
[0.077858,  -0.272368,  1.451821]];
xYZtoYES: Transf ~
[[0.000000, 1.000000,  0.000000],
[2.019368,  -1.743269,  -0.246417],
[0.423266,  0.277425,  -0.831107]];
xeroxRGBtoXYZ: Transf ~
[[0.468682, 0.356608,  0.138620],
[0.252939,  0.684458,  0.062603],
[0.022318,  0.109283,  0.693101]];
xeroxRGBtoYES: Transf ~
[[0.252939, 0.684458,  0.062603],
[0.500000,  -0.500000,  0.000000],
[0.250000,  0.250000,  -0.500000]];
yEStoXYZ: Transf ~
[[0.963910, 0.528019,  -0.156554],
[1.000000,  0.000000,  0.000000],
[0.824702,  0.268909,  -1.282945]];
yEStoXeroxRGB: Transf ~
[[1.000000, 1.431519,  0.125205],
[1.000000,  -0.568481,  0.125205],
[1.000000,  0.431519,  -1.874795]];
xYZtoNTSCRGB: Transf ~ [[1.910, -0.532, -0.288], [-0.985, 2.000, -0.028], [0.058, -0.118, 0.898]];
xYZtoYIQ: Transf ~ [[0.000, 1.000, 0.000], [1.389, -0.827, -0.453], [0.937, -1.194, 0.233]];
nTSCRGBtoXYZ: Transf ~ [[0.607, 0.174, 0.200], [0.299, 0.587, 0.114], [0.000, 0.066, 1.116]];
nTSCRGBtoYIQ: Transf ~ [[0.299, 0.587, 0.114], [0.596, -0.274, -0.322], [0.211, -0.523, 0.311]];
yIQtoXYZ: Transf ~ [[0.981, 0.312, 0.605], [1.000, 0.000, 0.000], [1.182, -1.252, 1.857]];
yIQtoNTSCRGB: Transf ~ [[1.000, 0.956, 0.621], [1.000, -0.272, -0.649], [1.000, -1.106, 1.703]];
yEStoNTSCRGB: Transf ~ [[1.000, 0.816, 0.029], [1.000, -0.538, 0.219], [1.000, 0.409, -1.769]];
yEStoYIQ: Transf ~ [[1.000, -0.025, -0.065], [0.000, 0.502, 0.526], [0.000, 0.581, -0.659]];
nTSCRGBtoYES: Transf ~ [[0.343, 0.579, 0.077], [0.791, -0.715, -0.076], [0.377, 0.162, -0.539]];
yIQtoYES: Transf ~ [[1.000, 0.085, -0.031], [0.000, 1.035, 0.826], [0.000, 0.913, -0.789]];
d65ToD50, yesD65ToD50: Transf;
referenceWhite: XYZ ← [0.963910, 1.000000, 0.824702];
maxLuminance: REAL ← 1.0;
Transform: PROC [t: Transf, v: Triple] RETURNS [Triple] ~ BEGIN
Fast inline version for internal use. See below for exported version with type checking.
RETURN [[t[0][0]*v.r + t[0][1]*v.s + t[0][2]*v.t,
t[1][0]*v.r + t[1][1]*v.s + t[1][2]*v.t,
t[2][0]*v.r + t[2][1]*v.s + t[2][2]*v.t]]
END; -- Transform
Multiply: PROC [a, b: Transf] RETURNS [Transf] ~ BEGIN
Fast inline version for internal use. See below for exported version with type checking.
RETURN [[[a[0][0]*b[0][0] + a[0][1]*b[1][0] + a[0][2]*b[2][0],
a[0][0]*b[0][1] + a[0][1]*b[1][1] + a[0][2]*b[2][1],
a[0][0]*b[0][2] + a[0][1]*b[1][2] + a[0][2]*b[2][2]],

[a[1][0]*b[0][0] + a[1][1]*b[1][0] + a[1][2]*b[2][0],
a[1][0]*b[0][1] + a[1][1]*b[1][1] + a[1][2]*b[2][1],
a[1][0]*b[0][2] + a[1][1]*b[1][2] + a[1][2]*b[2][2]],

[a[2][0]*b[0][0] + a[2][1]*b[1][0] + a[2][2]*b[2][0],
a[2][0]*b[0][1] + a[2][1]*b[1][1] + a[2][2]*b[2][1],
a[2][0]*b[0][2] + a[2][1]*b[1][2] + a[2][2]*b[2][2]]]]
END; -- Multiply
D65toD50: PROC RETURNS [Transf] ~ BEGIN
Correcting transformation from D65 to D50.
D65ToRgb: PROC RETURNS [d65: Transf] ~ BEGIN
Normalizing transformation from tristimulus measured under D65 to RGB.
d65[0][0] ← 3.508; d65[0][1] ← -1.741; d65[0][2] ← -0.544;
d65[1][0] ← -1.069; d65[1][1] ← 1.977; d65[1][2] ← 0.035;
d65[2][0] ← 0.056; d65[2][1] ← -0.197; d65[2][2] ← 1.051
END; -- D65ToRgb
RgbToD50: PROC RETURNS [d50: Transf] ~ BEGIN
Inverse transformation from tristimulus measured under D50 to RGB.
d50[0][0] ← 0.469; d50[0][1] ← 0.357; d50[0][2] ← 0.139;
d50[1][0] ← 0.253; d50[1][1] ← 0.684; d50[1][2] ← 0.063;
d50[2][0] ← 0.022; d50[2][1] ← 0.109; d50[2][2] ← 0.693
END; -- RgbToD65
RETURN [Multiply [RgbToD50[], D65ToRgb[]]]
END; -- D65toD50
IlluminantChange: PUBLIC PROC [xyz65: XYZ] RETURNS [XYZ] ~ BEGIN
Illuminant correction from D65 to D50 for a tristimulus.
RETURN [LOOPHOLE [Transform [d65ToD50, LOOPHOLE [xyz65]]]];
END; -- IlluminantChange
YesIlluminantChange: PUBLIC PROC [yes65: YES] RETURNS [YES] ~ BEGIN
Illuminant correction from D65 to D50 for a YES color.
RETURN [LOOPHOLE [Transform [yesD65ToD50, LOOPHOLE [yes65]]]];
END; -- YesIlluminantChange
XeroxRGBFromXYZ: PUBLIC PROC [xyz: XYZ] RETURNS [rgb: RGB] ~ BEGIN
rgb ← LOOPHOLE [Transform [xYZtoXeroxRGB, LOOPHOLE [xyz]]];
END;
XeroxRGBFromYES: PUBLIC PROC [yes: YES] RETURNS [rgb: RGB] ~ BEGIN
rgb ← LOOPHOLE [Transform [yEStoXeroxRGB, LOOPHOLE [yes]]];
END;
YESFromXYZ: PUBLIC PROC [xyz: XYZ] RETURNS [yes: YES] ~ BEGIN
yes ← LOOPHOLE [Transform [xYZtoYES, LOOPHOLE [xyz]]];
END;
YESFromXeroxRGB: PUBLIC PROC [rgb: RGB] RETURNS [yes: YES] ~ BEGIN
yes ← LOOPHOLE [Transform [xeroxRGBtoYES, LOOPHOLE [rgb]]];
END;
XYZFromXeroxRGB: PUBLIC PROC [rgb: RGB] RETURNS [xyz: XYZ] ~ BEGIN
xyz ← LOOPHOLE [Transform [xeroxRGBtoXYZ, LOOPHOLE [rgb]]]
END;
XYZFromYES: PUBLIC PROC [yes: YES] RETURNS [xyz: XYZ] ~ BEGIN
xyz ← LOOPHOLE [Transform [yEStoXYZ, LOOPHOLE [yes]]];
END;
NTSCRGBFromXYZ: PUBLIC PROC [xyz: XYZ] RETURNS [rgb: RGB] ~ BEGIN
rgb ← LOOPHOLE [Transform [xYZtoNTSCRGB, LOOPHOLE [xyz]]];
END;
NTSCRGBFromYIQ: PUBLIC PROC [yiq: YIQ] RETURNS [rgb: RGB] ~ BEGIN
rgb ← LOOPHOLE [Transform [yIQtoNTSCRGB, LOOPHOLE [yiq]]];
END;
YIQFromXYZ: PUBLIC PROC [xyz: XYZ] RETURNS [yiq: YIQ] ~ BEGIN
yiq ← LOOPHOLE [Transform [xYZtoYIQ, LOOPHOLE [xyz]]];
END;
YIQFromNTSCRGB: PUBLIC PROC [rgb: RGB] RETURNS [yiq: YIQ] ~ BEGIN
yiq ← LOOPHOLE [Transform [nTSCRGBtoYIQ, LOOPHOLE [rgb]]];
END;
XYZFromNTSCRGB: PUBLIC PROC [rgb: RGB] RETURNS [xyz: XYZ] ~ BEGIN
xyz ← LOOPHOLE [Transform [nTSCRGBtoXYZ, LOOPHOLE [rgb]]];
END;
XYZFromYIQ: PUBLIC PROC [yiq: YIQ] RETURNS [xyz: XYZ] ~ BEGIN
xyz ← LOOPHOLE [Transform [yIQtoXYZ, LOOPHOLE [yiq]]];
END;
NTSCRGBFromYES: PUBLIC PROC [yes: YES] RETURNS [rgb: RGB] ~ BEGIN
rgb ← LOOPHOLE [Transform [yEStoNTSCRGB, LOOPHOLE [yes]]];
END;
YIQFromYES: PUBLIC PROC [yes: YES] RETURNS [yiq: YIQ] ~ BEGIN
yiq ← LOOPHOLE [Transform [yEStoYIQ, LOOPHOLE [yes]]];
END;
YESFromNTSCRGB: PUBLIC PROC [rgb: RGB] RETURNS [yes: YES] ~ BEGIN
yes ← LOOPHOLE [Transform [nTSCRGBtoYES, LOOPHOLE [rgb]]];
END;
YESFromYIQ: PUBLIC PROC [yiq: YIQ] RETURNS [yes: YES] ~ BEGIN
yes ← LOOPHOLE [Transform [yIQtoYES, LOOPHOLE [yiq]]];
END;
CIELABFromXYZ: PUBLIC PROC [xyz, white: XYZ] RETURNS [CIELAB] ~ BEGIN
fy: REAL;
IF (white.Y = 0) THEN white ← [referenceWhite.X * maxLuminance, maxLuminance, referenceWhite.Z * maxLuminance];
fy ← F [xyz.Y / white.Y];
RETURN [[Lightness [xyz.Y, white.Y], (500.0*(F[xyz.X/white.X]-fy)), (200.0*(fy-F[xyz.Z/white.Z]))]];
END; -- CIELABFromXYZ
XYZFromCIELAB: PUBLIC PROC [lab: CIELAB, white: XYZ] RETURNS [XYZ] ~ BEGIN
xyz: XYZ; fY: REAL ~ (lab.lStar + 16.0) / 116.0;
x: REAL ~ lab.aStar / 500.0 + fY; z: REAL ~ -lab.bStar / 200.0 + fY;
IF (white.Y = 0) THEN white ← [referenceWhite.X * maxLuminance, maxLuminance, referenceWhite.Z * maxLuminance];
xyz.Y ← Luminance [lab.lStar, white.Y];
IF (lab.lStar > 7.999554) THEN {xyz.X ← white.X * x*x*x; xyz.Z ← white.Z * z*z*z}
ELSE {xyz.X ← white.X/7.787*(x-16.0/116.0); xyz.Z ← white.Z/7.787*(z-16.0/116.0)};
RETURN [xyz]
END; -- CIELABFromXYZ
NormXYZFromCIELAB: PROC [lab: CIELAB] RETURNS [XYZ] ~ BEGIN
white: XYZ ~ referenceWhite;
xyz: XYZ; fY: REAL ~ (lab.lStar + 16.0) / 116.0;
x: REAL ~ lab.aStar / 500.0 + fY; z: REAL ~ -lab.bStar / 200.0 + fY;
xyz.Y ← NormLuminance [lab.lStar];
IF (lab.lStar > 7.999554) THEN {xyz.X ← white.X * x*x*x; xyz.Z ← white.Z * z*z*z}
ELSE {xyz.X ← white.X/7.787*(x-16.0/116.0); xyz.Z ← white.Z/7.787*(z-16.0/116.0)};
RETURN [xyz]
END; -- NormXYZFromCIELAB
F: PROC [t: REAL] RETURNS [REAL] ~ BEGIN
RETURN [IF t > 0.008856 THEN RealFns.Power [t, 1.0/3.0] ELSE 7.787*t + (16.0/116.0)]
END; -- F
Lightness: PUBLIC PROC [Y, whiteY: REAL] RETURNS [REAL] ~ BEGIN
Returns L* from luminance Y.
t: REAL;
IF (whiteY = 0) THEN whiteY ← maxLuminance;
t ← Y / whiteY;
IF (t <= 0.008856) THEN RETURN [903.292 * t]
ELSE RETURN [116.0 * F[t] - 16.0]
END; -- Lightness
Luminance: PUBLIC PROC [lStar, whiteY: REAL] RETURNS [REAL] ~ BEGIN
Returns luminance Y from L*. 903.292 * 0.008856 = 7.999554.
IF (whiteY = 0) THEN whiteY ← maxLuminance;
IF (lStar <= 7.999554) THEN RETURN [whiteY*lStar/903.292]
ELSE {p: REAL ~ (lStar+16.0)/116.0; RETURN [p*p*p * whiteY]}
END; -- Luminance
NormLuminance: PROC [lStar: REAL] RETURNS [REAL] ~ BEGIN
Returns normalized luminance 0 d Y d 1 from L*. 903.292 * 0.008856 = 7.999554.
IF (lStar <= 7.999554) THEN RETURN [lStar/903.292]
ELSE {p: REAL ~ (lStar+16.0)/116.0; RETURN [p*p*p]}
END; -- NormLuminance
MetricChromaticity: TYPE ~ RECORD [uPrime, vPrime: REAL];
UVFromXYZ: PROC [xyz: XYZ] RETURNS [MetricChromaticity] ~ BEGIN
u' = 4X / (X + 15Y + 3Z) and v' = 9Y / (X + 15Y + 3Z)
norm: REAL ~ 1.0 / (xyz.X + 15*xyz.Y + 3*xyz.Z);
RETURN [[4 * xyz.X * norm, 9 * xyz.Y * norm]]
END; -- UVFromXYZ
CIELUVFromXYZ: PUBLIC PROC [xyz, white: XYZ] RETURNS [CIELUV] ~ BEGIN
luv: CIELUV; whiteChr, uv: MetricChromaticity;
IF (white.Y = 0) THEN white ← [referenceWhite.X * maxLuminance, maxLuminance, referenceWhite.Z * maxLuminance];
whiteChr ← UVFromXYZ [white];
uv ← IF (xyz.X + 15*xyz.Y + 3*xyz.Z > 0) THEN UVFromXYZ [xyz] ELSE whiteChr;
luv.lStar ← Lightness [xyz.Y, white.Y];
luv.uStar ← 13 * luv.lStar * (uv.uPrime - whiteChr.uPrime);
luv.vStar ← 13 * luv.lStar * (uv.vPrime - whiteChr.vPrime);
RETURN [luv]
END;
XYZFromCIELUV: PUBLIC PROC [luv: CIELUV, white: XYZ] RETURNS [XYZ] ~ BEGIN
whiteChr, uv: MetricChromaticity; chr: Yxy; norm: REAL;
IF (white.Y = 0) THEN white ← [referenceWhite.X * maxLuminance, maxLuminance, referenceWhite.Z * maxLuminance];
whiteChr ← UVFromXYZ [white];
uv ← [luv.uStar/(13*luv.lStar)+whiteChr.uPrime, luv.vStar/(13*luv.lStar)+whiteChr.vPrime];
chr.Y ← Luminance [luv.lStar, white.Y]; norm ← 1.0 / (18*uv.uPrime - 48*uv.vPrime + 36);
chr.x ← 27 * uv.uPrime * norm; chr.y ← 12 * uv.vPrime * norm;
RETURN [Tristimulus [chr]]
END; -- CIELUVFromXYZ
 
Colorimetry Utilities
Tristimulus: PUBLIC PROC [yxy: Yxy] RETURNS [xyz: XYZ] ~ BEGIN
Converts from the CIE 1931 Yxy color system to tristimuls values.
IF (yxy.y = 0) THEN RETURN [[0, 0, 0]];
xyz.X ← yxy.Y * (yxy.x / yxy.y); xyz.Y ← yxy.Y;
xyz.Z ← yxy.Y * (1.0 - yxy.x - yxy.y) / yxy.y
END; -- Tristimulus
ABDifference: PUBLIC PROC [c1, c2: CIELAB] RETURNS [REAL] ~ BEGIN
CIE 1976 color stimulus difference.
d: RECORD [r, s, t: REAL] ~ [(c1.lStar - c2.lStar), (c1.aStar - c2.aStar), ( c1.bStar - c2.bStar)];
RETURN [RealFns.SqRt [d.r*d.r + d.s*d.s + d.t*d.t]]
END; -- ABDifference
CMCDifference: PUBLIC PROC [c1, c2: CIELAB] RETURNS [REAL] ~ BEGIN
CMC(l:c) color stimulus difference. Uses a formula which has been shown to give a better correlation for small color differences in the colorant industries. The relative weightings of the contributions of the differences in L*, C*ab, H*ab, are varied according to the position of the color in the CIELAB space.
cStar: REAL ~ ABChroma [c1]; -- difference is small, so c1 or c2 does not matter
hStar: REAL ~ ABHueAngle [c1]; -- difference is small, so c1 or c2 does not matter
f, t, sl, sc, sh: REAL; cStar4: REAL ~ RealFns.Power [cStar, 4]; d: RECORD [l, c, h: REAL];
t ← IF (hStar > 164) AND (hStar < 345) THEN 0.56 + ABS [0.2 * RealFns.CosDeg [hStar + 168]]
ELSE 0.36 + ABS [0.4 * RealFns.CosDeg [hStar + 35]];
f ← RealFns.SqRt [cStar4 / (cStar4 + 1900)];
sl ← IF (c1.lStar < 16) THEN 0.511 ELSE 0.040975 * c1.lStar / (1.0 + 0.01765 * c1.lStar);
sc ← 0.0638 * cStar / (1.0 + 0.0131 * cStar) + 0.638;
sh ← (f * t + 1 - f ) * sc;
d ← [(c1.lStar - c2.lStar) / sl, (c1.aStar - c2.aStar) / sc, ( c1.bStar - c2.bStar) / sh];
RETURN [RealFns.SqRt [d.l*d.l + d.c*d.c + d.h*d.h]]
END; -- CMCDifference
HCLDifferenceCIELAB: PUBLIC PROC [c1, c2: CIELAB] RETURNS [hue, chroma, lightness: REAL] ~ BEGIN
For compatibility with CalibratedColorFns.
diff: REAL ← ABDifference [c1, c2];
chroma ← ABChroma [c1] - ABChroma [c2]; lightness ← c1.lStar - c2.lStar;
hue ← RealFns.SqRt [diff*diff - lightness*lightness - chroma*chroma];
END; -- HCLDifferenceCIELAB
ABChroma: PUBLIC PROC [c: CIELAB] RETURNS [REAL] ~ BEGIN
CIE 1976 a,b chroma.
RETURN [RealFns.SqRt[c.aStar*c.aStar + c.bStar*c.bStar]]
END; -- ABChroma
ABHueAngle: PUBLIC PROC [c: CIELAB] RETURNS [REAL] ~ BEGIN
CIE 1976 a,b hue-angle.
a: REAL ~ RealFns.ArcTanDeg [y: c.bStar, x: c.aStar];
IF (a < 0) THEN RETURN [360 + a] ELSE RETURN [a]
END; -- ABHueAngle
ABHueDifference: PUBLIC PROC [c1, c2: CIELAB] RETURNS [REAL] ~ BEGIN
CIE 1976 a,b hue-difference.
h1: REAL ~ ABHueAngle [c1]; h2: REAL ~ ABHueAngle [c2];
e: REAL ~ ABDifference [c1, c2];
l: REAL ~ c1.lStar - c2.lStar; c: REAL ~ ABChroma [c1] - ABChroma [c2];
hDiff: REAL ~ RealFns.SqRt [e*e - l*l - c*c];
IF (h2 > h1) THEN RETURN [hDiff] ELSE RETURN [- hDiff]
END; -- ABHueDifference
The following is for convenience of ``cylindrical coordinate clients'' and not part of the Standard.
LabToLch: PUBLIC PROC [lab: CIELAB] RETURNS [LCh] ~ BEGIN
Transforms from cartesian to cylindrical CIELAB coordinates.
RETURN [[lab.lStar, ABChroma [lab], ABHueAngle [lab]]]
END; -- LabToLch
LchToLab: PUBLIC PROC [lch: LCh] RETURNS [CIELAB] ~ BEGIN
Transforms from cartesian to cylindrical CIELAB coordinates.
RETURN [[lch.lStar, lch.cStar * RealFns.CosDeg [lch.hStar], lch.cStar * RealFns.SinDeg [lch.hStar]]]
END; -- LchToLab
UVDifference: PUBLIC PROC [c1, c2: CIELUV] RETURNS [REAL] ~ BEGIN
CIE 1976 color stimulus difference.
d: RECORD [r, s, t: REAL] ~ [(c1.lStar - c2.lStar), (c1.uStar - c2.uStar), (c1.vStar - c2.vStar)];
RETURN [RealFns.SqRt [d.r*d.r + d.s*d.s + d.t*d.t]]
END; -- UVDifference
HCLDifferenceCIELUV: PUBLIC PROC [c1, c2: CIELUV] RETURNS [hue, chroma, lightness: REAL] ~ BEGIN
For compatibility with CalibratedColorFns.
diff: REAL ← UVDifference [c1, c2];
chroma ← UVChroma [c1] - UVChroma [c2]; lightness ← c1.lStar - c2.lStar;
hue ← RealFns.SqRt [diff*diff - lightness*lightness - chroma*chroma];
END; -- HCLDifferenceCIELUV
UVChroma: PUBLIC PROC [c: CIELUV] RETURNS [REAL] ~ BEGIN
CIE 1976 u,v chroma.
RETURN [RealFns.SqRt [c.uStar*c.uStar + c.vStar*c.vStar]]
END; -- UVChroma
UVSaturation: PUBLIC PROC [c: CIELUV] RETURNS [REAL] ~ BEGIN
CIE 1976 u,v chroma.
RETURN [RealFns.SqRt [c.uStar*c.uStar + c.vStar*c.vStar] / c.lStar]
END; -- UVSaturation
UVHueAngle: PUBLIC PROC [c: CIELUV] RETURNS [REAL] ~ BEGIN
CIE 1976 u,v hue-angle.
a: REAL ~ RealFns.ArcTanDeg [y: c.vStar, x: c.uStar];
IF (a < 0) THEN RETURN [360 + a] ELSE RETURN [a]
END; -- UVHueAngle
UVHueDifference: PUBLIC PROC [c1, c2: CIELUV] RETURNS [REAL] ~ BEGIN
CIE 1976 u,v hue-difference.
h1: REAL ~ UVHueAngle [c1]; h2: REAL ~ UVHueAngle [c2];
e: REAL ~ UVDifference [c1, c2];
l: REAL ~ c1.lStar - c2.lStar; c: REAL ~ UVChroma [c1] - UVChroma [c2];
hDiff: REAL ~ RealFns.SqRt [e*e - l*l - c*c];
IF (h2 > h1) THEN RETURN [hDiff] ELSE RETURN [- hDiff]
END; -- UVHueDifference
d65ToD50 ← D65toD50 [];
yesD65ToD50 ← Multiply [Multiply [yEStoXYZ, d65ToD50], xYZtoYES];
END.