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 core-foundation
   4 core-foundation.dictionaries core-foundation.strings
   5 core-graphics.types destructors init
   6 kernel math memoize fonts combinators 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" "Monaco" }
  81         { "sans-serif" "Lucida Grande" }
  82         { "serif" "Times" }
  83     }
  84
  85 : font-name ( string -- string' )
  86     font-names ?at drop ;
  87
  88 : (bold) ( x -- y ) kCTFontBoldTrait bitor ; inline
  89
  90 : (italic) ( x -- y ) kCTFontItalicTrait bitor ; inline
  91
  92 : font-traits ( font -- n )
  93     [ 0 ] dip
  94     [ bold?>> [ (bold) ] when ]
  95     [ italic?>> [ (italic) ] when ] bi ;
  96
  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 ;
 101
 102 MEMO: (cache-font) ( font -- open-font )
 103     [
 104         [
 105             [ name>> font-name <CFString> &CFRelease ] [ size>> ] bi
 106             f CTFontCreateWithName
 107         ] keep apply-font-traits
 108     ] with-destructors ;
 109
 110 : cache-font ( font -- open-font )
 111     strip-font-colors (cache-font) ;
 112
 113 MEMO: (cache-font-metrics) ( font -- metrics )
 114     [ metrics new ] dip
 115     (cache-font) {
 116         [ CTFontGetAscent >>ascent ]
 117         [ CTFontGetDescent >>descent ]
 118         [ CTFontGetLeading >>leading ]
 119         [ CTFontGetCapHeight >>cap-height ]
 120         [ CTFontGetXHeight >>x-height ]
 121     } cleave
 122     compute-height ;
 123
 124 : cache-font-metrics ( font -- metrics )
 125     strip-font-colors (cache-font-metrics) ;
 126
 127 [
 128     \ (cache-font) reset-memoized
 129     \ (cache-font-metrics) reset-memoized
 130 ] "core-text.fonts" add-startup-hook