1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1985-2002, University of Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(tty,
   36        [ tty_clear/0
   37        , tty_flash/0
   38        , menu/3
   39        ]).   40:- use_module(library(lists), [append/3, nth1/3]).

 tty_clear

Clear the display.

   61tty_clear :-
   62    string_action(cl).

 tty_flash

Give visual signal if possible, otherwise beep.

   68tty_flash :-
   69    tty_get_capability(vb, string, Vb),
   70    !,
   71    tty_put(Vb, 1).
   72tty_flash :-
   73    put(7).

 string_action(+Name)

Send string from the termcap library with specified name.

   79string_action(Name) :-
   80    tty_get_capability(Name, string, String),
   81    tty_put(String, 1).
   82
   83/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   84                                 FORMAT
   85
   86The functions below add some extras to the format facilities.  This to
   87simplify screen management.  It adds ~T to the set of format characters.
   88The argument to ~T is a (list of) tty control commands.  The ~l command
   89is defined to clear to the end of the line before generating a newline.
   90
   91Example:
   92
   93?- format('~T~3l', home),
   94   format('    1) Hello World~l'),
   95   format('    2) Exit~2l'),
   96   format('    Your choice? ~T', [clear_display, flush]),
   97   get_single_char(X).
   98- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
   99
  100:- format_predicate('T', tty_action(_Arg, _What)).  101:- format_predicate('l', tty_nl(_Args)).  102
  103tty_action(_, What) :-
  104    tty_action(What).
  105
  106tty_action([]) :- !.
  107tty_action([A|B]) :-
  108    !,
  109    tty_action(A),
  110    tty_action(B).
  111tty_action(goto(X,Y)) :-
  112    !,
  113    tty_goto(X, Y).
  114tty_action(home) :-
  115    !,
  116    tty_goto(0, 0).
  117tty_action(flush) :-
  118    !,
  119    ttyflush.
  120tty_action(center(Text)) :-
  121    !,
  122    tty_size(W, _),
  123    format('~t~a~t~*|', [Text, W]).
  124tty_action(back(N)) :-
  125    !,
  126    forall(between(1, N, _), put_code(8)).
  127tty_action(Long) :-
  128    abbreviation(Long, Short),
  129    !,
  130    string_action(Short).
  131tty_action(Short) :-
  132    string_action(Short).
  133
  134abbreviation(clear,             cl).            % clear and home
  135abbreviation(clear_line,        ce).            % clear-to-end-of-line
  136abbreviation(clear_display,     cd).            % clear-to-end-of-display
  137
  138tty_nl(default) :-
  139    !,
  140    tty_nl(1).
  141tty_nl(N) :-
  142    tty_get_capability(ce, string, Ce),
  143    forall(between(1, N, _),
  144           (   tty_put(Ce, 1),
  145               nl)).
  146
  147
  148                 /*******************************
  149                 *             MENU             *
  150                 *******************************/

 menu(+Title, +Options, -Choice) is semidet

Show a menu. The display is cleared, the title is centered at the top, the options are displayed and finally the user actions are parsed and the user's choice is returned. The screen looks like this:

        --------------------------------------------
        |                                          |
        |                  Title                   |
        |                                          |
        |   1) Option One                          |
        |   2) Option Two                          |
        |   3) Quit                                |
        |                                          |
        |   Your Choice? *                         |
        |                                          |

