domains
/* содержит объявления типов объектов (доменов), используемых в программе */
     list=integer*
     /* домен типа списка целых чисел */
predicates
/* содержит объявление предикатов */
      add_in_begin (integer, list, list)
     /* предикат, реализующий добавление компоненты в начало стека */
     add (list, list, list)
     /* вспомогательный предикат для добавления элементов*/
     write_stek (list, integer)
     /* предикат, реализующий вывод стека */
     vvod (integer, list)
     /* предикат, реализующий формирование стека */
     process (integer, list, list)
     /* предикат, выполняющий действия, описанные в меню */
     show_menu (list, list)
     /* предикат, реализующий вывод меню на экран */
     run_file
     /* предикат, позволяющий повторять вывод меню до тех пор,
      пока пользователь не выйдет из программы */
goal /* целевое утверждение */
     run_file.
clauses /* содержит утверждения */
     run_file:-
          show_menu ([], _), nl,
          write ("Нажмите любую клавишу."),
          readchar (_),
          exit.
     show_menu (Spisok, S1):-
          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 ("  ****************************************"), nl,
          write ("  0  Выход из программы."), nl, nl,
          write ("Укажите номер: (0-4) "),
          readint (G),
          G<5,
          process (G, Spisok, S1),
          /* Spisok - исходный стек, S1 - результирующий стек */
          show_menu (S1, _),!.
          /* посылаем в качестве исходного результирующий стек */
     process (0, _, []):-!,
     /* выход из программы */
          exit.
     process (1, _, S1):-
     /* заполнение стека */
          makewindow (2, 7, 7, "Заполнение стека", 0, 0, 25, 80), nl,
          write ("Введите количество элементов стека:"), nl, nl,
          readint (Kol), nl,
          write("Вводите элементы:"), nl, nl,
          vvod (Kol, S1), nl, nl,
          write("Стек заполнен."),
          nl, nl,
          write ("Для продолжения нажмите любую клавишу."),
          readchar (_),
          removewindow,!.
     process (2, Spisok, S1):-
     /* добавление элемента в вершину стека */
          makewindow (3, 7, 7, "Добавление элемента в вершину стека",
          0, 0, 25, 80), nl,
          write ("Введите добавляемый в вершину стека элемент:"), nl, nl,
          readint (X), nl,
          add_in_begin (X, Spisok, S1),
          nl, nl,
          write ("Элемент в вершину добавлен."),
          nl, nl,
          write ("Для продолжения нажмите любую клавишу."),
          readchar (_),
          removewindow,!.
     process (3, Spisok, S1):-
     /* удаление элемента из вершины стека */
          makewindow (4, 7, 7, "Удаление элемента из вершины стека",
          0, 0, 25, 80), nl,
          write ("Элемент из вершины стека удален."), nl, nl,
          Spisok = [_|S1],
          write ("Для продолжения нажмите любую клавишу."),
          readchar (_),
          removewindow,!.
     process (4, Spisok, S1):-
     /* печать стека */
          nl, nl,
          write ("Полученный стек:"), nl, nl,
          write_stek (Spisok, 0),
          S1 = Spisok,
          nl, nl,
          write ("Для продолжения нажмите любую клавишу."),
          readchar (_),
          removewindow,!.

     vvod (0, []).
     vvod (N, L):-
          readint (X),
          N1 = N-1,
          vvod (N1, LL),
          G = [X|[]],
          add (LL, G, L).

     add ([], S, S).
     add ([X|S1], S2, [X|S3]):-
          add (S1, S2, S3).
     add_in_begin (X, L, [X|L]):-!.

     write_stek ([], 0):-
          write ("Стек пустой!!!").
     write_stek ([], 1):-!.
     write_stek ([H|T], _):-
          write (H, "  "),
          write_stek (T, 1).