]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/wrap/wrap.factor
basis: use lint.vocabs tool to trim using lists
[factor.git] / basis / wrap / wrap.factor
index 87a870d75d771421e6abdf58bfdf1dbf2eb2809c..4fe6247d991938c49d2ca43336ac465e808ab0e1 100644 (file)
@@ -1,32 +1,45 @@
-USING: sequences kernel namespaces make splitting math math.order ;
+! Copyright (C) 2009 Daniel Ehrenberg
+! Copyright (C) 2017 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays kernel math sequences sequences.private ;
 IN: wrap
 
-! Very stupid word wrapping/line breaking
-! This will be replaced by a Unicode-aware method,
-! which works with variable-width fonts
-
-SYMBOL: width
-
-: line-chunks ( string -- words-lines )
-    "\n" split [ " \t" split harvest ] map ;
-
-: (split-chunk) ( words -- )
-    -1 over [ length + 1+ dup width get > ] find drop nip
-    [ 1 max cut-slice swap , (split-chunk) ] [ , ] if* ;
-
-: split-chunk ( words -- lines )
-    [ (split-chunk) ] { } make ;
-
-: join-spaces ( words-seqs -- lines )
-    [ [ " " join ] map ] map concat ;
-
-: broken-lines ( string width -- lines )
-    width [
-        line-chunks [ split-chunk ] map join-spaces
-    ] with-variable ;
-
-: line-break ( string width -- newstring )
-    broken-lines "\n" join ;
-
-: indented-break ( string width indent -- newstring )
-    [ length - broken-lines ] keep [ prepend ] curry map "\n" join ;
+TUPLE: element contents black white ;
+
+C: <element> element
+
+:: wrap ( elements width -- array )
+    elements length integer>fixnum-strict :> #elements
+    elements [ black>> ] { } map-as :> black
+    elements [ white>> ] { } map-as :> white
+
+    #elements 1 + f <array> :> minima
+    #elements 1 + 0 <array> :> breaks
+
+    0 0 minima set-nth-unsafe
+
+    minima [| base i |
+        0 i 1 + [ dup #elements <= ] [| j |
+            j 1 - black nth-unsafe + dup :> w
+            j 1 - white nth-unsafe +
+
+            w width > [
+                j 1 - i = [
+                    0 j minima set-nth-unsafe
+                    i j breaks set-nth-unsafe
+                ] when #elements
+            ] [
+                base
+                j #elements = [ width w - sq + ] unless :> cost
+                j minima nth-unsafe [ cost >= ] [ t ] if* [
+                    cost j minima set-nth-unsafe
+                    i j breaks set-nth-unsafe
+                ] when j
+            ] if 1 +
+        ] while 2drop
+    ] each-index
+
+    #elements [ dup 0 > ] [
+        [ breaks nth dup ] keep elements <slice>
+        [ contents>> ] map
+    ] produce nip reverse ;