Filled holes in FLTK, FLTK.Events, FLTK.Screen, tweaked Fl_Shortcut implementation

1 files changed, 988 insertions, 0 deletions

diff --git a/body/fltk-events.adb b/body/fltk-events.adb
new file mode 100644
index 0000000..a15c55b
--- /dev/null
+++ b/body/fltk-events.adb
@@ -0,0 +1,988 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+with
+
+    Ada.Assertions,
+    Interfaces.C.Strings;
+
+use type
+
+    Interfaces.C.int,
+    Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Events is
+
+
+    package Chk renames Ada.Assertions;
+
+
+
+
+    ------------------------
+    --  Constants From C  --
+    ------------------------
+
+    fl_enum_button1 : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_button1, "fl_enum_button1");
+
+    fl_enum_button2 : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_button2, "fl_enum_button2");
+
+    fl_enum_button3 : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_button3, "fl_enum_button3");
+
+    fl_enum_button4 : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_button4, "fl_enum_button4");
+
+    fl_enum_button5 : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_button5, "fl_enum_button5");
+
+    fl_enum_left_mouse : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_left_mouse, "fl_enum_left_mouse");
+
+    fl_enum_middle_mouse : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_middle_mouse, "fl_enum_middle_mouse");
+
+    fl_enum_right_mouse : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_right_mouse, "fl_enum_right_mouse");
+
+    fl_enum_back_mouse : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_back_mouse, "fl_enum_back_mouse");
+
+    fl_enum_forward_mouse : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_forward_mouse, "fl_enum_forward_mouse");
+
+
+
+
+    ------------------------
+    --  Functions From C  --
+    ------------------------
+
+    --  Handlers  --
+
+    procedure fl_event_add_handler
+           (F : in Storage.Integer_Address);
+    pragma Import (C, fl_event_add_handler, "fl_event_add_handler");
+    pragma Inline (fl_event_add_handler);
+
+    procedure fl_event_set_dispatch
+           (F : in Storage.Integer_Address);
+    pragma Import (C, fl_event_set_dispatch, "fl_event_set_dispatch");
+    pragma Inline (fl_event_set_dispatch);
+
+    function fl_event_handle_dispatch
+           (E : in Interfaces.C.int;
+            W : in Storage.Integer_Address)
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_handle_dispatch, "fl_event_handle_dispatch");
+    pragma Inline (fl_event_handle_dispatch);
+
+    function fl_event_handle
+           (E : in Interfaces.C.int;
+            W : in Storage.Integer_Address)
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_handle, "fl_event_handle");
+    pragma Inline (fl_event_handle);
+
+
+
+
+    --  Receiving  --
+
+    function fl_event_get_grab
+        return Storage.Integer_Address;
+    pragma Import (C, fl_event_get_grab, "fl_event_get_grab");
+    pragma Inline (fl_event_get_grab);
+
+    procedure fl_event_set_grab
+           (T : in Storage.Integer_Address);
+    pragma Import (C, fl_event_set_grab, "fl_event_set_grab");
+    pragma Inline (fl_event_set_grab);
+
+    function fl_event_get_pushed
+        return Storage.Integer_Address;
+    pragma Import (C, fl_event_get_pushed, "fl_event_get_pushed");
+    pragma Inline (fl_event_get_pushed);
+
+    procedure fl_event_set_pushed
+           (T : in Storage.Integer_Address);
+    pragma Import (C, fl_event_set_pushed, "fl_event_set_pushed");
+    pragma Inline (fl_event_set_pushed);
+
+    function fl_event_get_belowmouse
+        return Storage.Integer_Address;
+    pragma Import (C, fl_event_get_belowmouse, "fl_event_get_belowmouse");
+    pragma Inline (fl_event_get_belowmouse);
+
+    procedure fl_event_set_belowmouse
+           (T : in Storage.Integer_Address);
+    pragma Import (C, fl_event_set_belowmouse, "fl_event_set_belowmouse");
+    pragma Inline (fl_event_set_belowmouse);
+
+    function fl_event_get_focus
+        return Storage.Integer_Address;
+    pragma Import (C, fl_event_get_focus, "fl_event_get_focus");
+    pragma Inline (fl_event_get_focus);
+
+    procedure fl_event_set_focus
+           (To : in Storage.Integer_Address);
+    pragma Import (C, fl_event_set_focus, "fl_event_set_focus");
+    pragma Inline (fl_event_set_focus);
+
+    function fl_event_get_visible_focus
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_get_visible_focus, "fl_event_get_visible_focus");
+    pragma Inline (fl_event_get_visible_focus);
+
+    procedure fl_event_set_visible_focus
+           (T : in Interfaces.C.int);
+    pragma Import (C, fl_event_set_visible_focus, "fl_event_set_visible_focus");
+    pragma Inline (fl_event_set_visible_focus);
+
+
+
+
+    --  Clipboard  --
+
+    function fl_event_clipboard_text
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, fl_event_clipboard_text, "fl_event_clipboard_text");
+    pragma Inline (fl_event_clipboard_text);
+
+    function fl_event_clipboard_type
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, fl_event_clipboard_type, "fl_event_clipboard_type");
+    pragma Inline (fl_event_clipboard_type);
+
+
+
+
+    --  Multikey  --
+
+    function fl_event_compose
+           (D : out Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_compose, "fl_event_compose");
+    pragma Inline (fl_event_compose);
+
+    function fl_event_text
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, fl_event_text, "fl_event_text");
+    pragma Inline (fl_event_text);
+
+    function fl_event_length
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_length, "fl_event_length");
+    pragma Inline (fl_event_length);
+
+    function fl_event_test_shortcut
+           (S : in Interfaces.C.unsigned)
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_test_shortcut, "fl_event_test_shortcut");
+    pragma Inline (fl_event_test_shortcut);
+
+
+
+
+    --  Modifiers  --
+
+    function fl_event_get
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_get, "fl_event_get");
+    pragma Inline (fl_event_get);
+
+    function fl_event_state
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_state, "fl_event_state");
+    pragma Inline (fl_event_state);
+
+    function fl_event_check_state
+           (S : in Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_check_state, "fl_event_check_state");
+    pragma Inline (fl_event_check_state);
+
+
+
+
+    --  Mouse  --
+
+    function fl_event_x
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_x, "fl_event_x");
+    pragma Inline (fl_event_x);
+
+    function fl_event_x_root
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_x_root, "fl_event_x_root");
+    pragma Inline (fl_event_x_root);
+
+    function fl_event_y
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_y, "fl_event_y");
+    pragma Inline (fl_event_y);
+
+    function fl_event_y_root
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_y_root, "fl_event_y_root");
+    pragma Inline (fl_event_y_root);
+
+    function fl_event_dx
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_dx, "fl_event_dx");
+    pragma Inline (fl_event_dx);
+
+    function fl_event_dy
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_dy, "fl_event_dy");
+    pragma Inline (fl_event_dy);
+
+    procedure fl_event_get_mouse
+           (X, Y : out Interfaces.C.int);
+    pragma Import (C, fl_event_get_mouse, "fl_event_get_mouse");
+    pragma Inline (fl_event_get_mouse);
+
+    function fl_event_is_click
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_is_click, "fl_event_is_click");
+    pragma Inline (fl_event_is_click);
+
+    procedure fl_event_set_click
+           (C : in Interfaces.C.int);
+    pragma Import (C, fl_event_set_click, "fl_event_set_click");
+    pragma Inline (fl_event_set_click);
+
+    function fl_event_get_clicks
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_get_clicks, "fl_event_get_clicks");
+    pragma Inline (fl_event_get_clicks);
+
+    procedure fl_event_set_clicks
+           (C : in Interfaces.C.int);
+    pragma Import (C, fl_event_set_clicks, "fl_event_set_clicks");
+    pragma Inline (fl_event_set_clicks);
+
+    function fl_event_button
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_button, "fl_event_button");
+    pragma Inline (fl_event_button);
+
+    function fl_event_button1
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_button1, "fl_event_button1");
+    pragma Inline (fl_event_button1);
+
+    function fl_event_button2
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_button2, "fl_event_button2");
+    pragma Inline (fl_event_button2);
+
+    function fl_event_button3
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_button3, "fl_event_button3");
+    pragma Inline (fl_event_button3);
+
+    function fl_event_button4
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_button4, "fl_event_button4");
+    pragma Inline (fl_event_button4);
+
+    function fl_event_button5
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_button5, "fl_event_button5");
+    pragma Inline (fl_event_button5);
+
+    function fl_event_buttons
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_buttons, "fl_event_buttons");
+    pragma Inline (fl_event_buttons);
+
+    function fl_event_inside2
+           (C : in Storage.Integer_Address)
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_inside2, "fl_event_inside2");
+    pragma Inline (fl_event_inside2);
+
+    function fl_event_inside
+           (X, Y, W, H : in Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_inside, "fl_event_inside");
+    pragma Inline (fl_event_inside);
+
+
+
+
+    --  Keyboard  --
+
+    function fl_event_key
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_key, "fl_event_key");
+    pragma Inline (fl_event_key);
+
+    function fl_event_original_key
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_original_key, "fl_event_original_key");
+    pragma Inline (fl_event_original_key);
+
+    function fl_event_key_during
+           (K : in Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_key_during, "fl_event_key_during");
+    pragma Inline (fl_event_key_during);
+
+    function fl_event_get_key
+           (K : in Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_get_key, "fl_event_get_key");
+    pragma Inline (fl_event_get_key);
+
+    function fl_event_ctrl
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_ctrl, "fl_event_ctrl");
+    pragma Inline (fl_event_ctrl);
+
+    function fl_event_alt
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_alt, "fl_event_alt");
+    pragma Inline (fl_event_alt);
+
+    function fl_event_command
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_command, "fl_event_command");
+    pragma Inline (fl_event_command);
+
+    function fl_event_shift
+        return Interfaces.C.int;
+    pragma Import (C, fl_event_shift, "fl_event_shift");
+    pragma Inline (fl_event_shift);
+
+
+
+
+    -------------
+    --  Hooks  --
+    -------------
+
+    function Event_Handler_Hook
+           (Num : in Interfaces.C.int)
+        return Interfaces.C.int
+    is
+        Ret_Val : Event_Outcome;
+    begin
+        for Func of reverse Handlers loop
+            Ret_Val := Func (Event_Kind'Val (Num));
+            if Ret_Val /= Not_Handled then
+                return Event_Outcome'Pos (Ret_Val);
+            end if;
+        end loop;
+        return Event_Outcome'Pos (Not_Handled);
+    end Event_Handler_Hook;
+
+
+    function Dispatch_Hook
+           (Num : in Interfaces.C.int;
+            Ptr : in Storage.Integer_Address)
+        return Interfaces.C.int
+    is
+        Ada_Ptr : Storage.Integer_Address;
+        Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class;
+    begin
+        if Ptr /= Null_Pointer then
+            Ada_Ptr := fl_widget_get_user_data (Ptr);
+            pragma Assert (Ada_Ptr /= Null_Pointer);
+            Actual_Window := Window_Convert.To_Pointer (Storage.To_Address (Ada_Ptr));
+        end if;
+        return Event_Outcome'Pos (Current_Dispatch (Event_Kind'Val (Num), Actual_Window));
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error with
+        "Window passed to Event_Dispatch hook did not have user_data pointer back to Ada";
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "Event_Dispatch hook passed unexpected event int value of " &
+        Interfaces.C.int'Image (Num);
+    end Dispatch_Hook;
+
+
+
+
+    -----------------------
+    --  API Subprograms  --
+    -----------------------
+
+    --  Handlers  --
+
+    procedure Add_Handler
+           (Func : in Event_Handler) is
+    begin
+        Handlers.Append (Func);
+    end Add_Handler;
+
+
+    procedure Remove_Handler
+           (Func : in Event_Handler) is
+    begin
+        for I in reverse Handlers.First_Index .. Handlers.Last_Index loop
+            if Handlers (I) = Func then
+                Handlers.Delete (I);
+                return;
+            end if;
+        end loop;
+    end Remove_Handler;
+
+
+    function Get_Dispatch
+        return Event_Dispatch is
+    begin
+        return Current_Dispatch;
+    end Get_Dispatch;
+
+
+    procedure Set_Dispatch
+           (Func : in Event_Dispatch) is
+    begin
+        Current_Dispatch := Func;
+        if Current_Dispatch /= null then
+            fl_event_set_dispatch (Storage.To_Integer (Dispatch_Hook'Address));
+        else
+            fl_event_set_dispatch (Null_Pointer);
+        end if;
+    end Set_Dispatch;
+
+
+    function Handle_Dispatch
+           (Event  : in     Event_Kind;
+            Origin : in out FLTK.Widgets.Groups.Windows.Window'Class)
+        return Event_Outcome
+    is
+        Result : Interfaces.C.int := fl_event_handle_dispatch
+           (Event_Kind'Pos (Event),
+            Wrapper (Origin).Void_Ptr);
+    begin
+        return Event_Outcome'Val (Result);
+    exception
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "Fl::handle returned unexpected int value of " & Interfaces.C.int'Image (Result);
+    end Handle_Dispatch;
+
+
+    function Handle
+           (Event  : in     Event_Kind;
+            Origin : in out FLTK.Widgets.Groups.Windows.Window'Class)
+        return Event_Outcome
+    is
+        Result : Interfaces.C.int := fl_event_handle
+           (Event_Kind'Pos (Event),
+            Wrapper (Origin).Void_Ptr);
+    begin
+        return Event_Outcome'Val (Result);
+    exception
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "Fl::handle_ returned unexpected int value of " & Interfaces.C.int'Image (Result);
+    end Handle;
+
+
+
+
+    --  Receiving  --
+
+    function Get_Grab
+        return access FLTK.Widgets.Groups.Windows.Window'Class
+    is
+        Grab_Ptr : Storage.Integer_Address := fl_event_get_grab;
+        Actual_Grab : access FLTK.Widgets.Groups.Windows.Window'Class;
+    begin
+        if Grab_Ptr /= Null_Pointer then
+            Grab_Ptr := fl_widget_get_user_data (Grab_Ptr);
+            pragma Assert (Grab_Ptr /= Null_Pointer);
+            Actual_Grab := Window_Convert.To_Pointer (Storage.To_Address (Grab_Ptr));
+        end if;
+        return Actual_Grab;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error with
+        "Widget returned by Fl::grab did not have user_data reference back to Ada";
+    end Get_Grab;
+
+
+    procedure Set_Grab
+           (To : in FLTK.Widgets.Groups.Windows.Window'Class) is
+    begin
+        fl_event_set_grab (Wrapper (To).Void_Ptr);
+    end Set_Grab;
+
+
+    procedure Release_Grab is
+    begin
+        fl_event_set_grab (Null_Pointer);
+    end Release_Grab;
+
+
+    function Get_Pushed
+        return access FLTK.Widgets.Widget'Class
+    is
+        Pushed_Ptr : Storage.Integer_Address := fl_event_get_pushed;
+        Actual_Pushed : access FLTK.Widgets.Widget'Class;
+    begin
+        if Pushed_Ptr /= Null_Pointer then
+            Pushed_Ptr := fl_widget_get_user_data (Pushed_Ptr);
+            pragma Assert (Pushed_Ptr /= Null_Pointer);
+            Actual_Pushed := Widget_Convert.To_Pointer (Storage.To_Address (Pushed_Ptr));
+        end if;
+        return Actual_Pushed;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error with
+        "Widget returned by Fl::pushed did not have user_data reference back to Ada";
+    end Get_Pushed;
+
+
+    procedure Set_Pushed
+           (To : in FLTK.Widgets.Widget'Class) is
+    begin
+        fl_event_set_pushed (Wrapper (To).Void_Ptr);
+    end Set_Pushed;
+
+
+    function Get_Below_Mouse
+        return access FLTK.Widgets.Widget'Class
+    is
+        Below_Ptr : Storage.Integer_Address := fl_event_get_belowmouse;
+        Actual_Below : access FLTK.Widgets.Widget'Class;
+    begin
+        if Below_Ptr /= Null_Pointer then
+            Below_Ptr := fl_widget_get_user_data (Below_Ptr);
+            pragma Assert (Below_Ptr /= Null_Pointer);
+            Actual_Below := Widget_Convert.To_Pointer (Storage.To_Address (Below_Ptr));
+        end if;
+        return Actual_Below;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error with
+        "Widget returned by Fl::belowmouse did not have user_data reference back to Ada";
+    end Get_Below_Mouse;
+
+
+    procedure Set_Below_Mouse
+           (To : in FLTK.Widgets.Widget'Class) is
+    begin
+        fl_event_set_belowmouse (Wrapper (To).Void_Ptr);
+    end Set_Below_Mouse;
+
+
+    function Get_Focus
+        return access FLTK.Widgets.Widget'Class
+    is
+        Focus_Ptr : Storage.Integer_Address := fl_event_get_focus;
+        Actual_Focus : access FLTK.Widgets.Widget'Class;
+    begin
+        if Focus_Ptr /= Null_Pointer then
+            Focus_Ptr := fl_widget_get_user_data (Focus_Ptr);
+            pragma Assert (Focus_Ptr /= Null_Pointer);
+            Actual_Focus := Widget_Convert.To_Pointer (Storage.To_Address (Focus_Ptr));
+        end if;
+        return Actual_Focus;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error with
+        "Widget returned by Fl::focus did not have user_data reference back to Ada";
+    end Get_Focus;
+
+
+    procedure Set_Focus
+           (To : in FLTK.Widgets.Widget'Class) is
+    begin
+        fl_event_set_focus (Wrapper (To).Void_Ptr);
+    end Set_Focus;
+
+
+    function Has_Visible_Focus
+        return Boolean is
+    begin
+        return fl_event_get_visible_focus /= 0;
+    end Has_Visible_Focus;
+
+
+    procedure Set_Visible_Focus
+           (To : in Boolean) is
+    begin
+        fl_event_set_visible_focus (Boolean'Pos (To));
+    end Set_Visible_Focus;
+
+
+
+
+    --  Clipboard  --
+
+    function Clipboard_Text
+        return String
+    is
+        Text_Ptr : Interfaces.C.Strings.chars_ptr := fl_event_clipboard_text;
+    begin
+        if Text_Ptr = Interfaces.C.Strings.Null_Ptr then
+            return "";
+        else
+            return Interfaces.C.Strings.Value (Text_Ptr);
+        end if;
+    end Clipboard_Text;
+
+
+    function Clipboard_Kind
+        return String
+    is
+        Text_Ptr : Interfaces.C.Strings.chars_ptr := fl_event_clipboard_type;
+    begin
+        if Text_Ptr = Interfaces.C.Strings.Null_Ptr then
+            return "";
+        else
+            return Interfaces.C.Strings.Value (Text_Ptr);
+        end if;
+    end Clipboard_Kind;
+
+
+
+
+    --  Multikey  --
+
+    function Compose
+           (Del : out Natural)
+        return Boolean is
+    begin
+        return fl_event_compose (Interfaces.C.int (Del)) /= 0;
+    end Compose;
+
+
+    function Text
+        return String
+    is
+        Str : Interfaces.C.Strings.chars_ptr := fl_event_text;
+    begin
+        if Str = Interfaces.C.Strings.Null_Ptr then
+            return "";
+        else
+            return Interfaces.C.Strings.Value (Str, Interfaces.C.size_t (fl_event_length));
+        end if;
+    end Text;
+
+
+    function Text_Length
+        return Natural is
+    begin
+        return Natural (fl_event_length);
+    end Text_Length;
+
+
+    function Test_Shortcut
+           (Shortcut : in Key_Combo)
+        return Boolean is
+    begin
+        return fl_event_test_shortcut (To_C (Shortcut)) /= 0;
+    end Test_Shortcut;
+
+
+
+
+    --  Modifiers  --
+
+    function Last
+        return Event_Kind
+    is
+        Value : Interfaces.C.int := fl_event_get;
+    begin
+        return Event_Kind'Val (Value);
+    exception
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "Fl::event returned unexpected int value of " & Interfaces.C.int'Image (Value);
+    end Last;
+
+
+    function Last_Modifier
+        return Modifier is
+    begin
+        return To_Ada (Interfaces.C.unsigned (fl_event_state));
+    end Last_Modifier;
+
+
+    function Last_Modifier
+           (Had : in Modifier)
+        return Boolean is
+    begin
+        return fl_event_check_state (Interfaces.C.int (To_C (Had))) /= 0;
+    end Last_Modifier;
+
+
+
+
+    --  Mouse  --
+
+    function Mouse_X
+        return Integer is
+    begin
+        return Integer (fl_event_x);
+    end Mouse_X;
+
+
+    function Mouse_X_Root
+        return Integer is
+    begin
+        return Integer (fl_event_x_root);
+    end Mouse_X_Root;
+
+
+    function Mouse_Y
+        return Integer is
+    begin
+        return Integer (fl_event_y);
+    end Mouse_Y;
+
+
+    function Mouse_Y_Root
+        return Integer is
+    begin
+        return Integer (fl_event_y_root);
+    end Mouse_Y_Root;
+
+
+
+    function Mouse_DX
+        return Integer is
+    begin
+        return Integer (fl_event_dx);
+    end Mouse_DX;
+
+
+    function Mouse_DY
+        return Integer is
+    begin
+        return Integer (fl_event_dy);
+    end Mouse_DY;
+
+
+    procedure Get_Mouse
+           (X, Y : out Integer) is
+    begin
+        fl_event_get_mouse (Interfaces.C.int (X), Interfaces.C.int (Y));
+    end Get_Mouse;
+
+
+    function Is_Click
+        return Boolean is
+    begin
+        return fl_event_is_click /= 0;
+    end Is_Click;
+
+
+    procedure Clear_Click is
+    begin
+        fl_event_set_click (0);
+    end Clear_Click;
+
+
+    function Is_Multi_Click
+        return Boolean is
+    begin
+        return fl_event_get_clicks /= 0;
+    end Is_Multi_Click;
+
+
+    function Get_Clicks
+        return Natural
+    is
+        Raw : Interfaces.C.int := fl_event_get_clicks;
+    begin
+        if Is_Click then
+            return Positive (Raw + 1);
+        else
+            return 0;
+        end if;
+    exception
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "Fl::event_clicks returned unexpected int value of " &
+        Interfaces.C.int'Image (Raw);
+    end Get_Clicks;
+
+
+    procedure Set_Clicks
+           (To : in Natural) is
+    begin
+        if To = 0 then
+            fl_event_set_clicks (0);
+            Clear_Click;
+        elsif To = 1 then
+            fl_event_set_clicks (0);
+        else
+            fl_event_set_clicks (Interfaces.C.int (To) - 1);
+        end if;
+    end Set_Clicks;
+
+
+    function Last_Button
+        return Mouse_Button
+    is
+        Code : Interfaces.C.int := fl_event_button;
+    begin
+        pragma Assert (Last = Push or Last = Release);
+        if Code = fl_enum_left_mouse then
+            return Left_Button;
+        elsif Code = fl_enum_middle_mouse then
+            return Middle_Button;
+        elsif Code = fl_enum_right_mouse then
+            return Right_Button;
+        elsif Code = fl_enum_back_mouse then
+            return Back_Button;
+        elsif Code = fl_enum_forward_mouse then
+            return Forward_Button;
+        else
+            raise Internal_FLTK_Error with "Fl::event_button returned unexpected int value of " &
+                Interfaces.C.int'Image (Code);
+        end if;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error with
+        "Fl::event_button was called when the most recent event was not Push or Release";
+    end Last_Button;
+
+
+    function Mouse_Left
+        return Boolean is
+    begin
+        return fl_event_button1 /= 0;
+    end Mouse_Left;
+
+
+    function Mouse_Middle
+        return Boolean is
+    begin
+        return fl_event_button2 /= 0;
+    end Mouse_Middle;
+
+
+    function Mouse_Right
+        return Boolean is
+    begin
+        return fl_event_button3 /= 0;
+    end Mouse_Right;
+
+
+    function Mouse_Back
+        return Boolean is
+    begin
+        return fl_event_button4 /= 0;
+    end Mouse_Back;
+
+
+    function Mouse_Forward
+        return Boolean is
+    begin
+        return fl_event_button5 /= 0;
+    end Mouse_Forward;
+
+
+    procedure Mouse_Buttons
+           (Left, Middle, Right, Back, Forward : out Boolean)
+    is
+        type Cint_Mod is mod 2 ** Interfaces.C.int'Size;
+        Mask : Interfaces.C.int := fl_event_buttons;
+    begin
+        Left    := (Cint_Mod (Mask) and Cint_Mod (fl_enum_button1)) /= 0;
+        Middle  := (Cint_Mod (Mask) and Cint_Mod (fl_enum_button2)) /= 0;
+        Right   := (Cint_Mod (Mask) and Cint_Mod (fl_enum_button3)) /= 0;
+        Back    := (Cint_Mod (Mask) and Cint_Mod (fl_enum_button4)) /= 0;
+        Forward := (Cint_Mod (Mask) and Cint_Mod (fl_enum_button5)) /= 0;
+    exception
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "Fl::event_buttons returned unexpected int value of " &
+        Interfaces.C.int'Image (Mask);
+    end Mouse_Buttons;
+
+
+    function Is_Inside
+           (Child : in FLTK.Widgets.Widget'Class)
+        return Boolean is
+    begin
+        return fl_event_inside2 (Wrapper (Child).Void_Ptr) /= 0;
+    end Is_Inside;
+
+
+    function Is_Inside
+           (X, Y, W, H : in Integer)
+        return Boolean is
+    begin
+        return fl_event_inside
+           (Interfaces.C.int (X),
+            Interfaces.C.int (Y),
+            Interfaces.C.int (W),
+            Interfaces.C.int (H)) /= 0;
+    end Is_Inside;
+
+
+
+
+    --  Keyboard  --
+
+    function Last_Key
+        return Keypress is
+    begin
+        return To_Ada (Interfaces.C.unsigned (fl_event_key));
+    end Last_Key;
+
+
+    function Original_Last_Key
+        return Keypress is
+    begin
+        return To_Ada (Interfaces.C.unsigned (fl_event_original_key));
+    end Original_Last_Key;
+
+
+    function Pressed_During
+           (Key : in Keypress)
+        return Boolean is
+    begin
+        return fl_event_key_during (Interfaces.C.int (To_C (Key))) /= 0;
+    end Pressed_During;
+
+
+    function Key_Now
+           (Key : in Keypress)
+        return Boolean is
+    begin
+        return fl_event_get_key (Interfaces.C.int (To_C (Key))) /= 0;
+    end Key_Now;
+
+
+    function Key_Ctrl
+        return Boolean is
+    begin
+        return fl_event_ctrl /= 0;
+    end Key_Ctrl;
+
+
+    function Key_Alt
+        return Boolean is
+    begin
+        return fl_event_alt /= 0;
+    end Key_Alt;
+
+
+    function Key_Command
+        return Boolean is
+    begin
+        return fl_event_command /= 0;
+    end Key_Command;
+
+
+    function Key_Shift
+        return Boolean is
+    begin
+        return fl_event_shift /= 0;
+    end Key_Shift;
+
+
+begin
+
+
+    fl_event_add_handler (Storage.To_Integer (Event_Handler_Hook'Address));
+
+
+end FLTK.Events;
+
+