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