IIColorImpl.mesa
Copyright © 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
Stone, June 25, 1985 5:15:17 pm PDT
Michael Plass, September 15, 1986 5:08:49 pm PDT
Doug Wyatt, March 6, 1986 10:18:48 pm PST
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
Copied type declarations
Chromaticity: TYPE ~ IIColor.Chromaticity;
Color: TYPE ~ IIColor.Color;
ColorOperator: TYPE ~ IIColor.ColorOperator;
ColorOperatorRep: TYPE ~ IIColor.ColorOperatorRep;
ColorOutput: TYPE ~ IIColorPrivate.ColorOutput;
ColorOutputImplRep: PUBLIC TYPE ~ RECORD [];
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;
ColorOperatorClass: TYPE ~ IIColorPrivate.ColorOperatorClass;
ColorOperatorClassRep: PUBLIC TYPE ~ IIColorPrivate.ColorOperatorClassRep;
Matrix3 manipulation
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;
Now A is upper-triangular;
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]
};
Calibration
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] ~ {
We want to find the maximum value of Y such that c.x, c.y, Y is inside of the current RGB gamut. (x,y,z)*S=(X,Y,Z). (x,y,z)*S*CIEToRGB=(r,g,b)*S. We want to find the maximum value for S such that R, G and B <=1. Find the MAX[r,g,b]. S=1/max. Y=y*S.
NOTE: there is no chromaticity value for black (r=g=b=0). Black is Y=0.
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]
};
Representation conversions
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;
};
ensures that v is in [0..1]; raises BoundsFault if not
These algorithms use the hexacone model described in
"Color Gamut Transform Pairs" by Alvy Ray Smith
Siggraph 1978, p. 12.
Algorithms from Foley and van Dam
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];
};
Color Output
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];
};
ColorOperator common
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]
};
GrayLinear ColorOperator
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
]];
};
GrayDensity ColorOperator
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
]];
};
GrayVisual ColorOperator
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
]];
};
Map ColorOperator
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
]];
};
BuildMap ColorOperator
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
];
};
Calibrated ColorOperator
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
];
};
RGB ColorOperator
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
]];
};
ColorMap ColorOperator
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
]];
};
Making Colors
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.
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]]];
};
CubeRootFn: PROC [r: REAL] RETURNS [REAL] ~ {
IF r>0.008856 THEN RETURN[RealFns.Root[index: 3, arg: r]]
ELSE RETURN[(903.29*r+16.0)/116.0];
};
LStar: PUBLIC PROC [Y: REAL] RETURNS [REAL] ~ {
RETURN[116.0*CubeRootFn[Y/100]-16.0];
};
LABFromCIE: PUBLIC PROC [val, illum: XYZ] RETURNS [CIELAB] ~ {
fX: REAL ~ CubeRootFn[val.X/illum.X];
fY: REAL ~ CubeRootFn[val.Y/illum.Y];
fZ: REAL ~ CubeRootFn[val.Z/illum.Z];
RETURN[[L: 116*fY-16, a: 500*(fX-fY), b: 200*(fY-fZ)]];
};
CIEFromLAB: PUBLIC PROC [val: CIELAB, illum: XYZ] RETURNS [XYZ] ~ {
fY: REAL ~ (val.L+16)/116;
fX: REAL ~ fY+val.a/500;
fZ: REAL ~ fY-val.b/200;
RETURN[[X: illum.X*(fX*fX*fX), Y: illum.Y*(fY*fY*fY), Z: illum.Z*(fZ*fZ*fZ)]];
};
LUVFromCIE: PUBLIC PROC [val, illum: XYZ] RETURNS [CIELUV] ~ {
den: REAL ~ -2*val.x+12*val.y+3;
uPrime: REAL ~ 4*val.x/den;
vPrime: REAL ~ 9*val.y/den;
RETURN[[L: xxx, u: xxx, v: xxx]];
};