1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays kernel locals math math.order math.vectors
4 sequences ui.gadgets accessors combinators ;
5 IN: ui.baseline-alignment
9 GENERIC: baseline ( gadget -- y )
11 M: gadget baseline drop f ;
13 GENERIC: cap-height ( gadget -- y )
15 M: gadget cap-height drop f ;
19 ! Text has ascent/descent/cap-height slots, graphics does not.
20 TUPLE: gadget-metrics height ascent descent cap-height ;
22 : <gadget-metrics> ( gadget dim -- metrics )
23 second swap [ baseline ] [ cap-height ] bi
24 [ dup [ 2dup - ] [ f ] if ] dip
25 gadget-metrics boa ; inline
27 : max-ascent ( seq -- n )
28 0 [ ascent>> [ max ] when* ] reduce ; inline
30 : max-cap-height ( seq -- n )
31 0 [ cap-height>> [ max ] when* ] reduce ; inline
33 : max-descent ( seq -- n )
34 0 [ descent>> [ max ] when* ] reduce ; inline
36 : max-text-height ( seq -- y )
37 0 [ [ height>> ] [ ascent>> ] bi [ max ] [ drop ] if ] reduce ;
39 : max-graphics-height ( seq -- y )
40 0 [ [ height>> ] [ ascent>> ] bi [ drop ] [ max ] if ] reduce ;
42 : (align-baselines) ( y max leading -- y' ) [ swap - ] dip + ;
44 :: combine-metrics ( graphics-height ascent descent cap-height -- ascent' descent' )
45 cap-height 2 / :> mid-line
47 [ ascent mid-line - max mid-line + >integer ]
48 [ descent mid-line + max mid-line - >integer ] bi ;
52 :: align-baselines ( gadgets -- ys )
53 gadgets [ dup pref-dim <gadget-metrics> ] map
54 dup max-ascent :> max-ascent
55 dup max-cap-height :> max-cap-height
56 dup max-graphics-height :> max-graphics-height
58 max-cap-height max-graphics-height + 2 /i :> critical-line
59 critical-line max-ascent [-] :> text-leading
60 max-ascent critical-line [-] :> graphics-leading
64 [ ascent>> max-ascent text-leading ]
65 [ height>> max-graphics-height graphics-leading ] if
69 : measure-metrics ( children sizes -- ascent descent )
70 [ <gadget-metrics> ] 2map
72 [ max-graphics-height ]
79 : measure-height ( children sizes -- height )