Lab2AISD

program AISD_LAB2;

uses
    System.SysUtils;

const
    SegmentCount = 10;

type
    PPages = ^PagesListElem;
    PagesListElem = record
        PageValue: Word;
        NextPage: PPages;
    end;

    PTerm = ^TermListElem;
    TermListElem = record
        TermValue: String;
        Subterm: PTerm;
        Pages: PPages;
        NextTerm: PTerm;
    end;

    PHeader = ^PSegmentListHeader;
    PSegmentListHeader = record
        FirstTerm: PTerm;
    end;

    THashTable = array [0..SegmentCount-1] of PHeader;

var
    Choice: Integer;
    NewTerm: PTerm;
    TermValue: String;
    HashTable: THashTable;

procedure OutputMainMenu;
begin
    Writeln('--------------------------------------------------------');
    Writeln('1. Просмотреть предметный указатель по алфавиту');
    Writeln('2. Просмотреть предметный указатель по номерам страниц');
    Writeln('3. Добавить термин');
    Writeln('4. Редактировать термин');
    Writeln('5. Удалить термин');
    Writeln('6. Поиск терминов по подтермину');
    Writeln('7. Поиск подтермина по термину');
    Writeln('8. Выход');
    Writeln('--------------------------------------------------------');
    Writeln('Выберите желаемое действие:');
end;

procedure OutputEditTermMenu;
begin
    Writeln('--------------------------------------------------------');
    Writeln('1. Добавить подтермин');
    Writeln('2. Редактировать подтермин');
    Writeln('3. Удалить подтермин');
    Writeln('4. Добавить номер страницы');
    Writeln('5. Удалить номер страницы');
    Writeln('6. Завершить');
    Writeln('--------------------------------------------------------');
    Writeln('Выберите желаемое действие:');
end;

function InputChoice(Min, Max: Integer): Integer;
var
    Num: Integer;
    IsCorrect: Boolean;
begin
    repeat
        IsCorrect := True;
        try
            Readln(Num);
        except
            Writeln('Некорректный ввод! Попробуйте еще:');
            IsCorrect := False;
        end;
        if IsCorrect and ((Num < Min) or (Num > Max)) then
        begin
            Writeln('Некорректный ввод! Попробуйте еще:');
            IsCorrect := False;
        end;
    until IsCorrect;
    InputChoice := Num;
end;

procedure CreateHashTable(var HashTable: THashTable);
var
    I: Integer;
begin
    for I := Low(HashTable) to High(HashTable) do
    begin
        New(HashTable[I]);
        HashTable[I]^.FirstTerm := nil;
    end;
end;

function HasTermListThisTerm (Header: PHeader; NewTermValue: String): Boolean;
var
    HasThisTerm: Boolean;
    Head: PTerm;
begin
    HasThisTerm := False;
    if Header^.FirstTerm <> nil then
    begin
        Head := Header^.FirstTerm;
        repeat
            if Head^.TermValue = NewTermValue then
            begin
                HasThisTerm := True;
                Break;
            end;
            Head := Head^.NextTerm;
        until Head = nil;

        if HasThisTerm then
            Writeln('Такой термин найден!');
    end;

    HasTermListThisTerm := HasThisTerm;
end;

function GetHashValue(NewTermValue: String): Integer;
var
    I, Temp: Integer;
begin
    Temp := 0;
    for I := Low(NewTermValue) to High(NewTermValue) do
    begin
        Temp := Temp + Ord(NewTermValue[I]);
    end;
    GetHashValue := Temp mod SegmentCount;
end;

function HasThisTerm(HashTable: THashTable; NewTermValue: String): Boolean;
begin
    HasThisTerm := HasTermListThisTerm (HashTable[GetHashValue(NewTermValue)], NewTermValue);
end;

function CreateNewTerm(Value: String): PTerm;
var
    NewTerm: PTerm;
begin
    New(NewTerm);
    NewTerm^.TermValue := Value;
    NewTerm^.Subterm := nil;
    NewTerm^.Pages := nil;
    NewTerm^.NextTerm := nil;

    CreateNewTerm := NewTerm;
end;

procedure AddTermToHashTable(Header: PHeader; Term: PTerm);
var
    Head: PTerm;
