kolibrios-fun/programs/develop/cedit/SRC/Lines.ob07

(*
    Copyright 2021-2023 Anton Krotov

    This file is part of CEdit.

    CEdit is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    CEdit is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)

MODULE Lines;

IMPORT
    List, SYSTEM, API, Utils;

CONST
    WCHAR_SIZE = 2;
    SPACE* = 20X;
    TAB* = 9X;
    NUL* = 0FDD0X;
    TAB1* = 0FDD1X;
    MAX_TAB_WIDTH* = 16;

TYPE

    tLine* = POINTER TO RECORD (List.tItem)
        ptr: INTEGER;
        length*: INTEGER;
        modified*, saved*, temp, label*: BOOLEAN;
        cin*, cout*, pos*: INTEGER
    END;

    PmovInt = PROCEDURE (VAR v: INTEGER; x: INTEGER);
    PmovBool = PROCEDURE (save: BOOLEAN; VAR v1: BOOLEAN; x1: BOOLEAN; VAR v2: BOOLEAN; x2: BOOLEAN);
    PmovPtr = PROCEDURE (VAR v: List.tItem; x: List.tItem);

    PTypedPtr = PROCEDURE (p: List.tItem);
    PUntypedPtr = PROCEDURE (p: INTEGER);

    tVector* = POINTER TO RECORD
    	size, data: INTEGER
    END;

    tVectorItem = tLine;

    fConvert* = PROCEDURE (VAR c: WCHAR): BOOLEAN;


VAR

    _movInt: PmovInt;
    _movBool: PmovBool;
    _movPtr: PmovPtr;
    _typedPtr: PTypedPtr;
    _untypedPtr: PUntypedPtr;

    pMaxLength, tab*: INTEGER;
    tabs*: BOOLEAN;


PROCEDURE createVector* (size: INTEGER): tVector;
VAR
	res: tVector;
BEGIN
	IF size > 0 THEN
		NEW(res);
		res.size := size;
		IF size < 4096 THEN
			size := 4096
		END;
		res.data := API._NEW(size*SYSTEM.SIZE(tVectorItem));
		IF res.data = 0 THEN
			DISPOSE(res)
		END
	ELSE
		res := NIL
	END
	RETURN res
END createVector;


PROCEDURE destroyVector* (VAR vector: tVector);
BEGIN
	IF vector # NIL THEN
		IF vector.data # 0 THEN
			vector.data := API._DISPOSE(vector.data)
		END;
		DISPOSE(vector)
	END
END destroyVector;


