diff options
Diffstat (limited to 'ncurses-5.3/Ada95/samples/sample-curses_demo-mouse.adb')
-rw-r--r-- | ncurses-5.3/Ada95/samples/sample-curses_demo-mouse.adb | 221 |
1 files changed, 0 insertions, 221 deletions
diff --git a/ncurses-5.3/Ada95/samples/sample-curses_demo-mouse.adb b/ncurses-5.3/Ada95/samples/sample-curses_demo-mouse.adb deleted file mode 100644 index a97c1ba..0000000 --- a/ncurses-5.3/Ada95/samples/sample-curses_demo-mouse.adb +++ /dev/null @@ -1,221 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Curses_Demo.Mouse -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses; use Terminal_Interface.Curses; -with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; -with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse; -with Terminal_Interface.Curses.Text_IO; use Terminal_Interface.Curses.Text_IO; -with Terminal_Interface.Curses.Text_IO.Integer_IO; -with Terminal_Interface.Curses.Text_IO.Enumeration_IO; - -with Sample.Helpers; use Sample.Helpers; -with Sample.Manifest; use Sample.Manifest; -with Sample.Keyboard_Handler; use Sample.Keyboard_Handler; -with Sample.Function_Key_Setting; use Sample.Function_Key_Setting; -with Sample.Explanation; use Sample.Explanation; - -package body Sample.Curses_Demo.Mouse is - - package Int_IO is new - Terminal_Interface.Curses.Text_IO.Integer_IO (Integer); - use Int_IO; - - package Button_IO is new - Terminal_Interface.Curses.Text_IO.Enumeration_IO (Mouse_Button); - use Button_IO; - - package State_IO is new - Terminal_Interface.Curses.Text_IO.Enumeration_IO (Button_State); - use State_IO; - - procedure Demo is - - type Controls is array (1 .. 3) of Panel; - - Frame : Window; - Msg : Window; - Ctl : Controls; - Pan : Panel; - K : Real_Key_Code; - V : Cursor_Visibility := Invisible; - W : Window; - Note : Window; - Msg_L : constant Line_Count := 8; - Lins : Line_Position := Lines; - Cols : Column_Position; - Mask : Event_Mask; - procedure Show_Mouse_Event; - - procedure Show_Mouse_Event - is - Evt : constant Mouse_Event := Get_Mouse; - Y : Line_Position; - X : Column_Position; - Button : Mouse_Button; - State : Button_State; - W : Window; - begin - Get_Event (Evt, Y, X, Button, State); - Put (Msg, "Event at"); - Put (Msg, " X="); Put (Msg, Integer (X), 3); - Put (Msg, ", Y="); Put (Msg, Integer (Y), 3); - Put (Msg, ", Btn="); Put (Msg, Button, 10); - Put (Msg, ", Stat="); Put (Msg, State, 15); - for I in Ctl'Range loop - W := Get_Window (Ctl (I)); - if Enclosed_In_Window (W, Evt) then - Transform_Coordinates (W, Y, X, From_Screen); - Put (Msg, ",Box("); - Put (Msg, Integer (I), 1); Put (Msg, ","); - Put (Msg, Integer (Y), 1); Put (Msg, ","); - Put (Msg, Integer (X), 1); Put (Msg, ")"); - end if; - end loop; - New_Line (Msg); - Flush (Msg); - Update_Panels; Update_Screen; - end Show_Mouse_Event; - - begin - Push_Environment ("MOUSE00"); - Notepad ("MOUSE-PAD00"); - Default_Labels; - Set_Cursor_Visibility (V); - - Note := Notepad_Window; - if Note /= Null_Window then - Get_Window_Position (Note, Lins, Cols); - end if; - Frame := Create (Msg_L, Columns, Lins - Msg_L, 0); - if Has_Colors then - Set_Background (Win => Frame, - Ch => (Color => Default_Colors, - Attr => Normal_Video, - Ch => ' ')); - Set_Character_Attributes (Win => Frame, - Attr => Normal_Video, - Color => Default_Colors); - Erase (Frame); - end if; - Msg := Derived_Window (Frame, Msg_L - 2, Columns - 2, 1, 1); - Pan := Create (Frame); - - Set_Meta_Mode; - Set_KeyPad_Mode; - Mask := Start_Mouse; - - Box (Frame); - Window_Title (Frame, "Mouse Protocol"); - Refresh_Without_Update (Frame); - Allow_Scrolling (Msg, True); - - declare - Middle_Column : constant Integer := Integer (Columns) / 2; - Middle_Index : constant Natural := Ctl'First + (Ctl'Length / 2); - Width : constant Column_Count := 5; - Height : constant Line_Count := 3; - Half : constant Column_Count := Width / 2; - Space : constant Column_Count := 3; - Position : Integer; - W : Window; - begin - for I in Ctl'Range loop - Position := (Integer (I) - Integer (Middle_Index)) * - Integer (Half + Space + Width) + Middle_Column; - W := Create (Height, - Width, - 1, - Column_Position (Position)); - if Has_Colors then - Set_Background (Win => W, - Ch => (Color => Menu_Back_Color, - Attr => Normal_Video, - Ch => ' ')); - Set_Character_Attributes (Win => W, - Attr => Normal_Video, - Color => Menu_Fore_Color); - Erase (W); - end if; - Ctl (I) := Create (W); - Box (W); - Move_Cursor (W, 1, Half); - Put (W, Integer (I), 1); - Refresh_Without_Update (W); - end loop; - end; - - Update_Panels; Update_Screen; - - loop - K := Get_Key; - if K in Special_Key_Code'Range then - case K is - when QUIT_CODE => exit; - when HELP_CODE => Explain_Context; - when EXPLAIN_CODE => Explain ("MOUSEKEYS"); - when Key_Mouse => Show_Mouse_Event; - when others => null; - end case; - end if; - end loop; - - for I in Ctl'Range loop - W := Get_Window (Ctl (I)); - Clear (W); - Delete (Ctl (I)); - Delete (W); - end loop; - - Clear (Frame); - Delete (Pan); - Delete (Msg); - Delete (Frame); - - Set_Cursor_Visibility (V); - End_Mouse (Mask); - - Pop_Environment; - Update_Panels; Update_Screen; - - end Demo; - -end Sample.Curses_Demo.Mouse; - |