begin
    if Header^.FirstTerm <> nil then
    begin
        Head := Header^.FirstTerm;
        while Head^.NextTerm <> nil do
            Head := Head^.NextTerm;
        Head^.NextTerm := Term;
    end
    else
        Header^.FirstTerm := Term;
end;

procedure AddTerm(NewTerm: PTerm);
begin
    AddTermToHashTable(HashTable[GetHashValue(NewTerm^.TermValue)], NewTerm);
    Writeln('Термин добавлен успешно!');
end;

function CreateSubterm(Value: String): PTerm;
var
    NewSubterm: PTerm;
begin
    New(NewSubterm);
    NewSubterm^.TermValue := Value;
    NewSubterm^.Subterm := nil;
    NewSubterm^.Pages := nil;
    NewSubterm^.NextTerm := nil;

    CreateSubterm := NewSubterm;
end;

function HasSubtermListThisSubterm(Term: PTerm; NewSubtermValue: String): Boolean;
var
    Curr: PTerm;
    HasThisSubterm: Boolean;
begin
    HasThisSubterm := False;
    Curr := Term^.Subterm;
    if Curr <> nil then
    begin
        repeat
            if Curr^.TermValue = NewSubtermValue then
            begin
                HasThisSubterm := True;
                Break;
            end;
            Curr := Curr^.NextTerm;
        until Curr = nil;
    end;

    HasSubtermListThisSubterm := HasThisSubterm;
end;

procedure DeleteSubterm(NewTerm: PTerm);
var
    Curr, Temp: PTerm;
    DelSubtermValue: String;
begin
    Writeln('Введите подтермин: ');
    Readln(DelSubtermValue);
    if HasSubtermListThisSubterm(NewTerm, DelSubtermValue) then
    begin
        Curr := NewTerm^.Subterm;
        if Curr^.TermValue = DelSubtermValue then
        begin
            Temp := Curr;
            NewTerm^.Subterm := Curr^.NextTerm;
            Dispose(Temp);
        end
        else
        begin
            Temp := Curr^.NextTerm;
            while Temp^.TermValue <> DelSubtermValue do
            begin
                Curr := Temp;
                Temp := Temp^.NextTerm;
            end;

            Curr^.NextTerm := Temp^.NextTerm;
            Dispose(Temp);
        end;
        Writeln('Подтермин удален успешно!')
    end
    else
        Writeln('Подтермин не найден!');
end;

function CreatePage(PageValue: Word): PPages;
var
    Page: PPages;
begin
    New(Page);
    Page^.PageValue := PageValue;
    Page^.NextPage := nil;

    CreatePage := Page;
end;

procedure AddPage(NewTerm: PTerm);
var
    Page: Word;
    Curr, Temp: PPages;
begin
    Writeln('Введите страницу с термином:');
    Page := InputChoice(0, 65000);

    if NewTerm^.Pages = nil then
    begin
        NewTerm^.Pages := CreatePage(Page);
        Writeln('Страница добавлена успешно!');
    end
    else
    begin
        Curr := NewTerm^.Pages;
        if Page <= Curr^.PageValue then
        begin
            if Curr^.PageValue = Page then
            begin
                Writeln('Такая страница уже указана!');
                Exit;
            end
            else
            begin
                Temp := CreatePage(Page);
                Temp^.NextPage := Curr;
                NewTerm^.Pages := Temp;
            end;
        end
        else
        begin
            while (Curr^.NextPage <> nil) and (Curr^.NextPage^.PageValue <= Page) do
            begin
                if Curr^.NextPage^.PageValue = Page then
                begin
                    Writeln('Такая страница уже указана!');
                    Exit;
                end;
                Curr := Curr^.NextPage;
            end;

            if Curr^.NextPage = nil then
                Curr^.NextPage := CreatePage(Page)
            else
            begin
                Temp := CreatePage(Page);
                Temp^.NextPage := Curr^.NextPage;
                Curr^.NextPage := Temp;
            end;
        end;
        Writeln('Страница добавлена успешно!');
    end;
end;

procedure DeletePage(NewTerm: PTerm);
var
    Page: Word;
    Curr, Temp: PPages;
