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