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

basis/fonts/fonts.factor

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

basis/ui/gadgets/panes/panes.factor

@@ -179,9 +179,9 @@ M: pane-stream make-span-stream
 
 MEMO: specified-font ( assoc -- font )
     #! 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 {
                 { f [ ] }
@@ -191,10 +191,11 @@ MEMO: specified-font ( assoc -- font )
                 { bold-italic [ t >>bold? t >>italic? ] }
             } 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 )
     { font-name font-style font-size foreground background }