1-----------------------------------------------------------------------
2--              GtkAda - Ada95 binding for Gtk+/Gnome                --
3--                                                                   --
4--                  Copyright (C) 2001-2013, AdaCore                 --
5--                                                                   --
6-- This library is free software; you can redistribute it and/or     --
7-- modify it under the terms of the GNU General Public               --
8-- License as published by the Free Software Foundation; either      --
9-- version 2 of the License, or (at your option) any later version.  --
10--                                                                   --
11-- This library is distributed in the hope that it will be useful,   --
12-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
13-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
14-- General Public License for more details.                          --
15--                                                                   --
16-- You should have received a copy of the GNU General Public         --
17-- License along with this library; if not, write to the             --
18-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
19-- Boston, MA 02111-1307, USA.                                       --
20--                                                                   --
21-- As a special exception, if other files instantiate generics from  --
22-- this unit, or you link this unit with other files to produce an   --
23-- executable, this  unit  does not  by itself cause  the resulting  --
24-- executable to be covered by the GNU General Public License. This  --
25-- exception does not however invalidate any other reasons why the   --
26-- executable file  might be covered by the  GNU Public License.     --
27-----------------------------------------------------------------------
28
29with Interfaces.C.Strings;
30with Glib.Object; use Glib.Object;
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   subtype String9 is String (1 .. 9);
61   Weight_Map : constant array (Enums.Weight) of String9 :=
62     (Enums.Pango_Weight_Ultralight  => "Light    ",
63      Enums.Pango_Weight_Light       => "Light    ",
64      Enums.Pango_Weight_Normal      => "         ",
65      Enums.Pango_Weight_Medium      => "Medium   ",
66      Enums.Pango_Weight_Semi_Bold   => "Semi-Bold",
67      Enums.Pango_Weight_Bold        => "Bold     ",
68      Enums.Pango_Weight_Ultrabold   => "Bold     ",
69      Enums.Pango_Weight_Heavy       => "Heavy    ");
70
71   procedure g_free (c_str : Interfaces.C.Strings.chars_ptr);
72   pragma Import (C, g_free, "g_free");
73
74   -----------
75   -- Equal --
76   -----------
77
78   function Equal
79     (Desc1 : Pango_Font_Description;
80      Desc2 : Pango_Font_Description) return Boolean
81   is
82      function Internal
83        (Desc1 : Pango_Font_Description;
84         Desc2 : Pango_Font_Description) return Gboolean;
85      pragma Import (C, Internal, "pango_font_description_equal");
86
87   begin
88      return Boolean'Val (Internal (Desc1, Desc2));
89   end Equal;
90
91   ----------
92   -- Free --
93   ----------
94
95   procedure Free (Desc : in out Pango_Font_Description) is
96      procedure Internal (Desc : Pango_Font_Description);
97      pragma Import (C, Internal, "pango_font_description_free");
98
99   begin
100      Internal (Desc);
101      Desc := null;
102   end Free;
103
104   -----------------
105   -- From_String --
106   -----------------
107
108   function From_String (Str : String) return Pango_Font_Description is
109      function Internal (Str : String) return Pango_Font_Description;
110      pragma Import (C, Internal, "pango_font_description_from_string");
111
112   begin
113      return Internal (Str & ASCII.NUL);
114   end From_String;
115
116   ------------------------
117   -- To_Font_Decription --
118   ------------------------
119
120   function To_Font_Description
121     (Family_Name : String := "";
122      Style       : Enums.Style := Enums.Pango_Style_Normal;
123      Variant     : Enums.Variant := Enums.Pango_Variant_Normal;
124      Weight      : Enums.Weight := Enums.Pango_Weight_Normal;
125      Stretch     : Enums.Stretch := Enums.Pango_Stretch_Normal;
126      Size        : Gint := 0) return Pango_Font_Description
127   is
128      Result : constant Pango_Font_Description :=
129        From_String (Family_Name & " " &
130                     Style_Map (Style) & " " &
131                     Variant_Map (Variant) &
132                     Weight_Map (Weight) & " " &
133                     Stretch_Map (Stretch) & Gint'Image (Size));
134   begin
135      return Result;
136   end To_Font_Description;
137
138   ---------------
139   -- To_String --
140   ---------------
141
142   function To_String (Desc : Pango_Font_Description) return String is
143      function Internal
144        (Desc : Pango_Font_Description) return Interfaces.C.Strings.chars_ptr;
145      pragma Import (C, Internal, "pango_font_description_to_string");
146
147      C_Result : constant Interfaces.C.Strings.chars_ptr := Internal (Desc);
148      Result   : constant String := Interfaces.C.Strings.Value (C_Result);
149
150   begin
151      g_free (C_Result);
152      return Result;
153   end To_String;
154
155   -----------------
156   -- To_Filename --
157   -----------------
158
159   function To_Filename (Desc : Pango_Font_Description) return String is
160      function Internal
161        (Desc : Pango_Font_Description) return Interfaces.C.Strings.chars_ptr;
162      pragma Import (C, Internal, "pango_font_description_to_filename");
163
164      C_Result : constant Interfaces.C.Strings.chars_ptr := Internal (Desc);
165      Result   : constant String := Interfaces.C.Strings.Value (C_Result);
166
167   begin
168      g_free (C_Result);
169      return Result;
170   end To_Filename;
171
172   ----------------
173   -- Get_Family --
174   ----------------
175
176   function Get_Family (Desc : Pango_Font_Description) return String is
177      function Internal
178        (Desc : Pango_Font_Description) return Interfaces.C.Strings.chars_ptr;
179      pragma Import (C, Internal, "pango_font_description_get_family");
180
181   begin
182      return Interfaces.C.Strings.Value (Internal (Desc));
183   end Get_Family;
184
185   ----------------
186   -- Set_Family --
187   ----------------
188
189   procedure Set_Family
190     (Desc : Pango_Font_Description;
191      Name : String)
192   is
193      procedure Internal
194        (Desc : Pango_Font_Description;
195         Name : String);
196      pragma Import (C, Internal, "pango_font_description_set_family");
197
198   begin
199      Internal (Desc, Name & ASCII.NUL);
200   end Set_Family;
201
202   -----------------
203   -- From_String --
204   -----------------
205
206   function From_String (Language : String) return Pango_Language is
207      function Internal (Language : String) return Pango_Language;
208      pragma Import (C, Internal, "pango_language_from_string");
209   begin
210      return Internal (Language & ASCII.NUL);
211   end From_String;
212
213   -----------------
214   -- Get_Metrics --
215   -----------------
216
217   function Get_Metrics
218     (Font : access Pango_Font_Record'Class;
219      Language : Pango_Language := null) return Pango_Font_Metrics
220   is
221      function Internal (Font : System.Address; Lang : Pango_Language)
222         return Pango_Font_Metrics;
223      pragma Import (C, Internal, "pango_font_get_metrics");
224   begin
225      return Internal (Get_Object (Font), Language);
226   end Get_Metrics;
227
228   ----------------
229   -- To_Address --
230   ----------------
231
232   function To_Address
233     (F : Pango_Font_Description; Add : System.Address)
234      return System.Address
235   is
236      pragma Unreferenced (Add);
237   begin
238      return F.all'Address;
239   end To_Address;
240
241end Pango.Font;
242