DIRECTORY
Atom, Convert, IO, IOUtils, RefText, Rope, TapeStreams, Translate;
TapeFmtConversion:
CEDAR
PROGRAM
IMPORTS Atom, Convert,
IO, IOUtils, RefText, Translate
SHARES TapeStreams =
BEGIN
FromANSIVariable: TapeStreams.Conversion =
BEGIN
[ base: IO.STREAM , clientData: REF ANY ← NIL] RETURNS [ s: IO.STREAM ];
s ←
IO.CreateStream[
streamProcs:
IO.CreateStreamProcs[
variety: input,
class: $FromANSIVariable,
getChar: ANSIGetChar],
streamData: NEW[ANSIInRec ← []],
backingStream: base];
END;
ANSIInRec:
TYPE =
RECORD [
charsToCR: INT ← -1
];
ANSIIn: TYPE = REF ANSIInRec ← NIL;
ANSIGetChar:
PROC [ self:
IO.
STREAM ]
RETURNS [
CHAR ] =
BEGIN
a: ANSIIn = NARROW[self.streamData];
DO
SELECT (a.charsToCR ← a.charsToCR-1)
FROM
> -1 => RETURN[IO.GetChar[self.backingStream]];
= -1 => RETURN['\n];
ENDCASE =>
BEGIN
t: REF TEXT = NEW[TEXT[4]];
c: CHAR;
FOR c ←
IO.GetChar[self.backingStream],
IO.GetChar[self.backingStream]
WHILE
NOT c
IN ['0..'9]
DO
-- skip over interblock padding
IF c # '^ THEN ERROR; -- is padding always '^ ?
ENDLOOP;
t.length ← 4;
t[0] ← c;
FOR i: INT IN [1..3] DO t[i] ← IO.GetChar[self.backingStream] ENDLOOP;
a.charsToCR ← Convert.IntFromRope[RefText.TrustTextAsRope[t]]-4;
END;
ENDLOOP;
END;
ToANSIVariable: TapeStreams.Conversion =
BEGIN
[ base: IO.STREAM , clientData: REF ANY ← NIL] RETURNS [ s: IO.STREAM ];
blockSize: INT ← 80;
streamData: ANSIOut ←
NEW[ANSIOutRec ← [
flushBlockBacking: NARROW[IOUtils.LookupProc[base, $FlushBlock], REF TapeStreams.FlushBlockProc]^]];
FOR prev:
IO.
STREAM ← base, prev.backingStream
WHILE prev #
NIL
DO
WITH prev.streamData
SELECT
FROM
t: TapeStreams.TapeStreamState => {blockSize ← t.blockSize; EXIT};
ENDCASE => NULL;
ENDLOOP;
streamData.buf ← NEW[TEXT[blockSize-4]];
streamData.buf.length ← 0;
s ←
IO.CreateStream[
streamProcs:
IO.CreateStreamProcs[
variety: output,
class: $ToANSIVariable,
putChar: ANSIPutChar,
flush: ANSIFlush],
streamData: streamData,
backingStream: base];
END;
ANSIOutRec:
TYPE =
RECORD [
flushBlockBacking: TapeStreams.FlushBlockProc ← NIL,
buf: REF TEXT ← NIL
];
ANSIOut: TYPE = REF ANSIOutRec ← NIL;
ANSIPutChar:
PROC [ self:
IO.
STREAM, char:
CHAR ] =
BEGIN
a: ANSIOut = NARROW[self.streamData];
SELECT char
FROM
'\n =>
BEGIN
a.flushBlockBacking[self: self.backingStream, padChar: '^, bytesRequired: 4+a.buf.length];
self.backingStream.PutF["%04d%g", IO.int[4+a.buf.length], IO.text[a.buf]];
a.buf.length ← 0;
END;
ENDCASE => {a.buf[a.buf.length] ← char; a.buf.length ← a.buf.length+1};
END;
ANSIFlush:
PROC [ self:
IO.
STREAM ] =
BEGIN
a: ANSIOut = NARROW[self.streamData];
ANSIPutChar[self, ' ];
a.flushBlockBacking[self: self.backingStream, padChar: '^];
END;
ANSIFlushBlock:
PROC [ self:
IO.
STREAM, padChar:
CHAR ← '\000, bytesRequired:
INT ←
LAST[
INT], truncate:
BOOL ←
FALSE ]
-- TapeStreams.FlushBlockProc -- =
BEGIN
a: ANSIOut = NARROW[self.streamData];
ERROR; -- I'm not quite sure what this operation means...
END;
ToPGT: TapeStreams.Conversion =
BEGIN
[ base: IO.STREAM , clientData: REF ANY ← NIL] RETURNS [ s: IO.STREAM ];
convert: TapeStreams.Conversion = Translate.AsciiToEbcdic[lrecl: 0].first^.proc;
ebcdicBase: IO.STREAM = convert[base];
s ←
IO.CreateStream[
streamProcs:
IO.CreateStreamProcs[
variety: output,
class: $ToPGT,
putChar: PGTPutChar],
streamData: NIL,
backingStream: ebcdicBase];
END;
PGTPutChar:
PROC [ self:
IO.
STREAM, char:
CHAR ] =
BEGIN
SELECT char
FROM
' , '\n => NULL;
ENDCASE => self.backingStream.PutChar[char];
END;
pl: Atom.PropList ← NARROW[Atom.GetProp[$TapeTool, $Conversions]];
pl ← Atom.PutPropOnList[pl, $FromEbcdic, Translate.EbcdicToAscii[].first];
pl ← Atom.PutPropOnList[pl, $ToEbcdic, Translate.AsciiToEbcdic[].first];
pl ← Atom.PutPropOnList[pl, $ToPGT,
NEW[TapeStreams.ConversionRecord ← [$ToPGT, ToPGT, NIL]]];
pl ← Atom.PutPropOnList[pl, $FromANSIVariable,
NEW[TapeStreams.ConversionRecord ← [$FromANSIVariable, FromANSIVariable, NIL]]];
pl ← Atom.PutPropOnList[pl, $ToANSIVariable,
NEW[TapeStreams.ConversionRecord ← [$ToANSIVariable, ToANSIVariable, NIL]]];
Atom.PutProp[$TapeTool, $Conversions, pl];
END.