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 ]]; }; 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]; }; 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; 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. žImagerColorImpl.mesa Copyright c 1984 Xerox Corporation. All rights reserved. Doug Wyatt, November 3, 1984 3:58:27 pm PST 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. default CIE coordinates for calibration Hitachi's CIE coordinates (from catalog # CE-E500R, Jan. 1982) Κ 8˜šœ™Jšœ Οmœ.™9Jšœ+™+J™—šΟk ˜ Jš œ žœžœ<žœžœžœ8˜΄Jšœžœ˜$Jšœžœ˜,Jšœžœ˜—J˜Jšœžœž˜Jšžœ˜ Jšžœ ˜Jšœžœžœ ˜J™Jšœžœ'˜;Jšœ žœ˜/J™š Οnœžœžœžœžœžœ˜,Jšžœžœžœžœžœžœžœ˜/Jšœ˜J˜—š Ÿœžœžœžœžœžœ˜-Jš žœžœžœžœžœžœ˜'Jšœ˜J˜—š Ÿœžœžœ žœžœžœ˜?Jšœžœžœ Οc#˜GJšžœžœ˜Jšžœžœžœ˜Jšžœžœžœžœ ˜ J˜J˜—š Ÿœžœžœžœžœžœ˜9Jšžœžœ˜J˜J˜—šŸ œžœžœžœžœžœžœ˜JJš œžœžœžœ žœ˜5Jšœ žœ˜šžœ˜JšΟf˜Jš‘˜Jš‘˜Jšœ˜—J˜J˜—šŸ œžœžœžœžœžœžœ˜JJš œžœžœžœ žœ˜5Jšžœžœžœžœžœžœžœ˜šžœ˜Jš‘˜Jš‘˜Jš‘˜Jšœ˜—J˜J˜—Iproc™šœ―™―K™—š Ÿœžœ žœžœžœ˜-Kšœžœžœ ˜šœžœžœžœž˜Kšœ ˜4Kšœ ˜1Kšœ ˜2Kšžœžœ˜—Kšžœžœžœžœ˜#J˜J˜—š Ÿ œžœžœžœžœžœ˜2Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœžœžœ  ˜,Kšœžœžœ  ˜1Kšœžœ˜Kšžœ žœžœ ˜6šžœ˜Kšœžœ ˜Kšœžœ˜%Kšœ žœ ˜Kšžœ$˜*K˜—J˜J˜—š Ÿ œžœžœžœžœžœ˜2Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšžœžœžœ ˜šžœ˜Kšœžœ˜Kšœ ˜-Kšœžœ  ˜(Kšœžœ ˜Kšœžœ˜Kšœžœ˜šžœž˜Kšœžœ ˜Kšœžœ ˜Kšœžœ ˜Kšœžœ ˜Kšœžœ ˜Kšœžœ ˜Kšžœžœ˜—K˜—J˜J˜—š Ÿ œžœžœžœžœžœ˜2Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœžœžœ ˜Kšœžœžœ ˜Kšœ žœ˜Kšžœ žœžœ ˜:šžœ˜Kšœžœ ˜Kšœžœ˜%Kš œ žœžœžœžœ˜MKšžœ(˜.K˜—J˜J˜—š Ÿ œžœžœžœžœžœ˜2Kšœžœ˜Kšœžœ˜Kšœ žœ˜Kšžœžœžœ#˜5šžœ˜š Ÿœžœ žœžœžœ˜.Kšœžœžœžœžœžœžœžœ˜=šžœž˜Kšœžœ  ˜-Kšœžœ ˜"Kšœžœ  ˜7Kšžœžœ   ˜&—K˜—Kšœžœ  ˜)Kš œžœžœžœžœ˜OKšœžœ˜KšžœP˜VK˜—J˜J˜—š Ÿ œžœžœžœžœ˜4Jš œžœžœžœžœ˜Jšžœžœžœ˜J˜J˜—šŸœžœžœžœ˜NJšœžœ˜%Jšœžœ˜Jš‘/˜/Jš‘ ˜ Jš‘&˜&Jš‘&˜&Jš‘&˜&š‘˜Jš‘˜Jš‘˜Jš‘˜—Jš‘!˜!Jš‘!˜!Jš‘!˜!Jš‘!˜!Jš‘!˜!Jš‘!˜!Jš‘!˜!Jš‘!˜!Jš‘!˜!Jšžœ˜ J˜J˜—K™šœ'™'Kšœžœžœžœ˜?Kšœžœžœžœ˜@Kšœ žœžœžœ ˜FKšœ žœžœžœ ˜E—™>Kšœ žœžœžœ ˜PKšœ žœžœžœ ˜PKšœ žœžœžœ ˜QKšœ žœžœžœ ˜Q—šœ,˜,JšœT˜TJ˜—šŸœžœžœ.žœ˜YJš‘(˜(Jš‘(˜(Jš‘(˜(Jš‘(˜(Jš‘(˜(Jš‘(˜(Jš‘(˜(Jš‘(˜(Jš‘(˜(J˜J˜—J˜Jšœžœ.˜;Jšœžœ.˜;Jšžœžœžœ&˜DJ˜š Ÿœžœžœžœžœ˜9Jšžœžœžœ˜Jšžœžœžœ˜Jšžœžœ žœžœ!˜>Jšžœ˜J˜J˜—š Ÿœžœžœžœžœ˜9Jšžœžœ'˜1J˜J˜—šŸœžœžœ,žœ˜NJšžœ˜Jšœžœ1˜HJšžœžœD˜NJ˜J˜—šŸœžœžœB˜_Jšžœ˜JšžœžœO˜YJ˜J˜—Jšœ žœ˜(J˜š Ÿœžœžœžœžœ˜NJšœžœžœ˜2Jš œžœžœžœ žœ˜5Jšœžœ žœ"˜LJšœžœN˜YJšœžœN˜YJšœžœN˜YJšžœ˜ J˜J˜—š Ÿœžœ žœžœžœ˜YJšžœ˜šœžœžœ ˜IJšœ7˜7—Jšžœ˜ J˜J˜—Jšžœ˜—…—œ+r