racket/gui win32: fix East Asian font problem
When the theme-specified default font has a localized name, using it as a Pango faily name doesn't work, with the result that text on controls could be truncated. Get a Pango-friendly name by converting a LOGFONT to a Pango font description and getting the name from the font description.
This commit is contained in:
Matthew Flatt
parent
a713ca8a8b
commit
7a9c8e5d40
|
|
@ -1,11 +1,17 @@
|
|||
#lang racket/base
|
||||
(require racket/class
|
||||
racket/draw
|
||||
ffi/unsafe
|
||||
racket/draw/private/local
|
||||
racket/draw/unsafe/pango)
|
||||
racket/draw/unsafe/pango
|
||||
"types.rkt"
|
||||
"utils.rkt")
|
||||
|
||||
(provide
|
||||
(protect-out font->hfont))
|
||||
(protect-out font->hfont
|
||||
logfont->pango-family
|
||||
(struct-out LOGFONTW) _LOGFONTW _LOGFONTW-pointer))
|
||||
|
||||
|
||||
(define display-font-map
|
||||
(pango_win32_font_map_for_display))
|
||||
|
|
@ -35,3 +41,35 @@
|
|||
(begin0
|
||||
(pango_win32_font_cache_load font-cache logfont)
|
||||
(g_free logfont)))))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define-cstruct _LOGFONTW
|
||||
([lfHeight _LONG]
|
||||
[lfWidth _LONG]
|
||||
[lfEscapement _LONG]
|
||||
[lfOrientation _LONG]
|
||||
[lfWeight _LONG]
|
||||
[lfItalic _BYTE]
|
||||
[lfUnderline _BYTE]
|
||||
[lfStrikeOut _BYTE]
|
||||
[lfCharSet _BYTE]
|
||||
[lfOutPrecision _BYTE]
|
||||
[lfClipPrecision _BYTE]
|
||||
[lfQuality _BYTE]
|
||||
[lfPitchAndFamily _BYTE]
|
||||
[lfFaceName (_array _uint16 32)]))
|
||||
|
||||
(define (logfont->pango-family logfontw)
|
||||
(define logfont (malloc _LOGFONTW))
|
||||
(memcpy logfont logfontw (ctype-sizeof _LOGFONTW)) ; bit enough for _LOGFONTA, too
|
||||
(WideCharToMultiByte 0 0
|
||||
(array-ptr (LOGFONTW-lfFaceName logfontw)) 0
|
||||
(array-ptr (LOGFONTW-lfFaceName logfontw)) 32
|
||||
#f #f)
|
||||
(define desc
|
||||
(pango_win32_font_description_from_logfont logfont))
|
||||
(if desc
|
||||
(pango_font_description_get_family desc)
|
||||
;; random fallback:
|
||||
"Arial"))
|
||||
|
|
|
|||
|
|
@ -3,13 +3,13 @@
|
|||
ffi/unsafe/alloc
|
||||
"utils.rkt"
|
||||
"const.rkt"
|
||||
"types.rkt")
|
||||
"types.rkt"
|
||||
"font.rkt")
|
||||
|
||||
(provide
|
||||
(protect-out get-theme-logfont
|
||||
get-theme-font-face
|
||||
get-theme-font-size
|
||||
_LOGFONT-pointer
|
||||
OpenThemeData
|
||||
CloseThemeData
|
||||
DrawThemeParentBackground
|
||||
|
|
@ -19,38 +19,6 @@
|
|||
|
||||
(define _HTHEME (_cpointer 'HTHEME))
|
||||
|
||||
(define-cstruct _FaceName1
|
||||
([c1 _uint16]
|
||||
[c2 _uint16]
|
||||
[c3 _uint16]
|
||||
[c4 _uint16]
|
||||
[c5 _uint16]
|
||||
[c6 _uint16]
|
||||
[c7 _uint16]
|
||||
[c8 _uint16]))
|
||||
|
||||
(define-cstruct _FaceName
|
||||
([f1 _FaceName1]
|
||||
[f2 _FaceName1]
|
||||
[f3 _FaceName1]
|
||||
[f4 _FaceName1]))
|
||||
|
||||
(define-cstruct _LOGFONT
|
||||
([lfHeight _LONG]
|
||||
[lfWidth _LONG]
|
||||
[lfEscapement _LONG]
|
||||
[lfOrientation _LONG]
|
||||
[lfWeight _LONG]
|
||||
[lfItalic _BYTE]
|
||||
[lfUnderline _BYTE]
|
||||
[lfStrikeOut _BYTE]
|
||||
[lfCharSet _BYTE]
|
||||
[lfOutPrecision _BYTE]
|
||||
[lfClipPrecision _BYTE]
|
||||
[lfQuality _BYTE]
|
||||
[lfPitchAndFamily _BYTE]
|
||||
[lfFaceName _FaceName])) ; 32 of them
|
||||
|
||||
(define-uxtheme CloseThemeData (_wfun _HTHEME -> (r : _HRESULT)
|
||||
-> (when (negative? r)
|
||||
(error 'CloseThemeData "failed: ~s" (bitwise-and #xFFFF r))))
|
||||
|
|
@ -59,13 +27,13 @@
|
|||
(define-uxtheme OpenThemeData (_wfun _HWND _string/utf-16 -> (_or-null _HTHEME))
|
||||
#:wrap (allocator maybe-CloseThemeData))
|
||||
|
||||
(define-uxtheme GetThemeFont (_wfun _HTHEME _HDC _int _int _int (f : (_ptr o _LOGFONT))
|
||||
(define-uxtheme GetThemeFont (_wfun _HTHEME _HDC _int _int _int (f : (_ptr o _LOGFONTW))
|
||||
-> (r : _HRESULT)
|
||||
-> (if (negative? r)
|
||||
(error 'GetThemeFont "failed: ~s" (bitwise-and #xFFFF r))
|
||||
f)))
|
||||
|
||||
(define-uxtheme GetThemeSysFont(_wfun (_or-null _HTHEME) _int (f : (_ptr o _LOGFONT))
|
||||
(define-uxtheme GetThemeSysFont(_wfun (_or-null _HTHEME) _int (f : (_ptr o _LOGFONTW))
|
||||
-> (r : _HRESULT)
|
||||
-> (if (negative? r)
|
||||
(error 'GetThemeSysFont "failed: ~s" (bitwise-and #xFFFF r))
|
||||
|
|
@ -98,7 +66,7 @@
|
|||
theme-logfont)
|
||||
|
||||
(define (get-theme-font-face)
|
||||
(cast (LOGFONT-lfFaceName theme-logfont) _pointer _string/utf-16))
|
||||
(cast (array-ptr (LOGFONTW-lfFaceName theme-logfont)) _pointer _string/utf-16))
|
||||
|
||||
(define (get-theme-font-size)
|
||||
(abs (LOGFONT-lfHeight theme-logfont)))
|
||||
(abs (LOGFONTW-lfHeight theme-logfont)))
|
||||
|
|
|
|||
|
|
@ -42,7 +42,8 @@
|
|||
CheckMenuItem
|
||||
ModifyMenuW
|
||||
RemoveMenu
|
||||
SelectObject))
|
||||
SelectObject
|
||||
WideCharToMultiByte))
|
||||
|
||||
(define gdi32-lib (ffi-lib "gdi32.dll"))
|
||||
(define user32-lib (ffi-lib "user32.dll"))
|
||||
|
|
@ -151,3 +152,7 @@
|
|||
-> (unless r (failed 'RemoveMenu))))
|
||||
|
||||
(define-gdi32 SelectObject (_wfun _HDC _pointer -> _pointer))
|
||||
|
||||
(define-kernel32 WideCharToMultiByte (_wfun _UINT _DWORD _pointer _int
|
||||
_pointer _int _pointer _pointer
|
||||
-> _int))
|
||||
|
|
|
|||
|
|
@ -59,7 +59,7 @@
|
|||
(define-user32 ScreenToClient (_wfun _HWND _POINT-pointer -> (r : _BOOL)
|
||||
-> (unless r (failed 'ClientToScreen))))
|
||||
|
||||
(define-gdi32 CreateFontIndirectW (_wfun _LOGFONT-pointer -> _HFONT))
|
||||
(define-gdi32 CreateFontIndirectW (_wfun _LOGFONTW-pointer -> _HFONT))
|
||||
|
||||
(define-shell32 DragAcceptFiles (_wfun _HWND _BOOL -> _void))
|
||||
|
||||
|
|
@ -797,7 +797,8 @@
|
|||
(set! default-control-font
|
||||
(make-object font%
|
||||
(get-theme-font-size)
|
||||
(get-theme-font-face)
|
||||
(logfont->pango-family
|
||||
(get-theme-logfont))
|
||||
'system
|
||||
'normal 'normal #f 'default
|
||||
#t)))
|
||||
|
|
|
|||
|
|
@ -298,6 +298,7 @@
|
|||
(define-pango pango_font_description_set_weight (_pfun PangoFontDescription _int -> _void))
|
||||
(define-pango pango_font_description_set_size (_pfun PangoFontDescription _int -> _void))
|
||||
(define-pango pango_font_description_set_absolute_size (_pfun PangoFontDescription _double* -> _void))
|
||||
(define-pango pango_font_description_get_family (_pfun PangoFontDescription -> _string))
|
||||
|
||||
(define _PangoWin32FontCache (_cpointer 'PangoWin32FontCache))
|
||||
(define _HFONT (_cpointer 'HFONT))
|
||||
|
|
@ -307,6 +308,9 @@
|
|||
(define-pangowin32 pango_win32_font_logfont (_pfun PangoFont -> _LOGFONT-pointer)
|
||||
#:make-fail make-not-available
|
||||
#:wrap (allocator g_free))
|
||||
(define-pangowin32 pango_win32_font_description_from_logfont (_pfun _LOGFONT-pointer -> PangoFontDescription)
|
||||
#:make-fail make-not-available
|
||||
#:wrap (allocator pango_font_description_free))
|
||||
(define-pangowin32 pango_win32_font_cache_unload (_pfun _PangoWin32FontCache _HFONT -> _void)
|
||||
#:make-fail make-not-available)
|
||||
(define-pangowin32 pango_win32_font_cache_load (_pfun _PangoWin32FontCache _LOGFONT-pointer -> _HFONT)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user