factor/basis/wrap/wrap.factor

61 lines
1.4 KiB
Factor

USING: sequences kernel namespaces make splitting
math math.order fry assocs accessors ;
IN: wrap
! Word wrapping/line breaking -- not Unicode-aware
TUPLE: word key width break? ;
C: <word> word
<PRIVATE
SYMBOL: width
: break-here? ( column word -- ? )
break?>> not [ width get > ] [ drop f ] if ;
: find-optimal-break ( words -- n )
[ 0 ] dip [ [ width>> + dup ] keep break-here? ] find drop nip ;
: (wrap) ( words -- )
dup find-optimal-break
[ 1 max cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if* ;
: intersperse ( seq elt -- seq' )
[ '[ _ , ] [ , ] interleave ] { } make ;
: split-lines ( string -- words-lines )
string-lines [
" \t" split harvest
[ dup length f <word> ] map
" " 1 t <word> intersperse
] map ;
: join-words ( wrapped-lines -- lines )
[
[ break?>> ]
[ trim-head-slice ]
[ trim-tail-slice ] bi
[ key>> ] map concat
] map ;
: join-lines ( strings -- string )
"\n" join ;
PRIVATE>
: wrap ( words width -- lines )
width [
[ (wrap) ] { } make
] with-variable ;
: wrap-lines ( lines width -- newlines )
[ split-lines ] dip '[ _ wrap join-words ] map concat ;
: wrap-string ( string width -- newstring )
wrap-lines join-lines ;
: wrap-indented-string ( string width indent -- newstring )
[ length - wrap-lines ] keep '[ _ prepend ] map join-lines ;