1/* 
    2	Copyright 2014-215 Samer Abdallah (UCL)
    3	 
    4	This program is free software; you can redistribute it and/or
    5	modify it under the terms of the GNU Lesser General Public License
    6	as published by the Free Software Foundation; either version 2
    7	of the License, or (at your option) any later version.
    8
    9	This program is distributed in the hope that it will be useful,
   10	but WITHOUT ANY WARRANTY; without even the implied warranty of
   11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12	GNU Lesser General Public License for more details.
   13
   14	You should have received a copy of the GNU Lesser General Public
   15	License along with this library; if not, write to the Free Software
   16	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   17*/
   18
   19:- module(termutils, 
   20   [  with_status_line/1
   21   ,  put_cap/2
   22   ,  put_cap/1
   23   ,  status/2
   24   ,  msg/2
   25   ,  msg/1
   26   ,  heading/2
   27   ,  ask/3
   28   ,  get_key/2
   29   ,  userchk/1
   30   ,  termcap/2
   31   ]).   32      
   33:- meta_predicate with_status_line(0).   34
   35put_cap(Cap) :- tty_get_capability(Cap,string,Atom), tty_put(Atom,1).
   36put_cap(Cap,Lines) :- tty_get_capability(Cap,string,Atom), tty_put(Atom,Lines).
   37
   38user:goal_expansion(put_cap(Cap), tty_put(Atom,1)) :-
   39	tty_get_capability(Cap,string,Atom).
   40user:goal_expansion(put_cap(Cap,Lines), tty_put(Atom,Lines)) :-
   41	tty_get_capability(Cap,string,Atom).
   42
   43with_status_line(Goal) :-
   44	stream_property(user_output,buffer(Buff)),
   45	tty_size(_,Width), W is Width-1,
   46	flag(line_len,_,W),
   47	setup_call_cleanup(
   48		set_stream(user_output,buffer(false)), (put_cap(cr), call(Goal), status("",[])),
   49		set_stream(user_output,buffer(Buff))).
   50
   51msg(F) :- msg(F,[]).
   52msg(F,A) :- format(user_output,F,A), nl.
   53
   54ask(F,A,Ch) :- 
   55   format(user_output,F,A), flush_output(user_output), 
   56   get_single_char(C), put_char(user_output,C), 
   57   char_code(Ch,C), nl.
   58
   59heading(F,A) :- 
   60   with_output_to(user_output, (ansi_format([bold],F,A), nl,nl)).
   61
   62status(F,A) :- 
   63	format(string(Msg),F,A), 
   64	flag(line_len,MaxLen,MaxLen),
   65	string_length(Msg,Len),
   66	(Len>MaxLen -> sub_string(Msg,0,MaxLen,_,Msg1); Msg=Msg1),
   67	write(user_output,Msg1), put_cap(ce), put_cap(cr).
 get_key(+Valid:list(char), -C:char) is det
Get and validate a key press from the user. The character must be one of the ones listed in Valid, otherwise, an error message is printed and the user prompted again.
   75get_key(Valid,C) :-
   76	read_char_echo(D), nl,
   77	(	member(D,Valid) -> C=D
   78	;	D='\n' -> get_key(Valid,C) % this improves interaction with acme
   79	;	format('Unknown command "~q"; valid keys are ~q.\n', [D,Valid]),
   80		write('Command? '),
   81		get_key(Valid,C)).
 prompt_for_key(+Msg:atom, +Keys:list(char), -Key:char) is semidet
Prompt user for a keypress. Prompt message is Msg, and valid keys are listed in Keys.
   88prompt_for_key(Msg,Keys,Key) :- format('~p ~q? ',[Msg,Keys]), get_key(Keys,Key).
 read_char_echo(-C:atom) is det
Read a single character from the current input, echo it to the output.
   95read_char_echo(C) :-
   96	get_single_char(Code), 
   97	put_code(Code), flush_output,
   98	char_code(C,Code). 
 userchk(T) is semidet
Write T and ask this user if it is ok. User presses y or n. userchk succeeds if if the keypress was y and fails if it was n.
  105userchk(T) :- prompt_for_key(T,[y,n],y).
 termcap(-Cap:atom, -Type:atom) is nondet
Extracts two character termcap capabilities and types from TERMCAP environment variable. These can be used with tty_get_capability/3.
  110termcap(Cap,Type) :-
  111   getenv('TERMCAP',TERMCAP),
  112   atom_codes(TERMCAP, Codes),
  113   phrase((any,cap(CapCodes,Type)),Codes,_),
  114   atom_codes(Cap,CapCodes).
  115
  116any --> []; [_], any.
  117cap([C1,C2],Type) --> ":", gr(C1), gr(C2), delim(Type).
  118gr(C) --> [C], {code_type(C,graph)}.
  119delim(bool) --> ":".
  120delim(string) --> "=".
  121delim(number) --> "#"