Ada95/ada_include/terminal_interface-curses-aux.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                           GNAT ncurses Binding                           --
   4 --                                                                          --
   5 --                      Terminal_Interface.Curses.Aux                       --
   6 --                                                                          --
   7 --                                 B O D Y                                  --
   8 --                                                                          --
   9 --  Version 00.92                                                           --
  10 --                                                                          --
  11 --  The ncurses Ada95 binding is copyrighted 1996 by                        --
  12 --  Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de                     --
  13 --                                                                          --
  14 --  Permission is hereby granted to reproduce and distribute this           --
  15 --  binding by any means and for any fee, whether alone or as part          --
  16 --  of a larger distribution, in source or in binary form, PROVIDED         --
  17 --  this notice is included with any such distribution, and is not          --
  18 --  removed from any of its header files. Mention of ncurses and the        --
  19 --  author of this binding in any applications linked with it is            --
  20 --  highly appreciated.                                                     --
  21 --                                                                          --
  22 --  This binding comes AS IS with no warranty, implied or expressed.        --
  23 ------------------------------------------------------------------------------
  24 --  Version Control:
  25 --  $Revision: 1.3 $
  26 ------------------------------------------------------------------------------
  27 package body Terminal_Interface.Curses.Aux is
  28    --
  29    --  Some helpers
  30    procedure Fill_String (Cp  : in  chars_ptr;
  31                           Str : out String)
  32    is
  33       --  Fill the string with the characters referenced by the
  34       --  chars_ptr.
  35       --
  36       Len : Natural;
  37    begin
  38       if Cp /= Null_Ptr then
  39          Len := Natural (Strlen (Cp));
  40          if Str'Length < Len then
  41             raise Constraint_Error;
  42          end if;
  43          declare
  44             S : String (1 .. Len);
  45          begin
  46             S := Value (Cp);
  47             Str (Str'First .. (Str'First + Len - 1)) := S (S'Range);
  48          end;
  49       else
  50          Len := 0;
  51       end if;
  52
  53       if Len < Str'Length then
  54          Str ((Str'First + Len) .. Str'Last) := (others => ' ');
  55       end if;
  56
  57    end Fill_String;
  58
  59    procedure Eti_Exception (Code : Eti_Error)
  60    is
  61    begin
  62       case Code is
  63          when E_Ok              => null;
  64          when E_System_Error    => raise Eti_System_Error;
  65          when E_Bad_Argument    => raise Eti_Bad_Argument;
  66          when E_Posted          => raise Eti_Posted;
  67          when E_Connected       => raise Eti_Connected;
  68          when E_Bad_State       => raise Eti_Bad_State;
  69          when E_No_Room         => raise Eti_No_Room;
  70          when E_Not_Posted      => raise Eti_Not_Posted;
  71          when E_Unknown_Command => raise Eti_Unknown_Command;
  72          when E_No_Match        => raise Eti_No_Match;
  73          when E_Not_Selectable  => raise Eti_Not_Selectable;
  74          when E_Not_Connected   => raise Eti_Not_Connected;
  75          when E_Request_Denied  => raise Eti_Request_Denied;
  76          when E_Invalid_Field   => raise Eti_Invalid_Field;
  77          when E_Current         => raise Eti_Current;
  78       end case;
  79    end Eti_Exception;
  80
  81 end Terminal_Interface.Curses.Aux;