1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
5 -- Sample.Form_Demo.Aux --
9 ------------------------------------------------------------------------------
10 -- Copyright 2020 Thomas E. Dickey --
11 -- Copyright 1998-2004,2009 Free Software Foundation, Inc. --
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: --
21 -- The above copyright notice and this permission notice shall be included --
22 -- in all copies or substantial portions of the Software. --
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. --
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 --
36 ------------------------------------------------------------------------------
37 -- Author: Juergen Pfeifer, 1996
40 -- $Date: 2020/02/02 23:34:34 $
41 -- Binding Version 01.00
42 ------------------------------------------------------------------------------
43 with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
45 with Sample.Manifest; use Sample.Manifest;
46 with Sample.Helpers; use Sample.Helpers;
47 with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
48 with Sample.Explanation; use Sample.Explanation;
50 package body Sample.Form_Demo.Aux is
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
61 L := L + 2; -- count for frame at top and bottom
64 -- Calculate horizontal coordinate at the screen center
65 X := (Columns - C) / 2;
66 Y := 1; -- start always in line 1
69 function Create (F : Form;
72 Col : Column_Position) return Panel
81 Geometry (F, L, C, Y, X);
82 W := New_Window (L, C, Lin, Col);
86 Set_Background (Win => W,
88 Color => Default_Colors,
89 Attr => Normal_Video));
90 Set_Character_Attributes (Win => W,
91 Color => Default_Colors,
92 Attr => Normal_Video);
95 S := Derived_Window (W, L - 2, C - 2, 1, 1);
100 Set_Sub_Window (F, S);
101 if Title'Length > 0 then
102 Window_Title (W, Title);
104 Pan := New_Panel (W);
109 procedure Destroy (F : Form;
115 S := Get_Sub_Window (F);
119 Set_Window (F, Null_Window);
120 Set_Sub_Window (F, Null_Window);
126 function Get_Request (F : Form;
128 Handle_CRLF : Boolean := True) return Key_Code
130 W : constant Window := Get_Window (F);
137 if K in Special_Key_Code'Range then
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;
155 elsif K in Normal_Key_Code'Range then
156 Ch := Character'Val (K);
158 when CAN => return QUIT; -- CTRL-X
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
167 when ETB => return F_Next_Word; -- CTRL-W
168 when DC4 => return F_Previous_Word; -- CTRL-T
170 when SOH => return F_Begin_Field; -- CTRL-A
171 when ENQ => return F_End_Field; -- CTRL-E
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
181 when SO => return F_Next_Choice; -- CTRL-N
182 when DLE => return F_Previous_Choice; -- CTRL-P
190 when others => return K;
198 function Make (Top : Line_Position;
199 Left : Column_Position;
200 Text : String) return Field
203 C : constant Column_Count := Column_Count (Text'Length);
205 Fld := New_Field (1, C, Top, Left);
206 Set_Buffer (Fld, 0, Text);
207 Switch_Options (Fld, (Active => True, others => False), False);
209 Set_Background (Fld => Fld, Color => Default_Colors);
214 function Make (Height : Line_Count := 1;
215 Width : Column_Count;
217 Left : Column_Position;
218 Off_Screen : Natural := 0) return Field
220 Fld : constant Field := New_Field (Height, Width, Top, Left, Off_Screen);
223 Set_Foreground (Fld => Fld, Color => Form_Fore_Color);
224 Set_Background (Fld => Fld, Color => Form_Back_Color);
226 Set_Background (Fld, (Reverse_Video => True, others => False));
231 function Default_Driver (F : Form;
233 P : Panel) return Boolean
236 if P = Null_Panel then
237 raise Panel_Exception;
239 if K in User_Key_Code'Range and then K = QUIT then
240 if Driver (F, F_Validate_Field) = Form_Ok then
247 function Count_Active (F : Form) return Natural
250 O : Field_Option_Set;
251 H : constant Natural := Field_Count (F);
255 Get_Options (Fields (F, I), O);
264 end Sample.Form_Demo.Aux;