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

 tty_clear

Clear the display.

   63tty_clear :-
   64    string_action(cl).

 tty_flash

Give visual signal if possible, otherwise beep.

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

 string_action(+Name)

Send string from the termcap library with specified name.

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

 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).

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