terminal_interface-curses.adb

ncurses-5.4

   begin
      if Wclear (Win) = Curses_Err then
         raise Curses_Exception;
      end if;
   end Clear;

   procedure Clear_To_End_Of_Screen (Win : in Window := Standard_Window)
   is
      function Wclearbot (W : Window) return C_Int;
      pragma Import (C, Wclearbot, "wclrtobot");
   begin
      if Wclearbot (Win) = Curses_Err then
         raise Curses_Exception;
      end if;
   end Clear_To_End_Of_Screen;

   procedure Clear_To_End_Of_Line (Win : in Window := Standard_Window)
   is
      function Wcleareol (W : Window) return C_Int;
      pragma Import (C, Wcleareol, "wclrtoeol");
   begin
      if Wcleareol (Win) = Curses_Err then
         raise Curses_Exception;
      end if;
   end Clear_To_End_Of_Line;
------------------------------------------------------------------------------
   procedure Set_Background
     (Win : in Window := Standard_Window;
      Ch  : in Attributed_Character)
   is
      procedure WBackground (W : in Window; Ch : in C_Chtype);
      pragma Import (C, WBackground, "wbkgdset");
   begin
      WBackground (Win, AttrChar_To_Chtype (Ch));
   end Set_Background;

   procedure Change_Background
     (Win : in Window := Standard_Window;
      Ch  : in Attributed_Character)
   is
      function WChangeBkgd (W : Window; Ch : C_Chtype) return C_Int;
      pragma Import (C, WChangeBkgd, "wbkgd");
   begin
      if WChangeBkgd (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
         raise Curses_Exception;
      end if;
   end Change_Background;

   function Get_Background (Win : Window := Standard_Window)
     return Attributed_Character
   is
      function Wgetbkgd (Win : Window) return C_Chtype;
      pragma Import (C, Wgetbkgd, "getbkgd");
   begin
      return Chtype_To_AttrChar (Wgetbkgd (Win));
   end Get_Background;
------------------------------------------------------------------------------
   procedure Change_Lines_Status (Win   : in Window := Standard_Window;
                                  Start : in Line_Position;
                                  Count : in Positive;
                                  State : in Boolean)
   is
      function Wtouchln (Win : Window;
                         Sta : C_Int;
                         Cnt : C_Int;
                         Chg : C_Int) return C_Int;
      pragma Import (C, Wtouchln, "wtouchln");
   begin
      if Wtouchln (Win, C_Int (Start), C_Int (Count),
                   C_Int (Boolean'Pos (State))) = Curses_Err then
         raise Curses_Exception;
      end if;
   end Change_Lines_Status;

   procedure Touch (Win : in Window := Standard_Window)
   is
      Y : Line_Position;
      X : Column_Position;
   begin
      Get_Size (Win, Y, X);
      Change_Lines_Status (Win, 0, Positive (Y), True);
   end Touch;

   procedure Untouch (Win : in Window := Standard_Window)
   is
      Y : Line_Position;
      X : Column_Position;
   begin
      Get_Size (Win, Y, X);
      Change_Lines_Status (Win, 0, Positive (Y), False);
   end Untouch;

   procedure Touch (Win   : in Window := Standard_Window;
                    Start : in Line_Position;
                    Count : in Positive)
   is
   begin
      Change_Lines_Status (Win, Start, Count, True);
   end Touch;

   function Is_Touched
     (Win  : Window := Standard_Window;
      Line : Line_Position) return Boolean
   is
      function WLineTouched (W : Window; L : C_Int) return Curses_Bool;
      pragma Import (C, WLineTouched, "is_linetouched");
   begin
      if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then
         return False;
      else
         return True;
      end if;
   end Is_Touched;

   function Is_Touched
     (Win : Window := Standard_Window) return Boolean
   is
      function WWinTouched (W : Window) return Curses_Bool;
      pragma Import (C, WWinTouched, "is_wintouched");
   begin
      if WWinTouched (Win) = Curses_Bool_False then
         return False;
      else
         return True;
      end if;
   end Is_Touched;
------------------------------------------------------------------------------
   procedure Copy
     (Source_Window            : in Window;
      Destination_Window       : in Window;
      Source_Top_Row           : in Line_Position;
      Source_Left_Column       : in Column_Position;
      Destination_Top_Row      : in Line_Position;
      Destination_Left_Column  : in Column_Position;
      Destination_Bottom_Row   : in Line_Position;
      Destination_Right_Column : in Column_Position;
      Non_Destructive_Mode     : in Boolean := True)
   is
      function Copywin (Src : Window;
                        Dst : Window;
                        Str : C_Int;
                        Slc : C_Int;
                        Dtr : C_Int;
                        Dlc : C_Int;
                        Dbr : C_Int;
                        Drc : C_Int;
                        Ndm : C_Int) return C_Int;
      pragma Import (C, Copywin, "copywin");
   begin
      if Copywin (Source_Window,
                  Destination_Window,
                  C_Int (Source_Top_Row),
                  C_Int (Source_Left_Column),
                  C_Int (Destination_Top_Row),
                  C_Int (Destination_Left_Column),
                  C_Int (Destination_Bottom_Row),
                  C_Int (Destination_Right_Column),
                  Boolean'Pos (Non_Destructive_Mode)
                ) = Curses_Err then
         raise Curses_Exception;
      end if;
   end Copy;

   procedure Overwrite
     (Source_Window      : in Window;
      Destination_Window : in Window)
   is
      function Overwrite (Src : Window; Dst : Window) return C_Int;
      pragma Import (C, Overwrite, "overwrite");
   begin
      if Overwrite (Source_Window, Destination_Window) = Curses_Err then
         raise Curses_Exception;
      end if;
   end Overwrite;

   procedure Overlay
     (Source_Window      : in Window;
      Destination_Window : in Window)
   is
      function Overlay (Src : Window; Dst : Window) return C_Int;
      pragma Import (C, Overlay, "overlay");
   begin
      if Overlay (Source_Window, Destination_Window) = Curses_Err then
         raise Curses_Exception;
      end if;
   end Overlay;

------------------------------------------------------------------------------
   procedure Insert_Delete_Lines
     (Win   : in Window := Standard_Window;
      Lines : in Integer       := 1) -- default is to insert one line above
   is
      function Winsdelln (W : Window; N : C_Int) return C_Int;
      pragma Import (C, Winsdelln, "winsdelln");
   begin
      if Winsdelln (Win, C_Int (Lines)) = Curses_Err then
         raise Curses_Exception;
      end if;
   end Insert_Delete_Lines;

   procedure Delete_Line (Win : in Window := Standard_Window)
   is
   begin
      Insert_Delete_Lines (Win, -1);
   end Delete_Line;

   procedure Insert_Line (Win : in Window := Standard_Window)
   is
   begin
      Insert_Delete_Lines (Win, 1);
   end Insert_Line;
------------------------------------------------------------------------------


   procedure Get_Size
     (Win               : in Window := Standard_Window;
      Number_Of_Lines   : out Line_Count;
      Number_Of_Columns : out Column_Count)
   is
      --  Please note: in ncurses they are one off.
      --  This might be different in other implementations of curses
      Y : C_Int := C_Int (W_Get_Short (Win, Offset_maxy)) + C_Int (Offset_XY);
      X : C_Int := C_Int (W_Get_Short (Win, Offset_maxx)) + C_Int (Offset_XY);
   begin
      Number_Of_Lines   := Line_Count (Y);
      Number_Of_Columns := Column_Count (X);
   end Get_Size;

   procedure Get_Window_Position
     (Win             : in Window := Standard_Window;
      Top_Left_Line   : out Line_Position;
      Top_Left_Column : out Column_Position)
   is
      Y : C_Short := W_Get_Short (Win, Offset_begy);
      X : C_Short := W_Get_Short (Win, Offset_begx);
   begin
      Top_Left_Line   := Line_Position (Y);
      Top_Left_Column := Column_Position (X);
   end Get_Window_Position;

   procedure Get_Cursor_Position
     (Win    : in  Window := Standard_Window;
      Line   : out Line_Position;
      Column : out Column_Position)
   is
      Y : C_Short := W_Get_Short (Win, Offset_cury);
      X : C_Short := W_Get_Short (Win, Offset_curx);
   begin
      Line   := Line_Position (Y);
      Column := Column_Position (X);
   end Get_Cursor_Position;

   procedure Get_Origin_Relative_To_Parent
     (Win                : in  Window;
      Top_Left_Line      : out Line_Position;
      Top_Left_Column    : out Column_Position;
      Is_Not_A_Subwindow : out Boolean)
   is
      Y : C_Int := W_Get_Int (Win, Offset_pary);
      X : C_Int := W_Get_Int (Win, Offset_parx);
   begin
      if Y = -1 then
         Top_Left_Line   := Line_Position'Last;
         Top_Left_Column := Column_Position'Last;
         Is_Not_A_Subwindow := True;
      else
         Top_Left_Line   := Line_Position (Y);
         Top_Left_Column := Column_Position (X);
         Is_Not_A_Subwindow := False;
      end if;
   end Get_Origin_Relative_To_Parent;
------------------------------------------------------------------------------
   function New_Pad (Lines   : Line_Count;
                     Columns : Column_Count) return Window
   is
      function Newpad (Lines : C_Int; Columns : C_Int) return Window;
      pragma Import (C, Newpad, "newpad");

      W : Window;
   begin
      W := Newpad (C_Int (Lines), C_Int (Columns));
      if W = Null_Window then
         raise Curses_Exception;
      end if;
      return W;
   end New_Pad;

   function Sub_Pad
     (Pad                   : Window;
      Number_Of_Lines       : Line_Count;
      Number_Of_Columns     : Column_Count;
      First_Line_Position   : Line_Position;
      First_Column_Position : Column_Position) return Window
   is
      function Subpad
        (Pad                   : Window;
         Number_Of_Lines       : C_Int;
         Number_Of_Columns     : C_Int;
         First_Line_Position   : C_Int;
         First_Column_Position : C_Int) return Window;
      pragma Import (C, Subpad, "subpad");

      W : Window;
   begin
      W := Subpad (Pad,
                   C_Int (Number_Of_Lines),
                   C_Int (Number_Of_Columns),
                   C_Int (First_Line_Position),
                   C_Int (First_Column_Position));
      if W = Null_Window then
         raise Curses_Exception;
      end if;
      return W;
   end Sub_Pad;

   procedure Refresh
     (Pad                      : in Window;
      Source_Top_Row           : in Line_Position;
      Source_Left_Column       : in Column_Position;
      Destination_Top_Row      : in Line_Position;
      Destination_Left_Column  : in Column_Position;
      Destination_Bottom_Row   : in Line_Position;
      Destination_Right_Column : in Column_Position)
   is
      function Prefresh
        (Pad                      : Window;
         Source_Top_Row           : C_Int;
         Source_Left_Column       : C_Int;
         Destination_Top_Row      : C_Int;
         Destination_Left_Column  : C_Int;
         Destination_Bottom_Row   : C_Int;
         Destination_Right_Column : C_Int) return C_Int;
      pragma Import (C, Prefresh, "prefresh");
   begin
      if Prefresh (Pad,
                   C_Int (Source_Top_Row),
                   C_Int (Source_Left_Column),
                   C_Int (Destination_Top_Row),
                   C_Int (Destination_Left_Column),
                   C_Int (Destination_Bottom_Row),
                   C_Int (Destination_Right_Column)) = Curses_Err then
         raise Curses_Exception;
      end if;
   end Refresh;

   procedure Refresh_Without_Update
     (Pad                      : in Window;
      Source_Top_Row           : in Line_Position;
      Source_Left_Column       : in Column_Position;
      Destination_Top_Row      : in Line_Position;
      Destination_Left_Column  : in Column_Position;
      Destination_Bottom_Row   : in Line_Position;
      Destination_Right_Column : in Column_Position)
   is
      function Pnoutrefresh
        (Pad                      : Window;
         Source_Top_Row           : C_Int;
         Source_Left_Column       : C_Int;
         Destination_Top_Row      : C_Int;
         Destination_Left_Column  : C_Int;
         Destination_Bottom_Row   : C_Int;
         Destination_Right_Column : C_Int) return C_Int;
      pragma Import (C, Pnoutrefresh, "pnoutrefresh");
   begin
      if Pnoutrefresh (Pad,
                       C_Int (Source_Top_Row),
                       C_Int (Source_Left_Column),
                       C_Int (Destination_Top_Row),
                       C_Int (Destination_Left_Column),
                       C_Int (Destination_Bottom_Row),
                       C_Int (Destination_Right_Column)) = Curses_Err then
         raise Curses_Exception;
      end if;
   end Refresh_Without_Update;

   procedure Add_Character_To_Pad_And_Echo_It
     (Pad : in Window;
      Ch  : in Attributed_Character)
   is
      function Pechochar (Pad : Window; Ch : C_Chtype)
                          return C_Int;
      pragma Import (C, Pechochar, "pechochar");
   begin
      if Pechochar (Pad, AttrChar_To_Chtype (Ch)) = Curses_Err then
         raise Curses_Exception;
      end if;
   end Add_Character_To_Pad_And_Echo_It;

   procedure Add_Character_To_Pad_And_Echo_It
     (Pad : in Window;
      Ch  : in Character)
   is
   begin