: 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-startup-hook
+[
+ \ (cache-font) reset-memoized
+ \ windows-fonts reset-memoized
+] "windows.fonts" add-startup-hook
: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
[ metrics new 0 >>width ] dip {