ruberon/source/TEXTDRV.ob07

MODULE TEXTDRV;

IMPORT FILES, C := COLLECTIONS;


CONST

    CR = 0DX; LF = 0AX; HT = 9X;

    CHUNK = 1024 * 256;

    defTabSize* = 4;


TYPE

    TEXT* = POINTER TO RECORD (C.ITEM)

        chunk:        ARRAY CHUNK OF CHAR;
        pos, size:    INTEGER;
        file:         FILES.FILE;
        utf8:         BOOLEAN;
        CR:           BOOLEAN;

        line*, col*:  INTEGER;
        ifc*:         INTEGER;
        elsec*:       INTEGER;
        eof*:         BOOLEAN;
        eol*:         BOOLEAN;
        skip*:        BOOLEAN;
        peak*:        CHAR;
        _skip*,
        _elsif*,
        _else*:       ARRAY 100 OF BOOLEAN;
        fname*:       ARRAY 2048 OF CHAR

    END;


VAR

    texts: C.COLLECTION;
    TabSize: INTEGER;


PROCEDURE load (text: TEXT);
    BEGIN
        IF ~text.eof THEN
            text.size := FILES.read(text.file, text.chunk, LEN(text.chunk));
            text.pos := 0;
            IF text.size = 0 THEN
                text.eof := TRUE;
                text.chunk[0] := 0X
            END;
            text.peak := text.chunk[0]
        END
    END load;


PROCEDURE next* (text: TEXT);
    VAR
        c: CHAR;

    BEGIN
        IF text.pos < text.size - 1 THEN
            INC(text.pos);
            text.peak := text.chunk[text.pos]
        ELSE
            load(text)
        END;

        IF ~text.eof THEN

            c := text.peak;

            IF c = CR THEN
                INC(text.line);
                text.col := 0;
                text.eol := TRUE;
                text.CR  := TRUE
            ELSIF c = LF THEN
                IF ~text.CR THEN
                    INC(text.line);
                    text.col := 0;
                    text.eol := TRUE
                ELSE
                    text.eol := FALSE
                END;
                text.CR := FALSE
            ELSIF c = HT THEN
                text.col := text.col + TabSize - text.col MOD TabSize;
                text.eol := FALSE;
                text.CR  := FALSE
            ELSE
                IF text.utf8 THEN
                    IF ORD(c) DIV 64 # 2 THEN
                        INC(text.col)
                    END
                ELSE
                    INC(text.col)
                END;
                text.eol := FALSE;
                text.CR  := FALSE
            END

        END

    END next;


PROCEDURE init (text: TEXT);
    BEGIN
        IF (text.pos = 0) & (text.size >= 3) THEN
            IF (text.chunk[0] = 0EFX) &
            (text.chunk[1] = 0BBX) &
            (text.chunk[2] = 0BFX) THEN
                text.pos := 3;
                text.utf8 := TRUE
            END
        END;

        IF text.size = 0 THEN
            text.chunk[0] := 0X;
            text.size := 1;
            text.eof := FALSE
        END;

        text.line := 1;
        text.col  := 1;

        text.peak := text.chunk[text.pos]
    END init;


PROCEDURE close* (VAR text: TEXT);
    BEGIN
        IF text # NIL THEN
            IF text.file # NIL THEN
                FILES.close(text.file)
            END;

            C.push(texts, text);
            text := NIL
        END
    END close;


PROCEDURE open* (name: ARRAY OF CHAR): TEXT;
    VAR
        text: TEXT;
        citem: C.ITEM;

    BEGIN
        citem := C.pop(texts);
        IF citem = NIL THEN
            NEW(text)
        ELSE
            text := citem(TEXT)
        END;

        IF text # NIL THEN
            text.chunk[0] := 0X;
            text.pos  := 0;
            text.size := 0;
            text.utf8 := FALSE;
            text.CR   := FALSE;
            text.line := 1;
            text.col  := 1;
            text.eof  := FALSE;
            text.eol  := FALSE;
            text.skip := FALSE;
            text.ifc  := 0;
            text.elsec := 0;
            text._skip[0] := FALSE;
            text.peak := 0X;
            text.file := FILES.open(name);
            COPY(name, text.fname);
            IF text.file # NIL THEN
                load(text);
                init(text)
            ELSE
                close(text)
            END
        END

        RETURN text
    END open;


PROCEDURE setTabSize* (n: INTEGER);
    BEGIN
        IF (0 < n) & (n <= 64) THEN
            TabSize := n
        ELSE
            TabSize := defTabSize
        END
    END setTabSize;


BEGIN
    TabSize := defTabSize;
    texts := C.create()
END TEXTDRV.