Fixes #2966

[factor.git] / basis / windows / fonts / fonts.factor

diff --git a/basis/windows/fonts/fonts.factor b/basis/windows/fonts/fonts.factor
old mode 100755 (executable)
new mode 100644 (file)
index 65a08ce..8b09cd2
--- a/basis/windows/fonts/fonts.factor
+++ b/basis/windows/fonts/fonts.factor
@@ -19,11 +19,11 @@ MEMO: windows-fonts ( -- fonts )
 : 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
@@ -31,13 +31,18 @@ MEMO:: (cache-font) ( font -- HFONT )
     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
+STARTUP-HOOK: [
+    \ (cache-font) reset-memoized
+    \ windows-fonts reset-memoized
+]
 
 : TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
     [ metrics new 0 >>width ] dip {