1 ! Copyright (C) 2009 Slava Pestov.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators kernel locals math math.functions
4 math.order sequences ui.gadgets ;
5 IN: ui.baseline-alignment
9 TUPLE: aligned-gadget < gadget baseline cap-height ;
11 GENERIC: baseline* ( gadget -- y )
13 GENERIC: baseline ( gadget -- y )
15 M: gadget baseline drop f ;
17 M: aligned-gadget baseline
19 [ baseline* ] [ ] [ layout-state>> ] tri
20 [ drop ] [ dupd baseline<< ] if
23 GENERIC: cap-height* ( gadget -- y )
25 GENERIC: cap-height ( gadget -- y )
27 M: gadget cap-height drop f ;
29 M: aligned-gadget cap-height
31 [ cap-height* ] [ ] [ layout-state>> ] tri
32 [ drop ] [ dupd cap-height<< ] if
37 ! Text has ascent/descent/cap-height slots, graphics does not.
38 TUPLE: gadget-metrics height ascent descent cap-height ;
40 : <gadget-metrics> ( gadget dim -- metrics )
41 second swap [ baseline ] [ cap-height ] bi
42 [ dup [ 2dup - ] [ f ] if ] dip
43 gadget-metrics boa ; inline
45 : ?supremum ( seq -- n/f )
46 sift [ f ] [ supremum ] if-empty ;
48 : max-ascent ( seq -- n/f )
49 [ ascent>> ] map ?supremum ;
51 : max-cap-height ( seq -- n/f )
52 [ cap-height>> ] map ?supremum ;
54 : max-descent ( seq -- n/f )
55 [ descent>> ] map ?supremum ;
57 : max-graphics-height ( seq -- n )
58 [ ascent>> ] reject [ height>> ] map ?supremum 0 or ;
60 :: combine-metrics ( graphics-height ascent descent cap-height -- ascent' descent' )
62 cap-height 0 or 2 / :> mid-line
64 [ ascent mid-line - max mid-line + floor >integer ]
65 [ descent mid-line + max mid-line - ceiling >integer ] bi
68 : (measure-metrics) ( children sizes -- graphics-height ascent descent cap-height )
69 [ <gadget-metrics> ] 2map
71 [ max-graphics-height ]
79 :: align-baselines ( gadgets -- ys )
80 gadgets [ dup pref-dim <gadget-metrics> ] map
81 dup max-ascent 0 or :> max-ascent
82 dup max-cap-height 0 or :> max-cap-height
83 dup max-graphics-height :> max-graphics-height
85 max-cap-height max-graphics-height + 2 /i :> critical-line
86 critical-line max-ascent [-] :> text-leading
87 max-ascent critical-line [-] :> graphics-leading
91 [ ascent>> max-ascent swap - text-leading ]
92 [ height>> max-graphics-height swap - 2 /i graphics-leading ] if +
95 : measure-metrics ( children sizes -- ascent descent )
96 (measure-metrics) combine-metrics ;
98 : measure-height ( children sizes -- height )
99 (measure-metrics) [ combine-metrics + ] [ 2drop ] if* ;
101 : measure-height-metrics ( children sizes -- height ascent descent )
102 (measure-metrics) [ dup ] 3dip
103 [ combine-metrics ] keep [ [ + nip ] 2keep ] when ;