From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 20 Sep 2012 19:13:52 +0000 (-0700)
Subject: windows.fonts: speed up cached fonts.
X-Git-Tag: 0.97~2357
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=3470492e21c441f5fdbf073a696fd69cddedd49f

windows.fonts: speed up cached fonts.
---

diff --git a/basis/windows/fonts/fonts.factor b/basis/windows/fonts/fonts.factor
index 65a08ce3c7..700f4c42d5 100644
--- 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,11 +31,13 @@ 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