1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.syntax assocs core-foundation
4 core-foundation.dictionaries core-foundation.strings
5 core-graphics.types core-text.utilities destructors init
6 kernel math memoize fonts combinators unix.types ;
9 TYPEDEF: void* CTFontRef
10 TYPEDEF: void* CTFontDescriptorRef
12 ! CTFontSymbolicTraits
13 : kCTFontItalicTrait ( -- n ) 0 2^ ; inline
14 : kCTFontBoldTrait ( -- n ) 1 2^ ; inline
15 : kCTFontExpandedTrait ( -- n ) 5 2^ ; inline
16 : kCTFontCondensedTrait ( -- n ) 6 2^ ; inline
17 : kCTFontMonoSpaceTrait ( -- n ) 10 2^ ; inline
18 : kCTFontVerticalTrait ( -- n ) 11 2^ ; inline
19 : kCTFontUIOptimizedTrait ( -- n ) 12 2^ ; inline
21 C-GLOBAL: kCTFontSymbolicTrait
22 C-GLOBAL: kCTFontWeightTrait
23 C-GLOBAL: kCTFontWidthTrait
24 C-GLOBAL: kCTFontSlantTrait
26 C-GLOBAL: kCTFontNameAttribute
27 C-GLOBAL: kCTFontDisplayNameAttribute
28 C-GLOBAL: kCTFontFamilyNameAttribute
29 C-GLOBAL: kCTFontStyleNameAttribute
30 C-GLOBAL: kCTFontTraitsAttribute
31 C-GLOBAL: kCTFontVariationAttribute
32 C-GLOBAL: kCTFontSizeAttribute
33 C-GLOBAL: kCTFontMatrixAttribute
34 C-GLOBAL: kCTFontCascadeListAttribute
35 C-GLOBAL: kCTFontCharacterSetAttribute
36 C-GLOBAL: kCTFontLanguagesAttribute
37 C-GLOBAL: kCTFontBaselineAdjustAttribute
38 C-GLOBAL: kCTFontMacintoshEncodingsAttribute
39 C-GLOBAL: kCTFontFeaturesAttribute
40 C-GLOBAL: kCTFontFeatureSettingsAttribute
41 C-GLOBAL: kCTFontFixedAdvanceAttribute
42 C-GLOBAL: kCTFontOrientationAttribute
44 FUNCTION: CTFontDescriptorRef CTFontDescriptorCreateWithAttributes (
45 CFDictionaryRef attributes
48 FUNCTION: CTFontRef CTFontCreateWithName (
51 CGAffineTransform* matrix
54 FUNCTION: CTFontRef CTFontCreateWithFontDescriptor (
55 CTFontDescriptorRef descriptor,
57 CGAffineTransform* matrix
60 FUNCTION: CTFontRef CTFontCreateCopyWithSymbolicTraits (
63 CGAffineTransform* matrix,
64 uint32_t symTraitValue,
68 FUNCTION: CGFloat CTFontGetAscent ( CTFontRef font ) ;
70 FUNCTION: CGFloat CTFontGetDescent ( CTFontRef font ) ;
72 FUNCTION: CGFloat CTFontGetLeading ( CTFontRef font ) ;
74 FUNCTION: CGFloat CTFontGetCapHeight ( CTFontRef font ) ;
76 FUNCTION: CGFloat CTFontGetXHeight ( CTFontRef font ) ;
80 { "monospace" "Monaco" }
81 { "sans-serif" "Lucida Grande" }
85 : font-name ( string -- string' )
88 : (bold) ( x -- y ) kCTFontBoldTrait bitor ; inline
90 : (italic) ( x -- y ) kCTFontItalicTrait bitor ; inline
92 : font-traits ( font -- n )
94 [ bold?>> [ (bold) ] when ]
95 [ italic?>> [ (italic) ] when ] bi ;
97 : apply-font-traits ( font style -- font' )
98 [ drop ] [ [ 0.0 f ] dip font-traits dup ] 2bi
99 CTFontCreateCopyWithSymbolicTraits
100 dup [ [ CFRelease ] dip ] [ drop ] if ;
102 MEMO: (cache-font) ( font -- open-font )
105 [ name>> font-name <CFString> &CFRelease ] [ size>> ] bi
106 f CTFontCreateWithName
107 ] keep apply-font-traits
110 : cache-font ( font -- open-font )
111 strip-font-colors (cache-font) ;
113 MEMO: (cache-font-metrics) ( font -- metrics )
116 [ CTFontGetAscent >>ascent ]
117 [ CTFontGetDescent >>descent ]
118 [ CTFontGetLeading >>leading ]
119 [ CTFontGetCapHeight >>cap-height ]
120 [ CTFontGetXHeight >>x-height ]
124 : cache-font-metrics ( font -- metrics )
125 strip-font-colors (cache-font-metrics) ;
128 \ (cache-font) reset-memoized
129 \ (cache-font-metrics) reset-memoized
130 ] "core-text.fonts" add-init-hook