1------------------------------------------------------------------------------ 2-- GtkAda - Ada95 binding for the Gimp Toolkit -- 3-- -- 4-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet -- 5-- Copyright (C) 1998-2015, AdaCore -- 6-- -- 7-- This library is free software; you can redistribute it and/or modify it -- 8-- under terms of the GNU General Public License as published by the Free -- 9-- Software Foundation; either version 3, or (at your option) any later -- 10-- version. This library is distributed in the hope that it will be useful, -- 11-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 12-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 13-- -- 14-- As a special exception under Section 7 of GPL version 3, you are granted -- 15-- additional permissions described in the GCC Runtime Library Exception, -- 16-- version 3.1, as published by the Free Software Foundation. -- 17-- -- 18-- You should have received a copy of the GNU General Public License and -- 19-- a copy of the GCC Runtime Library Exception along with this program; -- 20-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 21-- <http://www.gnu.org/licenses/>. -- 22-- -- 23------------------------------------------------------------------------------ 24 25with Gdk.Types; use Gdk.Types; 26with System; 27with Interfaces.C.Strings; 28 29package body Gdk.Main is 30 31 ---------- 32 -- Init -- 33 ---------- 34 35 procedure Init is 36 gnat_argc : Interfaces.C.int; 37 pragma Import (C, gnat_argc); 38 39 gnat_argv : System.Address; 40 pragma Import (C, gnat_argv); 41 42 procedure Internal (argc : System.Address; argv : System.Address); 43 pragma Import (C, Internal, "gdk_init"); 44 45 begin 46 Internal (gnat_argc'Address, gnat_argv'Address); 47 end Init; 48 49 ----------------- 50 -- Get_Display -- 51 ----------------- 52 53 function Get_Display return String is 54 use Interfaces.C.Strings; 55 56 function Internal return chars_ptr; 57 pragma Import (C, Internal, "gdk_get_display"); 58 59 Result : constant chars_ptr := Internal; 60 61 begin 62 if Result = Null_Ptr then 63 return ""; 64 else 65 return Interfaces.C.Strings.Value (Internal); 66 end if; 67 end Get_Display; 68 69 ------------------- 70 -- Keyboard_Grab -- 71 ------------------- 72 73 function Keyboard_Grab 74 (Window : Gdk.Gdk_Window; 75 Owner_Events : Boolean := True; 76 Time : Guint32 := 0) return Gdk_Grab_Status 77 is 78 function Internal 79 (Window : Gdk_Window; 80 Owner_Events : Gint; 81 Time : Guint32) return Gint; 82 pragma Import (C, Internal, "gdk_keyboard_grab"); 83 84 begin 85 return Gdk_Grab_Status'Val 86 (Internal (Window, To_Gint (Owner_Events), Time)); 87 end Keyboard_Grab; 88 89 --------------------- 90 -- Keyboard_Ungrab -- 91 --------------------- 92 93 procedure Keyboard_Ungrab (Time : Guint32 := 0) is 94 procedure Internal (Time : Guint32); 95 pragma Import (C, Internal, "gdk_keyboard_ungrab"); 96 97 begin 98 Internal (Time); 99 end Keyboard_Ungrab; 100 101 ------------------ 102 -- Pointer_Grab -- 103 ------------------ 104 105 function Pointer_Grab 106 (Window : Gdk.Gdk_Window; 107 Owner_Events : Boolean := True; 108 Event_Mask : Gdk.Event.Gdk_Event_Mask; 109 Confine_To : Gdk.Gdk_Window := null; 110 Cursor : Gdk.Gdk_Cursor := null; 111 Time : Guint32 := 0) return Gdk_Grab_Status 112 is 113 function Internal 114 (Window : Gdk_Window; 115 Owner_Events : Gint; 116 Event_Mask : Gint; 117 Confine_To : Gdk_Window; 118 Cursor : Gdk_Cursor; 119 Time : Guint32) return Gint; 120 pragma Import (C, Internal, "gdk_pointer_grab"); 121 122 begin 123 return Gdk_Grab_Status'Val 124 (Internal 125 (Window, 126 To_Gint (Owner_Events), 127 Gint (Event_Mask), 128 Confine_To, 129 Cursor, 130 Time)); 131 end Pointer_Grab; 132 133 ------------------------ 134 -- Pointer_Is_Grabbed -- 135 ------------------------ 136 137 function Pointer_Is_Grabbed return Boolean is 138 function Internal return Gint; 139 pragma Import (C, Internal, "gdk_pointer_is_grabbed"); 140 141 begin 142 return Internal /= 0; 143 end Pointer_Is_Grabbed; 144 145 -------------------- 146 -- Pointer_Ungrab -- 147 -------------------- 148 149 procedure Pointer_Ungrab (Time : Guint32 := 0) is 150 procedure Internal (Time : Guint32); 151 pragma Import (C, Internal, "gdk_pointer_ungrab"); 152 153 begin 154 Internal (Time); 155 end Pointer_Ungrab; 156 157end Gdk.Main; 158