Refactor basis/wrap to have a more flexible API

basis/wrap/wrap-tests.factor

@@ -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

basis/wrap/wrap.factor

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

basis/xml/writer/writer.factor

@@ -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 -- )