1 ! Copyright (C) 2009 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: combinators kernel sequences math arrays locals fry accessors
4 lists splitting make combinators.short-circuit namespaces
5 grouping splitting.monotonic ;
8 ! black is the text length, white is the whitespace length
9 TUPLE: element contents black white ;
12 : element-length ( element -- n )
13 [ black>> ] [ white>> ] bi + ;
15 TUPLE: paragraph line-max line-ideal lines head-width tail-cost ;
16 C: <paragraph> paragraph
18 : top-fits? ( paragraph -- ? )
20 [ dup lines>> 1list? [ line-ideal>> ] [ line-max>> ] if ] bi <= ;
22 : fits? ( paragraph -- ? )
23 ! Make this not count spaces at end
24 { [ lines>> car 1list? ] [ top-fits? ] } 1|| ;
26 :: min-by ( seq quot -- elt )
27 f 1/0. seq [| key value new |
28 new quot call :> newvalue
29 newvalue value < [ new newvalue ] [ key value ] if
32 : paragraph-cost ( paragraph -- cost )
33 dup lines>> 1list? [ drop 0 ] [
34 [ [ head-width>> ] [ line-ideal>> ] bi - sq ]
38 : min-cost ( paragraphs -- paragraph )
39 [ paragraph-cost ] min-by ;
41 : new-line ( paragraph element -- paragraph )
43 [ drop [ line-max>> ] [ line-ideal>> ] bi ]
44 [ [ lines>> ] [ 1list ] bi* swons ]
46 [ drop paragraph-cost ]
47 } 2cleave <paragraph> ;
49 : glue ( paragraph element -- paragraph )
51 [ drop [ line-max>> ] [ line-ideal>> ] bi ]
52 [ [ lines>> unswons ] dip swons swons ]
53 [ [ head-width>> ] [ element-length ] bi* + ]
55 } 2cleave <paragraph> ;
57 : wrap-step ( paragraphs element -- paragraphs )
59 [ [ min-cost ] dip new-line ]
63 : 1paragraph ( line-max line-ideal element -- paragraph )
64 [ 1list 1list ] [ black>> ] bi 0 <paragraph> ;
66 : post-process ( paragraph -- array )
67 lines>> [ [ contents>> ] lmap>array ] lmap>array ;
69 : initialize ( line-max line-ideal elements -- elements paragraph )
70 <reversed> unclip-slice [ -rot ] dip 1paragraph 1array ;
72 : wrap ( elements line-max line-ideal -- paragraph )