     compute-height ;
 
 : cache-font-metrics ( font -- metrics )
-    strip-font-colors (cache-font-metrics) ;
+    [ name>> ] [ size>> ] [ font-traits ] tri (cache-font-metrics) ;
 
 [
     \ (cache-font) reset-memoized

: font-name ( string -- string' )
    font-names ?at drop ;

: (bold) ( x -- y ) kCTFontBoldTrait bitor ; inline

: (italic) ( x -- y ) kCTFontItalicTrait bitor ; inline

: font-traits ( font -- n )
    [ 0 ] dip
    [ bold?>> [ (bold) ] when ]
    [ italic?>> [ (italic) ] when ] bi ;

: apply-font-traits ( font style -- 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 ] [ size>> ] bi
            f CTFontCreateWithName
        ] keep apply-font-traits
    ] with-destructors ;

: cache-font ( font -- open-font )
    strip-font-colors (cache-font) ;

MEMO: (cache-font-metrics) ( font -- metrics )
    [ metrics new ] dip
    (cache-font) {
        [ CTFontGetAscent >>ascent ]
        [ CTFontGetDescent >>descent ]

! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.syntax assocs core-foundation
core-foundation.dictionaries core-foundation.strings
core-graphics.types destructors init kernel locals
math memoize fonts combinators unix.types ;
IN: core-text.fonts

TYPEDEF: void* CTFontRef
