diff --git a/basis/ui/baseline-alignment/baseline-alignment.factor b/basis/ui/baseline-alignment/baseline-alignment.factor index e02c6188f5..1cdaf760dc 100644 --- a/basis/ui/baseline-alignment/baseline-alignment.factor +++ b/basis/ui/baseline-alignment/baseline-alignment.factor @@ -24,35 +24,47 @@ 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 + [ descent>> ] map ?supremum ; : max-text-height ( seq -- y ) - 0 [ [ height>> ] [ ascent>> ] bi [ max ] [ drop ] if ] reduce ; + [ ascent>> ] filter [ height>> ] map ?supremum ; : max-graphics-height ( seq -- y ) - 0 [ [ height>> ] [ ascent>> ] bi [ drop ] [ max ] if ] reduce ; - -: (align-baselines) ( y max leading -- y' ) [ swap - ] dip + ; + [ ascent>> not ] filter [ 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 + >integer ] + [ descent mid-line + max mid-line - >integer ] bi + ] [ f f ] if ; + +: (measure-metrics) ( children sizes -- graphics-height ascent descent cap-height ) + [ ] 2map + { + [ max-graphics-height ] + [ max-ascent ] + [ max-descent ] + [ max-cap-height ] + } cleave ; PRIVATE> :: align-baselines ( gadgets -- ys ) gadgets [ dup pref-dim ] 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 @@ -61,20 +73,12 @@ PRIVATE> [ 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/ graphics-leading ] if + ] map ; : measure-metrics ( children sizes -- ascent descent ) - [ ] 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 ; \ No newline at end of file diff --git a/basis/ui/gadgets/packs/packs-tests.factor b/basis/ui/gadgets/packs/packs-tests.factor index cae7d12dc3..153579643d 100644 --- a/basis/ui/gadgets/packs/packs-tests.factor +++ b/basis/ui/gadgets/packs/packs-tests.factor @@ -90,4 +90,43 @@ IN: ui.gadgets.packs.tests [ ] [ "g" get prefer ] unit-test -[ ] [ "g" get layout ] unit-test \ No newline at end of file +[ ] [ "g" get layout ] unit-test + +! Baseline alignment without any text gadgets should behave like align=1/2 + +baseline+ >>align + { 30 30 } >>dim add-gadget + { 30 20 } >>dim add-gadget +"g" set + +[ { 60 30 } ] [ "g" get pref-dim ] unit-test + +[ ] [ "g" get prefer ] unit-test + +[ ] [ "g" get layout ] unit-test + +[ V{ { 0 0 } { 30 5 } } ] +[ "g" get children>> [ loc>> ] map ] unit-test + + +baseline+ >>align + { 30 30 } >>dim add-gadget +10 10 { 10 10 } add-gadget +"g" set + +[ ] [ "g" get prefer ] unit-test + +[ ] [ "g" get layout ] unit-test + +[ V{ { 0 0 } { 30 10 } } ] +[ "g" get children>> [ loc>> ] map ] unit-test + + +baseline+ >>align + { 30 30 } >>dim add-gadget add-gadget +10 10 { 10 10 } add-gadget +"g" set + +[ ] [ "g" get prefer ] unit-test + +[ ] [ "g" get layout ] unit-test + +[ V{ { 0 0 } { 30 10 } } ] +[ "g" get children>> [ loc>> ] map ] unit-test \ No newline at end of file diff --git a/basis/ui/gadgets/packs/packs.factor b/basis/ui/gadgets/packs/packs.factor index 95f04dfe4d..f47b374aeb 100644 --- a/basis/ui/gadgets/packs/packs.factor +++ b/basis/ui/gadgets/packs/packs.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: sequences ui.gadgets ui.baseline-alignment kernel math -math.functions math.vectors math.order math.rectangles namespaces -accessors fry combinators arrays ; +USING: sequences ui.gadgets ui.baseline-alignment +ui.baseline-alignment.private kernel math math.functions math.vectors +math.order math.rectangles namespaces accessors fry combinators arrays ; IN: ui.gadgets.packs TUPLE: pack < gadget @@ -84,8 +84,7 @@ M: pack pref-dim* children>> dup pref-dims measure-metrics drop ; : pack-cap-height ( pack -- n ) - children>> [ cap-height ] map sift - [ f ] [ supremum ] if-empty ; + children>> [ cap-height ] map ?supremum ; PRIVATE>