1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.syntax assocs core-foundation
4 core-foundation.strings core-text.utilities destructors init
5 kernel math memoize fonts combinators ;
8 TYPEDEF: void* CTFontRef
9 TYPEDEF: void* CTFontDescriptorRef
11 ! CTFontSymbolicTraits
12 : kCTFontItalicTrait ( -- n ) 0 2^ ; inline
13 : kCTFontBoldTrait ( -- n ) 1 2^ ; inline
14 : kCTFontExpandedTrait ( -- n ) 5 2^ ; inline
15 : kCTFontCondensedTrait ( -- n ) 6 2^ ; inline
16 : kCTFontMonoSpaceTrait ( -- n ) 10 2^ ; inline
17 : kCTFontVerticalTrait ( -- n ) 11 2^ ; inline
18 : kCTFontUIOptimizedTrait ( -- n ) 12 2^ ; inline
20 C-GLOBAL: kCTFontSymbolicTrait
21 C-GLOBAL: kCTFontWeightTrait
22 C-GLOBAL: kCTFontWidthTrait
23 C-GLOBAL: kCTFontSlantTrait
25 C-GLOBAL: kCTFontNameAttribute
26 C-GLOBAL: kCTFontDisplayNameAttribute
27 C-GLOBAL: kCTFontFamilyNameAttribute
28 C-GLOBAL: kCTFontStyleNameAttribute
29 C-GLOBAL: kCTFontTraitsAttribute
30 C-GLOBAL: kCTFontVariationAttribute
31 C-GLOBAL: kCTFontSizeAttribute
32 C-GLOBAL: kCTFontMatrixAttribute
33 C-GLOBAL: kCTFontCascadeListAttribute
34 C-GLOBAL: kCTFontCharacterSetAttribute
35 C-GLOBAL: kCTFontLanguagesAttribute
36 C-GLOBAL: kCTFontBaselineAdjustAttribute
37 C-GLOBAL: kCTFontMacintoshEncodingsAttribute
38 C-GLOBAL: kCTFontFeaturesAttribute
39 C-GLOBAL: kCTFontFeatureSettingsAttribute
40 C-GLOBAL: kCTFontFixedAdvanceAttribute
41 C-GLOBAL: kCTFontOrientationAttribute
43 FUNCTION: CTFontDescriptorRef CTFontDescriptorCreateWithAttributes (
44 CFDictionaryRef attributes
47 FUNCTION: CTFontRef CTFontCreateWithName (
50 CGAffineTransform* matrix
53 FUNCTION: CTFontRef CTFontCreateWithFontDescriptor (
54 CTFontDescriptorRef descriptor,
56 CGAffineTransform* matrix
59 FUNCTION: CTFontRef CTFontCreateCopyWithSymbolicTraits (
62 CGAffineTransform* matrix,
63 uint32_t symTraitValue,
67 FUNCTION: CGFloat CTFontGetAscent ( CTFontRef font ) ;
69 FUNCTION: CGFloat CTFontGetDescent ( CTFontRef font ) ;
71 FUNCTION: CGFloat CTFontGetLeading ( CTFontRef font ) ;
73 FUNCTION: CGFloat CTFontGetCapHeight ( CTFontRef font ) ;
75 FUNCTION: CGFloat CTFontGetXHeight ( CTFontRef font ) ;
79 { "monospace" "Monaco" }
80 { "sans-serif" "Lucida Grande" }
84 : font-name ( string -- string' )
87 : (bold) ( x -- y ) kCTFontBoldTrait bitor ; inline
89 : (italic) ( x -- y ) kCTFontItalicTrait bitor ; inline
91 : font-traits ( font -- n )
93 [ bold?>> [ (bold) ] when ]
94 [ italic?>> [ (italic) ] when ] bi ;
96 : apply-font-traits ( font style -- font' )
97 [ drop ] [ [ 0.0 f ] dip font-traits dup ] 2bi
98 CTFontCreateCopyWithSymbolicTraits
99 dup [ [ CFRelease ] dip ] [ drop ] if ;
101 MEMO: (cache-font) ( font -- open-font )
104 [ name>> font-name <CFString> &CFRelease ] [ size>> ] bi
105 f CTFontCreateWithName
106 ] keep apply-font-traits
109 : cache-font ( font -- open-font )
110 strip-font-colors (cache-font) ;
112 MEMO: (cache-font-metrics) ( font -- metrics )
115 [ CTFontGetAscent >>ascent ]
116 [ CTFontGetDescent >>descent ]
117 [ CTFontGetLeading >>leading ]
118 [ CTFontGetCapHeight >>cap-height ]
119 [ CTFontGetXHeight >>x-height ]
123 : cache-font-metrics ( font -- metrics )
124 strip-font-colors (cache-font-metrics) ;
127 \ (cache-font) reset-memoized
128 \ (cache-font-metrics) reset-memoized
129 ] "core-text.fonts" add-init-hook