<<>> <> <> <> <> <> <> <> <<>> DIRECTORY ColorFns, Imager, ImagerColor, ImagerColorPrivate, ImagerError, ImagerPixel, Real USING [Fix], RealFns; ColorFnsImpl: CEDAR PROGRAM IMPORTS Real, RealFns EXPORTS ColorFns ~ BEGIN OPEN ColorFns; <> ToRange: PROC [v: REAL] RETURNS [REAL] = INLINE { RETURN[IF v<0 THEN 0 ELSE IF v>1 THEN 1 ELSE v]; }; <> <<>> <> <<"Color Gamut Transform Pairs" by Alvy Ray Smith>> <> <> 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] = { <> <<1.0, 1.422, 0.124>> <<1.0, -0.578, 0.124>> <<1.0, 0.422, -1.876>> <> 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] = { <> <<0.258, 0.680, 0.062>> <<0.5, -0.5, 0>> <<0.25, 0.25, -0.5>> <> 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 ]]; }; <> 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]]; }; <> <> <> <> <> <> <> <<};>> <> <> <> DensityFromReflectance: PUBLIC PROC [r: REAL] RETURNS [REAL] = { <> <> RETURN[IF r=0 THEN 5.0 ELSE RealFns.Log[base: 10, arg: (100.0/r)]]; }; ReflectanceFromDensity: PUBLIC PROC [d: REAL] RETURNS [REAL] = { <> RETURN[100.0/RealFns.Power[base: 10, exponent: d]]; }; <> <> DensityFromDotArea: PUBLIC PROC [area: REAL, solidD: REAL ¬ 1.5, n: REAL ¬ 1.4] RETURNS [density: REAL] = { <> <> density ¬ -n*RealFns.Log[ base: 10, arg: (1-area*(1-RealFns.Power[base: 10, exponent: -solidD/n])/100.0)]; RETURN[density]; }; <> <> <<>> DotAreaFromDensity: PUBLIC PROC [density: REAL, solidD: REAL ¬ 1.5, n: REAL ¬ 1.4] RETURNS [area: REAL] = { <> area ¬ 100.0*(1-RealFns.Power[base: 10, exponent: -density/n])/ (1-RealFns.Power[base: 10, exponent: -solidD/n]); RETURN[area]; }; <> <<>> <> Transf: TYPE ~ ARRAY [0 .. 3) OF ARRAY [0 .. 3) OF REAL; Triple: TYPE ~ RECORD [r, s, t: REAL]; <> <> <> <> <> <> <> 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 <> 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 <> 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 <> D65ToRgb: PROC RETURNS [d65: Transf] ~ BEGIN <> 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 <> 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 <> RETURN [LOOPHOLE [Transform [d65ToD50, LOOPHOLE [xyz65]]]]; END; -- IlluminantChange YesIlluminantChange: PUBLIC PROC [yes65: YES] RETURNS [YES] ~ BEGIN <> 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 <> 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 <> 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 <> 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 <> 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 <> Tristimulus: PUBLIC PROC [yxy: Yxy] RETURNS [xyz: XYZ] ~ BEGIN <> 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 <> 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 <> 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 <> 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 <> RETURN [RealFns.SqRt[c.aStar*c.aStar + c.bStar*c.bStar]] END; -- ABChroma ABHueAngle: PUBLIC PROC [c: CIELAB] RETURNS [REAL] ~ BEGIN <> 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 <> 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 <> LabToLch: PUBLIC PROC [lab: CIELAB] RETURNS [LCh] ~ BEGIN <> RETURN [[lab.lStar, ABChroma [lab], ABHueAngle [lab]]] END; -- LabToLch LchToLab: PUBLIC PROC [lch: LCh] RETURNS [CIELAB] ~ BEGIN <> 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 <> 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 <> 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 <> RETURN [RealFns.SqRt [c.uStar*c.uStar + c.vStar*c.vStar]] END; -- UVChroma UVSaturation: PUBLIC PROC [c: CIELUV] RETURNS [REAL] ~ BEGIN <> RETURN [RealFns.SqRt [c.uStar*c.uStar + c.vStar*c.vStar] / c.lStar] END; -- UVSaturation UVHueAngle: PUBLIC PROC [c: CIELUV] RETURNS [REAL] ~ BEGIN <> 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 <> 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.