basis/wrap/wrap.factor

   1 USING: sequences kernel namespaces make splitting
   2 math math.order fry assocs accessors ;
   3 IN: wrap
   4
   5 ! Word wrapping/line breaking -- not Unicode-aware
   6
   7 TUPLE: word key width break? ;
   8
   9 C: <word> word
  10
  11 <PRIVATE
  12
  13 SYMBOL: width
  14
  15 : break-here? ( column word -- ? )
  16     break?>> not [ width get > ] [ drop f ] if ;
  17
  18 : find-optimal-break ( words -- n )
  19     [ 0 ] dip [ [ width>> + dup ] keep break-here? ] find drop nip ;
  20
  21 : (wrap) ( words -- )
  22     dup find-optimal-break
  23     [ 1 max cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if* ;
  24
  25 : intersperse ( seq elt -- seq' )
  26     [ '[ _ , ] [ , ] interleave ] { } make ;
  27
  28 : split-lines ( string -- words-lines )
  29     string-lines [
  30         " \t" split harvest
  31         [ dup length f <word> ] map
  32         " " 1 t <word> intersperse
  33     ] map ;
  34
  35 : join-words ( wrapped-lines -- lines )
  36     [
  37         [ break?>> ]
  38         [ trim-head-slice ]
  39         [ trim-tail-slice ] bi
  40         [ key>> ] map concat
  41     ] map ;
  42
  43 : join-lines ( strings -- string )
  44     "\n" join ;
  45
  46 PRIVATE>
  47
  48 : wrap ( words width -- lines )
  49     width [
  50         [ (wrap) ] { } make
  51     ] with-variable ;
  52
  53 : wrap-lines ( lines width -- newlines )
  54     [ split-lines ] dip '[ _ wrap join-words ] map concat ;
  55
  56 : wrap-string ( string width -- newstring )
  57     wrap-lines join-lines ;
  58
  59 : wrap-indented-string ( string width indent -- newstring )
  60     [ length - wrap-lines ] keep '[ _ prepend ] map join-lines ;