steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

derive-font: output base font if font given is f

db4
Slava Pestov 2009-02-05 22:16:07 -06:00
parent 68d5e3ebaf
commit e0f8a3a7b1
2 changed files with 26 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
basis/fonts/fonts.factor
View File

@ -1,14 +1,18 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel colors accessors combinators ; USING: kernel colors colors.constants accessors combinators ;
IN: fonts IN: fonts
TUPLE: font name size bold? italic? foreground background ; TUPLE: font
name
size
bold?
italic?
{ foreground initial: COLOR: black }
{ background initial: COLOR: white } ;
: <font> ( -- font ) : <font> ( -- font )
font new font new ; inline
black >>foreground
white >>background ; inline
: font-with-foreground ( font color -- font' ) : font-with-foreground ( font color -- font' )
[ clone ] dip >>foreground ; inline [ clone ] dip >>foreground ; inline
@ -25,6 +29,7 @@ TUPLE: font name size bold? italic? foreground background ;
[ >>background ] [ >>foreground ] bi* ; [ >>background ] [ >>foreground ] bi* ;
: derive-font ( base font -- font' ) : derive-font ( base font -- font' )
[
[ clone ] dip over { [ clone ] dip over {
[ [ name>> ] either? >>name ] [ [ name>> ] either? >>name ]
[ [ size>> ] either? >>size ] [ [ size>> ] either? >>size ]
@ -32,7 +37,8 @@ TUPLE: font name size bold? italic? foreground background ;
[ [ italic?>> ] either? >>italic? ] [ [ italic?>> ] either? >>italic? ]
[ [ foreground>> ] either? >>foreground ] [ [ foreground>> ] either? >>foreground ]
[ [ background>> ] either? >>background ] [ [ background>> ] either? >>background ]
} 2cleave ; } 2cleave
] when* ;
: serif-font ( -- font ) : serif-font ( -- font )
<font> <font>

13
basis/ui/gadgets/panes/panes.factor
View File

@ -179,9 +179,9 @@ M: pane-stream make-span-stream
MEMO: specified-font ( assoc -- font ) MEMO: specified-font ( assoc -- font )
#! We memoize here to avoid creating lots of duplicate font objects. #! We memoize here to avoid creating lots of duplicate font objects.
[ <font> ] dip [ monospace-font <font> ] dip
{ {
[ font-name swap at "monospace" or >>name ] [ font-name swap at >>name ]
[ [
font-style swap at { font-style swap at {
{ f [ ] } { f [ ] }
@ -191,10 +191,11 @@ MEMO: specified-font ( assoc -- font )
{ bold-italic [ t >>bold? t >>italic? ] } { bold-italic [ t >>bold? t >>italic? ] }
} case } case
] ]
[ font-size swap at 12 or >>size ] [ font-size swap at >>size ]
[ foreground swap at black or >>foreground ] [ foreground swap at >>foreground ]
[ background swap at white or >>background ] [ background swap at >>background ]
} cleave ; } cleave
derive-font ;
: apply-font-style ( style gadget -- style gadget ) : apply-font-style ( style gadget -- style gadget )
{ font-name font-style font-size foreground background } { font-name font-style font-size foreground background }