From: emery@mitre-bedford.arpa (David Emery)
Subject: Interactive (terminal) IO: sample implementation
Date: 30 Apr 92 18:56:27 GMT [thread overview]
Message-ID: <EMERY.92Apr30135627@Dr_No.mitre.org> (raw)
One of the common criticisms of Ada that I've heard concerns the
ability of Ada to do terminal-oriented, interactive I/O. Generally,
people have responded that the problem tends to be in the operating
system, rather than in the Ada compilation system. They also point
out some problems with TEXT_IO that makes this very hard to do.
Well, in part to show it can be done (and how easy it is to do it),
attached is a package that performs interactive non-blocking I/O on
terminals in POSIX operating systems, using the POSIX/Ada binding.
This package is modelled after the Basic "inkey" function, that reads
the keyboard and returns a value if one is available, or returns an
indication that no input is available. In either case, the "inkey"
function does not block.
This program has been tested against a partial POSIX prototype
developed here at MITRE, implementing P1003.5 Draft 8. (I found
several bugs in my prototype getting this to work.) I fully expect
this code to be portable to conforming POSIX/Ada implementations.
(What, you don't have a conforming POSIX/Ada implementation? Ask your
compiler vendor when his implementation will be ready...)
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;
-- Sets up the terminal for non-blocking input.
-- If echo is true, then characters are echoed by the terminal
-- driver. Otherwise, no echoing of characters occurs.
-- Errors: As per POSIX_IO.open and
-- POSIX_Terminal_Functions.set_terminal_characteristics
procedure read (td : in terminal_descriptor;
valid : out boolean;
char : out POSIX.POSIX_Character);
-- Returns valid = true if a character is available from the
-- terminal and returns the character itself in char.
-- If valid is false, then char is undefined.
-- Errors: As per POSIX_IO.read, for a file opened
-- with the NON_BLOCKING option
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.
-- Errors: As per POSIX_IO.write, for a file opened
-- with the NON_BLOCKING option
procedure close (td : in out terminal_descriptor);
-- Closes the terminal (and restores its previous state).
-->Failure to call this routine before the program exits can
-->leave the terminal driver in a very dangerous state!!
-- Note that any copies of the terminal_descriptor are
-- now invalid.
-- Errors: As per POSIX_IO.close and
-- POSIX_Terminal_Functions.set_terminal_characteristics
private
type terminal_stuff;
type terminal_descriptor is access terminal_stuff;
end inkey;
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);
-- bodies --
function open_terminal (name : POSIX.POSIX_string
:= POSIX.to_POSIX_String("/dev/tty");
echo : boolean := false)
return terminal_descriptor
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);
-- need POSIX-style non_blocking
answer.original_chars := TERM.get_terminal_Characteristics
(file => answer.fd);
updated_chars := answer.original_chars; -- we'll update this copy
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)
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; -- POSIX.POSIX_Error...
end read;
procedure write (td : in terminal_descriptor;
char : in POSIX.POSIX_Character)
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; -- POSIX.POSIX_Error...
end write;
procedure close (td : in out terminal_descriptor)
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;
end close;
end Inkey;
with POSIX, Inkey;
procedure inkey_demo is
-- This program tries to read a character from the terminal.
-- If a character is input, it is printed (no echoing is
-- performed by the terminal driver.)
-- If no character is available, it prints out a ".".
-- If the character is 'q', the read loop exits.
-- Otherwise, the loop delays for 0.1 seconds, and tries again.
function "=" (L, R : POSIX.POSIX_Character)
return boolean renames POSIX."=";
td : Inkey.terminal_descriptor;
char : POSIX.POSIX_Character;
valid : boolean;
begin
td := Inkey.open_terminal; -- default name, no echo
loop
Inkey.read (td, valid, char);
if (valid) then
Inkey.write (td, char);
else
Inkey.write (td, POSIX.POSIX_Character('.'));
end if;
exit when (char = POSIX.POSIX_Character('q'));
delay 0.1;
end loop;
Inkey.write (td, POSIX.POSIX_Character'val(11)); -- newline
Inkey.close (td);
exception
when others =>
inkey.close (td); -- very important, to prevent screwing
-- up the terminal driver when this program
-- exits!!
RAISE;
end inkey_demo;
reply other threads:[~1992-04-30 18:56 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox