-- ----------------------------------------------------------------- --
-- 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;
syntax highlighted by Code2HTML, v. 0.9.1