basis/fonts/fonts.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel colors accessors combinators ;
   4 IN: fonts
   5
   6 TUPLE: font name size bold? italic? foreground background ;
   7
   8 : <font> ( -- font )
   9     font new
  10         black >>foreground
  11         white >>background ; inline
  12
  13 : font-with-foreground ( font color -- font' )
  14     [ clone ] dip >>foreground ; inline
  15
  16 : font-with-background ( font color -- font' )
  17     [ clone ] dip >>background ; inline
  18
  19 : reverse-video-font ( font -- font )
  20     clone dup
  21     [ foreground>> ] [ background>> ] bi
  22     [ >>background ] [ >>foreground ] bi* ;
  23
  24 : derive-font ( base font -- font' )
  25     [ clone ] dip over {
  26         [ [ name>> ] either? >>name ]
  27         [ [ size>> ] either? >>size ]
  28         [ [ bold?>> ] either? >>bold? ]
  29         [ [ italic?>> ] either? >>italic? ]
  30         [ [ foreground>> ] either? >>foreground ]
  31         [ [ background>> ] either? >>background ]
  32     } 2cleave ;
  33
  34 : serif-font ( -- font )
  35     <font>
  36         "serif" >>name
  37         12 >>size ; foldable
  38
  39 : sans-serif-font ( -- font )
  40     <font>
  41         "sans-serif" >>name
  42         12 >>size ; foldable
  43
  44 : monospace-font ( -- font )
  45     <font>
  46         "monospace" >>name
  47         12 >>size ; foldable