Interactive (terminal) IO: sample implementation

Interactive (terminal) IO: sample implementation

[David Emery]

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;