ImagerColorPrivateImpl.mesa
Copyright Ó 1984, 1985, 1986, 1987, 1991, 1992 by Xerox Corporation. All rights reserved.
Stone, June 25, 1985 5:15:17 pm PDT
Michael Plass, October 20, 1992 12:36 pm PDT
Doug Wyatt, January 19, 1987 7:34:21 pm PST
DIRECTORY
FunctionCache USING [Cache, CompareProc, Create, Insert, Lookup],
ImagerError USING [Error],
ImagerColor USING [Color, ColorOperator, ColorOperatorClassRep, ColorOperatorRep, ColorRep, ConstantColor, OpConstantColor, PixelEncoding, PixelEncodingRep, RGB, SampledBlack, SampledColor, SampleEncoding, SampleEncodingRep, SampleTableProc, SampleValue, SpecialColor, Structure, StructureClass, StructureClassRep, StructureRep],
ImagerColorPrivate USING [ApplyProc, ColorOperatorClass, ColorOperatorClassRep, ColorOperatorCreateProc, ColorPoint, ColorPointRep, ColorSpace, ColorTransform, ColorTransformGenerator, DataEqualProc, Element, ElementAction, ElementGenerator, GetCreateDataProc, GetPixelEncodingProc, PixelBuffer, Signal, StructureClassRep, TranslateProc, TupleProc],
ImagerPixelArray USING [PixelArray],
ImagerTransformation USING [Transformation],
IO USING [int, PutFR],
RealInline USING [MCRound],
Rope USING [Concat, Equal, ROPE],
RuntimeError USING [BoundsFault],
SymTab USING [Create, Fetch, Ref, Store];
ImagerColorPrivateImpl: CEDAR MONITOR
IMPORTS FunctionCache, ImagerError, IO, RealInline, RuntimeError, Rope, SymTab
EXPORTS ImagerColor, ImagerColorPrivate
~ BEGIN
Copied type declarations
Color: TYPE ~ ImagerColor.Color;
ColorOperator: TYPE ~ ImagerColor.ColorOperator;
ColorOperatorRep: TYPE ~ ImagerColor.ColorOperatorRep;
ColorRep: TYPE ~ ImagerColor.ColorRep;
ConstantColor: TYPE ~ ImagerColor.ConstantColor;
ColorOperatorCreateProc: TYPE ~ ImagerColorPrivate.ColorOperatorCreateProc;
OpConstantColor: TYPE ~ ImagerColor.OpConstantColor;
DataEqualProc: TYPE ~ ImagerColorPrivate.DataEqualProc;
GetCreateDataProc: TYPE ~ ImagerColorPrivate.GetCreateDataProc;
PixelArray: TYPE ~ ImagerPixelArray.PixelArray;
RGB: TYPE ~ ImagerColor.RGB;
ROPE: TYPE ~ Rope.ROPE;
SampledBlack: TYPE ~ ImagerColor.SampledBlack;
SampledColor: TYPE ~ ImagerColor.SampledColor;
SampleTableProc: TYPE ~ ImagerColor.SampleTableProc;
SpecialColor: TYPE ~ ImagerColor.SpecialColor;
Transformation: TYPE ~ ImagerTransformation.Transformation;
TranslateProc: TYPE ~ ImagerColorPrivate.TranslateProc;
GetPixelEncodingProc: TYPE ~ ImagerColorPrivate.GetPixelEncodingProc;
ApplyProc: TYPE ~ ImagerColorPrivate.ApplyProc;
TupleProc: TYPE ~ ImagerColorPrivate.TupleProc;
ColorOperatorClass: TYPE ~ ImagerColorPrivate.ColorOperatorClass;
ColorOperatorClassRep:
PUBLIC
TYPE ~ ImagerColorPrivate.ColorOperatorClassRep;
ColorSpace: TYPE ~ ImagerColorPrivate.ColorSpace;
ColorTransformGenerator: TYPE ~ ImagerColorPrivate.ColorTransformGenerator;
ColorTransform: TYPE ~ ImagerColorPrivate.ColorTransform;
ColorPoint: TYPE ~ ImagerColorPrivate.ColorPoint;
ColorPointRep: TYPE ~ ImagerColorPrivate.ColorPointRep;
The Structure type
Structure:
TYPE ~ ImagerColor.Structure;
Element: TYPE ~ ImagerColorPrivate.Element;
ElementAction: TYPE ~ ImagerColorPrivate.ElementAction;
ElementGenerator:
TYPE ~ ImagerColorPrivate.ElementGenerator;
StructureClass: TYPE ~ REF StructureClassRep;
StructureClassRep:
PUBLIC
TYPE ~ ImagerColorPrivate.StructureClassRep;
-- export to ImagerColor
MakeStructure:
PUBLIC
PROC [class: StructureClass, data:
REF]
RETURNS [Structure] ~ {
structure: Structure ~ NEW[ImagerColor.StructureRep ¬ [class: class, data: data]];
RETURN [structure]
};
SSize:
PUBLIC
PROC [structure: Structure]
RETURNS [
INT] ~ {
RETURN [IF structure = NIL THEN 0 ELSE structure.class.size[structure]]
};
SCheckSize:
PUBLIC
PROC [structure: Structure, size:
INT]
RETURNS [
INT] ~ {
structureSize: INT ~ SSize[structure];
IF structureSize = size THEN RETURN [size];
ERROR ImagerError.Error[error: [$wrongSize, IO.PutFR["Argument vector to ColorModelOperator has incorrect size (expected %g, found %g)", IO.int[size], IO.int[structureSize]]]];
};
SGet:
PUBLIC PROC [structure: Structure, i:
INT]
RETURNS [Element] ~ {
IF structure = NIL OR i < 0 THEN RuntimeError.BoundsFault;
RETURN [structure.class.get[structure, i]]
};
SGetAtom:
PUBLIC
PROC [structure: Structure, i:
INT]
RETURNS [
ATOM] ~ {
WITH SGet[structure, i]
SELECT
FROM
e: Element.atom => RETURN [e.atom];
ENDCASE => NULL;
ERROR ImagerError.Error[error: [$wrongType, "Wrong type (expected Identifier)"]];
};
SGetReal:
PUBLIC
PROC [structure: Structure, i:
INT]
RETURNS [
REAL] ~ {
WITH SGet[structure, i]
SELECT
FROM
e: Element.int => RETURN [e.int];
e: Element.real => RETURN [e.real];
ENDCASE => NULL;
ERROR ImagerError.Error[error: [$wrongType, "Wrong type (expected Number)"]];
};
SGetInt:
PUBLIC
PROC [structure: Structure, i:
INT]
RETURNS [
INT] ~ {
WITH SGet[structure, i]
SELECT
FROM
e: Element.int => RETURN [e.int];
ENDCASE => NULL;
ERROR ImagerError.Error[error: [$wrongType, "Wrong type (expected Integer)"]];
};
SGetStructure:
PUBLIC
PROC [structure: Structure, i:
INT]
RETURNS [Structure] ~ {
WITH SGet[structure, i]
SELECT
FROM
e: Element.structure => RETURN [e.structure];
If we find 0, we return an empty structure instead; this convention is allowed by several of the color model operators defined in the Raster Encoding Standard
e: Element.int => IF e.int = 0 THEN RETURN [StructureFromList[NIL]];
e: Element.real => IF e.real = 0.0 THEN RETURN [StructureFromList[NIL]];
ENDCASE => NULL;
ERROR ImagerError.Error[error: [$wrongType, "Wrong type (expected Vector)"]];
};
SGetOptionalStructure:
PUBLIC
PROC [structure: Structure, i:
INT, wantSize:
INT ¬ -1]
RETURNS [Structure] ~ {
WITH SGet[structure, i]
SELECT
FROM
e: Element.structure => {
IF wantSize >= 0 THEN [] ¬ SCheckSize[e.structure, wantSize];
RETURN [e.structure];
};
If we find 0, return NIL instead; this convention is allowed by several of the color model operators defined in the Color Encoding Standard
e: Element.int => IF e.int = 0 THEN RETURN [NIL];
e: Element.real => IF e.real = 0.0 THEN RETURN [NIL];
ENDCASE => NULL;
ERROR ImagerError.Error[error: [$wrongType, "Wrong type (expected Vector or 0)"]];
};
SGetColor:
PUBLIC
PROC [structure: Structure, i:
INT]
RETURNS [Color] ~ {
WITH SGet[structure, i]
SELECT
FROM
e: Element.color => RETURN [e.color];
ENDCASE => NULL;
ERROR ImagerError.Error[error: [$wrongType, "Wrong type (expected Color)"]];
};
SGetColorOperator:
PUBLIC
PROC [structure: Structure, i:
INT]
RETURNS [ColorOperator] ~ {
WITH SGet[structure, i]
SELECT
FROM
e: Element.colorOperator => RETURN [e.colorOperator];
ENDCASE => NULL;
ERROR ImagerError.Error[error: [$wrongType, "Wrong type (expected ColorOperator)"]];
};
SGetProp:
PUBLIC PROC [structure: Structure, key:
ATOM]
RETURNS [Element] ~ {
size: INT ~ SSize[structure];
FOR i:
INT ¬ 0, i+2
WHILE i+1 < size
DO
WITH SGet[structure, i]
SELECT
FROM
a: Element.atom => {IF a.atom = key THEN RETURN [SGet[structure, i+1]]};
ENDCASE => NULL;
ENDLOOP;
RETURN [[structure[NIL]]]
};
FlatStructureRep: TYPE ~ RECORD [SEQUENCE size: NAT OF REF Element];
flatStructureClass: StructureClass ~ NEW[StructureClassRep ¬ [size: FlatSize, get: FlatGet]];
FlatSize:
PROC [structure: Structure]
RETURNS [
INT] ~ {
data: REF FlatStructureRep ~ NARROW[structure.data];
RETURN [data.size]
};
FlatGet:
PROC [structure: Structure, i:
INT]
RETURNS [Element] ~ {
data: REF FlatStructureRep ~ NARROW[structure.data];
element: Element ~ data[i];
RETURN [element]
};
StructureFromElementGenerator:
PUBLIC
PROC [elementGenerator: ElementGenerator]
RETURNS [Structure] ~ {
data: REF FlatStructureRep ¬ NIL;
size: INT ¬ 0;
CountElements: ElementAction ~ { size ¬ size + 1 };
i: INT ¬ 0;
StoreElements: ElementAction ~ {
WITH element
SELECT
FROM
atom: Element.atom => data[i] ¬ NEW[Element.atom ¬ atom];
structure: Element.structure => data[i] ¬ NEW[Element.structure ¬ structure];
real: Element.real => data[i] ¬ NEW[Element.real ¬ real];
int: Element.int => data[i] ¬ NEW[Element.int ¬ int];
color: Element.color => data[i] ¬ NEW[Element.color ¬ color];
colorOperator: Element.colorOperator => data[i] ¬ NEW[Element.colorOperator ¬ colorOperator];
ENDCASE => ERROR;
i ¬ i + 1
};
elementGenerator[CountElements];
data ¬ NEW[FlatStructureRep[size]];
elementGenerator[StoreElements];
IF i # size THEN ERROR; -- client did not do the same things both times
RETURN [MakeStructure[class: flatStructureClass, data: data]]
};
StructureFromList:
PUBLIC
PROC [list:
LIST
OF Element]
RETURNS [Structure] ~ {
GenerateElements: ElementGenerator ~ {
FOR each:
LIST
OF Element ¬ list, each.rest
UNTIL each =
NIL
DO
elementAction[each.first];
ENDLOOP;
};
RETURN [StructureFromElementGenerator[GenerateElements]];
};
MergeStructureRep: TYPE ~ RECORD [sSize: INT, s, t: Structure];
mergeStructureClass: StructureClass ~ NEW[StructureClassRep ¬ [size: MergeSize, get: MergeGet]];
MergeSize:
PROC [structure: Structure]
RETURNS [
INT] ~ {
data: REF MergeStructureRep ~ NARROW[structure.data];
RETURN [data.sSize+SSize[data.t]]
};
MergeGet:
PROC [structure: Structure, i:
INT]
RETURNS [Element] ~ {
data: REF MergeStructureRep ~ NARROW[structure.data];
IF i < data.sSize THEN RETURN [SGet[data.s, i]] ELSE RETURN [SGet[data.t, i-data.sSize]];
};
SMergeProp:
PUBLIC PROC [s, t: Structure]
RETURNS [Structure] ~ {
SELECT
TRUE
FROM
s = NIL => RETURN [t];
t = NIL => RETURN [s];
ENDCASE => {
sSize: INT ~ SSize[s];
tSize: INT ~ SSize[t];
data: REF MergeStructureRep ~ NEW[MergeStructureRep ¬ [sSize: sSize, s: s, t: t]];
structure: Structure ~ MakeStructure[class: mergeStructureClass, data: data];
RETURN [structure]
};
};
StructureEqual:
PUBLIC
PROC [s, t: Structure]
RETURNS [
BOOL] ~ {
IF s = t
THEN RETURN [TRUE]
ELSE {
sSize: INT ~ SSize[s];
tSize: INT ~ SSize[t];
IF sSize # tSize THEN RETURN [FALSE];
FOR i:
INT
IN [0..sSize)
DO
WITH SGet[s, i]
SELECT
FROM
si: Element.atom => WITH SGet[t, i] SELECT FROM ti: Element.atom => IF si.atom#ti.atom THEN RETURN [FALSE] ENDCASE => RETURN [FALSE];
si: Element.int => WITH SGet[t, i] SELECT FROM ti: Element.int => IF si.int#ti.int THEN RETURN [FALSE] ENDCASE => RETURN [FALSE];
si: Element.real => WITH SGet[t, i] SELECT FROM ti: Element.real => IF si.real#ti.real THEN RETURN [FALSE] ENDCASE => RETURN [FALSE];
si: Element.structure => WITH SGet[t, i] SELECT FROM ti: Element.structure => IF NOT StructureEqual[si.structure, ti.structure] THEN RETURN [FALSE] ENDCASE => RETURN [FALSE];
si: Element.color => WITH SGet[t, i] SELECT FROM ti: Element.color => IF NOT ColorEqual[si.color, ti.color] THEN RETURN [FALSE] ENDCASE => RETURN [FALSE];
si: Element.colorOperator => WITH SGet[t, i] SELECT FROM ti: Element.colorOperator => IF NOT si.colorOperator#ti.colorOperator THEN RETURN [FALSE] ENDCASE => RETURN [FALSE];
ENDCASE => ERROR;
ENDLOOP;
RETURN [TRUE]
};
};
ColorEqual:
PUBLIC
PROC [a, b: ImagerColor.Color]
RETURNS [
BOOL] ~ {
IF a = b THEN RETURN [TRUE];
WITH a
SELECT
FROM
aConstant: ConstantColor => {
WITH b
SELECT
FROM
bConstant: ConstantColor => {
RETURN [ConstantColorsEqual[aConstant, bConstant]]
};
ENDCASE => NULL;
};
ENDCASE => NULL;
RETURN [FALSE];
};
ConstantColorsEqual:
PUBLIC
PROC [a, b: ConstantColor]
RETURNS [
BOOL] ~ {
IF a=b THEN RETURN [TRUE];
WITH a
SELECT
FROM
aOp: OpConstantColor =>
WITH b
SELECT
FROM
bOp: OpConstantColor => {
IF aOp.colorOperator # bOp.colorOperator THEN RETURN [FALSE];
IF aOp.size # bOp.size THEN RETURN [FALSE];
FOR j:
NAT
IN [0..aOp.size)
DO
IF aOp[j] # bOp[j] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE]
};
ENDCASE => RETURN [FALSE];
aSp: SpecialColor =>
WITH b
SELECT
FROM
bSp: SpecialColor => {
IF aSp.type # bSp.type THEN RETURN [FALSE];
IF NOT Rope.Equal[aSp.name, bSp.name, FALSE] THEN RETURN [FALSE];
IF aSp.data # bSp.data THEN RETURN [FALSE];
RETURN [ConstantColorsEqual[aSp.substitute, bSp.substitute]];
};
ENDCASE => RETURN [FALSE];
ENDCASE => ERROR;
};
PixelEncoding Concrete Representation
PixelEncoding: TYPE ~ REF PixelEncodingRep;
PixelEncodingRep: TYPE ~ ImagerColor.PixelEncodingRep;
ApplyPixelEncoding:
PUBLIC PROC [pm: PixelEncoding, i:
NAT, value:
REAL]
RETURNS [
REAL] ~ {
RETURN [IF pm = NIL THEN value ELSE pm[i][MIN [MAX[RealInline.MCRound[value], 0], pm[i].size-1]]]
};
PixelEncodingEqual:
PUBLIC
PROC [a, b: PixelEncoding]
RETURNS [
BOOL] ~ {
IF a=NIL OR b=NIL THEN RETURN [a=b];
IF a.samplesPerPixel # b.samplesPerPixel THEN RETURN [FALSE];
FOR i:
NAT
IN [0..a.samplesPerPixel)
DO
IF NOT SampleEncodingEqual[a[i], b[i]] THEN RETURN [FALSE]
ENDLOOP;
RETURN [TRUE]
};
PixelEncodingFromStructure:
PUBLIC PROC [structure: Structure]
RETURNS [PixelEncoding] ~ {
IF structure =
NIL
THEN
RETURN [
NIL]
ELSE {
size: NAT ~ SSize[structure];
map: PixelEncoding ¬ NEW[PixelEncodingRep[size]];
FOR j:
INT
IN [0..size)
DO
map[j] ¬ SampleEncodingFromStructure[SGetStructure[structure, j]]
ENDLOOP;
RETURN [map]
};
};
StructureFromPixelEncoding:
PUBLIC PROC [map: PixelEncoding]
RETURNS [Structure] ~ {
G:
PROC [elementAction: ImagerColorPrivate.ElementAction] ~ {
FOR i:
NAT
IN [0..map.samplesPerPixel)
DO
elementAction[[structure[StructureFromSampleEncoding[map[i]]]]]
ENDLOOP;
};
RETURN [StructureFromElementGenerator[G]]
};
SampleEncoding: TYPE ~ REF SampleEncodingRep;
SampleEncodingRep:
TYPE ~ ImagerColor.SampleEncodingRep;
MakeSampleEncoding:
PUBLIC
PROC [size:
NAT, sampleTableProc: SampleTableProc]
RETURNS [SampleEncoding] ~ {
IF size=0 THEN RETURN [NIL]
ELSE {
map: SampleEncoding ~ NEW[SampleEncodingRep[size]];
FOR i: NAT IN [0..size) DO map[i] ¬ IF sampleTableProc = NIL THEN i ELSE sampleTableProc[i] ENDLOOP;
RETURN [map];
};
};
SampleEncodingEqual:
PUBLIC
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]
};
SampleEncodingFromStructure:
PUBLIC PROC [structure: Structure]
RETURNS [SampleEncoding] ~ {
size: INT ~ SSize[structure];
IF size=0
THEN { RETURN [NIL] }
ELSE {
v: SampleEncoding ¬ NEW[SampleEncodingRep[size]];
FOR i: INT IN [0..size) DO v[i] ¬ SGetReal[structure, i] ENDLOOP;
RETURN [v]
};
};
sampleEncodingClass: StructureClass ~
NEW[ImagerColorPrivate.StructureClassRep ¬ [
size: SampleEncodingSize,
get: SampleEncodingGet
]];
SampleEncodingSize:
PROC [structure: Structure]
RETURNS [
INT] ~ {
WITH structure.data
SELECT
FROM
v: SampleEncoding => RETURN [v.size];
ENDCASE => RETURN [0];
};
SampleEncodingGet:
PROC [structure: Structure, i:
INT]
RETURNS [Element] ~ {
WITH structure.data
SELECT
FROM
v: SampleEncoding => RETURN [[real[v[i]]]];
ENDCASE => RETURN [[real[0.0]]];
};
StructureFromSampleEncoding:
PUBLIC PROC [e: SampleEncoding]
RETURNS [Structure] ~ {
RETURN [IF e = NIL THEN NIL ELSE MakeStructure[sampleEncodingClass, e]]
};
Named Color Registry
namedColorTable: PUBLIC SymTab.Ref ¬ SymTab.Create[mod: 53, case: FALSE];
RegisterNamedColor:
PUBLIC
PROC [color: ImagerColor.SpecialColor] ~ {
IF color.name = NIL THEN ERROR;
[] ¬ SymTab.Store[x: namedColorTable, key: color.name, val: color];
};
ColorSpace Table
ColorSpaceTableRep: TYPE ~ RECORD [SEQUENCE end: ColorSpace OF ColorOperator];
colorSpaceTable: REF ColorSpaceTableRep ¬ NEW[ColorSpaceTableRep[ColorSpace.firstProcess.ORD+1]];
DefineProcessSpace:
PUBLIC
PROC [colorOperator: ColorOperator, val: ColorSpace[Y..firstProcess] ¬ firstProcess]
RETURNS [ColorSpace] ~ {
result: ColorSpace ¬ val;
UNTIL StoreColorOperator[result, colorOperator] DO result ¬ result.SUCC ENDLOOP;
RETURN [result]
};
StoreColorOperator:
ENTRY
PROC [colorSpace: ColorSpace, colorOperator: ColorOperator]
RETURNS [
BOOL] ~ {
cst: REF ColorSpaceTableRep ¬ colorSpaceTable;
IF colorSpace >= cst.end
THEN {
newSize: NAT ~ MAX[ ORD[cst.end]*2, ORD[colorSpace]+1 ];
new: REF ColorSpaceTableRep ~ NEW[ColorSpaceTableRep[newSize]];
FOR s: ColorSpace
IN [
FIRST[ColorSpace]..cst.end)
DO
new[s] ¬ cst[s];
ENDLOOP;
colorSpaceTable ¬ cst ¬ new;
};
SELECT cst[colorSpace]
FROM
colorOperator => { RETURN [TRUE] };
NIL => { cst[colorSpace] ¬ colorOperator; RETURN [TRUE] };
ENDCASE => { RETURN [FALSE] };
};
ColorOperatorFromColorSpace:
PUBLIC
ENTRY
PROC [colorSpace: ColorSpace]
RETURNS [ColorOperator] ~ {
RETURN [IF colorSpace < colorSpaceTable.end THEN colorSpaceTable[colorSpace] ELSE NIL]
};
ColorSpaceDimension:
PUBLIC
PROC [colorSpace: ColorSpace]
RETURNS [
NAT] ~ {
SELECT colorSpace
FROM
$Y => RETURN [1];
$RGB, $CIELAB, $YES => RETURN [3];
$Highlight => RETURN [2];
ENDCASE => {
op: ColorOperator ~ ColorOperatorFromColorSpace[colorSpace];
RETURN [IF op = NIL THEN 0 ELSE op.samplesPerPixelIn]
};
};
Color Output
GetPixelEncoding:
PUBLIC
PROC [colorOperator: ColorOperator]
RETURNS [PixelEncoding] ~ {
class: ColorOperatorClass ~ colorOperator.class;
RETURN[class.getPixelEncoding[colorOperator]];
};
TransformConstantColor:
PUBLIC
PROC [color: OpConstantColor, colorSpace: ColorSpace]
RETURNS [ColorPoint] ~ {
class: ColorOperatorClass ~ color.colorOperator.class;
pixelEncoding: PixelEncoding ~ GetPixelEncoding[color.colorOperator];
pixelIn: TupleProc ~ { RETURN [ApplyPixelEncoding[pixelEncoding, i, color[i]]] };
out: ColorPoint ~ MakeColorPoint[ColorSpaceDimension[colorSpace]];
class.apply[color.colorOperator, pixelIn, colorSpace, out];
RETURN [out]
};
ApplyToList:
PUBLIC
PROC [colorOperator: ColorOperator, colorSpace: ColorSpace, pixel:
LIST
OF
REAL]
RETURNS [
LIST
OF
REAL] ~ {
class: ColorOperatorClass ~ colorOperator.class;
pixelEncoding: PixelEncoding ~ GetPixelEncoding[colorOperator];
pixelIn: TupleProc ~ {
list: LIST OF REAL ¬ pixel;
THROUGH [0..i) DO list ¬ list.rest ENDLOOP;
RETURN [ApplyPixelEncoding[pixelEncoding, i, list.first]]
};
outList: LIST OF REAL ¬ LIST[0];
out: ColorPoint ¬ MakeColorPoint[ColorSpaceDimension[colorSpace]];
class.apply[colorOperator, pixelIn, colorSpace, out];
FOR i:
NAT
DECREASING
IN [0..out.dim)
DO
outList ¬ CONS[out[i], outList];
ENDLOOP;
out ¬ DestroyColorPoint[out];
RETURN [outList];
};
CommonDim: TYPE ~ [1..4];
scratchColorPoint: ARRAY [0..1] OF ARRAY CommonDim OF ColorPoint ¬ ALL[ALL[NIL]];
MakeColorPoint:
PUBLIC
PROC [dim:
NAT, s:
REAL ¬ 0.0]
RETURNS [d: ColorPoint] ~ {
TryScratch:
ENTRY
PROC ~
INLINE {
FOR i:
NAT
IN [0..
LENGTH[scratchColorPoint])
DO
d ¬ scratchColorPoint[i][dim];
IF d # NIL THEN { scratchColorPoint[i][dim] ¬ NIL; RETURN };
ENDLOOP;
};
IF dim IN CommonDim THEN TryScratch[];
IF d = NIL THEN d ¬ NEW[ColorPointRep[dim]];
d.outOfGamut ¬ FALSE;
FOR i: NAT IN [0..dim) DO d[i] ¬ s ENDLOOP;
};
DestroyColorPoint:
PUBLIC
ENTRY
PROC [d: ColorPoint]
RETURNS [ColorPoint ¬
NIL] ~ {
IF d #
NIL
THEN {
dim: NAT ~ d.dim;
IF dim
IN CommonDim
THEN {
FOR i:
NAT
IN [0..
LENGTH[scratchColorPoint])
DO
IF scratchColorPoint[i][dim] =
NIL
THEN {
scratchColorPoint[i][dim] ¬ d;
RETURN
};
ENDLOOP;
};
};
};
ChooseColorSpace:
PUBLIC
PROC [colorOperator: ColorOperator, spaces:
LIST
OF ColorSpace]
RETURNS [ColorSpace] ~ {
Choose a color space to work in.
FOR tail:
LIST
OF ColorSpace ¬ spaces, tail.rest
UNTIL tail =
NIL
DO
c: ColorSpace ¬ tail.first;
IF ColorOperatorFromColorSpace[tail.first] = colorOperator THEN RETURN [c];
FOR t:
LIST
OF ColorSpace ¬ colorOperator.class.supportedOutputs, t.rest
UNTIL t=
NIL
DO
IF t.first = c THEN RETURN [c];
ENDLOOP;
ENDLOOP;
ERROR ImagerError.Error[[$unsupportedColorOperator, "this color operator is not supported for this device", LIST[[$ColorOperator, colorOperator]]]];
};
ColorPointFromColor:
PUBLIC
PROC [color: OpConstantColor, transform: ColorTransform]
RETURNS [ColorPoint] ~ {
colorSpace: ColorSpace ~ transform.domain;
v: ColorPoint ¬ TransformConstantColor[color, colorSpace];
d: ColorPoint ~ MakeColorPoint[transform.rangeMax.dim];
transform.proc[transform, v, d];
v ¬ DestroyColorPoint[v];
RETURN [d]
};
NarrowToOp:
PROC [color: ConstantColor]
RETURNS [OpConstantColor] ~ {
c: ConstantColor ¬ color;
DO
WITH c
SELECT
FROM
special: SpecialColor => c ¬ special.substitute;
op: OpConstantColor => RETURN [op];
ENDCASE => ERROR ImagerError.Error[[$noSubstituteColor, "No substitute for SpecialColor"]]
ENDLOOP;
};
IntensityFromColor:
PUBLIC
PROC [color: ConstantColor]
RETURNS [Y:
REAL ¬ 0] ~ {
p: ColorPoint ¬ TransformConstantColor[NarrowToOp[color], $Y];
Y ¬ p[0];
p ¬ DestroyColorPoint[p];
};
GrayFromColor:
PUBLIC
PROC [color: ConstantColor]
RETURNS [
REAL] ~ {
RETURN [1.0-IntensityFromColor[color]]
};
ColorOperator Common
colorOperatorClassTable:
PUBLIC SymTab.Ref ¬ SymTab.Create[case:
FALSE];
FindColorOperatorClass:
PUBLIC
PROC [name:
ROPE]
RETURNS [ColorOperatorClass] ~ {
class: ColorOperatorClass ~ NARROW[SymTab.Fetch[colorOperatorClassTable, name].val];
IF class = NIL THEN ImagerError.Error[error: [$colorModelOperatorNotFound, Rope.Concat["Failed to find color model operator: ", name], LIST[[$name, name]]]];
RETURN [class];
};
NewColorOperatorClass:
PUBLIC
PROC [name:
ROPE, createColorOperator: ColorOperatorCreateProc, getCreateData: GetCreateDataProc, getPixelEncoding: GetPixelEncodingProc, apply: ApplyProc, dataEqual: DataEqualProc, supportedOutputs:
LIST
OF ColorSpace]
RETURNS [ColorOperatorClass] ~ {
class: ColorOperatorClass ~ NEW[ColorOperatorClassRep ¬ [name: name, createColorOperator: createColorOperator, getCreateData: getCreateData, getPixelEncoding: getPixelEncoding, apply: apply, dataEqual: dataEqual, supportedOutputs: supportedOutputs]];
[] ¬ SymTab.Store[x: colorOperatorClassTable, key: name, val: class];
RETURN [class];
};
colorOperatorCache: FunctionCache.Cache ~ FunctionCache.Create[maxEntries:
INT.
LAST, maxTotalSize:
INT.
LAST];
NewColorOperator:
PUBLIC
PROC [chromatic:
BOOL, samplesPerPixelIn:
NAT, class: ColorOperatorClass, data:
REF, appearanceHints: Structure]
RETURNS [ColorOperator] ~ {
compare: FunctionCache.CompareProc ~ {
WITH argument
SELECT
FROM
old: ColorOperator => RETURN [old.chromatic = chromatic AND old.samplesPerPixelIn = samplesPerPixelIn AND old.class = class AND StructureEqual[old.appearanceHints, appearanceHints] 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]
};
END.