<> <> <> <<>> 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.