kolibrios/programs/develop/cedit/SRC/ChangeLog.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 ChangeLog;

IMPORT List, Lines, API, SYSTEM;

TYPE
    tIntItem = POINTER TO RECORD (List.tItem)
    	cnt: INTEGER;
    	adr, val: ARRAY 8 OF INTEGER
    END;

    tBoolItem = POINTER TO RECORD (List.tItem)
        line: Lines.tLine;
        adr: INTEGER;
        val, save: BOOLEAN
    END;

    tUntypedPtr = POINTER TO RECORD (List.tItem)
    	cnt: INTEGER;
    	p: ARRAY 64 OF INTEGER
    END;

    tTypedPtr = POINTER TO RECORD (List.tItem)
    	cnt: INTEGER;
    	p: ARRAY 64 OF List.tItem
    END;

    tGuard* = POINTER TO RECORD (List.tItem)
        saved*: BOOLEAN
    END;

    tLog* = POINTER TO RECORD
        Log*, TPointers, UPointers: List.tList;
        guard, first: tGuard;
        isLast: BOOLEAN
    END;


VAR
    CL*: tLog;


PROCEDURE isLastGuard* (guard: tGuard): BOOLEAN;
VAR
    item: List.tItem;
    res: BOOLEAN;
BEGIN
    IF guard # NIL THEN
        item := CL.Log.last;
        WHILE ~(item IS tGuard) DO
            item := item.prev
        END;
        res := guard = item
    ELSE
        res := TRUE
    END
    RETURN res
END isLastGuard;


PROCEDURE getFirstGuard (): tGuard;
VAR
	item: List.tItem;
BEGIN
	item := CL.Log.first;
	WHILE ~(item IS tGuard) DO
		item := item.next
	END
	RETURN item(tGuard)
END getFirstGuard;


