IPImagerImpl.mesa
Copyright © 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
Michael Plass, July 23, 1985 2:15:57 pm PDT
Doug Wyatt, November 6, 1986 6:44:14 pm PST
DIRECTORY
Basics USING [bitsPerWord],
Imager,
ImagerColor USING [],
ImagerColorDefs USING [Color, ConstantColor, ColorOperator, ColorOperatorRep],
ImagerColorOperator USING [ColorFromPixel, GrayLinearColorModel, GrayVisualColorModel, MapColorModel, PixelProc, RGBLinearColorModel],
ImagerFont,
ImagerPixelArrayDefs USING [PixelArray, PixelArrayClassRep, PixelArrayRep],
ImagerPixelArrayPrivate USING [PixelArrayClass, PixelArrayClassRep],
ImagerSample USING [Sample, UnsafeSamples],
ImagerTransformation USING [Transformation],
IPImager USING [],
IPInterpreter,
PrincOps USING [BitAddress, DstFunc, SrcFunc],
Rope USING [Equal, ROPE],
RuntimeError USING [BoundsFault];
IPImagerImpl: CEDAR PROGRAM
IMPORTS ImagerColorOperator, ImagerFont, IPInterpreter, Rope, RuntimeError
EXPORTS IPImager, ImagerPixelArrayDefs
= BEGIN OPEN IPInterpreter;
ROPE: TYPE ~ Rope.ROPE;
Font: TYPE ~ ImagerFont.Font;
XChar: TYPE ~ ImagerFont.XChar;
XCharProc: TYPE ~ ImagerFont.XCharProc;
XStringProc: TYPE ~ ImagerFont.XStringProc;
Transformation: TYPE ~ ImagerTransformation.Transformation;
MaskChar:
PUBLIC
PROC [self: Ref, fd: Vector, i: Cardinal] ~ {
characterMasks: Vector ~ VectorFromAny[GetPR[fd, "characterMasks"]];
found: BOOL; value: Any;
[found, value] ← GetPropC[characterMasks, i];
IF found
THEN {
maskOp: PROC ~ { Do[self, OperatorFromAny[value]] };
Mark[self, 0];
PushVector[self, fd];
DoSaveAll[self, maskOp];
WHILE Count[self]>0 DO Pop[self] ENDLOOP;
Unmark[self, 0];
};
};
FindFont:
PUBLIC
PROC [self: Ref, v: Vector]
RETURNS [Font] ~ {
name: ROPE ~ NameFromVector[v];
font: Font ~ ImagerFont.Find[name];
RETURN[font];
};
I did not find these until after I implemented them in another way - mfp
LargeVectorData: TYPE ~ REF LargeVectorDataRep;
LargeVectorDataRep: TYPE ~ RECORD[
file: FS.OpenFile,
start, length: INT,
bytesPerElement: NAT,
elements: INT
];
largeVectorClass: VectorClass ~ NEW[VectorClassRep ← [type: $LargeVector,
shape: LargeVectorShape, get: LargeVectorGet]];
LargeVectorShape: PROC [v: Vector] RETURNS [VectorShape] ~ {
data: LargeVectorData ~ NARROW[v.data];
RETURN[[lowerBound: 0, size: data.elements]];
};
LargeVectorGet: PROC [v: Vector, i: Cardinal] RETURNS [x: Any ← NIL] ~ {
data: LargeVectorData ~ NARROW[v.data];
MasterError[$unimplemented, "Get is unimplemented for a largeVector"];
RETURN[NIL];
IF i IN[0..data.elements) THEN {
bytesPerElement: NAT ~ data.bytesPerElement;
stream: STREAM ~ FS.StreamFromOpenFile[data.file];
IO.SetIndex[stream, data.start+i*bytesPerElement];
IF bytesPerElement<=4 THEN {
value: INT ~ IPMaster.GetSigned[stream, bytesPerElement];
x ← NumberFromInt[value];
}
ELSE {
value: REAL ~ IPMaster.GetCardinal[stream, bytesPerElement];
x ← NumberFromReal[value];
};
IO.Close[stream];
}
ELSE ERROR RuntimeError.BoundsFault;
};
MakeLargeVector: PUBLIC PROC [
stream: STREAM,
length: INT,
bytesPerElement: NAT
] RETURNS [Vector] ~ {
start: INT ~ IO.GetIndex[stream];
IPMaster.SkipBytes[stream, length];
IF bytesPerElement#0 AND (length MOD bytesPerElement)=0 THEN {
file: FS.OpenFile ~ FS.OpenFileFromStream[stream];
data: LargeVectorData ~ NEW[LargeVectorDataRep ← [file: file,
start: start, length: length, bytesPerElement: bytesPerElement,
elements: length/bytesPerElement]];
RETURN[NEW[VectorRep ← [class: largeVectorClass, data: data]]];
}
ELSE ERROR;
};
PixelArray: TYPE ~ ImagerPixelArrayDefs.PixelArray;
PixelArrayRep: TYPE ~ ImagerPixelArrayDefs.PixelArrayRep;
Sample: TYPE ~ ImagerSample.Sample;
UnsafeSamples: TYPE ~ ImagerSample.UnsafeSamples;
PixelArrayData: TYPE ~ REF PixelArrayDataRep;
PixelArrayDataRep:
TYPE ~
RECORD[
samplesPerLayer: INT,
maxSampleValue: Vector,
maxSampleValueI: Cardinal,
constant maximum sample value, if maxSampleValue=NIL, or max, maxSampleValue#NIL
sampleVector: Vector
];
MakePixelArray:
PUBLIC
PROC [
xPixels, yPixels: Cardinal,
-- number of pixels in slow and fast directions
samplesPerPixel: Cardinal,
-- number of sample values for each pixel
maxSampleValue: Vector,
-- maximum sample value; if NIL, use maxSampleValueI
maxSampleValueI: Cardinal,
-- constant maximum sample value, if maxSampleValue=NIL
samplesInterleaved:
BOOL,
-- if true, samples for one pixel are contiguous
m: Transformation,
-- transformation from pixel coordinates to master coordinates
samples: Vector
-- the actual samples
]
RETURNS [PixelArray] ~ {
sampleShape: VectorShape ~ Shape[samples];
data: PixelArrayData ~ NEW[PixelArrayDataRep];
IF maxSampleValue#
NIL
THEN {
shape: VectorShape ~ Shape[maxSampleValue];
IF shape.lowerBound#0 OR shape.size#samplesPerPixel THEN ERROR;
maxSampleValueI ← 0;
FOR i: Cardinal
IN[0..samplesPerPixel)
DO
maxSampleValueI ← MAX[GetCardinal[maxSampleValue, i], maxSampleValueI];
ENDLOOP;
};
IF samplesInterleaved
AND samplesPerPixel>1
THEN {
MasterError[$unimplemented, "Not implemented: interleaved samples"];
};
IF sampleShape.lowerBound#0
OR (samplesPerPixel*xPixels*yPixels)#sampleShape.size
THEN {
MasterError[$wrongShape, "samples vector has wrong shape for MAKEPIXELARRAY"];
};
data^ ← [
samplesPerLayer: xPixels*yPixels,
maxSampleValue: maxSampleValue,
maxSampleValueI: maxSampleValueI,
sampleVector: samples
];
RETURN[NEW[PixelArrayRep ← [class: IF samples.class.type = $PackedBits THEN pixelArrayBitmapClass ELSE pixelArrayClass, data: data,
sSize: xPixels, fSize: yPixels, samplesPerPixel: samplesPerPixel, m: m]]];
};
PixelArrayClass: TYPE ~ ImagerPixelArrayPrivate.PixelArrayClass;
PixelArrayClassRep: PUBLIC TYPE ~ ImagerPixelArrayPrivate.PixelArrayClassRep;
pixelArrayBitmapClass: PixelArrayClass ~
NEW[PixelArrayClassRep ← [
type: $InterpressBits,
MaxSampleValue: IPMaxSampleValue,
UnsafeGetSamples: IPUnsafeGetSamples,
UnsafeGetBits: IPUnsafeGetBits
]];
pixelArrayClass: PixelArrayClass ~
NEW[PixelArrayClassRep ← [
type: $Interpress,
MaxSampleValue: IPMaxSampleValue,
UnsafeGetSamples: IPUnsafeGetSamples
]];
IPMaxSampleValue:
PROC [pa: PixelArray, i:
NAT]
RETURNS [Sample] ~ {
data: PixelArrayData ~ NARROW[pa.data];
IF i
IN[0..pa.samplesPerPixel)
THEN {
IF data.maxSampleValue = NIL THEN RETURN [data.maxSampleValueI]
ELSE RETURN [GetCardinal[data.maxSampleValue, i]];
}
ELSE ERROR RuntimeError.BoundsFault;
};
IPUnsafeGetSamples:
UNSAFE
PROC [pa: PixelArray, i:
NAT ← 0, s, f:
INT,
samples: UnsafeSamples, count:
NAT] ~
UNCHECKED {
data: PixelArrayData ~ NARROW[pa.data];
layerOffset: INT ~ data.samplesPerLayer*i;
IF i NOT IN[0..pa.samplesPerPixel) THEN ERROR RuntimeError.BoundsFault;
IF s NOT IN[0..pa.sSize) THEN ERROR RuntimeError.BoundsFault;
IF f NOT IN[0..pa.fSize) THEN ERROR RuntimeError.BoundsFault;
IF f+count NOT IN[0..pa.fSize] THEN ERROR RuntimeError.BoundsFault;
UnsafeGetElements[vector: data.sampleVector, buffer: samples, start: layerOffset+s*pa.fSize+f, count: count];
};
bitsPerWord: NAT ~ Basics.bitsPerWord;
IPUnsafeGetBits:
UNSAFE
PROC [pa: PixelArray, i:
NAT ← 0, s, f:
INT,
dst: PrincOps.BitAddress, dstBpl:
INTEGER, width, height:
CARDINAL,
srcFunc: PrincOps.SrcFunc ← null, dstFunc: PrincOps.DstFunc ← null] ~
UNCHECKED {
data: PixelArrayData ~ NARROW[pa.data];
layerOffset: INT ~ data.samplesPerLayer*i;
lineIndex: INT ← layerOffset+s*pa.fSize+f;
dstBase: LONG POINTER ← dst.word;
dstBit: NAT ← dst.bit;
delta: NAT ~ dstBpl;
IF i NOT IN[0..pa.samplesPerPixel) THEN ERROR RuntimeError.BoundsFault;
IF s NOT IN[0..pa.sSize) THEN ERROR RuntimeError.BoundsFault;
IF s+height NOT IN[0..pa.sSize] THEN ERROR RuntimeError.BoundsFault;
IF f NOT IN[0..pa.fSize) THEN ERROR RuntimeError.BoundsFault;
IF f+width NOT IN[0..pa.fSize] THEN ERROR RuntimeError.BoundsFault;
THROUGH [0..height)
DO
IPInterpreter.UnsafeGetBits[vector: data.sampleVector, dst: [word: dstBase, bit: dstBit], start: lineIndex, count: width, srcFunc: srcFunc, dstFunc: dstFunc];
lineIndex ← lineIndex + pa.fSize;
dstBase ← dstBase + NAT[dstBit + delta] / bitsPerWord;
dstBit ← NAT[dstBit + delta] MOD bitsPerWord;
ENDLOOP;
};
FindDecompressor:
PUBLIC
PROC [self: Ref, v: Vector]
RETURNS [Operator] ~ {
name: ROPE ~ NameFromVector[v];
ERROR;
};
Colors, Color Operators
Color: TYPE ~ ImagerColorDefs.Color;
ConstantColor: TYPE ~ ImagerColorDefs.ConstantColor;
ColorOperator: TYPE ~ ImagerColorDefs.ColorOperator;
ColorOperatorRep: TYPE ~ ImagerColorDefs.ColorOperatorRep;
FindColor:
PUBLIC
PROC [self: Ref, v: Vector]
RETURNS [Color] ~ {
name: ROPE ~ NameFromVector[v];
ERROR;
};
ColorOperatorDo:
PROC [op: Operator, state: Ref] ~ {
colorOperator: ColorOperator ~ NARROW[op.data];
coords: Vector ~ PopVector[state];
pixel: ImagerColorOperator.PixelProc ~ { RETURN[GetCardinal[coords, i]] };
PushAny[state, ImagerColorOperator.ColorFromPixel[colorOperator, pixel]];
};
colorOperatorClass: OperatorClass ~
NEW[OperatorClassRep ← [
type: $ColorOperator, do: ColorOperatorDo]];
OperatorFromColorOperator:
PUBLIC
PROC [colorOperator: ColorOperator]
RETURNS [Operator] ~ {
RETURN[NEW[OperatorRep ← [class: colorOperatorClass, data: colorOperator]]];
};
ColorOperatorFromOperator:
PUBLIC
PROC [op: Operator]
RETURNS [ColorOperator] ~ {
IF op.class.type=$ColorOperator
THEN
WITH op.data
SELECT
FROM
colorOp: ColorOperator => RETURN[colorOp]; ENDCASE;
RETURN[NIL];
};
FindColorOperator:
PUBLIC
PROC [self: Ref, v: Vector]
RETURNS [Operator] ~ {
name: ROPE ~ NameFromVector[v];
ERROR;
};
Color Model Operators
ColorModelOperator: TYPE ~ PROC [parameters: Vector] RETURNS [colorOperator: Operator];
ColorModelOperatorData: TYPE ~ REF ColorModelOperatorDataRep;
ColorModelOperatorDataRep:
TYPE ~
RECORD[
name: ROPE,
operator: ColorModelOperator
];
ColorModelOperatorDo:
PROC [op: Operator, state: Ref] ~ {
data: ColorModelOperatorData ~ NARROW[op.data];
parameters: Vector ~ PopVector[state];
PushOperator[state, data.operator[parameters]];
};
colorModelOperatorClass: OperatorClass ~
NEW[OperatorClassRep ← [
type: $ColorModelOperator, do: ColorModelOperatorDo]];
FindColorModelOperator:
PUBLIC
PROC [self: Ref, v: Vector]
RETURNS [Operator] ~ {
name: ROPE ~ NameFromVector[v];
data: ColorModelOperatorData ~ NEW[ColorModelOperatorDataRep ← [
name: name, operator: NIL]];
SELECT
TRUE
FROM
Rope.Equal[name, "Xerox/grayLinear", FALSE] => data.operator ← XeroxGrayLinear;
Rope.Equal[name, "Xerox/grayDensity", FALSE] => data.operator ← XeroxGrayDensity;
Rope.Equal[name, "Xerox/grayVisual", FALSE] => data.operator ← XeroxGrayVisual;
Rope.Equal[name, "Xerox/Research/RGBLinear", FALSE] => data.operator ← XeroxResearchRGBLinear;
Rope.Equal[name, "Xerox/Map", FALSE] => data.operator ← XeroxMap;
Rope.Equal[name, "standard/buildMap", FALSE] => op ← xxx;
Rope.Equal[name, "standard/separations", FALSE] => op ← xxx;
ENDCASE;
IF data.operator=NIL THEN ERROR;
RETURN[NEW[OperatorRep ← [class: colorModelOperatorClass, data: data]]];
};
CheckSize:
PROC [v: Vector, size: Cardinal] ~ {
shape: VectorShape ~ Shape[v];
IF shape.lowerBound=0 AND shape.size=size THEN RETURN;
ERROR;
};
GetPixelMap:
PROC [parameters: Vector, i: Cardinal]
RETURNS [Vector] ~ {
x: Any ~ Get[parameters, i];
IF Type[x]=number AND RealFromAny[x]=0 THEN RETURN[NIL]
ELSE {
pixelMap: Vector ~ VectorFromAny[x];
shape: VectorShape ~ Shape[pixelMap];
IF shape.lowerBound#0 THEN ERROR;
RETURN[pixelMap];
};
};
XeroxGrayLinear:
PROC [parameters: Vector]
RETURNS [Operator] ~ {
colorOp: ColorOperator ← NIL;
sWhite: REAL ~ GetReal[parameters, 0];
sBlack: REAL ~ GetReal[parameters, 1];
pixelMap: Vector ~ GetPixelMap[parameters, 2];
mapSize: CARDINAL ~ IF pixelMap#NIL THEN Shape[pixelMap].size-1 ELSE 0;
mapProc: PROC [i: CARDINAL] RETURNS [REAL] ~ { RETURN[GetReal[pixelMap, i]] };
CheckSize[parameters, 3];
colorOp ← ImagerColorOperator.GrayLinearColorModel[sWhite: sWhite, sBlack: sBlack,
maxSampleValue: mapSize, sampleMap: mapProc];
RETURN[OperatorFromColorOperator[colorOp]];
};
XeroxGrayDensity: PROC [parameters: Vector] RETURNS [Operator] ~ {
colorOp: ImagerColor.ColorOperator ← NIL;
sWhite: REAL ~ GetReal[parameters, 0];
sBlack: REAL ~ GetReal[parameters, 1];
dBlack: REAL ~ GetReal[parameters, 2];
pixelMap: Vector ~ GetPixelMap[parameters, 3];
mapSize: CARDINAL ~ IF pixelMap#NIL THEN Shape[pixelMap].size ELSE 0;
mapProc: PROC [i: CARDINAL] RETURNS [REAL] ~ { RETURN[GetReal[pixelMap, i]] };
CheckSize[parameters, 4];
colorOp ← ImagerColor.GrayDensityOp[
sWhite: sWhite, sBlack: sBlack, dWhite: dWhite, dBlack: dBlack];
RETURN[OperatorFromColorOperator[colorOp]];
};
XeroxGrayVisual:
PROC [parameters: Vector]
RETURNS [Operator] ~ {
colorOp: ColorOperator ← NIL;
sWhite: REAL ~ GetReal[parameters, 0];
sBlack: REAL ~ GetReal[parameters, 1];
pixelMap: Vector ~ GetPixelMap[parameters, 2];
mapSize: CARDINAL ~ IF pixelMap#NIL THEN Shape[pixelMap].size-1 ELSE 0;
mapProc: PROC [i: CARDINAL] RETURNS [REAL] ~ { RETURN[GetReal[pixelMap, i]] };
CheckSize[parameters, 3];
colorOp ← ImagerColorOperator.GrayVisualColorModel[sWhite: sWhite, sBlack: sBlack,
maxSampleValue: mapSize, sampleMap: mapProc];
RETURN[OperatorFromColorOperator[colorOp]];
};
XeroxResearchRGBLinear:
PROC [parameters: Vector]
RETURNS [Operator] ~ {
maxSampleValue: Cardinal ~ GetCardinal[parameters, 0];
colorOp: ColorOperator ← ImagerColorOperator.RGBLinearColorModel[maxSampleValue];
RETURN[OperatorFromColorOperator[colorOp]];
};
XeroxMap:
PROC [parameters: Vector]
RETURNS [Operator] ~ {
maxSampleValue: Cardinal ~ Shape[parameters].size-1;
map: PROC [s: CARDINAL] RETURNS [ConstantColor] ~ {RETURN [NARROW[Get[parameters, s]]]};
colorOp: ColorOperator ~ ImagerColorOperator.MapColorModel[maxSampleValue, map];
RETURN[OperatorFromColorOperator[colorOp]];
};
MapColorModelOperator: PROC [self: Ref] ~ {
v: Vector ~ PopVector[self];
shape: VectorShape ~ Shape[v];
IF shape.lowerBound=0 AND shape.size=1 THEN {
map: Vector ~ VectorFromAny[Get[v, 0]];
PushOperator[self, OperatorFromColorOperator[colorOp]];
};
ERROR;
};
SeparationsColorModelOperator: PROC [self: Ref] ~ {
v: Vector ~ PopVector[self];
shape: VectorShape ~ Shape[v];
IF shape.lowerBound=0 THEN {
samplesPerPixel: Cardinal ~ shape.size;
op: REF ColorOperatorRep.separations ~ NEW[ColorOperatorRep.separations[samplesPerPixel]];
FOR i: Cardinal IN[0..samplesPerPixel) DO
s: Vector ~ VectorFromAny[Get[v, i]];
sh: VectorShape ~ Shape[s];
IF sh.lowerBound=0 AND sh.size=6 THEN {
X: REAL ~ GetReal[s, 0];
Y: REAL ~ GetReal[s, 1];
Z: REAL ~ GetReal[s, 2];
sMax: REAL ~ GetReal[s, 3];
sMin: REAL ~ GetReal[s, 4];
map: SampleMap ~ GetSampleMap[s, 5];
op[i] ← NEW[SeparationRep ← [cie: [X, Y, Z], sMax: sMax, sMin: sMin, map: map]];
}
ELSE ERROR;
ENDLOOP;
PushOperator[self, OperatorFromColorOperator[op]];
}
ELSE ERROR;
};
END.