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