basis/core-text/fonts/fonts.factor

   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 combinators
   4 core-foundation core-foundation.dictionaries
   5 core-foundation.strings core-graphics.types destructors fonts
   6 init kernel math memoize unix.types ;
   7 IN: core-text.fonts
   8
   9 TYPEDEF: void* CTFontRef
  10 TYPEDEF: void* CTFontDescriptorRef
  11
  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
  20
  21 C-GLOBAL: CFStringRef kCTFontSymbolicTrait
  22 C-GLOBAL: CFStringRef kCTFontWeightTrait
  23 C-GLOBAL: CFStringRef kCTFontWidthTrait
  24 C-GLOBAL: CFStringRef kCTFontSlantTrait
  25
  26 C-GLOBAL: CFStringRef kCTFontNameAttribute
  27 C-GLOBAL: CFStringRef kCTFontDisplayNameAttribute
  28 C-GLOBAL: CFStringRef kCTFontFamilyNameAttribute
  29 C-GLOBAL: CFStringRef kCTFontStyleNameAttribute
  30 C-GLOBAL: CFStringRef kCTFontTraitsAttribute
  31 C-GLOBAL: CFStringRef kCTFontVariationAttribute
  32 C-GLOBAL: CFStringRef kCTFontSizeAttribute
  33 C-GLOBAL: CFStringRef kCTFontMatrixAttribute
  34 C-GLOBAL: CFStringRef kCTFontCascadeListAttribute
  35 C-GLOBAL: CFStringRef kCTFontCharacterSetAttribute
  36 C-GLOBAL: CFStringRef kCTFontLanguagesAttribute
  37 C-GLOBAL: CFStringRef kCTFontBaselineAdjustAttribute
  38 C-GLOBAL: CFStringRef kCTFontMacintoshEncodingsAttribute
  39 C-GLOBAL: CFStringRef kCTFontFeaturesAttribute
  40 C-GLOBAL: CFStringRef kCTFontFeatureSettingsAttribute
  41 C-GLOBAL: CFStringRef kCTFontFixedAdvanceAttribute
  42 C-GLOBAL: CFStringRef kCTFontOrientationAttribute
  43
  44 FUNCTION: CTFontDescriptorRef CTFontDescriptorCreateWithAttributes (
  45    CFDictionaryRef attributes
  46 )
  47
  48 FUNCTION: CTFontRef CTFontCreateWithName (
  49    CFStringRef name,
  50    CGFloat size,
  51    CGAffineTransform* matrix
  52 )
  53
  54 FUNCTION: CTFontRef CTFontCreateWithFontDescriptor (
  55    CTFontDescriptorRef descriptor,
  56    CGFloat size,
  57    CGAffineTransform* matrix
  58 )
  59
  60 FUNCTION: CTFontRef CTFontCreateCopyWithSymbolicTraits (
  61    CTFontRef font,
  62    CGFloat size,
  63    CGAffineTransform* matrix,
  64    uint32_t symTraitValue,
  65    uint32_t symTraitMask
  66 )
  67
  68 FUNCTION: CGFloat CTFontGetAscent ( CTFontRef font )
  69
  70 FUNCTION: CGFloat CTFontGetDescent ( CTFontRef font )
  71
  72 FUNCTION: CGFloat CTFontGetLeading ( CTFontRef font )
  73
  74 FUNCTION: CGFloat CTFontGetCapHeight ( CTFontRef font )
  75
  76 FUNCTION: CGFloat CTFontGetXHeight ( CTFontRef font )
  77
  78 CONSTANT: font-names
  79     H{
  80         { "monospace" "Menlo" }
  81         { "sans-serif" "LucidaGrande" }
  82         { "serif" "Times" }
  83     }
  84
  85 : font-name ( string -- string' )
  86     font-names ?at drop ;
  87
  88 : font-traits ( font -- n )
  89     [ 0 ] dip
  90     [ bold?>> [ kCTFontBoldTrait bitor ] when ]
  91     [ italic?>> [ kCTFontItalicTrait bitor ] when ] bi ;
  92
  93 MEMO:: (cache-font) ( name size traits -- open-font )
  94     [
  95         name font-name <CFString> &CFRelease
  96         size f CTFontCreateWithName dup
  97         0.0 f traits dup CTFontCreateCopyWithSymbolicTraits
  98         [ [ CFRelease ] dip ] when*
  99     ] with-destructors ;
 100
 101 : cache-font ( font -- open-font )
 102     [ name>> ] [ size>> ] [ font-traits ] tri (cache-font) ;
 103
 104 : cache-font@2x ( font -- open-font )
 105     [ name>> ] [ size>> 2 * ] [ font-traits ] tri (cache-font) ;
 106
 107 MEMO: (cache-font-metrics) ( name size traits -- metrics )
 108     [ metrics new ] 3dip
 109     (cache-font) {
 110         [ CTFontGetAscent >>ascent ]
 111         [ CTFontGetDescent >>descent ]
 112         [ CTFontGetLeading >>leading ]
 113         [ CTFontGetCapHeight >>cap-height ]
 114         [ CTFontGetXHeight >>x-height ]
 115     } cleave
 116     compute-height ;
 117
 118 : cache-font-metrics ( font -- metrics )
 119     [ name>> ] [ size>> ] [ font-traits ] tri (cache-font-metrics) ;
 120
 121 [
 122     \ (cache-font) reset-memoized
 123     \ (cache-font-metrics) reset-memoized
 124 ] "core-text.fonts" add-startup-hook