* Re: How to check for characters in input stream?
1994-09-14 23:55 ` Luke Teyssier
@ 1994-09-15 8:26 ` David Emery
0 siblings, 0 replies; 5+ messages in thread
From: David Emery @ 1994-09-15 8:26 UTC (permalink / raw)
--Here (again) is a package to do non-blocking character IO using
--POSIX/Ada. dave
with POSIX;
package Inkey is
type terminal_descriptor is private;
function open_terminal (name : POSIX.POSIX_string
:= POSIX.to_POSIX_String("/dev/tty");
echo : boolean := false)
return terminal_descriptor;
-- if echo is true, then characters are echoed by the terminal
-- driver. Otherwise, no echoing of characters occurs.
procedure read (td : in terminal_descriptor;
valid : out boolean;
char : out POSIX.POSIX_Character);
-- returns valid if a character is available from the terminal
-- and returns the character itself in char. Needless to
-- say, if valid is false, then char is undefined.
procedure write (td : in terminal_descriptor;
char : in POSIX.POSIX_Character);
-- writes the character immediately on the terminal. No
-- buffering. Note that this can raise POSIX_Error with
-- Resource_Temporarily_Unavailable if the write would block,
-- the same way other calls to POSIX_IO.write can.
procedure close (td : in out terminal_descriptor);
-- closes the terminal (and restores its previous state)
-- note that any copies of the terminal_descriptor are
-- now invalid
private
type terminal_stuff;
type terminal_descriptor is access terminal_stuff;
end inkey;
------------------------------------------------------------------------
--with POSIX;
with POSIX_IO, POSIX_Terminal_Functions;
with Unchecked_Deallocation;
package body inkey is
package TERM renames POSIX_Terminal_Functions;
function "=" (l, r : POSIX.IO_Count)
return boolean renames POSIX."=";
type terminal_stuff is record
fd : POSIX_IO.file_descriptor;
original_chars : TERM.terminal_characteristics;
end record;
procedure free is new Unchecked_Deallocation
(terminal_stuff, terminal_descriptor);
function open_terminal (name : POSIX.POSIX_string
:= POSIX.to_POSIX_String("/dev/tty");
echo : boolean := false)
return terminal_descriptor
-- if echo is true, then characters are echoed by the terminal
-- driver. Otherwise, no echoing of characters occurs.
is
answer : terminal_stuff;
updated_chars : TERM.terminal_characteristics;
modes : TERM.terminal_modes_set;
begin
answer.fd := POSIX_IO.open
(name => name,
mode => POSIX_IO.Read_Write,
options => POSIX_IO.non_blocking);
answer.original_chars := TERM.get_terminal_Characteristics
(file => answer.fd);
updated_chars := answer.original_chars;
modes := TERM.terminal_modes_of (updated_chars);
-- we want non-canonical mode, and whatever was provided
-- for echo
modes(TERM.canonical_input) := false;
modes(TERM.echo) := echo;
TERM.define_terminal_modes (updated_chars, modes);
-- we also want the input time to be 0, and the min input count
-- to be 0.
TERM.define_input_time (updated_chars, duration'(0.0));
TERM.define_minimum_input_count (updated_chars, 0);
TERM.Set_Terminal_Characteristics
(file => answer.fd,
characteristics => updated_chars,
apply => TERM.immediately);
RETURN new terminal_stuff'(answer);
exception
when others =>
-- if terminal is open, then close it...
begin
POSIX_IO.close (answer.fd);
exception
when others => null; -- ignore any errors here
end;
RAISE;
end open_terminal;
procedure read (td : in terminal_descriptor;
valid : out boolean;
char : out POSIX.POSIX_Character)
-- returns valid if a character is available from the terminal
-- and returns the character itself in char. Needless to
-- say, if valid is false, then char is undefined.
is
read_count : POSIX.IO_Count;
buff : POSIX_IO.IO_Buffer(1..1);
begin
POSIX_IO.read
(file => td.all.fd,
buffer => buff,
last => read_count);
if (read_count = 0) then
valid := false;
else
valid := true;
char := buff(1);
end if;
exception
when constraint_error => -- td is invalid, i.e. null;
POSIX.Set_error_code (POSIX.invalid_argument);
RAISE POSIX.POSIX_Error;
when others => RAISE; -- this will inc
end read;
procedure write (td : in terminal_descriptor;
char : in POSIX.POSIX_Character)
-- writes the character immediately on the terminal. No
-- buffering
is
buff : POSIX_IO.IO_Buffer(1..1);
last : POSIX.IO_Count;
begin
buff(1) := char;
POSIX_IO.write
(file => td.all.fd,
buffer => buff,
last => last); -- should be 0 or 1...
if (last /= 1) then -- can't write.
POSIX.set_error_code (POSIX.Resource_Temporarily_Unavailable);
RAISE POSIX.POSIX_Error;
end if;
exception
when constraint_error => -- td is invalid, i.e. null;
POSIX.Set_error_code (POSIX.invalid_argument);
RAISE POSIX.POSIX_Error;
when others => RAISE; -- this will inc
end write;
procedure close (td : in out terminal_descriptor)
-- closes the terminal (and restores its previous state)
is
begin
TERM.Set_Terminal_Characteristics
(file => td.all.fd,
characteristics => td.all.original_chars,
apply => TERM.immediately);
POSIX_IO.close (td.all.fd);
free (td);
exception
when constraint_error => -- td is invalid, i.e. null;
null; -- already closed?!
when others => RAISE; -- this will inc
end close;
end inkey;
--
--The preceeding opinions do not necessarily reflect the opinions of
--The MITRE Corporation or its sponsors.
-- "A good plan violently executed -NOW- is better than a perfect plan
-- next week" George Patton
-- "Any damn fool can write a plan. It's the execution that gets you
-- all screwed up" James Hollingsworth
-------------------------------------------------------------------------
^ permalink raw reply [flat|nested] 5+ messages in thread