-- ----------------------------------------------------------------- -- -- AdaSDL -- -- Binding to Simple Direct Media Layer -- -- Copyright (C) 2001 A.M.F.Vargas -- -- Antonio M. F. Vargas -- -- Ponta Delgada - Azores - Portugal -- -- http://www.adapower.net/~avargas -- -- E-mail: avargas@adapower.net -- -- ----------------------------------------------------------------- -- -- -- -- This library is free software; you can redistribute it and/or -- -- modify it under the terms of the GNU General Public -- -- License as published by the Free Software Foundation; either -- -- version 2 of the License, or (at your option) any later version. -- -- -- -- This library is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- -- General Public License for more details. -- -- -- -- You should have received a copy of the GNU General Public -- -- License along with this library; if not, write to the -- -- Free Software Foundation, Inc., 59 Temple Place - Suite 330, -- -- Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from -- -- this unit, or you link this unit with other files to produce an -- -- executable, this unit does not by itself cause the resulting -- -- executable to be covered by the GNU General Public License. This -- -- exception does not however invalidate any other reasons why the -- -- executable file might be covered by the GNU Public License. -- -- ----------------------------------------------------------------- -- -- **************************************************************** -- -- This is an Ada binding to SDL ( Simple DirectMedia Layer from -- -- Sam Lantinga - www.libsld.org ) -- -- **************************************************************** -- -- In order to help the Ada programmer, the comments in this file -- -- are, in great extent, a direct copy of the original text in the -- -- SDL header files. -- -- **************************************************************** -- with System; with Interfaces.C; with SDL.Types; use SDL.Types; with SDL.Keyboard; with SDL.Active; with SDL.Mouse; with SDL.Joystick; package SDL.Events is type Event_Type is new Interfaces.Unsigned_8; for Event_Type'Size use 8; -- pragma Convention (C, Event_Type); package I renames Interfaces; package M renames SDL.Mouse; package Jy renames SDL.Joystick; -- ------------------ -- Orginal C Event enumerations -- ------------------ -- Unused (do not remove) NOEVENT : constant Event_Type := 0; -- Application loses/gains visibility ISACTIVEEVENT : constant Event_Type := 1; -- Keys pressed KEYDOWN : constant Event_Type := 2; -- Keys released KEYUP : constant Event_Type := 3; -- Mouse moved MOUSEMOTION : constant Event_Type := 4; -- Mouse button pressed MOUSEBUTTONDOWN : constant Event_Type := 5; -- Mouse button released MOUSEBUTTONUP : constant Event_Type := 6; -- Joystick axis motion JOYAXISMOTION : constant Event_Type := 7; -- Joystick trackball motion JOYBALLMOTION : constant Event_Type := 8; -- Joystick hat position change JOYHATMOTION : constant Event_Type := 9; -- Joystick button pressed JOYBUTTONDOWN : constant Event_Type := 10; -- Joystick button released JOYBUTTONUP : constant Event_Type := 11; -- User-requested quit QUIT : constant Event_Type := 12; -- System specific event ISSYSWMEVENT : constant Event_Type := 13; -- Reserved for future use.. EVENT_RESERVEDA : constant Event_Type := 14; -- Reserved for future use.. EVENT_RESERVEDB : constant Event_Type := 15; -- User resized video mode VIDEORESIZE : constant Event_Type := 16; -- Reserved for future use.. EVENT_RESERVED1 : constant Event_Type := 17; -- Reserved for future use.. EVENT_RESERVED2 : constant Event_Type := 18; -- Reserved for future use.. EVENT_RESERVED3 : constant Event_Type := 19; -- Reserved for future use.. EVENT_RESERVED4 : constant Event_Type := 20; -- Reserved for future use.. EVENT_RESERVED5 : constant Event_Type := 21; -- Reserved for future use.. EVENT_RESERVED6 : constant Event_Type := 22; -- Reserved for future use.. EVENT_RESERVED7 : constant Event_Type := 23; -- Events USEREVENT through MAXEVENTS-1 are for your use ISUSEREVENT : constant Event_Type := 24; -- This last event is only for bounding internal arrays -- It is the number of bits in the event mask datatype -- Uint32 NUMEVENTS : constant Event_Type := 32; -- Predefined event masks type Event_Mask is mod 2**Integer (NUMEVENTS); ACTIVEEVENTMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (ISACTIVEEVENT))); KEYDOWNMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (KEYDOWN))); KEYUPMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (KEYUP))); MOUSEMOTIONMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (MOUSEMOTION))); MOUSEBUTTONDOWNMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (MOUSEBUTTONDOWN))); MOUSEBUTTONUPMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (MOUSEBUTTONUP))); MOUSEEVENTMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (MOUSEMOTION))) or Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (MOUSEBUTTONDOWN))) or Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (MOUSEBUTTONUP))); JOYAXISMOTIONMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (JOYAXISMOTION))); JOYBALLMOTIONMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (JOYBALLMOTION))); JOYHATMOTIONMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (JOYHATMOTION))); JOYBUTTONDOWNMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (JOYBUTTONDOWN))); JOYBUTTONUPMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (JOYBUTTONUP))); JOYEVENTMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (JOYAXISMOTION))) or Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (JOYBALLMOTION))) or Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (JOYHATMOTION))) or Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (JOYBUTTONDOWN))) or Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (JOYBUTTONUP))); VIDEORESIZEMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (VIDEORESIZE))); QUITMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (QUIT))); SYSWMEVENTMASK : constant Event_Mask := Event_Mask (I.Shift_Left (I.Unsigned_32 (1), Integer (ISSYSWMEVENT))); ALLEVENTS : constant Event_Mask := 16#FFFFFFFF#; -- Application visibility event structure type ActiveEvent is record -- the_type, -- ISACTIVEEVENT the_type : Event_Type; -- ISACTIVEEVENT; gain, -- Whether given states were gained or lost (1/0) state : SDL.Active.Active_State; -- A mask of the focus states end record; pragma Convention (C, ActiveEvent); -- Keyboard event structure type KeyboardEvent is record the_type : Event_Type; -- KEYDOWN or KEYUP which : Uint8; -- The keyboard device index state : Uint8; -- PRESSED or RELEASED keysym : aliased SDL.Keyboard.keysym; end record; pragma Convention (C, KeyboardEvent); -- Mouse motion event structure type MouseMotionEvent is record the_type : Event_Type; -- MOUSEMOTION which : Uint8; -- The mouse device index state : Uint8; -- The current state x, y : Uint16; -- The X/Y coordinates of the mouse xrel : Sint16; -- The relative motion in the X direction yrel : Sint16; -- The relative motion in the Y direction end record; pragma Convention (C, MouseMotionEvent); -- Mouse button event structure type MouseButtonEvent is record the_type : Event_Type; -- MOUSEBUTTONDOWN or MOUSEBUTTONUP which : Uint8; -- The mouse device index button : Uint8; -- The mouse button index state : M.Mouse_Button_State; -- PRESSED or RELEASED x, y : Uint16; -- The X/Y coordinates of the mouse at -- press time end record; pragma Convention (C, MouseButtonEvent); -- Joystick axis motion event structure type JoyAxisEvent is record the_type : Event_Type; -- JOYAXISMOTION which : Uint8; -- The joystick device index axis : Uint8; -- The joystick axis index value : Sint16; -- The axis value (range: -32768 to 32767) end record; pragma Convention (C, JoyAxisEvent); -- Joystick trackball motion event structure type JoyBallEvent is record the_type : Event_Type; -- JOYBALLMOTION which : Uint8; -- The joystick device index ball : Uint8; -- The joystick trackball index xrel : Sint16; -- The relative motion in the X direction yrel : Sint16; -- The relative motion in the Y direction end record; pragma Convention (C, JoyBallEvent); -- Joystick hat position change event structure type JoyHatEvent is record the_type : Event_Type; -- JOYHATMOTION which : Uint8; -- The joystick device index hat : Uint8; -- The joystick hat index value : Jy.HAT_State; -- The hat position value -- 8 1 2 -- 7 0 3 -- 6 5 4 -- Note that zero means the POV is centered. end record; pragma Convention (C, JoyHatEvent); -- Joystick button event structure */ type JoyButtonEvent is record the_type : Event_Type; -- JOYBUTTONDOWN or JOYBUTTONUP which : Uint8; -- The joystick device index button : Uint8; -- The joystick button index state : Uint8; -- PRESSED or RELEASED end record; pragma Convention (C, JoyButtonEvent); -- The "window resized" event -- When you get this event, you are responsible for setting a new video -- mode with the new width and height. type ResizeEvent is record the_type : Event_Type; -- VIDEORESIZE w, h : C.int; -- New width and height end record; pragma Convention (C, ResizeEvent); -- The "quit requested" event type QuitEvent is record the_type : Event_Type; -- QUIT end record; pragma Convention (C, QuitEvent); -- A user-defined event type type UserEvent is record the_type : Event_Type; -- USEREVENT through NUMEVENTS-1 code : C.int; -- User defined event code data1 : void_ptr; -- User defined data pointer data2 : void_ptr; -- User defined data pointer end record; pragma Convention (C, UserEvent); type SysWMmsg_ptr is new System.Address; -- If you want to use this event, you should use SDL.Syswm type SysWMEvent is record the_type : Event_Type; msg : SysWMmsg_ptr; end record; pragma Convention (C, SysWMEvent); type Event_Selection is ( Is_Event_Type, Is_ActiveEvent, Is_KeyboardEvent, Is_MouseMotionEvent, Is_MouseButtonEvent, Is_JoyAxisEvent, Is_JoyBallEvent, Is_JoyHatEvent, Is_JoyButtonEvent, Is_ResizeEvent, Is_QuitEvent, Is_UserEvent, Is_SysWMEvent); -- General event structure type Event (Event_Selec : Event_Selection := Is_Event_Type) is record case Event_Selec is when Is_Event_Type => the_type : Event_Type; when Is_ActiveEvent => active : ActiveEvent; when Is_KeyboardEvent => key : KeyboardEvent; when Is_MouseMotionEvent => motion : MouseMotionEvent; when Is_MouseButtonEvent => button : MouseButtonEvent; when Is_JoyAxisEvent => jaxis : JoyAxisEvent; when Is_JoyBallEvent => jball : JoyBallEvent; when Is_JoyHatEvent => jhat : JoyHatEvent; when Is_JoyButtonEvent => jbutton : JoyButtonEvent; when Is_ResizeEvent => resize : ResizeEvent; when Is_QuitEvent => quit : QuitEvent; when Is_UserEvent => user : UserEvent; when Is_SysWMEvent => syswm : SysWMEvent; end case; end record; pragma Convention (C, Event); pragma Unchecked_Union (Event); type Event_ptr is access all Event; pragma Convention (C, Event_ptr); -- ------------------- -- Function prototypes -- ------------------- -- Pumps the event loop, gathering events from the input devices. -- This function updates the event queue and internal input device state. -- This should only be run in the thread that sets the video mode. procedure PumpEvents; pragma Import (C, PumpEvents, "SDL_PumpEvents"); -- Checks the event queue for messages and optionally returns them. -- If 'action' is ADDEVENT, up to 'numevents' events will be added to -- the back of the event queue. -- If 'action' is PEEKEVENT, up to 'numevents' events at the front -- of the event queue, matching 'mask', will be returned and will not -- be removed from the queue. -- If 'action' is GETEVENT, up to 'numevents' events at the front -- of the event queue, matching 'mask', will be returned and will be -- removed from the queue. -- This function returns the number of events actually stored, or -1 -- if there was an error. This function is thread-safe. type eventaction is new C.int; ADDEVENT : constant := 0; PEEKEVENT : constant := 1; GETEVENT : constant := 2; type Events_Array is array (Natural range <>) of Event; procedure PeepEventsVP ( result : out C.int; events : in out Events_Array; numevents : C.int; action : eventaction; mask : Event_Mask); pragma Import (C, PeepEventsVP, "SDL_PeepEvents"); pragma Import_Valued_Procedure (PeepEventsVP); -- From Ada this function is to be called only as -- ... := PeepEvents (null, 0, the_action, the_mask); -- in other cases use PeepEventsVP. function PeepEvents ( events : Event_ptr; numevents : C.int; action : eventaction; mask : Event_Mask) return C.int; pragma Import (C, PeepEvents, "SDL_PeepEvents"); -- pending events, or 0 if there are none available. If 'event' is not -- NULL, the next event is removed from the queue and stored in that area. function PollEvent (the_event : access Event) return C.int; pragma Import (C, PollEvent, "SDL_PollEvent"); -- Check the pending events. Doesn't remove them. function Poll_Event return C.int; pragma Inline (Poll_Event); -- A corresponding Valued Procedure procedure PollEventVP (result : out C.int; the_event : in out Event); pragma Import (C, PollEventVP, "SDL_PollEvent"); pragma Import_Valued_Procedure (PollEventVP); -- Waits indefinitely for the next available event, returning 1, or 0 -- if there was an error while waiting for events. If 'event' is not -- NULL, the next event is removed from the queue and stored in that area. function WaitEvent (event : Event_ptr) return C.int; procedure WaitEvent (event : Event_ptr); procedure WaitEvent (the_event : in out Event); pragma Import (C, WaitEvent, "SDL_WaitEvent"); procedure Wait_Event ( Result : out C.int; the_event : in out Event); pragma Import (C, Wait_Event, "SDL_WaitEvent"); pragma Import_Valued_Procedure (Wait_Event); function Wait_Any_Event return C.int; pragma Inline (Wait_Any_Event); -- Add an event to the event queue. -- This function returns 0, or -1 if the event couldn't be added to -- the event queue. If the event queue is full, this function fails. function PushEvent (event : Event_ptr) return C.int; procedure PushEvent (event : Event_ptr); function PushEvent (the_event : Event) return C.int; procedure PushEvent (the_event : Event); pragma Import (C, PushEvent, "SDL_PushEvent"); -- This function sets up a filter to process all events before they -- change internal state and are posted to the internal event queue. -- The filter is protypted as: type EventFilter_ptr is access function (event : Event_ptr) return C.int; pragma Convention (C, EventFilter_ptr); -- If the filter returns 1, then the event will be added to the internal -- queue. If it returns 0, then the event will be dropped from the queue, -- but the internal state will still be updated. This allows selective -- filtering of dynamically arriving events. -- WARNING: Be very careful of what you do in the event filter function, -- as it may run in a different thread! -- There is one caveat when dealing with the QUITEVENT event type. The -- event filter is only called when the window manager desires to close the -- application window. If the event filter returns 1, then the window will -- be closed, otherwise the window will remain open if possible. -- If the quit event is generated by an interrupt signal, it will bypass -- the internal queue and be delivered to the application at the next event -- poll. procedure SetEventFilter (filter : EventFilter_ptr); pragma Import (C, SetEventFilter, "SDL_SetEventFilter"); -- Return the current event filter - can be used to "chain" filters. -- If there is no event filter set, this function returns NULL. function GetEventFilter return EventFilter_ptr; pragma Import (C, GetEventFilter, "SDL_GetEventFilter"); -- This function allows you to set the state of processing certain events. -- If 'state' is set to IGNORE, that event will be automatically dropped -- from the event queue and will not event be filtered. -- If 'state' is set to ENABLE, that event will be processed normally. -- If 'state' is set to QUERY, EventState will return the -- current processing state of the specified event. QUERY : constant := -1; IGNORE : constant := 0; DISABLE : constant := 0; ENABLE : constant := 1; function EventState ( the_type : Event_Type; state : C.int) return Uint8; procedure EventState ( the_type : Event_Type; state : C.int); pragma Import (C, EventState, "SDL_EventState"); end SDL.Events;