1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
5 -- Sample.Menu_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.Menu_Demo.Aux is
36 procedure Geometry (M : in Menu;
39 Y : out Line_Position;
40 X : out Column_Position;
41 Fy : out Line_Position;
42 Fx : out Column_Position);
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
52 Spc_Desc : Column_Position; -- spaces between description and item
54 Set_Mark (M, Menu_Marker);
56 Spacing (M, Spc_Desc, Fy, Fx);
59 Fx := Fx + Column_Position (Fy - 1); -- looks a bit nicer
61 L := L + 2 * Fy; -- count for frame at top and bottom
64 -- Calculate horizontal coordinate at the screen center
65 X := (Columns - C) / 2;
66 Y := 1; -- always startin line 1
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
79 Geometry (M, L, C, Y, X, Fy, Fx);
82 function Create (M : Menu;
85 Col : Column_Position) return Panel
90 Y, Fy : Line_Position;
91 X, Fx : Column_Position;
94 Geometry (M, L, C, Y, X, Fy, Fx);
95 W := New_Window (L, C, Lin, Col);
99 Set_Background (Win => W,
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);
108 S := Derived_Window (W, L - Fy, C - Fx, Fy, Fx);
113 Set_Sub_Window (M, S);
114 if Title'Length > 0 then
115 Window_Title (W, Title);
117 Pan := New_Panel (W);
122 procedure Destroy (M : in Menu;
128 S := Get_Sub_Window (M);
132 Set_Window (M, Null_Window);
133 Set_Sub_Window (M, Null_Window);
139 function Get_Request (M : Menu; P : Panel) return Key_Code
141 W : constant Window := Get_Window (M);
148 if K in Special_Key_Code'Range then
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;
164 elsif K in Normal_Key_Code'Range then
165 Ch := Character'Val (K);
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;
189 end Sample.Menu_Demo.Aux;