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 ) : wrap-paragraph ( paragraph -- wrapped-paragraph )
[ children>> [ gadget>word ] map ] [ margin>> ] bi [ children>> [ gadget>word ] map ] [ margin>> ] bi
dup wrap-words [ <line> ] map! ; wrap-words [ <line> ] map! ;
: cached-wrapped ( paragraph -- wrapped-paragraph ) : cached-wrapped ( paragraph -- wrapped-paragraph )
dup wrapped>> dup wrapped>>

View File

@ -20,7 +20,7 @@ IN: wrap.strings
PRIVATE> PRIVATE>
: wrap-lines ( string width -- newlines ) : 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-string ( string width -- newstring )
wrap-lines join-lines ; wrap-lines join-lines ;

View File

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

View File

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

View File

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