<> <> <> <> <> <<>> DIRECTORY Imager USING [Error], ImagerColor USING [CIE, CIEChromaticity, HSL, HSV, RGB, RGBCalibration, RGBCalibrationImplRep, YIQ], ImagerColorDefs USING [ColorOperator, ColorRep, ConstantColor, ConstantColorClassRep, ConstantColorImplRep, PixelArray, SampledColor, Transformation], ImagerColorOperator USING [BlackColorModel], ImagerColorPrivate USING [ConstantColorClass, ConstantColorClassRep, ConstantColorImpl, ConstantColorImplRep, RGBCalibrationImpl, RGBCalibrationImplRep, StippleFunction], ImagerPixelArray USING [MaxSampleValue], Real USING [FixI], RefTab USING [Create, Fetch, Ref, Store], RuntimeError USING [BoundsFault]; ImagerColorImpl: CEDAR PROGRAM IMPORTS Imager, ImagerColorOperator, ImagerPixelArray, Real, RefTab, RuntimeError EXPORTS ImagerColor, ImagerColorDefs, ImagerColorPrivate ~ BEGIN OPEN ImagerColorPrivate, ImagerColor, ImagerColorDefs; <<>> ConstantColorImpl: TYPE ~ ImagerColorPrivate.ConstantColorImpl; ConstantColorImplRep: PUBLIC TYPE ~ ImagerColorPrivate.ConstantColorImplRep; ConstantColorClass: TYPE ~ ImagerColorPrivate.ConstantColorClass; ConstantColorClassRep: PUBLIC TYPE ~ ImagerColorPrivate.ConstantColorClassRep; RGBCalibrationImpl: TYPE ~ ImagerColorPrivate.RGBCalibrationImpl; RGBCalibrationImplRep: PUBLIC TYPE ~ ImagerColorPrivate.RGBCalibrationImplRep; <> defaultCalibration: RGBCalibration _ NIL; GetDefaultCalibration: PUBLIC PROC RETURNS [RGBCalibration] ~ { RETURN[defaultCalibration]; }; <<>> CreateCalibration: PUBLIC PROC [type: ATOM, red, green, blue: CIEChromaticity, white: CIEChromaticity, YMax: REAL _ 100] RETURNS [RGBCalibration] ~ { ERROR; }; CIEFromRGB: PUBLIC PROC [rgb: RGB, calibration: RGBCalibration _ NIL] RETURNS [CIE] ~ { cal: RGBCalibration ~ IF calibration=NIL THEN defaultCalibration ELSE calibration; impl: RGBCalibrationImpl ~ cal.impl; RETURN[[ X: impl.cXR*rgb.R+impl.cXG*rgb.G+impl.cXB*rgb.B, Y: impl.cYR*rgb.R+impl.cYG*rgb.G+impl.cYB*rgb.B, Z: impl.cZR*rgb.R+impl.cZG*rgb.G+impl.cZB*rgb.B ]]; }; <<>> RGBFromCIE: PUBLIC PROC [cie: CIE, calibration: RGBCalibration _ NIL] RETURNS [RGB] ~ { cal: RGBCalibration ~ IF calibration=NIL THEN defaultCalibration ELSE calibration; impl: RGBCalibrationImpl ~ cal.impl; RETURN[[ R: impl.cRX*cie.X+impl.cRY*cie.Y+impl.cRZ*cie.Z, G: impl.cGX*cie.X+impl.cGY*cie.Y+impl.cGZ*cie.Z, B: impl.cBX*cie.X+impl.cBY*cie.Y+impl.cBZ*cie.Z ]]; }; RGBMaxY: PUBLIC PROC [c: CIEChromaticity, calibration: RGBCalibration _ NIL] RETURNS [Y: REAL] ~ { <> <> cie: CIE _ [X: c.x, Y: c.y, Z: 1-(c.x+c.y)]; rgb: RGB _ RGBFromCIE[cie, calibration]; max: REAL _ MAX[MAX[rgb.R, rgb.G],rgb.B]; Y _ c.y/max; --it would be an unusual device that had max=0 }; <<>> ChromaticityFromCIE: PUBLIC PROC [c: CIE] RETURNS [CIEChromaticity] ~ { sum: REAL ~ c.X+c.Y+c.Z; RETURN[[x: c.X/sum, y: c.Y/sum]]; }; CIEFromChromaticity: PUBLIC PROC [c: CIEChromaticity, Y: REAL] RETURNS [CIE] ~ { scale: REAL ~ Y/c.y; RETURN[[X: c.x*scale, Y: Y, Z: (1-c.x-c.y)*scale]]; }; <<>> ToRange: PROC[v: REAL] RETURNS[REAL] = INLINE { IF v IN[0..1] THEN RETURN[v] ELSE ERROR RuntimeError.BoundsFault; }; <> <<>> <> <<"Color Gamut Transform Pairs" by Alvy Ray Smith>> <> <> HSLFromRGB: PUBLIC PROC [val: RGB] RETURNS [HSL] ~ { max,min,rc,gc,bc,del, h, s, l: REAL; red: REAL _ ToRange[val.R]; green: REAL _ ToRange[val.G]; blue: REAL _ ToRange[val.B]; max _ MAX[red,MAX[green,blue]]; min _ MIN[red,MIN[green,blue]]; l _ (max+min)/2; IF max=min THEN RETURN[[0,0,l]]; --gray del _ max-min; s _ IF l <= 0.5 THEN del/(max+min) ELSE del/(2-max-min); rc _ (max-red)/del; gc _ (max-green)/del; bc _ (max-blue)/del; IF max = red THEN h _ bc-gc --between yellow and magenta ELSE IF max = green THEN h _ 2+rc-bc --between cyan and yellow ELSE IF max = blue THEN h _ 4+gc-rc --between magenta and cyan ELSE ERROR Imager.Error[[$invalidColor, "Invalid RGB color"]]; h _ h/6.0; IF h < 0 THEN h _ h+1; RETURN[[h, s, l]]; }; 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, g, b, h, s, v: REAL _ 0; max,min,rc,gc,bc: REAL; r _ ToRange[val.R]; g _ ToRange[val.G]; b _ ToRange[val.B]; min _ MIN[MIN[r,g],b]; --amount of white v _ max _ MAX[MAX[r,g],b];--maximum "brightness" IF max#0 THEN s _ (max-min)/max ELSE s _ 0; IF s=0 THEN RETURN[[0,0,v]]; --gray rc _ (max - r)/(max - min); gc _ (max - g)/(max - min); bc _ (max - b)/(max - min); IF r=max THEN h_bc-gc ELSE IF g=max THEN h_2+rc-bc ELSE IF b=max THEN h_4+gc-rc; h _ h / 6.0; IF h<0 THEN h_h+1; RETURN[[h, s, v]]; }; RGBFromHSV: PUBLIC PROC [val: HSV] RETURNS [RGB] ~ { hue, saturation, value: REAL; ihue: INTEGER; 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.FixI[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 ]]; }; colorTable: RefTab.Ref ~ RefTab.Create[mod: 31]; PutColor: PROC [atom: ATOM, color: ConstantColor] ~ { impl: ConstantColorImpl ~ color.impl; <> [] _ RefTab.Store[x: colorTable, key: atom, val: color]; }; GetColor: PROC [atom: ATOM] RETURNS [color: ConstantColor] ~ { found: BOOL; val: REF; [found: found, val: val] _ RefTab.Fetch[x: colorTable, key: atom]; IF found THEN WITH val SELECT FROM color: ConstantColor => RETURN[color]; ENDCASE => ERROR; RETURN[NIL]; }; IntensityFromGray: PROC [f: REAL] RETURNS [REAL] ~ { IF f>=1 THEN RETURN[0]; IF f<=0 THEN RETURN[1]; RETURN[1-f]; }; NewGray: PROC [f: REAL] RETURNS [ConstantColor] ~ { impl: ConstantColorImpl ~ NEW[ConstantColorImplRep.gray _ [ Y: IntensityFromGray[f], variant: gray[f]]]; RETURN[NEW[ColorRep.constant _ [variant: constant[impl: impl]]]]; }; IntensityFromRGB: PROC [val: RGB] RETURNS [REAL] ~ { Y: REAL ~ 0.30*val.R+0.59*val.G+0.11*val.B; IF Y<=0 THEN RETURN[0]; IF Y>=1 THEN RETURN[1]; RETURN[Y]; }; NewRGB: PROC [rgb: RGB] RETURNS [ConstantColor] ~ { impl: ConstantColorImpl ~ NEW[ConstantColorImplRep.rgb _ [ Y: IntensityFromRGB[rgb], variant: rgb[val: rgb]]]; RETURN[NEW[ColorRep.constant _ [variant: constant[impl: impl]]]]; }; NewHSV: PROC [hsv: HSV] RETURNS [ConstantColor] ~ { RETURN[NewRGB[RGBFromHSV[hsv]]]; }; NewHSL: PROC [hsl: HSL] RETURNS [ConstantColor] ~ { RETURN[NewRGB[RGBFromHSL[hsl]]]; }; ColorFromAtom: PUBLIC PROC [atom: ATOM] RETURNS [ConstantColor] ~ { RETURN[GetColor[atom]]; }; ColorFromGray: PUBLIC PROC [f: REAL] RETURNS [ConstantColor] ~ { IF f<=0.0 THEN RETURN[GetColor[$White]]; IF f>=1.0 THEN RETURN[GetColor[$Black]]; IF f=0.5 THEN RETURN[GetColor[$Gray]]; RETURN[NewGray[f]]; }; ColorFromRGB: PUBLIC PROC [rgb: RGB, calibration: RGBCalibration _ NIL] RETURNS [ConstantColor] ~ { IF rgb.R=0 AND rgb.G=0 AND rgb.B=0 THEN RETURN[GetColor[$RGBBlack]]; IF rgb.R=1 AND rgb.G=1 AND rgb.B=1 THEN RETURN[GetColor[$RGBWhite]]; IF rgb.R=1 AND rgb.G=0 AND rgb.B=0 THEN RETURN[GetColor[$Red]]; IF rgb.R=0 AND rgb.G=1 AND rgb.B=0 THEN RETURN[GetColor[$Green]]; IF rgb.R=0 AND rgb.G=0 AND rgb.B=1 THEN RETURN[GetColor[$Blue]]; IF rgb.R=0 AND rgb.G=1 AND rgb.B=1 THEN RETURN[GetColor[$Cyan]]; IF rgb.R=1 AND rgb.G=0 AND rgb.B=1 THEN RETURN[GetColor[$Magenta]]; IF rgb.R=1 AND rgb.G=1 AND rgb.B=0 THEN RETURN[GetColor[$Yellow]]; RETURN[NewRGB[rgb]]; }; ColorFromHSV: PUBLIC PROC [hsv: HSV] RETURNS [ConstantColor] ~ { IF hsv.V=0 THEN RETURN[GetColor[$Black]]; IF hsv.V=1 AND hsv.S=0 THEN RETURN[GetColor[$White]]; RETURN[NewHSV[hsv]]; }; GrayFromColor: PUBLIC PROC [color: ConstantColor] RETURNS [REAL] ~ { impl: ConstantColorImpl ~ color.impl; RETURN[1-impl.Y]; }; <> <> <> <<};>> <<>> ComponentFromColor: PUBLIC PROC [color: ConstantColor, name: ATOM] RETURNS [REAL] ~ { class: ConstantColorClass ~ color.class; impl: REF ConstantColorImplRep ~ color.impl; Component: TYPE ~ {Intensity, Red, Green, Blue}; component: Component _ Intensity; IF class#NIL AND class.ComponentFromColor # NIL THEN RETURN [class.ComponentFromColor[color, name]]; SELECT name FROM $Intensity => component _ Intensity; $Red => component _ Red; $Green => component _ Green; $Blue => component _ Blue; ENDCASE => Imager.Error[[$UnknownColorComponent, "Unknown Color Component"]]; WITH impl SELECT FROM stipple: REF ConstantColorImplRep.stipple => NULL; gray: REF ConstantColorImplRep.gray => NULL; rgb: REF ConstantColorImplRep.rgb => { SELECT component FROM Intensity => NULL; Red => RETURN [rgb.val.R]; Green => RETURN [rgb.val.G]; Blue => RETURN [rgb.val.B]; ENDCASE => NULL; }; ENDCASE => RETURN [impl.Y]; RETURN [impl.Y]; }; IntensityFromStipple: PROC [word: WORD] RETURNS [REAL] ~ { nBits: NAT ~ 16; bits: PACKED ARRAY [0..nBits) OF [0..1] ~ LOOPHOLE[word]; count: NAT _ 0; -- count the number of 1 bits FOR i: NAT IN[0..nBits) DO count _ count+bits[i] ENDLOOP; RETURN[REAL[nBits-count]/nBits]; }; ColorFromStipple: PUBLIC PROC [word: WORD, function: StippleFunction] RETURNS [ConstantColor] ~ { impl: ConstantColorImpl ~ NEW[ConstantColorImplRep _ [ Y: IntensityFromStipple[word], variant: stipple[word: word, function: function]]]; RETURN[NEW[ColorRep.constant _ [variant: constant[impl: impl]]]]; }; MakeSampledBlack: PUBLIC PROC[ pa: PixelArray, um: Transformation, clear: BOOL _ FALSE ] RETURNS[SampledColor] ~ { IF pa.samplesPerPixel#1 THEN ERROR; IF ImagerPixelArray.MaxSampleValue[pa, 0]#1 THEN ERROR; RETURN[NEW[ColorRep.sampled _ [variant: sampled[ pa: pa, um: um, colorOperator: ImagerColorOperator.BlackColorModel[clear]]]]]; }; MakeSampledColor: PUBLIC PROC[ pa: PixelArray, um: Transformation, colorOperator: ColorOperator ] RETURNS[SampledColor] ~ { RETURN[NEW[ColorRep[sampled] _ [variant: sampled[ pa: pa, um: um, colorOperator: colorOperator]]]]; }; InitColorTable: PROC ~ { PutColor[$White, NewGray[0.0]]; PutColor[$RGBWhite, NewRGB[[R: 1, G: 1, B: 1]]]; PutColor[$Black, NewGray[1.0]]; PutColor[$RGBBlack, NewRGB[[R: 0, G: 0, B: 0]]]; PutColor[$Invert, ColorFromStipple[word: WORD.LAST, function: invert]]; PutColor[$Clear, ColorFromStipple[word: 0, function: paint]]; PutColor[$Gray, NewGray[0.5]]; PutColor[$Red, NewRGB[[R: 1, G: 0, B: 0]]]; PutColor[$Green, NewRGB[[R: 0, G: 1, B: 0]]]; PutColor[$Blue, NewRGB[[R: 0, G: 0, B: 1]]]; PutColor[$Cyan, NewRGB[[R: 0, G: 1, B: 1]]]; PutColor[$Magenta, NewRGB[[R: 1, G: 0, B: 1]]]; PutColor[$Yellow, NewRGB[[R: 1, G: 1, B: 0]]]; PutColor[$Pink, NewHSL[[H: 0.0, S: 0.5, L: 0.7]]]; -- ??? PutColor[$Orange, NewHSL[[H: 0.04, S: 0.6, L: 0.4]]]; PutColor[$Brown, NewHSL[[H: 0.08, S: 0.6, L: 0.2]]]; PutColor[$Olive, NewHSL[[H: 0.25, S: 0.6, L: 0.2]]]; -- ??? PutColor[$YellowGreen, NewHSL[[H: 0.25, S: 0.6, L: 0.5]]]; -- ??? PutColor[$Purple, NewHSL[[H: 0.73, S: 0.6, L: 0.4]]]; }; InitColorTable[]; END. <> <0.008856 THEN RETURN[RealFns.Root[index: 3, arg: r]]>> <> <<};>> <<>> <> <> <<};>> <<>> <> <> <> <> <> <<};>> <<>> <> <> <> <> <> <<};>> <<>> <> <> <> <> <> <<};>> <<>>