--- /dev/null
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.syntax help.markup strings math kernel ;
+IN: wrap
+
+ABOUT: "wrap"
+
+ARTICLE: "wrap" "Word wrapping"
+"The " { $vocab-link "wrap" } " vocabulary implements word wrapping. There is support for simple string wrapping, with the following words:"
+{ $subsection wrap-lines }
+{ $subsection wrap-string }
+{ $subsection wrap-indented-string }
+"Additionally, the vocabulary provides capabilities to wrap arbitrary groups of things, in units called words."
+{ $subsection wrap }
+{ $subsection word }
+{ $subsection <word> } ;
+
+HELP: wrap-lines
+{ $values { "lines" string } { "width" integer } { "newlines" "sequence of strings" } }
+{ $description "Given a string, divides it into a sequence of lines where each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ;
+
+HELP: wrap-string
+{ $values { "string" string } { "width" integer } { "newstring" string } }
+{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ;
+
+HELP: wrap-indented-string
+{ $values { "string" string } { "width" integer } { "indent" string } { "newstring" string } }
+{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space. Before each line, the indent string is added." } ;
+
+HELP: wrap
+{ $values { "words" { "a sequence of " { $instance word } "s" } } { "width" integer } { "lines" "a sequence of sequences of words" } }
+{ $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given width. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ;
+
+HELP: word
+{ $class-description "A word, for the purposes of " { $vocab-link "wrap" } ", is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Words can be created with " { $link <word> } "." }
+{ $see-also wrap } ;
+
+HELP: <word>
+{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "word" word } }
+{ $description "Creates a " { $link word } " object with the given parameters." }
+{ $see-also wrap } ;
-IN: wrap.tests
+! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
USING: tools.test wrap multiline sequences ;
+IN: wrap.tests
[
{
} 35 wrap [ { } like ] map
] unit-test
+[
+ {
+ {
+ T{ word f 1 10 f }
+ T{ word f 2 10 f }
+ T{ word f 3 9 t }
+ T{ word f 3 9 t }
+ T{ word f 3 9 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 9 t }
+ T{ word f 3 9 t }
+ T{ word f 3 9 t }
+ T{ word f 4 10 f }
+ T{ word f 5 10 f }
+ } 35 wrap [ { } like ] map
+] unit-test
+
[
<" This is a
long piece
] [
<" This is a long piece of text that we wish to word wrap."> 12
" " wrap-indented-string
-] unit-test
\ No newline at end of file
+] unit-test
+
+[ "this text\nhas lots of\nspaces" ]
+[ "this text has lots of spaces" 12 wrap-string ] unit-test
+
+[ "hello\nhow\nare\nyou\ntoday?" ]
+[ "hello how are you today?" 3 wrap-string ] unit-test
+! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
USING: sequences kernel namespaces make splitting
math math.order fry assocs accessors ;
IN: wrap
: break-here? ( column word -- ? )
break?>> not [ width get > ] [ drop f ] if ;
+: walk ( n words -- n )
+ ! If on a break, take the rest of the breaks
+ ! If not on a break, go back until you hit a break
+ 2dup bounds-check? [
+ 2dup nth break?>>
+ [ [ break?>> not ] find-from drop ]
+ [ [ break?>> ] find-last-from drop 1+ ] if
+ ] [ drop ] if ;
+
: find-optimal-break ( words -- n )
- [ 0 ] dip [ [ width>> + dup ] keep break-here? ] find drop nip ;
+ [ 0 ] keep
+ [ [ width>> + dup ] keep break-here? ] find drop nip
+ [ 1 max swap walk ] [ drop f ] if* ;
: (wrap) ( words -- )
- dup find-optimal-break
- [ 1 max cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if* ;
+ [
+ dup find-optimal-break
+ [ cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if*
+ ] unless-empty ;
: intersperse ( seq elt -- seq' )
[ '[ _ , ] [ , ] interleave ] { } make ;
: join-words ( wrapped-lines -- lines )
[
- [ break?>> ]
- [ trim-head-slice ]
- [ trim-tail-slice ] bi
+ [ break?>> ] trim-slice
[ key>> ] map concat
] map ;