Refactor basis/wrap to have a more flexible API

db4
Slava Pestov 2009-02-02 03:47:45 -06:00
parent b684db297a
commit 0497132a47
3 changed files with 96 additions and 20 deletions

View File

@ -0,0 +1,48 @@
IN: wrap.tests
USING: tools.test wrap multiline sequences ;
[
{
{
T{ word f 1 10 f }
T{ word f 2 10 f }
T{ word f 3 2 t }
}
{
T{ word f 4 10 f }
T{ word f 5 10 f }
}
}
] [
{
T{ word f 1 10 f }
T{ word f 2 10 f }
T{ word f 3 2 t }
T{ word f 4 10 f }
T{ word f 5 10 f }
} 35 wrap [ { } like ] map
] unit-test
[
<" This is a
long piece
of text
that we
wish to
word wrap.">
] [
<" This is a long piece of text that we wish to word wrap."> 10
wrap-string
] unit-test
[
<" This is a
long piece
of text
that we
wish to
word wrap.">
] [
<" This is a long piece of text that we wish to word wrap."> 12
" " wrap-indented-string
] unit-test

View File

@ -1,32 +1,60 @@
USING: sequences kernel namespaces make splitting math math.order ;
USING: sequences kernel namespaces make splitting
math math.order fry assocs accessors ;
IN: wrap
! Very stupid word wrapping/line breaking
! This will be replaced by a Unicode-aware method,
! which works with variable-width fonts
! Word wrapping/line breaking -- not Unicode-aware
TUPLE: word key width break? ;
C: <word> word
<PRIVATE
SYMBOL: width
: line-chunks ( string -- words-lines )
"\n" split [ " \t" split harvest ] map ;
: break-here? ( column word -- ? )
break?>> not [ width get > ] [ drop f ] if ;
: (split-chunk) ( words -- )
-1 over [ length + 1+ dup width get > ] find drop nip
[ 1 max cut-slice swap , (split-chunk) ] [ , ] if* ;
: find-optimal-break ( words -- n )
[ 0 ] dip [ [ width>> + dup ] keep break-here? ] find drop nip ;
: split-chunk ( words -- lines )
[ (split-chunk) ] { } make ;
: (wrap) ( words -- )
dup find-optimal-break
[ 1 max cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if* ;
: join-spaces ( words-seqs -- lines )
[ [ " " join ] map ] map concat ;
: intersperse ( seq elt -- seq' )
[ '[ _ , ] [ , ] interleave ] { } make ;
: broken-lines ( string width -- lines )
: 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 [
line-chunks [ split-chunk ] map join-spaces
[ (wrap) ] { } make
] with-variable ;
: line-break ( string width -- newstring )
broken-lines "\n" join ;
: wrap-lines ( lines width -- newlines )
[ split-lines ] dip '[ _ wrap join-words ] map concat ;
: indented-break ( string width indent -- newstring )
[ length - broken-lines ] keep [ prepend ] curry map "\n" join ;
: wrap-string ( string width -- newstring )
wrap-lines join-lines ;
: wrap-indented-string ( string width indent -- newstring )
[ length - wrap-lines ] keep '[ _ prepend ] map join-lines ;

View File

@ -69,7 +69,7 @@ M: string write-xml
escape-string xml-pprint? get [
dup [ blank? ] all?
[ drop "" ]
[ nl 80 indent-string indented-break ] if
[ nl 80 indent-string wrap-indented-string ] if
] when write ;
: write-tag ( tag -- )