PROCEDURE setVectorItem* (vector: tVector; idx: INTEGER; item: tVectorItem);
BEGIN
	ASSERT(vector # NIL);
	ASSERT((0 <= idx) & (idx < vector.size));
	SYSTEM.PUT(vector.data + idx*SYSTEM.SIZE(tVectorItem), item)
END setVectorItem;


PROCEDURE getVectorItem* (vector: tVector; idx: INTEGER): tVectorItem;
VAR
	res: tVectorItem;
BEGIN
	ASSERT(vector # NIL);
	ASSERT((0 <= idx) & (idx < vector.size));
	SYSTEM.GET(vector.data + idx*SYSTEM.SIZE(tVectorItem), res)
	RETURN res
END getVectorItem;


PROCEDURE movInt (VAR v: INTEGER; x: INTEGER);
BEGIN
    _movInt(v, x)
END movInt;


PROCEDURE movPtr (VAR v: List.tItem; x: List.tItem);
BEGIN
    _movPtr(v, x)
END movPtr;


PROCEDURE malloc (size: INTEGER): INTEGER;
VAR
    maxLength: INTEGER;
BEGIN
    ASSERT(pMaxLength # 0);
    SYSTEM.GET(pMaxLength, maxLength);
    IF size > maxLength THEN
        SYSTEM.PUT(pMaxLength, size)
    END;
    size := size*WCHAR_SIZE + 4;
    INC(size, (-size) MOD 32)
    RETURN API._NEW(size)
END malloc;


PROCEDURE free (line: tLine; newPtr: INTEGER);
BEGIN
    IF line.ptr # 0 THEN
        IF line.temp THEN
            line.ptr := API._DISPOSE(line.ptr)
        ELSE
            line.ptr := 0
        END
    END;
    IF ~line.temp THEN
        movInt(line.ptr, newPtr);
        IF newPtr # 0 THEN
            _untypedPtr(newPtr)
        END
    END;
    line.ptr := newPtr
END free;


PROCEDURE create* (temp: BOOLEAN): tLine;
VAR
    line: tLine;
BEGIN
    NEW(line);
    line.label := FALSE;
    ASSERT(line # NIL);
    IF ~temp THEN
        _typedPtr(line)
    END;
    line.next := NIL;
    line.prev := NIL;
    IF ~temp THEN
        movPtr(line.next, NIL);
        movPtr(line.prev, NIL)
    END;
    line.ptr := malloc(1);
    ASSERT(line.ptr # 0);
    IF ~temp THEN
        _untypedPtr(line.ptr);
        movInt(line.ptr, line.ptr)
    END;
    SYSTEM.PUT16(line.ptr, 0);
    line.length := 0;
    IF ~temp THEN
        movInt(line.length, 0)
    END;
    line.temp := temp;
    line.modified := FALSE;
    line.saved := FALSE;
    IF ~temp THEN
        _movBool(FALSE, line.modified, FALSE, line.saved, FALSE)
    END;
    line.cin := 0;
    line.cout := 0;
    line.pos := 0
    RETURN line
END create;


PROCEDURE destroy* (VAR line: tLine);
BEGIN
    IF line.temp THEN
        free(line, 0);
        DISPOSE(line)
    ELSE
        line := NIL
    END
END destroy;


PROCEDURE resize* (line: tLine; size: INTEGER);
BEGIN
	ASSERT(line.temp);
	IF size > 0 THEN
		line.ptr := API._DISPOSE(line.ptr);
		size := size*WCHAR_SIZE + 4;
		INC(size, (-size) MOD 32);
		line.ptr := API._NEW(size)
	ELSE
		destroy(line)
	END
END resize;


PROCEDURE getChar* (line: tLine; i: INTEGER): WCHAR;
VAR
	res: WCHAR;
BEGIN
	IF (0 <= i) & (i < line.length) THEN
		SYSTEM.GET(line.ptr + i*WCHAR_SIZE, res)
	ELSE
		res := 0X
	END
	RETURN res
END getChar;


PROCEDURE tabWidth (line: tLine; pos: INTEGER): INTEGER;
VAR
    n: INTEGER;
BEGIN
    n := pos;
    IF getChar(line, pos) = TAB THEN
        INC(pos);
        WHILE getChar(line, pos) = TAB1 DO
            INC(pos)
        END
    END
    RETURN pos - n
END tabWidth;


PROCEDURE save* (line: tLine);
BEGIN
    IF ~line.temp THEN
    	_movBool(TRUE, line.modified, FALSE, line.saved, TRUE)
    END;
    line.modified := FALSE;
    line.saved := TRUE
END save;


PROCEDURE isSpace* (c: WCHAR): BOOLEAN;
    RETURN (c = SPACE) OR (c = TAB) OR (c = TAB1)
END isSpace;


PROCEDURE trimLength* (line: tLine): INTEGER;
VAR
    i: INTEGER;
BEGIN
    i := line.length - 1;
    WHILE (i >= 0) & isSpace(getChar(line, i)) DO
        DEC(i)
    END
    RETURN i + 1
END trimLength;


PROCEDURE getPChar* (line: tLine; i: INTEGER): INTEGER;
    RETURN line.ptr + i*WCHAR_SIZE
END getPChar;


PROCEDURE setChar* (line: tLine; i: INTEGER; c: WCHAR);
BEGIN
    SYSTEM.PUT(line.ptr + i*WCHAR_SIZE, c)
END setChar;


PROCEDURE move* (src, dst: tLine);
BEGIN
    SYSTEM.MOVE(src.ptr, dst.ptr, (MIN(src.length, dst.length) + 1)*WCHAR_SIZE)
END move;


PROCEDURE delChar* (line: tLine; pos: INTEGER);
VAR
    ptr: INTEGER;
BEGIN
    IF pos < line.length THEN
        ptr := malloc(line.length);
        ASSERT(ptr # 0);
        IF ~line.temp THEN
            movInt(line.length, line.length - 1)
        END;
        DEC(line.length);
        SYSTEM.MOVE(line.ptr, ptr, pos*WCHAR_SIZE);
        SYSTEM.MOVE(line.ptr + pos*WCHAR_SIZE + WCHAR_SIZE, ptr + pos*WCHAR_SIZE, (line.length - pos)*WCHAR_SIZE);
        SYSTEM.PUT16(ptr + line.length*WCHAR_SIZE, 0);
        free(line, ptr)
    END
END delChar;


PROCEDURE insert* (line: tLine; pos: INTEGER; c: WCHAR);
VAR
    ptr: INTEGER;
BEGIN
    ptr := malloc(line.length + 2);
    ASSERT(ptr # 0);
    SYSTEM.MOVE(line.ptr, ptr, pos*WCHAR_SIZE);
    SYSTEM.PUT(ptr + pos*WCHAR_SIZE, c);
    SYSTEM.MOVE(line.ptr + pos*WCHAR_SIZE, ptr + pos*WCHAR_SIZE + WCHAR_SIZE, (line.length - pos)*WCHAR_SIZE);
    IF ~line.temp THEN
        movInt(line.length, line.length + 1)
    END;
    INC(line.length);
    SYSTEM.PUT16(ptr + line.length*WCHAR_SIZE, 0);
    free(line, ptr)
END insert;


PROCEDURE _insert2* (line1: tLine; pos: INTEGER; line2: tLine);
VAR
    ptr: INTEGER;
BEGIN
    IF line2.length > 0 THEN
        ptr := malloc(line1.length + line2.length + 1);
        ASSERT(ptr # 0);
        SYSTEM.MOVE(line1.ptr, ptr, pos*WCHAR_SIZE);
        SYSTEM.MOVE(line2.ptr, ptr + pos*WCHAR_SIZE, line2.length*WCHAR_SIZE);
        SYSTEM.MOVE(line1.ptr + pos*WCHAR_SIZE, ptr + (pos + line2.length)*WCHAR_SIZE, (line1.length - pos)*WCHAR_SIZE);
        SYSTEM.PUT16(ptr + (line1.length + line2.length)*WCHAR_SIZE, 0);
        IF ~line1.temp THEN
            movInt(line1.length, line1.length + line2.length)
        END;
        IF ~line2.temp THEN
            movInt(line2.length, 0)
        END;
        INC(line1.length, line2.length);
        free(line1, ptr)
    END
END _insert2;


PROCEDURE insert2* (line1: tLine; pos: INTEGER; line2: tLine);
BEGIN
	_insert2(line1, pos, line2);
	IF line2.length > 0 THEN
		line2.length := 0;
		free(line2, 0)
	END
END insert2;


PROCEDURE insert3* (line: tLine; pos, n: INTEGER);
VAR
    ptr: INTEGER;
BEGIN
    IF n > 0 THEN
        ptr := malloc(line.length + n + 1);
        ASSERT(ptr # 0);
        SYSTEM.MOVE(line.ptr, ptr, pos*WCHAR_SIZE);
        SYSTEM.MOVE(line.ptr + pos*WCHAR_SIZE, ptr + (pos + n)*WCHAR_SIZE, (line.length - pos)*WCHAR_SIZE);
        SYSTEM.PUT16(ptr + (line.length + n)*WCHAR_SIZE, 0);
        IF ~line.temp THEN
            movInt(line.length, line.length + n)
        END;
        INC(line.length, n);
        free(line, ptr)
    END
END insert3;


PROCEDURE delCharN* (line: tLine; pos, n: INTEGER);
VAR
    ptr: INTEGER;
BEGIN
    IF n > 0 THEN
        ptr := malloc(line.length - n + 1);
        ASSERT(ptr # 0);
        SYSTEM.MOVE(line.ptr, ptr, pos*WCHAR_SIZE);
        SYSTEM.MOVE(line.ptr + (pos + n)*WCHAR_SIZE, ptr + pos*WCHAR_SIZE, (line.length - pos - n)*WCHAR_SIZE);
        SYSTEM.PUT16(ptr + (line.length - n)*WCHAR_SIZE, 0);
        IF ~line.temp THEN
            movInt(line.length, line.length - n)
        END;
        DEC(line.length, n);
        free(line, ptr)
    END
END delCharN;


PROCEDURE fixTabs (line: tLine);
VAR
    i, n, k: INTEGER;
BEGIN
    i := 0;
    WHILE i < line.length DO
        n := tabWidth(line, i);
        IF n # 0 THEN
            k := tab - i MOD tab;
            IF n > k THEN
                delCharN(line, i + 1, n - k)
            ELSIF n < k THEN
                DEC(k, n);
                insert3(line, i + 1, k);
                WHILE k > 0 DO
                    setChar(line, i + 1, TAB1);
                    INC(i);
                    DEC(k)
                END
            END
        END;
        INC(i)
    END
END fixTabs;


PROCEDURE modify* (line: tLine);
BEGIN
    IF ~line.temp THEN
        _movBool(FALSE, line.modified, TRUE, line.saved, FALSE)
    END;
    line.modified := TRUE;
    line.saved := FALSE;
    fixTabs(line)
END modify;


PROCEDURE wrap* (line, nextLine: tLine; pos: INTEGER);
VAR
    ptr1, ptr2: INTEGER;
    n: INTEGER;
BEGIN
    ptr1 := malloc(pos + 1);
    ASSERT(ptr1 # 0);
    n := line.length - pos;
    ptr2 := malloc(n + 1);
    ASSERT(ptr2 # 0);
    SYSTEM.MOVE(line.ptr, ptr1, pos*WCHAR_SIZE);
    SYSTEM.PUT16(ptr1 + pos*WCHAR_SIZE, 0);
    SYSTEM.MOVE(line.ptr + pos*WCHAR_SIZE, ptr2, n*WCHAR_SIZE);
    SYSTEM.PUT16(ptr2 + n*WCHAR_SIZE, 0);
    IF ~line.temp THEN
        movInt(line.length, pos)
    END;
    IF ~nextLine.temp THEN
        movInt(nextLine.length, n)
    END;
    line.length := pos;
    nextLine.length := n;
    free(line, ptr1);
    free(nextLine, ptr2)
END wrap;


PROCEDURE copy* (line: tLine);
VAR
    ptr: INTEGER;
BEGIN
    ptr := malloc(line.length + 1);
    ASSERT(ptr # 0);
    SYSTEM.MOVE(line.ptr, ptr, line.length*WCHAR_SIZE);
    SYSTEM.PUT16(ptr + line.length*WCHAR_SIZE, 0);
    free(line, ptr)
END copy;


PROCEDURE convert* (line: tLine; pos1, pos2: INTEGER; func: fConvert): BOOLEAN;
VAR
    i: INTEGER;
    modified: BOOLEAN;
    c: WCHAR;
BEGIN
	ASSERT(func # NIL);
    modified := FALSE;
    i := pos2;
    WHILE i >= pos1 DO
        c := getChar(line, i);
        IF func(c) THEN
            modified := TRUE
        END;
        DEC(i)
    END;

    IF modified THEN
        copy(line);
        i := pos2;
        WHILE i >= pos1 DO
            c := getChar(line, i);
            IF func(c) THEN
                setChar(line, i, c)
            END;
            DEC(i)
        END;
        modify(line)
    END
    RETURN modified
END convert;


PROCEDURE init* (movInt: PmovInt; movPtr: PmovPtr; movBool: PmovBool; typedPtr: PTypedPtr; untypedPtr: PUntypedPtr);
BEGIN
    _movInt := movInt;
    _movPtr := movPtr;
    _movBool := movBool;
    _typedPtr := typedPtr;
    _untypedPtr := untypedPtr;
END init;


PROCEDURE setMaxLength* (VAR maxLength: INTEGER);
BEGIN
    pMaxLength := SYSTEM.ADR(maxLength)
END setMaxLength;


PROCEDURE setTabs* (_tab: INTEGER);
BEGIN
    IF _tab = 0 THEN
        _tab := 4
    END;
    tabs := _tab > 0;
    tab := ABS(_tab);
    IF tab > MAX_TAB_WIDTH THEN
    	tab := MAX_TAB_WIDTH
    END
END setTabs;


BEGIN
    pMaxLength := 0
END Lines.