1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
5 -- Sample.Form_Demo.Aux --
11 -- The ncurses Ada95 binding is copyrighted 1996 by --
12 -- Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de --
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. --
22 -- This binding comes AS IS with no warranty, implied or expressed. --
23 ------------------------------------------------------------------------------
26 ------------------------------------------------------------------------------
27 with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
29 with Sample.Manifest; use Sample.Manifest;
30 with Sample.Helpers; use Sample.Helpers;
31 with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
32 with Sample.Explanation; use Sample.Explanation;
34 package body Sample.Form_Demo.Aux is
36 procedure Geometry (F : in Form;
37 L : out Line_Count; -- Lines used for menu
38 C : out Column_Count; -- Columns used for menu
39 Y : out Line_Position; -- Proposed Line for menu
40 X : out Column_Position) -- Proposed Column for menu
45 L := L + 2; -- count for frame at top and bottom
48 -- Calculate horizontal coordinate at the screen center
49 X := (Columns - C) / 2;
50 Y := 1; -- start always in line 1
53 function Create (F : Form;
56 Col : Column_Position) return Panel
65 Geometry (F, L, C, Y, X);
66 W := New_Window (L, C, Lin, Col);
70 Set_Background (Win => W,
72 Color => Default_Colors,
73 Attr => Normal_Video));
74 Set_Character_Attributes (Win => W,
75 Color => Default_Colors,
76 Attr => Normal_Video);
79 S := Derived_Window (W, L - 2, C - 2, 1, 1);
84 Set_Sub_Window (F, S);
85 if Title'Length > 0 then
86 Window_Title (W, Title);
93 procedure Destroy (F : in Form;
99 S := Get_Sub_Window (F);
103 Set_Window (F, Null_Window);
104 Set_Sub_Window (F, Null_Window);
110 function Get_Request (F : Form;
112 Handle_CRLF : Boolean := True) return Key_Code
114 W : constant Window := Get_Window (F);
121 if K in Special_Key_Code'Range then
123 when HELP_CODE => Explain_Context;
124 when EXPLAIN_CODE => Explain ("FORMKEYS");
125 when Key_Home => return F_First_Field;
126 when Key_End => return F_Last_Field;
127 when QUIT_CODE => return QUIT;
128 when Key_Cursor_Down => return F_Down_Char;
129 when Key_Cursor_Up => return F_Up_Char;
130 when Key_Cursor_Left => return F_Left_Char;
131 when Key_Cursor_Right => return F_Right_Char;
132 when Key_Next_Page => return F_ScrollForward_Line;
133 when Key_Previous_Page => return F_ScrollBackward_Line;
134 when Key_Backspace => return F_Delete_Previous;
135 when others => return K;
137 elsif K in Normal_Key_Code'Range then
138 Ch := Character'Val (K);
140 when DC1 => return QUIT; -- CTRL-Q
141 when ACK => return F_Next_Page; -- CTRL-F
142 when STX => return F_Previous_Page; -- CTRL-B
143 when SO => return F_Next_Field; -- CTRL-N
144 when DLE => return F_Previous_Field; -- CTRL-P
145 when FF => return F_Left_Field; -- CTRL-L
146 when DC2 => return F_Right_Field; -- CTRL-R
147 when NAK => return F_Up_Field; -- CTRL-U
148 when EOT => return F_Down_Field; -- CTRL-D
149 when ETB => return F_Next_Word; -- CTRL-W
150 when DC4 => return F_Previous_Word; -- CTRL-T
151 when DC3 => return F_Begin_Field; -- CTRL-S
152 when ENQ => return F_End_Field; -- CTRL-E
153 when HT => return F_Insert_Char; -- CTRL-I
154 when SI => return F_Insert_Line; -- CTRL-O
155 when SYN => return F_Delete_Char; -- CTRL-V
156 when BS => return F_Delete_Previous; -- CTRL-H
157 when EM => return F_Delete_Line; -- CTRL-Y
158 when BEL => return F_Delete_Word; -- CTRL-G
159 when VT => return F_Clear_EOF; -- CTRL-K
160 when CAN => return F_Clear_Field; -- CTRL-X
161 when SOH => return F_Next_Choice; -- CTRL-A
162 when SUB => return F_Previous_Choice; -- CTRL-Z
169 when others => return K;
177 function Make (Top : Line_Position;
178 Left : Column_Position;
179 Text : String) return Field
182 C : Column_Count := Column_Count (Text'Length);
184 Fld := New_Field (1, C, Top, Left);
185 Set_Buffer (Fld, 0, Text);
186 Switch_Options (Fld, (Active => True, others => False), False);
188 Set_Background (Fld => Fld, Color => Default_Colors);
193 function Make (Height : Line_Count := 1;
194 Width : Column_Count;
196 Left : Column_Position;
197 Off_Screen : Natural := 0) return Field
199 Fld : Field := New_Field (Height, Width, Top, Left, Off_Screen);
202 Set_Foreground (Fld => Fld, Color => Form_Fore_Color);
203 Set_Background (Fld => Fld, Color => Form_Back_Color);
205 Set_Background (Fld, (Reverse_Video => True, others => False));
210 function Default_Driver (F : Form;
212 P : Panel) return Boolean
215 if K in User_Key_Code'Range and then K = QUIT then
216 if Driver (F, F_Validate_Field) = Form_Ok then
223 function Count_Active (F : Form) return Natural
226 O : Field_Option_Set;
227 A : constant Field_Array_Access := Fields (F);
228 H : constant Natural := Field_Count (F);
232 Get_Options (A.all (I), O);
241 end Sample.Form_Demo.Aux;