steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

core-text.fonts: making cache-font and cache-font-metrics twice as fast.

db4
John Benediktsson 2012-07-13 15:18:35 -07:00
parent 8b6e3eab62
commit 8350b54bbc
1 changed files with 13 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
basis/core-text/fonts/fonts.factor
View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.syntax assocs core-foundation USING: accessors alien.c-types alien.syntax assocs core-foundation
core-foundation.dictionaries core-foundation.strings core-foundation.dictionaries core-foundation.strings
core-graphics.types destructors init core-graphics.types destructors init kernel locals
kernel math memoize fonts combinators unix.types ; math memoize fonts combinators unix.types ;
IN: core-text.fonts IN: core-text.fonts
TYPEDEF: void* CTFontRef TYPEDEF: void* CTFontRef
@ -85,33 +85,24 @@ CONSTANT: font-names
: font-name ( string -- string' ) : font-name ( string -- string' )
font-names ?at drop ; font-names ?at drop ;
: (bold) ( x -- y ) kCTFontBoldTrait bitor ; inline
: (italic) ( x -- y ) kCTFontItalicTrait bitor ; inline
: font-traits ( font -- n ) : font-traits ( font -- n )
[ 0 ] dip [ 0 ] dip
[ bold?>> [ (bold) ] when ] [ bold?>> [ kCTFontBoldTrait bitor ] when ]
[ italic?>> [ (italic) ] when ] bi ; [ italic?>> [ kCTFontItalicTrait bitor ] when ] bi ;
: apply-font-traits ( font style -- font' ) MEMO:: (cache-font) ( name size traits -- open-font )
[ drop ] [ [ 0.0 f ] dip font-traits dup ] 2bi
CTFontCreateCopyWithSymbolicTraits
dup [ [ CFRelease ] dip ] [ drop ] if ;
MEMO: (cache-font) ( font -- open-font )
[ [
[ name font-name <CFString> &CFRelease
[ name>> font-name <CFString> &CFRelease ] [ size>> ] bi size f CTFontCreateWithName dup
f CTFontCreateWithName 0.0 f traits dup CTFontCreateCopyWithSymbolicTraits
] keep apply-font-traits [ [ CFRelease ] dip ] when*
] with-destructors ; ] with-destructors ;
: cache-font ( font -- open-font ) : cache-font ( font -- open-font )
strip-font-colors (cache-font) ; [ name>> ] [ size>> ] [ font-traits ] tri (cache-font) ;
MEMO: (cache-font-metrics) ( font -- metrics ) MEMO: (cache-font-metrics) ( name size traits -- metrics )
[ metrics new ] dip [ metrics new ] 3dip
(cache-font) { (cache-font) {
[ CTFontGetAscent >>ascent ] [ CTFontGetAscent >>ascent ]
[ CTFontGetDescent >>descent ] [ CTFontGetDescent >>descent ]
@ -122,7 +113,7 @@ MEMO: (cache-font-metrics) ( font -- metrics )
compute-height ; compute-height ;
: cache-font-metrics ( font -- metrics ) : cache-font-metrics ( font -- metrics )
strip-font-colors (cache-font-metrics) ; [ name>> ] [ size>> ] [ font-traits ] tri (cache-font-metrics) ;
[ [
\ (cache-font) reset-memoized \ (cache-font) reset-memoized