domains
/* содержит объявления типов объектов (доменов), используемых в программе */
     tre = tr (tre, integer, tre); nil
     /* структура, состоящая из корня, левого и правого поддерева */
predicates
/* содержит объявление предикатов */
     in (integer, tre, integer)
     /* предикат, проверяющий наличие элемента в дереве */
     adlist (tre, integer, tre)
     /* предикат, реализующий добавление элемента в дерево */
     write_tree (tre, tre)
     /* предикат, реализующий вывод дерева */
     write_tree1 (tre, tre, integer, integer)
     /* вспомогательный предикат для вывода */
     while (integer, tre, tre)
     /* предикат, реализующий ввод дерева */
     tab (integer)
     /* вспомогательный предикат для печати пробелов */
     obhod_left (tre)
     /* предикат для левостороннего обхода */
     obhod_end (tre)
     /* предикат для концевого обхода */
     obhod_back (tre)
     /* предикат для обратного обхода */
     delete (tre, integer, tre, integer)
     /* предикат, реализующий удаление элемента из дерева */
     delete1 (tre, integer, tre)
     /* вспомогательный предикат для удаления элемента из дерева */
     process (integer, tre, tre)
     /* предикат, выполняющий действия, описанные в меню */
     show_menu (tre, tre)
     /* предикат, реализующий вывод меню на экран */
     run_file
     /* предикат, позволяющий повторять вывод меню до тех пор,
     пока пользователь не выйдет из программы */
goal 
/* целевое утверждение */
     run_file.
clauses
 /* содержит утверждения */
     run_file:-
          show_menu (nil, _), nl,
          write ("Нажмите любую клавишу."),
          readchar (_),
          exit.
     show_menu (T,T1):-
          makewindow (1, 7, 7, "Главное меню", 0, 0, 25, 80), nl,
          /* номер окна - 1, символы в нем белые, а фон черный (7), 
          рамка белая (7), название окна, верхний левый угол окна на строке 0,
          столбце 0, а само окно имеет 25 строк и 80 столбцов */
          write ("Выберите действие:"), nl, nl,
          write ("  1  Построение дерева."), nl,
          write ("  2  Добавление вершины к дереву."), nl,
          write ("  3  Удаление вершины из дерева."), nl,
          write ("  4  Обходы дерева."), nl,
          write ("  5  Вывод дерева."), nl,
          write ("*************************************"), nl,
          write ("  0  Выход из программы."), nl, nl,
          write ("Укажите номер: (0-5) "),
          readint (G),
          G<6,
          process (G, T, T1),
          /* T - исходное дерево, T1 - результирующее дерево */
         show_menu (T1, _),!.
         /* посылаем в качестве исходного дерева результирующее*/
     process (0, T, nil):-
     /* выход из программы */
          exit, 
          T = nil.
     process (1, _, T1):-
     /* построение дерева */
          makewindow (2, 7, 7, "Построение дерева", 0, 0, 25, 80), nl,
          write ("Вводите элементы, окончание-999"), nl ,nl,
          readint (Z),
          while (Z, nil, T1),
          nl, nl,
          write ("Дерево построено."), nl, nl,
          write ("Для продолжения нажмите любую клавишу."),
          readchar (_),
          removewindow,!.
          /* удаляет текущее окно с экрана */
     process (2, T, T1):-
     /* добавление вершины к дереву */
          makewindow (3, 7, 7, "Добавление вершины к дереву", 0, 0, 25, 80), nl,
          write ("Введите добавляемый элемент: "),
          readint (C),
          adlist (T, C, T1),
          nl, nl,
          write ("Элемент к дереву добавлен."), nl, nl,
          write ("Для продолжения нажмите любую клавишу."),
          readchar (_),
          removewindow,!.
     process (3, T, T1):-
     /* удаление элемента из дерева */
          makewindow (4, 7, 7, "Удаление элемента из дерева", 0, 0, 25, 80), nl,
          write ("Введите удаляемый элемент: "),
          readint (F),
          in (F, T, H),
          delete (T, F, T1, H),
          nl, nl,
          write ("Для продолжения нажмите любую клавишу."),
          readchar (_),
          removewindow,!.
     process (4, T, T1):-
     /* обходы дерева */
          makewindow (3, 7, 7, "Обходы дерева", 0, 0, 25, 80), nl,
          write ("Рассматриваемое дерево :"), nl, nl,
          write_tree (T, T1), nl,
          write ("Левосторонний обход :"), nl, nl,
          obhod_left (T), nl, nl,
          write ("Концевой обход :"), nl, nl,
          obhod_end (T), nl, nl,
          write ("Обратный обход :"), nl, nl,
          obhod_back (T), nl, nl,
          write ("Для продолжения нажмите любую клавишу."),
          readchar (_),
          removewindow,!.
     process (5, T, T):-
     /* вывод дерева */
          nl, nl,
          write ("Полученное дерево: "), nl, nl,
          write_tree (T, T), nl,
          write ("Для продолжения нажмите любую клавишу."),
          readchar (_),
          removewindow,!.

     in (X, tr (_, X, _), 0).
     in (_, tr (nil, _, nil), 1):-!.
     in (X, tr (L, K, _), H):-
          X<K,
          in (X, L, H).
     in (X, tr (R, K, _), H):-
          X>K,
          in (X, R, H).

     adlist (nil, X, tr (nil, X, nil)).
     adlist (tr (L, X, R), X, tr (L, X, R)).
     adlist (tr (L, K, R), X, tr (L1, K, R)):-
          X<K,
          adlist (L, X, L1).
     adlist (tr (L, K, R), X, tr (L, K, R1)):-
          X>K,
          adlist (R, X, R1).

     while (999, D, D):- !.
     while (X, D,K):-
          adlist (D, X, D1),
          readint (X1),
          while (X1, D1, K).

     write_tree (T, T):-
          write_tree1 (T, T, 0, 0).

     write_tree1 (nil, _, _, 1):-!.
     write_tree1 (nil, _, _, 0): -   
          write ("Дерево пустое!!!"), nl.
     write_tree1 (tr (L, X, R), T, S, _):-
          B = S+2,
          write_tree1 (R, T, B, 1), 
          tab (B),
          write (X), nl,         
          write_tree1 (L, T, B, 1).

     tab (0).
     tab (X):-
          write (" "),
          X1 = X-1,
          tab (X1). 

     obhod_end (nil).
     obhod_end (tr (L, X, R)):-
          obhod_end (L),
          obhod_end (R),
          write (X, " ").
          obhod_back (nil).

     obhod_back (tr (L, X, R)):-
          obhod_back (L),
          write (X, " "),
          obhod_back (R).

     obhod_left (nil).
     obhod_left (tr (L, X, R)):-
          write (X," "),
          obhod_left (L),
          obhod_left (R).

     delete (tr (nil, X, R), X, R, 0): - 
          nl, write ("Элемент из дерева удален.").
     delete (tr (L, X, nil), X, L, 0): -
          nl, write ("Элемент из дерева удален.").
     delete (T, _, T, 1): - 
          nl, write ("Такого элемента нет!!!").
     delete (tr (L, X, R), X, tr (L, Y, R1), _):-
          delete1 (R, Y, R1).
     delete (tr (L, K, R), X, tr (L1, K, R), H):-
          X<K,
          delete (L, X, L1, H).
      delete (tr (L, K, R), X, tr (L, K, R1), H):-
           X>K,
           delete (R, X, R1, H).

      delete1 (tr (nil, Y, R), Y, R).
      delete1 (tr (L, K, R), Y, tr (L1, K, R)):-
           delete1 (L, Y, L1).