/pliant/language/ui/ansi_terminal.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	module "/pliant/install/ring2.pli"
17	submodule "console1.pli"
18
19
20
21	#  input
22
23
24	public
25	constant keyboard_break  3
26	constant keyboard_rubout 8
27	constant keyboard_enter  13
28	constant keyboard_insert 126
29	constant keyboard_delete 5B337Eh
30	constant keyboard_up     5B41h
31	constant keyboard_down   5B42h
32	constant keyboard_left   5B44h
33	constant keyboard_right  5B43h
34	constant keyboard_page_up   5B357Eh
35	constant keyboard_page_down 5B367Eh
36
37
38	if os_api="linux" and (constant (os_extra_info search "static" -1)<>(-1))
39
40	function keyboard_raw_readchar -> c
41	arg Int c
42	os_read 0 addressof:c 1
43
44	eif os_api="linux" or os_api="posix"
45
46	type os_TermIOs
47	field uInt c_iflag c_oflag c_cflag c_lflag
48	field uInt8 c_line
49	field (Array uInt8 32) c_cc
50	field uInt c_ispeed c_ospeed
51	field (Array Byte 16) pliant_padding
52
53	function os_tcgetattr fd ios
54	arg Int fd ; arg_w os_TermIOs ios
55	external os_libc_filename "tcgetattr"
56
57	function os_tcsetattr fd when ios
58	arg Int fd ; arg Int when ; arg os_TermIOs ios
59	external os_libc_filename "tcsetattr"
60
61	function os_cfmakeraw ios
62	arg_w os_TermIOs ios
63	external os_libc_filename "cfmakeraw"
64
65	function keyboard_raw_readchar timeout -> c
66	arg Float timeout ; arg Int c
67	var os_TermIOs current wished
68	os_tcgetattr 0 current
69	memory_copy addressof:current addressof:wished os_TermIOs:size
70	os_cfmakeraw wished
71	os_tcsetattr 0 0 wished
72	if timeout<>undefined
73	var os_pollfd fd
74	fd fd := 0
75	fd events := os_POLLIN
76	if (os_poll addressof:fd 1 (cast timeout*1000 Int))<1
77	os_tcsetattr 0 0 current
78	return undefined
79	c := 0
80	if (os_read 0 addressof:c 1)<>1
81	c := undefined
82	if c=current:c_cc:2
83	c := keyboard_rubout
84	os_tcsetattr 0 0 current
85
86	function keyboard_raw_readchar -> c
87	arg Int c
88	c := keyboard_raw_readchar undefined
89
90	eif os_api="win32"
91
92	gvar Int handle := -1
93
94	function keyboard_raw_readchar -> c
95	arg Int c
96	if handle=-1
97	var uInt access := os_GENERIC_READ
98	var uInt share :=  os_FILE_SHARE_READ .or. os_FILE_SHARE_WRITE
99	var uInt creation := os_OPEN_EXISTING
100	var uInt wflags := os_FILE_ATTRIBUTE_NORMAL .or. os_FILE_FLAG_SEQUENTIAL_SCAN
101	handle := os_CreateFile "con" access share null creation wflags null
102	os_GetConsoleMode handle (var uInt mode)
103	os_SetConsoleMode handle mode .and. .not. os_ENABLE_LINE_INPUT+os_ENABLE_ECHO_INPUT
104	os_ReadFile handle addressof:(var uInt8 ch) 1 (var Int red) null
105	os_SetConsoleMode handle mode
106	c := shunt ch<>10 ch keyboard_raw_readchar
107
108	eif os_api="os2"
109
110	function keyboard_raw_readchar -> c
111	arg Int c
112	os_DosRead 0 addressof:(var uInt8 ch) 1 (var Int red)
113	c := shunt ch<>10 ch keyboard_raw_readchar
114
115	doc
116	[Under Win32, 'keyboard_raw_readchar' works sadely because 'SetConsoleMode' fails.]
117
118
119	gvar Int keyboard_buffer := undefined
120
121	function keyboard_readchar -> c
122	arg Int c
123	if keyboard_buffer<>undefined
124	c := keyboard_buffer
125	keyboard_buffer := undefined
126	return
127	c := keyboard_raw_readchar
128	if c=27
129	c := keyboard_raw_readchar
130	if c=5Bh
131	while true
132	var Int d := keyboard_raw_readchar
133	c := c*2^8+d
134	if d<30h or d>=40h
135	return
136	else
137	keyboard_buffer := c
138	c := 27
139	eif os_api="linux" and c=keyboard_break
140	os_kill os_getpid os_SIGINT
141
142
143	function keyboard_input m -> s
144	arg Str m s
145	console m
146	s := ""
147	while true
148	var Int c := keyboard_readchar
149	if c=keyboard_rubout
150	if s:len>0
151	s := s 0 s:len-1
152	console character:keyboard_rubout+" "+character:keyboard_rubout
153	eif c=keyboard_enter
154	console "[lf]"
155	return
156	eif c<256
157	s := s+character:c
158	console character:c
159
160	function keyboard_input_password m -> s
161	arg Str m s
162	console m
163	s := ""
164	while true
165	var Int c := keyboard_readchar
166	if c=keyboard_rubout
167	if s:len>0
168	s := s 0 s:len-1
169	console character:keyboard_rubout+" "+character:keyboard_rubout
170	eif c=keyboard_enter
171	console "[lf]"
172	return
173	eif c<256
174	s := s+character:c
175	console "."
176
177
178	export keyboard_readchar keyboard_raw_readchar keyboard_input keyboard_input_password
179
180
181
182	#  output
183
184
185	function console_move x y
186	arg Int x y
187	console character:27 "[lb]" y+1 ";" x+1 "H"
188
189	export console_move