wrap: remove line-ideal, we only ever use a max-width.

char-rename
John Benediktsson 2017-02-01 20:30:57 -08:00
parent ecdb8dfe62
commit f7ce76aa4b
6 changed files with 19 additions and 20 deletions

View File

@ -41,7 +41,7 @@ TUPLE: line words width height baseline ;
: wrap-paragraph ( paragraph -- wrapped-paragraph )
[ children>> [ gadget>word ] map ] [ margin>> ] bi
dup wrap-words [ <line> ] map! ;
wrap-words [ <line> ] map! ;
: cached-wrapped ( paragraph -- wrapped-paragraph )
dup wrapped>>

View File

@ -20,7 +20,7 @@ IN: wrap.strings
PRIVATE>
: wrap-lines ( string width -- newlines )
[ split-lines ] dip '[ _ dup wrap join-elements ] map! concat ;
[ split-lines ] dip '[ _ wrap join-elements ] map! concat ;
: wrap-string ( string width -- newstring )
wrap-lines join-lines ;

View File

@ -3,8 +3,8 @@
USING: tools.test wrap.words sequences ;
IN: wrap.words.tests
{ { } } [ f 35 35 wrap-words ] unit-test
{ { } } [ { } 35 35 wrap-words ] unit-test
{ { } } [ f 35 wrap-words ] unit-test
{ { } } [ { } 35 wrap-words ] unit-test
{
{
@ -25,7 +25,7 @@ IN: wrap.words.tests
T{ wrapping-word f 3 2 t }
T{ wrapping-word f 4 10 f }
T{ wrapping-word f 5 10 f }
} 35 35 wrap-words [ { } like ] map
} 35 wrap-words [ { } like ] map
] unit-test
{
@ -51,7 +51,7 @@ IN: wrap.words.tests
T{ wrapping-word f 3 9 t }
T{ wrapping-word f 4 10 f }
T{ wrapping-word f 5 10 f }
} 35 35 wrap-words [ { } like ] map
} 35 wrap-words [ { } like ] map
] unit-test
{
@ -79,5 +79,5 @@ IN: wrap.words.tests
T{ wrapping-word f 3 9 t }
T{ wrapping-word f 4 10 f }
T{ wrapping-word f 5 10 f }
} 35 35 wrap-words [ { } like ] map
} 35 wrap-words [ { } like ] map
] unit-test

View File

@ -37,5 +37,5 @@ C: <wrapping-word> wrapping-word
PRIVATE>
: wrap-words ( words line-max line-ideal -- lines )
[ words>elements ] 2dip wrap [ concat ] map! ;
: wrap-words ( words width -- lines )
[ words>elements ] dip wrap [ concat ] map! ;

View File

@ -2,4 +2,4 @@
! See http://factorcode.org/license.txt for BSD license.
USING: wrap tools.test ;
{ { } } [ { } 10 10 wrap ] unit-test
{ { } } [ { } 10 wrap ] unit-test

View File

@ -13,15 +13,14 @@ C: <element> element
: element-length ( element -- n )
[ black>> ] [ white>> ] bi + ; inline
TUPLE: paragraph line-max line-ideal lines head-width tail-cost ;
TUPLE: paragraph line-max lines head-width tail-cost ;
C: <paragraph> paragraph
: if-one-line ( paragraph true false -- )
[ dup lines>> 1list? ] 2dip if ; inline
TYPED: top-fits? ( paragraph: paragraph -- ? )
[ head-width>> ]
[ [ line-ideal>> ] [ line-max>> ] if-one-line ] bi <= ; inline
[ head-width>> ] [ line-max>> ] bi <= ; inline
TYPED: fits? ( paragraph: paragraph -- ? )
! Make this not count spaces at end
@ -29,7 +28,7 @@ TYPED: fits? ( paragraph: paragraph -- ? )
TYPED: paragraph-cost ( paragraph: paragraph -- cost )
[ drop 0 ] [
[ head-width>> ] [ line-ideal>> - sq ] [ tail-cost>> ] tri +
[ head-width>> ] [ line-max>> - sq ] [ tail-cost>> ] tri +
] if-one-line ; inline
: min-cost ( paragraphs -- paragraph )
@ -37,7 +36,7 @@ TYPED: paragraph-cost ( paragraph: paragraph -- cost )
TYPED: new-line ( paragraph: paragraph element: element -- paragraph )
{
[ drop [ line-max>> ] [ line-ideal>> ] bi ]
[ drop line-max>> ]
[ [ lines>> ] [ 1list ] bi* swons ]
[ nip black>> ]
[ drop paragraph-cost ]
@ -53,19 +52,19 @@ TYPED: wrap-step ( paragraphs: array element: element -- paragraphs )
2bi swap prefix { array } declare
[ fits? ] filter ; inline
: 1paragraph ( line-max line-ideal element -- paragraph )
: 1paragraph ( line-max element -- paragraph )
[ 1list 1list ] [ black>> ] bi 0 <paragraph> ;
: post-process ( paragraph -- array )
lines>> [ [ contents>> ] lmap>array ] lmap>array ;
: initial-step ( line-max line-ideal elements -- elements paragraph )
reverse unclip [ -rot ] dip 1paragraph 1array ;
: initial-step ( line-max elements -- elements paragraph )
reverse unclip swapd 1paragraph 1array ;
PRIVATE>
: wrap ( elements line-max line-ideal -- array )
rot [ 2drop { } ] [
: wrap ( elements width -- array )
swap [ drop { } ] [
initial-step
[ wrap-step ] reduce
min-cost