terminal_interface-curses-forms.adb

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

      return Natural (Count (Frm));
   end Field_Count;
   --  |
   --  |
   --  |
   procedure Move (Fld    : in Field;
                   Line   : in Line_Position;
                   Column : in Column_Position)
   is
      function Move (Fld : Field; L, C : C_Int) return C_Int;
      pragma Import (C, Move, "move_field");

      Res : constant Eti_Error := Move (Fld, C_Int (Line), C_Int (Column));
   begin
      if Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Move;
   --  |
   --  |=====================================================================
   --  | man page form_new.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   function Create (Fields : Field_Array_Access) return Form
   is
      function NewForm (Fields : System.Address) return Form;
      pragma Import (C, NewForm, "new_form");

      M   : Form;
   begin
      pragma Assert (Fields (Fields'Last) = Null_Field);
      if Fields (Fields'Last) /= Null_Field then
         raise Form_Exception;
      else
         M := NewForm (Fields (Fields'First)'Address);
         if M = Null_Form then
            raise Form_Exception;
         end if;
         return M;
      end if;
   end Create;
   --  |
   --  |
   --  |
   procedure Delete (Frm : in out Form)
   is
      function Free (Frm : Form) return C_Int;
      pragma Import (C, Free, "free_form");

      Res : constant Eti_Error := Free (Frm);
   begin
      if Res /= E_Ok then
         Eti_Exception (Res);
      end if;
      Frm := Null_Form;
   end Delete;
   --  |
   --  |=====================================================================
   --  | man page form_opts.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Set_Options (Frm     : in Form;
                          Options : in Form_Option_Set)
   is
      function Set_Form_Opts (Frm : Form;
                              Opt : C_Int) return C_Int;
      pragma Import (C, Set_Form_Opts, "set_form_opts");

      Opt : constant C_Int := FrmOS_2_CInt (Options);
      Res : Eti_Error;
   begin
      Res := Set_Form_Opts (Frm, Opt);
      if  Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_Options;
   --  |
   --  |
   --  |
   procedure Switch_Options (Frm     : in Form;
                             Options : in Form_Option_Set;
                             On      : Boolean := True)
   is
      function Form_Opts_On (Frm : Form;
                             Opt : C_Int) return C_Int;
      pragma Import (C, Form_Opts_On, "form_opts_on");
      function Form_Opts_Off (Frm : Form;
                              Opt : C_Int) return C_Int;
      pragma Import (C, Form_Opts_Off, "form_opts_off");

      Err : Eti_Error;
      Opt : constant C_Int := FrmOS_2_CInt (Options);
   begin
      if On then
         Err := Form_Opts_On (Frm, Opt);
      else
         Err := Form_Opts_Off (Frm, Opt);
      end if;
      if Err /= E_Ok then
         Eti_Exception (Err);
      end if;
   end Switch_Options;
   --  |
   --  |
   --  |
   procedure Get_Options (Frm     : in  Form;
                          Options : out Form_Option_Set)
   is
      function Form_Opts (Frm : Form) return C_Int;
      pragma Import (C, Form_Opts, "form_opts");

      Res : constant C_Int := Form_Opts (Frm);
   begin
      Options := CInt_2_FrmOS (Res);
   end Get_Options;
   --  |
   --  |
   --  |
   function Get_Options (Frm : Form := Null_Form) return Form_Option_Set
   is
      Fos : Form_Option_Set;
   begin
      Get_Options (Frm, Fos);
      return Fos;
   end Get_Options;
   --  |
   --  |=====================================================================
   --  | man page form_post.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Post (Frm  : in Form;
                   Post : in Boolean := True)
   is
      function M_Post (Frm : Form) return C_Int;
      pragma Import (C, M_Post, "post_form");
      function M_Unpost (Frm : Form) return C_Int;
      pragma Import (C, M_Unpost, "unpost_form");

      Res : Eti_Error;
   begin
      if Post then
         Res := M_Post (Frm);
      else
         Res := M_Unpost (Frm);
      end if;
      if Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Post;
   --  |
   --  |=====================================================================
   --  | man page form_cursor.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Position_Cursor (Frm : Form)
   is
      function Pos_Form_Cursor (Frm : Form) return C_Int;
      pragma Import (C, Pos_Form_Cursor, "pos_form_cursor");

      Res : constant Eti_Error := Pos_Form_Cursor (Frm);
   begin
      if  Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Position_Cursor;
   --  |
   --  |=====================================================================
   --  | man page form_data.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   function Data_Ahead (Frm : Form) return Boolean
   is
      function Ahead (Frm : Form) return C_Int;
      pragma Import (C, Ahead, "data_ahead");

      Res : constant C_Int := Ahead (Frm);
   begin
      if Res = Curses_False then
         return False;
      else
         return True;
      end if;
   end Data_Ahead;
   --  |
   --  |
   --  |
   function Data_Behind (Frm : Form) return Boolean
   is
      function Behind (Frm : Form) return C_Int;
      pragma Import (C, Behind, "data_behind");

      Res : constant C_Int := Behind (Frm);
   begin
      if Res = Curses_False then
         return False;
      else
         return True;
      end if;
   end Data_Behind;
   --  |
   --  |=====================================================================
   --  | man page form_driver.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   function Driver (Frm : Form;
                    Key : Key_Code) return Driver_Result
   is
      function Frm_Driver (Frm : Form; Key : C_Int) return C_Int;
      pragma Import (C, Frm_Driver, "form_driver");

      R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key));
   begin
      if R /= E_Ok then
         if R = E_Unknown_Command then
            return Unknown_Request;
         elsif R = E_Invalid_Field then
            return Invalid_Field;
         elsif R = E_Request_Denied then
            return Request_Denied;
         else
            Eti_Exception (R);
            return Form_Ok;
         end if;
      else
         return Form_Ok;
      end if;
   end Driver;
   --  |
   --  |=====================================================================
   --  | man page form_page.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Set_Current (Frm : in Form;
                          Fld : in Field)
   is
      function Set_Current_Fld (Frm : Form; Fld : Field) return C_Int;
      pragma Import (C, Set_Current_Fld, "set_current_field");

      Res : constant Eti_Error := Set_Current_Fld (Frm, Fld);
   begin
      if Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_Current;
   --  |
   --  |
   --  |
   function Current (Frm : in Form) return Field
   is
      function Current_Fld (Frm : Form) return Field;
      pragma Import (C, Current_Fld, "current_field");

      Fld : constant Field := Current_Fld (Frm);
   begin
      if Fld = Null_Field then
         raise Form_Exception;
      end if;
      return Fld;
   end Current;
   --  |
   --  |
   --  |
   procedure Set_Page (Frm  : in Form;
                       Page : in Page_Number := Page_Number'First)
   is
      function Set_Frm_Page (Frm : Form; Pg : C_Int) return C_Int;
      pragma Import (C, Set_Frm_Page, "set_form_page");

      Res : constant Eti_Error := Set_Frm_Page (Frm, C_Int (Page));
   begin
      if Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_Page;
   --  |
   --  |
   --  |
   function Page (Frm : Form) return Page_Number
   is
      function Get_Page (Frm : Form) return C_Int;
      pragma Import (C, Get_Page, "form_page");

      P : constant C_Int := Get_Page (Frm);
   begin
      if P < 0 then
         raise Form_Exception;
      else
         return Page_Number (P);
      end if;
   end Page;

   function Get_Index (Fld : Field) return Positive
   is
      function Get_Fieldindex (Fld : Field) return C_Int;
      pragma Import (C, Get_Fieldindex, "field_index");

      Res : constant C_Int := Get_Fieldindex (Fld);
   begin
      if Res = Curses_Err then
         raise Form_Exception;
      end if;
      return Positive (Natural (Res) + Positive'First);
   end Get_Index;

   --  |
   --  |=====================================================================
   --  | man page form_new_page.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Set_New_Page (Fld      : in Field;
                           New_Page : in Boolean := True)
   is
      function Set_Page (Fld : Field; Flg : C_Int) return C_Int;
      pragma Import (C, Set_Page, "set_new_page");

      Res : constant Eti_Error := Set_Page (Fld, Boolean'Pos (New_Page));
   begin
      if Res /= E_Ok then
         Eti_Exception (Res);
      end if;
   end Set_New_Page;
   --  |
   --  |
   --  |
   function Is_New_Page (Fld : Field) return Boolean
   is
      function Is_New (Fld : Field) return C_Int;
      pragma Import (C, Is_New, "new_page");

      Res : constant C_Int := Is_New (Fld);
   begin
      if Res = Curses_False then
         return False;
      else
         return True;
      end if;
   end Is_New_Page;

   procedure Free (FA          : in out Field_Array_Access;
                   Free_Fields : in Boolean := False)
   is
      procedure Release is new Ada.Unchecked_Deallocation
        (Field_Array, Field_Array_Access);
   begin
      if FA /= null and then Free_Fields then
         for I in FA'First .. (FA'Last - 1) loop
            if FA (I) /= Null_Field then
               Delete (FA (I));
            end if;
         end loop;
      end if;
      Release (FA);
   end Free;

   --  |=====================================================================

   function Default_Field_Options return Field_Option_Set
   is
   begin
      return Get_Options (Null_Field);
   end Default_Field_Options;

   function Default_Form_Options return Form_Option_Set
   is
   begin
      return Get_Options (Null_Form);
   end Default_Form_Options;

end Terminal_Interface.Curses.Forms;