use reject instead of [ ... not ] filter.

[factor.git] / basis / ui / baseline-alignment / baseline-alignment.factor

diff --git a/basis/ui/baseline-alignment/baseline-alignment.factor b/basis/ui/baseline-alignment/baseline-alignment.factor
index e02c6188f5ccd1c0c284f8614ab564c4ba651c6c..2527b522951319fe36bdb29c2c5faa296c8d38d1 100644 (file)
--- a/basis/ui/baseline-alignment/baseline-alignment.factor
+++ b/basis/ui/baseline-alignment/baseline-alignment.factor
@@ -1,19 +1,39 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel locals math math.order math.vectors
-sequences ui.gadgets accessors combinators ;
+USING: accessors combinators kernel locals math math.functions
+math.order sequences ui.gadgets ;
 IN: ui.baseline-alignment
 
 SYMBOL: +baseline+
 
+TUPLE: aligned-gadget < gadget baseline cap-height ;
+
+GENERIC: baseline* ( gadget -- y )
+
 GENERIC: baseline ( gadget -- y )
 
 M: gadget baseline drop f ;
 
+M: aligned-gadget baseline
+    dup baseline>>
+    [ ] [
+        [ baseline* ] [ ] [ layout-state>> ] tri
+        [ drop ] [ dupd baseline<< ] if
+    ] ?if ;
+
+GENERIC: cap-height* ( gadget -- y )
+
 GENERIC: cap-height ( gadget -- y )
 
 M: gadget cap-height drop f ;
 
+M: aligned-gadget cap-height
+    dup cap-height>>
+    [ ] [
+        [ cap-height* ] [ ] [ layout-state>> ] tri
+        [ drop ] [ dupd cap-height<< ] if
+    ] ?if ;
+
 <PRIVATE
 
 ! Text has ascent/descent/cap-height slots, graphics does not.
@@ -24,57 +44,58 @@ TUPLE: gadget-metrics height ascent descent cap-height ;
     [ dup [ 2dup - ] [ f ] if ] dip
     gadget-metrics boa ; inline
 
+: ?supremum ( seq -- n/f )
+    sift [ f ] [ supremum ] if-empty ;
+
 : max-ascent ( seq -- n )
-    0 [ ascent>> [ max ] when* ] reduce ; inline
+    [ ascent>> ] map ?supremum ;
 
 : max-cap-height ( seq -- n )
-    0 [ cap-height>> [ max ] when* ] reduce ; inline
+    [ cap-height>> ] map ?supremum ;
 
 : max-descent ( seq -- n )
-    0 [ descent>> [ max ] when* ] reduce ; inline
-
-: max-text-height ( seq -- y )
-    0 [ [ height>> ] [ ascent>> ] bi [ max ] [ drop ] if ] reduce ;
+    [ descent>> ] map ?supremum ;
 
 : max-graphics-height ( seq -- y )
-    0 [ [ height>> ] [ ascent>> ] bi [ drop ] [ max ] if ] reduce ;
-
-: (align-baselines) ( y max leading -- y' ) [ swap - ] dip + ;
+    [ ascent>> ] reject [ height>> ] map ?supremum 0 or ;
 
 :: combine-metrics ( graphics-height ascent descent cap-height -- ascent' descent' )
-    cap-height 2 / :> mid-line 
-    graphics-height 2 /
-    [ ascent mid-line - max mid-line + >integer ]
-    [ descent mid-line + max mid-line - >integer ] bi ;
+    ascent [
+        cap-height 2 / :> mid-line 
+        graphics-height 2 /
+        [ ascent mid-line - max mid-line + floor >integer ]
+        [ descent mid-line + max mid-line - ceiling >integer ] bi
+    ] [ f f ] if ;
+
+: (measure-metrics) ( children sizes -- graphics-height ascent descent cap-height )
+    [ <gadget-metrics> ] 2map
+    {
+        [ max-graphics-height ]
+        [ max-ascent ]
+        [ max-descent ]
+        [ max-cap-height ]
+    } cleave ;
 
 PRIVATE>
 
 :: align-baselines ( gadgets -- ys )
     gadgets [ dup pref-dim <gadget-metrics> ] map
-    dup max-ascent :> max-ascent
-    dup max-cap-height :> max-cap-height
+    dup max-ascent 0 or :> max-ascent
+    dup max-cap-height 0 or :> max-cap-height
     dup max-graphics-height :> max-graphics-height
-    
+
     max-cap-height max-graphics-height + 2 /i :> critical-line
     critical-line max-ascent [-] :> text-leading
     max-ascent critical-line [-] :> graphics-leading
 
     [
         dup ascent>>
-        [ ascent>> max-ascent text-leading ]
-        [ height>> max-graphics-height graphics-leading ] if
-        (align-baselines)
+        [ ascent>> max-ascent swap - text-leading ]
+        [ height>> max-graphics-height swap - 2 /i graphics-leading ] if +
     ] map ;
 
 : measure-metrics ( children sizes -- ascent descent )
-    [ <gadget-metrics> ] 2map
-    {
-        [ max-graphics-height ]
-        [ max-ascent ]
-        [ max-descent ]
-        [ max-cap-height ]
-    } cleave
-    combine-metrics ;
+    (measure-metrics) combine-metrics ;
 
 : measure-height ( children sizes -- height )
-    measure-metrics + ;
\ No newline at end of file
+    (measure-metrics) dup [ combine-metrics + ] [ 3drop ] if ;