1-----------------------------------------------------------------------
2--               GtkAda - Ada95 binding for Gtk+/Gnome               --
3--                                                                   --
4--   Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet   --
5--                Copyright (C) 2000-2001 ACT-Europe                 --
6--                                                                   --
7-- This library is free software; you can redistribute it and/or     --
8-- modify it under the terms of the GNU General Public               --
9-- License as published by the Free Software Foundation; either      --
10-- version 2 of the License, or (at your option) any later version.  --
11--                                                                   --
12-- This library is distributed in the hope that it will be useful,   --
13-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
14-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
15-- General Public License for more details.                          --
16--                                                                   --
17-- You should have received a copy of the GNU General Public         --
18-- License along with this library; if not, write to the             --
19-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
20-- Boston, MA 02111-1307, USA.                                       --
21--                                                                   --
22-- As a special exception, if other files instantiate generics from  --
23-- this unit, or you link this unit with other files to produce an   --
24-- executable, this  unit  does not  by itself cause  the resulting  --
25-- executable to be covered by the GNU General Public License. This  --
26-- exception does not however invalidate any other reasons why the   --
27-- executable file  might be covered by the  GNU Public License.     --
28-----------------------------------------------------------------------
29
30with Interfaces.C.Pointers;
31
32package body Gdk.Visual is
33
34   type Aliased_Gint_Array is array (Natural range <>) of aliased Gint;
35
36   package Gint_Ptr is new Interfaces.C.Pointers
37     (Index => Natural, Element => Gint, Element_Array => Aliased_Gint_Array,
38      Default_Terminator => 0);
39
40   type Aliased_Visual_Type_Array is array (Natural range <>)
41     of aliased Gdk_Visual_Type;
42
43   package Visual_Type_Ptr is new Interfaces.C.Pointers
44     (Index => Natural, Element => Gdk_Visual_Type,
45      Element_Array => Aliased_Visual_Type_Array,
46      Default_Terminator => Visual_Static_Gray);
47
48   --------------
49   -- Get_Best --
50   --------------
51
52   function Get_Best return Gdk_Visual is
53      function Internal return Gdk_Visual;
54      pragma Import (C, Internal, "gdk_visual_get_best");
55   begin
56      return Internal;
57   end Get_Best;
58
59   procedure Get_Best (Visual : out Gdk_Visual) is
60   begin
61      Visual := Get_Best;
62   end Get_Best;
63
64   function Get_Best (Depth : Gint) return Gdk_Visual is
65      function Internal (Depth : Gint) return Gdk_Visual;
66      pragma Import (C, Internal, "gdk_visual_get_best_with_depth");
67
68   begin
69      return Internal (Depth);
70   end Get_Best;
71
72   function Get_Best (Visual_Type : Gdk_Visual_Type) return Gdk_Visual is
73      function Internal (Visual_Type : Gdk_Visual_Type) return Gdk_Visual;
74      pragma Import (C, Internal, "gdk_visual_get_best_with_type");
75
76   begin
77      return Internal (Visual_Type);
78   end Get_Best;
79
80   function Get_Best
81     (Depth : Gint; Visual_Type : Gdk_Visual_Type) return Gdk_Visual
82   is
83      function Internal
84        (Depth : Gint; Visual_Type : Gdk_Visual_Type) return Gdk_Visual;
85      pragma Import (C, Internal, "gdk_visual_get_best_with_both");
86
87   begin
88      return Internal (Depth, Visual_Type);
89   end Get_Best;
90
91   ------------------
92   -- List_Visuals --
93   ------------------
94
95   function List_Visuals return Gdk_Visual_List.Glist is
96      function Internal return System.Address;
97      pragma Import (C, Internal, "gdk_list_visuals");
98      Result : Gdk_Visual_List.Glist;
99   begin
100      Gdk_Visual_List.Set_Object (Result, Internal);
101      return Result;
102   end List_Visuals;
103
104   ------------------
105   -- Query_Depths --
106   ------------------
107
108   function Query_Depths return Gint_Array is
109      procedure Internal (Depths : out Gint_Ptr.Pointer; Count : out Gint);
110      pragma Import (C, Internal, "gdk_query_depths");
111
112      Internal_Result : Gint_Ptr.Pointer;
113      Count : Gint;
114
115   begin
116      Internal (Internal_Result, Count);
117
118      declare
119         Temp : constant Aliased_Gint_Array :=
120           Gint_Ptr.Value (Ref => Internal_Result,
121                           Length => Interfaces.C.ptrdiff_t (Count));
122         Result : Gint_Array (1 .. Temp'Length);
123
124      begin
125         for Index in Temp'Range loop
126            Result (Result'First + Index - Temp'First) := Temp (Index);
127         end loop;
128
129         return Result;
130      end;
131   end Query_Depths;
132
133   ------------------------
134   -- Query_Visual_Types --
135   ------------------------
136
137   function Query_Visual_Types return Gdk_Visual_Type_Array is
138      procedure Internal (Visual_Type : out Visual_Type_Ptr.Pointer;
139                          Count : out Gint);
140      pragma Import (C, Internal, "gdk_query_visual_types");
141
142      Internal_Result : Visual_Type_Ptr.Pointer;
143      Count : Gint;
144
145   begin
146      Internal (Internal_Result, Count);
147
148      declare
149         Temp : constant Aliased_Visual_Type_Array :=
150           Visual_Type_Ptr.Value (Ref => Internal_Result,
151                                  Length => Interfaces.C.ptrdiff_t (Count));
152         Result : Gdk_Visual_Type_Array (1 .. Temp'Length);
153
154      begin
155         for Index in Temp'Range loop
156            Result (Result'First + Index - Temp'First) := Temp (Index);
157         end loop;
158
159         return Result;
160      end;
161   end Query_Visual_Types;
162
163end Gdk.Visual;
164