begin
    Writeln('Введите страницу с термином:');
    Page := InputChoice(0, 65000);

    if NewTerm^.Pages = nil then
    begin
        Writeln('Термин не указан ни на одной из страниц!');
        Exit;
    end
    else
    begin
        Curr := NewTerm^.Pages;
        if Curr^.PageValue = Page then
        begin
            NewTerm^.Pages := Curr^.NextPage;
            Dispose(Curr);
            Writeln('Удаление страницы успешно!');
        end
        else
        begin
            while (Curr^.NextPage <> nil) and (Curr^.NextPage^.PageValue <> Page) do
                Curr := Curr^.NextPage;

            if (Curr^.NextPage <> nil) and (Curr^.NextPage^.PageValue = Page) then
            begin
                Temp := Curr^.NextPage;
                Curr^.NextPage := Temp^.NextPage;
                Dispose(Temp);
                Writeln('Удаление страницы успешно!');
            end
            else
            begin
                Writeln('Термин не найден на данной странице!');
            end;
        end;
    end;
end;

procedure AddSubterm(NewTerm: PTerm);forward;

procedure EditSubterm(NewTerm: PTerm);
var
    SubtermValue: String;
    NowSubterm: PTerm;
    Choice:Integer;
begin
    if NewTerm^.Subterm = nil then
    begin
        Writeln('У данного термина еще нет подтерминов!');
        Exit;
    end
    else
    begin
        Writeln('Введите поддтермин');
        Readln(SubtermValue);
        if HasSubtermListThisSubterm(NewTerm, SubtermValue) then
        begin
            if (NewTerm^.Subterm^.TermValue = SubtermValue) then
            begin
                NowSubterm := NewTerm^.Subterm;
            end
            else
            begin
                NowSubterm := NewTerm^.Subterm;
                while (NowSubterm^.NextTerm <> nil) and (NowSubterm^.NextTerm^.TermValue <> SubtermValue) do
                    NowSubterm := NowSubterm^.NextTerm;

                NowSubterm := NowSubterm^.NextTerm;
            end;

            repeat
                Writeln('--------------------------------------------------------');
                Writeln('РЕДАКТОР ПОДТЕРМИНА ' + SubtermValue);
                OutputEditTermMenu;
                Choice := InputChoice(1,6);
                case Choice of
                    1: AddSubterm(NowSubterm);
                    2: EditSubterm(NowSubterm);
                    3: DeleteSubterm(NowSubterm);
                    4: AddPage(NowSubterm);
                    5: DeletePage(NowSubterm);
                    6:
                end;
            until Choice = 6;
        end
        else
            Writeln('Подтермин не найден!');
    end;
end;

procedure AddSubterm(NewTerm: PTerm);
var
    Curr, NewSubterm: PTerm;
    NewSubtermValue: String;
    Choice:Integer;
begin
    Writeln('Введите подтермин: ');
    Readln(NewSubtermValue);
    if HasSubtermListThisSubterm(NewTerm, NewSubtermValue) then
        Writeln('Такой подтермин уже существует')
    else
    begin
        NewSubterm := CreateNewTerm(NewSubtermValue);
        repeat
            Writeln('--------------------------------------------------------');
            Writeln('РЕДАКТОР ПОДТЕРМИНА ' + NewSubtermValue);
            OutputEditTermMenu;
            Choice := InputChoice(1,6);
            case Choice of
                1: AddSubterm(NewSubterm);
                2: EditSubterm(NewSubterm);
                3: DeleteSubterm(NewSubterm);
                4: AddPage(NewSubterm);
                5: DeletePage(NewSubterm);
                6:
            end;
        until Choice = 6;

        Curr := NewTerm^.Subterm;
        if Curr <> nil then
        begin
            while Curr^.NextTerm <> nil do
                Curr := Curr^.NextTerm;
            Curr^.NextTerm := NewSubterm;
        end
        else
            NewTerm^.Subterm := NewSubterm;

        Writeln('Подтермин добавлен успешно!');
    end;
end;

procedure InsertElementInAlphabet(var Header: PHeader; Term: PTerm);
var
    Curr, Temp, NewTerm: PTerm;
