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]). 42 43 44/** <module> Terminal operations 45 46This library package defines some common operations on terminals. It is 47based on the Unix termcap facility to perform terminal independant I/O 48on video displays. The package consists of three sections: 49 50 1. Predicates to perform simple operations on terminals 51 2. Extenstions to format/2 to include cursor position and clearing 52 sections of the screen. 53 3. A generic predicate to build simple menus. 54 55@bug The stream information on the terminal related streams 56 is not maintained by these predicates. 57*/ 58 59%! tty_clear 60% 61% Clear the display. 62 63tty_clear :- 64 string_action(cl). 65 66%! tty_flash 67% 68% Give visual signal if possible, otherwise beep. 69 70tty_flash :- 71 tty_get_capability(vb, string, Vb), 72 !, 73 tty_put(Vb, 1). 74tty_flash :- 75 put(7). 76 77%! string_action(+Name) 78% 79% Send string from the termcap library with specified name. 80 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 *******************************/ 153 154%! menu(+Title, +Options, -Choice) is semidet. 155% 156% Show a menu. The display is cleared, the title is centered at 157% the top, the options are displayed and finally the user actions 158% are parsed and the user's choice is returned. The screen looks 159% like this: 160% 161% == 162% -------------------------------------------- 163% | | 164% | Title | 165% | | 166% | 1) Option One | 167% | 2) Option Two | 168% | 3) Quit | 169% | | 170% | Your Choice? * | 171% | | 172% == 173% 174% The user selects an item by pressing the number of the item, or 175% the first letter of the option. If more then one option match, 176% the common prefix of the matching options is given and the user 177% is expected to type the next character. On illegal input the 178% screen is flashed (or a beep is given if the terminal can't flash 179% the screen). 180% 181% Text fields (the title and option texts) are either plain atoms 182% or terms Fmt/Args. In the latter case the argument is transformed 183% into an atom using format/3. 184% 185% The specification of an option is a term PrologName:UserName. 186% PrologName is an atom, which is returned as choice if the user 187% selects this menu item. UserName is processed as a text field 188% (see above) and displayed. The entries are numbered automatically. 189% 190% The example above could be defined as: 191% 192% == 193% get_action(Choice) :- 194% menu('Title', 195% [ option_1 : 'Option One' 196% , option_2 : 'Option Two' 197% , quit : 'Quit' 198% ], Choice). 199% == 200 201 (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 (List) :- 212 build_menu(List, 1), 213 format('~2n Your choice? ~T', clear_display). 214 ([], _). 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 (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])