25 lines
689 B
Racket
25 lines
689 B
Racket
#lang racket/base
|
|
(require racket/class
|
|
racket/draw/private/local
|
|
racket/draw/unsafe/pango)
|
|
|
|
(provide
|
|
(protect-out font->hfont))
|
|
|
|
(define display-font-map
|
|
(pango_win32_font_map_for_display))
|
|
|
|
(define display-context
|
|
(pango_font_map_create_context display-font-map))
|
|
|
|
(define font-cache (pango_win32_font_cache_new))
|
|
|
|
(define (font->hfont f)
|
|
(let* ([pfont (pango_font_map_load_font display-font-map
|
|
display-context
|
|
(send f get-pango))]
|
|
[logfont (pango_win32_font_logfont pfont)])
|
|
(begin0
|
|
(pango_win32_font_cache_load font-cache logfont)
|
|
(g_free logfont))))
|