begin
    New(NewTerm);
    NewTerm^.TermValue := Term^.TermValue;
    NewTerm^.Subterm := Term^.Subterm;
    NewTerm^.Pages := Term^.Pages;
    NewTerm^.NextTerm := nil;

    if Header^.FirstTerm = nil then
    begin
        Header^.FirstTerm := NewTerm;
    end
    else
    begin
        if (NewTerm^.TermValue <= Header^.FirstTerm^.TermValue) then
        begin
            New(Temp);
            Temp^.NextTerm := Header^.FirstTerm;
            Header^.FirstTerm := Temp;
            Temp^.TermValue := NewTerm^.TermValue;
            Temp^.Subterm := NewTerm^.Subterm;
            Temp^.Pages := NewTerm^.Pages;
        end
        else
        begin
            Curr := Header^.FirstTerm;
            while (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.TermValue <= NewTerm^.TermValue) do
                Curr := Curr^.NextTerm;

            New(Temp);
            Temp^.NextTerm := Curr^.NextTerm;
            Curr^.NextTerm := Temp;
            Temp^.TermValue := NewTerm^.TermValue;
            Temp^.Subterm := NewTerm^.Subterm;
            Temp^.Pages := NewTerm^.Pages;
        end;
    end;
end;

function InitializeList(): PHeader;
var
    Header: PHeader;
begin
    New(Header);
    Header^.FirstTerm := nil;
    InitializeList := Header;
end;

function TurnArrayToAlphabetSortedList(HashTable: THashTable): PHeader;
Var
    I: Integer;
    Curr: PTerm;
    SortedListHeader: PHeader;
Begin
    SortedListHeader := InitializeList();
    for I := Low(HashTable) to High(HashTable) do
        if HashTable[I]^.FirstTerm <> nil then
        begin
            Curr := HashTable[I]^.FirstTerm;
            while Curr^.NextTerm <> nil do
            begin
                InsertElementInAlphabet(SortedListHeader, Curr);
                Curr := Curr^.NextTerm;
            end;
            if Curr <> nil then
                InsertElementInAlphabet(SortedListHeader, Curr);
        end;
    TurnArrayToAlphabetSortedList := SortedListHeader;
End;

procedure OutputSubterm(Subterm: PTerm; Padding: String);
var
    Page: PPages;
begin
    if Subterm = nil then
        Exit
    else
    begin
        Write(Padding + Subterm^.TermValue + '| ');
        Page := Subterm^.Pages;
        while Page <> nil do
        begin
            Write(Page^.PageValue, ' ');
            Page := Page^.NextPage;
        end;
        Writeln;
        OutputSubterm(Subterm^.Subterm, Padding + '    ');
    end;
end;

procedure OutputList(Header: PHeader);
var
    Term, Subterm: PTerm;
    Page: PPages;
begin
    if Header^.FirstTerm = nil then
        Writeln('Предметный указатель не заполнен!')
    else
    begin
        Writeln('ПРЕДМЕТНЫЙ УКАЗАТЕЛЬ');
        Term := Header^.FirstTerm;
        repeat
            Writeln('----------------------------');
            Write(Term^.TermValue + '| ');
            Page := Term^.Pages;
            while Page <> nil do
            begin
                Write(Page^.PageValue, ' ');
                Page := Page^.NextPage;
            end;
            if (Term^.Subterm <> nil) then
            begin
                Writeln;
                Subterm := Term^.Subterm;
                repeat
                    OutputSubterm(Subterm, '    ');
                    Subterm := Subterm^.NextTerm;
                until Subterm = nil;
            end
            else
                Writeln;
            Writeln('----------------------------');
            Term := Term^.NextTerm;
        until Term = nil;
    end;
end;

procedure DisposeList (var Header: PHeader);
var
    Curr, Temp: PTerm;
begin
    Curr := Header^.FirstTerm;
    while Curr <> nil do
    begin
        Temp := Curr;
        Curr := Curr^.NextTerm;
        Dispose(Temp);
    end;
    Dispose(Header);
end;

procedure OutputSubjectIndexInAlphabet(HashTable: THashTable);
var
    AlphabetListHeader: PHeader;
