1 ! Copyright (C) 2005, 2009 Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays fry kernel math math.order sequences
4 ui.baseline-alignment ui.gadgets ui.gadgets.labels
5 ui.gadgets.packs.private ui.render wrap.words ;
6 IN: ui.gadgets.paragraphs
11 TUPLE: word-break-gadget < label ;
13 : <word-break-gadget> ( text -- gadget )
14 word-break-gadget new-label ;
16 M: word-break-gadget draw-gadget* drop ;
18 INSTANCE: word-break-gadget word-break
20 ! A gadget that arranges its children in a word-wrap style.
21 TUPLE: paragraph < aligned-gadget margin wrapped ;
23 : <paragraph> ( margin -- gadget )
25 horizontal >>orientation
30 : gadget>word ( gadget -- word )
31 [ ] [ pref-dim first ] [ word-break? ] tri <word> ;
33 : line-width ( words -- n )
34 [ break?>> ] trim-tail-slice [ width>> ] map-sum ;
36 TUPLE: line words width height baseline ;
38 : <line> ( words -- line )
39 [ ] [ line-width ] [ [ key>> ] map dup pref-dims ] tri
40 [ measure-height ] [ measure-metrics drop ] 2bi line boa ;
42 : wrap-paragraph ( paragraph -- wrapped-paragraph )
43 [ children>> [ gadget>word ] map ] [ margin>> ] bi
44 dup wrap-words [ <line> ] map! ;
46 : cached-wrapped ( paragraph -- wrapped-paragraph )
48 [ nip ] [ [ wrap-paragraph dup ] keep wrapped<< ] if* ;
50 : max-line-width ( wrapped-paragraph -- x )
51 [ width>> ] [ max ] map-reduce ;
53 : sum-line-heights ( wrapped-paragraph -- y )
54 [ height>> ] map-sum ;
56 M: paragraph pref-dim*
57 cached-wrapped [ max-line-width ] [ sum-line-heights ] bi 2array ;
59 : line-y-coordinates ( wrapped-paragraph -- ys )
60 0 [ height>> + ] accumulate nip ;
62 : word-x-coordinates ( wrapped-line -- xs )
63 0 [ width>> + ] accumulate nip ;
65 : layout-word ( word x y -- )
66 [ key>> ] 2dip 2array >>loc prefer ;
68 : layout-line ( wrapped-line y -- )
72 [ word-x-coordinates ]
73 [ [ key>> ] map align-baselines ] tri
74 ] dip '[ _ + layout-word ] 3each ;
78 cached-wrapped dup line-y-coordinates [ layout-line ] 2each ;
80 M: paragraph baseline*
81 cached-wrapped [ f ] [ first baseline>> ] if-empty ;
83 M: paragraph cap-height* pack-cap-height ;