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 ) ;
75 { "monospace" "Monaco" }
76 { "sans-serif" "Lucida Grande" }
80 : font-name ( string -- string' )
81 font-names at-default ;
83 : (bold) ( x -- y ) kCTFontBoldTrait bitor ; inline
85 : (italic) ( x -- y ) kCTFontItalicTrait bitor ; inline
87 : font-traits ( font -- n )
89 [ bold?>> [ (bold) ] when ]
90 [ italic?>> [ (italic) ] when ] bi ;
92 : apply-font-traits ( font style -- font' )
93 [ drop ] [ [ 0.0 f ] dip font-traits dup ] 2bi
94 CTFontCreateCopyWithSymbolicTraits
95 dup [ [ CFRelease ] dip ] [ drop ] if ;
97 MEMO: (cache-font) ( font -- open-font )
100 [ name>> font-name <CFString> &CFRelease ] [ size>> ] bi
101 f CTFontCreateWithName
102 ] keep apply-font-traits
105 : cache-font ( font -- open-font )
106 strip-font-colors (cache-font) ;
108 MEMO: (cache-font-metrics) ( font -- metrics )
116 : cache-font-metrics ( font -- metrics )
117 strip-font-colors (cache-font-metrics) ;
120 \ (cache-font) reset-memoized
121 \ (cache-font-metrics) reset-memoized
122 ] "core-text.fonts" add-init-hook