<<>>
    <<MoreIOClassesImpl.Mesa>>
        <<Copyright Ó 1991 by Xerox Corporation.  All rights reserved.>>
        <<Spreitzer, April 25, 1986 10:39:38 pm PST>>
        <<JKF January 11, 1989 9:52:17 am PST>>
        <<Michael Plass, November 27, 1991 10:35 am PST>>

    DIRECTORY
        IO USING [Backup, CharsAvail, Close, CreateStream, CreateStreamProcs, EndOf, EndOfStream, EraseChar, GetChar, PutBlock, PutChar, 
        PutF1, 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.PutF1["%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.PutF1["%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[];

        }.