1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
5 -- Sample.Form_Demo.Aux --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998 Free Software Foundation, Inc. --
12 -- Permission is hereby granted, free of charge, to any person obtaining a --
13 -- copy of this software and associated documentation files (the --
14 -- "Software"), to deal in the Software without restriction, including --
15 -- without limitation the rights to use, copy, modify, merge, publish, --
16 -- distribute, distribute with modifications, sublicense, and/or sell --
17 -- copies of the Software, and to permit persons to whom the Software is --
18 -- furnished to do so, subject to the following conditions: --
20 -- The above copyright notice and this permission notice shall be included --
21 -- in all copies or substantial portions of the Software. --
23 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
24 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
25 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
26 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
27 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
28 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
29 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
31 -- Except as contained in this notice, the name(s) of the above copyright --
32 -- holders shall not be used in advertising or otherwise to promote the --
33 -- sale, use or other dealings in this Software without prior written --
35 ------------------------------------------------------------------------------
36 -- Author: Juergen Pfeifer, 1996
39 -- Binding Version 01.00
40 ------------------------------------------------------------------------------
41 with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
43 with Sample.Manifest; use Sample.Manifest;
44 with Sample.Helpers; use Sample.Helpers;
45 with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
46 with Sample.Explanation; use Sample.Explanation;
48 package body Sample.Form_Demo.Aux is
50 procedure Geometry (F : in Form;
51 L : out Line_Count; -- Lines used for menu
52 C : out Column_Count; -- Columns used for menu
53 Y : out Line_Position; -- Proposed Line for menu
54 X : out Column_Position) -- Proposed Column for menu
59 L := L + 2; -- count for frame at top and bottom
62 -- Calculate horizontal coordinate at the screen center
63 X := (Columns - C) / 2;
64 Y := 1; -- start always in line 1
67 function Create (F : Form;
70 Col : Column_Position) return Panel
79 Geometry (F, L, C, Y, X);
80 W := New_Window (L, C, Lin, Col);
84 Set_Background (Win => W,
86 Color => Default_Colors,
87 Attr => Normal_Video));
88 Set_Character_Attributes (Win => W,
89 Color => Default_Colors,
90 Attr => Normal_Video);
93 S := Derived_Window (W, L - 2, C - 2, 1, 1);
98 Set_Sub_Window (F, S);
99 if Title'Length > 0 then
100 Window_Title (W, Title);
102 Pan := New_Panel (W);
107 procedure Destroy (F : in Form;
113 S := Get_Sub_Window (F);
117 Set_Window (F, Null_Window);
118 Set_Sub_Window (F, Null_Window);
124 function Get_Request (F : Form;
126 Handle_CRLF : Boolean := True) return Key_Code
128 W : constant Window := Get_Window (F);
135 if K in Special_Key_Code'Range then
137 when HELP_CODE => Explain_Context;
138 when EXPLAIN_CODE => Explain ("FORMKEYS");
139 when Key_Home => return F_First_Field;
140 when Key_End => return F_Last_Field;
141 when QUIT_CODE => return QUIT;
142 when Key_Cursor_Down => return F_Down_Char;
143 when Key_Cursor_Up => return F_Up_Char;
144 when Key_Cursor_Left => return F_Previous_Char;
145 when Key_Cursor_Right => return F_Next_Char;
146 when Key_Next_Page => return F_Next_Page;
147 when Key_Previous_Page => return F_Previous_Page;
148 when Key_Backspace => return F_Delete_Previous;
149 when Key_Clear_Screen => return F_Clear_Field;
150 when Key_Clear_End_Of_Line => return F_Clear_EOF;
151 when others => return K;
153 elsif K in Normal_Key_Code'Range then
154 Ch := Character'Val (K);
156 when CAN => return QUIT; -- CTRL-X
158 when ACK => return F_Next_Field; -- CTRL-F
159 when STX => return F_Previous_Field; -- CTRL-B
160 when FF => return F_Left_Field; -- CTRL-L
161 when DC2 => return F_Right_Field; -- CTRL-R
162 when NAK => return F_Up_Field; -- CTRL-U
163 when EOT => return F_Down_Field; -- CTRL-D
165 when ETB => return F_Next_Word; -- CTRL-W
166 when DC4 => return F_Previous_Word; -- CTRL-T
168 when SOH => return F_Begin_Field; -- CTRL-A
169 when ENQ => return F_End_Field; -- CTRL-E
171 when HT => return F_Insert_Char; -- CTRL-I
172 when SI => return F_Insert_Line; -- CTRL-O
173 when SYN => return F_Delete_Char; -- CTRL-V
174 when BS => return F_Delete_Previous; -- CTRL-H
175 when EM => return F_Delete_Line; -- CTRL-Y
176 when BEL => return F_Delete_Word; -- CTRL-G
177 when VT => return F_Clear_EOF; -- CTRL-K
179 when SO => return F_Next_Choice; -- CTRL-N
180 when DLE => return F_Previous_Choice; -- CTRL-P
188 when others => return K;
196 function Make (Top : Line_Position;
197 Left : Column_Position;
198 Text : String) return Field
201 C : Column_Count := Column_Count (Text'Length);
203 Fld := New_Field (1, C, Top, Left);
204 Set_Buffer (Fld, 0, Text);
205 Switch_Options (Fld, (Active => True, others => False), False);
207 Set_Background (Fld => Fld, Color => Default_Colors);
212 function Make (Height : Line_Count := 1;
213 Width : Column_Count;
215 Left : Column_Position;
216 Off_Screen : Natural := 0) return Field
218 Fld : Field := New_Field (Height, Width, Top, Left, Off_Screen);
221 Set_Foreground (Fld => Fld, Color => Form_Fore_Color);
222 Set_Background (Fld => Fld, Color => Form_Back_Color);
224 Set_Background (Fld, (Reverse_Video => True, others => False));
229 function Default_Driver (F : Form;
231 P : Panel) return Boolean
234 if K in User_Key_Code'Range and then K = QUIT then
235 if Driver (F, F_Validate_Field) = Form_Ok then
242 function Count_Active (F : Form) return Natural
245 O : Field_Option_Set;
246 H : constant Natural := Field_Count (F);
250 Get_Options (Fields (F, I), O);
259 end Sample.Form_Demo.Aux;