<> <> <> <> <> <<>> DIRECTORY Atom, FunctionCache, II USING [Error], IIColor, IIColorPrivate USING [ColorOperatorClass, ColorOperatorClassRep, ColorOutput, ColorOutputImplRep, ColorOutputRep, DataBuildMap, DataBuildMapRep, DataCalibrated, DataCalibratedRep, DataColorMap, DataColorMapRep, DataGrayDensity, DataGrayDensityRep, DataGrayLinear, DataGrayLinearRep, DataGrayVisual, DataGrayVisualRep, DataEqualProc, DataMap, DataMapRep, DataRGB, DataRGBRep, MaxInRep, StippleData, StippleDataRep, TranslatePixelsProc, TranslateProc, TupleFromPixelProc, TupleProc], IIPixel, IIPixelArray USING [GetPixels, MaxSampleValue, PixelArray], IISample, IITransformation USING [Transformation], Real, RealFns USING [Power], Rope USING [ROPE], RuntimeError USING [BoundsFault], SF USING [Vec], Terminal USING [ChannelValue, ColorValue]; IIColorImpl: CEDAR PROGRAM IMPORTS FunctionCache, II, IIPixelArray, IISample, IIPixel, Real, RealFns, RuntimeError EXPORTS IIColor, IIColorPrivate ~ BEGIN <> Chromaticity: TYPE ~ IIColor.Chromaticity; Color: TYPE ~ IIColor.Color; ColorOperator: TYPE ~ IIColor.ColorOperator; ColorOperatorRep: TYPE ~ IIColor.ColorOperatorRep; ColorOutput: TYPE ~ IIColorPrivate.ColorOutput; <> ColorOutputRep: TYPE ~ IIColorPrivate.ColorOutputRep; ColorRep: TYPE ~ IIColor.ColorRep; ConstantColor: TYPE ~ IIColor.ConstantColor; DataEqualProc: TYPE ~ IIColorPrivate.DataEqualProc; Function: TYPE ~ IISample.Function; HSL: TYPE ~ IIColor.HSL; HSV: TYPE ~ IIColor.HSV; Matrix3: TYPE ~ IIColor.Matrix3; Pixel3Encoding: TYPE ~ IIColor.Pixel3Encoding; PixelArray: TYPE ~ IIPixelArray.PixelArray; PixelBuffer: TYPE ~ IIPixel.PixelBuffer; PixelMap: TYPE ~ IIPixel.PixelMap; PixelProc: TYPE ~ IIPixel.PixelProc; RGB: TYPE ~ IIColor.RGB; RGBCalibration: TYPE ~ IIColor.RGBCalibration; RGBCalibrationRep: TYPE ~ IIColor.RGBCalibrationRep; ROPE: TYPE ~ Rope.ROPE; Row3: TYPE ~ IIColor.Row3; Sample: TYPE ~ IISample.Sample; SampleBuffer: TYPE ~ IISample.SampleBuffer; SampledBlack: TYPE ~ IIColor.SampledBlack; SampledColor: TYPE ~ IIColor.SampledColor; SampleEncoding: TYPE ~ IIColor.SampleEncoding; SampleEncodingRep: TYPE ~ IIColor.SampleEncodingRep; SampleTableProc: TYPE ~ IIColor.SampleTableProc; SpecialColor: TYPE ~ IIColor.SpecialColor; Transformation: TYPE ~ IITransformation.Transformation; TranslatePixelsProc: TYPE ~ IIColorPrivate.TranslatePixelsProc; TranslateProc: TYPE ~ IIColorPrivate.TranslateProc; TupleFromPixelProc: TYPE ~ IIColorPrivate.TupleFromPixelProc; TupleProc: TYPE ~ IIColorPrivate.TupleProc; XYZ: TYPE ~ IIColor.XYZ; YIQ: TYPE ~ IIColor.YIQ; ColorOperatorClass: TYPE ~ IIColorPrivate.ColorOperatorClass; ColorOperatorClassRep: PUBLIC TYPE ~ IIColorPrivate.ColorOperatorClassRep; <> Diagonal3: PROC [x: Row3] RETURNS [m: Matrix3 _ ALL[ALL[0.0]]] ~ { n: NAT ~ 3; FOR i: NAT IN [0..n) DO m[i][i] _ x[i] ENDLOOP; }; Transform3: PROC [x: Row3, m: Matrix3] RETURNS [y: Row3] ~ { n: NAT ~ 3; FOR j: NAT IN [0..n) DO t: REAL _ 0.0; FOR i: NAT IN [0..n) DO t _ t + x[i]*m[i][j]; ENDLOOP; y[j] _ t; ENDLOOP; }; Concat3: PROC [A, B: Matrix3] RETURNS [C: Matrix3] ~ { n: NAT ~ 3; FOR i: NAT IN [0..n) DO FOR j: NAT IN [0..n) DO t: REAL _ 0.0; FOR k: NAT IN [0..n) DO t _ t + A[i][k]*B[k][j]; ENDLOOP; C[i][j] _ t; ENDLOOP; ENDLOOP; }; Invert3: PROC [A: Matrix3] RETURNS [Matrix3] ~ { n: NAT ~ 3; C: Matrix3 _ ALL[ALL[Real.TrappingNaN]]; B: Matrix3 _ ALL[ALL[0]]; FOR i: NAT IN [0..n) DO B[i][i] _ 1 ENDLOOP; FOR i: NAT IN [0..n) DO bestk: NAT _ i; FOR k: NAT IN [i..n) DO IF ABS[A[k][i]] > ABS[A[bestk][i]] THEN bestk _ k ENDLOOP; IF i#bestk THEN { {t: Row3 ~ A[i]; A[i] _ A[bestk]; A[bestk] _ t}; {t: Row3 ~ B[i]; B[i] _ B[bestk]; B[bestk] _ t}; }; FOR k: NAT IN (i..n) DO r: REAL = A[k][i]/A[i][i]; -- Singular A causes divide by zero A[k][i] _ 0; FOR j: NAT IN (i..n) DO A[k][j] _ A[k][j] - A[i][j]*r ENDLOOP; FOR j: NAT IN [0..n) DO B[k][j] _ B[k][j] - B[i][j]*r ENDLOOP; ENDLOOP ENDLOOP; <> FOR j: NAT IN [0..n) DO FOR i: NAT DECREASING IN [0..n) DO x: REAL _ B[i][j]; FOR k: NAT IN (i..n) DO x _ x - A[i][k]*C[k][j]; ENDLOOP; C[i][j] _ x / A[i][i]; ENDLOOP ENDLOOP; RETURN [C] }; <> defaultCalibration: RGBCalibration _ CreateCalibration[ type: $Default, red: [x: 0.6, y: 0.325], green: [x: 0.22, y: 0.62], blue: [x: 0.23, y: 0.2], white: [x: 0.29, y: 0.3], maxY: 1 ]; MatrixFromChromaticities: PROC [red, green, blue, white: Chromaticity, maxY: REAL] RETURNS [Matrix3] ~ { cieWhite: XYZ ~ XYZFromChromaticity[white, maxY]; z: PROC [c: Chromaticity] RETURNS [REAL] ~ INLINE {RETURN [1-(c.x+c.y)]}; m1: Matrix3 ~ [ [ red.x, red.y, z[red] ], [ green.x, green.y, z[green] ], [ blue.x, blue.y, z[blue] ] ]; scale: Row3 ~ Transform3[[cieWhite.X, cieWhite.Y, cieWhite.Z], Invert3[m1]]; m2: Matrix3 ~ Concat3[Diagonal3[scale], m1]; RETURN [m2] }; CreateCalibration: PUBLIC PROC [type: ATOM, red, green, blue: Chromaticity, white: Chromaticity, maxY: REAL] RETURNS [RGBCalibration] ~ { m: Matrix3 ~ MatrixFromChromaticities[red, green, blue, white, maxY]; new: RGBCalibration ~ NEW [RGBCalibrationRep _ [ type: type, red: red, green: green, blue: blue, white: white, maxY: maxY, matrixRGBtoXYZ: m, matrixXYZtoRGB: Invert3[m] ]]; RETURN [new] }; GetDefaultCalibration: PUBLIC PROC RETURNS [RGBCalibration] ~ { RETURN[defaultCalibration]; }; <<>> XYZFromRGB: PUBLIC PROC [rgb: RGB, calibration: RGBCalibration _ NIL] RETURNS [XYZ] ~ { cal: RGBCalibration ~ IF calibration=NIL THEN defaultCalibration ELSE calibration; v: Row3 ~ Transform3[[rgb.R, rgb.G, rgb.B], cal.matrixRGBtoXYZ]; RETURN [[X: v[0], Y: v[1], Z: v[2]]] }; RGBFromXYZ: PUBLIC PROC [xyz: XYZ, calibration: RGBCalibration _ NIL] RETURNS [RGB] ~ { cal: RGBCalibration ~ IF calibration=NIL THEN defaultCalibration ELSE calibration; v: Row3 ~ Transform3[[xyz.X, xyz.Y, xyz.Z], cal.matrixXYZtoRGB]; RETURN [[R: v[0], G: v[1], B: v[2]]] }; RGBMaxY: PUBLIC PROC [c: Chromaticity, calibration: RGBCalibration] RETURNS [REAL] ~ { <> <> cie: XYZ ~ [X: c.x, Y: c.y, Z: 1-(c.x+c.y)]; rgb: RGB ~ RGBFromXYZ[cie, calibration]; max: REAL ~ MAX[rgb.R, rgb.G, rgb.B]; Y: REAL ~ c.y/max; --it would be an unusual device that had max=0 RETURN [Y] }; <> ChromaticityFromXYZ: PUBLIC PROC [c: XYZ] RETURNS [Chromaticity] ~ { sum: REAL ~ c.X+c.Y+c.Z; RETURN[[x: c.X/sum, y: c.Y/sum]]; }; XYZFromChromaticity: PUBLIC PROC [c: Chromaticity, Y: REAL] RETURNS [XYZ] ~ { 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] ~ { 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; 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 II.Error[[$invalidColor, "Invalid RGB color"]] )/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: 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]]; }; matrixRGBtoYIQ: Matrix3 ~ [ [0.30, 0.59, 0.11], [0.60, -0.28, -0.32], [0.21, -0.52, 0.31] ]; matrixYIQtoRGB: Matrix3 ~ Invert3[matrixRGBtoYIQ]; YIQFromRGB: PUBLIC PROC [val: RGB] RETURNS [YIQ] ~ { v: Row3 ~ Transform3[[val.R, val.G, val.B], matrixRGBtoYIQ]; RETURN [[Y: v[0], I: v[1], Q: v[2]]] }; RGBFromYIQ: PUBLIC PROC [val: YIQ] RETURNS [RGB] ~ { v: Row3 ~ Transform3[[val.Y, val.I, val.Q], matrixRGBtoYIQ]; RETURN [[R: v[0], G: v[1], B: v[2]]] }; IntensityFromGray: PROC [f: REAL] RETURNS [REAL] ~ { IF f>=1 THEN RETURN[0]; IF f<=0 THEN RETURN[1]; RETURN[1-f]; }; 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]; }; <> intensityOut: ColorOutput _ NEW[ColorOutputRep _ [ type: $Y, samplesPerPixelOut: 1, impl: NIL ]]; rgbOut: ColorOutput _ NEW[ColorOutputRep _ [ type: $RGB, samplesPerPixelOut: 3, impl: NIL ]]; Debug: PROC [self: ColorOperator, output: ColorOutput, pixel: LIST OF Sample] RETURNS [LIST OF REAL] ~ { pixelIn: PROC [i: NAT] RETURNS [Sample] ~ { list: LIST OF Sample _ pixel; THROUGH [0..i) DO list _ list.rest ENDLOOP; RETURN [list.first] }; out: LIST OF REAL _ NIL; tupleAction: PROC [tupleOut: TupleProc] ~ { FOR i: NAT DECREASING IN [0..output.samplesPerPixelOut) DO out _ CONS[tupleOut[i], out]; ENDLOOP; }; TupleFromPixel[self, output, pixelIn, tupleAction]; RETURN [out]; }; TupleFromPixel: PUBLIC PROC [self: ColorOperator, output: ColorOutput, pixelIn: PixelProc, tupleAction: PROC [tupleOut: TupleProc]] ~ { class: ColorOperatorClass ~ self.class; class.TupleFromPixel[self, output, pixelIn, tupleAction]; }; PixelFromPixel: PUBLIC PROC [self: ColorOperator, output: ColorOutput, pixelIn: PixelProc, maxOut: PixelProc, pixelAction: PROC [pixelOut: PixelProc]] ~ { class: ColorOperatorClass ~ self.class; tupleAction: PROC [tupleOut: TupleProc] ~ { pixelOut: PixelProc ~ { RETURN[Real.Round[maxOut[i]*tupleOut[i]]] }; pixelAction[pixelOut]; }; class.TupleFromPixel[self, output, pixelIn, tupleAction]; }; TranslatePixels: PUBLIC PROC [self: ColorOperator, output: ColorOutput, maxIn: PixelProc, maxOut: PixelProc, translateAction: PROC [translate: TranslateProc]] ~ { class: ColorOperatorClass ~ self.class; IF class.TranslatePixels=NIL THEN { slowTranslate: TranslateProc ~ { samplesPerPixelOut: NAT ~ output.samplesPerPixelOut; FOR j: NAT IN [0..pixelsIn.length) DO pixelIn: PixelProc ~ { RETURN[pixelsIn[i][j]] }; pixelOutAction: PROC [pixelOut: PixelProc] ~ { FOR i: NAT IN [0..samplesPerPixelOut) DO pixelsOut[i][j] _ pixelOut[i]; ENDLOOP; }; PixelFromPixel[self, output, pixelIn, maxOut, pixelOutAction]; ENDLOOP; }; translateAction[slowTranslate]; } ELSE class.TranslatePixels[self, output, maxIn, maxOut, translateAction]; }; Translate: PUBLIC PROC [self: ColorOperator, output: ColorOutput, pa: PixelArray, maxOut: PixelProc] RETURNS [PixelMap] ~ { size: SF.Vec ~ [s: NAT[pa.sSize], f: NAT[pa.fSize]]; samplesPerPixelIn: NAT ~ pa.samplesPerPixel; samplesPerPixelOut: NAT ~ output.samplesPerPixelOut; maxIn: PixelProc ~ { RETURN[pa.MaxSampleValue[i]] }; pm: PixelMap ~ IIPixel.NewPixelMap[samplesPerPixelOut, [[0,0], size], maxOut]; translateAction: PROC [translate: TranslateProc] ~ { pixelsIn: PixelBuffer ~ IIPixel.ObtainScratchPixels[samplesPerPixelIn, size.f]; pixelsOut: PixelBuffer ~ IIPixel.ObtainScratchPixels[samplesPerPixelOut, size.f]; FOR s: NAT IN[0..size.s) DO pa.GetPixels[s: s, f: 0, pixels: pixelsIn]; translate[pixelsIn: pixelsIn, pixelsOut: pixelsOut]; pm.PutPixels[initIndex: [s: s, f: 0], pixels: pixelsOut]; ENDLOOP; IIPixel.ReleaseScratchPixels[pixelsOut]; IIPixel.ReleaseScratchPixels[pixelsIn]; }; TranslatePixels[self, output, maxIn, maxOut, translateAction]; RETURN[pm]; }; TupleFromColor: PUBLIC PROC [self: ConstantColor, output: ColorOutput, tupleAction: PROC [tupleOut: TupleProc]] ~ { pixelIn: PixelProc ~ { RETURN[self.pixel[i]] }; TupleFromPixel[self.colorOperator, output, pixelIn, tupleAction]; }; PixelFromColor: PUBLIC PROC [self: ConstantColor, output: ColorOutput, maxOut: PixelProc, pixelAction: PROC [pixelOut: PixelProc]] ~ { pixelIn: PixelProc ~ { RETURN[self.pixel[i]] }; PixelFromPixel[self.colorOperator, output, pixelIn, maxOut, pixelAction]; }; outputIntensity: ColorOutput _ NIL; outputRGB: ColorOutput _ NIL; IntensityFromColor: PUBLIC PROC [self: ConstantColor] RETURNS [Y: REAL _ 0] ~ { pixelIn: PixelProc ~ { RETURN[self.pixel[i]] }; tupleAction: PROC [tupleOut: TupleProc] ~ { Y _ tupleOut[0] }; TupleFromPixel[self.colorOperator, outputIntensity, pixelIn, tupleAction]; }; GrayFromColor: PUBLIC PROC [color: ConstantColor] RETURNS [REAL] ~ { RETURN [1.0-IntensityFromColor[color]] }; RGBFromColor: PUBLIC PROC [self: ConstantColor] RETURNS [rgb: RGB _ [0, 0, 0]] ~ { pixelIn: PixelProc ~ { RETURN[self.pixel[i]] }; tupleAction: PROC [tupleOut: TupleProc] ~ { rgb _ [R: tupleOut[0], G: tupleOut[1], B: tupleOut[2]]; }; TupleFromPixel[self.colorOperator, outputRGB, pixelIn, tupleAction]; }; <> NewColorOperatorClass: PUBLIC PROC [name: ROPE, TupleFromPixel: TupleFromPixelProc, TranslatePixels: TranslatePixelsProc, DataEqual: DataEqualProc] RETURNS [ColorOperatorClass] ~ { class: ColorOperatorClass ~ NEW [ColorOperatorClassRep _ [name: name, TupleFromPixel: TupleFromPixel, TranslatePixels: TranslatePixels, DataEqual: DataEqual]]; RETURN[class]; }; colorOperatorCache: FunctionCache.Cache ~ FunctionCache.Create[maxEntries: INT.LAST, maxTotalSize: INT.LAST]; NewColorOperator: PUBLIC PROC [chromatic: BOOL, samplesPerPixelIn: NAT, class: ColorOperatorClass, data: REF] RETURNS [ColorOperator] ~ { compare: FunctionCache.CompareProc ~ { WITH argument SELECT FROM old: ColorOperator => RETURN [old.chromatic = chromatic AND old.samplesPerPixelIn = samplesPerPixelIn AND old.class = class AND class.DataEqual[data, old.data]]; ENDCASE => RETURN [FALSE]; }; new: ColorOperator _ NARROW[FunctionCache.Lookup[x: colorOperatorCache, compare: compare].value]; IF new # NIL THEN RETURN [new]; new _ NEW[ColorOperatorRep _ [chromatic: chromatic, samplesPerPixelIn: samplesPerPixelIn, class: class, data: data]]; FunctionCache.Insert[x: colorOperatorCache, argument: new, value: new, size: 1]; RETURN [new] }; TranslatePixelsTable: PROC [self: ColorOperator, output: ColorOutput, maxIn: PixelProc, maxOut: PixelProc, translateAction: PROC [translate: TranslateProc]] ~ { maxIn0: Sample ~ maxIn[0]; samplesPerPixelOut: NAT ~ output.samplesPerPixelOut; table: PixelBuffer ~ IIPixel.ObtainScratchPixels[samplesPerPixelOut, maxIn0+1]; tableTranslate: TranslateProc ~ TRUSTED { count: NAT ~ pixelsIn.length; FOR i: NAT IN[0..samplesPerPixelOut) DO samplesIn: SampleBuffer ~ pixelsIn[0]; samplesOut: SampleBuffer ~ pixelsOut[i]; samplesTable: SampleBuffer ~ table[i]; pointerIn: LONG POINTER TO IISample.RawSamples _ samplesIn.PointerToSamples[start: 0, count: count]; pointerOut: LONG POINTER TO IISample.RawSamples _ samplesOut.PointerToSamples[start: 0, count: count]; THROUGH [0..count/8) DO pointerOut[0] _ samplesTable[pointerIn[0]]; pointerOut[1] _ samplesTable[pointerIn[1]]; pointerOut[2] _ samplesTable[pointerIn[2]]; pointerOut[3] _ samplesTable[pointerIn[3]]; pointerOut[4] _ samplesTable[pointerIn[4]]; pointerOut[5] _ samplesTable[pointerIn[5]]; pointerOut[6] _ samplesTable[pointerIn[6]]; pointerOut[7] _ samplesTable[pointerIn[7]]; pointerIn _ pointerIn+8; pointerOut _ pointerOut+8; ENDLOOP; THROUGH [0..count MOD 8) DO pointerOut[0] _ samplesTable[pointerIn[0]]; pointerIn _ pointerIn+1; pointerOut _ pointerOut+1; ENDLOOP; ENDLOOP; }; FOR s0: Sample IN[0..maxIn0] DO pixelIn: PixelProc ~ { check: [0..1) ~ i; RETURN[s0] }; pixelOutAction: PROC [pixelOut: PixelProc] ~ { FOR i: NAT IN[0..samplesPerPixelOut) DO table[i][s0] _ pixelOut[i] ENDLOOP; }; PixelFromPixel[self, output, pixelIn, maxOut, pixelOutAction]; ENDLOOP; translateAction[tableTranslate]; IIPixel.ReleaseScratchPixels[table]; }; MakeSampleEncoding: PUBLIC PROC [size: NAT, sampleTableProc: SampleTableProc] RETURNS [SampleEncoding] ~ { IF size=0 THEN RETURN[NIL] ELSE { map: SampleEncoding ~ NEW[SampleEncodingRep[size]]; FOR i: Sample IN[0..size) DO map[i] _ sampleTableProc[i] ENDLOOP; RETURN[map]; }; }; SampleEncodingEqual: PROC [a, b: SampleEncoding] RETURNS [BOOL] ~ { IF a = NIL AND b = NIL THEN RETURN [TRUE]; IF a = NIL OR b = NIL THEN RETURN [FALSE]; IF a.size # b.size THEN RETURN [FALSE]; FOR i: NAT IN [0..a.size) DO IF a[i] # b[i] THEN RETURN [FALSE] ENDLOOP; RETURN [TRUE]; }; DataEqualMaxIn: DataEqualProc ~ { a: REF IIColorPrivate.MaxInRep ~ NARROW[selfData]; b: REF IIColorPrivate.MaxInRep ~ NARROW[otherData]; RETURN [a.maxIn = b.maxIn] }; <> classGrayLinear: ColorOperatorClass ~ NewColorOperatorClass[ name: "Xerox/GrayLinear", TupleFromPixel: TupleFromPixelGrayLinear, TranslatePixels: TranslatePixelsTable, DataEqual: DataEqualGrayLinear ]; TupleFromPixelGrayLinear: TupleFromPixelProc ~ { data: IIColorPrivate.DataGrayLinear ~ NARROW[self.data]; s0: Sample ~ pixelIn[0]; s: REAL ~ IF data.map=NIL THEN REAL[s0] ELSE data.map[s0]; f: REAL ~ (s-data.sWhite)/(data.sBlack-data.sWhite); x: REAL ~ IF f<=0 THEN 1 ELSE IF f>=1 THEN 0 ELSE 1-f; tupleOut: TupleProc ~ { RETURN[x] }; tupleAction[tupleOut]; }; DataEqualGrayLinear: DataEqualProc ~ { a: IIColorPrivate.DataGrayLinear ~ NARROW[selfData]; b: IIColorPrivate.DataGrayLinear ~ NARROW[otherData]; RETURN [a.sWhite = b.sWhite AND a.sBlack = b.sBlack AND SampleEncodingEqual[a.map, b.map]] }; NewColorOperatorGrayLinear: PUBLIC PROC [sWhite, sBlack: REAL, sampleTableSize: Sample _ 0, sampleTableProc: SampleTableProc _ NIL] RETURNS [ColorOperator] ~ { data: IIColorPrivate.DataGrayLinear ~ NEW[IIColorPrivate.DataGrayLinearRep _ [ sWhite: sWhite, sBlack: sBlack, map: MakeSampleEncoding[sampleTableSize, sampleTableProc] ]]; RETURN[NewColorOperator[ chromatic: FALSE, samplesPerPixelIn: 1, class: classGrayLinear, data: data ]]; }; <> classGrayDensity: ColorOperatorClass ~ NewColorOperatorClass[ name: "Xerox/GrayDensity", TupleFromPixel: TupleFromPixelGrayDensity, TranslatePixels: TranslatePixelsTable, DataEqual: DataEqualGrayLinear ]; TupleFromPixelGrayDensity: TupleFromPixelProc ~ { data: IIColorPrivate.DataGrayDensity ~ NARROW[self.data]; s0: Sample ~ pixelIn[0]; s: REAL ~ IF data.map=NIL THEN REAL[s0] ELSE data.map[s0]; d: REAL ~ ((s-data.sWhite)/(data.sBlack-data.sWhite))*data.dBlack; f: REAL ~ RealFns.Power[base: 10, exponent: -d]; x: REAL ~ IF f<=0 THEN 1 ELSE IF f>=1 THEN 0 ELSE 1-f; tupleOut: TupleProc ~ { RETURN[x] }; tupleAction[tupleOut]; }; DataEqualGrayDensity: DataEqualProc ~ { a: IIColorPrivate.DataGrayDensity ~ NARROW[selfData]; b: IIColorPrivate.DataGrayDensity ~ NARROW[otherData]; RETURN [a.sWhite = b.sWhite AND a.sBlack = b.sBlack AND a.dBlack = b.dBlack AND SampleEncodingEqual[a.map, b.map]] }; NewColorOperatorGrayDensity: PUBLIC PROC [sWhite, sBlack, dBlack: REAL, sampleTableSize: Sample _ 0, sampleTableProc: SampleTableProc _ NIL] RETURNS [ColorOperator] ~ { data: IIColorPrivate.DataGrayDensity ~ NEW[IIColorPrivate.DataGrayDensityRep _ [ sWhite: sWhite, sBlack: sBlack, dBlack: dBlack, map: MakeSampleEncoding[sampleTableSize, sampleTableProc] ]]; RETURN[NewColorOperator[ chromatic: FALSE, samplesPerPixelIn: 1, class: classGrayDensity, data: data ]]; }; <> classGrayVisual: ColorOperatorClass ~ NewColorOperatorClass[ name: "Xerox/GrayVisual", TupleFromPixel: TupleFromPixelGrayVisual, TranslatePixels: TranslatePixelsTable, DataEqual: DataEqualGrayVisual ]; TupleFromPixelGrayVisual: TupleFromPixelProc ~ { data: IIColorPrivate.DataGrayVisual ~ NARROW[self.data]; s0: Sample ~ pixelIn[0]; s: REAL ~ IF data.map=NIL THEN REAL[s0] ELSE data.map[s0]; L: REAL ~ (s-data.sBlack)/(data.sWhite-data.sBlack); Y: REAL ~ IF L<=0.09 THEN L/0.09 ELSE RealFns.Power[base: (L+0.16)/0.25, exponent: 3]; f: REAL ~ 1-0.01*Y; x: REAL ~ IF f<=0 THEN 1 ELSE IF f>=1 THEN 0 ELSE 1-f; tupleOut: TupleProc ~ { RETURN[x] }; tupleAction[tupleOut]; }; DataEqualGrayVisual: DataEqualProc ~ { a: IIColorPrivate.DataGrayVisual ~ NARROW[selfData]; b: IIColorPrivate.DataGrayVisual ~ NARROW[otherData]; RETURN [a.sWhite = b.sWhite AND a.sBlack = b.sBlack AND SampleEncodingEqual[a.map, b.map]] }; NewColorOperatorGrayVisual: PUBLIC PROC [sWhite, sBlack: REAL, sampleTableSize: Sample _ 0, sampleTableProc: SampleTableProc _ NIL] RETURNS [ColorOperator] ~ { data: IIColorPrivate.DataGrayVisual ~ NEW[IIColorPrivate.DataGrayVisualRep _ [ sWhite: sWhite, sBlack: sBlack, map: MakeSampleEncoding[sampleTableSize, sampleTableProc] ]]; RETURN[NewColorOperator[ chromatic: FALSE, samplesPerPixelIn: 1, class: classGrayVisual, data: data ]]; }; <> classMap: ColorOperatorClass ~ NewColorOperatorClass[ name: "Xerox/Map", TupleFromPixel: TupleFromPixelMap, TranslatePixels: TranslatePixelsTable, DataEqual: DataEqualMap ]; TupleFromPixelMap: TupleFromPixelProc ~ { data: IIColorPrivate.DataMap ~ NARROW[self.data]; color: ConstantColor ~ data[pixelIn[0]]; TupleFromColor[color, output, tupleAction]; }; DataEqualMap: DataEqualProc ~ { a: IIColorPrivate.DataMap ~ NARROW[selfData]; b: IIColorPrivate.DataMap ~ NARROW[otherData]; IF a.size # b.size THEN RETURN [FALSE]; FOR i: NAT IN [0..a.size) DO ai: ConstantColor ~ a[i]; bi: ConstantColor ~ b[i]; IF ai.colorOperator#bi.colorOperator OR ai.size # bi.size THEN RETURN [FALSE]; FOR j: NAT IN [0..ai.size) DO IF ai[j] # bi[j] THEN RETURN [FALSE]; ENDLOOP; ENDLOOP; RETURN [TRUE]; }; NewColorOperatorMap: PUBLIC PROC [maxSampleValue: Sample, map: PROC [Sample] RETURNS [ConstantColor]] RETURNS [ColorOperator] ~ { data: IIColorPrivate.DataMap ~ NEW[IIColorPrivate.DataMapRep[maxSampleValue+1] _ [v:]]; chromatic: BOOL _ FALSE; FOR s0: Sample IN [0..maxSampleValue] DO color: ConstantColor ~ map[s0]; data.v[s0] _ color; chromatic _ chromatic OR color.colorOperator.chromatic; ENDLOOP; RETURN[NewColorOperator[ chromatic: chromatic, samplesPerPixelIn: 1, class: classMap, data: data ]]; }; <> classBuildMap: ColorOperatorClass ~ NewColorOperatorClass[ name: "Xerox/BuildMap", TupleFromPixel: TupleFromPixelBuildMap, TranslatePixels: TranslatePixelsTable, DataEqual: DataEqualBuildMap ]; TupleFromPixelBuildMap: TupleFromPixelProc ~ { data: IIColorPrivate.DataBuildMap ~ NARROW[self.data]; pixelMapped: PixelProc ~ { check: [0..1) ~ i; s0: Sample ~ pixelIn[0]; RETURN [data[s0]] }; TupleFromPixel[data.colorOperator, output, pixelMapped, tupleAction]; }; DataEqualBuildMap: DataEqualProc ~ { a: IIColorPrivate.DataBuildMap ~ NARROW[selfData]; b: IIColorPrivate.DataBuildMap ~ NARROW[otherData]; IF a.colorOperator # b.colorOperator THEN RETURN [FALSE]; IF a.size # b.size THEN RETURN [FALSE]; FOR i: NAT IN [0..a.size) DO IF a[i] # b[i] THEN RETURN [FALSE] ENDLOOP; RETURN [TRUE]; }; NewColorOperatorBuildMap: PUBLIC PROC [colorOperator: ColorOperator, maxSampleValue: Sample, map: PROC [Sample] RETURNS [Sample]] RETURNS [ColorOperator] ~ { data: IIColorPrivate.DataBuildMap ~ NEW[IIColorPrivate.DataBuildMapRep[maxSampleValue+1] _ [colorOperator: colorOperator, v: ]]; FOR s0: Sample IN [0..maxSampleValue] DO data.v[s0] _ map[s0] ENDLOOP; RETURN NewColorOperator[ chromatic: colorOperator.chromatic, samplesPerPixelIn: 1, class: classBuildMap, data: data ]; }; <> classCalibrated: ColorOperatorClass ~ NewColorOperatorClass[ name: "Xerox/Calibrated", TupleFromPixel: TupleFromPixelCalibrated, TranslatePixels: TranslatePixelsCalibrated, DataEqual: DataEqualCalibrated ]; TupleFromPixelCalibrated: TupleFromPixelProc ~ { <<[self: ColorOperator, output: ColorOutput, pixelIn: PixelProc, tupleAction: PROC [tupleOut: TupleProc]]>> data: IIColorPrivate.DataCalibrated ~ NARROW[self.data]; Decode: PROC [rawPixel: ARRAY [0..3) OF Sample] RETURNS [result: Row3] ~ INLINE { FOR i: NAT IN [0..3) DO result[i] _ IF data.encoding[i] = NIL THEN rawPixel[i] ELSE data.encoding[i][rawPixel[i]] ENDLOOP; }; pixel: Row3 ~ Decode[[pixelIn[0], pixelIn[1], pixelIn[2]]]; cie: Row3 ~ Transform3[pixel, data.matrix]; SELECT output.type FROM $RGB => { warn: BOOL; -- ColorOutput will need something about calibration in it. rgb: Row3 ~ Transform3[cie, defaultCalibration.matrixXYZtoRGB]; tupleOut: TupleProc ~ {RETURN [rgb[i]]}; tupleAction[tupleOut]; }; $Y => { tupleOut: TupleProc ~ {RETURN [cie[1]] --Y--}; tupleAction[tupleOut]; }; ENDCASE => ERROR; }; TranslatePixelsCalibrated: TranslatePixelsProc ~ { data: IIColorPrivate.DataCalibrated ~ NARROW[self.data]; unimplemented: BOOL; -- still need to implement this; this generates a compiler warning }; DataEqualCalibrated: DataEqualProc ~ { a: IIColorPrivate.DataCalibrated ~ NARROW[selfData]; b: IIColorPrivate.DataCalibrated ~ NARROW[otherData]; FOR i: NAT IN [0..3) DO IF NOT SampleEncodingEqual[a.encoding[i], b.encoding[i]] THEN RETURN[FALSE] ENDLOOP; IF a.matrix # b.matrix THEN RETURN [FALSE]; IF a.hints # b.hints THEN RETURN [FALSE]; RETURN [TRUE] }; NewColorOperatorCalibrated: PUBLIC PROC [encoding: Pixel3Encoding, matrix: Matrix3, hints: Atom.PropList] RETURNS [ColorOperator] ~ { data: IIColorPrivate.DataCalibrated ~ NEW[IIColorPrivate.DataCalibratedRep _ [encoding: encoding, matrix: matrix, hints: hints]]; RETURN NewColorOperator[ chromatic: TRUE, samplesPerPixelIn: 1, class: classCalibrated, data: data ]; }; <> classRGB: ColorOperatorClass ~ NewColorOperatorClass[ name: "Xerox/Research/RGB", TupleFromPixel: TupleFromPixelRGB, TranslatePixels: TranslatePixelsRGB, DataEqual: DataEqualMaxIn ]; TupleFromPixelRGB: TupleFromPixelProc ~ { data: IIColorPrivate.DataRGB ~ NARROW[self.data]; tupleRGB: TupleProc ~ { check: [0..3) ~ i; value: Sample ~ pixelIn[i]; max: Sample ~ data.maxIn; RETURN[MIN[value, max]/REAL[max]]; }; tupleY: TupleProc ~ { check: [0..1) ~ i; val: RGB ~ [R: tupleRGB[0], G: tupleRGB[1], B: tupleRGB[2]]; RETURN[IntensityFromRGB[val]]; }; SELECT output.type FROM $RGB => tupleAction[tupleRGB]; $Y => tupleAction[tupleY]; ENDCASE => ERROR; }; TranslatePixelsRGB: PROC [self: ColorOperator, output: ColorOutput, maxIn: PixelProc, maxOut: PixelProc, translateAction: PROC [translate: TranslateProc]] ~ { data: IIColorPrivate.DataRGB ~ NARROW[self.data]; Easy: PROC RETURNS [BOOL] ~ INLINE { IF output.samplesPerPixelOut # 3 THEN RETURN [FALSE]; IF output.type # $RGB THEN RETURN [FALSE]; FOR i: NAT IN [0..3) DO IF maxIn[0] # data.maxIn THEN RETURN [FALSE]; IF maxOut[0] # data.maxIn THEN RETURN [FALSE]; ENDLOOP; RETURN [TRUE]; }; IF Easy[] THEN { easyTranslate: IIColorPrivate.TranslateProc ~ { <<[pixelsIn: IIPixel.PixelBuffer, pixelsOut: IIPixel.PixelBuffer]>> FOR i: NAT IN [0..3) DO IISample.CopySamples[dst: pixelsOut[i], src: pixelsIn[i]]; ENDLOOP; }; translateAction[easyTranslate]; } ELSE { table: ARRAY [0..3) OF SampleBuffer ~ [ IISample.ObtainScratchSamples[maxIn[0]+1], IISample.ObtainScratchSamples[maxIn[1]+1], IISample.ObtainScratchSamples[maxIn[2]+1] ]; hardTranslate: IIColorPrivate.TranslateProc ~ TRUSTED { <<[pixelsIn: IIPixel.PixelBuffer, pixelsOut: IIPixel.PixelBuffer]>> SELECT output.type FROM $Y => { n: NAT ~ pixelsOut.length; d: LONG POINTER TO IISample.RawSamples ~ IISample.PointerToSamples[buffer: pixelsOut[0], start: 0, count: n]; s: ARRAY [0..3) OF LONG POINTER TO IISample.RawSamples ~ [ IISample.PointerToSamples[buffer: pixelsIn[0], start: 0, count: n], IISample.PointerToSamples[buffer: pixelsIn[1], start: 0, count: n], IISample.PointerToSamples[buffer: pixelsIn[2], start: 0, count: n] ]; FOR i: NAT IN [0..n) DO d[i] _ table[0][s[0][i]]+table[1][s[1][i]]+table[2][s[2][i]]; ENDLOOP; }; $RGB => { n: NAT ~ pixelsOut.length; FOR k: NAT IN [0..3) DO d: LONG POINTER TO IISample.RawSamples ~ IISample.PointerToSamples[buffer: pixelsOut[k], start: 0, count: n]; s: LONG POINTER TO IISample.RawSamples ~ IISample.PointerToSamples[buffer: pixelsIn[k], start: 0, count: n]; t: SampleBuffer ~ table[k]; FOR i: NAT IN [0..pixelsOut.length) DO d[i] _ t[s[i]]; ENDLOOP; ENDLOOP; }; ENDCASE => ERROR; }; factors: ARRAY [0..3) OF REAL ~ IF output.type = $Y THEN [0.30, 0.59, 0.11] ELSE [1, 1, 1]; FOR i: NAT IN [0..3) DO FOR s: Sample IN [0..table[i].length) DO r: REAL ~ factors[i]*s/data.maxIn; m: REAL ~ maxOut[MIN[i, output.samplesPerPixelOut-1]]; val: Sample ~ Real.Round[MIN[MAX[r, 0.0], 1.0]*m]; table[i][s] _ val; ENDLOOP; ENDLOOP; translateAction[hardTranslate]; FOR i: NAT IN [0..3) DO IISample.ReleaseScratchSamples[table[i]] ENDLOOP; }; }; NewColorOperatorRGB: PUBLIC PROC [maxIn: Sample] RETURNS [ColorOperator] ~ { data: IIColorPrivate.DataRGB ~ NEW[IIColorPrivate.DataRGBRep _ [maxIn: maxIn]]; RETURN[NewColorOperator[ chromatic: TRUE, samplesPerPixelIn: 3, class: classRGB, data: data ]]; }; <> classColorMap: ColorOperatorClass ~ NewColorOperatorClass[ name: "Xerox/Research/ColorMap", TupleFromPixel: TupleFromPixelColorMap, TranslatePixels: TranslatePixelsTable, DataEqual: DataEqualColorMap ]; TupleFromPixelColorMap: TupleFromPixelProc ~ { data: IIColorPrivate.DataColorMap ~ NARROW[self.data]; s0: Sample ~ pixelIn[0]; triple: IIColor.ColorValueTriple ~ data[s0]; max: Terminal.ColorValue ~ Terminal.ColorValue.LAST; tupleRGB: TupleProc ~ { value: Terminal.ColorValue ~ triple[i]; RETURN[REAL[value]/REAL[max]]; }; tupleY: TupleProc ~ { check: [0..1) ~ i; val: RGB ~ [R: tupleRGB[0], G: tupleRGB[1], B: tupleRGB[2]]; RETURN[IntensityFromRGB[val]]; }; SELECT output.type FROM $RGB => tupleAction[tupleRGB]; $Y => tupleAction[tupleY]; ENDCASE => ERROR; }; DataEqualColorMap: DataEqualProc ~ { a: IIColorPrivate.DataColorMap ~ NARROW[selfData]; b: IIColorPrivate.DataColorMap ~ NARROW[otherData]; IF a.size # b.size THEN RETURN [FALSE]; FOR i: NAT IN [0..a.size) DO IF a[i] # b[i] THEN RETURN [FALSE] ENDLOOP; RETURN [TRUE] }; NewColorOperatorColorMap: PUBLIC PROC [maxIn: Sample, map: IIColor.ColorMapProc] RETURNS [ColorOperator] ~ { data: IIColorPrivate.DataColorMap ~ NEW[IIColorPrivate.DataColorMapRep[maxIn]]; FOR i: Terminal.ChannelValue IN [0..maxIn] DO data[i] _ map[i] ENDLOOP; RETURN[NewColorOperator[ chromatic: TRUE, samplesPerPixelIn: 1, class: classColorMap, data: data ]]; }; <> ColorFromPixel: PUBLIC PROC [colorOperator: ColorOperator, pixel: PixelProc] RETURNS [ConstantColor] ~ { size: NAT ~ colorOperator.samplesPerPixelIn; color: ConstantColor ~ NEW[ColorRep.constant[size] _ [constant[colorOperator: colorOperator, pixel:]]]; FOR i: NAT IN [0..size) DO color.pixel[i] _ pixel[i] ENDLOOP; RETURN [color]; }; <<>> makeGrayUnit: NAT ~ 1000; makeGrayLinear: ColorOperator ~ NewColorOperatorGrayLinear[0.0, REAL[makeGrayUnit]]; ColorFromGray: PUBLIC PROC [f: REAL] RETURNS [ConstantColor] ~ { color: ConstantColor ~ NEW[ColorRep.constant[1] _ [constant[colorOperator: makeGrayLinear, pixel:]]]; color.pixel[0] _ Real.Round[MIN[MAX[f, 0.0], 1.0]*makeGrayUnit]; RETURN [color]; }; rgb1000: ColorOperator ~ NewColorOperatorRGB[makeGrayUnit]; ColorFromRGB: PUBLIC PROC [rgb: RGB] RETURNS [ConstantColor] ~ { color: ConstantColor ~ NEW[ColorRep.constant[3] _ [constant[colorOperator: rgb1000, pixel:]]]; color.pixel[0] _ Real.Round[MIN[MAX[rgb.R, 0.0], 1.0]*makeGrayUnit]; color.pixel[0] _ Real.Round[MIN[MAX[rgb.G, 0.0], 1.0]*makeGrayUnit]; color.pixel[0] _ Real.Round[MIN[MAX[rgb.B, 0.0], 1.0]*makeGrayUnit]; RETURN [color]; }; 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: Function] RETURNS [SpecialColor] ~ { data: IIColorPrivate.StippleData ~ NEW[IIColorPrivate.StippleDataRep _ [word: word, function: function]]; RETURN[NEW[ColorRep.special _ [special[type: $Stipple, data: data, substitute: NIL]]]]; }; MakeSampledBlack: PUBLIC PROC [pa: PixelArray, um: Transformation, clear: BOOL _ FALSE] RETURNS [SampledBlack] ~ { IF pa.samplesPerPixel#1 THEN ERROR; IF IIPixelArray.MaxSampleValue[pa, 0]#1 THEN ERROR; RETURN[NEW[ColorRep.sampledBlack _ [sampledBlack[pa: pa, um: um, clear: clear]]]]; }; MakeSampledColor: PUBLIC PROC [pa: PixelArray, um: Transformation, colorOperator: ColorOperator] RETURNS [SampledColor] ~ { RETURN[NEW[ColorRep.sampled _ [sampled[pa: pa, um: um, colorOperator: colorOperator]]]]; }; END. <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<>> <> <0.008856 THEN RETURN[RealFns.Root[index: 3, arg: r]]>> <> <<};>> <<>> <> <> <<};>> <<>> <> <> <> <> <> <<};>> <<>> <> <> <> <> <> <<};>> <<>> <> <> <> <> <> <<};>> <<>>