77 lines
1.9 KiB
Factor
77 lines
1.9 KiB
Factor
! Copyright (C) 2005, 2009 Slava Pestov
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors kernel math math.order sequences wrap arrays fry
|
|
ui.gadgets ui.gadgets.labels ui.render ;
|
|
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 < gadget margin ;
|
|
|
|
: <paragraph> ( margin -- gadget )
|
|
paragraph new-gadget
|
|
horizontal >>orientation
|
|
swap >>margin ;
|
|
|
|
<PRIVATE
|
|
|
|
: gadget>word ( gadget -- word )
|
|
[ ] [ pref-dim first ] [ word-break? ] tri <word> ;
|
|
|
|
TUPLE: line words ascent descent ;
|
|
|
|
: <line> ( words -- line )
|
|
dup [ key>> ] map dup pref-dims baseline-metrics line boa ;
|
|
|
|
: wrap-paragraph ( paragraph -- wrapped-paragraph )
|
|
[ children>> [ gadget>word ] map ] [ margin>> ] bi wrap
|
|
[ <line> ] map ;
|
|
|
|
: line-width ( wrapped-line -- n )
|
|
[ break?>> ] trim-tail-slice [ width>> ] sigma ;
|
|
|
|
: max-line-width ( wrapped-paragraph -- x )
|
|
[ words>> line-width ] [ max ] map-reduce ;
|
|
|
|
: line-height ( wrapped-line -- ys )
|
|
[ ascent>> ] [ descent>> ] bi + ;
|
|
|
|
: sum-line-heights ( wrapped-paragraph -- y )
|
|
[ line-height ] sigma ;
|
|
|
|
M: paragraph pref-dim*
|
|
wrap-paragraph [ max-line-width ] [ sum-line-heights ] bi 2array ;
|
|
|
|
: line-y-coordinates ( wrapped-paragraph -- ys )
|
|
0 [ line-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 baseline-align ] tri
|
|
] dip '[ _ + layout-word ] 3each ;
|
|
|
|
M: paragraph layout*
|
|
wrap-paragraph dup line-y-coordinates
|
|
[ layout-line ] 2each ;
|
|
|
|
PRIVATE> |