DIRECTORY
IO USING [Backup, CharsAvail, Close, CreateStream, CreateStreamProcs, EndOf, EndOfStream, EraseChar, GetChar, PutBlock, PutChar, PutF, STREAM, StreamProcs, Value],
IOUtils USING [AmbushStream, closedStreamProcs, CopyPFProcs, Format, PFProcs, SetPFCodeProc, SetPFProcs],
MoreIOClasses USING [],
RefText USING [New],
Rope USING [Concat, ROPE];
MoreIOClassesImpl:
CEDAR
PROGRAM
IMPORTS IO, IOUtils, RefText, Rope
EXPORTS MoreIOClasses
= {
STREAM: TYPE = IO.STREAM;
Joining: TYPE = REF JoiningPrivate;
JoiningPrivate:
TYPE =
RECORD [
input, output: IO.STREAM
];
joinProcs:
REF
IO.StreamProcs =
IO.CreateStreamProcs[
variety: inputOutput,
class: $MoreIOClassesJoin,
getChar: GetJoinChar,
endOf: EndOfJoin,
charsAvail: JoinCharsAvail,
backup: BackupJoin,
putChar: PutJoinChar,
close: CloseJoin,
eraseChar: EraseJoinChar
];
joinPFProcs: IOUtils.PFProcs ← IOUtils.CopyPFProcs[NIL];
Join:
PUBLIC
PROC [input, output:
IO.
STREAM]
RETURNS [joined:
IO.
STREAM] = {
jg: Joining = NEW [JoiningPrivate ← [input, output]];
joined ← IO.CreateStream[joinProcs, jg];
[] ← IOUtils.SetPFProcs[joined, joinPFProcs];
};
GetJoinChar:
PROC [self:
STREAM]
RETURNS [char:
CHAR] = {
jg: Joining = NARROW[self.streamData];
char ← jg.input.GetChar[];
};
EndOfJoin:
PROC [self:
STREAM]
RETURNS [b:
BOOL] = {
jg: Joining = NARROW[self.streamData];
b ← jg.input.EndOf[];
};
JoinCharsAvail:
PROC [self:
STREAM, wait:
BOOL]
RETURNS [avail:
INT] = {
jg: Joining = NARROW[self.streamData];
avail ← jg.input.CharsAvail[wait];
};
BackupJoin:
PROC [self:
STREAM, char:
CHAR] = {
jg: Joining = NARROW[self.streamData];
jg.input.Backup[char];
};
PutJoinChar:
PROC [self:
STREAM, char:
CHAR] = {
jg: Joining = NARROW[self.streamData];
jg.output.PutChar[char];
};
CloseJoin:
PROC [self:
STREAM, abort:
BOOL ←
FALSE] = {
jg: Joining = NARROW[self.streamData];
jg.input.Close[abort];
jg.output.Close[abort];
IOUtils.AmbushStream[self, IOUtils.closedStreamProcs, NIL];
};
EraseJoinChar:
PROC [self:
STREAM, char:
CHAR] = {
jg: Joining = NARROW[self.streamData];
jg.output.EraseChar[char];
};
PFJoinL:
PROC [stream:
STREAM, val:
IO.Value, format: IOUtils.Format, char:
CHAR]
--IOUtils.PFCodeProc-- = {
jg: Joining = NARROW[stream.streamData];
jg.output.PutF["%l", val];
};
Buffer: TYPE = REF BufferPrivate;
BufferPrivate:
TYPE =
RECORD [
tHead, tTail: TextList ← NIL,
lHead, lTail: LooksList ← NIL
];
TextList: TYPE = LIST OF Text;
Text:
TYPE =
RECORD [
startIndex: INT,
text: REFTEXT
];
TextSize: NAT ← 240;
REFTEXT: TYPE = REF TEXT;
ROPE: TYPE = Rope.ROPE;
LooksList: TYPE = LIST OF Looks;
Looks:
TYPE =
RECORD [
index: INT,
deltaLooks: ROPE ← NIL];
buffProcs:
REF
IO.StreamProcs =
IO.CreateStreamProcs[
variety: output,
class: $MoreIOClassesBuff,
putChar: PutBuffChar,
close: CloseBuff
];
buffPFProcs: IOUtils.PFProcs ← IOUtils.CopyPFProcs[NIL];
CreateBuffer:
PUBLIC
PROC
RETURNS [buffer:
IO.
STREAM] = {
br: Buffer = NEW [BufferPrivate ← []];
ClearBuffer[br];
buffer ← IO.CreateStream[buffProcs, br];
[] ← IOUtils.SetPFProcs[buffer, buffPFProcs];
};
ClearBuffer:
PROC [br: Buffer] = {
t0: TextList = LIST[[0, RefText.New[TextSize]]];
l0: LooksList = LIST[[0]];
br^ ← [t0, t0, l0, l0];
};
PutBuffChar:
PROC [self:
STREAM, char:
CHAR] = {
br: Buffer = NARROW[self.streamData];
t: TextList ← br.tTail;
len: INT = t.first.text.maxLength;
IF t.first.text.length = len
THEN {
t ← LIST[[t.first.startIndex + len, RefText.New[TextSize]]];
br.tTail ← br.tTail.rest ← t};
t.first.text[t.first.text.length] ← char;
t.first.text.length ← t.first.text.length + 1;
};
CloseBuff:
PROC [self:
STREAM, abort:
BOOL ←
FALSE] = {
br: Buffer = NARROW[self.streamData];
IOUtils.AmbushStream[self, IOUtils.closedStreamProcs, self.streamData];
};
PFBuffL:
PROC [stream:
STREAM, val:
IO.Value, format: IOUtils.Format, char:
CHAR]
--IOUtils.PFCodeProc-- = {
br: Buffer = NARROW[stream.streamData];
l: LooksList ← br.lTail;
index: INT = br.tTail.first.startIndex + br.tTail.first.text.length;
dLooks:
ROPE =
WITH val
SELECT
FROM
x: rope IO.Value => x.value,
ENDCASE => ERROR;
IF l.first.index # index
THEN {
l ← LIST[[index]];
br.lTail ← br.lTail.rest ← l};
l.first.deltaLooks ← l.first.deltaLooks.Concat[dLooks];
};
SendBuffer:
PUBLIC
PROC [buffer, to:
IO.
STREAM, andErase:
BOOL] = {
br: Buffer = NARROW[buffer.streamData];
tHead: TextList ← br.tHead;
lHead: LooksList ← br.lHead;
index: INT ← 0;
size: INT = br.tTail.first.startIndex + br.tTail.first.text.length;
DO
SELECT
TRUE
FROM
index = size AND lHead = NIL => EXIT;
lHead #
NIL
AND lHead.first.index <= index => {
to.PutF["%l", [rope[lHead.first.deltaLooks]]];
lHead ← lHead.rest;
};
index < size
AND (lHead =
NIL
OR lHead.first.index > index) => {
limit: INT = IF lHead = NIL THEN size ELSE lHead.first.index;
blockStart: INT = tHead.first.startIndex;
blockEnd: INT = blockStart + tHead.first.text.length;
nChars: INT = MIN[limit, blockEnd] - index;
to.PutBlock[tHead.first.text, index-blockStart, nChars];
IF (index ← index + nChars) = blockEnd THEN tHead ← tHead.rest;
};
ENDCASE => ERROR ENDLOOP;
IF andErase THEN ClearBuffer[br];
};
emptyInputProcs:
REF
IO.StreamProcs =
IO.CreateStreamProcs[
variety: input,
class: $MoreIOClassesEmptyInput,
getChar: GetEmptyChar,
endOf: EndOfEmpty,
charsAvail: EmptyCharsAvail,
close: CloseEmpty
];
emptyInputStream: PUBLIC IO.STREAM ← IO.CreateStream[emptyInputProcs, NIL];
GetEmptyChar:
PROC [self:
STREAM]
RETURNS [
CHAR] = {
ERROR IO.EndOfStream[self];
};
EndOfEmpty: PROC [self: STREAM] RETURNS [BOOL] = {RETURN [TRUE]};
EmptyCharsAvail: PROC [self: STREAM, wait: BOOL] RETURNS [INT] = {RETURN [0]};
CloseEmpty: PROC [self: STREAM, abort: BOOL ← FALSE] = {IOUtils.AmbushStream[self, IOUtils.closedStreamProcs, NIL]};
Start:
PROC = {
[] ← IOUtils.SetPFCodeProc[joinPFProcs, 'l, PFJoinL];
[] ← IOUtils.SetPFCodeProc[buffPFProcs, 'l, PFBuffL];
};
Start[];
}.