1 ! Copyright (C) 2005, 2010 Slava Pestov.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays combinators kernel math math.order
4 math.vectors sequences ui.baseline-alignment
5 ui.baseline-alignment.private ui.gadgets ;
8 TUPLE: pack < aligned-gadget
11 { gap initial: { 0 0 } } ;
15 : (packed-dims) ( gadget sizes -- list )
16 swap [ dim>> ] [ fill>> ] bi '[ _ over v- _ v*n v+ ] map ;
18 : orient ( seq1 seq2 gadget -- seq )
19 orientation>> '[ _ set-axis ] 2map ;
21 : packed-dims ( gadget sizes -- seq )
22 [ (packed-dims) ] [ nip ] [ drop ] 2tri orient ;
24 : gap-locs ( sizes gap -- seq )
25 [ { 0 0 } ] dip '[ v+ _ v+ ] accumulate nip ;
27 : numerically-aligned-locs ( sizes pack -- seq )
28 [ align>> ] [ dim>> ] bi rot [ v- [ * ] with map ] 2with map ;
30 : baseline-aligned-locs ( pack -- seq )
31 children>> align-baselines [ 0 swap 2array ] map ;
33 : aligned-locs ( sizes pack -- seq )
34 dup align>> +baseline+ eq?
35 [ nip baseline-aligned-locs ]
36 [ numerically-aligned-locs ]
39 : packed-locs ( sizes pack -- seq )
40 [ aligned-locs ] [ gap>> gap-locs ] [ nip ] 2tri orient ;
44 : pack-layout ( pack sizes -- )
45 [ packed-dims ] [ drop ] 2bi
46 [ children>> [ dim<< ] 2each ]
47 [ [ packed-locs ] [ children>> ] bi [ loc<< ] 2each ] 2bi ;
49 : <pack> ( orientation -- pack )
53 : <pile> ( -- pack ) vertical <pack> ;
55 : <filled-pile> ( -- pack ) <pile> 1 >>fill ;
57 : <shelf> ( -- pack ) horizontal <pack> ;
61 : gap-dim ( pack -- dim )
62 [ gap>> ] [ children>> length 1 [-] ] bi v*n ;
64 : max-pack-dim ( pack sizes -- dim )
65 over align>> +baseline+ eq?
66 [ [ children>> ] dip measure-height 0 swap 2array ] [ nip max-dims ] if ;
68 : pack-pref-dim ( pack sizes -- dim )
70 [ [ gap-dim ] [ sum-dims ] bi* v+ ]
71 [ drop orientation>> ]
75 dup children>> pref-dims pack-pref-dim ;
77 : vertical-baseline ( pack -- y )
78 children>> [ f ] [ first baseline ] if-empty ; inline
80 : horizontal-baseline ( pack -- y )
81 children>> dup pref-dims measure-metrics drop ; inline
83 : pack-cap-height ( pack -- n/f )
84 children>> [ cap-height ] map ?supremum ; inline
90 { vertical [ vertical-baseline ] }
91 { horizontal [ horizontal-baseline ] }
94 M: pack cap-height* pack-cap-height ;
97 dup children>> pref-dims pack-layout ;
100 [ orientation>> ] [ children>> ] bi [ loc>> ] fast-children-on ;