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