1------------------------------------------------------------------------------ 2-- -- 3-- GNAT ncurses Binding Samples -- 4-- -- 5-- Sample.Curses_Demo.Mouse -- 6-- -- 7-- B O D Y -- 8-- -- 9------------------------------------------------------------------------------ 10-- Copyright (c) 1998-2006,2008 Free Software Foundation, Inc. -- 11-- -- 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: -- 19-- -- 20-- The above copyright notice and this permission notice shall be included -- 21-- in all copies or substantial portions of the Software. -- 22-- -- 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. -- 30-- -- 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 -- 34-- authorization. -- 35------------------------------------------------------------------------------ 36-- Author: Juergen Pfeifer, 1996 37-- Version Control 38-- $Revision: 1.16 $ 39-- $Date: 2008/07/26 18:48:19 $ 40-- Binding Version 01.00 41------------------------------------------------------------------------------ 42with Terminal_Interface.Curses; use Terminal_Interface.Curses; 43with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; 44with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse; 45with Terminal_Interface.Curses.Text_IO; use Terminal_Interface.Curses.Text_IO; 46with Terminal_Interface.Curses.Text_IO.Integer_IO; 47with Terminal_Interface.Curses.Text_IO.Enumeration_IO; 48 49with Sample.Helpers; use Sample.Helpers; 50with Sample.Manifest; use Sample.Manifest; 51with Sample.Keyboard_Handler; use Sample.Keyboard_Handler; 52with Sample.Function_Key_Setting; use Sample.Function_Key_Setting; 53with Sample.Explanation; use Sample.Explanation; 54 55package body Sample.Curses_Demo.Mouse is 56 57 package Int_IO is new 58 Terminal_Interface.Curses.Text_IO.Integer_IO (Integer); 59 use Int_IO; 60 61 package Button_IO is new 62 Terminal_Interface.Curses.Text_IO.Enumeration_IO (Mouse_Button); 63 use Button_IO; 64 65 package State_IO is new 66 Terminal_Interface.Curses.Text_IO.Enumeration_IO (Button_State); 67 use State_IO; 68 69 procedure Demo is 70 71 type Controls is array (1 .. 3) of Panel; 72 73 Frame : Window; 74 Msg : Window; 75 Ctl : Controls; 76 Pan : Panel; 77 K : Real_Key_Code; 78 V : Cursor_Visibility := Invisible; 79 W : Window; 80 Note : Window; 81 Msg_L : constant Line_Count := 8; 82 Lins : Line_Position := Lines; 83 Cols : Column_Position; 84 Mask : Event_Mask; 85 procedure Show_Mouse_Event; 86 87 procedure Show_Mouse_Event 88 is 89 Evt : constant Mouse_Event := Get_Mouse; 90 Y : Line_Position; 91 X : Column_Position; 92 Button : Mouse_Button; 93 State : Button_State; 94 W : Window; 95 begin 96 Get_Event (Evt, Y, X, Button, State); 97 Put (Msg, "Event at"); 98 Put (Msg, " X="); Put (Msg, Integer (X), 3); 99 Put (Msg, ", Y="); Put (Msg, Integer (Y), 3); 100 Put (Msg, ", Btn="); Put (Msg, Button, 10); 101 Put (Msg, ", Stat="); Put (Msg, State, 15); 102 for I in Ctl'Range loop 103 W := Get_Window (Ctl (I)); 104 if Enclosed_In_Window (W, Evt) then 105 Transform_Coordinates (W, Y, X, From_Screen); 106 Put (Msg, ",Box("); 107 Put (Msg, (I), 1); Put (Msg, ","); 108 Put (Msg, Integer (Y), 1); Put (Msg, ","); 109 Put (Msg, Integer (X), 1); Put (Msg, ")"); 110 end if; 111 end loop; 112 New_Line (Msg); 113 Flush (Msg); 114 Update_Panels; Update_Screen; 115 end Show_Mouse_Event; 116 117 begin 118 Push_Environment ("MOUSE00"); 119 Notepad ("MOUSE-PAD00"); 120 Default_Labels; 121 Set_Cursor_Visibility (V); 122 123 Note := Notepad_Window; 124 if Note /= Null_Window then 125 Get_Window_Position (Note, Lins, Cols); 126 end if; 127 Frame := Create (Msg_L, Columns, Lins - Msg_L, 0); 128 if Has_Colors then 129 Set_Background (Win => Frame, 130 Ch => (Color => Default_Colors, 131 Attr => Normal_Video, 132 Ch => ' ')); 133 Set_Character_Attributes (Win => Frame, 134 Attr => Normal_Video, 135 Color => Default_Colors); 136 Erase (Frame); 137 end if; 138 Msg := Derived_Window (Frame, Msg_L - 2, Columns - 2, 1, 1); 139 Pan := Create (Frame); 140 141 Set_Meta_Mode; 142 Set_KeyPad_Mode; 143 Mask := Start_Mouse; 144 145 Box (Frame); 146 Window_Title (Frame, "Mouse Protocol"); 147 Refresh_Without_Update (Frame); 148 Allow_Scrolling (Msg, True); 149 150 declare 151 Middle_Column : constant Integer := Integer (Columns) / 2; 152 Middle_Index : constant Natural := Ctl'First + (Ctl'Length / 2); 153 Width : constant Column_Count := 5; 154 Height : constant Line_Count := 3; 155 Half : constant Column_Count := Width / 2; 156 Space : constant Column_Count := 3; 157 Position : Integer; 158 W : Window; 159 begin 160 for I in Ctl'Range loop 161 Position := ((I) - Integer (Middle_Index)) * 162 Integer (Half + Space + Width) + Middle_Column; 163 W := Create (Height, 164 Width, 165 1, 166 Column_Position (Position)); 167 if Has_Colors then 168 Set_Background (Win => W, 169 Ch => (Color => Menu_Back_Color, 170 Attr => Normal_Video, 171 Ch => ' ')); 172 Set_Character_Attributes (Win => W, 173 Attr => Normal_Video, 174 Color => Menu_Fore_Color); 175 Erase (W); 176 end if; 177 Ctl (I) := Create (W); 178 Box (W); 179 Move_Cursor (W, 1, Half); 180 Put (W, (I), 1); 181 Refresh_Without_Update (W); 182 end loop; 183 end; 184 185 Update_Panels; Update_Screen; 186 187 loop 188 K := Get_Key; 189 if K in Special_Key_Code'Range then 190 case K is 191 when QUIT_CODE => exit; 192 when HELP_CODE => Explain_Context; 193 when EXPLAIN_CODE => Explain ("MOUSEKEYS"); 194 when Key_Mouse => Show_Mouse_Event; 195 when others => null; 196 end case; 197 end if; 198 end loop; 199 200 for I in Ctl'Range loop 201 W := Get_Window (Ctl (I)); 202 Clear (W); 203 Delete (Ctl (I)); 204 Delete (W); 205 end loop; 206 207 Clear (Frame); 208 Delete (Pan); 209 Delete (Msg); 210 Delete (Frame); 211 212 Set_Cursor_Visibility (V); 213 End_Mouse (Mask); 214 215 Pop_Environment; 216 Update_Panels; Update_Screen; 217 218 end Demo; 219 220end Sample.Curses_Demo.Mouse; 221