choinka

(* Lab10 - choinka *)

program choinka;
uses crt;

type
PListItem = ^ListItem;

PTreeItem = ^TreeItem;

ListItem = record
    next : PListItem;
    prev : PListItem;
    val : PTreeItem;
end;

TreeItem = record
    firstChild : PListItem;
    name : String;
end;

var
root : PTreeItem;
tempListItem, tempListItem2 : PListItem;
cmd : char;
depth, i : integer;
personName, presentName : string;

procedure initTree;
begin
    new(root);
    root^.name := 'choinka';
    root^.firstChild := nil;
end;

procedure addPerson(name : string);
var newPerson : PTreeItem;
begin
    new(newPerson);
    newPerson^.name := name;
    newPerson^.firstChild := nil;

    if root^.firstChild = nil then
    begin
        new(root^.firstChild);
        root^.firstChild^.val := newPerson;
    end
    else
    begin
        tempListItem := root^.firstChild;
        while (tempListItem^.next <> nil) do
        begin
            tempListItem := tempListItem^.next;
        end;
        new(tempListItem^.next);
        tempListItem^.next^.val := newPerson;
        tempListItem^.next^.prev := tempListItem;
        tempListItem^.next^.next := nil;
    end;
end;

procedure removePerson(name : string);
begin
    if root^.firstChild = nil then
    begin
        tempListItem := root^.firstChild;

        while (tempListItem^.val^.name <> name) and (tempListItem^.next <> nil) do
        begin
            tempListItem := tempListItem^.next;
        end;

        if tempListItem^.val^.name = name then
        begin
            if (tempListItem^.next = nil) and (tempListItem^.prev = nil) then
            begin
                root^.firstChild := nil;
            end
            else
            begin
                if (tempListItem^.next = nil) then
                begin
                    tempListItem^.next^.prev := tempListItem^.prev
                end;
                if (tempListItem^.next = nil) then
                begin
                    tempListItem^.prev^.next := tempListItem^.next;
                end;
            end;
        end;
    end
end;

procedure addPresent(personName : string; presentName : string);
begin
    if root^.firstChild = nil then
    begin
        tempListItem := root^.firstChild;

        while (tempListItem^.val^.name <> personName) and (tempListItem^.next <> nil) do
        begin
            tempListItem := tempListItem^.next;
        end;

        if tempListItem^.val^.name = personName then
        begin
            tempListItem := tempListItem^.val^.firstChild;

            if tempListItem = nil then
            begin
                new(tempListItem);
                new(tempListItem^.val);
                tempListItem^.val^.name := presentName;
                tempListItem^.val^.firstChild := nil;
            end
            else
            begin
                while (tempListItem^.next <> nil) do
                begin
                    tempListItem := tempListItem^.next;
                end;
                new(tempListItem^.next);
                new(tempListItem^.next^.val);
                tempListItem^.next^.val^.name := presentName;
                tempListItem^.next^.prev := tempListItem;
            end;
        end;
    end
end;

procedure removePresent(personName : string; presentName : string);
begin
    if root^.firstChild = nil then
    begin
        tempListItem := root^.firstChild;

        while (tempListItem^.val^.name <> personName) and (tempListItem^.next <> nil) do
        begin
            tempListItem := tempListItem^.next;
        end;

        if tempListItem^.val^.name = personName then
        begin
            tempListItem := tempListItem^.val^.firstChild;


            while (tempListItem^.val^.name <> presentName) and (tempListItem^.next <> nil) do
            begin
                tempListItem := tempListItem^.next;
            end;

            if tempListItem^.val^.name = presentName then
            begin
                if (tempListItem^.next = nil) and (tempListItem^.prev = nil) then
                begin
                    removePerson(personName);
                end
                else
                begin
                    if (tempListItem^.next = nil) then
                    begin
                        tempListItem^.next^.prev := tempListItem^.prev
                    end;
                    if (tempListItem^.next = nil) then
                    begin
                        tempListItem^.prev^.next := tempListItem^.next;
                    end;
                end;
            end;
        end;
    end;
end;

procedure printNode(treeItem : PTreeItem);
begin
    for i := 1 to depth do
    begin
        write('  ');
    end;

    writeln(treeItem^.name);

    tempListItem2 := treeItem^.firstChild;

    if treeItem^.firstChild <> nil then
    begin
        while tempListItem2 <> nil do
        begin
            inc(depth);
            printNode(tempListItem2^.val);
            tempListItem := tempListItem2^.next;
            dec(depth);
        end;
    end;
end;


begin
    initTree();

    repeat
    begin
        clrscr;
        writeln('Twoja choinka:');
        depth := 0;
        printNode(root);
        writeln('1 dodaj osobe, 2 usun osobe, 3 dodaj prezent, 4 usun prezent, 0 wyjscie');
        cmd := readkey;

        case cmd of
            '1':
            begin
                write('Podaj osobe: ');
                readln(personName);
                addPerson(personName);
            end;

            '2':
            begin

            end;

            '3':
            begin

            end;

            '4':
            begin

            end;
        end;
    end
    until cmd = '0';
end.