
    <<XlTextWindowImpl.mesa>>
        <<Copyright Ó 1988, 1989, 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Christian Jacobi, July 4, 1988 1:01:32 pm PDT>>
        <<Christian Jacobi, March 24, 1992 3:42 pm PST>>

    DIRECTORY 
        IO,
        Ascii,
        RefText,
        Rope, 
        Xl,
        XlCursor,
        XlTextWindow;

    XlTextWindowImpl: CEDAR MONITOR 
        IMPORTS IO, RefText, Rope, Xl, XlCursor
        EXPORTS XlTextWindow =
    BEGIN OPEN Xl, XlTextWindow;

    Failed: PUBLIC ERROR = CODE;

    myPropKey: REF ATOM Ź NEW[ATOM Ź $XlTextWindowImpl];

    events: EventFilter ~ CreateEventFilter[configureNotify, destroyNotify];

    TextConnection: TYPE = REF TextConnectionRec;
    TextConnectionRec: TYPE = MONITORED RECORD [
        tq: TQ Ź NIL,  --share the expose tq for texts of same connection
        textCursor: Xl.Cursor Ź nullCursor,
        defaultFont: Font Ź nullFont
        ];

    InitConnection: InitializeProcType = {
        tcr: TextConnection Ź NEW[TextConnectionRec];
        tcr.tq Ź CreateTQ[$XlTextWindowImpl];
        tcr.textCursor Ź XlCursor.SharedStandardCursor[c, circle];
        RETURN [tcr]
        };

    TextRecord: TYPE = MONITORED RECORD [
        connection: Xl.Connection Ź NIL,
        window: Window Ź nullWindow,
        wSize: Size Ź [0, 0], --size of window
        lineDY: INT Ź 15, --distance between lines
        leftSpace: NAT Ź 2, --distance between left border and first character x origin
        rightSpace: NAT Ź 2, --distance between window right border and last characters right border
        topOffset, bottomOffset: NAT Ź 2, --distance between baseline and border
        ascent, descent: NAT Ź 2,
        bottomSpace: NAT Ź 2, 
        charDX: NAT Ź 10, 
        lineSpace: NAT Ź 2,
        pos: Point Ź [0, 0], --position for next character; not yet clipped
        font: Font Ź nullFont,
        gc: GContext Ź NIL, --could we somehow share gc's?
        alive: BOOL Ź TRUE 
        ];

    SetWindowSize: ENTRY PROC [tRef: REF TextRecord, s: Size] = {
        IF tRef#NIL THEN tRef.wSize Ź s
        };

    TextEventProc: EventProcType = {
        ENABLE Xl.XError => GOTO oops;
        tRef: REF TextRecord ~ NARROW[clientData];
        WITH event SELECT FROM
            destroyNotify: DestroyNotifyEvent => {
                IF destroyNotify.window=tRef.window THEN tRef.alive Ź FALSE
                };
            configureNotify: ConfigureNotifyEvent => {
                IF configureNotify.window=tRef.window THEN {
                    SetWindowSize[tRef, configureNotify.geometry.size];
                    };
                };
            mapNotify: MapNotifyEvent => {
                IF mapNotify.window=tRef.window THEN {
                    g: GeometryRec Ź GetGeometry[event.connection, tRef.window];
                    SetWindowSize[tRef, g.geometry.size];
                    };
                };
            ENDCASE => {};
        EXITS oops => {};
        };


    CreateTextHandle: PUBLIC PROC [] RETURNS [handle: Handle] = {
        tRef: REF TextRecord Ź NEW[TextRecord];
        RETURN [tRef];
        };

    CreateTextWindow: PUBLIC PROC [handle: Handle, c: Connection, parent: Window, geometry: Geometry, font: Font Ź nullFont, 
    moreMatches: MatchList Ź NIL, depth: INTEGER Ź -1, attributes: Attributes] = {
        SetupFont: PROC [tcr: TextConnection] = {
            ENABLE UNWIND => NULL;
            IF tcr.defaultFont=nullFont THEN { 
                tcr.defaultFont Ź Xl.OpenFont[c, "8x13"];
                } 
            };
        screen: Screen Ź QueryScreen[c, parent];
        tcr: TextConnection Ź NARROW[GetConnectionPropAndInit[c, myPropKey, InitConnection]];
        tRef: REF TextRecord Ź NARROW[handle];
        IF tRef.window#nullWindow THEN ERROR; 
        attributes.eventMask Ź OREvents[attributes.eventMask, exposureMask, structureNotifyMask];
        IF attributes.backgroundPixel=illegalPixel THEN attributes.backgroundPixel Ź screen.whitePixel; 
        IF font=nullFont THEN {
            IF tcr.defaultFont=nullFont THEN SetupFont[tcr];
            font Ź tcr.defaultFont 
            };
        tRef.connection Ź c; tRef.font Ź font; 
        Xl.IncRefCount[c, tRef];
        SetWindowSize[tRef, geometry.size];
        BEGIN
            fi: REF READONLY FontInfoRec Ź QueryFont[c, tRef.font];
            tRef.ascent Ź fi.fontAscent;
            tRef.descent Ź fi.fontDescent;
            tRef.lineDY Ź tRef.ascent+tRef.descent+tRef.lineSpace;
            tRef.charDX Ź fi.maxBounds.charWidth;
            tRef.topOffset Ź tRef.ascent+tRef.lineSpace;
            tRef.bottomOffset Ź tRef.descent+tRef.bottomSpace;
            tRef.gc Ź MakeGContext[c]; --should we share contexts of same parent???
            SetGCForeground[tRef.gc, screen.blackPixel];
            SetGCBackground[tRef.gc, screen.whitePixel];
            SetGCFont[tRef.gc, font];
            END; 
        HomePos[tRef];
        moreMatches Ź CONS[
            NEW[MatchRep Ź [proc: TextEventProc, handles: events, tq: tcr.tq, data: tRef]],
            moreMatches
            ];
        IF IllegalCursor[attributes.cursor] THEN attributes.cursor Ź tcr.textCursor;
        tRef.window Ź CreateWindow[c: c, matchList: moreMatches, geometry: geometry, depth: depth, attributes: attributes, parent: parent]; 
        tRef.alive Ź TRUE;
        };

    ForgetWindow: PUBLIC PROC [handle: Handle] = {
        tRef: REF TextRecord Ź NARROW[handle];
        Xl.DecRefCount[tRef.connection, tRef];
        tRef.alive Ź FALSE; 
        tRef.connection Ź NIL; 
        tRef.window Ź Xl.nullWindow; 
        };

    GetWindow: PUBLIC PROC [handle: Handle] RETURNS [w: Xl.Window] = {
        tRef: REF TextRecord Ź NARROW[handle];
        RETURN [tRef.window];
        };

    HomePos: ENTRY PROC [tRef: REF TextRecord] = {
        ENABLE UNWIND => NULL;
        IF tRef#NIL THEN {
            tRef.pos.x Ź tRef.leftSpace;
            tRef.pos.y Ź tRef.topOffset;
            };
        };

    PosAndIncrement: ENTRY PROC [tr: REF TextRecord, rr: INT] RETURNS [pos: Point Ź [0, 0]] = {
        <<--increments position but returns previous value atomicly>>
        ENABLE UNWIND => NULL;
        IF tr#NIL THEN {
            pos Ź tr.pos; 
            tr.pos.x Ź tr.pos.x+rr;
            };
        };

    OutRope: PUBLIC PROC [handle: Handle, r: Rope.ROPE, start: INT Ź 0, len: INT Ź Rope.MaxLen] = {
        tRef: REF TextRecord Ź NARROW[handle];
        Action: Rope.ActionType = {UnflushedOutChar[tRef, c]};
        IF tRef.window=nullWindow THEN RETURN;
        [] Ź Rope.Map[base: r, action: Action, len: len, start: start];
        Flush[tRef.connection, 200];
        };

    OutChar: PUBLIC PROC [handle: Handle, ch: CHAR] = {
        tRef: REF TextRecord Ź NARROW[handle];
        IF tRef.window=nullWindow THEN RETURN;
        UnflushedOutChar[tRef, ch];
        Flush[tRef.connection, 200];
        };

    UnflushedOutChar: PROC [tRef: REF TextRecord, ch: CHAR] = {
        IF tRef.connection=NIL OR ~tRef.alive THEN RETURN;
        <<IF ~tRef.alive THEN ERROR Failed;>>
        SELECT ch FROM
            Ascii.CR, Ascii.LF => {
                NewLine[tRef];
                };
            Ascii.FF => {
                HomePos[tRef];
                ClearArea[tRef.connection, tRef.window, [0, 0], [2000, 2000], FALSE];
                };
            Ascii.NUL => {};
            Ascii.BS => {
                tRef.pos.x Ź MAX[tRef.pos.x-tRef.charDX, 0];
                ClearArea[tRef.connection, tRef.window, [tRef.pos.x, MAX[tRef.pos.y, tRef.ascent]-tRef.ascent], [tRef.charDX, tRef.lineDY], FALSE];
                };
            ENDCASE => {
                pos: Point;
                IF INT[tRef.pos.x+tRef.charDX+tRef.rightSpace]>INT[tRef.wSize.width] AND tRef.pos.x>tRef.leftSpace THEN NewLine[tRef];
                pos Ź PosAndIncrement[tRef, tRef.charDX];
                Xl.ImageChar[tRef.connection, tRef.window.drawable, pos, tRef.gc, ch];
                };
        };

    NewLine: PROC [tr: REF TextRecord] = {
        mustScroll: INT Ź AdvanceLine[tr];
        IF mustScroll>0 AND tr.alive THEN {
            y: INT;
            <<--scrollup>>
            Xl.CopyArea[c: tr.connection, src: tr.window.drawable, dst: tr.window.drawable, srcP: [0, mustScroll], dstP: [0, 0], size: 
            [tr.wSize.width, tr.wSize.height-mustScroll], gc: tr.gc];
            <<--clear bottom>>
            y Ź MAX[tr.pos.y, tr.ascent]-tr.ascent;
            ClearArea[tr.connection, tr.window, [0, y], [2000, 2000]];
            };
        };

    AdvanceLine: ENTRY PROC [tr: REF TextRecord] RETURNS [mustScroll: INTŹ0] = {
        ENABLE UNWIND => NULL;
        tr.pos.y Ź tr.pos.y+tr.lineDY;
        tr.pos.x Ź tr.leftSpace;
        IF INT[tr.pos.y+tr.bottomOffset] > INT[tr.wSize.height] THEN {
            mustScroll Ź MIN[MAX[tr.wSize.height/4, tr.lineDY], tr.wSize.height];
            tr.pos.y Ź tr.pos.y - mustScroll;
            }
        };

    outputStreamProcs: REF IO.StreamProcs Ź IO.CreateStreamProcs[
        variety: $output, 
        class: $XlTexts,
        putChar: OutputTextWindowStreamPutChar,
        putBlock: OutputTextWindowStreamPutBlock,
        eraseChar: OutputTextWindowStreamEraseChar
        ];

    OutputTextWindowStreamPutChar: PROC [self: IO.STREAM, char: CHAR] = {
        ENABLE Xl.XError, Failed => {ERROR IO.Error[StreamClosed, self]};
        tRef: REF TextRecord  = NARROW[self.streamData];
        IF tRef.window=nullWindow THEN RETURN;
        UnflushedOutChar[tRef, char];
        Flush[tRef.connection, 200];
        };

    OutputTextWindowStreamPutBlock: PROC [self: IO.STREAM, block: REF READONLY TEXT, startIndex: NAT, count: NAT] = {
        ENABLE Xl.XError, Failed => {ERROR IO.Error[StreamClosed, self]};
        tRef: REF TextRecord  = NARROW[self.streamData];
        Action: PROC[c: CHAR] RETURNS [BOOLŹFALSE] = {UnflushedOutChar[tRef, c]};
        IF tRef.window=nullWindow THEN RETURN;
        [] Ź RefText.Map[s: block, action: Action, len: count, start: startIndex];
        Flush[tRef.connection, 200];
        };

    OutputTextWindowStreamEraseChar: PROC [self: IO.STREAM, char: CHAR] = {
        OutputTextWindowStreamPutChar[self, Ascii.BS]
        };

    OutputStream: PUBLIC PROC [handle: Handle] RETURNS [s: IO.STREAM] = {
        RETURN[IO.CreateStream[streamProcs: outputStreamProcs, streamData: handle]];
        };

    END.