<> <> <> <> <<>> DIRECTORY Basics USING [bitsPerWord], Imager USING [ConcatT, Context, DoSave, SetFont, SetXRelI, Show, ShowXChar, Trans], ImagerColor USING [], ImagerColorDefs USING [Color, ConstantColor, ColorOperator, ColorOperatorRep], ImagerColorOperator USING [ColorFromPixel, GrayLinearColorModel, GrayVisualColorModel, MapColorModel, PixelProc, RGBLinearColorModel], ImagerFont USING [Find, Font, Modify, XChar, XCharProc, XStringProc], ImagerPixelArrayDefs USING [PixelArray, PixelArrayClassRep, PixelArrayRep], ImagerPixelArrayPrivate USING [PixelArrayClass, PixelArrayClassRep], ImagerSample USING [Sample, UnsafeSamples], ImagerTransformation USING [Transformation], IPImager USING [], IPInterpreter USING [Any, Do, DoSave, Get, GetInteger, GetReal, Identifier, IdentifierFromAny, Integer, MasterError, Operator, OperatorClass, OperatorClassRep, OperatorFromAny, OperatorRep, PopVector, PushColor, PushOperator, RealFromAny, Ref, Shape, StringFromVector, Type, UnsafeGetBits, UnsafeGetElements, Vector, VectorClass, VectorClassRep, VectorFromAny, VectorRep, VectorShape], PrincOps USING [BitAddress, DstFunc, SrcFunc], RefText USING [AppendChar, AppendRope, ObtainScratch, ReleaseScratch], Rope USING [Equal, FromRefText, ROPE], RuntimeError USING [BoundsFault]; IPImagerImpl: CEDAR PROGRAM IMPORTS Imager, ImagerColorOperator, ImagerFont, IPInterpreter, RefText, 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; Show: PUBLIC PROC [self: Ref, v: Vector] ~ { showVec: Vector ~ self.showVec; IF showVec=NIL THEN { string: XStringProc ~ { StringFromVector[v, charAction] }; Imager.Show[context: self.imager, string: string]; } ELSE { charAction: XCharProc ~ { i: CARDINAL ~ LOOPHOLE[char]; charOp: Operator ~ OperatorFromAny[Get[showVec, i]]; action: PROC ~ { Imager.Trans[self.imager]; Do[self, charOp] }; DoSave[self, action]; }; StringFromVector[v, charAction]; }; }; ShowAndXRel: PUBLIC PROC [self: Ref, v: Vector] ~ { showVec: Vector ~ self.showVec; IF showVec=NIL THEN { string: XStringProc ~ { StringFromVector[v, charAction] }; Imager.Show[context: self.imager, string: string, xrel: TRUE]; } ELSE { show: BOOL _ TRUE; charAction: XCharProc ~ { IF show THEN { i: CARDINAL ~ LOOPHOLE[char]; charOp: Operator ~ OperatorFromAny[Get[showVec, i]]; action: PROC ~ { Imager.Trans[self.imager]; Do[self, charOp] }; DoSave[self, action]; } ELSE Imager.SetXRelI[self.imager, INTEGER[char.code]-128]; show _ NOT show; }; StringFromVector[v, charAction]; }; }; <<$Font Vectors>> <<>> fontClass: VectorClass ~ NEW[VectorClassRep _ [type: $Font, shape: FontShape, get: FontGet]]; FontShape: PROC [v: Vector] RETURNS [VectorShape] ~ { font: Font ~ v.font; RETURN[[lowerBound: 0, size: INT[CARDINAL.LAST]+1]]; }; FontGet: PROC [v: Vector, i: Integer] RETURNS [Any] ~ { font: Font ~ v.font; char: XChar ~ LOOPHOLE[CARDINAL[i]]; RETURN[OperatorFromChar[font: font, char: char]]; }; VectorFromFont: PUBLIC PROC [font: Font] RETURNS [Vector] ~ { RETURN[NEW[VectorRep _ [class: fontClass, data: NIL, font: font]]]; }; FontFromVector: PUBLIC PROC [v: Vector] RETURNS [Font] ~ { RETURN[v.font]; }; <<>> <<$Char Operators (the result of Get[font, i])>> <<>> CharData: TYPE ~ REF CharDataRep; CharDataRep: TYPE ~ RECORD[font: Font, char: XChar]; charClass: OperatorClass ~ NEW[OperatorClassRep _ [type: $Char, do: CharDo]]; CharDo: PROC [op: Operator, state: Ref] ~ { data: CharData ~ NARROW[op.data]; imager: Imager.Context ~ state.imager; action: PROC ~ { imager.SetFont[data.font]; imager.ShowXChar[data.char] }; imager.DoSave[action]; }; OperatorFromChar: PROC [font: Font, char: XChar] RETURNS [Operator] ~ { data: CharData ~ NEW[CharDataRep _ [font: font, char: char]]; RETURN[NEW[OperatorRep _ [class: charClass, data: data]]]; }; <<>> <<$Modified Vectors (the result of ModifyFont[v, ...] where v is not a $Font Vector)>> <<>> ModifiedData: TYPE ~ REF ModifiedDataRep; ModifiedDataRep: TYPE ~ RECORD[v: Vector, m: Transformation]; modifiedClass: VectorClass ~ NEW[VectorClassRep _ [type: $Modified, shape: ModifiedShape, get: ModifiedGet]]; ModifiedShape: PROC [v: Vector] RETURNS [VectorShape] ~ { data: ModifiedData ~ NARROW[v.data]; RETURN[Shape[data.v]]; }; ModifiedGet: PROC [v: Vector, i: Integer] RETURNS [Any] ~ { data: ModifiedData ~ NARROW[v.data]; val: Any ~ Get[data.v, i]; WITH val SELECT FROM op: Operator => RETURN[OperatorFromModifiedChar[e: op, m: data.m]]; ENDCASE; MasterError[$wrongType, "Element of font vector is not an Operator."]; RETURN[NIL]; }; <<$ModifiedChar Operators (the result of Get[v, i], where v is a $Modified Vector)>> <<>> ModifiedCharData: TYPE ~ REF ModifiedCharDataRep; ModifiedCharDataRep: TYPE ~ RECORD[e: Operator, m: Transformation]; modifiedCharClass: OperatorClass ~ NEW[OperatorClassRep _ [type: $ModifiedChar, do: ModifiedCharDo]]; ModifiedCharDo: PROC [op: Operator, state: Ref] ~ { data: ModifiedCharData ~ NARROW[op.data]; state.imager.ConcatT[data.m]; Do[state, data.e]; }; OperatorFromModifiedChar: PROC [e: Operator, m: Transformation] RETURNS [Operator] ~ { data: ModifiedCharData ~ NEW[ModifiedCharDataRep _ [e: e, m: m]]; RETURN[NEW[OperatorRep _ [class: modifiedCharClass, data: data]]]; }; NameFromVector: PROC [v: Vector] RETURNS [name: ROPE] ~ { shape: VectorShape ~ Shape[v]; scratch: REF TEXT ~ RefText.ObtainScratch[100]; text: REF TEXT _ scratch; FOR i: Integer IN[0..shape.size) DO id: Identifier ~ IdentifierFromAny[Get[v, shape.lowerBound+i]]; IF i#0 THEN text _ RefText.AppendChar[text, '/]; text _ RefText.AppendRope[text, id.rope]; ENDLOOP; name _ Rope.FromRefText[text]; RefText.ReleaseScratch[scratch]; }; FindFont: PUBLIC PROC [self: Ref, v: Vector] RETURNS [Vector] ~ { name: ROPE ~ NameFromVector[v]; font: Font ~ ImagerFont.Find[name]; RETURN[VectorFromFont[font]]; }; FindFontVec: PUBLIC PROC [self: Ref, v: Vector] RETURNS [Vector] ~ { MasterError[$unimplemented, "Not implemented: FINDFONTVEC"]; RETURN[NIL]; }; ModifyFont: PUBLIC PROC [v: Vector, m: Transformation] RETURNS [Vector] ~ { IF v.font#NIL THEN RETURN[VectorFromFont[ImagerFont.Modify[v.font, m]]] ELSE { data: ModifiedData ~ NEW[ModifiedDataRep _ [v: v, m: m]]; RETURN[NEW[VectorRep _ [class: modifiedClass, data: data]]]; }; }; <> <> <> <> <> <> <> <<];>> <<>> <> <<>> <> <> <> <<};>> <<>> <> <> <> <> <> <> <> <> <> <> <> <<}>> <> <> <> <<};>> <> <<}>> <> <<};>> <<>> <> <> <> <> <> <> <> <<}>> <> <<};>> <<>> 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: Integer, <> sampleVector: Vector ]; MakePixelArray: PUBLIC PROC [ xPixels, yPixels: Integer, -- number of pixels in slow and fast directions samplesPerPixel: Integer, -- number of sample values for each pixel maxSampleValue: Vector, -- maximum sample value; if NIL, use maxSampleValueI maxSampleValueI: Integer, -- 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: Integer IN[0..samplesPerPixel) DO maxSampleValueI _ MAX[GetInteger[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 [GetInteger[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; }; <<>> <> <<>> 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[GetInteger[coords, i]] }; PushColor[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; }; <> 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; < 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; < op _ xxx;>> < op _ xxx;>> ENDCASE; IF data.operator=NIL THEN ERROR; RETURN[NEW[OperatorRep _ [class: colorModelOperatorClass, data: data]]]; }; CheckSize: PROC [v: Vector, size: Integer] ~ { shape: VectorShape ~ Shape[v]; IF shape.lowerBound=0 AND shape.size=size THEN RETURN; ERROR; }; GetPixelMap: PROC [parameters: Vector, i: Integer] 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]]; }; <> <> <> <> <> <> <> <> <> <> <> <<};>> <<>> 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: Integer ~ GetInteger[parameters, 0]; colorOp: ColorOperator _ ImagerColorOperator.RGBLinearColorModel[maxSampleValue]; RETURN[OperatorFromColorOperator[colorOp]]; }; XeroxMap: PROC [parameters: Vector] RETURNS [Operator] ~ { maxSampleValue: Integer ~ Shape[parameters].size-1; map: PROC [s: CARDINAL] RETURNS [ConstantColor] ~ {RETURN [NARROW[Get[parameters, s]]]}; colorOp: ColorOperator ~ ImagerColorOperator.MapColorModel[maxSampleValue, map]; RETURN[OperatorFromColorOperator[colorOp]]; }; <> <> <> <> <> <> <<};>> <> <<};>> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<}>> <> <> <> <<}>> <> <<};>> <<>> END.