1------------------------------------------------------------------------------
2--                                                                          --
3--      Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet       --
4--                     Copyright (C) 2000-2015, AdaCore                     --
5--                                                                          --
6-- This library is free software;  you can redistribute it and/or modify it --
7-- under terms of the  GNU General Public License  as published by the Free --
8-- Software  Foundation;  either version 3,  or (at your  option) any later --
9-- version. This library is distributed in the hope that it will be useful, --
10-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
12--                                                                          --
13-- As a special exception under Section 7 of GPL version 3, you are granted --
14-- additional permissions described in the GCC Runtime Library Exception,   --
15-- version 3.1, as published by the Free Software Foundation.               --
16--                                                                          --
17-- You should have received a copy of the GNU General Public License and    --
18-- a copy of the GCC Runtime Library Exception along with this program;     --
19-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
20-- <http://www.gnu.org/licenses/>.                                          --
21--                                                                          --
22------------------------------------------------------------------------------
23
24pragma Style_Checks (Off);
25pragma Warnings (Off, "*is already use-visible*");
26with Glib.Type_Conversion_Hooks; use Glib.Type_Conversion_Hooks;
27with Gtkada.Bindings;            use Gtkada.Bindings;
28pragma Warnings(Off);  --  might be unused
29with Interfaces.C.Strings;       use Interfaces.C.Strings;
30pragma Warnings(On);
31
32package body Pango.Font is
33
34   subtype String7 is String (1 .. 7);
35   Style_Map : constant array (Enums.Style) of String7 :=
36     (Enums.Pango_Style_Normal  => "       ",
37      Enums.Pango_Style_Oblique => "Oblique",
38      Enums.Pango_Style_Italic  => "Italic ");
39
40   subtype String10 is String (1 .. 10);
41   Variant_Map : constant array (Enums.Variant) of String10 :=
42     (Enums.Pango_Variant_Normal     => "          ",
43      Enums.Pango_Variant_Small_Caps => "Small-Caps");
44
45   subtype String15 is String (1 .. 15);
46   Stretch_Map : constant array (Enums.Stretch) of String15 :=
47     (Enums.Pango_Stretch_Ultra_Condensed => "Ultra-Condensed",
48      Enums.Pango_Stretch_Extra_Condensed => "Extra-Condensed",
49      Enums.Pango_Stretch_Condensed       => "Condensed      ",
50      Enums.Pango_Stretch_Semi_Condensed  => "Semi-Condensed ",
51      Enums.Pango_Stretch_Normal          => "               ",
52      Enums.Pango_Stretch_Semi_Expanded   => "Semi-Expanded  ",
53      Enums.Pango_Stretch_Expanded        => "Expanded       ",
54      Enums.Pango_Stretch_Extra_Expanded  => "Extra-Expanded ",
55      Enums.Pango_Stretch_Ultra_Expanded  => "Ultra-Expanded ");
56
57   --  Some of the values are not directly supported by pango.
58   --  ??? See fonts.c in pango
59
60   Weight_Map : constant array (Enums.Weight) of String10 :=
61     (Enums.Pango_Weight_Ultralight  => "Light     ",
62      Enums.Pango_Weight_Thin        => "Thin      ",
63      Enums.Pango_Weight_Light       => "Light     ",
64      Enums.Pango_Weight_Normal      => "          ",
65      Enums.Pango_Weight_Book        => "Book      ",
66      Enums.Pango_Weight_Medium      => "Medium    ",
67      Enums.Pango_Weight_Semibold    => "Semi-Bold ",
68      Enums.Pango_Weight_Bold        => "Bold      ",
69      Enums.Pango_Weight_Semilight   => "Semi-Light",
70      Enums.Pango_Weight_Ultrabold   => "Bold      ",
71      Enums.Pango_Weight_Ultraheavy  => "Ultraheavy",
72      Enums.Pango_Weight_Heavy       => "Heavy     ");
73
74   function To_Font_Description
75     (Family_Name : String := "";
76      Style       : Enums.Style := Enums.Pango_Style_Normal;
77      Variant     : Enums.Variant := Enums.Pango_Variant_Normal;
78      Weight      : Enums.Weight := Enums.Pango_Weight_Normal;
79      Stretch     : Enums.Stretch := Enums.Pango_Stretch_Normal;
80      Size        : Gint := 0) return Pango_Font_Description
81   is
82   begin
83      return From_String (Family_Name & " " &
84         Style_Map (Style) & " " &
85         Variant_Map (Variant) &
86         Weight_Map (Weight) & " " &
87         Stretch_Map (Stretch) & Gint'Image (Size));
88   end To_Font_Description;
89
90   function To_Address
91     (F : Pango_Font_Description; Add : System.Address)
92   return System.Address
93   is
94      pragma Unreferenced (Add);
95   begin
96      return F.all'Address;
97   end To_Address;
98
99   ----------
100   -- Free --
101   ----------
102
103   procedure Free (Desc : in out Pango_Font_Description) is
104      procedure Internal (Desc : Pango_Font_Description);
105      pragma Import (C, Internal, "pango_font_description_free");
106
107   begin
108      Internal (Desc);
109      Desc := null;
110   end Free;
111
112   package Type_Conversion_Pango_Font is new Glib.Type_Conversion_Hooks.Hook_Registrator
113     (Font_Get_Type'Access, Pango_Font_Record);
114   pragma Unreferenced (Type_Conversion_Pango_Font);
115
116   -------------
117   -- Gdk_New --
118   -------------
119
120   procedure Gdk_New (Self : out Pango_Font_Description) is
121      function Internal return Pango_Font_Description;
122      pragma Import (C, Internal, "pango_font_description_new");
123   begin
124      Self := Internal;
125   end Gdk_New;
126
127   --------------------------------
128   -- Pango_Font_Description_New --
129   --------------------------------
130
131   function Pango_Font_Description_New return Pango_Font_Description is
132      function Internal return Pango_Font_Description;
133      pragma Import (C, Internal, "pango_font_description_new");
134      Self : Pango_Font_Description;
135   begin
136      Self := Internal;
137      return Self;
138   end Pango_Font_Description_New;
139
140   ------------------
141   -- Better_Match --
142   ------------------
143
144   function Better_Match
145      (Self      : Pango_Font_Description;
146       Old_Match : Pango_Font_Description;
147       New_Match : Pango_Font_Description) return Boolean
148   is
149      function Internal
150         (Self      : Pango_Font_Description;
151          Old_Match : Pango_Font_Description;
152          New_Match : Pango_Font_Description) return Glib.Gboolean;
153      pragma Import (C, Internal, "pango_font_description_better_match");
154   begin
155      return Internal (Self, Old_Match, New_Match) /= 0;
156   end Better_Match;
157
158   --------------
159   -- Describe --
160   --------------
161
162   function Describe
163      (Font : not null access Pango_Font_Record'Class)
164       return Pango_Font_Description
165   is
166      function Internal
167         (Font : System.Address) return Pango_Font_Description;
168      pragma Import (C, Internal, "pango_font_describe");
169   begin
170      return Internal (Get_Object (Font));
171   end Describe;
172
173   ---------------------------------
174   -- Describe_With_Absolute_Size --
175   ---------------------------------
176
177   function Describe_With_Absolute_Size
178      (Font : not null access Pango_Font_Record'Class)
179       return Pango_Font_Description
180   is
181      function Internal
182         (Font : System.Address) return Pango_Font_Description;
183      pragma Import (C, Internal, "pango_font_describe_with_absolute_size");
184   begin
185      return Internal (Get_Object (Font));
186   end Describe_With_Absolute_Size;
187
188   -----------
189   -- Equal --
190   -----------
191
192   function Equal
193      (Self  : Pango_Font_Description;
194       Desc2 : Pango_Font_Description) return Boolean
195   is
196      function Internal
197         (Self  : Pango_Font_Description;
198          Desc2 : Pango_Font_Description) return Glib.Gboolean;
199      pragma Import (C, Internal, "pango_font_description_equal");
200   begin
201      return Internal (Self, Desc2) /= 0;
202   end Equal;
203
204   ----------------
205   -- Get_Family --
206   ----------------
207
208   function Get_Family (Self : Pango_Font_Description) return UTF8_String is
209      function Internal
210         (Self : Pango_Font_Description)
211          return Interfaces.C.Strings.chars_ptr;
212      pragma Import (C, Internal, "pango_font_description_get_family");
213   begin
214      return Gtkada.Bindings.Value_Allowing_Null (Internal (Self));
215   end Get_Family;
216
217   -----------------------
218   -- Get_Glyph_Extents --
219   -----------------------
220
221   procedure Get_Glyph_Extents
222      (Font         : not null access Pango_Font_Record;
223       Glyph        : Pango_Glyph;
224       Ink_Rect     : out Pango_Rectangle;
225       Logical_Rect : out Pango_Rectangle)
226   is
227      procedure Internal
228         (Font         : System.Address;
229          Glyph        : Pango_Glyph;
230          Ink_Rect     : out Pango_Rectangle;
231          Logical_Rect : out Pango_Rectangle);
232      pragma Import (C, Internal, "pango_font_get_glyph_extents");
233   begin
234      Internal (Get_Object (Font), Glyph, Ink_Rect, Logical_Rect);
235   end Get_Glyph_Extents;
236
237   -----------------
238   -- Get_Metrics --
239   -----------------
240
241   function Get_Metrics
242      (Font     : not null access Pango_Font_Record;
243       Language : Pango.Language.Pango_Language := Pango.Language.Null_Pango_Language)
244       return Pango.Font_Metrics.Pango_Font_Metrics
245   is
246      function Internal
247         (Font     : System.Address;
248          Language : System.Address) return System.Address;
249      pragma Import (C, Internal, "pango_font_get_metrics");
250   begin
251      return From_Object (Internal (Get_Object (Font), Get_Object (Language)));
252   end Get_Metrics;
253
254   --------------------------
255   -- Get_Size_Is_Absolute --
256   --------------------------
257
258   function Get_Size_Is_Absolute
259      (Self : Pango_Font_Description) return Boolean
260   is
261      function Internal (Self : Pango_Font_Description) return Glib.Gboolean;
262      pragma Import (C, Internal, "pango_font_description_get_size_is_absolute");
263   begin
264      return Internal (Self) /= 0;
265   end Get_Size_Is_Absolute;
266
267   -----------
268   -- Merge --
269   -----------
270
271   procedure Merge
272      (Self             : Pango_Font_Description;
273       Desc_To_Merge    : Pango_Font_Description;
274       Replace_Existing : Boolean)
275   is
276      procedure Internal
277         (Self             : Pango_Font_Description;
278          Desc_To_Merge    : Pango_Font_Description;
279          Replace_Existing : Glib.Gboolean);
280      pragma Import (C, Internal, "pango_font_description_merge");
281   begin
282      Internal (Self, Desc_To_Merge, Boolean'Pos (Replace_Existing));
283   end Merge;
284
285   ------------------
286   -- Merge_Static --
287   ------------------
288
289   procedure Merge_Static
290      (Self             : Pango_Font_Description;
291       Desc_To_Merge    : Pango_Font_Description;
292       Replace_Existing : Boolean)
293   is
294      procedure Internal
295         (Self             : Pango_Font_Description;
296          Desc_To_Merge    : Pango_Font_Description;
297          Replace_Existing : Glib.Gboolean);
298      pragma Import (C, Internal, "pango_font_description_merge_static");
299   begin
300      Internal (Self, Desc_To_Merge, Boolean'Pos (Replace_Existing));
301   end Merge_Static;
302
303   ----------------
304   -- Set_Family --
305   ----------------
306
307   procedure Set_Family
308      (Self   : Pango_Font_Description;
309       Family : UTF8_String)
310   is
311      procedure Internal
312         (Self   : Pango_Font_Description;
313          Family : Interfaces.C.Strings.chars_ptr);
314      pragma Import (C, Internal, "pango_font_description_set_family");
315      Tmp_Family : Interfaces.C.Strings.chars_ptr := New_String (Family);
316   begin
317      Internal (Self, Tmp_Family);
318      Free (Tmp_Family);
319   end Set_Family;
320
321   -----------------------
322   -- Set_Family_Static --
323   -----------------------
324
325   procedure Set_Family_Static
326      (Self   : Pango_Font_Description;
327       Family : UTF8_String)
328   is
329      procedure Internal
330         (Self   : Pango_Font_Description;
331          Family : Interfaces.C.Strings.chars_ptr);
332      pragma Import (C, Internal, "pango_font_description_set_family_static");
333      Tmp_Family : Interfaces.C.Strings.chars_ptr := New_String (Family);
334   begin
335      Internal (Self, Tmp_Family);
336      Free (Tmp_Family);
337   end Set_Family_Static;
338
339   -----------------
340   -- To_Filename --
341   -----------------
342
343   function To_Filename (Self : Pango_Font_Description) return UTF8_String is
344      function Internal
345         (Self : Pango_Font_Description)
346          return Interfaces.C.Strings.chars_ptr;
347      pragma Import (C, Internal, "pango_font_description_to_filename");
348   begin
349      return Gtkada.Bindings.Value_And_Free (Internal (Self));
350   end To_Filename;
351
352   ---------------
353   -- To_String --
354   ---------------
355
356   function To_String (Self : Pango_Font_Description) return UTF8_String is
357      function Internal
358         (Self : Pango_Font_Description)
359          return Interfaces.C.Strings.chars_ptr;
360      pragma Import (C, Internal, "pango_font_description_to_string");
361   begin
362      return Gtkada.Bindings.Value_And_Free (Internal (Self));
363   end To_String;
364
365   -----------------
366   -- From_String --
367   -----------------
368
369   function From_String (Str : UTF8_String) return Pango_Font_Description is
370      function Internal
371         (Str : Interfaces.C.Strings.chars_ptr)
372          return Pango_Font_Description;
373      pragma Import (C, Internal, "pango_font_description_from_string");
374      Tmp_Str    : Interfaces.C.Strings.chars_ptr := New_String (Str);
375      Tmp_Return : Pango_Font_Description;
376   begin
377      Tmp_Return := Internal (Tmp_Str);
378      Free (Tmp_Str);
379      return Tmp_Return;
380   end From_String;
381
382end Pango.Font;
383