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
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,
69 { "monospace" "Monaco" }
70 { "sans-serif" "Lucida Grande" }
74 : font-name ( string -- string' )
75 font-names at-default ;
77 : (bold) ( x -- y ) kCTFontBoldTrait bitor ; inline
79 : (italic) ( x -- y ) kCTFontItalicTrait bitor ; inline
81 : font-traits ( font -- n )
83 [ bold?>> [ (bold) ] when ]
84 [ italic?>> [ (italic) ] when ] bi ;
86 : apply-font-traits ( font style -- font' )
87 [ drop ] [ [ 0.0 f ] dip font-traits dup ] 2bi
88 CTFontCreateCopyWithSymbolicTraits
89 dup [ [ CFRelease ] dip ] [ drop ] if ;
91 MEMO: (cache-font) ( font -- open-font )
94 [ name>> font-name <CFString> &CFRelease ] [ size>> ] bi
95 f CTFontCreateWithName
96 ] keep apply-font-traits
99 : cache-font ( font -- open-font )
100 clone f >>foreground f >>background (cache-font) ;
102 [ \ (cache-font) reset-memoized ] "core-text.fonts" add-init-hook