<> <> <> <> <<>> DIRECTORY Basics, ImagerFont USING [BYTE, MapRope, XChar, XCharProc, XStringProc], ImagerSample, IO USING [PutChar, RopeFromROS, ROS, STREAM], IPInterpreter, IPMaster, PrincOps, PrincOpsUtils, RefText, Rope; IPVectorImpl: CEDAR MONITOR IMPORTS Basics, IO, IPInterpreter, ImagerFont, ImagerSample, IPMaster, PrincOpsUtils, RefText, Rope EXPORTS IPInterpreter ~ BEGIN OPEN IPInterpreter; ROPE: TYPE ~ Rope.ROPE; BYTE: TYPE ~ ImagerFont.BYTE; XChar: TYPE ~ ImagerFont.XChar; XCharProc: TYPE ~ ImagerFont.XCharProc; XStringProc: TYPE ~ ImagerFont.XStringProc; Shape: PUBLIC PROC [v: Vector] RETURNS [VectorShape] ~ { shape: VectorShape ~ v.class.shape[v]; <<[] _ BoundsCheckCardinal[shape.lowerBound];>> <> <> RETURN[shape]; }; Get: PUBLIC PROC [v: Vector, i: Cardinal] RETURNS [Any] ~ { IF v.class.get # NIL THEN RETURN[v.class.get[v, BoundsCheckCardinal[i]]] ELSE { val: INT _ v.class.getCardinal[v, BoundsCheckCardinal[i]]; RETURN[IF val=0 THEN zeroObj ELSE IF val=1 THEN oneObj ELSE NEW[NumberRep _ [int[val]]]]; }; }; zeroObj: Any ~ NEW[NumberRep _ [zero[0]]]; oneObj: Any ~ NEW[NumberRep _ [int[1]]]; GetCardinal: PUBLIC PROC [v: Vector, i: Cardinal] RETURNS [Cardinal] ~ { IF v.class.getCardinal # NIL THEN RETURN[v.class.getCardinal[v, BoundsCheckCardinal[i]]]; RETURN[CardinalFromAny[v.class.get[v, BoundsCheckCardinal[i]]]]; }; GetReal: PUBLIC PROC [v: Vector, i: Cardinal] RETURNS [REAL] ~ { RETURN[RealFromAny[v.class.get[v, BoundsCheckCardinal[i]]]]; }; MapProp: PUBLIC PROC [v: Vector, action: PropProc] RETURNS [BOOL] ~ { IF v.class=mergedClass THEN { data: MergedData ~ NARROW[v.data]; IF MapProp[data.v2, action] THEN RETURN[TRUE]; IF MapProp[data.v1, action] THEN RETURN[TRUE]; } ELSE { shape: VectorShape ~ Shape[v]; IF NOT Even[shape.size] THEN MasterError[$invalidPropVec, "Property vector has odd length"]; FOR i: INT _ 0, i+2 WHILE i(maxCardinal-sum) THEN MasterError[$boundsFault, "Sum of run sizes exceeds maxCardinal"]; sum _ BoundsCheckCardinal[sum+run]; ENDLOOP; RETURN[sum]; }; RunGet: PUBLIC PROC [r: Vector, i: Cardinal] RETURNS [Any] ~ { shape: VectorShape ~ Shape[r]; sum: Cardinal _ 0; -- sum of the run lengths IF shape.lowerBound#0 OR NOT Even[shape.size] THEN MasterError[$invalidRunVec, "Run vector has nonzero lower bound or odd length"]; IF BoundsCheckCardinal[i]=0 THEN OutOfBounds[]; FOR i: Cardinal _ 0, i+2 WHILE i(maxCardinal-sum) THEN MasterError[$boundsFault, "Sum of run sizes exceeds maxCardinal"]; sum _ BoundsCheckCardinal[sum+run]; IF i<=sum THEN RETURN[Get[r, i+1]]; ENDLOOP; OutOfBounds[]; RETURN[NIL]; }; <<>> arrayClass: VectorClass ~ NEW[VectorClassRep _ [type: $Array, shape: ArrayShape, get: ArrayGet]]; ArrayShape: PROC [v: Vector] RETURNS [VectorShape] ~ { array: Array ~ NARROW[v.data]; RETURN[[lowerBound: BoundsCheckCardinal[array.lowerBound], size: array.size]]; }; ArrayGet: PROC [v: Vector, i: Cardinal] RETURNS [Any] ~ { array: Array ~ NARROW[v.data]; RETURN[array[BoundsCheckCardinal[i]-BoundsCheckCardinal[array.lowerBound]]]; }; NewArray: PROC [shape: VectorShape] RETURNS [Array] ~ { RETURN[NEW[ArrayRep[shape.size] _ [lowerBound: shape.lowerBound, array: ]]]; }; MakeVecLU: PUBLIC PROC [l, u: Cardinal, pop: PROC RETURNS [Any]] RETURNS [Vector] ~ { array: Array ~ NewArray[[BoundsCheckCardinal[l], BoundsCheckCardinal[u]-l+1]]; FOR i: NAT DECREASING IN[0..array.size) DO array[i] _ pop[] ENDLOOP; RETURN[NEW[VectorRep _ [class: arrayClass, data: array]]]; }; MakeVec: PUBLIC PROC [n: Cardinal, pop: PROC RETURNS [Any]] RETURNS [Vector] ~ { array: Array ~ NewArray[[0, BoundsCheckCardinal[n]]]; FOR i: NAT DECREASING IN[0..array.size) DO array[i] _ pop[] ENDLOOP; RETURN[NEW[VectorRep _ [class: arrayClass, data: array]]]; }; CopyArray: PROC [old: Array] RETURNS [new: Array] ~ { new _ NewArray[[old.lowerBound, old.size]]; FOR i: NAT IN[0..new.size) DO new[i] _ old[i] ENDLOOP; }; VectorFromArray: PUBLIC PROC [array: Array] RETURNS [Vector] ~ { RETURN[NEW[VectorRep _ [class: arrayClass, data: CopyArray[array]]]]; }; ArrayFromVector: PUBLIC PROC [v: Vector] RETURNS [Array] ~ { IF v.class.type=$Array THEN { array: Array ~ NARROW[v.data]; RETURN[CopyArray[array]]; } ELSE { array: Array ~ NewArray[Shape[v]]; FOR i: NAT IN[0..array.size) DO array[i] _ Get[v, array.lowerBound+i] ENDLOOP; RETURN[array]; }; }; ZeroData: TYPE ~ REF ZeroDataRep; ZeroDataRep: TYPE ~ RECORD[n: Cardinal]; zeroClass: VectorClass ~ NEW[VectorClassRep _ [type: $Zero, shape: ZeroShape, get: ZeroGet]]; ZeroShape: PROC [v: Vector] RETURNS [VectorShape] ~ { data: ZeroData ~ NARROW[v.data]; RETURN[[lowerBound: 0, size: data.n]]; }; ZeroGet: PROC [v: Vector, i: Cardinal] RETURNS [Any] ~ { data: ZeroData ~ NARROW[v.data]; IF NOT i IN[0..data.n) THEN OutOfBounds[]; RETURN[NIL]; }; ZeroVec: PUBLIC PROC [n: Cardinal] RETURNS [Vector] ~ { data: ZeroData ~ NEW[ZeroDataRep _ [n: BoundsCheckCardinal[n]]]; RETURN[NEW[VectorRep _ [class: zeroClass, data: data]]]; }; MergedData: TYPE ~ REF MergedDataRep; MergedDataRep: TYPE ~ RECORD[v1, v2: Vector]; mergedClass: VectorClass ~ NEW[VectorClassRep _ [type: $Merged, shape: MergedShape, get: MergedGet, getProp: MergedGetProp]]; MergedShape: PROC [v: Vector] RETURNS [VectorShape] ~ { data: MergedData ~ NARROW[v.data]; MasterError[$undefinedOperation, "SHAPE is undefined for merged property vector"]; RETURN[[0, 0]]; }; MergedGet: PROC [v: Vector, i: Cardinal] RETURNS [Any] ~ { data: MergedData ~ NARROW[v.data]; MasterError[$undefinedOperation, "GET is undefined for merged property vector"]; RETURN[NIL]; }; MergedGetProp: PROC [v: Vector, propName: Any] RETURNS [found: BOOL, value: Any] ~ { data: MergedData ~ NARROW[v.data]; [found, value] _ GetProp[data.v2, propName]; IF NOT found THEN [found, value] _ GetProp[data.v1, propName]; }; MergeProp: PUBLIC PROC [v1, v2: Vector] RETURNS [Vector] ~ { data: MergedData ~ NEW[MergedDataRep _ [v1: v1, v2: v2]]; RETURN[NEW[VectorRep _ [class: mergedClass, data: data]]]; }; StringData: TYPE ~ REF StringDataRep; StringDataRep: TYPE ~ RECORD[SEQUENCE size: NAT OF XChar]; stringClass: VectorClass ~ NEW[VectorClassRep _ [type: $String, shape: StringShape, get: StringGet]]; StringShape: PROC [v: Vector] RETURNS [VectorShape] ~ { s: StringData ~ NARROW[v.data]; RETURN[[lowerBound: 0, size: s.size]]; }; StringGet: PROC [v: Vector, i: Cardinal] RETURNS [Any] ~ { s: StringData ~ NARROW[v.data]; char: XChar ~ s[i]; RETURN[NEW[NumberRep _ [int[LOOPHOLE[char, CARDINAL]]]]]; }; VectorFromString: PUBLIC PROC [string: XStringProc] RETURNS [Vector] ~ { size, i: NAT _ 0; s: StringData _ NIL; count: XCharProc ~ { size _ size+1 }; store: XCharProc ~ { s[i] _ char; i _ i+1 }; string[count]; -- determine size s _ NEW[StringDataRep[size]]; string[store]; -- store the characters IF i#size THEN ERROR Bug; RETURN[NEW[VectorRep _ [class: stringClass, data: s]]]; }; VectorFromRope: PUBLIC PROC [rope: ROPE] RETURNS [Vector] ~ { xStringProc: XStringProc ~ {ImagerFont.MapRope[rope: rope, charAction: charAction]}; RETURN [VectorFromString[xStringProc]] }; StringFromVector: PUBLIC PROC [v: Vector, charAction: XCharProc] ~ { IF v.class.type=$String THEN { s: StringData ~ NARROW[v.data]; FOR i: NAT IN[0..s.size) DO charAction[s[i]] ENDLOOP; } ELSE { shape: VectorShape ~ Shape[v]; FOR i: INT IN[0..shape.size) DO char: CARDINAL ~ GetCardinal[v, shape.lowerBound+i]; charAction[LOOPHOLE[char]]; ENDLOOP; }; }; RopeFromVector: PUBLIC PROC [v: Vector] RETURNS [ROPE] ~ { stream: IO.STREAM ~ IO.ROS[]; set: BYTE _ 0; charAction: PROC [char: XChar] ~ { IF char.set#set THEN { IO.PutChar[stream, VAL[255]]; IO.PutChar[stream, VAL[set _ char.set]]; }; IO.PutChar[stream, VAL[char.code]]; }; StringFromVector[v, charAction]; RETURN[IO.RopeFromROS[stream]]; }; VectorFromName: PUBLIC PROC [rope: ROPE] RETURNS [Vector] ~ { size, i: NAT _ 0; array: Array _ NIL; count: IPMaster.PartActionType ~ { size _ size+1 }; store: IPMaster.PartActionType ~ { array[i] _ Rope.Substr[base, start, len]; i _ i+1 }; [] _ IPMaster.MapParts[base: rope, delimiter: '/, action: count]; array _ NewArray[[0, size]]; [] _ IPMaster.MapParts[base: rope, delimiter: '/, action: store]; RETURN[NEW[VectorRep _ [class: arrayClass, data: array]]]; }; NameFromVector: PUBLIC PROC [v: Vector] RETURNS [name: ROPE] ~ { shape: VectorShape ~ Shape[v]; scratch: REF TEXT ~ RefText.ObtainScratch[100]; text: REF TEXT _ scratch; FOR i: Cardinal 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]; ENDLOOP; name _ Rope.FromRefText[text]; RefText.ReleaseScratch[scratch]; }; packedByteClass: VectorClass ~ NEW[VectorClassRep _ [type: $PackedByte, shape: PackedByteShape, getCardinal: PackedByteGetCardinal]]; PackedByteData: TYPE ~ REF PackedByteDataRep; PackedByteDataRep: TYPE ~ RECORD [ bytes: ROPE, size: INT, bytesPerElement: NAT, signed: BOOL ]; PackedByteShape: PROC [v: Vector] RETURNS [VectorShape] ~ { data: PackedByteData ~ NARROW[v.data]; RETURN[[lowerBound: 0, size: data.size]]; }; PackedByteGetCardinal: PROC [v: Vector, i: Cardinal] RETURNS [Cardinal] ~ { data: PackedByteData ~ NARROW[v.data]; start: INT ~ BoundsCheckCardinal[i]*data.bytesPerElement; char: CHAR _ Rope.Fetch[data.bytes, start]; val: INT _ ORD[char]; IF data.signed AND val >= 128 THEN val _ val - 256; FOR i: INT IN [1..data.bytesPerElement) DO char _ Rope.Fetch[data.bytes, start+i]; val _ Basics.DoubleShiftLeft[[li[val]], 8].li + ORD[char]; ENDLOOP; RETURN[val]; }; VectorFromBytes: PUBLIC PROC [bytes: ROPE, bytesPerElement: NAT, signed: BOOL] RETURNS [Vector] ~ { ropeSize: INT ~ Rope.Size[bytes]; bpe: [1..4] ~ bytesPerElement; data: PackedByteData _ NEW[PackedByteDataRep _ [bytes: bytes, size: ropeSize/bpe, bytesPerElement: bytesPerElement, signed: signed]]; IF data.size*bpe # ropeSize THEN ERROR; RETURN[NEW[VectorRep _ [class: packedByteClass, data: data]]]; }; packedBitClass: VectorClass ~ NEW[VectorClassRep _ [type: $PackedBits, shape: PackedBitShape, getCardinal: PackedBitGetCardinal]]; PackedBitData: TYPE ~ REF PackedBitDataRep; PackedBitDataRep: TYPE ~ RECORD [ bytes: ROPE, size: INT, dataBitsPerLine: NAT, bytesPerLine: NAT ]; PackedBitShape: PROC [v: Vector] RETURNS [VectorShape] ~ { data: PackedBitData ~ NARROW[v.data]; RETURN[[lowerBound: 0, size: data.size]]; }; PackedBitGetCardinal: PROC [v: Vector, i: Cardinal] RETURNS [Cardinal] ~ { data: PackedBitData ~ NARROW[v.data]; index: LONG CARDINAL ~ BoundsCheckCardinal[i]; line, dot, val: CARDINAL; char: CHAR; [quotient: line, remainder: dot] _ Basics.LongDivMod[index, data.dataBitsPerLine]; char _ Rope.Fetch[data.bytes, Basics.LongMult[line, data.bytesPerLine]+dot/8]; val _ Basics.BITSHIFT[ORD[char], INTEGER[dot MOD 8]-7] MOD 2; RETURN[val]; }; VectorFromBits: PUBLIC PROC [bytes: ROPE, dataBitsPerLine, padBitsPerLine: NAT] RETURNS [Vector] ~ { ropeSize: INT ~ Rope.Size[bytes]; totalBitsPerLine: NAT ~ dataBitsPerLine+padBitsPerLine; bytesPerLine: NAT ~ totalBitsPerLine/8; slop: [0..0] ~ totalBitsPerLine MOD 8; lines: INT ~ ropeSize/bytesPerLine; data: PackedBitData ~ NEW[PackedBitDataRep _ [bytes: bytes, size: lines*dataBitsPerLine, dataBitsPerLine: dataBitsPerLine, bytesPerLine: bytesPerLine]]; RETURN [NEW[VectorRep _ [class: packedBitClass, data: data]]] }; scratchText: REF TEXT _ NIL; ObtainScratch: ENTRY PROC [size: NAT] RETURNS [text: REF TEXT _ NIL] ~ { ENABLE UNWIND => NULL; IF scratchText#NIL AND scratchText.maxLength >= size THEN {text _ scratchText; text.length _ 0; scratchText _ NIL} ELSE text _ NEW[TEXT[size]]; }; ReleaseScratch: ENTRY PROC [text: REF TEXT] ~ { scratchText _ text; }; UnsafeGetElements: PUBLIC UNSAFE PROC [vector: Vector, buffer: LONG POINTER TO Basics.RawWords, start: INT, count: NAT] ~ UNCHECKED { IF vector.class = packedByteClass THEN { data: PackedByteData ~ NARROW[vector.data]; byteCount: NAT ~ Basics.LongMult[count, data.bytesPerElement]; text: REF TEXT ~ ObtainScratch[byteCount]; startByte: INT ~ BoundsCheckCardinal[start]*data.bytesPerElement; zero: [0..0] ~ Rope.AppendChars[buffer: text, rope: data.bytes, start: startByte, len: byteCount]-byteCount; bytePtr: LONG POINTER ~ LOOPHOLE[text, LONG POINTER] + SIZE[TEXT[0]]; ImagerSample.UnsafeGetF[samples: buffer, count: count, s: 0, f: 0, base: bytePtr, wordsPerLine: LAST[NAT], bitsPerSample: data.bytesPerElement*8]; ReleaseScratch[text]; } ELSE { <> FOR i: INT IN [0..count) DO buffer[i] _ GetCardinal[vector, start+i]; ENDLOOP; }; }; bitsPerWord: NAT ~ Basics.bitsPerWord; nullBitBltTable: PrincOps.BitBltTable ~ [ dst: [word: NIL, bit: 0], dstBpl: 0, src: [word: NIL, bit: 0], srcDesc: [srcBpl[0]], width: 0, height: 0, flags: [] ]; UnsafeGetBits: PUBLIC UNSAFE PROC [vector: Vector, dst: PrincOps.BitAddress, start: INT, count: NAT, srcFunc: PrincOps.SrcFunc, dstFunc: PrincOps.DstFunc] ~ UNCHECKED { IF vector.class = packedBitClass THEN { data: PackedBitData ~ NARROW[vector.data]; text: REF TEXT ~ ObtainScratch[(CARDINAL[count]+7)/8]; index: INT _ BoundsCheckCardinal[start]; residual: CARDINAL _ count; dstBase: LONG POINTER _ dst.word; dstBit: CARDINAL _ dst.bit; bbTableSpace: PrincOps.BBTableSpace; bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace]; bb^ _ nullBitBltTable; bb.flags _ [disjoint: TRUE, gray: FALSE, srcFunc: srcFunc, dstFunc: dstFunc]; bb.height _ 1; bb.src.word _ LOOPHOLE[text, LONG POINTER] + SIZE[TEXT[0]]; UNTIL residual = 0 DO zero: [0..0]; line, dot, delta, byteCount: CARDINAL; [quotient: line, remainder: dot] _ Basics.LongDivMod[index, data.dataBitsPerLine]; bb.width _ delta _ MIN[residual, NAT[data.dataBitsPerLine-dot]]; byteCount _ (delta+7)/8; text.length _ 0; zero _ Rope.AppendChars[buffer: text, rope: data.bytes, start: Basics.LongMult[line, data.bytesPerLine]+dot/8, len: byteCount]-byteCount; bb.dst _ [word: dstBase, bit: dstBit]; bb.src.bit _ dot MOD 8; PrincOpsUtils.BITBLT[bb]; dstBase _ dstBase + NAT[dstBit + delta] / bitsPerWord; dstBit _ NAT[dstBit + delta] MOD bitsPerWord; index _ index + delta; residual _ residual - delta; ENDLOOP; ReleaseScratch[text]; } ELSE ERROR; -- could do it, but it would be slow; avoid at a higher level. }; <> <> <> <> <> <<];>> <<>> <> <> <> <> <> <> <> <<];>> <> <> <> <> <<};>> <> <> <= data.length THEN ERROR IO.EndOfStream[self]>> <> <> <> <> <<};>> <<};>> <> <> <= data.length];>> <<};>> <> <> <> <<};>> <> <> <> <> <<};>> <> <> <> <<};>> END.