1------------------------------------------------------------------------------ 2-- -- 3-- GNAT ncurses Binding -- 4-- -- 5-- Terminal_Interface.Curses.Text_IO.Aux -- 6-- -- 7-- B O D Y -- 8-- -- 9------------------------------------------------------------------------------ 10-- Copyright 2020 Thomas E. Dickey -- 11-- Copyright 1999-2006,2009 Free Software Foundation, Inc. -- 12-- -- 13-- Permission is hereby granted, free of charge, to any person obtaining a -- 14-- copy of this software and associated documentation files (the -- 15-- "Software"), to deal in the Software without restriction, including -- 16-- without limitation the rights to use, copy, modify, merge, publish, -- 17-- distribute, distribute with modifications, sublicense, and/or sell -- 18-- copies of the Software, and to permit persons to whom the Software is -- 19-- furnished to do so, subject to the following conditions: -- 20-- -- 21-- The above copyright notice and this permission notice shall be included -- 22-- in all copies or substantial portions of the Software. -- 23-- -- 24-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- 25-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- 26-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- 27-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- 28-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- 29-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- 30-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- 31-- -- 32-- Except as contained in this notice, the name(s) of the above copyright -- 33-- holders shall not be used in advertising or otherwise to promote the -- 34-- sale, use or other dealings in this Software without prior written -- 35-- authorization. -- 36------------------------------------------------------------------------------ 37-- Author: Juergen Pfeifer, 1996 38-- Version Control: 39-- $Revision: 1.14 $ 40-- $Date: 2020/02/02 23:34:34 $ 41-- Binding Version 01.00 42------------------------------------------------------------------------------ 43package body Terminal_Interface.Curses.Text_IO.Aux is 44 45 procedure Put_Buf 46 (Win : Window; 47 Buf : String; 48 Width : Field; 49 Signal : Boolean := True; 50 Ljust : Boolean := False) 51 is 52 L : Field; 53 Len : Field; 54 W : Field := Width; 55 LC : Line_Count; 56 CC : Column_Count; 57 Y : Line_Position; 58 X : Column_Position; 59 60 procedure Output (From, To : Field); 61 62 procedure Output (From, To : Field) 63 is 64 begin 65 if Len > 0 then 66 if W = 0 then 67 W := Len; 68 end if; 69 if Len > W then 70 -- LRM A10.6 (7) says this 71 W := Len; 72 end if; 73 74 pragma Assert (Len <= W); 75 Get_Size (Win, LC, CC); 76 if Column_Count (Len) > CC then 77 if Signal then 78 raise Layout_Error; 79 else 80 return; 81 end if; 82 else 83 if Len < W and then not Ljust then 84 declare 85 Filler : constant String (1 .. (W - Len)) 86 := (others => ' '); 87 begin 88 Put (Win, Filler); 89 end; 90 end if; 91 Get_Cursor_Position (Win, Y, X); 92 if (X + Column_Position (Len)) > CC then 93 New_Line (Win); 94 end if; 95 Put (Win, Buf (From .. To)); 96 if Len < W and then Ljust then 97 declare 98 Filler : constant String (1 .. (W - Len)) 99 := (others => ' '); 100 begin 101 Put (Win, Filler); 102 end; 103 end if; 104 end if; 105 end if; 106 end Output; 107 108 begin 109 pragma Assert (Win /= Null_Window); 110 if Ljust then 111 L := 1; 112 for I in 1 .. Buf'Length loop 113 exit when Buf (L) = ' '; 114 L := L + 1; 115 end loop; 116 Len := L - 1; 117 Output (1, Len); 118 else -- input buffer is not left justified 119 L := Buf'Length; 120 for I in 1 .. Buf'Length loop 121 exit when Buf (L) = ' '; 122 L := L - 1; 123 end loop; 124 Len := Buf'Length - L; 125 Output (L + 1, Buf'Length); 126 end if; 127 end Put_Buf; 128 129end Terminal_Interface.Curses.Text_IO.Aux; 130