]> gitweb.factorcode.org Git - factor.git/commitdiff
windows.fonts: speed up cached fonts.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 20 Sep 2012 19:13:52 +0000 (12:13 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 20 Sep 2012 19:14:44 +0000 (12:14 -0700)
basis/windows/fonts/fonts.factor

index 65a08ce3c7e7fa35db00ecf14fbc8e3965614b6e..700f4c42d599037032b7ebb184423f1e1c7adff9 100644 (file)
@@ -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