1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
5 -- Sample.Form_Demo.Aux --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998-2004,2009 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 -- $Date: 2009/12/26 17:38:58 $
40 -- Binding Version 01.00
41 ------------------------------------------------------------------------------
42 with Ada
.Characters
.Latin_1
; use Ada
.Characters
.Latin_1
;
44 with Sample
.Manifest
; use Sample
.Manifest
;
45 with Sample
.Helpers
; use Sample
.Helpers
;
46 with Sample
.Keyboard_Handler
; use Sample
.Keyboard_Handler
;
47 with Sample
.Explanation
; use Sample
.Explanation
;
49 package body Sample
.Form_Demo
.Aux
is
51 procedure Geometry
(F
: Form
;
52 L
: out Line_Count
; -- Lines used for menu
53 C
: out Column_Count
; -- Columns used for menu
54 Y
: out Line_Position
; -- Proposed Line for menu
55 X
: out Column_Position
) -- Proposed Column for menu
60 L
:= L
+ 2; -- count for frame at top and bottom
63 -- Calculate horizontal coordinate at the screen center
64 X
:= (Columns
- C
) / 2;
65 Y
:= 1; -- start always in line 1
68 function Create
(F
: Form
;
71 Col
: Column_Position
) return Panel
80 Geometry
(F
, L
, C
, Y
, X
);
81 W
:= New_Window
(L
, C
, Lin
, Col
);
85 Set_Background
(Win
=> W
,
87 Color
=> Default_Colors
,
88 Attr
=> Normal_Video
));
89 Set_Character_Attributes
(Win
=> W
,
90 Color
=> Default_Colors
,
91 Attr
=> Normal_Video
);
94 S
:= Derived_Window
(W
, L
- 2, C
- 2, 1, 1);
99 Set_Sub_Window
(F
, S
);
100 if Title
'Length > 0 then
101 Window_Title
(W
, Title
);
103 Pan
:= New_Panel
(W
);
108 procedure Destroy
(F
: Form
;
114 S
:= Get_Sub_Window
(F
);
118 Set_Window
(F
, Null_Window
);
119 Set_Sub_Window
(F
, Null_Window
);
125 function Get_Request
(F
: Form
;
127 Handle_CRLF
: Boolean := True) return Key_Code
129 W
: constant Window
:= Get_Window
(F
);
136 if K
in Special_Key_Code
'Range then
138 when HELP_CODE
=> Explain_Context
;
139 when EXPLAIN_CODE
=> Explain
("FORMKEYS");
140 when Key_Home
=> return F_First_Field
;
141 when Key_End
=> return F_Last_Field
;
142 when QUIT_CODE
=> return QUIT
;
143 when Key_Cursor_Down
=> return F_Down_Char
;
144 when Key_Cursor_Up
=> return F_Up_Char
;
145 when Key_Cursor_Left
=> return F_Previous_Char
;
146 when Key_Cursor_Right
=> return F_Next_Char
;
147 when Key_Next_Page
=> return F_Next_Page
;
148 when Key_Previous_Page
=> return F_Previous_Page
;
149 when Key_Backspace
=> return F_Delete_Previous
;
150 when Key_Clear_Screen
=> return F_Clear_Field
;
151 when Key_Clear_End_Of_Line
=> return F_Clear_EOF
;
152 when others => return K
;
154 elsif K
in Normal_Key_Code
'Range then
155 Ch
:= Character'Val (K
);
157 when CAN
=> return QUIT
; -- CTRL-X
159 when ACK
=> return F_Next_Field
; -- CTRL-F
160 when STX
=> return F_Previous_Field
; -- CTRL-B
161 when FF
=> return F_Left_Field
; -- CTRL-L
162 when DC2
=> return F_Right_Field
; -- CTRL-R
163 when NAK
=> return F_Up_Field
; -- CTRL-U
164 when EOT
=> return F_Down_Field
; -- CTRL-D
166 when ETB
=> return F_Next_Word
; -- CTRL-W
167 when DC4
=> return F_Previous_Word
; -- CTRL-T
169 when SOH
=> return F_Begin_Field
; -- CTRL-A
170 when ENQ
=> return F_End_Field
; -- CTRL-E
172 when HT
=> return F_Insert_Char
; -- CTRL-I
173 when SI
=> return F_Insert_Line
; -- CTRL-O
174 when SYN
=> return F_Delete_Char
; -- CTRL-V
175 when BS
=> return F_Delete_Previous
; -- CTRL-H
176 when EM
=> return F_Delete_Line
; -- CTRL-Y
177 when BEL
=> return F_Delete_Word
; -- CTRL-G
178 when VT
=> return F_Clear_EOF
; -- CTRL-K
180 when SO
=> return F_Next_Choice
; -- CTRL-N
181 when DLE
=> return F_Previous_Choice
; -- CTRL-P
189 when others => return K
;
197 function Make
(Top
: Line_Position
;
198 Left
: Column_Position
;
199 Text
: String) return Field
202 C
: constant Column_Count
:= Column_Count
(Text
'Length);
204 Fld
:= New_Field
(1, C
, Top
, Left
);
205 Set_Buffer
(Fld
, 0, Text
);
206 Switch_Options
(Fld
, (Active
=> True, others => False), False);
208 Set_Background
(Fld
=> Fld
, Color
=> Default_Colors
);
213 function Make
(Height
: Line_Count
:= 1;
214 Width
: Column_Count
;
216 Left
: Column_Position
;
217 Off_Screen
: Natural := 0) return Field
219 Fld
: constant Field
:= New_Field
(Height
, Width
, Top
, Left
, Off_Screen
);
222 Set_Foreground
(Fld
=> Fld
, Color
=> Form_Fore_Color
);
223 Set_Background
(Fld
=> Fld
, Color
=> Form_Back_Color
);
225 Set_Background
(Fld
, (Reverse_Video
=> True, others => False));
230 function Default_Driver
(F
: Form
;
232 P
: Panel
) return Boolean
235 if P
= Null_Panel
then
236 raise Panel_Exception
;
238 if K
in User_Key_Code
'Range and then K
= QUIT
then
239 if Driver
(F
, F_Validate_Field
) = Form_Ok
then
246 function Count_Active
(F
: Form
) return Natural
249 O
: Field_Option_Set
;
250 H
: constant Natural := Field_Count
(F
);
254 Get_Options
(Fields
(F
, I
), O
);
263 end Sample
.Form_Demo
.Aux
;