USING: assocs memoize locals kernel accessors init fonts math
-combinators windows.errors windows.types windows.gdi32 ;
+combinators system-info.windows windows.errors windows.types
+windows.gdi32 ;
IN: windows.fonts
-: windows-font-name ( string -- string' )
+MEMO: windows-fonts ( -- fonts )
+ windows-major 6 >=
+ H{
+ { "sans-serif" "Segoe UI" }
+ { "serif" "Cambria" }
+ { "monospace" "Consolas" }
+ }
H{
{ "sans-serif" "Tahoma" }
{ "serif" "Times New Roman" }
{ "monospace" "Courier New" }
- } ?at drop ;
+ } ? ;
+
+: windows-font-name ( string -- string' )
+ windows-fonts ?at drop ;
-MEMO:: (cache-font) ( font -- HFONT )
- font size>> neg ! nHeight
+MEMO:: (cache-font) ( name size bold? italic? -- HFONT )
+ size neg ! nHeight
0 0 0 ! nWidth, nEscapement, nOrientation
- font bold?>> FW_BOLD FW_NORMAL ? ! fnWeight
- font italic?>> TRUE FALSE ? ! fdwItalic
+ bold? FW_BOLD FW_NORMAL ? ! fnWeight
+ italic? TRUE FALSE ? ! fdwItalic
FALSE ! fdwUnderline
FALSE ! fdWStrikeOut
DEFAULT_CHARSET ! fdwCharSet
CLIP_DEFAULT_PRECIS ! fdwClipPrecision
DEFAULT_QUALITY ! fdwQuality
DEFAULT_PITCH ! fdwPitchAndFamily
- font name>> windows-font-name
+ name windows-font-name
CreateFont
dup win32-error=0/f ;
-: cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;
+: cache-font ( font -- HFONT )
+ { [ name>> ] [ size>> ] [ bold?>> ] [ italic?>> ] } cleave
+ (cache-font) ;
-[ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook
+[
+ \ (cache-font) reset-memoized
+ \ windows-fonts reset-memoized
+] "windows.fonts" add-startup-hook
: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
[ metrics new 0 >>width ] dip {