From 238d8ea0e8aa4b31e961e13bf496273df5cd2f35 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 6 Jun 2012 06:54:56 +0800 Subject: [PATCH] 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. original commit: 7a9c8e5d404cbbb246ed0ebdc0cf80ed2368be54 --- collects/mred/private/wx/win32/font.rkt | 42 ++++++++++++++++++++-- collects/mred/private/wx/win32/theme.rkt | 44 ++++------------------- collects/mred/private/wx/win32/utils.rkt | 7 +++- collects/mred/private/wx/win32/window.rkt | 5 +-- 4 files changed, 55 insertions(+), 43 deletions(-) diff --git a/collects/mred/private/wx/win32/font.rkt b/collects/mred/private/wx/win32/font.rkt index f3c93056..d71d174a 100644 --- a/collects/mred/private/wx/win32/font.rkt +++ b/collects/mred/private/wx/win32/font.rkt @@ -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")) diff --git a/collects/mred/private/wx/win32/theme.rkt b/collects/mred/private/wx/win32/theme.rkt index 75161fe1..8ba83870 100644 --- a/collects/mred/private/wx/win32/theme.rkt +++ b/collects/mred/private/wx/win32/theme.rkt @@ -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))) diff --git a/collects/mred/private/wx/win32/utils.rkt b/collects/mred/private/wx/win32/utils.rkt index b209ef09..4b4b6060 100644 --- a/collects/mred/private/wx/win32/utils.rkt +++ b/collects/mred/private/wx/win32/utils.rkt @@ -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)) diff --git a/collects/mred/private/wx/win32/window.rkt b/collects/mred/private/wx/win32/window.rkt index 6843c356..e43f2154 100644 --- a/collects/mred/private/wx/win32/window.rkt +++ b/collects/mred/private/wx/win32/window.rkt @@ -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)))