1------------------------------------------------------------------------------ 2-- -- 3-- GNAT ncurses Binding Samples -- 4-- -- 5-- Sample.Menu_Demo.Aux -- 6-- -- 7-- B O D Y -- 8-- -- 9------------------------------------------------------------------------------ 10-- Copyright 2020,2023 Thomas E. Dickey -- 11-- Copyright 1998-2006,2009 Free Software Foundation, Inc. -- 12-- -- 13-- Permission is hereby granted, free of charge, to any person obtaining a -- 14-- copy of this software and associated documentation files (the -- 15-- "Software"), to deal in the Software without restriction, including -- 16-- without limitation the rights to use, copy, modify, merge, publish, -- 17-- distribute, distribute with modifications, sublicense, and/or sell -- 18-- copies of the Software, and to permit persons to whom the Software is -- 19-- furnished to do so, subject to the following conditions: -- 20-- -- 21-- The above copyright notice and this permission notice shall be included -- 22-- in all copies or substantial portions of the Software. -- 23-- -- 24-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- 25-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- 26-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- 27-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- 28-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- 29-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- 30-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- 31-- -- 32-- Except as contained in this notice, the name(s) of the above copyright -- 33-- holders shall not be used in advertising or otherwise to promote the -- 34-- sale, use or other dealings in this Software without prior written -- 35-- authorization. -- 36------------------------------------------------------------------------------ 37-- Author: Juergen Pfeifer, 1996 38-- Version Control 39-- $Revision: 1.16 $ 40-- $Date: 2023/06/17 17:21:59 $ 41-- Binding Version 01.00 42------------------------------------------------------------------------------ 43with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; 44 45with Sample.Manifest; use Sample.Manifest; 46with Sample.Helpers; use Sample.Helpers; 47with Sample.Keyboard_Handler; use Sample.Keyboard_Handler; 48with Sample.Explanation; use Sample.Explanation; 49 50package body Sample.Menu_Demo.Aux is 51 52 procedure Geometry (M : Menu; 53 L : out Line_Count; 54 C : out Column_Count; 55 Y : out Line_Position; 56 X : out Column_Position; 57 Fy : out Line_Position; 58 Fx : out Column_Position); 59 60 procedure Geometry (M : Menu; 61 L : out Line_Count; -- Lines used for menu 62 C : out Column_Count; -- Columns used for menu 63 Y : out Line_Position; -- Proposed Line for menu 64 X : out Column_Position; -- Proposed Column for menu 65 Fy : out Line_Position; -- Vertical inner frame 66 Fx : out Column_Position) -- Horiz. inner frame 67 is 68 Spc_Desc : Column_Position; -- spaces between description and item 69 begin 70 Set_Mark (M, Menu_Marker); 71 72 Spacing (M, Spc_Desc, Fy, Fx); 73 Scale (M, L, C); 74 75 Fx := Fx + Column_Position (Fy - 1); -- looks a bit nicer 76 77 L := L + 2 * Fy; -- count for frame at top and bottom 78 C := C + 2 * Fx; -- " 79 80 -- Calculate horizontal coordinate at the screen center 81 X := (Columns - C) / 2; 82 Y := 1; -- always starting on line 1 83 84 end Geometry; 85 86 procedure Geometry (M : Menu; 87 L : out Line_Count; -- Lines used for menu 88 C : out Column_Count; -- Columns used for menu 89 Y : out Line_Position; -- Proposed Line for menu 90 X : out Column_Position) -- Proposed Column for menu 91 is 92 Fy : Line_Position; 93 Fx : Column_Position; 94 begin 95 Geometry (M, L, C, Y, X, Fy, Fx); 96 end Geometry; 97 98 function Create (M : Menu; 99 Title : String; 100 Lin : Line_Position; 101 Col : Column_Position) return Panel 102 is 103 W, S : Window; 104 L : Line_Count; 105 C : Column_Count; 106 Y, Fy : Line_Position; 107 X, Fx : Column_Position; 108 Pan : Panel; 109 begin 110 Geometry (M, L, C, Y, X, Fy, Fx); 111 W := New_Window (L, C, Lin, Col); 112 Set_Meta_Mode (W); 113 Set_KeyPad_Mode (W); 114 if Has_Colors then 115 Set_Background (Win => W, 116 Ch => (Ch => ' ', 117 Color => Menu_Back_Color, 118 Attr => Normal_Video)); 119 Set_Foreground (Men => M, Color => Menu_Fore_Color); 120 Set_Background (Men => M, Color => Menu_Back_Color); 121 Set_Grey (Men => M, Color => Menu_Grey_Color); 122 Erase (W); 123 end if; 124 S := Derived_Window (W, L - Fy, C - Fx, Fy, Fx); 125 Set_Meta_Mode (S); 126 Set_KeyPad_Mode (S); 127 Box (W); 128 Set_Window (M, W); 129 Set_Sub_Window (M, S); 130 if Title'Length > 0 then 131 Window_Title (W, Title); 132 end if; 133 Pan := New_Panel (W); 134 Post (M); 135 return Pan; 136 end Create; 137 138 procedure Destroy (M : Menu; 139 P : in out Panel) 140 is 141 W, S : Window; 142 begin 143 W := Get_Window (M); 144 S := Get_Sub_Window (M); 145 Post (M, False); 146 Erase (W); 147 Delete (P); 148 Set_Window (M, Null_Window); 149 Set_Sub_Window (M, Null_Window); 150 Delete (S); 151 Delete (W); 152 Update_Panels; 153 end Destroy; 154 155 function Get_Request (M : Menu; P : Panel) return Key_Code 156 is 157 W : constant Window := Get_Window (M); 158 K : Real_Key_Code; 159 Ch : Character; 160 begin 161 Top (P); 162 loop 163 K := Get_Key (W); 164 if K in Special_Key_Code'Range then 165 case K is 166 when HELP_CODE => Explain_Context; 167 when EXPLAIN_CODE => Explain ("MENUKEYS"); 168 when Key_Home => return REQ_FIRST_ITEM; 169 when QUIT_CODE => return QUIT; 170 when Key_Cursor_Down => return REQ_DOWN_ITEM; 171 when Key_Cursor_Up => return REQ_UP_ITEM; 172 when Key_Cursor_Left => return REQ_LEFT_ITEM; 173 when Key_Cursor_Right => return REQ_RIGHT_ITEM; 174 when Key_End => return REQ_LAST_ITEM; 175 when Key_Backspace => return REQ_BACK_PATTERN; 176 when Key_Next_Page => return REQ_SCR_DPAGE; 177 when Key_Previous_Page => return REQ_SCR_UPAGE; 178 when others => return K; 179 end case; 180 elsif K in Normal_Key_Code'Range then 181 Ch := Character'Val (K); 182 case Ch is 183 when CAN => return QUIT; -- CTRL-X 184 when SO => return REQ_NEXT_ITEM; -- CTRL-N 185 when DLE => return REQ_PREV_ITEM; -- CTRL-P 186 when NAK => return REQ_SCR_ULINE; -- CTRL-U 187 when EOT => return REQ_SCR_DLINE; -- CTRL-D 188 when ACK => return REQ_SCR_DPAGE; -- CTRL-F 189 when STX => return REQ_SCR_UPAGE; -- CTRL-B 190 when EM => return REQ_CLEAR_PATTERN; -- CTRL-Y 191 when BS => return REQ_BACK_PATTERN; -- CTRL-H 192 when SOH => return REQ_NEXT_MATCH; -- CTRL-A 193 when ENQ => return REQ_PREV_MATCH; -- CTRL-E 194 when DC4 => return REQ_TOGGLE_ITEM; -- CTRL-T 195 196 when CR | LF => return SELECT_ITEM; 197 when others => return K; 198 end case; 199 else 200 return K; 201 end if; 202 end loop; 203 end Get_Request; 204 205end Sample.Menu_Demo.Aux; 206