The user selects an item by pressing the number of the item, or the first letter of the option. If more then one option match, the common prefix of the matching options is given and the user is expected to type the next character. On illegal input the screen is flashed (or a beep is given if the terminal can't flash the screen).

Text fields (the title and option texts) are either plain atoms or terms Fmt/Args. In the latter case the argument is transformed into an atom using format/3.

The specification of an option is a term PrologName:UserName. PrologName is an atom, which is returned as choice if the user selects this menu item. UserName is processed as a text field (see above) and displayed. The entries are numbered automatically.

The example above could be defined as:

get_action(Choice) :-
        menu('Title',
                [ option_1 : 'Option One'
                , option_2 : 'Option Two'
                , quit     : 'Quit'
                ], Choice).

  200menu(Title, List, Choice) :-
  201    show_title(Title),
  202    build_menu(List),
  203    get_answer(List, Choice).
  204
  205show_title(Title) :-
  206    to_text(Title, T),
  207    format('~T~l~T~2l', [clear, center(T)]).
  208
  209build_menu(List) :-
  210    build_menu(List, 1),
  211    format('~2n      Your choice? ~T', clear_display).
  212
  213build_menu([], _).
  214build_menu([_:H|T], N) :-
  215    to_text(H, TH),
  216    format('~t~d~6|) ~a~l', [N, TH]),
  217    succ(N, NN),
  218    build_menu(T, NN).
  219
  220to_text(Fmt/Args, Text) :-
  221    !,
  222    format(string(Text), Fmt, Args).
  223to_text(Text, Text).
  224
  225:- dynamic
  226    menu_indent/1.  227
  228menu_indent(Old, New) :-
  229    (   retract(menu_indent(Old0))
  230    ->  Old = Old0
  231    ;   Old = 0
  232    ),
  233    assert(menu_indent(New)).
  234
  235get_answer(List, Choice) :-
  236    menu_indent(_, 0),
  237    get_answer(List, [], Choice).
  238
  239get_answer(List, Prefix, Choice) :-
  240    get_single_char(A),
  241    process_answer(A, List, Prefix, NewPrefix, Ch, Ok),
  242    (   Ok == yes
  243    ->  Ch = Choice
  244    ;   get_answer(List, NewPrefix, Choice)
  245    ).
  246
  247process_answer(127, _, _, [], _, no) :-
  248    !,
  249    feedback('').
  250process_answer(D, List, _, _, Choice, yes) :-
  251    code_type(D, digit),
  252    name(N, [D]),
  253    nth1(N, List, Choice:Name),
  254    !,
  255    feedback(Name).
  256process_answer(D, _, _, [], _, no) :-
  257    code_type(D, digit),
  258    feedback(''),
  259    tty_flash.
  260process_answer(C, List, Prefix, NewPrefix, Choice, Ok) :-
  261    append(Prefix, [C], NPrefix),
  262    matching(List, NPrefix, Matching),
  263    (   Matching == []
  264    ->  tty_flash,
  265        NewPrefix = Prefix,
  266        Ok = no
  267    ;   Matching = [Choice:Name]
  268    ->  Ok = yes,
  269        feedback(Name)
  270    ;   common_prefix(Matching, NewPrefix),
  271        feedback(NewPrefix),
  272        Ok = no
  273    ).
  274
  275matching([], _, []).
  276matching([H|T], Prefix, [H|R]) :-
  277    prefix(Prefix, H),
  278    !,
  279    matching(T, Prefix, R).
  280matching([_|T], Prefix, R) :-
  281    matching(T, Prefix, R).
  282
  283prefix(Prefix, _:Name) :-
  284    name(Name, Chars),
  285    common_prefix_strings(Prefix, Chars, Prefix),
  286    !.
  287
  288common_prefix([_:Name|T], Prefix) :-
  289    name(Name, Chars),
  290    common_prefix(T, Chars, Prefix).
  291
  292common_prefix([], Prefix, Prefix).
  293common_prefix([_:Name|T], Sofar, Prefix) :-
  294    name(Name, Chars),
  295    common_prefix_strings(Chars, Sofar, NewSofar),
  296    common_prefix(T, NewSofar, Prefix).
  297
  298common_prefix_strings([H1|T1], [H2|T2], [H1|R]) :-
  299    code_type(Lower, to_lower(H1)),
  300    code_type(Lower, to_lower(H2)),
  301    !,
  302    common_prefix_strings(T1, T2, R).
  303common_prefix_strings(_, _, []).
  304
  305feedback(Text) :-
  306    atomic(Text),
  307    !,
  308    atom_length(Text, New),
  309    menu_indent(Old, New),
  310    format('~T~a~T', [back(Old), Text, clear_line]).
  311feedback(Text) :-
  312    length(Text, New),
  313    menu_indent(Old, New),
  314    format('~T~s~T', [back(Old), Text, clear_line])