90 lines
2.3 KiB
Factor
90 lines
2.3 KiB
Factor
! Copyright (C) 2005, 2009 Slava Pestov
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors arrays fry kernel math math.order sequences
|
|
ui.baseline-alignment ui.gadgets ui.gadgets.labels
|
|
ui.gadgets.packs.private ui.render wrap.words ;
|
|
IN: ui.gadgets.paragraphs
|
|
|
|
MIXIN: word-break
|
|
|
|
! A word break gadget
|
|
TUPLE: word-break-gadget < label ;
|
|
|
|
: <word-break-gadget> ( text -- gadget )
|
|
word-break-gadget new-label ;
|
|
|
|
M: word-break-gadget draw-gadget* drop ;
|
|
|
|
INSTANCE: word-break-gadget word-break
|
|
|
|
! A gadget that arranges its children in a word-wrap style.
|
|
TUPLE: paragraph < aligned-gadget margin wrapped ;
|
|
|
|
: <paragraph> ( margin -- gadget )
|
|
paragraph new
|
|
horizontal >>orientation
|
|
swap >>margin ;
|
|
|
|
<PRIVATE
|
|
|
|
: gadget>word ( gadget -- word )
|
|
[ ] [ pref-dim first ] [ word-break? ] tri <wrapping-word> ;
|
|
|
|
: line-width ( words -- n )
|
|
[ break?>> ] trim-tail-slice [ width>> ] map-sum ;
|
|
|
|
TUPLE: line words width height baseline ;
|
|
|
|
: <line> ( words -- line )
|
|
[ ] [ line-width ] [ [ key>> ] map dup pref-dims ] tri
|
|
[ measure-height ] [ measure-metrics drop ] 2bi line boa ;
|
|
|
|
: wrap-paragraph ( paragraph -- wrapped-paragraph )
|
|
[ children>> [ gadget>word ] map ] [ margin>> ] bi
|
|
dup wrap-words [ <line> ] map! ;
|
|
|
|
: cached-wrapped ( paragraph -- wrapped-paragraph )
|
|
dup wrapped>>
|
|
[ ] [ [ wrap-paragraph dup ] keep wrapped<< ] ?if ;
|
|
|
|
: max-line-width ( wrapped-paragraph -- x )
|
|
[ width>> ] [ max ] map-reduce ;
|
|
|
|
: sum-line-heights ( wrapped-paragraph -- y )
|
|
[ height>> ] map-sum ;
|
|
|
|
M: paragraph pref-dim*
|
|
cached-wrapped [
|
|
{ 0 0 }
|
|
] [
|
|
[ max-line-width ] [ sum-line-heights ] bi 2array
|
|
] if-empty ;
|
|
|
|
: line-y-coordinates ( wrapped-paragraph -- ys )
|
|
0 [ height>> + ] accumulate nip ;
|
|
|
|
: word-x-coordinates ( wrapped-line -- xs )
|
|
0 [ width>> + ] accumulate nip ;
|
|
|
|
: layout-word ( word x y -- )
|
|
[ key>> ] 2dip 2array >>loc prefer ;
|
|
|
|
: layout-line ( wrapped-line y -- )
|
|
[
|
|
words>>
|
|
[ ]
|
|
[ word-x-coordinates ]
|
|
[ [ key>> ] map align-baselines ] tri
|
|
] dip '[ _ + layout-word ] 3each ;
|
|
|
|
M: paragraph layout*
|
|
f >>wrapped
|
|
cached-wrapped dup line-y-coordinates [ layout-line ] 2each ;
|
|
|
|
M: paragraph baseline*
|
|
cached-wrapped [ f ] [ first baseline>> ] if-empty ;
|
|
|
|
M: paragraph cap-height* pack-cap-height ;
|
|
|
|
PRIVATE>
|