begin
    AlphabetListHeader := TurnArrayToAlphabetSortedList(HashTable);
    OutputList(AlphabetListHeader);
    DisposeList(AlphabetListHeader);
end;

procedure InsertElementInPage(var Header: PHeader; Term: PTerm);
var
    Curr, Temp, NewTerm: PTerm;
    TermPage, CurrPage: PPages;
begin
    New(NewTerm);
    NewTerm^.TermValue := Term^.TermValue;
    NewTerm^.Subterm := Term^.Subterm;
    NewTerm^.Pages := Term^.Pages;
    NewTerm^.NextTerm := nil;

    if Header^.FirstTerm = nil then
    begin
        Header^.FirstTerm := NewTerm;
    end
    else
    begin
        if (NewTerm^.Pages^.PageValue <= Header^.FirstTerm^.Pages^.PageValue) then
        begin
            if (NewTerm^.Pages^.PageValue = Header^.FirstTerm^.Pages^.PageValue) then
            begin
                CurrPage := Header^.FirstTerm^.Pages;
                TermPage := NewTerm^.Pages;

                while (CurrPage <> nil) and (TermPage <> nil) and (TermPage^.PageValue = CurrPage^.PageValue) do
                begin
                    CurrPage := CurrPage^.NextPage;
                    TermPage := TermPage^.NextPage;
                end;

                if ((TermPage = nil) and (CurrPage <> nil)) or ((CurrPage <> nil) and (TermPage^.PageValue < CurrPage^.PageValue)) then
                begin
                    New(Temp);
                    Temp^.NextTerm := Header^.FirstTerm;
                    Header^.FirstTerm := Temp;
                    Temp^.TermValue := NewTerm^.TermValue;
                    Temp^.Subterm := NewTerm^.Subterm;
                    Temp^.Pages := NewTerm^.Pages;
                end
                else
                begin
                    New(Temp);
                    Temp^.NextTerm := Header^.FirstTerm^.NextTerm;
                    Header^.FirstTerm^.NextTerm := Temp;
                    Temp^.TermValue := NewTerm^.TermValue;
                    Temp^.Subterm := NewTerm^.Subterm;
                    Temp^.Pages := NewTerm^.Pages;
                end;
            end
            else
            begin
                New(Temp);
                Temp^.NextTerm := Header^.FirstTerm;
                Header^.FirstTerm := Temp;
                Temp^.TermValue := NewTerm^.TermValue;
                Temp^.Subterm := NewTerm^.Subterm;
                Temp^.Pages := NewTerm^.Pages;
            end;
        end
        else
        begin
            Curr := Header^.FirstTerm;
            while (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.Pages^.PageValue < NewTerm^.Pages^.PageValue) do
                Curr := Curr^.NextTerm;

            if (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.Pages^.PageValue = NewTerm^.Pages^.PageValue) then
            begin
                CurrPage := Curr^.NextTerm^.Pages;
                TermPage := NewTerm^.Pages;

                while (CurrPage <> nil) and (TermPage <> nil) and (CurrPage^.PageValue = TermPage^.PageValue) do
                begin
                    CurrPage := CurrPage^.NextPage;
                    TermPage := TermPage^.NextPage;
                end;

                if ((TermPage = nil) and (CurrPage <> nil)) or ((CurrPage <> nil) and (TermPage^.PageValue < CurrPage^.PageValue)) then
                begin
                    New(Temp);
                    Temp^.NextTerm := Curr^.NextTerm;
                    Curr^.NextTerm := Temp;
                    Temp^.TermValue := NewTerm^.TermValue;
                    Temp^.Subterm := NewTerm^.Subterm;
                    Temp^.Pages := NewTerm^.Pages;
                end
                else
                begin
                    Curr := Curr^.NextTerm;

                    New(Temp);
                    Temp^.NextTerm := Curr^.NextTerm;
                    Curr^.NextTerm := Temp;
                    Temp^.TermValue := NewTerm^.TermValue;
                    Temp^.Subterm := NewTerm^.Subterm;
                    Temp^.Pages := NewTerm^.Pages;
                end;
            end
            else
            begin
                New(Temp);
                Temp^.NextTerm := Curr^.NextTerm;
                Curr^.NextTerm := Temp;
                Temp^.TermValue := NewTerm^.TermValue;
                Temp^.Subterm := NewTerm^.Subterm;
                Temp^.Pages := NewTerm^.Pages;
            end;
        end;
    end;
