Re: How to check for characters in input stream?

[emery@goldfinger.mitre.org (David Emery)]

--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
-------------------------------------------------------------------------