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