end;

function TurnArrayToPageSortedList(HashTable: THashTable): PHeader;
Var
    I: Integer;
    Curr: PTerm;
    SortedListHeader: PHeader;
Begin
    SortedListHeader := InitializeList();
    for I := Low(HashTable) to High(HashTable) do
        if HashTable[I]^.FirstTerm <> nil then
        begin
            Curr := HashTable[I]^.FirstTerm;
            repeat
                InsertElementInPage(SortedListHeader, Curr);
                Curr := Curr^.NextTerm;
            until Curr = nil;
        end;
    TurnArrayToPageSortedList := SortedListHeader;
End;

procedure OutputSubjectIndexInPage(HashTable: THashTable);
var
    PageListHeader: PHeader;
begin
    PageListHeader := TurnArrayToPageSortedList(HashTable);
    OutputList(PageListHeader);
    DisposeList(PageListHeader);
end;

procedure EditTerm(HashTable: THashTable);
var
    TermValue: String;
    NowTerm: PTerm;
    Choice:Integer;
    Header: PHeader;
begin
    Writeln('Введите термин');
    Readln(TermValue);
    if HasThisTerm(HashTable, TermValue) then
    begin
        Header := HashTable[GetHashValue(TermValue)];
        if (Header^.FirstTerm^.TermValue = TermValue) then
        begin
            NowTerm := Header^.FirstTerm;
        end
        else
        begin
            NowTerm := Header^.FirstTerm;
            while (NowTerm^.NextTerm <> nil) and (NowTerm^.NextTerm^.TermValue <> TermValue) do
                NowTerm := NowTerm^.NextTerm;

            NowTerm := NowTerm^.NextTerm;
        end;

        repeat
            Writeln('--------------------------------------------------------');
            Writeln('РЕДАКТОР ТЕРМИНА ' + TermValue);
            OutputEditTermMenu;
            Choice := InputChoice(1,6);
            case Choice of
                1: AddSubterm(NowTerm);
                2: EditSubterm(NowTerm);
                3: DeleteSubterm(NowTerm);
                4: AddPage(NowTerm);
                5: DeletePage(NowTerm);
                6:
            end;
        until Choice = 6;
    end
    else
        Writeln('Термин не найден!');
end;

procedure DeleteTerm(HashTable: THashTable);
var
    Curr, Temp: PTerm;
    DelTermValue: String;
    Header: PHeader;
begin
    Writeln('Введите термин: ');
    Readln(DelTermValue);
    if HasThisTerm(HashTable, DelTermValue) then
    begin
        Header := HashTable[GetHashValue(DelTermValue)];
        Curr := Header^.FirstTerm;
        if Curr^.TermValue = DelTermValue then
        begin
            Temp := Curr;
            Header^.FirstTerm := Curr^.NextTerm;
            Dispose(Temp);
        end
        else
        begin
            Temp := Curr^.NextTerm;
            while Temp^.TermValue <> DelTermValue do
            begin
                Curr := Temp;
                Temp := Temp^.NextTerm;
            end;

            Curr^.NextTerm := Temp^.NextTerm;
            Dispose(Temp);
        end;
        Writeln('Термин удален успешно!')
    end
    else
        Writeln('Термин не найден!');
end;

procedure OutputAllSubterms(Term: PTerm);
var
    Subterm: PTerm;
begin
    if (Term^.Subterm <> nil) then
    begin
        Subterm := Term^.Subterm;
        repeat
            OutputSubterm(Subterm, '    ');
            Subterm := Subterm^.NextTerm;
        until Subterm = nil;
    end
    else
        Writeln;
end;

procedure SearhSubtermByTerm(HashTable: THashTable; TermValue: String);
var
    Hash: Integer;
    Curr: PTerm;
begin
    Hash := GetHashValue(TermValue);
    if not HasThisTerm(HashTable, TermValue) then
        Writeln('Не найден такой термин!')
    else
    begin
        Curr := HashTable[Hash]^.FirstTerm;
        while (Curr <> nil) and (Curr^.TermValue <> TermValue) do
            Curr := Curr^.NextTerm;

        Writeln('Подтермины ', TermValue,':');
        OutputAllSubterms(Curr);
    end;
