ncurses 4.1
[ncurses.git] / Ada95 / samples / sample-form_demo-aux.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                       GNAT ncurses Binding Samples                       --
4 --                                                                          --
5 --                            Sample.Form_Demo.Aux                          --
6 --                                                                          --
7 --                                 B O D Y                                  --
8 --                                                                          --
9 --  Version 00.92                                                           --
10 --                                                                          --
11 --  The ncurses Ada95 binding is copyrighted 1996 by                        --
12 --  Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de                     --
13 --                                                                          --
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.                                                     --
21 --                                                                          --
22 --  This binding comes AS IS with no warranty, implied or expressed.        --
23 ------------------------------------------------------------------------------
24 --  Version Control
25 --  $Revision: 1.5 $
26 ------------------------------------------------------------------------------
27 with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
28
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;
33
34 package body Sample.Form_Demo.Aux is
35
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
41    is
42    begin
43       Scale (F, L, C);
44
45       L := L + 2;  -- count for frame at top and bottom
46       C := C + 2;  -- "
47
48       --  Calculate horizontal coordinate at the screen center
49       X := (Columns - C) / 2;
50       Y := 1; -- start always in line 1
51    end Geometry;
52
53    function Create (F     : Form;
54                     Title : String;
55                     Lin   : Line_Position;
56                     Col   : Column_Position) return Panel
57    is
58       W, S : Window;
59       L : Line_Count;
60       C : Column_Count;
61       Y : Line_Position;
62       X : Column_Position;
63       Pan : Panel;
64    begin
65       Geometry (F, L, C, Y, X);
66       W := New_Window (L, C, Lin, Col);
67       Set_Meta_Mode (W);
68       Set_KeyPad_Mode (W);
69       if Has_Colors then
70          Set_Background (Win => W,
71                          Ch  => (Ch    => ' ',
72                                  Color => Default_Colors,
73                                  Attr  => Normal_Video));
74          Set_Character_Attributes (Win => W,
75                                    Color => Default_Colors,
76                                    Attr  => Normal_Video);
77          Erase (W);
78       end if;
79       S := Derived_Window (W, L - 2, C - 2, 1, 1);
80       Set_Meta_Mode (S);
81       Set_KeyPad_Mode (S);
82       Box (W);
83       Set_Window (F, W);
84       Set_Sub_Window (F, S);
85       if Title'Length > 0 then
86          Window_Title (W, Title);
87       end if;
88       Pan := New_Panel (W);
89       Post (F);
90       return Pan;
91    end Create;
92
93    procedure Destroy (F : in Form;
94                       P : in out Panel)
95    is
96       W, S : Window;
97    begin
98       W := Get_Window (F);
99       S := Get_Sub_Window (F);
100       Post (F, False);
101       Erase (W);
102       Delete (P);
103       Set_Window (F, Null_Window);
104       Set_Sub_Window (F, Null_Window);
105       Delete (S);
106       Delete (W);
107       Update_Panels;
108    end Destroy;
109
110    function Get_Request (F           : Form;
111                          P           : Panel;
112                          Handle_CRLF : Boolean := True) return Key_Code
113    is
114       W  : constant Window := Get_Window (F);
115       K  : Real_Key_Code;
116       Ch : Character;
117    begin
118       Top (P);
119       loop
120          K := Get_Key (W);
121          if K in Special_Key_Code'Range then
122             case K is
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;
136             end case;
137          elsif K in Normal_Key_Code'Range then
138             Ch := Character'Val (K);
139             case Ch is
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
163                when CR | LF  =>
164                   if Handle_CRLF then
165                      return F_New_Line;
166                   else
167                      return K;
168                   end if;
169                when others => return K;
170             end case;
171          else
172             return K;
173          end if;
174       end loop;
175    end Get_Request;
176
177    function Make (Top         : Line_Position;
178                   Left        : Column_Position;
179                   Text        : String) return Field
180    is
181       Fld : Field;
182       C : Column_Count := Column_Count (Text'Length);
183    begin
184       Fld := New_Field (1, C, Top, Left);
185       Set_Buffer (Fld, 0, Text);
186       Switch_Options (Fld, (Active => True, others => False), False);
187       if Has_Colors then
188          Set_Background (Fld => Fld, Color => Default_Colors);
189       end if;
190       return Fld;
191    end Make;
192
193    function Make  (Height      : Line_Count := 1;
194                    Width       : Column_Count;
195                    Top         : Line_Position;
196                    Left        : Column_Position;
197                    Off_Screen  : Natural := 0) return Field
198    is
199       Fld : Field := New_Field (Height, Width, Top, Left, Off_Screen);
200    begin
201       if Has_Colors then
202          Set_Foreground (Fld => Fld, Color => Form_Fore_Color);
203          Set_Background (Fld => Fld, Color => Form_Back_Color);
204       else
205          Set_Background (Fld, (Reverse_Video => True, others => False));
206       end if;
207       return Fld;
208    end Make;
209
210    function Default_Driver (F : Form;
211                             K : Key_Code;
212                             P : Panel) return Boolean
213    is
214    begin
215       if K in User_Key_Code'Range and then K = QUIT then
216          if Driver (F, F_Validate_Field) = Form_Ok  then
217             return True;
218          end if;
219       end if;
220       return False;
221    end Default_Driver;
222
223    function Count_Active (F : Form) return Natural
224    is
225       N : Natural := 0;
226       O : Field_Option_Set;
227       A : constant Field_Array_Access := Fields (F);
228       H : constant Natural := Field_Count (F);
229    begin
230       if H > 0 then
231          for I in 1 .. H loop
232             Get_Options (A.all (I), O);
233             if O.Active then
234                N := N + 1;
235             end if;
236          end loop;
237       end if;
238       return N;
239    end Count_Active;
240
241 end Sample.Form_Demo.Aux;