PROCEDURE isFirstGuard* (guard: tGuard): BOOLEAN;
BEGIN
	ASSERT(guard # NIL);
	IF CL.first = NIL THEN
		CL.first := getFirstGuard()
	END
	RETURN guard = CL.first
END isFirstGuard;


PROCEDURE setGuard* (_guard: tGuard);
BEGIN
    CL.guard := _guard;
    CL.isLast := isLastGuard(_guard)
END setGuard;


PROCEDURE redo* (item: List.tItem);
VAR
	i: INTEGER;
BEGIN
	IF item IS tIntItem THEN
		FOR i := 0 TO item(tIntItem).cnt - 1 DO
			SYSTEM.PUT(item(tIntItem).adr[i], item(tIntItem).val[i])
		END
	ELSIF item IS tBoolItem THEN
		SYSTEM.PUT(item(tBoolItem).adr, item(tBoolItem).val)
	END
END redo;


PROCEDURE clear (guard: tGuard);
VAR
    item: List.tItem;
BEGIN
    CL.isLast := TRUE;
    REPEAT
        item := List.pop(CL.Log);
        IF item # guard THEN
            DISPOSE(item)
        END
    UNTIL item = guard;
    List.append(CL.Log, item)
END clear;


PROCEDURE save* (guard: tGuard);
VAR
	item: List.tItem;
	boolItem: tBoolItem;
	cur: List.tItem;
	del: BOOLEAN;
BEGIN
    item := CL.Log.first;
    WHILE item # NIL DO
        IF item IS tGuard THEN
            item(tGuard).saved := FALSE
        END;
        item := item.next
    END;
    guard.saved := TRUE;

    cur := CL.guard.prev;
    WHILE cur # NIL DO
        IF cur IS tBoolItem THEN
            boolItem := cur(tBoolItem);
            del := boolItem.save & boolItem.line.modified
        ELSE
            del := FALSE
        END;
        cur := cur.prev;
        IF del THEN
            List.delete(CL.Log, boolItem);
            DISPOSE(boolItem)
        END
    END
END save;


PROCEDURE changeWord (adrV, adrX: INTEGER);
VAR
	item: tIntItem;
	cur: List.tItem;
BEGIN
	IF ~CL.isLast THEN
		clear(CL.guard)
	END;
	cur := CL.Log.last;
	WHILE (cur # NIL) & ~(cur IS tGuard) & ~(cur IS tIntItem) DO
		cur := cur.prev
	END;
	IF (cur IS tIntItem) & (cur(tIntItem).cnt < LEN(cur(tIntItem).adr)) THEN
		item := cur(tIntItem)
	ELSE
		NEW(item);
		item.cnt := 0;
		List.append(CL.Log, item)
	END;
	item.adr[item.cnt] := adrV;
	SYSTEM.GET(adrX, item.val[item.cnt]);
	INC(item.cnt)
END changeWord;


PROCEDURE changeBool (line: Lines.tLine; VAR v: BOOLEAN; x: BOOLEAN);
VAR
    item: tBoolItem;
BEGIN
    NEW(item);
    item.line := line;
    item.adr := SYSTEM.ADR(v);
    item.val := x;
    item.save := FALSE;
    IF ~CL.isLast THEN
        clear(CL.guard)
    END;
    List.append(CL.Log, item)
END changeBool;


PROCEDURE delSaved*;
VAR
    boolItem: tBoolItem;
    cur: List.tItem;
    del: BOOLEAN;
BEGIN
    cur := CL.guard.next;
    WHILE cur # NIL DO
        IF cur IS tBoolItem THEN
            boolItem := cur(tBoolItem);
            del := boolItem.save
        ELSE
            del := FALSE
        END;
        cur := cur.next;
        IF del THEN
            List.delete(CL.Log, boolItem);
            DISPOSE(boolItem)
        END
    END
END delSaved;


PROCEDURE delCurSaved*;
VAR
    boolItem: tBoolItem;
    cur: List.tItem;
    del: BOOLEAN;
BEGIN
    cur := CL.guard.prev;
    WHILE (cur # NIL) & ~(cur IS tGuard) DO
        IF cur IS tBoolItem THEN
            boolItem := cur(tBoolItem);
            del := boolItem.save
        ELSE
            del := FALSE
        END;
        cur := cur.prev;
        IF del THEN
            SYSTEM.PUT(boolItem.adr, ~boolItem.val);
            List.delete(CL.Log, boolItem);
            DISPOSE(boolItem)
        END
    END
END delCurSaved;


PROCEDURE changeBool2 (line: Lines.tLine; VAR v: BOOLEAN; x: BOOLEAN);
VAR
    item: tBoolItem;
BEGIN
    NEW(item);
    item.line := line;
    item.adr := SYSTEM.ADR(v);
    item.val := x;
    item.save := TRUE;
    List.insert(CL.Log, CL.guard.prev, item)
END changeBool2;


PROCEDURE changeInt* (VAR v: INTEGER; x: INTEGER);
BEGIN
    changeWord(SYSTEM.ADR(v), SYSTEM.ADR(x))
END changeInt;


PROCEDURE changePtr (VAR v: List.tItem; x: List.tItem);
BEGIN
    changeWord(SYSTEM.ADR(v), SYSTEM.ADR(x))
END changePtr;


PROCEDURE typedPtr (p: List.tItem);
VAR
	item: tTypedPtr;
BEGIN
	item := CL.TPointers.last(tTypedPtr);
	IF (item = NIL) OR (item.cnt = LEN(item.p)) THEN
		NEW(item);
		item.cnt := 0;
		List.append(CL.TPointers, item)
	END;
	item.p[item.cnt] := p;
	INC(item.cnt)
END typedPtr;


PROCEDURE untypedPtr (p: INTEGER);
VAR
	item: tUntypedPtr;
BEGIN
	item := CL.UPointers.last(tUntypedPtr);
	IF (item = NIL) OR (item.cnt = LEN(item.p)) THEN
		NEW(item);
		item.cnt := 0;
		List.append(CL.UPointers, item)
	END;
	item.p[item.cnt] := p;
	INC(item.cnt)
END untypedPtr;


PROCEDURE setLog* (_CL: tLog);
BEGIN
    CL := _CL
END setLog;


PROCEDURE create* (VAR maxLength: INTEGER): tLog;
VAR
    newLog: tLog;
BEGIN
    NEW(newLog);
    newLog.guard := NIL;
    newLog.first := NIL;
    newLog.isLast := TRUE;
    newLog.Log := List.create(NIL);
    newLog.TPointers := List.create(NIL);
    newLog.UPointers := List.create(NIL);
    CL := newLog;
    Lines.setMaxLength(maxLength)
    RETURN newLog
END create;


PROCEDURE destroy* (VAR log: tLog);
VAR
	item: List.tItem;
	res, i: INTEGER;
BEGIN
	IF log # NIL THEN
		item := List.pop(log.Log);
		WHILE item # NIL DO
			DISPOSE(item);
			item := List.pop(log.Log)
		END;
		DISPOSE(log.Log);

		item := List.pop(log.TPointers);
		WHILE item # NIL DO
			FOR i := 0 TO item(tTypedPtr).cnt - 1 DO
				DISPOSE(item(tTypedPtr).p[i])
			END;
			DISPOSE(item);
			item := List.pop(log.TPointers)
		END;
		DISPOSE(log.TPointers);

		item := List.pop(log.UPointers);
		WHILE item # NIL DO
			FOR i := 0 TO item(tUntypedPtr).cnt - 1 DO
				res := API._DISPOSE(item(tUntypedPtr).p[i])
			END;
			DISPOSE(item);
			item := List.pop(log.UPointers)
		END;
		DISPOSE(log.UPointers);

		DISPOSE(log)
	END
END destroy;


BEGIN
    List.init(changeInt, changePtr);
    Lines.init(changeInt, changePtr, changeBool, changeBool2, typedPtr, untypedPtr)
END ChangeLog.