terminal_interface-curses-forms.adb

ncurses 库 可能有用酒用 没用就算了 我觉得还可以用

      Get_Options (Fld, Fos);
      return Fos;
   end Get_Options;
   --  |
   --  |=====================================================================
   --  | man page form_field_attributes.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Set_Foreground
     (Fld   : in Field;
      Fore  : in Character_Attribute_Set := Normal_Video;
      Color : in Color_Pair := Color_Pair'First)
   is
      function Set_Field_Fore (Fld  : Field;
                               Attr : C_Chtype) return C_Int;
      pragma Import (C, Set_Field_Fore, "set_field_fore");

      Ch : constant Attributed_Character := (Ch    => Character'First,
                                             Color => Color,
                                             Attr  => Fore);
      Res : constant Eti_Error :=
        Set_Field_Fore (Fld, AttrChar_To_Chtype (Ch));
   begin
      if  Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_Foreground;
   --  |
   --  |
   --  |
   procedure Foreground (Fld  : in  Field;
                         Fore : out Character_Attribute_Set)
   is
      function Field_Fore (Fld : Field) return C_Chtype;
      pragma Import (C, Field_Fore, "field_fore");
   begin
      Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
   end Foreground;

   procedure Foreground (Fld   : in  Field;
                         Fore  : out Character_Attribute_Set;
                         Color : out Color_Pair)
   is
      function Field_Fore (Fld : Field) return C_Chtype;
      pragma Import (C, Field_Fore, "field_fore");
   begin
      Fore  := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
      Color := Chtype_To_AttrChar (Field_Fore (Fld)).Color;
   end Foreground;
   --  |
   --  |
   --  |
   procedure Set_Background
     (Fld   : in Field;
      Back  : in Character_Attribute_Set := Normal_Video;
      Color : in Color_Pair := Color_Pair'First)
   is
      function Set_Field_Back (Fld  : Field;
                               Attr : C_Chtype) return C_Int;
      pragma Import (C, Set_Field_Back, "set_field_back");

      Ch : constant Attributed_Character := (Ch    => Character'First,
                                             Color => Color,
                                             Attr  => Back);
      Res : constant Eti_Error :=
        Set_Field_Back (Fld, AttrChar_To_Chtype (Ch));
   begin
      if  Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_Background;
   --  |
   --  |
   --  |
   procedure Background (Fld  : in  Field;
                         Back : out Character_Attribute_Set)
   is
      function Field_Back (Fld : Field) return C_Chtype;
      pragma Import (C, Field_Back, "field_back");
   begin
      Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
   end Background;

   procedure Background (Fld   : in  Field;
                         Back  : out Character_Attribute_Set;
                         Color : out Color_Pair)
   is
      function Field_Back (Fld : Field) return C_Chtype;
      pragma Import (C, Field_Back, "field_back");
   begin
      Back  := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
      Color := Chtype_To_AttrChar (Field_Back (Fld)).Color;
   end Background;
   --  |
   --  |
   --  |
   procedure Set_Pad_Character (Fld : in Field;
                                Pad : in Character := Space)
   is
      function Set_Field_Pad (Fld : Field;
                              Ch  : C_Int) return C_Int;
      pragma Import (C, Set_Field_Pad, "set_field_pad");

      Res : constant Eti_Error := Set_Field_Pad (Fld,
                                                 C_Int (Character'Pos (Pad)));
   begin
      if Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_Pad_Character;
   --  |
   --  |
   --  |
   procedure Pad_Character (Fld : in  Field;
                            Pad : out Character)
   is
      function Field_Pad (Fld : Field) return C_Int;
      pragma Import (C, Field_Pad, "field_pad");
   begin
      Pad := Character'Val (Field_Pad (Fld));
   end Pad_Character;
   --  |
   --  |=====================================================================
   --  | man page form_field_info.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Info (Fld                : in  Field;
                   Lines              : out Line_Count;
                   Columns            : out Column_Count;
                   First_Row          : out Line_Position;
                   First_Column       : out Column_Position;
                   Off_Screen         : out Natural;
                   Additional_Buffers : out Buffer_Number)
   is
      type C_Int_Access is access all C_Int;
      function Fld_Info (Fld : Field;
                         L, C, Fr, Fc, Os, Ab : C_Int_Access)
                         return C_Int;
      pragma Import (C, Fld_Info, "field_info");

      L, C, Fr, Fc, Os, Ab : aliased C_Int;
      Res : constant Eti_Error := Fld_Info (Fld,
                                            L'Access, C'Access,
                                            Fr'Access, Fc'Access,
                                            Os'Access, Ab'Access);
   begin
      if Res /= E_Ok then
         Eti_Exception (Res);
      else
         Lines              := Line_Count (L);
         Columns            := Column_Count (C);
         First_Row          := Line_Position (Fr);
         First_Column       := Column_Position (Fc);
         Off_Screen         := Natural (Os);
         Additional_Buffers := Buffer_Number (Ab);
      end if;
   end Info;
--  |
--  |
--  |
   procedure Dynamic_Info (Fld     : in Field;
                           Lines   : out Line_Count;
                           Columns : out Column_Count;
                           Max     : out Natural)
   is
      type C_Int_Access is access all C_Int;
      function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return C_Int;
      pragma Import (C, Dyn_Info, "dynamic_field_info");

      L, C, M : aliased C_Int;
      Res : constant Eti_Error := Dyn_Info (Fld,
                                            L'Access, C'Access,
                                            M'Access);
   begin
      if Res /= E_Ok then
         Eti_Exception (Res);
      else
         Lines   := Line_Count (L);
         Columns := Column_Count (C);
         Max     := Natural (M);
      end if;
   end Dynamic_Info;
   --  |
   --  |=====================================================================
   --  | man page form_win.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Set_Window (Frm : in Form;
                         Win : in Window)
   is
      function Set_Form_Win (Frm : Form;
                             Win : Window) return C_Int;
      pragma Import (C, Set_Form_Win, "set_form_win");

      Res : constant Eti_Error := Set_Form_Win (Frm, Win);
   begin
      if  Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_Window;
   --  |
   --  |
   --  |
   function Get_Window (Frm : Form) return Window
   is
      function Form_Win (Frm : Form) return Window;
      pragma Import (C, Form_Win, "form_win");

      W : constant Window := Form_Win (Frm);
   begin
      return W;
   end Get_Window;
   --  |
   --  |
   --  |
   procedure Set_Sub_Window (Frm : in Form;
                             Win : in Window)
   is
      function Set_Form_Sub (Frm : Form;
                             Win : Window) return C_Int;
      pragma Import (C, Set_Form_Sub, "set_form_sub");

      Res : constant Eti_Error := Set_Form_Sub (Frm, Win);
   begin
      if  Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_Sub_Window;
   --  |
   --  |
   --  |
   function Get_Sub_Window (Frm : Form) return Window
   is
      function Form_Sub (Frm : Form) return Window;
      pragma Import (C, Form_Sub, "form_sub");

      W : constant Window := Form_Sub (Frm);
   begin
      return W;
   end Get_Sub_Window;
   --  |
   --  |
   --  |
   procedure Scale (Frm     : in Form;
                    Lines   : out Line_Count;
                    Columns : out Column_Count)
   is
      type C_Int_Access is access all C_Int;
      function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return C_Int;
      pragma Import (C, M_Scale, "scale_form");

      X, Y : aliased C_Int;
      Res  : constant Eti_Error := M_Scale (Frm, Y'Access, X'Access);
   begin
      if Res /= E_Ok then
         Eti_Exception (Res);
      end if;
      Lines := Line_Count (Y);
      Columns := Column_Count (X);
   end Scale;
   --  |
   --  |=====================================================================
   --  | man page menu_hook.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Set_Field_Init_Hook (Frm  : in Form;
                                  Proc : in Form_Hook_Function)
   is
      function Set_Field_Init (Frm  : Form;
                               Proc : Form_Hook_Function) return C_Int;
      pragma Import (C, Set_Field_Init, "set_field_init");

      Res : constant Eti_Error := Set_Field_Init (Frm, Proc);
   begin
      if  Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_Field_Init_Hook;
   --  |
   --  |
   --  |
   procedure Set_Field_Term_Hook (Frm  : in Form;
                                  Proc : in Form_Hook_Function)
   is
      function Set_Field_Term (Frm  : Form;
                               Proc : Form_Hook_Function) return C_Int;
      pragma Import (C, Set_Field_Term, "set_field_term");

      Res : constant Eti_Error := Set_Field_Term (Frm, Proc);
   begin
      if Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_Field_Term_Hook;
   --  |
   --  |
   --  |
   procedure Set_Form_Init_Hook (Frm  : in Form;
                                 Proc : in Form_Hook_Function)
   is
      function Set_Form_Init (Frm  : Form;
                              Proc : Form_Hook_Function) return C_Int;
      pragma Import (C, Set_Form_Init, "set_form_init");

      Res : constant Eti_Error := Set_Form_Init (Frm, Proc);
   begin
      if  Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_Form_Init_Hook;
   --  |
   --  |
   --  |
   procedure Set_Form_Term_Hook (Frm  : in Form;
                                 Proc : in Form_Hook_Function)
   is
      function Set_Form_Term (Frm  : Form;
                              Proc : Form_Hook_Function) return C_Int;
      pragma Import (C, Set_Form_Term, "set_form_term");

      Res : constant Eti_Error := Set_Form_Term (Frm, Proc);
   begin
      if Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_Form_Term_Hook;
   --  |
   --  |=====================================================================
   --  | man page form_fields.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Redefine (Frm  : in Form;
                       Flds : in Field_Array_Access)
   is
      function Set_Frm_Fields (Frm   : Form;
                               Items : System.Address) return C_Int;
      pragma Import (C, Set_Frm_Fields, "set_form_fields");

      Res : Eti_Error;
   begin
      pragma Assert (Flds (Flds'Last) = Null_Field);
      if Flds (Flds'Last) /= Null_Field then
         raise Form_Exception;
      else
         Res := Set_Frm_Fields (Frm, Flds (Flds'First)'Address);
         if  Res /= E_Ok then
            Eti_Exception (Res);
         end if;
      end if;
   end Redefine;
   --  |
   --  |
   --  |
   function Fields (Frm   : Form;
                    Index : Positive) return Field
   is
      use F_Array;

      function C_Fields (Frm : Form) return Pointer;
      pragma Import (C, C_Fields, "form_fields");

      P : Pointer := C_Fields (Frm);
   begin
      if P = null or else Index not in 1 .. Field_Count (Frm) then
         raise Form_Exception;
      else
         P := P + ptrdiff_t (C_Int (Index) - 1);
         return P.all;
      end if;
   end Fields;
   --  |
   --  |
   --  |
   function Field_Count (Frm : Form) return Natural
   is
      function Count (Frm : Form) return C_Int;
      pragma Import (C, Count, "field_count");
   begin