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

(*
    Copyright 2021, 2022 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)
        adr, val: INTEGER
    END;

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

    tUntypedPtr = POINTER TO RECORD (List.tItem)
        p: INTEGER
    END;

    tTypedPtr = POINTER TO RECORD (List.tItem)
        p: List.tItem
    END;

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

    tLog* = POINTER TO RECORD
        Log*, Pointers*: 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);
BEGIN
    IF item IS tIntItem THEN
        SYSTEM.PUT(item(tIntItem).adr, item(tIntItem).val)
    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;
BEGIN
    NEW(item);
    item.adr := adrV;
    SYSTEM.GET(adrX, item.val);
    IF ~CL.isLast THEN
        clear(CL.guard)
    END;
    List.append(CL.Log, item)
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
    NEW(item);
    item.p := p;
    List.append(CL.Pointers, item)
END typedPtr;


PROCEDURE untypedPtr (p: INTEGER);
VAR
    item: tUntypedPtr;
BEGIN
    NEW(item);
    item.p := p;
    List.append(CL.Pointers, item)
END untypedPtr;


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


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.Pointers := List.create(NIL);
    CL := newLog;
    Lines.setMaxLength(maxLength)
    RETURN newLog
END create;


PROCEDURE destroy* (VAR log: tLog);
VAR
	item: List.tItem;
	res: 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.Pointers);
		WHILE item # NIL DO
            IF item IS tUntypedPtr THEN
                res := API._DISPOSE(item(tUntypedPtr).p)
            ELSIF item IS tTypedPtr THEN
                DISPOSE(item(tTypedPtr).p)
            END;
			DISPOSE(item);
			item := List.pop(log.Pointers)
		END;
		DISPOSE(log.Pointers);

		DISPOSE(log)
	END
END destroy;


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