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 Interfaces.C.Strings; use Interfaces.C.Strings;
26with System;               use System;
27
28package body Glib is
29
30   ----------------------
31   -- To_Boolean_Array --
32   ----------------------
33
34   function To_Boolean_Array (A : Gboolean_Array) return Boolean_Array is
35      Result : Boolean_Array (A'Range);
36   begin
37      for Index in A'Range loop
38         Result (Index) := A (Index) /= 0;
39      end loop;
40
41      return Result;
42   end To_Boolean_Array;
43
44   -------------
45   -- To_Gint --
46   -------------
47
48   function To_Gint (Bool : Boolean) return Gint is
49   begin
50      if Bool then
51         return 1;
52      else
53         return 0;
54      end if;
55   end To_Gint;
56
57   -----------------------
58   -- Quark_From_String --
59   -----------------------
60
61   function Quark_From_String (Id : String) return GQuark is
62      function Internal (Id : String) return GQuark;
63      pragma Import (C, Internal, "g_quark_from_string");
64   begin
65      return Internal (Id & ASCII.NUL);
66   end Quark_From_String;
67
68   ----------------------
69   -- Quark_Try_String --
70   ----------------------
71
72   function Quark_Try_String (Id : String) return GQuark is
73      function Internal (Id : String) return GQuark;
74      pragma Import (C, Internal, "g_quark_try_string");
75   begin
76      return Internal (Id & ASCII.NUL);
77   end Quark_Try_String;
78
79   ---------------
80   -- Type_Name --
81   ---------------
82
83   function Type_Name (Type_Num : GType) return String is
84      function Internal (Type_Num : GType) return chars_ptr;
85      pragma Import (C, Internal, "g_type_name");
86      Ret : constant chars_ptr := Internal (Type_Num);
87   begin
88      if Ret = Null_Ptr then
89         return "";
90      else
91         return Value (Ret);
92      end if;
93   end Type_Name;
94
95   --------------------
96   -- Type_From_Name --
97   --------------------
98
99   function Type_From_Name (Name : String) return GType is
100      function Internal (Name : String) return GType;
101      pragma Import (C, Internal, "g_type_from_name");
102   begin
103      return Internal (Name & ASCII.NUL);
104   end Type_From_Name;
105
106   -----------
107   -- Build --
108   -----------
109
110   function Build (Name : String) return Property is
111   begin
112      if Name (Name'Last) /= ASCII.NUL then
113         return Property (Name & ASCII.NUL);
114      else
115         return Property (Name);
116      end if;
117   end Build;
118
119   -------------------
120   -- Property_Name --
121   -------------------
122
123   function Property_Name (Prop : Property) return String is
124   begin
125      return String (Prop);
126   end Property_Name;
127
128   --------------------------------
129   -- Boxed_Type_Register_Static --
130   --------------------------------
131
132   function Boxed_Type_Register_Static
133     (Name : String;
134      Copy : Boxed_Copy;
135      Free : Boxed_Free) return GType
136   is
137      function Internal
138        (N : String; Copy : Boxed_Copy; Free : Boxed_Free) return GType;
139      pragma Import (C, Internal, "g_boxed_type_register_static");
140   begin
141      return Internal (Name & ASCII.NUL, Copy, Free);
142   end Boxed_Type_Register_Static;
143
144   ----------------
145   -- Get_Object --
146   ----------------
147
148   function Get_Object (Self : C_Boxed'Class) return System.Address is
149   begin
150      return Self.Ptr;
151   end Get_Object;
152
153   ----------------
154   -- Set_Object --
155   ----------------
156
157   procedure Set_Object (Self : in out C_Boxed'Class; Ptr : System.Address) is
158   begin
159      Self.Ptr := Ptr;
160   end Set_Object;
161
162   -------------
163   -- Is_Null --
164   -------------
165
166   function Is_Null (Self : C_Boxed'Class) return Boolean is
167   begin
168      return Self.Ptr = System.Null_Address;
169   end Is_Null;
170end Glib;
171