ncurses 4.1
[ncurses.git] / Ada95 / ada_include / terminal_interface-curses-text_io-aux.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                           GNAT ncurses Binding                           --
4 --                                                                          --
5 --                   Terminal_Interface.Curses.Text_IO.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.4 $
26 ------------------------------------------------------------------------------
27 package body Terminal_Interface.Curses.Text_IO.Aux is
28
29    procedure Put_Buf
30      (Win    : in Window;
31       Buf    : in String;
32       Width  : in Field;
33       Signal : in Boolean := True;
34       Ljust  : in Boolean := False)
35    is
36       L   : Field;
37       Len : Field;
38       W   : Field := Width;
39       LC  : Line_Count;
40       CC  : Column_Count;
41       Y   : Line_Position;
42       X   : Column_Position;
43
44       procedure Output (From, To : Field);
45
46       procedure Output (From, To : Field)
47       is
48       begin
49          if Len > 0 then
50             if W = 0 then
51                W := Len;
52             end if;
53             if Len > W then
54                --  LRM A10.6 (7) says this
55                W := Len;
56             end if;
57
58             pragma Assert (Len <= W);
59             Get_Size (Win, LC, CC);
60             if Column_Count (Len) > CC then
61                if Signal then
62                   raise Layout_Error;
63                else
64                   return;
65                end if;
66             else
67                if Len < W and then not Ljust then
68                   declare
69                      Filler : constant String (1 .. (W - Len))
70                        := (others => ' ');
71                   begin
72                      Put (Win, Filler);
73                   end;
74                end if;
75                Get_Cursor_Position (Win, Y, X);
76                if (X + Column_Position (Len)) > CC then
77                   New_Line (Win);
78                end if;
79                Put (Win, Buf (From .. To));
80                if Len < W and then Ljust then
81                   declare
82                      Filler : constant String (1 .. (W - Len))
83                        := (others => ' ');
84                   begin
85                      Put (Win, Filler);
86                   end;
87                end if;
88             end if;
89          end if;
90       end Output;
91
92    begin
93       pragma Assert (Win /= Null_Window);
94       if Ljust then
95          L := 1;
96          for I in 1 .. Buf'Length loop
97             exit when Buf (L) = ' ';
98             L := L + 1;
99          end loop;
100          Len := L - 1;
101          Output (1, Len);
102       else  -- input buffer is not left justified
103          L := Buf'Length;
104          for I in 1 .. Buf'Length loop
105             exit when Buf (L) = ' ';
106             L := L - 1;
107          end loop;
108          Len := Buf'Length - L;
109          Output (L + 1, Buf'Length);
110       end if;
111    end Put_Buf;
112
113 end Terminal_Interface.Curses.Text_IO.Aux;
114