end;

procedure OutputTerm(Term: PTerm);
var
    Page: PPages;
    Subterm: PTerm;
begin
    Writeln('----------------------------');
    Write(Term^.TermValue + '| ');
    Page := Term^.Pages;
    while Page <> nil do
    begin
        Write(Page^.PageValue, ' ');
        Page := Page^.NextPage;
    end;
    if (Term^.Subterm <> nil) then
    begin
        Writeln;
        Subterm := Term^.Subterm;
        repeat
            OutputSubterm(Subterm, '    ');
            Subterm := Subterm^.NextTerm;
        until Subterm = nil;
    end
    else
        Writeln;
    Writeln('----------------------------');
end;

function CheckSubtermList(Subterm: PTerm; SubtermValue: String): Boolean;
var
    HasSubterm: Boolean;
    Curr: PTerm;
begin
    Curr := Subterm;

    HasSubterm := SubtermValue = Curr^.TermValue;
    if HasSubterm then
    begin
        CheckSubtermList := True;
        Exit;
    end;

    if Curr^.Subterm <> nil then
    begin
        HasSubterm := CheckSubtermList(Curr^.Subterm, SubtermValue);
        if HasSubterm then
        begin
            CheckSubtermList := True;
            Exit;
        end;
    end;

    if Curr^.NextTerm <> nil then
    begin
        HasSubterm := CheckSubtermList(Curr^.NextTerm, SubtermValue);
        if HasSubterm then
        begin
            CheckSubtermList := True;
            Exit;
        end;
    end
end;

procedure CheckTermBySubterm(Term: PTerm; SubtermValue: String; var HasTerm: Boolean);
begin
    while Term <> nil do
    begin
        if Term^.Subterm <> nil then
        begin
            if CheckSubtermList(Term^.Subterm, SubtermValue)then
            begin
                OutputTerm(Term);
                HasTerm := True;
            end;
        end;
        Term := Term^.NextTerm;
    end;
end;

procedure SearchTermBySubterm(HashTable: THashTable; SubtermValue: String);
var
    I: Integer;
    HasTerm: Boolean;
begin
    HasTerm := False;
    for I := Low(HashTable) to High(HashTable) do
    begin
        if HashTable[I]^.FirstTerm <> nil then
        begin
            CheckTermBySubterm(HashTable[I]^.FirstTerm, SubtermValue, HasTerm);
        end;
    end;

    if not HasTerm then
        Writeln('Термины не найдены!');
end;

begin
    Writeln('Данная программа - предметный указатель');
    CreateHashTable(HashTable);
    repeat
        OutputMainMenu;
        Choice := InputChoice(1, 8);
        case Choice of
            1: OutputSubjectIndexInAlphabet(HashTable);
            2: OutputSubjectIndexInPage(HashTable);
            3: begin
                    Writeln('Введите термин: ');
                    Readln(TermValue);
                    if not HasThisTerm(HashTable, TermValue) then
                    begin
                        NewTerm := CreateNewTerm(TermValue);
                        repeat
                            Writeln('--------------------------------------------------------');
                            Writeln('РЕДАКТОР ТЕРМИНА ' + TermValue);
                            OutputEditTermMenu;
                            Choice := InputChoice(1,6);
                            case Choice of
                                1: AddSubterm(NewTerm);
                                2: EditSubterm(NewTerm);
                                3: DeleteSubterm(NewTerm);
                                4: AddPage(NewTerm);
                                5: DeletePage(NewTerm);
                                6: AddTerm(NewTerm);
                            end;
                        until Choice = 6;
                    end;
                end;
            4: EditTerm(HashTable);
            5: DeleteTerm(HashTable);
            6: begin
                   Writeln('Введите подтермин:');
                   Readln(TermValue);
                   SearchTermBySubterm(HashTable, TermValue)
               end;
            7: begin
                   Writeln('Введите термин:');
                   Readln(TermValue);
                   SearhSubtermByTerm(HashTable, TermValue)
               end;
        end;
    until Choice = 8;
    end.