basis/wrap/words/words.factor

   1 ! Copyright (C) 2009 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors grouping kernel math sequences
   4 sequences.private splitting.monotonic wrap ;
   5 IN: wrap.words
   6
   7 TUPLE: word key width break? ;
   8 C: <word> word
   9
  10 <PRIVATE
  11
  12 : words-length ( words -- length )
  13     [ width>> ] map-sum ;
  14
  15 : make-element ( whites blacks -- element )
  16     [ append ] [ [ words-length ] bi@ ] 2bi <element> ;
  17
  18 : ?first2 ( seq -- first/f second/f )
  19     dup length dup 1 > [ drop first2-unsafe ] [
  20         0 > [ first-unsafe f ] [ drop f f ] if
  21     ] if ;
  22
  23 : split-words ( seq -- half-elements )
  24     [ [ break?>> ] same? ] monotonic-split ;
  25
  26 : ?first-break ( seq -- newseq f/element )
  27     dup first first break?>>
  28     [ unclip-slice f swap make-element ]
  29     [ f ] if ;
  30
  31 : make-elements ( seq f/element -- elements )
  32     [ 2 group [ ?first2 make-element ] map! ] dip
  33     [ prefix ] when* ;
  34
  35 : words>elements ( seq -- newseq )
  36     split-words ?first-break make-elements ;
  37
  38 PRIVATE>
  39
  40 : wrap-words ( words line-max line-ideal -- lines )
  41     [ words>elements ] 2dip wrap [ concat ] map! ;