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.syntax assocs core-foundation
   4 core-foundation.strings core-text.utilities destructors init
   5 kernel math memoize fonts combinators ;
   6 IN: core-text.fonts
   7
   8 TYPEDEF: void* CTFontRef
   9 TYPEDEF: void* CTFontDescriptorRef
  10
  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
  19
  20 C-GLOBAL: kCTFontSymbolicTrait
  21 C-GLOBAL: kCTFontWeightTrait
  22 C-GLOBAL: kCTFontWidthTrait
  23 C-GLOBAL: kCTFontSlantTrait
  24
  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
  42
  43 FUNCTION: CTFontDescriptorRef CTFontDescriptorCreateWithAttributes (
  44    CFDictionaryRef attributes
  45 ) ;
  46
  47 FUNCTION: CTFontRef CTFontCreateWithName (
  48    CFStringRef name,
  49    CGFloat size,
  50    CGAffineTransform* matrix
  51 ) ;
  52
  53 FUNCTION: CTFontRef CTFontCreateWithFontDescriptor (
  54    CTFontDescriptorRef descriptor,
  55    CGFloat size,
  56    CGAffineTransform* matrix
  57 ) ;
  58
  59 FUNCTION: CTFontRef CTFontCreateCopyWithSymbolicTraits (
  60    CTFontRef font,
  61    CGFloat size,
  62    CGAffineTransform* matrix,
  63    uint32_t symTraitValue,
  64    uint32_t symTraitMask
  65 ) ;
  66
  67 FUNCTION: CGFloat CTFontGetAscent ( CTFontRef font ) ;
  68
  69 FUNCTION: CGFloat CTFontGetDescent ( CTFontRef font ) ;
  70
  71 FUNCTION: CGFloat CTFontGetLeading ( CTFontRef font ) ;
  72
  73 FUNCTION: CGFloat CTFontGetCapHeight ( CTFontRef font ) ;
  74
  75 FUNCTION: CGFloat CTFontGetXHeight ( CTFontRef font ) ;
  76
  77 CONSTANT: font-names
  78     H{
  79         { "monospace" "Monaco" }
  80         { "sans-serif" "Lucida Grande" }
  81         { "serif" "Times" }
  82     }
  83
  84 : font-name ( string -- string' )
  85     font-names at-default ;
  86
  87 : (bold) ( x -- y ) kCTFontBoldTrait bitor ; inline
  88
  89 : (italic) ( x -- y ) kCTFontItalicTrait bitor ; inline
  90
  91 : font-traits ( font -- n )
  92     [ 0 ] dip
  93     [ bold?>> [ (bold) ] when ]
  94     [ italic?>> [ (italic) ] when ] bi ;
  95
  96 : apply-font-traits ( font style -- font' )
  97     [ drop ] [ [ 0.0 f ] dip font-traits dup ] 2bi
  98     CTFontCreateCopyWithSymbolicTraits
  99     dup [ [ CFRelease ] dip ] [ drop ] if ;
 100
 101 MEMO: (cache-font) ( font -- open-font )
 102     [
 103         [
 104             [ name>> font-name <CFString> &CFRelease ] [ size>> ] bi
 105             f CTFontCreateWithName
 106         ] keep apply-font-traits
 107     ] with-destructors ;
 108
 109 : cache-font ( font -- open-font )
 110     strip-font-colors (cache-font) ;
 111
 112 MEMO: (cache-font-metrics) ( font -- metrics )
 113     [ metrics new ] dip
 114     (cache-font) {
 115         [ CTFontGetAscent >>ascent ]
 116         [ CTFontGetDescent >>descent ]
 117         [ CTFontGetLeading >>leading ]
 118         [ CTFontGetCapHeight >>cap-height ]
 119         [ CTFontGetXHeight >>x-height ]
 120     } cleave
 121     compute-height ;
 122
 123 : cache-font-metrics ( font -- metrics )
 124     strip-font-colors (cache-font-metrics) ;
 125
 126 [
 127     \ (cache-font) reset-memoized
 128     \ (cache-font-metrics) reset-memoized
 129 ] "core-text.fonts" add-init-hook