1------------------------------------------------------------------------------ 2-- -- 3-- GNAT ncurses Binding Samples -- 4-- -- 5-- Sample.Form_Demo.Aux -- 6-- -- 7-- B O D Y -- 8-- -- 9------------------------------------------------------------------------------ 10-- Copyright 2020 Thomas E. Dickey -- 11-- Copyright 1998-2004,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.18 $ 40-- $Date: 2020/02/02 23:34:34 $ 41-- Binding Version 01.00 42------------------------------------------------------------------------------ 43with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; 44 45with Sample.Manifest; use Sample.Manifest; 46with Sample.Helpers; use Sample.Helpers; 47with Sample.Keyboard_Handler; use Sample.Keyboard_Handler; 48with Sample.Explanation; use Sample.Explanation; 49 50package body Sample.Form_Demo.Aux is 51 52 procedure Geometry (F : Form; 53 L : out Line_Count; -- Lines used for menu 54 C : out Column_Count; -- Columns used for menu 55 Y : out Line_Position; -- Proposed Line for menu 56 X : out Column_Position) -- Proposed Column for menu 57 is 58 begin 59 Scale (F, L, C); 60 61 L := L + 2; -- count for frame at top and bottom 62 C := C + 2; -- " 63 64 -- Calculate horizontal coordinate at the screen center 65 X := (Columns - C) / 2; 66 Y := 1; -- start always in line 1 67 end Geometry; 68 69 function Create (F : Form; 70 Title : String; 71 Lin : Line_Position; 72 Col : Column_Position) return Panel 73 is 74 W, S : Window; 75 L : Line_Count; 76 C : Column_Count; 77 Y : Line_Position; 78 X : Column_Position; 79 Pan : Panel; 80 begin 81 Geometry (F, L, C, Y, X); 82 W := New_Window (L, C, Lin, Col); 83 Set_Meta_Mode (W); 84 Set_KeyPad_Mode (W); 85 if Has_Colors then 86 Set_Background (Win => W, 87 Ch => (Ch => ' ', 88 Color => Default_Colors, 89 Attr => Normal_Video)); 90 Set_Character_Attributes (Win => W, 91 Color => Default_Colors, 92 Attr => Normal_Video); 93 Erase (W); 94 end if; 95 S := Derived_Window (W, L - 2, C - 2, 1, 1); 96 Set_Meta_Mode (S); 97 Set_KeyPad_Mode (S); 98 Box (W); 99 Set_Window (F, W); 100 Set_Sub_Window (F, S); 101 if Title'Length > 0 then 102 Window_Title (W, Title); 103 end if; 104 Pan := New_Panel (W); 105 Post (F); 106 return Pan; 107 end Create; 108 109 procedure Destroy (F : Form; 110 P : in out Panel) 111 is 112 W, S : Window; 113 begin 114 W := Get_Window (F); 115 S := Get_Sub_Window (F); 116 Post (F, False); 117 Erase (W); 118 Delete (P); 119 Set_Window (F, Null_Window); 120 Set_Sub_Window (F, Null_Window); 121 Delete (S); 122 Delete (W); 123 Update_Panels; 124 end Destroy; 125 126 function Get_Request (F : Form; 127 P : Panel; 128 Handle_CRLF : Boolean := True) return Key_Code 129 is 130 W : constant Window := Get_Window (F); 131 K : Real_Key_Code; 132 Ch : Character; 133 begin 134 Top (P); 135 loop 136 K := Get_Key (W); 137 if K in Special_Key_Code'Range then 138 case K is 139 when HELP_CODE => Explain_Context; 140 when EXPLAIN_CODE => Explain ("FORMKEYS"); 141 when Key_Home => return F_First_Field; 142 when Key_End => return F_Last_Field; 143 when QUIT_CODE => return QUIT; 144 when Key_Cursor_Down => return F_Down_Char; 145 when Key_Cursor_Up => return F_Up_Char; 146 when Key_Cursor_Left => return F_Previous_Char; 147 when Key_Cursor_Right => return F_Next_Char; 148 when Key_Next_Page => return F_Next_Page; 149 when Key_Previous_Page => return F_Previous_Page; 150 when Key_Backspace => return F_Delete_Previous; 151 when Key_Clear_Screen => return F_Clear_Field; 152 when Key_Clear_End_Of_Line => return F_Clear_EOF; 153 when others => return K; 154 end case; 155 elsif K in Normal_Key_Code'Range then 156 Ch := Character'Val (K); 157 case Ch is 158 when CAN => return QUIT; -- CTRL-X 159 160 when ACK => return F_Next_Field; -- CTRL-F 161 when STX => return F_Previous_Field; -- CTRL-B 162 when FF => return F_Left_Field; -- CTRL-L 163 when DC2 => return F_Right_Field; -- CTRL-R 164 when NAK => return F_Up_Field; -- CTRL-U 165 when EOT => return F_Down_Field; -- CTRL-D 166 167 when ETB => return F_Next_Word; -- CTRL-W 168 when DC4 => return F_Previous_Word; -- CTRL-T 169 170 when SOH => return F_Begin_Field; -- CTRL-A 171 when ENQ => return F_End_Field; -- CTRL-E 172 173 when HT => return F_Insert_Char; -- CTRL-I 174 when SI => return F_Insert_Line; -- CTRL-O 175 when SYN => return F_Delete_Char; -- CTRL-V 176 when BS => return F_Delete_Previous; -- CTRL-H 177 when EM => return F_Delete_Line; -- CTRL-Y 178 when BEL => return F_Delete_Word; -- CTRL-G 179 when VT => return F_Clear_EOF; -- CTRL-K 180 181 when SO => return F_Next_Choice; -- CTRL-N 182 when DLE => return F_Previous_Choice; -- CTRL-P 183 184 when CR | LF => 185 if Handle_CRLF then 186 return F_New_Line; 187 else 188 return K; 189 end if; 190 when others => return K; 191 end case; 192 else 193 return K; 194 end if; 195 end loop; 196 end Get_Request; 197 198 function Make (Top : Line_Position; 199 Left : Column_Position; 200 Text : String) return Field 201 is 202 Fld : Field; 203 C : constant Column_Count := Column_Count (Text'Length); 204 begin 205 Fld := New_Field (1, C, Top, Left); 206 Set_Buffer (Fld, 0, Text); 207 Switch_Options (Fld, (Active => True, others => False), False); 208 if Has_Colors then 209 Set_Background (Fld => Fld, Color => Default_Colors); 210 end if; 211 return Fld; 212 end Make; 213 214 function Make (Height : Line_Count := 1; 215 Width : Column_Count; 216 Top : Line_Position; 217 Left : Column_Position; 218 Off_Screen : Natural := 0) return Field 219 is 220 Fld : constant Field := New_Field (Height, Width, Top, Left, Off_Screen); 221 begin 222 if Has_Colors then 223 Set_Foreground (Fld => Fld, Color => Form_Fore_Color); 224 Set_Background (Fld => Fld, Color => Form_Back_Color); 225 else 226 Set_Background (Fld, (Reverse_Video => True, others => False)); 227 end if; 228 return Fld; 229 end Make; 230 231 function Default_Driver (F : Form; 232 K : Key_Code; 233 P : Panel) return Boolean 234 is 235 begin 236 if P = Null_Panel then 237 raise Panel_Exception; 238 end if; 239 if K in User_Key_Code'Range and then K = QUIT then 240 if Driver (F, F_Validate_Field) = Form_Ok then 241 return True; 242 end if; 243 end if; 244 return False; 245 end Default_Driver; 246 247 function Count_Active (F : Form) return Natural 248 is 249 N : Natural := 0; 250 O : Field_Option_Set; 251 H : constant Natural := Field_Count (F); 252 begin 253 if H > 0 then 254 for I in 1 .. H loop 255 Get_Options (Fields (F, I), O); 256 if O.Active then 257 N := N + 1; 258 end if; 259 end loop; 260 end if; 261 return N; 262 end Count_Active; 263 264end Sample.Form_Demo.Aux; 265