1#lang racket/base 2(require ffi/unsafe 3 ffi/unsafe/define 4 ffi/unsafe/alloc 5 "glib.rkt" 6 "cairo.rkt" 7 "../private/utils.rkt" 8 "../private/libs.rkt") 9 10(define-runtime-lib pango-lib 11 [(unix) (ffi-lib "libpango-1.0" '("0" ""))] 12 [(macosx) 13 (ffi-lib "libfribidi.0.dylib") 14 (ffi-lib "libpango-1.0.0.dylib")] 15 [(windows) 16 (ffi-lib "libfribidi-0.dll") 17 (ffi-lib "libpango-1.0-0.dll")]) 18 19(define-runtime-lib pangowin32-lib 20 [(unix) #f] 21 [(macosx)] 22 [(windows) 23 (ffi-lib "libpangowin32-1.0-0.dll")]) 24 25(define-runtime-lib pangocairo-lib 26 [(unix) (ffi-lib "libpangocairo-1.0" '("0" ""))] 27 [(macosx) 28 (ffi-lib "libharfbuzz.0.dylib") 29 (ffi-lib "libpangoft2-1.0.0.dylib") 30 (ffi-lib "libpangocairo-1.0.0.dylib")] 31 [(windows) 32 (ffi-lib "libiconv-2.dll") 33 (ffi-lib "libintl-9.dll") 34 (ffi-lib "libpangowin32-1.0-0.dll") 35 (ffi-lib "libexpat-1.dll") 36 (ffi-lib "libfreetype-6.dll") 37 (ffi-lib "libfontconfig-1.dll") 38 (ffi-lib "libharfbuzz-0.dll") 39 (ffi-lib "libpangoft2-1.0-0.dll") 40 (ffi-lib "libpangocairo-1.0-0.dll")]) 41 42(define-ffi-definer define-pango pango-lib 43 #:provide provide) 44(define-ffi-definer define-pangocairo pangocairo-lib 45 #:provide provide) 46(define-ffi-definer define-pangowin32 pangowin32-lib 47 #:provide provide) 48 49;; ALLOCATION NOTE: since Pango calls into Cairo, it has the same 50;; allocation constraints on arguments as Cairo functions; see 51;; "cairo.rkt". 52 53(define PangoContext (_cpointer 'PangoContext)) 54(define PangoLayout (_cpointer 'PangoLayout)) 55(define PangoFontDescription (_cpointer 'PangoFontDescription)) 56(define PangoFontFamily (_cpointer 'PangoFontFamily)) 57(define PangoFontFace (_cpointer 'PangoFontFace)) 58(define PangoFont (_cpointer 'PangoFont)) 59(define PangoFontMap (_cpointer 'PangoFontMap)) 60(define PangoFontMetrics (_cpointer 'PangoFontMetrics)) 61(define PangoAttrList (_cpointer 'PangoAttrList)) 62(define PangoAttribute (_cpointer 'PangoAttribute)) 63(define PangoLanguage (_cpointer 'PangoLanguage)) 64(define PangoCoverage (_cpointer 'PangoCoverage)) 65(define PangoLayoutIter (_cpointer 'PangoLayoutIter)) 66(define PangoLayoutLine (_cpointer 'PangoLayoutLine)) 67 68(define-cstruct _PangoRectangle ([x _int] 69 [y _int] 70 [width _int] 71 [height _int]) 72 #:malloc-mode 'atomic-interior) 73(provide make-PangoRectangle 74 PangoRectangle-x 75 PangoRectangle-y 76 PangoRectangle-width 77 PangoRectangle-height) 78 79(define-cstruct _PangoItem 80 ([offset _int] 81 [length _int] 82 [num_chars _int] 83 ;; Inline PangoAnalysis: 84 [shape_engine _pointer] 85 [lang_engine _pointer] 86 [font (_or-null PangoFont)] 87 [level _uint8] 88 [gravity _uint8] 89 [flags _uint8] 90 [script _uint8] 91 [language _pointer] 92 [extra_attrs _pointer])) 93 94(provide (struct-out PangoItem) 95 _PangoItem _PangoItem-pointer) 96 97(define-cstruct _PangoGlyphInfo 98 ([glyph _uint32] 99 [width _uint32] 100 [dx _uint32] 101 [dy _uint32] 102 [is_cluster_start _uint])) 103 104(provide (struct-out PangoGlyphInfo) 105 _PangoGlyphInfo _PangoGlyphInfo-pointer) 106 107(define-cstruct _PangoGlyphString 108 ([num_glyphs _int] 109 [glyphs _pointer] 110 [log_clusters _pointer]) 111 #:malloc-mode 'atomic-interior) 112 113(provide (struct-out PangoGlyphString) 114 _PangoGlyphString) 115 116(define-cstruct _PangoGlyphItem ([item _PangoItem-pointer] 117 [glyphs _PangoGlyphString-pointer])) 118(provide (struct-out PangoGlyphItem)) 119 120;; As of Pango 1.28, Pango is not thread-safe at the C level, which 121;; means that it isn't place-safe in Racket. Use the same lock as 122;; for Cairo, if any, since Pango calls Cairo. 123(define-syntax-rule (_pfun spec ...) 124 (_fun #:lock-name (or cairo-lock-name "pango-lock") spec ...)) 125 126(provide g_object_unref g_free) 127(define-gobj g_object_unref (_pfun _pointer -> _void) 128 #:wrap (deallocator)) 129(define-glib g_free (_pfun _pointer -> _void) 130 #:wrap (deallocator)) 131 132;; For working around a Win32 Pango bug (see `unref-font-map'): 133(define _GQueue (_cpointer 'GQueue)) 134(define-cstruct _PangoWin32FontMap ([type-instance _pointer] 135 [ref_count _uint] 136 [qdata _pointer] 137 [font_cache _pointer] 138 [freed_fonts _GQueue])) 139(define-glib g_queue_foreach (_pfun _GQueue _fpointer #;(_fun _pointer -> _void) _pointer -> _void)) 140(define-glib g_queue_free (_pfun _GQueue -> _void)) 141(define-glib g_queue_new (_pfun -> _GQueue)) 142(define-gobj raw_g_object_unref _fpointer #:c-id g_object_unref) 143 144(define-pangocairo pango_cairo_font_map_get_default (_pfun -> PangoFontMap)) ;; not an allocator 145(define-pangocairo pango_cairo_font_map_new (_pfun -> PangoFontMap) 146 #:wrap (allocator g_object_unref)) 147(define-pangocairo pango_cairo_font_map_get_resolution (_pfun PangoFontMap -> _double) 148 #:fail (lambda () (lambda (fm) 96.0))) 149 150;; A hook added by our patch (for Mac OS only): 151(define-pangocairo pango_core_text_add_family_for_font_descriptors 152 (_pfun PangoFontMap _string _int (_vector i _pointer) -> _void) 153 #:fail (lambda () (lambda (fm nm n decs) (void)))) 154 155(define-pango pango_context_new (_pfun -> PangoContext) 156 #:wrap (allocator g_object_unref)) 157;; pango_font_map_create_context() is in 1.22 and later 158(provide pango_font_map_create_context) 159(define (pango_font_map_create_context fm) 160 (let ([c (pango_context_new)]) 161 (pango_context_set_font_map c fm) 162 c)) 163(define-pangocairo pango_cairo_update_context (_pfun _cairo_t PangoContext -> _void)) 164 165;; The convenince function pango_cairo_create_context() is in 1.22 and later 166(provide pango_cairo_create_context) 167(define (pango_cairo_create_context cr) 168 (let ([ctx (pango_font_map_create_context 169 (pango_cairo_font_map_get_default))]) 170 (pango_cairo_update_context cr ctx) 171 ctx)) 172 173(define-pangocairo pango_cairo_create_layout (_pfun _cairo_t -> PangoLayout) 174 #:wrap (allocator g_object_unref)) 175(define-pangocairo pango_cairo_update_layout (_pfun _cairo_t PangoLayout -> _void)) 176(define-pango pango_layout_set_text (_pfun PangoLayout [s : _string] [_int = -1] -> _void)) 177(define-pangocairo pango_cairo_show_layout (_pfun _cairo_t PangoLayout -> _void)) 178(define-pangocairo pango_cairo_show_layout_line (_pfun _cairo_t PangoLayoutLine -> _void)) 179(define-pangocairo pango_cairo_show_glyph_string (_pfun _cairo_t PangoFont _PangoGlyphString-pointer -> _void)) 180(define-pangocairo pango_cairo_layout_line_path (_pfun _cairo_t PangoLayoutLine -> _void)) 181 182(define-pango pango_layout_iter_free (_pfun PangoLayoutIter -> _void) 183 #:wrap (deallocator)) 184(define-pango pango_layout_get_iter (_pfun PangoLayout -> PangoLayoutIter) 185 #:wrap (allocator pango_layout_iter_free)) 186(define-pango pango_layout_iter_get_baseline (_pfun PangoLayoutIter -> _int)) 187(define-pango pango_layout_iter_next_run (_pfun PangoLayoutIter -> _bool)) 188(define-pango pango_layout_iter_get_run (_pfun PangoLayoutIter -> (_or-null _PangoGlyphItem-pointer))) 189(define-pango pango_layout_iter_get_run_readonly (_pfun PangoLayoutIter -> (_or-null _PangoGlyphItem-pointer)) 190 #:fail (lambda () pango_layout_iter_get_run)) 191 192(define-pango pango_layout_get_line (_pfun PangoLayout _int -> PangoLayoutLine)) 193(define-pango pango_layout_get_line_readonly (_pfun PangoLayout _int -> PangoLayoutLine) 194 #:fail (lambda () pango_layout_get_line)) 195 196(define-pango pango_layout_get_context (_pfun PangoLayout -> PangoContext)) ;; not an allocator 197(define-pango pango_layout_get_extents (_pfun PangoLayout _pointer _PangoRectangle-pointer -> _void)) 198(define-pango pango_layout_get_baseline (_pfun PangoLayout -> _int) 199 ;; The convenince function pango_layout_get_baseline() is in 1.22 and later 200 #:fail (lambda () 201 (lambda (layout) 202 (let ([iter (pango_layout_get_iter layout)]) 203 (begin0 204 (pango_layout_iter_get_baseline iter) 205 (pango_layout_iter_free iter)))))) 206(define-pango pango_layout_get_spacing (_pfun PangoLayout -> _int)) 207 208(define-pango pango_layout_new (_pfun PangoContext -> PangoLayout) 209 #:wrap (allocator g_object_unref)) 210 211(define-pangocairo pango_cairo_context_get_font_options (_pfun PangoContext -> _cairo_font_options_t)) ;; not an allocator 212(define-pangocairo pango_cairo_context_set_font_options (_pfun PangoContext _cairo_font_options_t -> _void)) ;; makes a copy 213 214(define-pango pango_layout_set_font_description (_pfun PangoLayout PangoFontDescription -> _void)) ;; makes a copy 215(define-pango pango_context_get_font_map (_pfun PangoContext -> PangoFontMap)) ;; not an allocator 216(define-pango pango_context_set_font_map (_pfun PangoContext PangoFontMap -> _void)) 217(define-pango pango_font_family_get_name (_pfun PangoFontFamily -> _string)) ;; not an allocator 218(define-pango pango_font_family_is_monospace (_pfun PangoFontFamily -> _bool)) 219 220(define-pango pango_language_get_default (_pfun -> PangoLanguage) 221 ;; not available before 1.16 222 #:fail (lambda () (lambda () #f))) 223(define-pango pango_font_map_load_font (_pfun PangoFontMap PangoContext PangoFontDescription -> (_or-null PangoFont))) 224(define-pango pango_coverage_unref (_pfun PangoCoverage -> _void) 225 #:wrap (deallocator)) 226(define-pango pango_font_get_coverage (_pfun PangoFont PangoLanguage -> PangoCoverage) 227 #:wrap (allocator pango_coverage_unref)) 228(define-pango pango_coverage_get (_pfun PangoCoverage _int -> _int)) 229 230(define-pango pango_font_metrics_unref (_pfun PangoFontMetrics -> _void) 231 #:wrap (deallocator)) 232(define-pango pango_font_get_metrics (_pfun PangoFont (_or-null PangoLanguage) -> PangoFontMetrics) 233 #:wrap (allocator pango_font_metrics_unref)) 234(define-pango pango_font_metrics_get_approximate_char_width (_pfun PangoFontMetrics -> _int)) 235(define-pango pango_font_metrics_get_ascent (_pfun PangoFontMetrics -> _int)) 236(define-pango pango_font_metrics_get_descent (_pfun PangoFontMetrics -> _int)) 237 238(define-pango pango_layout_get_unknown_glyphs_count (_pfun PangoLayout -> _int) 239 ;; not available in old versions: 240 #:fail (lambda () (lambda (lo) 0))) 241 242(define-pango pango_attr_list_unref (_pfun PangoAttrList -> _void) 243 #:wrap (deallocator)) 244(define-pango pango_attr_list_new (_pfun -> PangoAttrList) 245 #:wrap (allocator pango_attr_list_unref)) 246(define-pango pango_attr_list_insert (_pfun PangoAttrList PangoAttribute -> _void) 247 ;; takes ownership of the attribute 248 #:wrap (deallocator cadr)) 249 250(define-pango pango_attribute_destroy (_pfun PangoAttribute -> _void) 251 #:wrap (deallocator)) 252(define-pango pango_attr_underline_new (_pfun _int -> PangoAttribute) 253 #:wrap (allocator pango_attribute_destroy)) 254(define-pango pango_attr_fallback_new (_pfun _bool -> PangoAttribute) 255 #:wrap (allocator pango_attribute_destroy)) 256 257(define-pango pango_attr_foreground_new (_pfun _uint16 _uint16 _uint16 -> PangoAttribute) 258 #:wrap (allocator pango_attribute_destroy)) 259(define-pango pango_attr_foreground_alpha_new (_pfun _uint16 -> PangoAttribute) 260 #:wrap (allocator pango_attribute_destroy) 261 #:fail (lambda () (lambda (alpha) #f))) 262 263(define-pango pango_layout_set_attributes (_pfun PangoLayout PangoAttrList -> _void)) 264 265(define-pango pango_font_map_list_families (_pfun PangoFontMap 266 (fams : (_ptr o _pointer)) 267 (len : (_ptr o _int)) 268 -> _void 269 -> (begin0 270 (for/list ([i (in-range len)]) 271 (ptr-ref fams PangoFontFamily i)) 272 (g_free fams)))) 273(define-pango pango_font_family_list_faces (_pfun PangoFontFamily 274 (faces : (_ptr o _pointer)) 275 (len : (_ptr o _int)) 276 -> _void 277 -> (begin0 278 (for/list ([i (in-range len)]) 279 (ptr-ref faces PangoFontFace i)) 280 (g_free faces)))) 281(define-pango pango_font_face_get_face_name (_pfun PangoFontFace -> _string)) 282 283(define-pango pango_font_description_free (_pfun PangoFontDescription -> _void) 284 #:wrap (deallocator)) 285(define-pango pango_font_description_new (_pfun -> PangoFontDescription) 286 #:wrap (allocator pango_font_description_free)) 287(define-pango pango_font_description_from_string (_pfun _string -> PangoFontDescription) 288 #:wrap (allocator pango_font_description_free)) 289(define-pango pango_font_description_set_family (_pfun PangoFontDescription _string -> _void)) 290(define-pango pango_font_description_set_style (_pfun PangoFontDescription _int -> _void)) 291(define-pango pango_font_description_set_weight (_pfun PangoFontDescription _int -> _void)) 292(define-pango pango_font_description_set_size (_pfun PangoFontDescription _int -> _void)) 293(define-pango pango_font_description_set_absolute_size (_pfun PangoFontDescription _double* -> _void)) 294(define-pango pango_font_description_get_family (_pfun PangoFontDescription -> _string)) 295 296(define-pango pango_font_description_to_string/ptr (_pfun PangoFontDescription -> _pointer) 297 #:c-id pango_font_description_to_string 298 #:wrap (allocator g_free)) 299(define (pango_font_description_to_string desc) 300 (cast (pango_font_description_to_string/ptr desc) _pointer _string)) 301(provide pango_font_description_to_string) 302 303(define-pango pango_font_face_describe (_pfun PangoFontFace -> PangoFontDescription) 304 #:wrap (allocator pango_font_description_free)) 305 306(define _PangoWin32FontCache (_cpointer 'PangoWin32FontCache)) 307(define _HFONT (_cpointer 'HFONT)) 308(define _LOGFONT-pointer _pointer) 309(define-pangowin32 pango_win32_font_map_for_display (_pfun -> PangoFontMap) 310 #:make-fail make-not-available) 311(define-pangowin32 pango_win32_font_logfont (_pfun PangoFont -> _LOGFONT-pointer) 312 #:make-fail make-not-available 313 #:wrap (allocator g_free)) 314(define-pangowin32 pango_win32_font_description_from_logfont (_pfun _LOGFONT-pointer -> PangoFontDescription) 315 #:make-fail make-not-available 316 #:wrap (allocator pango_font_description_free)) 317(define-pangowin32 pango_win32_font_cache_unload (_pfun _PangoWin32FontCache _HFONT -> _void) 318 #:make-fail make-not-available) 319(define-pangowin32 pango_win32_font_cache_load (_pfun _PangoWin32FontCache _LOGFONT-pointer -> _HFONT) 320 #:make-fail make-not-available) 321(define-pangowin32 pango_win32_font_cache_new (_pfun -> _PangoWin32FontCache) 322 #:make-fail make-not-available) 323 324(define-enum 325 0 326 PANGO_STYLE_NORMAL 327 PANGO_STYLE_OBLIQUE 328 PANGO_STYLE_ITALIC) 329 330(define-enum 331 0 332 PANGO_UNDERLINE_NONE 333 PANGO_UNDERLINE_SINGLE 334 PANGO_UNDERLINE_DOUBLE 335 PANGO_UNDERLINE_LOW 336 PANGO_UNDERLINE_ERROR) 337 338(define/provide PANGO_WEIGHT_THIN 100) 339(define/provide PANGO_WEIGHT_ULTRALIGHT 200) 340(define/provide PANGO_WEIGHT_LIGHT 300) 341(define/provide PANGO_WEIGHT_SEMILIGHT 350) 342(define/provide PANGO_WEIGHT_BOOK 380) 343(define/provide PANGO_WEIGHT_NORMAL 400) 344(define/provide PANGO_WEIGHT_MEDIUM 500) 345(define/provide PANGO_WEIGHT_SEMIBOLD 600) 346(define/provide PANGO_WEIGHT_BOLD 700) 347(define/provide PANGO_WEIGHT_ULTRABOLD 800) 348(define/provide PANGO_WEIGHT_HEAVY 900) 349(define/provide PANGO_WEIGHT_ULTRAHEAVY 1000) 350 351(define/provide PANGO_SCALE 1024) 352