ncurses 4.1
[ncurses.git] / Ada95 / samples / sample-menu_demo-aux.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                       GNAT ncurses Binding Samples                       --
4 --                                                                          --
5 --                            Sample.Menu_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.4 $
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.Menu_Demo.Aux is
35
36    procedure Geometry (M  : in  Menu;
37                        L  : out Line_Count;
38                        C  : out Column_Count;
39                        Y  : out Line_Position;
40                        X  : out Column_Position;
41                        Fy : out Line_Position;
42                        Fx : out Column_Position);
43
44    procedure Geometry (M  : in  Menu;
45                        L  : out Line_Count;        -- Lines used for menu
46                        C  : out Column_Count;      -- Columns used for menu
47                        Y  : out Line_Position;     -- Proposed Line for menu
48                        X  : out Column_Position;   -- Proposed Column for menu
49                        Fy : out Line_Position;     -- Vertical inner frame
50                        Fx : out Column_Position)   -- Horiz. inner frame
51    is
52       Spc_Desc : Column_Position; -- spaces between description and item
53    begin
54       Set_Mark (M, Menu_Marker);
55
56       Spacing (M, Spc_Desc, Fy, Fx);
57       Scale (M, L, C);
58
59       Fx := Fx + Column_Position (Fy - 1); -- looks a bit nicer
60
61       L := L + 2 * Fy;  -- count for frame at top and bottom
62       C := C + 2 * Fx;  -- "
63
64       --  Calculate horizontal coordinate at the screen center
65       X := (Columns - C) / 2;
66       Y := 1;  -- always startin line 1
67
68    end Geometry;
69
70    procedure Geometry (M : in  Menu;
71                        L : out Line_Count;        -- Lines used for menu
72                        C : out Column_Count;      -- Columns used for menu
73                        Y : out Line_Position;     -- Proposed Line for menu
74                        X  : out Column_Position)  -- Proposed Column for menu
75    is
76       Fy : Line_Position;
77       Fx : Column_Position;
78    begin
79       Geometry (M, L, C, Y, X, Fy, Fx);
80    end Geometry;
81
82    function Create (M     : Menu;
83                     Title : String;
84                     Lin   : Line_Position;
85                     Col   : Column_Position) return Panel
86    is
87       W, S : Window;
88       L : Line_Count;
89       C : Column_Count;
90       Y, Fy : Line_Position;
91       X, Fx : Column_Position;
92       Pan : Panel;
93    begin
94       Geometry (M, L, C, Y, X, Fy, Fx);
95       W := New_Window (L, C, Lin, Col);
96       Set_Meta_Mode (W);
97       Set_KeyPad_Mode (W);
98       if Has_Colors then
99          Set_Background (Win => W,
100                          Ch  => (Ch    => ' ',
101                                  Color => Menu_Back_Color,
102                                  Attr  => Normal_Video));
103          Set_Foreground (Men => M, Color => Menu_Fore_Color);
104          Set_Background (Men => M, Color => Menu_Back_Color);
105          Set_Grey (Men => M, Color => Menu_Grey_Color);
106          Erase (W);
107       end if;
108       S := Derived_Window (W, L - Fy, C - Fx, Fy, Fx);
109       Set_Meta_Mode (S);
110       Set_KeyPad_Mode (S);
111       Box (W);
112       Set_Window (M, W);
113       Set_Sub_Window (M, S);
114       if Title'Length > 0 then
115          Window_Title (W, Title);
116       end if;
117       Pan := New_Panel (W);
118       Post (M);
119       return Pan;
120    end Create;
121
122    procedure Destroy (M : in Menu;
123                       P : in out Panel)
124    is
125       W, S : Window;
126    begin
127       W := Get_Window (M);
128       S := Get_Sub_Window (M);
129       Post (M, False);
130       Erase (W);
131       Delete (P);
132       Set_Window (M, Null_Window);
133       Set_Sub_Window (M, Null_Window);
134       Delete (S);
135       Delete (W);
136       Update_Panels;
137    end Destroy;
138
139    function Get_Request (M : Menu; P : Panel) return Key_Code
140    is
141       W  : constant Window := Get_Window (M);
142       K  : Real_Key_Code;
143       Ch : Character;
144    begin
145       Top (P);
146       loop
147          K := Get_Key (W);
148          if K in Special_Key_Code'Range then
149             case K is
150                when HELP_CODE           => Explain_Context;
151                when EXPLAIN_CODE        => Explain ("MENUKEYS");
152                when Key_Home            => return REQ_FIRST_ITEM;
153                when QUIT_CODE           => return QUIT;
154                when Key_Cursor_Down     => return REQ_DOWN_ITEM;
155                when Key_Cursor_Up       => return REQ_UP_ITEM;
156                when Key_Cursor_Left     => return REQ_LEFT_ITEM;
157                when Key_Cursor_Right    => return REQ_RIGHT_ITEM;
158                when Key_End             => return REQ_LAST_ITEM;
159                when Key_Backspace       => return REQ_BACK_PATTERN;
160                when Key_Next_Page       => return REQ_SCR_DPAGE;
161                when Key_Previous_Page   => return REQ_SCR_UPAGE;
162                when others              => return K;
163             end case;
164          elsif K in Normal_Key_Code'Range then
165             Ch := Character'Val (K);
166             case Ch is
167                when DC1 => return QUIT;                  --  CTRL-Q
168                when SO  => return REQ_NEXT_ITEM;         --  CTRL-N
169                when DLE => return REQ_PREV_ITEM;         --  CTRL-P
170                when NAK => return REQ_SCR_ULINE;         --  CTRL-U
171                when EOT => return REQ_SCR_DLINE;         --  CTRL-D
172                when ACK => return REQ_SCR_DPAGE;         --  CTRL-F
173                when STX => return REQ_SCR_UPAGE;         --  CTRL-B
174                when CAN => return REQ_CLEAR_PATTERN;     --  CTRL-X
175                when BS  => return REQ_BACK_PATTERN;      --  CTRL-H
176                when SOH => return REQ_NEXT_MATCH;        --  CTRL-A
177                when SUB => return REQ_PREV_MATCH;        --  CTRL-Z
178                when DC4 => return REQ_TOGGLE_ITEM;       --  CTRL-T
179                when CR  => return SELECT_ITEM;           --  CTRL-M
180                when LF  => return SELECT_ITEM;           --  CTRL-J
181                when others => return K;
182             end case;
183          else
184             return K;
185          end if;
186       end loop;
187    end Get_Request;
188
189 end Sample.Menu_Demo.Aux;
190