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 ;
   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 CONSTANT: font-names
  68     H{
  69         { "monospace" "Monaco" }
  70         { "sans-serif" "Lucida Grande" }
  71         { "serif" "Times" }
  72     }
  73
  74 : font-name ( string -- string' )
  75     font-names at-default ;
  76
  77 : (bold) ( x -- y ) kCTFontBoldTrait bitor ; inline
  78
  79 : (italic) ( x -- y ) kCTFontItalicTrait bitor ; inline
  80
  81 : font-traits ( font -- n )
  82     [ 0 ] dip
  83     [ bold?>> [ (bold) ] when ]
  84     [ italic?>> [ (italic) ] when ] bi ;
  85
  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 ;
  90
  91 MEMO: (cache-font) ( font -- open-font )
  92     [
  93         [
  94             [ name>> font-name <CFString> &CFRelease ] [ size>> ] bi
  95             f CTFontCreateWithName
  96         ] keep apply-font-traits
  97     ] with-destructors ;
  98
  99 : cache-font ( font -- open-font )
 100     clone f >>foreground f >>background (cache-font) ;
 101
 102 [ \ (cache-font) reset-memoized ] "core-text.fonts" add-init-hook